bedload_formula.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\bedload_formula.f
00002 !
00080                      SUBROUTINE BEDLOAD_FORMULA
00081 !                    **************************
00082 !
00083      &(U2D,V2D,UCMOY,HN,CF,MU,TOB,TOBW,UW,TW,THETAW,FW,
00084      & ACLADM, UNLADM,KSP,KSR,AVA,NPOIN,ICF,HIDFAC,XMVS,XMVE,
00085      & DM,GRAV,VCE,HMIN,XWC,D90,KARMAN,ZERO,
00086      & PI,SUSP, AC, HIDING, T1, T2, T3, T4, T5, T6, T7, T8, T9, T10,
00087      & T11,TETAP, QSC, QSS,IELMT,SECCURRENT,SLOPEFF,
00088      & COEFPN,BIJK,HOULE)
00089 !
00090 !***********************************************************************
00091 ! SISYPHE   V6P2                                   21/07/2011
00092 !***********************************************************************
00093 !
00094 !
00095 !
00096 !
00097 !
00098 !
00099 !
00100 !
00101 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00102 !| AC             |<->| SHIELDS PARAMETER
00103 !| ACLADM         |-->| MEAN DIAMETER
00104 !| AVA            |-->| PERCENT AVAILABLE
00105 !| BIJK           |-->| EMPIRICAL COEFFICIENT
00106 !| CF             |-->| QUADRATIC FRICTION COEFFICIENT
00107 !| COEFPN         |-->| COEFFICIENT FOR SLOPING BED EFFECTS
00108 !| D90            |-->| D90
00109 !| DM             |-->| DIAMETER OF THE CLASS
00110 !| FW             |-->| WAVE FRICTION COEFFICIENT
00111 !| GRAV           |-->| GRAVITY
00112 !| HIDFAC         |-->| HIDING FACTOR FORMULA
00113 !| HIDING         |<->| HIDING FACTOR
00114 !| HMIN           |-->| MININMUM WATER DEPTH
00115 !| HN             |-->| WATER DEPTH
00116 !| HOULE          |-->| EFFECT OF WAVE
00117 !| ICF            |-->| CHOICE OF FORMULA
00118 !| IELMT          |-->| NUMBER OF ELEMENTS
00119 !| KARMAN         |-->| VON KARMAN COEFFICIENT
00120 !| KSP            |-->| SKIN BED ROUGHNESS (M)
00121 !| KSR            |-->| RIPPLE BED ROUGHNESS (M)
00122 !| MU             |-->| CORRECTION FOR SKIN FRICTION
00123 !| NPOIN          |-->| NUMBER OF POINTS
00124 !| PI             |-->| PI
00125 !| QSC            |<->| BED LOAD TRANSPORT RATE (m2/S)
00126 !| QSS            |<->| SUSPENDED LOAD TRANSPORT RATE (M2/S)
00127 !| SECCURRENT     |-->| EFFECT OF SECUNDARY CURRENTS
00128 !| SLOPEFF        |-->| FORMULA FOR SLOPING BED EFFECTS
00129 !| SUSP           |-->| SUSPENSION TREATMENT
00130 !| T1             |<->| WORKING ARRAYS
00131 !| T10            |<->| --
00132 !| T11            |<->| --
00133 !| T2             |<->| --
00134 !| T3             |<->| --
00135 !| T4             |<->| --
00136 !| T5             |<->| --
00137 !| T6             |<->| --
00138 !| T7             |<->| --
00139 !| T8             |<->| --
00140 !| T9             |<->| --
00141 !| TETAP          |<->| ADIMENSIONAL SKIN FRICTION
00142 !| THETAW         |-->| WAVE/CURRENT ANGLE
00143 !| TOB            |-->| TOTAL BED SHEAR STRESS (N/M2)
00144 !| TOBW           |-->| WAVE INDUCED BED SHEAR STRESS (N/M2)
00145 !| TW             |-->| WAVE PERIOD (S)
00146 !| U2D            |-->| LONGITUDINAL VELOCITY (m/S)
00147 !| UCMOY          |-->| CURRENT INTENSITY (M/S)
00148 !| UNLADM         |-->| DIAMETER OF LAYER 2 (M)
00149 !| UW             |-->| WAVE ORBITAL VELOCITY (M/S)
00150 !| V2D            |-->| TRANSVERSAL VELOCITY (M/S)
00151 !| VCE            |-->| FLUID KINEMATIC VISCOSITY (M2/S)
00152 !| XMVE           |-->| FLUID DENSITY (KG/M3)
00153 !| XMVS           |-->| SEDIMENT DENSITY (KG/M3)
00154 !| XWC            |-->| SETTLING VELOCITY (M/S)
00155 !| ZERO           |-->| ZERO
00156 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00157 !
00158       USE INTERFACE_SISYPHE,EX_BEDLOAD_FORMULA => BEDLOAD_FORMULA
00159       USE BIEF
00160       IMPLICIT NONE
00161       INTEGER LNG,LU
00162       COMMON/INFO/LNG,LU
00163 !
00164 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00165 !
00166       TYPE(BIEF_OBJ),   INTENT(IN)    :: U2D, V2D, UCMOY,HN, CF, TOB
00167       TYPE(BIEF_OBJ),   INTENT(IN)    :: MU,TOBW, UW, TW, THETAW, FW
00168       TYPE(BIEF_OBJ),   INTENT(IN)    :: ACLADM,UNLADM,KSR,KSP
00169       INTEGER,          INTENT(IN)    :: NPOIN, ICF, HIDFAC,IELMT
00170       DOUBLE PRECISION, INTENT(IN)    :: XMVS, XMVE, DM, GRAV, VCE
00171       DOUBLE PRECISION, INTENT(IN)    :: HMIN, XWC, D90
00172       DOUBLE PRECISION, INTENT(IN)    :: KARMAN, ZERO, PI
00173       LOGICAL,          INTENT(IN)    :: SUSP,SECCURRENT,HOULE
00174       DOUBLE PRECISION, INTENT(INOUT) :: AC
00175       TYPE(BIEF_OBJ),   INTENT(INOUT) :: HIDING
00176       TYPE(BIEF_OBJ),   INTENT(INOUT) :: T1, T2, T3, T4, T5, T6, T7
00177       TYPE(BIEF_OBJ),   INTENT(INOUT) :: T8, T9, T10,T11
00178       TYPE(BIEF_OBJ),   INTENT(INOUT) :: TETAP ! WORK ARRAY T12
00179       TYPE(BIEF_OBJ),   INTENT(INOUT) :: QSC, QSS
00180       TYPE(BIEF_OBJ),   INTENT(INOUT) ::  COEFPN
00181       INTEGER,          INTENT(IN)    :: SLOPEFF
00182 !
00183       DOUBLE PRECISION, INTENT (IN) :: BIJK,AVA(NPOIN)
00184 !
00185 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00186 !
00187       INTEGER                     :: I
00188       DOUBLE PRECISION            :: DENS,DSTAR
00189       DOUBLE PRECISION, PARAMETER :: ZERO_LOCAL = 1.D-6
00190       DOUBLE PRECISION            :: C1
00191 !
00192 !======================================================================!
00193 !======================================================================!
00194 !                               PROGRAM                                !
00195 !======================================================================!
00196 !======================================================================!
00197 !
00198       ! *************************** !
00199       ! I - ADIMENSIONAL PARAMETERS !
00200       ! *************************** !
00201       DENS  = (XMVS - XMVE )/ XMVE
00202       DSTAR = DM*(GRAV*DENS/VCE**2)**(1.D0/3.D0)
00203       ! ************************ !
00204       ! II -  SKIN FRICTION      !
00205       ! ************************ !
00206 !
00207       C1 = 1.D0/(DENS*XMVE*GRAV*DM)
00208       CALL OS('X=CYZ   ', X=TETAP, Y=TOB,Z=MU,  C=C1)
00209       CALL OS('X=+(Y,C)', X= TETAP,Y=TETAP, C=ZERO_LOCAL)
00210 !
00211       IF(SECCURRENT) CALL BEDLOAD_SECCURRENT(IELMT)
00212       ! ****************************************** !
00213       ! IV - COMPUTES 2 TRANSPORT TERMS            !
00214       !      QSS : SUSPENSION                      !
00215       !      QSC : BEDLOAD                         !
00216       ! ****************************************** !
00217       ! ===================================== !
00218       ! IV(1) - MEYER-PETER-MULLER FORMULATION!
00219       !         FOR BEDLOAD ONLY              !
00220       ! ===================================== !
00221       IF(ICF == 1) THEN
00222 !
00223         CALL BEDLOAD_MEYER(TETAP,HIDING,HIDFAC,DENS,GRAV,DM,AC,
00224      &                     T1,QSC,SLOPEFF,COEFPN)
00225         DO I=1,NPOIN
00226           QSC%R(I)=QSC%R(I)*AVA(I)
00227         ENDDO
00228 !
00229       ! =========================== !
00230       ! IV(2) - EINSTEIN FORMULATION!
00231       !         FOR BEDLOAD ONLY    !
00232       ! =========================== !
00233       ELSEIF(ICF == 2) THEN
00234         CALL BEDLOAD_EINST(TETAP,NPOIN,DENS,GRAV,DM,DSTAR,QSC)
00235         DO I=1,NPOIN
00236           QSC%R(I)=QSC%R(I)*AVA(I)*HIDING%R(I)
00237         ENDDO
00238 !
00239       ! =================================== !
00240       ! IV(30) - ENGELUND-HANSEN FORMULATION!
00241       !          FOR TOTAL TRANSPORT        !
00242       ! =================================== !
00243       ELSEIF(ICF == 30) THEN
00244 ! V6P0 MU IS USED INSTEAD OF CF
00245 ! BEWARE: DIFFERENCES
00246 !         CALL BEDLOAD_ENGEL(TETAP,DENS,GRAV,DM,QSC)
00247 ! BACK TO EARLIER VERSION OF BEDLOAD_ENGEL
00248         CALL BEDLOAD_ENGEL(TOB,CF,DENS,GRAV,DM,XMVE,T1,QSC)
00249 !       ARBITRARY DISTRIBUTION
00250         DO I=1,NPOIN
00251           QSC%R(I)=QSC%R(I)*AVA(I)*HIDING%R(I)
00252         ENDDO
00253 !
00254       ! ======================================== !
00255       ! IV(3) - ENGELUND-HANSEN FORMULATION      !
00256       !         MODIFIED: CHOLLET ET CUNGE       !
00257       !         FOR TOTAL TRANSPORT              !
00258       ! ======================================== !
00259       ELSEIF(ICF == 3) THEN
00260 !       KSP IS USED INSTEAD OF CFP
00261         CALL BEDLOAD_ENGEL_CC
00262      &       (TETAP,CF,NPOIN,GRAV,DM,DENS,T1,QSC)
00263 !       ARBITRARY DISTRIBUTION
00264         DO I=1,NPOIN
00265           QSC%R(I)=QSC%R(I)*AVA(I)*HIDING%R(I)
00266         ENDDO
00267 !
00268       ! ============================== !
00269       ! IV(4) - BIJKER FORMULATION     !
00270       !         FOR BEDLOAD + SUSPENSION !
00271       ! ============================== !
00272       ELSEIF (ICF == 4) THEN
00273         CALL BEDLOAD_BIJKER
00274      &   (TOBW,TOB,MU,KSP,KSR,HN,NPOIN,DM,DENS,XMVE,GRAV,
00275      &    XWC,KARMAN,ZERO,T4,T7,T8,T9,QSC,QSS,BIJK,HOULE)
00276         DO I=1,NPOIN
00277           QSC%R(I)=QSC%R(I)*AVA(I)*HIDING%R(I)
00278           QSS%R(I)=QSS%R(I)*AVA(I)*HIDING%R(I)
00279         ENDDO
00280 !
00281       ! ============================== !
00282       ! IV(5) - SOULSBY FORMULATION    !
00283       !         FOR BEDLOAD + SUSPENSION !
00284       ! ============================== !
00285       ELSEIF (ICF == 5) THEN
00286         CALL BEDLOAD_SOULSBY
00287      &       (UCMOY,HN,UW,NPOIN,DENS,GRAV,DM,DSTAR,HMIN,
00288      &        D90,QSC,QSS)
00289         DO I=1,NPOIN
00290           QSC%R(I)=QSC%R(I)*AVA(I)*HIDING%R(I)
00291           QSS%R(I)=QSS%R(I)*AVA(I)*HIDING%R(I)
00292         ENDDO
00293 !
00294       ! ================================================== !
00295       ! IV(6) - HUNZIKER / MEYER-PETER & MULLER FORMULATION!
00296       !         FOR BEDLOAD ONLY                           !
00297       ! ================================================== !
00298       ELSEIF (ICF == 6) THEN
00299         CALL BEDLOAD_HUNZ_MEYER
00300      &       (TOB, MU, ACLADM, UNLADM, NPOIN, DENS, XMVE, GRAV,
00301      &        DM, AC, T1, T2, T3, HIDING, QSC)
00302         DO I=1,NPOIN
00303           QSC%R(I)=QSC%R(I)*AVA(I)
00304         ENDDO
00305 !
00306       ! =========================== !
00307       ! IV(7) - VAN RIJN FORMULATION!
00308       !         FOR BEDLOAD ONLY    !
00309       ! =========================== !
00310       ELSEIF (ICF == 7) THEN
00311 !
00312         CALL BEDLOAD_VANRIJN
00313 !     &       (TOB,MU,NPOIN,DM,DENS,GRAV,DSTAR,AC,QSC)
00314      &       (TETAP,MU,NPOIN,DM,DENS,GRAV,DSTAR,AC,QSC)
00315         DO I=1,NPOIN
00316           QSC%R(I)=QSC%R(I)*AVA(I)*HIDING%R(I)
00317         ENDDO
00318 !
00319       ! ============================== !
00320       ! IV(8) - BAILARD FORMULATION    !
00321       !         FOR BEDLOAD + SUSPENSION !
00322       ! ============================== !
00323       ELSEIF (ICF == 8) THEN
00324 !
00325         CALL BEDLOAD_BAILARD
00326      &       (U2D,V2D,UCMOY,TOB,TOBW,THETAW,UW,FW,CF,NPOIN,
00327      &        PI,XMVE,GRAV,DENS,XWC,T1,T2,T3,T4,T5,T6,T7,
00328      &        T8,T9,T10,T11,QSC,QSS,HOULE)
00329         DO I=1,NPOIN
00330           QSC%R(I)=QSC%R(I)*AVA(I)*HIDING%R(I)
00331           QSS%R(I)=QSS%R(I)*AVA(I)*HIDING%R(I)
00332         ENDDO
00333 !
00334       ! ======================================= !
00335       ! IV(9) - DIBAJNIA AND WATANABE FORMULATION!
00336       !         FOR TOTAL TRANSPORT             !
00337       ! ======================================= !
00338       ELSEIF(ICF == 9) THEN
00339 !
00340         CALL BEDLOAD_DIBWAT
00341      &       (U2D,V2D,UCMOY, CF, TOB, TOBW, UW, TW, FW, THETAW,
00342      &        NPOIN, XMVE, DENS, GRAV, DM, XWC, PI, T1, T2, T3, T4,
00343      &        T5, T6, T7, T8, T9, T10, T11, QSC,HOULE)
00344 !       ARBITRARY DISTRIBUTION
00345         DO I=1,NPOIN
00346           QSC%R(I)=QSC%R(I)*AVA(I)*HIDING%R(I)
00347         ENDDO
00348 !
00349       ! ============================================ !
00350       ! IV(0) - USER-DEFINED FORMULATION             !
00351       ! ============================================ !
00352       ELSEIF (ICF == 0) THEN
00353         CALL QSFORM
00354      &       (U2D, V2D, TOB, HN, XMVE, TETAP, MU, NPOIN, DM,
00355      &       DENS, GRAV, DSTAR, AC, QSC, QSS)
00356         DO I=1,NPOIN
00357            QSC%R(I)=QSC%R(I)*AVA(I)*HIDING%R(I)
00358            QSS%R(I)=QSS%R(I)*AVA(I)*HIDING%R(I)
00359         ENDDO
00360       ! ================= !
00361       ! IV(ELSE) - ERROR  !
00362       ! ================= !
00363       ELSE
00364         IF(LNG == 1) WRITE(LU,200) ICF
00365         IF(LNG == 2) WRITE(LU,201) ICF
00366 200     FORMAT(1X,'TRANSP : FORMULE DE TRANSPORT INCONNUE :',1I6)
00367 201     FORMAT(1X,'TRANSP : TRANSPORT FORMULA UNKNOWN:',1I6)
00368         CALL PLANTE(1)
00369         STOP
00370       ENDIF
00371 !
00372 !-----------------------------------------------------------------------
00373 !
00374 !     WHEN SUSPENSION IS NOT ASKED SPECIFICALLY, SOME BEDLOAD TRANSPORT
00375 !     FORMULAS GIVE A VALUE
00376 !
00377       IF(.NOT.SUSP) THEN
00378         IF(ICF.EQ.4.OR.ICF.EQ.5.OR.ICF.EQ.8.OR.ICF.EQ.0) THEN
00379           DO I = 1,NPOIN
00380             QSC%R(I) = QSC%R(I) + QSS%R(I)
00381           ENDDO
00382         ELSE
00383 !         NOTE JMH: IS THIS REALLY USEFUL ???
00384           DO I = 1,NPOIN
00385             QSS%R(I) = 0.D0
00386           ENDDO
00387         ENDIF
00388       ENDIF
00389 !
00390 !=======================================================================
00391 !=======================================================================
00392 !
00393       RETURN
00394       END

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