qmout2.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\qmout2.f
00002 !
00056                         SUBROUTINE QMOUT2
00057 !                       *****************
00058 !
00059      &( TSTOT , TSDER , F     , XK    , ENRJ  , FREQ  , FMOY  , XKMOY ,
00060      &  USOLD , USNEW , DEPTH , PROINF, CMOUT3, CMOUT4, CMOUT5, CMOUT6,
00061      &  NF    , NPLAN , NPOIN2, CIMPLI, TAUX1 ,F_INT  , BETOTO, BETOTN)
00062 !
00063 !**********************************************************************
00064 ! TOMAWAC   V6P3                                  23/06/2011
00065 !**********************************************************************
00066 !
00067 !
00068 !reference    VAN DER WESTHUYSEN (2007): ADVANCES IN THE SPECTRAL
00069 !+              MODELLING OF WIND WAVES IN THE NEARSHORE, PHD THESID,
00070 !+              DELFT UNIVERSITY OF TECHNOLOGY
00071 !
00072 !
00073 !
00074 !
00075 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00076 !| BETA           |<->| WORK TABLE
00077 !| BETOTN         |<->| WORK TABLE
00078 !| BETOTO         |<->| WORK TABLE
00079 !| CIMPLI         |-->| IMPLICITATION COEFFICIENT FOR SOURCE TERM INTEG.
00080 !| CMOUT3         |-->| WESTHUYSEN WHITE CAPPING DISSIPATION COEFFICIENT
00081 !| CMOUT4         |-->| WESTHUYSEN SATURATION THRES. FOR THE DISSIPATION
00082 !| CMOUT5         |-->| WESTHUYSEN WHITE CAPPING DISSIPATION COEFFICIENT
00083 !| CMOUT6         |-->| WESTHUYSEN WHITE CAPPING WEIGHTING COEFFICIENT
00084 !| DEPTH          |-->| WATER DEPTH
00085 !| ENRJ           |-->| SPECTRUM VARIANCE
00086 !| F              |-->| DIRECTIONAL SPECTRUM
00087 !| FMOY           |-->| MEAN SPECTRAL FRQUENCY FMOY
00088 !| FREQ           |-->| DISCRETIZED FREQUENCIES
00089 !| XK             |-->| DISCRETIZED WAVE NUMBER
00090 !| XKMOY          |-->| AVERAGE WAVE NUMBER
00091 !| NF             |-->| NUMBER OF FREQUENCIES
00092 !| NPLAN          |-->| NUMBER OF DIRECTIONS
00093 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00094 !| PROINF         |-->| LOGICAL INDICATING INFINITE DEPTH ASSUMPTION
00095 !| TAUX1          |<->| WORK TABLE
00096 !| TSDER          |<->| DERIVED PART OF THE SOURCE TERM CONTRIBUTION
00097 !| TSTOT          |-->| TOTAL PART OF THE SOURCE TERM CONTRIBUTION
00098 !| USNEW          |-->| FRICTION VELOCITY AT TIME N+1
00099 !| USOLD          |<->| FRICTION VELOCITY AT TIME N
00100 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
00101 !  APPELS :    - PROGRAMME(S) APPELANT  : SEMIMP
00102 !  ********    - PROGRAMME(S) APPELE(S) :    -
00103 !
00104 !  REMARKS:
00105 !  ********
00106 !
00107 !  - THE CONSTANT CMOUT3 (Cdis,break) UTILISED IN WESTHUYSEN (2007)
00108 !                                    IS EQUAL TO 5.0*10^(-5)
00109 !  - THE CONSTANT CMOUT4 (Br) UTILISED IN WESTHUYSEN (2007)
00110 !                                    IS EQUAL TO 1.75*10^(-3)
00111 !  - THE CONSTANT CMOUT5 (Cdis,non-break) UTILISED IN WESTHUYSEN
00112 !                                    (2007) IS EQUAL TO 3.29
00113 !  - THE CONSTANT CMOUT6 (Delta) UTILISED IN WESTHUYSEN (2007)
00114 !                                    IS EQUAL TO 0
00115 !
00116       USE DECLARATIONS_TOMAWAC, ONLY : DEUPI,GRAVIT
00117 !
00118       IMPLICIT NONE
00119 !
00120       INTEGER LNG,LU
00121       COMMON/INFO/ LNG,LU
00122 !
00123 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00124 !
00125       INTEGER, INTENT(IN)             :: NF,NPLAN,NPOIN2
00126       DOUBLE PRECISION, INTENT(IN)    :: CMOUT3,CMOUT4
00127       DOUBLE PRECISION, INTENT(IN)    :: CMOUT5,CMOUT6,CIMPLI
00128       DOUBLE PRECISION, INTENT(IN)    :: USNEW(NPOIN2),USOLD(NPOIN2)
00129       DOUBLE PRECISION, INTENT(IN)    :: FREQ(NF),DEPTH(NPOIN2)
00130       DOUBLE PRECISION, INTENT(IN)    :: FMOY(NPOIN2),XK(NPOIN2,NF)
00131       DOUBLE PRECISION, INTENT(IN)    :: ENRJ(NPOIN2),XKMOY(NPOIN2)
00132       DOUBLE PRECISION, INTENT(INOUT) :: F_INT(NPOIN2),TAUX1(NPOIN2)
00133       DOUBLE PRECISION, INTENT(INOUT) :: BETOTO(NPOIN2),BETOTN(NPOIN2)
00134       DOUBLE PRECISION, INTENT(INOUT) :: TSTOT(NPOIN2,NPLAN,NF)
00135       DOUBLE PRECISION, INTENT(INOUT) :: TSDER(NPOIN2,NPLAN,NF)
00136       DOUBLE PRECISION, INTENT(INOUT) :: F(NPOIN2,NPLAN,NF)
00137       LOGICAL, INTENT(IN)             :: PROINF
00138 !
00139 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00140 !
00141       INTEGER JP,IFF,IP
00142       DOUBLE PRECISION PO,AUX,C1,C2,C3,P0O,P0N,W,SURDEUPIFREQ,B,DTETAR
00143       DOUBLE PRECISION BETAO,BETAN,CPHAS,CG1,SQBSCMOUT4,BETA,DEUKD,KD
00144       DOUBLE PRECISION SURCMOUT4
00145 !
00146       INTRINSIC SQRT,TANH,DBLE,SINH
00147 !
00148 !-----------------------------------------------------------------------
00149 !
00150 !     DTETAR = DEUPI/DBLE(NPLAN)
00151 !     F_INT WAS DIVIDED BY DEUPI AFTER IN FORMULAS, DIVISION REMOVED
00152       DTETAR = 1.D0/DBLE(NPLAN)
00153       C1     = - CMOUT5*DEUPI**9/GRAVIT**4
00154       C2     = - CMOUT5*DEUPI
00155       W = 25.D0
00156       SURCMOUT4 = 1.D0/CMOUT4
00157 !
00158       IF(PROINF) THEN
00159 !       DEEP WATER CASE, ARRAY DEPENDING ONLY ON THE SPATIAL MESH NODE
00160         DO IP = 1,NPOIN2
00161           TAUX1(IP) = C1 * ENRJ(IP)**2 * FMOY(IP)**9
00162         ENDDO
00163       ELSE
00164 !       FINITE DEPTH CASE
00165         DO IP=1,NPOIN2
00166           TAUX1(IP) = C2 * ENRJ(IP)**2 * FMOY(IP) * XKMOY(IP)**4
00167         ENDDO
00168       ENDIF
00169 !
00170 !     LOOP ON THE DISCRETISED FREQUENCIES
00171 !
00172       DO IFF=1,NF
00173 !
00174         SURDEUPIFREQ=1.D0/(DEUPI*FREQ(IFF))
00175 !
00176         DO IP=1,NPOIN2
00177           F_INT(IP)=F(IP,1,IFF)
00178         ENDDO
00179         DO JP=2,NPLAN
00180           DO IP=1,NPOIN2
00181             F_INT(IP)=F_INT(IP)+F(IP,JP,IFF)
00182           ENDDO
00183         ENDDO
00184         DO IP=1,NPOIN2
00185           F_INT(IP)=F_INT(IP)*DTETAR
00186         ENDDO
00187 !
00188         IF(PROINF) THEN
00189 !
00190           DO IP = 1,NPOIN2
00191 !
00192             CPHAS = XK(IP,IFF)*SURDEUPIFREQ
00193             P0O=3.D0+TANH(W*(USOLD(IP)*CPHAS-0.1D0))
00194             P0N=3.D0+TANH(W*(USNEW(IP)*CPHAS-0.1D0))
00195             CG1 = 0.5D0*GRAVIT*SURDEUPIFREQ
00196             B   = CG1*F_INT(IP)*XK(IP,IFF)**3
00197             SQBSCMOUT4=SQRT(B*SURCMOUT4)
00198 !           COMPUTES THE BREAK/NON-BREAK TRANSITION
00199             PO = 0.5D0*(1.D0+TANH(10.D0*(SQBSCMOUT4-1.D0)))
00200 !           COMPUTES THE BREAK BETA
00201             C3=-CMOUT3*SQRT(GRAVIT*XK(IP,IFF))
00202             BETAO=C3*SQBSCMOUT4**P0O
00203             BETAN=C3*SQBSCMOUT4**P0N
00204 !           COMPUTES THE NON-BREAK BETA
00205             AUX = (FREQ(IFF)/FMOY(IP))**2
00206             BETA=TAUX1(IP)*AUX*(1.D0-CMOUT6+CMOUT6*AUX)
00207 !           COMPUTES THE TOTAL BETA
00208             BETOTO(IP)=BETA+PO*(BETAO-BETA)
00209             BETOTN(IP)=BETA+PO*(BETAN-BETA)
00210 !
00211           ENDDO
00212 !
00213         ELSE
00214 !
00215           DO IP = 1,NPOIN2
00216 !
00217             CPHAS = XK(IP,IFF)*SURDEUPIFREQ
00218             KD=MIN(XK(IP,IFF)*DEPTH(IP),350.D0)
00219             DEUKD=KD+KD
00220             CG1=( 0.5D0+XK(IP,IFF)*DEPTH(IP)/SINH(DEUKD) )/CPHAS
00221             B = CG1*F_INT(IP)*XK(IP,IFF)**3
00222             SQBSCMOUT4=SQRT(B*SURCMOUT4)
00223 !           COMPUTES THE BREAK BETA
00224             C3=-CMOUT3*SQRT(GRAVIT*XK(IP,IFF))
00225             AUX=TANH(KD)
00226             P0O=3.D0+TANH(W*(USOLD(IP)*CPHAS-0.1D0))
00227             P0N=3.D0+TANH(W*(USNEW(IP)*CPHAS-0.1D0))
00228             BETAO=C3*SQBSCMOUT4**P0O*AUX**((2.D0-P0O)*0.25D0)
00229             BETAN=C3*SQBSCMOUT4**P0N*AUX**((2.D0-P0N)*0.25D0)
00230 !           COMPUTES THE NON-BREAK BETA
00231             AUX = XK(IP,IFF) / XKMOY(IP)
00232 !           COMPUTES THE TOTAL BETA
00233             BETA=TAUX1(IP)*AUX*(1.D0-CMOUT6+CMOUT6*AUX)
00234 !           COMPUTES THE BREAK/NON-BREAK TRANSITION
00235             PO = 0.5D0*(1.D0+TANH(10.D0*(SQBSCMOUT4-1.D0)))
00236             BETOTO(IP)=BETA+PO*(BETAO-BETA)
00237             BETOTN(IP)=BETA+PO*(BETAN-BETA)
00238 !
00239           ENDDO
00240 !
00241         ENDIF
00242 !
00243 !       TAKES THE SOURCE TERM INTO ACCOUNT
00244 !
00245         DO JP = 1,NPLAN
00246           DO IP = 1,NPOIN2
00247             TSTOT(IP,JP,IFF)=TSTOT(IP,JP,IFF)
00248      &      +(BETOTO(IP)+CIMPLI*(BETOTN(IP)-BETOTO(IP)))*F(IP,JP,IFF)
00249             TSDER(IP,JP,IFF)=TSDER(IP,JP,IFF) + BETOTN(IP)
00250           ENDDO
00251         ENDDO
00252 !
00253       ENDDO
00254 !
00255 !-----------------------------------------------------------------------
00256 !
00257       RETURN
00258       END

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