qbrek1.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\qbrek1.f
00002 !
00064                      SUBROUTINE QBREK1
00065 !                    *****************
00066 !
00067      &( TSTOT , TSDER , F     , FCAR  , VARIAN, DEPTH , ALFABJ, GAMBJ1,
00068      &  GAMBJ2, IQBBJ , IHMBJ , NF    , NPLAN , NPOIN2, BETA  )
00069 !
00070 !***********************************************************************
00071 ! TOMAWAC   V6P1                                   23/06/2011
00072 !***********************************************************************
00073 !
00074 !
00075 !
00076 !reference  BATTJES AND JANSSEN (1978) :
00077 !+                     "ENERGY LOSS AND SET-UP DUE TO BREAKING
00078 !+                      OF RANDOM WAVES". ICCE'78.
00079 !
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00086 !| ALFABJ         |-->| COEFFICIENT ALPHA OF BJ MODEL
00087 !| BETA           |<--| BREAKING WAVES COEFFICIENT
00088 !| DEPTH          |-->| WATER DEPTH
00089 !| F              |-->| DIRECTIONAL SPECTRUM
00090 !| FCAR           |-->| CHARACTERISTIC FREQUENCY
00091 !| GAMBJ1         |-->| GAMMA1 CONSTANT OF WAVE BREAKING BJ MODEL
00092 !| GAMBJ2         |-->| GAMMA2 CONSTANT OF WAVE BREAKING BJ MODEL
00093 !| IHMBJ          |-->| DEPTH-INDUCED BREAKING CRITERIUM GIVING THE
00094 !|                |   | BREAKING WAVE HEIGHT
00095 !| IQBBJ          |-->| SELECTED QB COMPUTATION METHOD FOR BJ MODEL
00096 !| NF             |-->| NUMBER OF FREQUENCIES
00097 !| NPLAN          |-->| NUMBER OF DIRECTIONS
00098 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00099 !| TSDER          |<->| DERIVED PART OF THE SOURCE TERM CONTRIBUTION
00100 !| TSTOT          |<->| TOTAL PART OF THE SOURCE TERM CONTRIBUTION
00101 !| VARIAN         |-->| SPECTRUM VARIANCE
00102 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00103 !
00104       IMPLICIT NONE
00105 !
00106 !.....VARIABLES IN ARGUMENT
00107 !     """"""""""""""""""""
00108       INTEGER          NF    , NPLAN  , NPOIN2, IQBBJ , IHMBJ
00109       DOUBLE PRECISION ALFABJ, GAMBJ1 , GAMBJ2
00110       DOUBLE PRECISION DEPTH(NPOIN2), BETA(NPOIN2)
00111       DOUBLE PRECISION TSTOT(NPOIN2,NPLAN,NF), TSDER(NPOIN2,NPLAN,NF)
00112       DOUBLE PRECISION     F(NPOIN2,NPLAN,NF), VARIAN(NPOIN2)
00113       DOUBLE PRECISION     FCAR(NPOIN2)
00114 !
00115 !.....LOCAL VARIABLES
00116 !     """""""""""""""""
00117       INTEGER          JP   , IFF , IP
00118       DOUBLE PRECISION COEF , HM  , XK8 , XKCAR , B , QB , SEUIL
00119 !
00120 !.....EXTERNAL FUNCTIONS
00121 !     """"""""""""""""""
00122       DOUBLE PRECISION   QBBJ78
00123       EXTERNAL           QBBJ78
00124 !
00125 !
00126       SEUIL=1.D-6
00127       COEF =-.25D0*ALFABJ
00128 !
00129 !.....COMPUTES THE LINEAR COEFFICIENT BETA: QBREK1 = BETA * F
00130 !     """""""""""""""""""""""""""""""""""""""""""""""""""""""
00131       DO IP = 1,NPOIN2
00132         IF (VARIAN(IP).GT.SEUIL) THEN
00133 !
00134 !..........COMPUTES THE MAXIMUM WAVE HEIGHT
00135 !          """""""""""""""""""""""""""""""""""""""
00136           IF(IHMBJ.EQ.1) THEN
00137             HM  = GAMBJ2*DEPTH(IP)
00138           ELSEIF(IHMBJ.EQ.2) THEN
00139             CALL WNSCOU(XKCAR,FCAR(IP),DEPTH(IP))
00140             XK8 = GAMBJ1/XKCAR
00141             HM  = XK8*DTANH(GAMBJ2*DEPTH(IP)/XK8)
00142           ENDIF
00143 !
00144 !..........COMPUTES THE FRACTION OF BREAKING WAVES
00145 !          """"""""""""""""""""""""""""""""""""""""""""
00146           B   = SQRT(8.D0*VARIAN(IP))/HM
00147           QB  = QBBJ78(B,IQBBJ)
00148 !
00149           BETA(IP) = COEF*QB*FCAR(IP)*HM**2/VARIAN(IP)
00150         ELSE
00151           BETA(IP) = 0.D0
00152         ENDIF
00153       ENDDO ! IP
00154 !
00155 !.....TAKES THE SOURCE TERM INTO ACCOUNT
00156 !     """"""""""""""""""""""""""""""""
00157       DO IFF = 1,NF
00158         DO JP = 1,NPLAN
00159           DO IP = 1,NPOIN2
00160             TSTOT(IP,JP,IFF) = TSTOT(IP,JP,IFF)+BETA(IP)*F(IP,JP,IFF)
00161           ENDDO ! IP
00162         ENDDO ! JP
00163       ENDDO ! IFF
00164 !
00165       RETURN
00166       END

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