bedload_solidischarge.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\bedload_solidischarge.f
00002 !
00094                      SUBROUTINE BEDLOAD_SOLIDISCHARGE
00095 !                    ********************************
00096 !
00097      &(MESH,U2D,V2D,UNORM,HN,TW,UW,MU,TOB,CF,TOBW,FW,THETAW,
00098      & AVA,MASKPT,MASKEL,ACLADM,UNLADM,KSP,KSR,LIQBOR,
00099      & QBOR,DEBUG,NPOIN,NPTFR,IELMT,ICF,KENT,OPTBAN,
00100      & HIDFAC,GRAV,DM,D90,XWC,XMVE,XMVS,VCE,HMIN,
00101      & HIDI,KARMAN,ZERO,PI,KARIM_HOLLY_YANG,
00102      & SUSP,MSK,T1,T2,T3,T4,T5,T6,T7,T8,T9,T10,
00103      & T11,T12,AC,HIDING,QSC,QSS,
00104      & SLOPEFF,COEFPN,PHISED,CALFA,SALFA,BETA,ZF_C,S,
00105      & DEVIA,BETA2,SECCURRENT,BIJK,HOULE,UNSV2D,U3D,V3D,CODE)
00106 !
00107 !***********************************************************************
00108 ! SISYPHE   V6P2                                   21/07/2011
00109 !***********************************************************************
00110 !
00111 !
00112 !
00113 !
00114 !
00115 !
00116 !
00117 !
00118 !
00119 !
00120 !
00121 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00122 !| AC             |<->| CRITICAL SHIELDS PARAMETER
00123 !| ACLADM         |-->| MEAN DIAMETER OF SEDIMENT
00124 !| AVA            |-->| PERCENT AVAILABLE
00125 !| BETA           |-->| COEFFICIENT FOR SLOPING BED EFFECT ( KOCH AND FLOKSTRA)
00126 !| BETA2          |-->| COEFFICIENT FOR THE DEVIATION  (TALMON ET AL.)
00127 !| BIJK           |-->| COEFFICIENT OF THE BIJKER FORMULA
00128 !| CALFA          |<->| COSINUS OF THE ANGLE BETWEEN MEAN FLOW AND TRANSPORT
00129 !| CF             |-->| QUADRATIC FRICTION COEFFICIENT
00130 !| COEFPN         |<->| CORRECTION OF TRANSORT FOR SLOPING BED EFFECT
00131 !| D90            |-->| D90
00132 !| DEBUG          |-->| FLAG FOR DEBUGGING
00133 !| DEVIA          |-->| SLOPE EFFECT FORMULA FOR DEVIATION
00134 !| DM             |-->| SEDIMENT GRAIN DIAMETER
00135 !| FW             |---| QUADRATIC FRICTION COEFFICIENT (WAVE)
00136 !| GRAV           |-->| ACCELERATION OF GRAVITY
00137 !| HIDFAC         |-->| HIDING FACTOR FORMULAS
00138 !| HIDI           |-->| HIDING FACTOR FOR PARTICULAR SIZE CLASS (HIDFAC =0)
00139 !| HIDING         |-->| HIDING FACTOR CORRECTION
00140 !| HMIN           |-->| MINIMUM VALUE OF WATER DEPTH
00141 !| HN             |-->| WATER DEPTH
00142 !| HOULE          |-->| LOGICAL, FOR WAVE EFFECTS
00143 !| ICF            |-->| BED-LOAD OR TOTAL LOAD TRANSPORT FORMULAS
00144 !| IELMT          |-->| NUMBER OF ELEMENTS
00145 !| KARMAN         |-->| VON KARMAN CONSTANT
00146 !| KENT           |-->| CONVENTION FOR LIQUID INPUT WITH PRESCRIBED VALUE
00147 !| KSP            |-->| BED SKIN ROUGHNESS
00148 !| KSR            |-->| RIPPLE BED ROUGHNESS
00149 !| LIQBOR         |-->| TYPE OF BOUNDARY CONDITION FOR QS
00150 !| MASKEL         |-->| MASKING OF ELEMENTS
00151 !| MASKPT         |-->| MASKING PER POINT
00152 !| MESH           |<->| MESH STRUCTURE
00153 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS
00154 !| MU             |<->| CORRECTION FACTOR FOR BED ROUGHNESS
00155 !| NPOIN          |-->| NUMBER OF POINTS
00156 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00157 !| OPTBAN         |-->| OPTION FOR TIDAL FLATS
00158 !| PHISED         |-->| ANGLE OF REPOSE OF THE SEDIMENT
00159 !| PI             |-->| PI
00160 !| QBOR           |-->| BOUNDARY CONDITION FOR TRANSPORT RATE
00161 !| QSC            |<->| BED LOAD TRANSPORT
00162 !| QSS            |<->| SUSPENDED LOAD TRANSPORT RATE
00163 !| S              |-->| VOID STRUCTURE
00164 !| SALFA          |<->| SINUS OF THE ANGLE BETWEEN TRANSPORT RATE AND CURRENT
00165 !| SECCURRENT     |-->| LOGICAL, PARAMETRISATION FOR SECONDARY CURRENTS
00166 !| SLOPEFF        |-->| LOGICAL, SLOPING BED EFFECT OR NOT
00167 !| SUSP           |-->| LOGICAL, SUSPENSION
00168 !| T1             |<->| WORK BIEF_OBJ STRUCTURE
00169 !| T10            |<->| WORK BIEF_OBJ STRUCTURE
00170 !| T11            |<->| WORK BIEF_OBJ STRUCTURE
00171 !| T12            |<->| WORK BIEF_OBJ STRUCTURE
00172 !| T13            |<->| WORK BIEF_OBJ STRUCTURE
00173 !| T2             |<->| WORK BIEF_OBJ STRUCTURE
00174 !| T3             |<->| WORK BIEF_OBJ STRUCTURE
00175 !| T4             |<->| WORK BIEF_OBJ STRUCTURE
00176 !| T5             |<->| WORK BIEF_OBJ STRUCTURE
00177 !| T6             |<->| WORK BIEF_OBJ STRUCTURE
00178 !| T7             |<->| WORK BIEF_OBJ STRUCTURE
00179 !| T8             |<->| WORK BIEF_OBJ STRUCTURE
00180 !| T9             |<->| WORK BIEF_OBJ STRUCTURE
00181 !| THETAW         |-->| ANGLE BETWEEN WAVE AND CURRENT
00182 !| TOB            |<->| BED SHEAR STRESS (TOTAL FRICTION)
00183 !| TOBW           |-->| WAVE INDUCED SHEAR STRESS
00184 !| TW             |-->| WAVE PERIOD
00185 !| U2D            |<->| MEAN FLOW VELOCITY X-DIRECTION
00186 !| UNLADM         |-->| MEAN DIAMETER OF ACTIVE STRATUM LAYER
00187 !| UNORM          |<->| NORM OF THE MEAN FLOW VELOCITY
00188 !| UNSV2D         |-->| INVERSE OF INTEGRALS OF TEST FUNCTIONS
00189 !| UW             |-->| ORBITAL WAVE VELOCITY
00190 !| V2D            |<->| MEAN FLOW VELOCITY Y-DIRECTION
00191 !| VCE            |-->| WATER VISCOSITY
00192 !| XMVE           |-->| FLUID DENSITY
00193 !| XMVS           |-->| WATER DENSITY
00194 !| XWC            |-->| SETTLING VELOCITY
00195 !| ZERO           |-->| ZERO
00196 !| ZF_C           |<->| BEDLOAD EVOLUTION
00197 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00198 !
00199       USE INTERFACE_SISYPHE,
00200      &    EX_BEDLOAD_SOLIDISCHARGE => BEDLOAD_SOLIDISCHARGE
00201       USE BIEF
00202 !
00203       IMPLICIT NONE
00204       INTEGER LNG,LU
00205       COMMON/INFO/LNG,LU
00206 !
00207 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00208 !
00209       TYPE(BIEF_MESH),  INTENT(INOUT) :: MESH
00210       TYPE(BIEF_OBJ),   INTENT(IN)    :: U2D, V2D,  HN, TW, UW
00211       TYPE(BIEF_OBJ),   INTENT(IN)    :: UNORM ,MU, KSR ,KSP
00212       TYPE(BIEF_OBJ),   INTENT(IN)    :: TOB, CF, TOBW, FW, THETAW
00213       TYPE(BIEF_OBJ),   INTENT(IN)    :: MASKPT, MASKEL
00214       TYPE(BIEF_OBJ),   INTENT(IN)    :: ACLADM, UNLADM, LIQBOR, QBOR
00215       INTEGER,          INTENT(IN)    :: DEBUG
00216       INTEGER,          INTENT(IN)    :: NPOIN, NPTFR, IELMT, ICF
00217       INTEGER,          INTENT(IN)    :: KENT, OPTBAN,HIDFAC
00218       DOUBLE PRECISION, INTENT(IN)    :: GRAV, DM, D90, XWC, XMVE, XMVS
00219       DOUBLE PRECISION, INTENT(IN)    :: VCE, HMIN
00220       DOUBLE PRECISION, INTENT(IN)    :: HIDI
00221       DOUBLE PRECISION, INTENT(IN)    :: KARMAN, ZERO, PI
00222       DOUBLE PRECISION, INTENT(IN)    :: KARIM_HOLLY_YANG
00223       LOGICAL,          INTENT(IN)    :: SUSP, MSK,SECCURRENT,HOULE
00224       TYPE(BIEF_OBJ),   INTENT(INOUT) :: T1,T2,T3,T4,T5,T6
00225       TYPE(BIEF_OBJ),   INTENT(INOUT) :: T7,T8,T9,T10,T11,T12
00226       DOUBLE PRECISION, INTENT(INOUT) :: AC
00227       TYPE(BIEF_OBJ),   INTENT(INOUT) :: HIDING
00228       TYPE(BIEF_OBJ),   INTENT(INOUT) :: QSC,QSS
00229 !
00230       INTEGER,          INTENT(IN)    :: SLOPEFF,DEVIA
00231       DOUBLE PRECISION, INTENT(IN)    :: PHISED,BETA,BETA2
00232       TYPE(BIEF_OBJ),   INTENT(IN)    :: ZF_C,S,UNSV2D
00233       TYPE(BIEF_OBJ),   INTENT(INOUT) :: CALFA,SALFA,COEFPN
00234 !
00235       DOUBLE PRECISION, INTENT(IN)    :: BIJK,AVA(NPOIN)
00236 !
00237       TYPE(BIEF_OBJ),    INTENT(IN)    :: U3D,V3D
00238       CHARACTER(LEN=24), INTENT(IN)    :: CODE
00239 !
00240 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00241 !
00242       DOUBLE PRECISION U3DNORM
00243 !
00244       INTEGER          :: I
00245 !
00246 !======================================================================!
00247 !                               PROGRAM                                !
00248 !======================================================================!
00249 !
00250       IF (DEBUG > 0) WRITE(LU,*) 'BEDLOAD_EFFPNT'
00251 !
00252 !     SLOPE EFFECT
00253 !
00254       IF(CODE(1:9).EQ.'TELEMAC3D') THEN
00255         DO I=1,NPOIN
00256           U3DNORM=SQRT(U3D%R(I)**2+V3D%R(I)**2)
00257           IF(U3DNORM.GE.1.D-12) THEN
00258             CALFA%R(I)=U3D%R(I)/U3DNORM
00259             SALFA%R(I)=V3D%R(I)/U3DNORM
00260           ELSE
00261             CALFA%R(I)=1.D0
00262             SALFA%R(I)=0.D0
00263           ENDIF
00264         ENDDO
00265       ELSE
00266         CALL OS('X=Y/Z   ',CALFA, U2D, UNORM, 0.D0, 2, 1.D0, 1.D-12)
00267         CALL OS('X=Y/Z   ',SALFA, V2D, UNORM, 0.D0, 2, 0.D0, 1.D-12)
00268       ENDIF
00269 !
00270       IF(SLOPEFF.EQ.0) CALL OS('X=C     ',X=COEFPN,C=1.D0)
00271 !
00272       IF(SLOPEFF.NE.0.OR.DEVIA.NE.0) THEN
00273         CALL BEDLOAD_EFFPNT
00274      &     (MASKEL,LIQBOR,S,ZF_C,U2D,V2D,UNORM,NPOIN,NPTFR,IELMT,
00275      &      KENT,BETA,PI,MSK,MESH,T1,T2,T3,T4,
00276      &      COEFPN,CALFA,SALFA,SLOPEFF,PHISED,DEVIA,BETA2,
00277      &      TOB,XMVS,XMVE,DM,GRAV,UNSV2D)
00278       ENDIF
00279 !
00280       IF (DEBUG > 0) WRITE(LU,*) 'END_BEDLOAD_EFFPNT'
00281 !
00282 !     MASKING/EXPOSURE COEFFICIENT
00283 !
00284       IF (DEBUG > 0) WRITE(LU,*) 'BEDLOAD_HIDING_FACTOR'
00285 !
00286 !     WITH HUNZIKER FORMULATION (6), THE HIDING FACTOR IS COMPUTED
00287 !     WITH THE SOLID DISCHARGE (SEE BEDLOAD_HUNZ_MEYER.F)
00288 !
00289       IF(ICF.NE.6) THEN
00290         CALL BEDLOAD_HIDING_FACTOR
00291      &     (ACLADM, HIDFAC, NPOIN, HIDI, DM, KARIM_HOLLY_YANG, HIDING)
00292       ENDIF
00293       IF (DEBUG > 0) WRITE(LU,*) 'END_BEDLOAD_HIDING_FACTOR'
00294 !
00295 !     QSC COMPUTED USING EMPIRICAL FORMULATION : T1 = DQSC/DH                           !
00296 !
00297       IF (DEBUG > 0) WRITE(LU,*) 'BEDLOAD_FORMULA'
00298 !
00299       CALL BEDLOAD_FORMULA
00300      &  (U2D,V2D, UNORM,HN, CF, MU,TOB, TOBW, UW, TW, THETAW, FW,
00301      &   ACLADM, UNLADM, KSP,KSR,AVA, NPOIN, ICF, HIDFAC, XMVS, XMVE,
00302      &   DM, GRAV, VCE, HMIN, XWC, D90, KARMAN, ZERO,
00303      &   PI, SUSP, AC, HIDING, T1, T2, T3, T4, T5, T6, T7, T8, T9,
00304      &   T10, T11, T12, QSC, QSS, IELMT,SECCURRENT,
00305      &   SLOPEFF, COEFPN, BIJK, HOULE)
00306       IF (DEBUG > 0) WRITE(LU,*) 'END_BEDLOAD_FORMULA'
00307 !
00308 !     TIDAL FLATS
00309 !
00310       IF(OPTBAN.EQ.2) THEN
00311         IF (DEBUG > 0) WRITE(LU,*) 'TIDAL_FLATS_TREATMENT'
00312         CALL OS('X=XY    ', X=QSC, Y=MASKPT)
00313         IF (DEBUG > 0) WRITE(LU,*) 'END_TIDAL_FLATS_TREATMENT'
00314       ENDIF
00315 !
00316 !-----------------------------------------------------------------------
00317 !
00318       RETURN
00319       END

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