bedload_diffin.f

Go to the documentation of this file.

!                   *************************
                    SUBROUTINE bedload_diffin
!                   *************************
!
     &(u, v, nbor, xnebor, ynebor, maskel, nelbor, nptfr,
     & kent, ksort, klog, kdir, kddl, kneu, msk, clt, litbor,
     & masktr, limtra,iklbor,neleb,nelebx)
!
!***********************************************************************
! SISYPHE   V7P0                                   27/03/2014
!***********************************************************************
!
!brief    INITIALISES THE BOUNDARY CONDITIONS.
!
!history  FRANCOIS MENARD (PLACEMENT @ LNHE)
!+        17/08/2004
!+        V6P0
!+
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!history  C.VILLARET (EDF-LNHE), P.TASSI (EDF-LNHE)
!+        19/07/2011
!+        V6P1
!+  Name of variables
!
!history  J-M HERVOUET (EDF LAB, LNHE)
!+        27/03/2014
!+        V7P0
!+  Adaptation to different numbering of boundary elements.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| CLT            |<->| TYPE OF BOUNDARY CONDITIONS FOR TRACER (MODIFIED LITBOR)
!| IKLBOR         |-->| CONNECTIVITY OF BOUNDARY ELEMENTS.
!| KDDL           |-->| CONVENTION FOR DEGREE OF FREEDOM
!| KDIR           |-->| CONVENTION FOR DIRICHLET POINT
!| KENT           |-->| CONVENTION FOR LIQUID INPUT WITH PRESCRIBED VALUE
!| KINC           |-->| CONVENTION FOR INCIDENT WAVE BOUNDARY CONDITION
!| KLOG           |-->| CONVENTION FOR SOLID BOUNDARY
!| KNEU           |-->| CONVENTION FOR NEUMANN CONDITION
!| KSORT          |-->| CONVENTION FOR FREE OUTPUT
!| LIMTRA         |<->| TYPE OF BOUNDARY CONDITION FOR TRACER
!| LITBOR         |<->| TYPE OF BOUNDARY CONDITIONS FOR TRACER (***)
!| MASKEL         |-->| MASKING OF ELEMENTS
!| MASKTR         |<->| MASKING FOR TRACERS, PER POINT
!| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS
!| NBOR           |-->| NUMBER OF BOUDARY POINTS
!| NELBOR         |-->| NUMBERS OF ELEMENTS TOUCHING THE BORDER
!| NELEB          |-->| NUMBER OF BOUDARY ELEMENTS
!| NELEBX         |-->| MAXIMUM NUMBER OF BOUDARY ELEMENTS
!| NPTFR          |-->| NUMBER OF BOUDARIES
!| U              |-->| FLOW VELOCITY IN THE X DIRECTION
!| V              |-->| FLOW VELOCITY IN THE Y DIRECTION
!| XNEBOR         |-->| X-COORDINATES OF THE BOUNDARY POINT
!| YNEBOR         |-->| Y-COORDINATES OF THE BOUNDARY POINT
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE interface_sisyphe, ex_bedload_diffin => bedload_diffin
      USE bief
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      TYPE(bief_obj), INTENT(IN)    :: U,V,NBOR,XNEBOR,YNEBOR
      TYPE(bief_obj), INTENT(IN)    :: MASKEL,NELBOR
      INTEGER,        INTENT(IN)    :: NPTFR,KENT,KSORT,KLOG
      INTEGER,        INTENT(IN)    :: KDIR,KDDL,KNEU,NELEB,NELEBX
      INTEGER,        INTENT(IN)    :: IKLBOR(nelebx,2)
      LOGICAL,        INTENT(IN)    :: MSK
      TYPE(bief_obj), INTENT(INOUT) :: CLT
      TYPE(bief_obj), INTENT(INOUT) :: LITBOR, MASKTR, LIMTRA
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER            :: K,K1,K2,IELEB
      DOUBLE PRECISION   :: USCALN,C
      INTEGER, PARAMETER :: DIR = 1
      INTEGER, PARAMETER :: DDL = 2
      INTEGER, PARAMETER :: NEU = 3
!
!======================================================================!
!======================================================================!
!                               PROGRAM                                !
!======================================================================!
!======================================================================!
!
      ! ****************************************************** !
      ! I - TYPES OF BOUNDARY CONDITIONS FOR THE TRACER        !
      !     MAY BE MODIFIED DEPENDING ON THE SIGN OF U.N       !
      !     FOR THE LIQUID BOUNDARIES (N : OUTGOING NORMAL)    !
      ! ****************************************************** !
!
      DO k = 1, nptfr
        clt%I(k) = litbor%I(k)
        ! I.1 - LIQUID BOUNDARIES
        ! --------------------------------------
        IF (clt%I(k) == kent) THEN
          uscaln = u%R(nbor%I(k))*xnebor%R(k)
     &           + v%R(nbor%I(k))*ynebor%R(k)
          ! OUTGOING VELOCITY, FREE TRACER
          ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          IF (uscaln >= 0.d0) clt%I(k) = ksort
        ELSEIF(clt%I(k) == ksort) THEN
          uscaln = u%R(nbor%I(k))*xnebor%R(k)
     &           + v%R(nbor%I(k))*ynebor%R(k)
          ! ENTERING VELOCITY, FREE TRACER
          ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          IF (uscaln <= 0.d0) clt%I(k) = kent
        ENDIF
      ENDDO
!
      ! **************************************************************** !
      ! II - MASKTR ARRAY DEFINED AS A FUNCTION OF CLT                   !
      !      EQUALS 1 FOR A SEGMENT OF NEUMANN TYPE, AND 0 OTHERWISE     !
      !      A SEGMENT IS OF NEUMANN TYPE IF THE USER SPECIFIES AT LEAST !
      !      ONE OF ITS NODES AS NEUMANN.                                !
      ! **************************************************************** !
!
      CALL os('X=0     ', x=masktr)
!
      DO ieleb = 1 , neleb
        k1=iklbor(ieleb,1)
        k2=iklbor(ieleb,2)
        ! II.1 - NEUMANN TYPE SEGMENTS
        ! -------------------------------
        IF(clt%I(k1).EQ.klog.OR.clt%I(k2).EQ.klog) THEN
          masktr%ADR(neu)%P%R(ieleb) = 1.d0
        ! II.2 - OUTGOING TYPE SEGMENTS
        ! ------------------------------
        ELSEIF(clt%I(k1).EQ.kent.AND.clt%I(k2).EQ.ksort) THEN
          masktr%ADR(ddl)%P%R(ieleb) = 1.d0
        ELSEIF (clt%I(k1).EQ.ksort.OR.clt%I(k2).EQ.ksort) THEN
          masktr%ADR(ddl)%P%R(ieleb) = 1.d0
        ! II.3 - OUTGOING TYPE SEGMENTS
        ! ------------------------------
        ELSEIF(clt%I(k1).EQ.ksort.AND.clt%I(k2).EQ.kent) THEN
          masktr%ADR(ddl)%P%R(ieleb) = 1.d0
        ELSEIF(clt%I(k1).EQ.kent.OR.clt%I(k2).EQ.kent) THEN
          masktr%ADR(dir)%P%R(ieleb) = 1.d0
        ELSE
          WRITE(lu,102)
          CALL plante(1)
          stop
        ENDIF
      ENDDO
!
      ! *********************** !
      ! III - POTENTIAL MASKING !
      ! *********************** !
!
      IF(msk) THEN
        DO ieleb = 1 , neleb
          c=maskel%R(nelbor%I(ieleb))
          masktr%ADR(dir)%P%R(ieleb) = masktr%ADR(dir)%P%R(ieleb)*c
          masktr%ADR(ddl)%P%R(ieleb) = masktr%ADR(ddl)%P%R(ieleb)*c
          masktr%ADR(neu)%P%R(ieleb) = masktr%ADR(neu)%P%R(ieleb)*c
        ENDDO
      ENDIF
!
      ! ************************************************************** !
      ! IV - FROM PHYSICAL CONDITION TO TECHNICAL CONDITIONS           !
      ! ************************************************************** !
!
      DO k = 1, nptfr
        ! IV.1 - 'INCOMING' BOUNDARY : IMPOSED TRACER
        ! -----------------------------------------
        IF(clt%I(k).EQ.kent) THEN
          limtra%I(k) = kdir
        ELSEIF(clt%I(k).EQ.ksort) THEN
          limtra%I(k) = kddl
        ! IV.2 - SOLID BOUNDARY : NEUMANN CONDITIONS
        ! ------------------------------------
        ELSEIF(clt%I(k).EQ.klog ) THEN
          limtra%I(k) = kneu
        ! IV.3 - ERROR: UNKNOWN LITBOR VALUE
        ! ----------------------------------------
        ELSE
          WRITE(lu,12) k, litbor%I(k)
          CALL plante(1)
          stop
        ENDIF
      ENDDO
      !----------------------------------------------------------------!
102   FORMAT(' BEDLOAD_DIFFIN: UNEXPECTED CASE')
12    FORMAT(' BEDLOAD_DIFFIN: POINT ',1i8,' LITBOR= ',1i8,' ?')
      !----------------------------------------------------------------!
!
!======================================================================!
!======================================================================!
!
      RETURN
      END