bedload_calcdw.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\bedload_calcdw.f
00002 !
00058                      SUBROUTINE BEDLOAD_CALCDW ! (_IMP_)
00059 !                    ***********************************
00060 !
00061      &  (UCW, UW, TW, NPOIN, PI, UW1, UW2, TW1, TW2)
00062 !
00063 !***********************************************************************
00064 ! SISYPHE   V6P1                                   21/07/2011
00065 !***********************************************************************
00066 !
00067 !
00068 !
00069 !
00070 !
00071 !
00072 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00073 !| NPOIN          |-->| NUMBER OF POINTS
00074 !| PI             |-->| PI
00075 !| TW             |-->| WAVE PERIOD
00076 !| TW1            |<->| MID WAVE PERIOD, CURRENT IN THE WAVE DIRECTION
00077 !| TW2            |<->| MID WAVE PERIOD, CURRENT IN THE OPPOSITE DIRECTION
00078 !| UCW            |-->| CURRENT PROJECTED IN THE WAVE DIRECTION
00079 !| UW             |-->| ORBITAL WAVE VELOCITY
00080 !| UW1            |<->| WORK ARRAY
00081 !| UW2            |<->| WORK ARRAY
00082 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00083 !
00084       USE INTERFACE_SISYPHE,EX_BEDLOAD_CALCDW => BEDLOAD_CALCDW
00085       USE BIEF
00086       IMPLICIT NONE
00087       INTEGER LNG,LU
00088       COMMON/INFO/LNG,LU
00089 !
00090 !     2/ GLOBAL VARIABLES
00091 !
00092       TYPE(BIEF_OBJ),   INTENT(IN)    :: UCW, UW, TW
00093       INTEGER,          INTENT(IN)    :: NPOIN
00094       DOUBLE PRECISION, INTENT(IN)    :: PI
00095       TYPE(BIEF_OBJ),   INTENT(INOUT) :: UW1, UW2, TW1, TW2
00096 !
00097 !     3/ LOCAL VARIABLES
00098 !
00099       INTEGER                     :: I
00100       DOUBLE PRECISION            :: UCMOY, RAP
00101       DOUBLE PRECISION            :: ACOSMRAP, ACOSPRAP, SQRTRAP
00102       DOUBLE PRECISION, PARAMETER :: ZERO = 1.D-06
00103 !
00104 !======================================================================!
00105 !======================================================================!
00106 !                               PROGRAM                                !
00107 !======================================================================!
00108 !======================================================================!
00109 !
00110       DO I = 1,NPOIN
00111         UCMOY = ABS(UCW%R(I))
00112         ! ****************** !
00113         !    I - WAVES ONLY  ! (_IMP_)
00114         ! ****************** !
00115         IF (UCMOY <= ZERO) THEN
00116           UW1%R(I) = UW%R(I)
00117           UW2%R(I) = UW%R(I)
00118           TW1%R(I) = TW%R(I) / 2.D0
00119           TW2%R(I) = TW%R(I) / 2.D0
00120         ELSE
00121           RAP = UW%R(I) / UCMOY
00122           ! ******************** !
00123           ! II - WAVES ARE PREDOMINANT ! (_IMP_)
00124           ! ******************** !
00125           IF (RAP > 1.D0) THEN
00126             ACOSMRAP = ACOS(-1.D0/RAP)
00127             ACOSPRAP = ACOS( 1.D0/RAP)
00128             SQRTRAP  = SQRT(1.D0-1.D0/RAP**2)
00129             TW1%R(I) = TW%R(I)*ACOSMRAP / PI
00130             TW2%R(I) = TW%R(I)*ACOSPRAP / PI
00131             UW1%R(I) = 2.D0*UCMOY**2 + UW%R(I)**2
00132      &               + 3.D0*UCMOY*UW%R(I)*SQRTRAP/ACOSMRAP
00133             UW1%R(I) = SQRT(UW1%R(I))
00134             UW2%R(I) = 2.D0*UCMOY**2 + UW%R(I)**2
00135      &               - 3.D0*UCMOY*UW%R(I)*SQRTRAP/ACOSPRAP
00136             UW2%R(I) = SQRT(UW2%R(I))
00137           ! ********************** !
00138           ! III - CURRENTS ARE PREDOMINANT ! (_IMP_)
00139           ! ********************** !
00140           ELSE
00141             UW1%R(I) = UCW%R(I)*SQRT(2.D0 + RAP**2)
00142             UW2%R(I) = ZERO
00143             TW1%R(I) = TW%R(I)
00144             TW2%R(I) = ZERO
00145           ENDIF
00146         ENDIF
00147       ENDDO
00148 !
00149 !======================================================================!
00150 !======================================================================!
00151 !
00152       RETURN
00153       END SUBROUTINE BEDLOAD_CALCDW

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