qtria2.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE qtria2
!                   *****************
!
     &( f     , xk    ,  nf    , ndire , npoin2, tstot )
!
!***********************************************************************
! TOMAWAC   V6P1                                   27/06/2011
!***********************************************************************
!
!brief    COMPUTES THE CONTRIBUTION OF THE NON-LINEAR
!+                INTERACTIONS SOURCE TERM (FREQUENCY TRIADS).
!+<BR>           (INSPIRED FROM THE BOUSSINESQ EQUATIONS)
!
!history  EDF/DER/LNH
!+        11/06/98
!+        V5P0
!+
!
!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
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| F              |-->| DIRECTIONAL SPECTRUM
!| NF             |-->| NUMBER OF FREQUENCIES
!| NDIRE          |-->| NUMBER OF DIRECTIONS
!| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
!| TSTOT          |<->| TOTAL PART OF THE SOURCE TERM CONTRIBUTION
!| XK             |-->| DISCRETIZED WAVE NUMBER
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_tomawac, ONLY : deupi,gravit, freq  , dfreq ,
     &                          depth , teta  , sintet, costet ,  raisf,
     &                          qindi,bdispb,bdsspb, kspb, nbd
!
      USE declarations_special
      USE interface_tomawac, ex_qtria2 => qtria2
      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(INOUT) :: TSTOT(npoin2,ndire,nf)
!.....VARIABLES FROM MODULE TOMAWAC
!     """""""""""""""""""""""""""""
! QINDI           CONFIGURATION INDEX
! NBD             NUMBER OF TRIAD CONFIGURATIONS
! BDISPB          LOWER DIRECTIONAL BOUND. OF SPB TRIAD MODEL
! BDSSPB          UPPER DIRECTIONAL BOUND. OF SPB TRIAD MODEL
! KSPB            COEFFICIENT K OF SPB TRIAD INTERACTION MODEL
! RAISF           FREQUENTIAL RATIO
!
!.....LOCAL VARIABLES
!     """""""""""""""""
      INTEGER  IFF, JFF, IPL, JPL , IPO
      INTEGER  IFR, IPP, IPM
      DOUBLE PRECISION  DTETA, FR1 , AP2  , XK1   , XK3 , DEP
      DOUBLE PRECISION  TETA2, XK2 , K2NL , NRJ2
      DOUBLE PRECISION  FREQ0, FREQ1, FREQ2, FREQ3, LRAISF, RAISM1
      DOUBLE PRECISION  VR1 , VR2 , VR3 , TK1 , TK2 , TK3
      DOUBLE PRECISION  BK1 , BK3 , DEP2
      DOUBLE PRECISION  FILT , BISP, DEUPI2
      DOUBLE PRECISION  VAR1 , XC1 , XC2 , XC3
      DOUBLE PRECISION  BMS , BMSP
!
      INTEGER IP1, IP3
!
!
!.....EXTERNAL FUNCTIONS
!     """""""""""""""""""
!      DOUBLE PRECISION KERBOU
!      EXTERNAL         KERBOU
!
!     """"""""""""""""""""""""""""""""""""""""""""""""""""""""""
!
      dteta = teta(2)-teta(1)
      bms  = 1.d0/15.d0
      bmsp = bms + 1.d0/3.d0
      deupi2 = deupi**2
      freq0  = freq(1)
      lraisf = log(raisf)
      raism1 = raisf-1.d0
!
      DO iff = 1,nf
        freq3 = freq(iff)
        DO jff = 1,iff-1
          freq1 = freq(jff)
          freq2 = freq3-freq1
          IF(freq2.LE.freq0) THEN
            cycle
          ENDIF
          fr1 = 1.d0 + log(freq2/freq0)/lraisf
          ifr = int(fr1)
          fr1 = fr1 - dble(ifr)
          fr1 = (raisf**fr1-1.d0)/raism1
          DO ip3 = 1,nbd
            ipl = qindi(ip3)
            DO ip1 = 1,nbd
              jpl = qindi(ip1)
              DO ipo = 1,npoin2
!               COMPUTES K2
!               --------------------
                dep = depth(ipo)
                xk1 = xk(ipo,jff)
                xk3 = xk(ipo,iff)
                k2nl   = sqrt((xk3*costet(ipl)-xk1*costet(jpl))**2
     &                   +(xk3*sintet(ipl)-xk1*sintet(jpl))**2)
                xk2    = (1.d0-fr1)*xk(ipo,ifr) + fr1*xk(ipo,ifr+1)
!
                teta2=atan2(xk3*sintet(ipl)-xk1*sintet(jpl)
     &                      ,xk3*costet(ipl)-xk1*costet(jpl))
                IF(teta2.LT.0.d0) teta2 = deupi + teta2
!
                IF(teta2.LT.bdispb .OR. teta2.GT.bdsspb) THEN
!               INTERACTIONS BETWEEN COMPONENTS WHICH DIRECTIONS ARE NOT
!               WITHIN THE ANGULAR SECTOR DEFINED BY THE USER (VARIABLES
!               BDISPB AND BDSSPB) ARE NOT TAKEN INTO ACCOUNT
                  cycle
                ENDIF
!
                ap2    = (teta2-teta(1))/dteta
                ipm    = nint(ap2)
                ipp    = ipm + 1
                IF(ipm.EQ.0) ipm=ndire
                IF(ipp.EQ.ndire+1) ipp = 1
!
!.........COMPUTES COUPLING COEFFICIENTS
!               """"""""""""""""""""""""""""""""""""
!               R(P-M,M)
                vr1 = kerbou(xk1,xk2,freq1,freq2,dep,teta(jpl),teta2)
!               R(M-P,P)
                vr2 = kerbou(-xk1,xk3,-freq1,freq3,dep,teta(jpl),
     &                       teta(ipl))
!               R(-M,P)
                vr3 = kerbou(-xk2,xk3,-freq2,freq3,dep,teta2,teta(ipl))
!
                filt = kspb/((xk2-k2nl)**2+kspb*kspb)
                filt = -0.5d0*filt/xk2
!
                dep2 = dep**2
                var1 = 2.d0*bms*dep2
                xc1  = var1*xk3*xk3
                xc2  = var1*xk2*xk2
                xc3  = var1*xk1*xk1
                var1 = bmsp*deupi2*dep2
                tk1 = (gravit*dep*(1.d0+xc1)-var1*freq3*freq3)
                tk2 = (gravit*dep*(1.d0+xc2)-var1*freq2*freq2)
                tk3 = (gravit*dep*(1.d0+xc3)-var1*freq1*freq1)
!
                bk1 = deupi*freq3*(1.d0+3.d0*xc1)
                bk3 = deupi*freq1*(1.d0+3.d0*xc3)
!
!
!.........TAKES THE SOURCE TERM INTO ACCOUNT
!         """"""""""""""""""""""""""""""""
!
                nrj2  = (1.d0-ap2)*((1.d0-fr1)*f(ipo,ipm,ifr)+fr1*
     &                  f(ipo,ipm,ifr+1))
     &                  + ap2*((1.d0-fr1)*f(ipo,ipp,ifr)
     &                  +fr1*f(ipo,ipp,ifr+1))
!
                bisp  = filt*
     &                  ((vr2/tk2)*f(ipo,ipl,iff)*f(ipo,jpl,jff)
     &                  +(vr3/tk3)*f(ipo,ipl,iff)*nrj2
     &                  -(vr1/tk1)*f(ipo,jpl,jff)*nrj2)
!
!                D12   = FILT*((VR2/TK2)*F(IPO,JPL,JFF)
!    &                        +(VR3/TK3)*NRJ2)
!                D21   = FILT*((VR2/TK2)*F(IPO,IPL,IFF)
!    &                        -(VR1/TK1)*NRJ2)
                vr1   = dfreq(jff)*dteta*vr1/bk1
                vr3   = 2.d0*dfreq(iff)*dteta*vr3/bk3
!
                tstot(ipo,ipl,iff) = tstot(ipo,ipl,iff) + vr1*bisp
                tstot(ipo,jpl,jff) = tstot(ipo,jpl,jff) - vr3*bisp
!
              ENDDO ! IPO
            ENDDO ! IP1
          ENDDO ! IP3
        ENDDO ! JFF
      ENDDO ! IFF
!
      RETURN
      END