qbrek3.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\qbrek3.f
00002 !
00068                      SUBROUTINE QBREK3
00069 !                    *****************
00070 !
00071      &( TSTOT , TSDER , F     , FCAR  , VARIAN, DEPTH , ALFARO, GAMARO,
00072      &  GAM2RO, IEXPRO, IDISRO, NF    , NPLAN , NPOIN2, BETA  )
00073 !
00074 !***********************************************************************
00075 ! TOMAWAC   V6P1                                   23/06/2011
00076 !***********************************************************************
00077 !
00078 !
00079 !
00080 !reference  ROELVINK (1993) :
00081 !+                     "DISSIPATION IN RANDOM WAVE GROUPS INCIDENT ON A
00082 !+                      BEACH". COASTAL ENG. VOL 19, PP 127-150.
00083 !
00084 !
00085 !
00086 !
00087 !
00088 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00089 !| ALFARO         |-->| COEFFICIENT ALPHA OF RO WAVE BREAKING MODEL
00090 !| BETA           |<--| BREAKING WAVES COEFFICIENT
00091 !| DEPTH          |-->| WATER DEPTH
00092 !| F              |-->| DIRECTIONAL SPECTRUM
00093 !| FCAR           |-->| CHARACTERISTIC FREQUENCY
00094 !| GAM2RO         |-->| GAMMA2 CONSTANT OF WAVE BREAKING RO MODEL
00095 !| GAMARO         |-->| GAMMA CONSTANT OF WAVE BREAKING RO MODEL
00096 !| IDISRO         |-->| WAVE HEIGHT DISTRIBUTION SLECTION FOR RO MODEL
00097 !| IEXPRO         |-->| EXPONENT OF WAVE HEIGHT DISTR. FOR RO MODEL
00098 !| NF             |-->| NUMBER OF FREQUENCIES
00099 !| NPLAN          |-->| NUMBER OF DIRECTIONS
00100 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00101 !| TSDER          |<->| DERIVED PART OF THE SOURCE TERM CONTRIBUTION
00102 !| TSTOT          |<->| TOTAL PART OF THE SOURCE TERM CONTRIBUTION
00103 !| VARIAN         |-->| SPECTRUM VARIANCE
00104 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00105 !
00106       USE DECLARATIONS_TOMAWAC, ONLY : PISUR2,DEUPI
00107       IMPLICIT NONE
00108 !
00109 !.....VARIABLES IN ARGUMENT
00110 !     """"""""""""""""""""
00111       INTEGER          NF    , NPLAN , NPOIN2, IEXPRO, IDISRO
00112       DOUBLE PRECISION ALFARO, GAMARO, GAM2RO
00113       DOUBLE PRECISION DEPTH(NPOIN2), BETA(NPOIN2), FCAR(NPOIN2)
00114       DOUBLE PRECISION TSTOT(NPOIN2,NPLAN,NF), TSDER(NPOIN2,NPLAN,NF)
00115       DOUBLE PRECISION     F(NPOIN2,NPLAN,NF), VARIAN(NPOIN2)
00116 !
00117 !.....LOCAL VARIABLES
00118 !     """""""""""""""""
00119       INTEGER  JP    , IFF   , IP
00120       DOUBLE PRECISION COEF1 , COEF2 , SEUIL
00121       DOUBLE PRECISION A     , XM    , SIGMA , BX    , FN
00122 !
00123 !.....EXTERNAL FUNCTIONS
00124 !     """"""""""""""""""
00125       DOUBLE PRECISION   GAMMLN, QGAUSS
00126       EXTERNAL           GAMMLN, QGAUSS
00127 !
00128 !
00129       SEUIL  = 1.D-6
00130       COEF1  = -2.D0*ALFARO
00131       COEF2  = 8.D0/(GAMARO**2)
00132 !
00133       IF(IDISRO.EQ.1) THEN
00134 !
00135 !.......COMPUTES THE LINEAR COEFFICIENT BETA (WEIBULL FIT)
00136 !       """""""""""""""""""""""""""""""""""""""""""""""""""""
00137         DO IP = 1,NPOIN2
00138           IF (VARIAN(IP).GT.SEUIL) THEN
00139             BX    = COEF2*VARIAN(IP)/(DEPTH(IP)*DEPTH(IP))
00140             SIGMA = SQRT(8.D0*VARIAN(IP))/DEPTH(IP)
00141             XM    = 1.D0 + 0.7D0*(TAN(PISUR2*SIGMA/GAM2RO))**2
00142             A     = EXP(XM*(GAMMLN(1.D0+1.D0/XM,DEUPI)))
00143             IF(XM.GT.98.D0) THEN
00144               FN = 1.D0
00145             ELSE
00146               FN = QGAUSS(BX,IEXPRO,A,XM)
00147             ENDIF
00148             BETA(IP) = COEF1*FCAR(IP)*FN
00149           ELSE
00150             BETA(IP) = 0.D0
00151           ENDIF
00152         ENDDO ! IP
00153 !
00154       ELSE
00155 !
00156 !.......COMPUTES THE LINEAR COEFFICIENT BETA (RAYLEIGH FIT)
00157 !       """"""""""""""""""""""""""""""""""""""""""""""""""""""
00158         DO IP = 1,NPOIN2
00159           BX = COEF2*VARIAN(IP)/(DEPTH(IP)**2)
00160           XM = 1.D0
00161           A  = 1.D0
00162           FN = QGAUSS(BX,IEXPRO,A,XM)
00163           BETA(IP) = COEF1*FCAR(IP)*FN
00164         ENDDO ! IP
00165       ENDIF
00166 !
00167 !     TAKES THE SOURCE TERM INTO ACCOUNT
00168 !
00169       DO IFF = 1,NF
00170         DO JP = 1,NPLAN
00171           DO IP = 1,NPOIN2
00172             TSTOT(IP,JP,IFF) = TSTOT(IP,JP,IFF)+BETA(IP)*F(IP,JP,IFF)
00173           ENDDO ! IP
00174         ENDDO ! JP
00175       ENDDO ! IFF
00176 !
00177       RETURN
00178       END

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