qtria1.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE qtria1
!                   *****************
!
     &( f     , xk    , nf    , ndire , npoin2, tstot , ftot  , fmoy  )
!
!***********************************************************************
! TOMAWAC   V6P1                                   27/06/2011
!***********************************************************************
!
!brief    COMPUTES THE CONTRIBUTION OF THE NON-LINEAR
!+                INTERACTIONS SOURCE TERM (FREQUENCY TRIADS).
!
!history  EDF/DER/LNH
!+        26/12/96
!+        V1P1
!+
!
!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)
!+        27/06/2011
!+        V6P1
!+   Translation of French names of the variables in argument
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| ALFLTA         |-->| COEFFICIENT ALPHA OF LTA TRIAD INTERACTION MODEL
!| DEPTH          |-->| WATER DEPTH
!| F              |-->| DIRECTIONAL SPECTRUM
!| FMOY           |-->| MEAN FREQUENCIES F-10
!| FREQ           |-->| DISCRETIZED FREQUENCIES
!| FTOT           |-->| SPECTRUM VARIANCE
!| GRAVIT         |-->| GRAVITY ACCELERATION
!| NF             |-->| NUMBER OF FREQUENCIES
!| NDIRE          |-->| NUMBER OF DIRECTIONS
!| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
!| RFMLTA         |-->| COEFFICIENT OF LTA TRIAD INTERACTION MODEL
!| TSTOT          |<->| TOTAL PART OF THE SOURCE TERM CONTRIBUTION
!| XK             |-->| DISCRETIZED WAVE NUMBER
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_tomawac, ONLY : gravit,deupi, alflta, rfmlta
     &                , raisf, freq, depth
!
      USE interface_tomawac, ex_qtria1 => qtria1
      IMPLICIT NONE
!
!.....VARIABLES IN ARGUMENT
!     """"""""""""""""""""
      INTEGER, INTENT(IN)    ::  NF, NDIRE, NPOIN2
      DOUBLE PRECISION, INTENT(IN)    :: F(npoin2,ndire,nf)
      DOUBLE PRECISION, INTENT(IN)    :: XK(npoin2,nf)
      DOUBLE PRECISION, INTENT(IN)    :: FTOT(npoin2) , FMOY(npoin2)
      DOUBLE PRECISION, INTENT(INOUT) :: TSTOT(npoin2,ndire,nf)
!
!.....VARIABLES FROM MODULE TOMAWAC
!     """""""""""""""""""""""""""""
!| ALFLTA         |-->| COEFFICIENT ALPHA OF LTA TRIAD INTERACTION MODEL
!| RFMLTA         |-->| COEFFICIENT OF LTA TRIAD INTERACTION MODEL
!| RAISF          |-->| FREQUENTIAL RATIO
!
!
!.....LOCAL VARIABLES
!     """""""""""""""""
      INTEGER           IIND  , IFMA  , IFF   , IPL   , IPO
      DOUBLE PRECISION  CPH   , CGR   , BIF   , RPS2  , RP    ,
     &                  fps2  , cphs2 , xkps2 , urs   , rind  , fmax  ,
     &                  f2p   , cph2p , xk2p  , cgr2p , e2p   , eps2  ,
     &                  omp   , om2p  , coef  , d     , deukd ,
     &                  splus , smoin ,fp    , xkp
!
!.....FUNCTION / FORMULATION
!     """"""""""""""""
!
      coef = gravit*sqrt(2.d0)
!
      DO ipo=1,npoin2
!
        d=depth(ipo)
!
!.......COMPUTES THE URSELL NUMBER AT THE CONSIDERED POINT IN SPACE
!       """""""""""""""""""""""""""""""""""""""""""""""""""""
        urs = coef*sqrt(ftot(ipo))/(deupi*d*fmoy(ipo))**2
!
!.......COMPUTES THE CONTRIBUTION OF TRIADS ONLY IF URSELL > 0.1
!       """""""""""""""""""""""""""""""""""""""""
        IF (urs.GT.0.1d0) THEN
!
!.........COMPUTES THE SINE OF THE BIPHASE
!         """""""""""""""""""""""""""""
          IF (urs.GT.10.d0) THEN
            bif=1.d0
          ELSE
            bif=sin(abs(deupi/4.d0*(-1.d0+tanh(0.2d0/urs))))
          ENDIF
!
!.........COMPUTES THE MAXIMUM FREQUENTIAL INDEX
!         """"""""""""""""""""""""""""""""""""""
          fmax = rfmlta*max(fmoy(ipo),freq(1))
          rind = 1.d0 + log(fmax/freq(1))/log(raisf)
          ifma = min(int(rind),nf)
!
          DO iff=1,ifma
            fp  = freq(iff)
            omp = deupi*fp
            xkp = xk(ipo,iff)
            cph = omp/xkp
!
!
!...........COMPUTES THE CONTIBUTION S+
!           """""""""""""""""""""""""""
            fps2 = fp/2.d0
            rind = 1.d0 + log(fps2/freq(1))/log(raisf)
            iind = int(rind)
            rind = rind-dble(iind)
!
            IF (iind.GT.0) THEN
              deukd=2.d0*xkp*d
              IF(deukd.LE.7.d2) THEN
                cgr = cph*(0.5d0+xkp*d/sinh(2.d0*xkp*d))
              ELSE
                cgr = 0.5d0*cph
              ENDIF
              CALL wnscou(xkps2,fps2,d)
              cphs2 = deupi*fps2/xkps2
              rps2 = cph*cgr*(
     &               xkps2**2*(gravit*d+2.d0*cphs2**2)/(xkp*d)/
     &   (gravit*d+(2.d0/15.d0)*gravit*d**3*xkp**2-0.4d0*(omp*d)**2)
     &               )**2
!              RPS2 = CPH*CGR*RPP(XKPS2,CPHS2,XKP,OMP,D)**2

!
              DO ipl=1,ndire
                eps2=(1.d0-rind)*f(ipo,ipl,iind)+rind*f(ipo,ipl,iind+1)
                splus = alflta*rps2*bif*(eps2-2.d0*f(ipo,ipl,iff))*eps2
                IF(splus.LT.0.d0) splus = 0.d0
                tstot(ipo,ipl,iff) = tstot(ipo,ipl,iff) + splus
              ENDDO
            ENDIF
!
!
!...........COMPUTES THE CONTIBUTION S-
!           """""""""""""""""""""""""""
            f2p = 2.d0*fp
            rind = 1.d0 + log(f2p/freq(1))/log(raisf)
            iind = int(rind)
            rind = rind-dble(iind)
            IF (iind.LT.ifma) THEN
              om2p  = deupi*f2p
              CALL wnscou(xk2p,f2p,d)
              cph2p = om2p/xk2p
              deukd=2.d0*xk2p*d
              IF(deukd.LE.700d2) THEN
                cgr2p = cph2p*(0.5d0+xk2p*d/sinh(2.d0*xk2p*d))
              ELSE
                cgr2p = cph2p*0.5d0
              ENDIF
              rp    = cph2p*cgr2p*(
     &                xkp**2*(gravit*d+2.d0*cph**2)/(xk2p*d)/
     &   (gravit*d+(2.d0/15.d0)*gravit*d**3*xk2p**2-0.4d0*(om2p*d)**2)
     &                )**2
!              RP    = CPH2P*CGR2P*RPP(XKP,CPH,XK2P,OM2P,D)**2

!
              DO ipl=1,ndire
                e2p = (1.d0-rind)*f(ipo,ipl,iind)+rind*f(ipo,ipl,iind+1)
                smoin = 2.d0*alflta*rp*bif*f(ipo,ipl,iff)
     &                *(f(ipo,ipl,iff)-2.d0*e2p)
                IF(smoin.LT.0.d0) smoin = 0.d0
                tstot(ipo,ipl,iff) = tstot(ipo,ipl,iff) - smoin
              ENDDO
            ENDIF
!
          ENDDO
        ENDIF
      ENDDO
!
      RETURN
      END