bedload_interact.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\bedload_interact.f
00002 !
00063                      SUBROUTINE BEDLOAD_INTERACT
00064 !                    ***************************
00065 !
00066      &(UCMOY,TOBW,TOB,ALPHAW,FW,CF,UW,NPOIN,XMVE,FCW)
00067 !
00068 !***********************************************************************
00069 ! SISYPHE   V6P1                                   21/07/2011
00070 !***********************************************************************
00071 !
00072 !
00073 !
00074 !
00075 !
00076 !
00077 !
00078 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00079 !| ALPHAW         |-->| ANGLE OF WAVES WITH OX
00080 !| CF             |-->| QUADRATIC FRICTION COEFFICIENT
00081 !| FCW            |<->| WAVE-CURRENT FRICTION FACTOR
00082 !| FW             |-->| WAVE FRICTION FACTOR
00083 !| NPOIN          |-->| NUMBER OF POINTS
00084 !| TOB            |<->| BED SHEAR STRESS (TOTAL FRICTION)
00085 !| TOBW           |-->| WAVE INDUCED SHEAR STRESS
00086 !| UCMOY          |-->| MEAN CURRENT
00087 !| UW             |-->| ORBITAL WAVE VELOCITY
00088 !| XMVE           |-->| FLUID DENSITY
00089 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00090 !
00091       USE INTERFACE_SISYPHE,EX_BEDLOAD_INTERACT => BEDLOAD_INTERACT
00092       USE BIEF
00093       IMPLICIT NONE
00094       INTEGER LNG,LU
00095       COMMON/INFO/LNG,LU
00096       !
00097       ! 2/ GLOBAL VARIABLES
00098       ! -------------------
00099       !
00100       TYPE(BIEF_OBJ),   INTENT(IN)  :: UCMOY, TOBW, TOB, ALPHAW
00101       TYPE(BIEF_OBJ),   INTENT(IN)  :: FW, CF, UW
00102       INTEGER,          INTENT(IN)  :: NPOIN
00103       DOUBLE PRECISION, INTENT(IN)  :: XMVE
00104       TYPE(BIEF_OBJ),   INTENT(INOUT) :: FCW
00105       !
00106       ! 3/ LOCAL VARIABLES
00107       ! ------------------
00108       !
00109       INTEGER                     :: I
00110       DOUBLE PRECISION            :: TX, LOGF
00111       DOUBLE PRECISION            :: CSAL,CSAL1, CSAL3
00112       DOUBLE PRECISION            :: AX, MX, NX, BX, PX, QX
00113       DOUBLE PRECISION            :: UCW2, TAUCW,ZERO
00114 !
00115       INTRINSIC MAX
00116 !
00117 !======================================================================!
00118 !======================================================================!
00119 !                               PROGRAM                                !
00120 !======================================================================!
00121 !======================================================================!
00122 !
00123       ZERO = 1.D-6
00124 !
00125       DO I = 1, NPOIN
00126 !
00127         TX = TOB%R(I) / MAX((TOB%R(I) + TOBW%R(I)),ZERO)
00128 !
00129         LOGF  = LOG10(2.D0*MAX(FW%R(I),ZERO)/MAX(CF%R(I),ZERO))
00130         CSAL  = ABS(COS(ALPHAW%R(I)))
00131         CSAL1 = CSAL**0.82D0
00132         CSAL3 = CSAL**2.70D0
00133 !
00134         AX = -0.07D0 + 1.87D0*CSAL1 + (-0.34D0 - 0.12D0*CSAL1)*LOGF
00135         MX =  0.72D0 - 0.33D0*CSAL1 + ( 0.08D0 + 0.34D0*CSAL1)*LOGF
00136         NX =  0.78D0 - 0.23D0*CSAL1 + ( 0.12D0 - 0.12D0*CSAL1)*LOGF
00137 !
00138         BX =  0.27D0 + 0.51D0*CSAL3 + (-0.10D0 - 0.24D0*CSAL3)*LOGF
00139         PX = -0.75D0 + 0.13D0*CSAL3 + ( 0.12D0 + 0.02D0*CSAL3)*LOGF
00140         QX =  0.89D0 + 0.40D0*CSAL3 + ( 0.50D0 - 0.28D0*CSAL3)*LOGF
00141 !
00142         IF(TX.LE.ZERO) THEN
00143           TAUCW = TOBW%R(I)
00144         ELSEIF(TX.LT.1.D0) THEN
00145           TAUCW = (1.D0 + BX * TX**PX * (1.D0 - TX)**QX)*TOB%R(I)*TX
00146      &          + (1.D0 + AX * TX**MX * (1.D0 - TX)**NX)*TOBW%R(I)
00147         ELSE
00148           TAUCW = TOB%R(I)
00149         ENDIF
00150 !
00151         UCW2 = (UCMOY%R(I)**2 + 0.5D0 * UW%R(I)**2) * XMVE
00152         FCW%R(I) = TAUCW / MAX(UCW2,1.D-10)
00153 !
00154       ENDDO
00155 !
00156 !======================================================================!
00157 !======================================================================!
00158 !
00159       RETURN
00160       END

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