moudiss1.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE moudiss1
!                   *****************
     &  (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,
     &deupi, varian, fmoy, xkmoy, cmout1, cmout2, gravit, proinf
!
      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, SIGMA, AUX, BETAMOU, TAUX1
      DOUBLE PRECISION AUX1, C1, C2
      INTEGER IP, JF, JP
      dtetar=deupi/dble(ndire)
      c1 = - cmout1*deupi**9/gravit**4
      c2 = - cmout1*deupi
      IF (proinf) THEN
!
!       INFINITE WATER DEPTH (USES F).

!.....LOOP ON THE DISCRETISED FREQUENCIES
!     """"""""""""""""""""""""""""""""""""""""""""
        DO jf=1,nf
          sigma=deupi*freq(jf)
          aux1=dfreq(jf)*dtetar
          DO ip=1,npoin2
            aux = (freq(jf)/fmoy(ip))**2
            taux1=c1 * varian(ip)**2 * fmoy(ip)**9
            betamou=taux1*aux*(1.d0-cmout2+cmout2*aux)
            DO jp=1,ndire
              fwx(ip)=fwx(ip)+((xk(ip,jf)/sigma)*sintet(jp)
     &             *betamou*fs(ip,jp,jf))*aux1
              fwy(ip)=fwy(ip)+((xk(ip,jf)/sigma)*costet(jp)
     &             *betamou*fs(ip,jp,jf))*aux1
            ENDDO
          ENDDO
        ENDDO
      ELSE
!       FINITE WATER DEPTH (USES K).
        DO jf=1,nf
          sigma=deupi*freq(jf)
          aux1=dfreq(jf)*dtetar
          DO ip=1,npoin2
            aux = xk(ip,jf) / xkmoy(ip)
            taux1 = c2 * varian(ip)**2 * fmoy(ip) * xkmoy(ip)**4
            betamou=taux1*aux*(1.d0-cmout2+cmout2*aux)
            DO jp=1,ndire
              fwx(ip)=fwx(ip)+((xk(ip,jf)/sigma)*sintet(jp)
     &             *betamou*fs(ip,jp,jf))*aux1
              fwy(ip)=fwy(ip)+((xk(ip,jf)/sigma)*costet(jp)
     &             *betamou*fs(ip,jp,jf))*aux1
            ENDDO
          ENDDO
        ENDDO
      ENDIF
      RETURN
      END