bedload_diffin.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\bedload_diffin.f
00002 !
00069                      SUBROUTINE BEDLOAD_DIFFIN
00070 !                    *************************
00071 !
00072      &(U, V, NBOR, XNEBOR, YNEBOR, MASKEL, NELBOR, NPTFR,
00073      & KENT, KSORT, KLOG, KDIR, KDDL, KNEU, MSK, CLT, LITBOR,
00074      & MASKTR, LIMTRA,IKLBOR,NELEB,NELEBX)
00075 !
00076 !***********************************************************************
00077 ! SISYPHE   V7P0                                   27/03/2014
00078 !***********************************************************************
00079 !
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00087 !| CLT            |<->| TYPE OF BOUNDARY CONDITIONS FOR TRACER (MODIFIED LITBOR)
00088 !| IKLBOR         |-->| CONNECTIVITY OF BOUNDARY ELEMENTS.
00089 !| KDDL           |-->| CONVENTION FOR DEGREE OF FREEDOM
00090 !| KDIR           |-->| CONVENTION FOR DIRICHLET POINT
00091 !| KENT           |-->| CONVENTION FOR LIQUID INPUT WITH PRESCRIBED VALUE
00092 !| KINC           |-->| CONVENTION FOR INCIDENT WAVE BOUNDARY CONDITION
00093 !| KLOG           |-->| CONVENTION FOR SOLID BOUNDARY
00094 !| KNEU           |-->| CONVENTION FOR NEUMANN CONDITION
00095 !| KSORT          |-->| CONVENTION FOR FREE OUTPUT
00096 !| LIMTRA         |<->| TYPE OF BOUNDARY CONDITION FOR TRACER
00097 !| LITBOR         |<->| TYPE OF BOUNDARY CONDITIONS FOR TRACER (***)
00098 !| MASKEL         |-->| MASKING OF ELEMENTS
00099 !| MASKTR         |<->| MASKING FOR TRACERS, PER POINT
00100 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS
00101 !| NBOR           |-->| NUMBER OF BOUDARY POINTS
00102 !| NELBOR         |-->| NUMBERS OF ELEMENTS TOUCHING THE BORDER
00103 !| NELEB          |-->| NUMBER OF BOUDARY ELEMENTS
00104 !| NELEBX         |-->| MAXIMUM NUMBER OF BOUDARY ELEMENTS
00105 !| NPTFR          |-->| NUMBER OF BOUDARIES
00106 !| U              |-->| FLOW VELOCITY IN THE X DIRECTION
00107 !| V              |-->| FLOW VELOCITY IN THE Y DIRECTION
00108 !| XNEBOR         |-->| X-COORDINATES OF THE BOUNDARY POINT
00109 !| YNEBOR         |-->| Y-COORDINATES OF THE BOUNDARY POINT
00110 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00111 !
00112       USE INTERFACE_SISYPHE, EX_BEDLOAD_DIFFIN => BEDLOAD_DIFFIN
00113       USE BIEF
00114       IMPLICIT NONE
00115       INTEGER LNG,LU
00116       COMMON/INFO/LNG,LU
00117 !
00118 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00119 !
00120       TYPE(BIEF_OBJ), INTENT(IN)    :: U,V,NBOR,XNEBOR,YNEBOR
00121       TYPE(BIEF_OBJ), INTENT(IN)    :: MASKEL,NELBOR
00122       INTEGER,        INTENT(IN)    :: NPTFR,KENT,KSORT,KLOG
00123       INTEGER,        INTENT(IN)    :: KDIR,KDDL,KNEU,NELEB,NELEBX
00124       INTEGER,        INTENT(IN)    :: IKLBOR(NELEBX,2)
00125       LOGICAL,        INTENT(IN)    :: MSK
00126       TYPE(BIEF_OBJ), INTENT(INOUT) :: CLT
00127       TYPE(BIEF_OBJ), INTENT(INOUT) :: LITBOR, MASKTR, LIMTRA
00128 !
00129 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00130 !
00131       INTEGER            :: K,K1,K2,IELEB
00132       DOUBLE PRECISION   :: USCALN,C
00133       INTEGER, PARAMETER :: DIR = 1
00134       INTEGER, PARAMETER :: DDL = 2
00135       INTEGER, PARAMETER :: NEU = 3
00136 !
00137 !======================================================================!
00138 !======================================================================!
00139 !                               PROGRAM                                !
00140 !======================================================================!
00141 !======================================================================!
00142 !
00143       ! ****************************************************** !
00144       ! I - TYPES OF BOUNDARY CONDITIONS FOR THE TRACER        !
00145       !     MAY BE MODIFIED DEPENDING ON THE SIGN OF U.N       !
00146       !     FOR THE LIQUID BOUNDARIES (N : OUTGOING NORMAL)    !
00147       ! ****************************************************** !
00148 !
00149       DO K = 1, NPTFR
00150         CLT%I(K) = LITBOR%I(K)
00151         ! I.1 - LIQUID BOUNDARIES
00152         ! --------------------------------------
00153         IF (CLT%I(K) == KENT) THEN
00154           USCALN = U%R(NBOR%I(K))*XNEBOR%R(K)
00155      &           + V%R(NBOR%I(K))*YNEBOR%R(K)
00156           ! OUTGOING VELOCITY, FREE TRACER
00157           ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00158           IF (USCALN >= 0.D0) CLT%I(K) = KSORT
00159         ELSEIF(CLT%I(K) == KSORT) THEN
00160           USCALN = U%R(NBOR%I(K))*XNEBOR%R(K)
00161      &           + V%R(NBOR%I(K))*YNEBOR%R(K)
00162           ! ENTERING VELOCITY, FREE TRACER
00163           ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00164           IF (USCALN <= 0.D0) CLT%I(K) = KENT
00165         ENDIF
00166       ENDDO
00167 !
00168       ! **************************************************************** !
00169       ! II - MASKTR ARRAY DEFINED AS A FUNCTION OF CLT                   !
00170       !      EQUALS 1 FOR A SEGMENT OF NEUMANN TYPE, AND 0 OTHERWISE     !
00171       !      A SEGMENT IS OF NEUMANN TYPE IF THE USER SPECIFIES AT LEAST !
00172       !      ONE OF ITS NODES AS NEUMANN.                                !
00173       ! **************************************************************** !
00174 !
00175       CALL OS('X=0     ', X=MASKTR)
00176 !
00177       DO IELEB = 1 , NELEB
00178         K1=IKLBOR(IELEB,1)
00179         K2=IKLBOR(IELEB,2)
00180         ! II.1 - NEUMANN TYPE SEGMENTS
00181         ! -------------------------------
00182         IF(CLT%I(K1).EQ.KLOG.OR.CLT%I(K2).EQ.KLOG) THEN
00183           MASKTR%ADR(NEU)%P%R(IELEB) = 1.D0
00184         ! II.2 - OUTGOING TYPE SEGMENTS
00185         ! ------------------------------
00186         ELSEIF(CLT%I(K1).EQ.KENT.AND.CLT%I(K2).EQ.KSORT) THEN
00187           MASKTR%ADR(DDL)%P%R(IELEB) = 1.D0
00188         ELSEIF (CLT%I(K1).EQ.KSORT.OR.CLT%I(K2).EQ.KSORT) THEN
00189           MASKTR%ADR(DDL)%P%R(IELEB) = 1.D0
00190         ! II.3 - OUTGOING TYPE SEGMENTS
00191         ! ------------------------------
00192         ELSEIF(CLT%I(K1).EQ.KSORT.AND.CLT%I(K2).EQ.KENT) THEN
00193           MASKTR%ADR(DDL)%P%R(IELEB) = 1.D0
00194         ELSEIF(CLT%I(K1).EQ.KENT.OR.CLT%I(K2).EQ.KENT) THEN
00195           MASKTR%ADR(DIR)%P%R(IELEB) = 1.D0
00196         ELSE
00197           IF (LNG == 1) WRITE(LU,101)
00198           IF (LNG == 2) WRITE(LU,102)
00199           CALL PLANTE(1)
00200           STOP
00201         ENDIF
00202       ENDDO
00203 !
00204       ! *********************** !
00205       ! III - POTENTIAL MASKING !
00206       ! *********************** !
00207 !
00208       IF(MSK) THEN
00209         DO IELEB = 1 , NELEB
00210           C=MASKEL%R(NELBOR%I(IELEB))
00211           MASKTR%ADR(DIR)%P%R(IELEB) = MASKTR%ADR(DIR)%P%R(IELEB)*C
00212           MASKTR%ADR(DDL)%P%R(IELEB) = MASKTR%ADR(DDL)%P%R(IELEB)*C
00213           MASKTR%ADR(NEU)%P%R(IELEB) = MASKTR%ADR(NEU)%P%R(IELEB)*C
00214         ENDDO
00215       ENDIF
00216 !
00217       ! ************************************************************** !
00218       ! IV - FROM PHYSICAL CONDITION TO TECHNICAL CONDITIONS           !
00219       ! ************************************************************** !
00220 !
00221       DO K = 1, NPTFR
00222         ! IV.1 - 'INCOMING' BOUNDARY : IMPOSED TRACER
00223         ! -----------------------------------------
00224         IF(CLT%I(K).EQ.KENT) THEN
00225           LIMTRA%I(K) = KDIR
00226         ELSEIF(CLT%I(K).EQ.KSORT) THEN
00227           LIMTRA%I(K) = KDDL
00228         ! IV.2 - SOLID BOUNDARY : NEUMANN CONDITIONS
00229         ! ------------------------------------
00230         ELSEIF(CLT%I(K).EQ.KLOG ) THEN
00231           LIMTRA%I(K) = KNEU
00232         ! IV.3 - ERROR: UNKNOWN LITBOR VALUE
00233         ! ----------------------------------------
00234         ELSE
00235           IF (LNG == 1) WRITE(LU,11) K, LITBOR%I(K)
00236           IF (LNG == 2) WRITE(LU,12) K, LITBOR%I(K)
00237           CALL PLANTE(1)
00238           STOP
00239         ENDIF
00240       ENDDO
00241       !----------------------------------------------------------------!
00242 101   FORMAT(' BEDLOAD_DIFFIN : CAS NON PREVU')
00243 11    FORMAT(' BEDLOAD_DIFFIN : POINT ',1I8,' LITBOR= ',1I8,' ?')
00244       !----------------------------------------------------------------!
00245 102   FORMAT(' BEDLOAD_DIFFIN: UNEXPECTED CASE')
00246 12    FORMAT(' BEDLOAD_DIFFIN: POINT ',1I8,' LITBOR= ',1I8,' ?')
00247       !----------------------------------------------------------------!
00248 !
00249 !======================================================================!
00250 !======================================================================!
00251 !
00252       RETURN
00253       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0