windiss2.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE windiss2
!                   *****************
     &  (fwx, fwy, npoin2, xk, ndire, fs,nf)
!  SURFACE STRESS DUE TO WIND INPUT ENERGY AND WHITECAPPING
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FS             |-->| VARIANCE DENSITY DIRECTIONAL SPECTRUM
!| FWX            |<--| SURFACE STRESS DUE TO WIND ALONG X
!| FWY            |<--| SURFACE STRESS DUE TO WIND ALONG Y
!| NF             |-->| NUMBER OF FREQUENCIES
!| NDIRE          |-->| NUMBER OF DIRECTIONS
!| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
!| XK             |-->| DISCRETIZED WAVE NUMBER
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!                    *****************

      USE declarations_tomawac, ONLY : freq, dfreq, sintet, costet,
     &   teta, deupi, roair, roeau, usdpi,
     &   twold, usold
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN) :: NPOIN2, NDIRE,NF
      DOUBLE PRECISION, INTENT(IN) :: FS(npoin2,ndire,nf)
      DOUBLE PRECISION, INTENT(IN) :: XK(npoin2,nf)
      DOUBLE PRECISION, INTENT(INOUT) :: FWX(npoin2), FWY(npoin2)
!
      DOUBLE PRECISION DTETAR,  C1, CONST,  AUX1, COEPHAS
      DOUBLE PRECISION USO, SIGMA, BETAWIN, DIREC,SURDEUPIFREQ
      INTEGER IP, JF, JP
      dtetar=deupi/dble(ndire)
      DO ip=1,npoin2
        fwx(ip) = 0.d0
        fwy(ip) = 0.d0
      ENDDO
      c1 = 0.25d0 * (roair/roeau) * deupi

!.....LOOP ON THE DISCRETISED FREQUENCIES
!     """"""""""""""""""""""""""""""""""""""""""""
      DO jf=1,nf

        const=c1*freq(jf)
        surdeupifreq=usdpi/freq(jf)
        aux1=dfreq(jf)*dtetar
        sigma=deupi*freq(jf)
!
!.......LOOP ON THE DISCRETISED DIRECTIONS
!       """"""""""""""""""""""""""""""""""""""""""""
        DO jp=1,ndire
          direc=teta(jp)
          DO ip=1,npoin2
!.......COMPUTES THE FREQUENCIES (OMEGA AND UETOILE/CPHASE)
            uso=28.d0*usold(ip)*cos(direc-twold(ip))
            coephas = xk(ip,jf)*surdeupifreq
            betawin = max(uso*coephas-1.d0,0.d0)*const

            fwx(ip)=fwx(ip)+((xk(ip,jf)/sigma)*sintet(jp)
     &           *betawin*fs(ip,jp,jf))*aux1
            fwy(ip)=fwy(ip)+((xk(ip,jf)/sigma)*costet(jp)
     &           *betawin*fs(ip,jp,jf))*aux1
          ENDDO
        ENDDO
      ENDDO
      RETURN
      END