qmout1.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE qmout1
!                   *****************
!
     &( tstot , tsder , f     , xk    , enrj  , fmoy  , xkmoy ,
     &  nf  , ndire , npoin2, taux1   )
!
!***********************************************************************
! TOMAWAC   V6P3                                   23/06/2011
!***********************************************************************
!
!brief    COMPUTES THE CONTRIBUTION OF THE WHITECAPPING
!+                SOURCE TERM BASED ON KOMEN ET AL. (1984).
!
!note     CMOUT1 (USED IN WAM-CYCLE 4) EQUALS 4.5.
!note   CMOUT2 (USED IN WAM-CYCLE 4) EQUALS 0.5.
!
!reference  KOMEN G.J., HASSELMANN S., HASSELMANN K. (1984) :
!+                     "ON THE EXISTENCE OF A FULLY DEVELOPED WINDSEA
!+                      SPECTRUM". JPO, VOL 14, PP 1271-1285.
!
!history  P. THELLIER; M. BENOIT (EDF/DER/LNH)
!+        06/04/95
!+        V1P0
!+
!
!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
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| ENRJ           |-->| SPECTRUM VARIANCE
!| F              |-->| DIRECTIONAL SPECTRUM
!| FMOY           |-->| MEAN SPECTRAL FRQUENCY FMOY
!| NF             |-->| NUMBER OF FREQUENCIES
!| NDIRE          |-->| NUMBER OF DIRECTIONS
!| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
!| PROINF         |-->| LOGICAL INDICATING INFINITE DEPTH ASSUMPTION
!| TAUX1          |<--| WORK TABLE
!| TSDER          |<->| DERIVED PART OF THE SOURCE TERM CONTRIBUTION
!| TSTOT          |<->| TOTAL PART OF THE SOURCE TERM CONTRIBUTION
!| XK             |-->| DISCRETIZED WAVE NUMBER
!| XKMOY          |-->| AVERAGE WAVE NUMBER
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_tomawac, ONLY : deupi,gravit, cmout1,cmout2,
     &                                 proinf, freq

! Variables in TOMAWAC MODULE
! CMOUT1         WHITE CAPPING DISSIPATION COEFFICIENT
! CMOUT2         WHITE CAPPING WEIGHTING COEFFICIENT
!
      USE interface_tomawac, ex_qmout1 => qmout1
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)             :: NF,NDIRE,NPOIN2
      DOUBLE PRECISION, INTENT(IN)    :: XKMOY(npoin2),ENRJ(npoin2)
      DOUBLE PRECISION, INTENT(INOUT) :: TAUX1(npoin2),FMOY(npoin2)
      DOUBLE PRECISION, INTENT(INOUT) :: TSTOT(npoin2,ndire,nf)
      DOUBLE PRECISION, INTENT(INOUT) :: TSDER(npoin2,ndire,nf)
      DOUBLE PRECISION, INTENT(IN)    :: F(npoin2,ndire,nf)
      DOUBLE PRECISION, INTENT(IN)    :: XK(npoin2,nf)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER  JP    , JF    , IP
      DOUBLE PRECISION AUX   , C1    , C2, BETA
!
      c1 = - cmout1*deupi**9/gravit**4
      c2 = - cmout1*deupi
!
      IF (proinf) THEN
!
!       INFINITE WATER DEPTH (USES F).
!
!       WORKING ARRAY (THIS TERM ONLY DEPENDS ON THE POINT IN SPACE)
!
        DO ip=1,npoin2
          taux1(ip) = c1 * enrj(ip)**2 * fmoy(ip)**9
        ENDDO
!
!       LOOP OVER DISCRETISED FREQUENCIES
!
        DO jf=1,nf
!
!         COMPUTES THE BETA COEFFICIENT : QMOUT1 = BETA * F
!
          DO ip=1,npoin2
            aux = (freq(jf)/fmoy(ip))**2
            beta=taux1(ip)*aux*(1.d0-cmout2+cmout2*aux)
            DO jp=1,ndire
              tstot(ip,jp,jf) = tstot(ip,jp,jf)+beta*f(ip,jp,jf)
              tsder(ip,jp,jf) = tsder(ip,jp,jf)+beta
            ENDDO
          ENDDO
!
!         TAKES THE SOURCE TERM INTO ACCOUNT
!
!
        ENDDO
!
      ELSE
!
!       FINITE WATER DEPTH (USES K).
!
!       WORKING ARRAY (THIS TERM ONLY DEPENDS ON THE POINT IN SPACE)
!
        DO ip=1,npoin2
          taux1(ip) = c2 * enrj(ip)**2 * fmoy(ip) * xkmoy(ip)**4
        ENDDO
!
!       LOOP OVER THE DISCRETISED FREQUENCIES
!
        DO jf=1,nf
!
!         COMPUTES THE BETA COEFFICIENT : QMOUT1 = BETA * F
!
          DO ip=1,npoin2
            aux = xk(ip,jf) / xkmoy(ip)
            beta=taux1(ip)*aux*(1.d0-cmout2+cmout2*aux)
            DO jp=1,ndire
              tstot(ip,jp,jf) = tstot(ip,jp,jf)+beta*f(ip,jp,jf)
              tsder(ip,jp,jf) = tsder(ip,jp,jf)+beta
            ENDDO
          ENDDO
        ENDDO

!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END