bedload_bijker.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\bedload_bijker.f
00002 !
00074                      SUBROUTINE BEDLOAD_BIJKER
00075 !                    *************************
00076 !
00077      &  (TOBW,TOB,MU,KSP,KSR,HN,NPOIN,DM,DENS,XMVE,GRAV,XWC,
00078      &   KARMAN,ZERO,T4,T7,T8,T9,QSC,QSS,BIJK,HOULE)
00079 !
00080 !***********************************************************************
00081 ! SISYPHE   V6P1                                   21/07/2011
00082 !***********************************************************************
00083 !
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !
00090 !
00091 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00092 !| BIJK           |-->| COEFFICIENT OF THE BIJKER FORMULA
00093 !| DENS           |-->| RELATIVE DENSITY
00094 !| DM             |-->| SEDIMENT GRAIN DIAMETER
00095 !| GRAV           |-->| ACCELERATION OF GRAVITY
00096 !| HN             |-->| WATER DEPTH
00097 !| HOULE          |-->| LOGICAL, FOR WAVE EFFECTS
00098 !| KARMAN         |-->| VON KARMAN CONSTANT
00099 !| KSP            |-->| BED SKIN ROUGHNESS
00100 !| KSR            |-->| RIPPLE BED ROUGHNESS
00101 !| MU             |<->| CORRECTION FACTOR FOR BED ROUGHNESS
00102 !| NPOIN          |-->| NUMBER OF POINTS
00103 !| QSC            |<->| BED LOAD TRANSPORT
00104 !| QSS            |<->| SUSPENDED LOAD TRANSPORT
00105 !| T4             |<->| WORK BIEF_OBJ STRUCTURE
00106 !| T7             |<->| WORK BIEF_OBJ STRUCTURE
00107 !| T8             |<->| WORK BIEF_OBJ STRUCTURE
00108 !| T9             |<->| WORK BIEF_OBJ STRUCTURE
00109 !| TOB            |<->| BED SHEAR STRESS (TOTAL FRICTION)
00110 !| TOBW           |-->| WAVE INDUCED SHEAR STRESS
00111 !| XMVE           |-->| FLUID DENSITY
00112 !| XWC            |-->| SETTLING VELOCITY
00113 !| ZERO           |-->| ZERO
00114 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00115 !
00116       USE INTERFACE_SISYPHE,EX_BEDLOAD_BIJKER => BEDLOAD_BIJKER
00117       USE BIEF
00118       IMPLICIT NONE
00119       INTEGER LNG,LU
00120       COMMON/INFO/LNG,LU
00121 !
00122 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00123 !
00124       TYPE(BIEF_OBJ),   INTENT(IN)    :: TOBW, TOB, KSR,KSP, HN,MU
00125       INTEGER,          INTENT(IN)    :: NPOIN
00126       LOGICAL,          INTENT(IN)    :: HOULE
00127       DOUBLE PRECISION, INTENT(IN)    :: DM, DENS, XMVE, GRAV, XWC
00128       DOUBLE PRECISION, INTENT(IN)    :: KARMAN, ZERO
00129       TYPE(BIEF_OBJ),   INTENT(INOUT) :: T4
00130       TYPE(BIEF_OBJ),   INTENT(INOUT) :: T7, T8, T9
00131       TYPE(BIEF_OBJ),   INTENT(INOUT)   :: QSC, QSS
00132 !
00133 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00134 !
00135       INTEGER                      :: I
00136       DOUBLE PRECISION             :: C1, C2, UCF
00137       DOUBLE PRECISION, INTENT(IN) :: BIJK
00138 !
00139 !======================================================================!
00140 !======================================================================!
00141 !                               PROGRAM                                !
00142 !======================================================================!
00143 !======================================================================!
00144 !
00145       ! ***************************************************** !
00146       ! I - STRESS UNDER THE COMBINED ACTION OF WAVES AND CURRENTS !
00147       ! ***************************************************** !
00148       IF(HOULE) THEN
00149         CALL OS('X=CY    ', X=T4, Y=TOBW, C= 0.5D0)
00150         CALL OS('X=X+Y   ', X=T4, Y=TOB)
00151       ELSE
00152         CALL OS('X=Y     ', X=T4, Y=TOB)
00153       ENDIF
00154       ! ******************************************************* !
00155       ! II - CORRECTION TO TAKE BED FORMS INTO ACCOUNT          !
00156       ! ******************************************************* !
00157 !      CALL OS('X=Y/Z   ', X=MU, Y=CFP, Z=CF)
00158 !      CALL OS('X=Y**C  ', X=MU, Y=MU , C=0.75D0)
00159       ! ***************************** !
00160       ! III - BEDLOAD TRANSPORT       !
00161       ! ***************************** !
00162       C1 = BIJK*DM
00163       C2 = DENS*DM*XMVE*GRAV
00164       DO I = 1, NPOIN
00165         IF (T4%R(I)*MU%R(I)> ZERO) THEN
00166           QSC%R(I) = C1*SQRT(TOB%R(I)/XMVE )
00167      &             * EXP(-0.27D0*(C2/(T4%R(I)*MU%R(I))))
00168         ELSE
00169           QSC%R(I) = 0.D0
00170         ENDIF
00171       ENDDO
00172       ! *********************************************************** !
00173       ! IV- ROUSE NUMBER AND LOWER BOUND OF EINSTEIN INTEGRAL       !
00174       ! *********************************************************** !
00175       DO I = 1, NPOIN
00176         IF (T4%R(I) > 0.D0) THEN
00177           UCF     = SQRT( T4%R(I) / XMVE)
00178           T7%R(I) = XWC / ( KARMAN * UCF )
00179 !         AUX     = 1.D0 + KARMAN*SQRT(2.D0/MAX(CF%R(I),ZERO))
00180 !         T8%R(I) = 30.D0*EXP(-AUX)
00181           T8%R(I) = MAX(KSR%R(I),KSP%R(I))/MAX(HN%R(I),ZERO)
00182         ELSE
00183           T7%R(I)= 100001.D0
00184           T8%R(I)= 100001.D0
00185         ENDIF
00186       ENDDO
00187       ! ************************************ !
00188       ! V - EINSTEIN INTEGRAL                !
00189       ! ************************************ !
00190       CALL INTEG(T7%R, T8%R, T9%R, NPOIN)
00191       ! ************************************** !
00192       ! VI - TRANSPORT BY SUSPENSION           !
00193       ! ************************************** !
00194       CALL OS('X=YZ    ', X=QSS, Y=T9, Z=QSC)
00195 !======================================================================!
00196 !======================================================================!
00197       RETURN
00198       END SUBROUTINE BEDLOAD_BIJKER

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