qwindl.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\qwindl.f
00002 !
00058                         SUBROUTINE QWINDL
00059 !                       *****************
00060 !
00061      &( TSTOT , FREQ  , USOLD , USNEW , TWOLD , TWNEW , TETA  ,
00062      &  NF    , NPLAN , NPOIN2, CIMPLI, USN   , USO   , FPMO  , FPMN )
00063 !
00064 !**********************************************************************
00065 ! TOMAWAC   V6P3                                   27/06/2011
00066 !**********************************************************************
00067 !
00068 !
00069 !reference   CAVALERI L. & P. MALANOTTE-RIZZOLI, 1981 :
00070 !+                 "WIND WAVE PREDICTION IN SHALLOW WATER : THEORY AND
00071 !+                  APPLICATIONS". J. GEOPHYS. RES., 86(C5),10,961-975
00072 !
00073 !reference   TOLMAN  (1992) : EFFECT OF NUMERICS ON THE PHYSICS IN
00074 !+                A THIRD-GENERATION WIND-WAVE MODEL, JPO, VOL 22,
00075 !+                PP 1095-1111.
00076 !
00077 !
00078 !
00079 !
00080 !
00081 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00082 !| CIMPLI         |-->| IMPLICITATION COEFFICIENT FOR SOURCE TERMS
00083 !| FPMN           |<->| WORK TABLE
00084 !| FPMO           |<->| WORK TABLE
00085 !| FREQ           |-->| DISCRETIZED FREQUENCIES
00086 !| NF             |-->| NUMBER OF FREQUENCIES
00087 !| NPLAN          |-->| NUMBER OF DIRECTIONS
00088 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00089 !| TETA           |-->| DISCRETIZED DIRECTIONS
00090 !| TSDER          |<->| DERIVED PART OF THE SOURCE TERM CONTRIBUTION
00091 !| TSTOT          |<->| TOTAL PART OF THE SOURCE TERM CONTRIBUTION
00092 !| TWNEW          |-->| WIND DIRECTION AT TIME N+1
00093 !| TWOLD          |-->| WIND DIRECTION AT TIME N
00094 !| USNEW          |-->| FRICTION VELOCITY AT TIME N+1
00095 !| USOLD          |-->| FRICTION VELOCITY AT TIME N
00096 !| XK             |-->| DISCRETIZED WAVE NUMBER
00097 !| USN            |<--| WORK TABLE
00098 !| USO            |<--| WORK TABLE
00099 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00100 !
00101 !  APPELS :    - PROGRAMME(S) APPELANT  : SEMIMP
00102 !  ********    - PROGRAMME(S) APPELE(S) :    -
00103 !**********************************************************************
00104 !
00105       USE DECLARATIONS_TOMAWAC, ONLY : DEUPI,GRAVIT
00106 !
00107       IMPLICIT NONE
00108 !
00109 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00110 !
00111       INTEGER, INTENT(IN)             :: NF,NPLAN,NPOIN2
00112       DOUBLE PRECISION, INTENT(IN)    :: CIMPLI
00113       DOUBLE PRECISION, INTENT(IN)    :: FREQ(NF),TETA(NPLAN)
00114       DOUBLE PRECISION, INTENT(INOUT) :: FPMO(NPOIN2),FPMN(NPOIN2)
00115       DOUBLE PRECISION, INTENT(IN)    :: TWOLD(NPOIN2),TWNEW(NPOIN2)
00116       DOUBLE PRECISION, INTENT(IN)    :: USNEW(NPOIN2),USOLD(NPOIN2)
00117       DOUBLE PRECISION, INTENT(INOUT) :: USO(NPOIN2,NPLAN)
00118       DOUBLE PRECISION, INTENT(INOUT) :: USN(NPOIN2,NPLAN)
00119       DOUBLE PRECISION, INTENT(INOUT) :: TSTOT(NPOIN2,NPLAN,NF)
00120 !
00121 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00122 !
00123       INTEGER JP,JF,IP
00124       DOUBLE PRECISION C1,C2,DIREC,ALPHAN,ALPHAO,SURFREQ4
00125 !
00126       INTRINSIC MAX,COS,EXP
00127 !
00128 !-----------------------------------------------------------------------
00129 !
00130       C1 = 1.5D-3/GRAVIT**2
00131       C2 = GRAVIT/(DEUPI*28.D0)
00132 !
00133 !     ARRAYS DEPENDING ONLY ON POINTS
00134 !
00135       DO IP=1,NPOIN2
00136         FPMO(IP)=(C2/MAX(USOLD(IP),1.D-20))**4
00137         FPMN(IP)=(C2/MAX(USNEW(IP),1.D-20))**4
00138       ENDDO
00139 !
00140 !     ARRAYS DEPENDING ONLY ON POINTS AND DIRECTIONS
00141 !     COULD BE OPTIMISED MORE BY DECOMPOSING THE COS...
00142 !
00143       DO JP=1,NPLAN
00144         DIREC=TETA(JP)
00145         DO IP=1,NPOIN2
00146           USO(IP,JP)=C1*(MAX(USOLD(IP)*COS(DIREC-TWOLD(IP)),0.D0))**4
00147           USN(IP,JP)=C1*(MAX(USNEW(IP)*COS(DIREC-TWNEW(IP)),0.D0))**4
00148         ENDDO
00149       ENDDO
00150 !
00151 !     LOOP ON THE DISCRETISED FREQUENCIES
00152 !
00153       DO JF=1,NF
00154         SURFREQ4=1.D0/FREQ(JF)**4
00155         DO JP=1,NPLAN
00156           DO IP=1,NPOIN2
00157             ALPHAO=USO(IP,JP)*EXP( -FPMO(IP)*SURFREQ4 )
00158             ALPHAN=USN(IP,JP)*EXP( -FPMN(IP)*SURFREQ4 )
00159 !           TAKES THE SOURCE TERM INTO ACCOUNT
00160             TSTOT(IP,JP,JF) = TSTOT(IP,JP,JF)
00161      &                      + (ALPHAO + CIMPLI*(ALPHAN-ALPHAO))
00162           ENDDO
00163         ENDDO
00164       ENDDO
00165 !
00166 !-----------------------------------------------------------------------
00167 !
00168       RETURN
00169       END

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