qbrek1.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE qbrek1
!                   *****************
!
     & ( tstot , f     , fcar  , varian, nf    , ndire , npoin2)
!
!***********************************************************************
! TOMAWAC   V6P1                                   23/06/2011
!***********************************************************************
!
!brief    COMPUTES THE CONTRIBUTION OF THE DEPTH-INDUCED
!+                BREAKING SOURCE TERM BASED ON BATTJES AND JANSSEN (1978).
!
!note     THIS SOURCE TERM IS LINEAR IN F(FREQ,TETA), AND THE LINEAR
!+          COEFFICIENT DOES NOT VARY WITH TIME.
!
!reference  BATTJES AND JANSSEN (1978) :
!+                     "ENERGY LOSS AND SET-UP DUE TO BREAKING
!+                      OF RANDOM WAVES". ICCE'78.
!
!history  F. BECQ; M. BENOIT (EDF/DER/LNH)
!+        14/02/96
!+        V1P1
!+
!
!history  OPTIMER
!+        14/06/2001
!+        V5P2
!+
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!history  G.MATTAROLO (EDF - LNHE)
!+        23/06/2011
!+        V6P1
!+   Translation of French names of the variables in argument
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| ALFABJ         |-->| COEFFICIENT ALPHA OF BJ MODEL
!| F              |-->| DIRECTIONAL SPECTRUM
!| FCAR           |-->| CHARACTERISTIC FREQUENCY
!| GAMBJ1         |-->| GAMMA1 CONSTANT OF WAVE BREAKING BJ MODEL
!| GAMBJ2         |-->| GAMMA2 CONSTANT OF WAVE BREAKING BJ MODEL
!| IHMBJ          |-->| DEPTH-INDUCED BREAKING CRITERIUM GIVING THE
!|                |   | BREAKING WAVE HEIGHT
!| IQBBJ          |-->| SELECTED QB COMPUTATION METHOD FOR BJ MODEL
!| NF             |-->| NUMBER OF FREQUENCIES
!| NDIRE          |-->| NUMBER OF DIRECTIONS
!| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
!| TSTOT          |<->| TOTAL PART OF THE SOURCE TERM CONTRIBUTION
!| VARIAN         |-->| SPECTRUM VARIANCE
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_tomawac, ONLY : alfabj, gambj1, gambj2, iqbbj,
     &                 ihmbj, depth, betabr

      USE interface_tomawac, ex_qbrek1 => qbrek1
      IMPLICIT NONE
!
!.....VARIABLES IN ARGUMENT
!     """"""""""""""""""""
      INTEGER, INTENT(IN)            :: NF, NDIRE, NPOIN2
      DOUBLE PRECISION, INTENT(IN)   :: F(npoin2,ndire,nf)
      DOUBLE PRECISION, INTENT(IN)   :: VARIAN(npoin2),FCAR(npoin2)
      DOUBLE PRECISION, INTENT(INOUT):: TSTOT(npoin2,ndire,nf)
!
!.....LOCAL VARIABLES
!     """""""""""""""""
      INTEGER          JP   , IFF , IP
      DOUBLE PRECISION COEF , HM  , XK8 , XKCAR , B , QB , SEUIL
!
!.....EXTERNAL FUNCTIONS
!     """"""""""""""""""
!      DOUBLE PRECISION   QBBJ78
!      EXTERNAL           QBBJ78
!
!
      seuil=1.d-6
      coef =-.25d0*alfabj
!
!.....COMPUTES THE LINEAR COEFFICIENT BETABR: QBREK1 = BETABR * F
!     """""""""""""""""""""""""""""""""""""""""""""""""""""""
      DO ip = 1,npoin2
        IF (varian(ip).GT.seuil) THEN
!
!..........COMPUTES THE MAXIMUM WAVE HEIGHT
!          """""""""""""""""""""""""""""""""""""""
          IF(ihmbj.EQ.1) THEN
            hm  = gambj2*depth(ip)
          ELSEIF(ihmbj.EQ.2) THEN
            CALL wnscou(xkcar,fcar(ip),depth(ip))
            xk8 = gambj1/xkcar
            hm  = xk8*tanh(gambj2*depth(ip)/xk8)
          ENDIF
!
!..........COMPUTES THE FRACTION OF BREAKING WAVES
!          """"""""""""""""""""""""""""""""""""""""""""
          b   = sqrt(8.d0*varian(ip))/hm
          qb  = qbbj78(b,iqbbj)
!
          betabr(ip) = coef*qb*fcar(ip)*hm**2/varian(ip)
        ELSE
          betabr(ip) = 0.d0
        ENDIF
!
!.....TAKES THE SOURCE TERM INTO ACCOUNT
!     """"""""""""""""""""""""""""""""
        DO iff = 1,nf
          DO jp = 1,ndire
            tstot(ip,jp,iff) = tstot(ip,jp,iff)+betabr(ip)*f(ip,jp,iff)
          ENDDO ! JP
        ENDDO ! IFF
      ENDdo!IP
!
      RETURN
      END