qwindl.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE qwindl
!                       *****************
!
     &( tstot , usold , usnew , twold , twnew , nf    , ndire ,
     &  npoin2, usn   , uso   , fpmo  , fpmn )
!
!**********************************************************************
! TOMAWAC   V6P3                                   27/06/2011
!**********************************************************************
!
!brief    COMPUTES THE CONTRIBUTION OF THE LINEAR WAVE GENERATION
!+               (BY WIND) SOURCE TERM BASED ON CAVALERI AND
!+                MALANOTTE-RIZZOLI (1981)
!
!reference   CAVALERI L. & P. MALANOTTE-RIZZOLI, 1981 :
!+                 "WIND WAVE PREDICTION IN SHALLOW WATER : THEORY AND
!+                  APPLICATIONS". J. GEOPHYS. RES., 86(C5),10,961-975
!
!reference   TOLMAN  (1992) : EFFECT OF NUMERICS ON THE PHYSICS IN
!+                A THIRD-GENERATION WIND-WAVE MODEL, JPO, VOL 22,
!+                PP 1095-1111.
!
!history  E. GAGNAIRE-RENOU (EDF/LNHE)
!+        09/2010
!+        V6P0
!+
!
!history  G.MATTAROLO (EDF - LNHE)
!+        27/06/2011
!+        V6P1
!+   Translation of French names of the variables in argument
!
!history  J-M HERVOUET (EDF/LNHE)
!+        23/12/2012
!+        V6P3
!+   A first optimisation.
!
!history  J-M HERVOUET (EDF/LNHE)
!+        09/07/2013
!+        V6P3
!+   (1.D0/1.D-90)**4 triggers an overflow, 20 put instead of 90.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FPMN           |<->| WORK TABLE
!| FPMO           |<->| WORK TABLE
!| NF             |-->| NUMBER OF FREQUENCIES
!| NDIRE          |-->| NUMBER OF DIRECTIONS
!| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
!| TSDER          |<->| DERIVED PART OF THE SOURCE TERM CONTRIBUTION
!| TSTOT          |<->| TOTAL PART OF THE SOURCE TERM CONTRIBUTION
!| TWNEW          |-->| WIND DIRECTION AT TIME N+1
!| TWOLD          |-->| WIND DIRECTION AT TIME N
!| USNEW          |-->| FRICTION VELOCITY AT TIME N+1
!| USOLD          |-->| FRICTION VELOCITY AT TIME N
!| XK             |-->| DISCRETIZED WAVE NUMBER
!| USN            |<--| WORK TABLE
!| USO            |<--| WORK TABLE
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
!  APPELS :    - PROGRAMME(S) APPELANT  : SEMIMP
!  ********    - PROGRAMME(S) APPELE(S) :    -
!**********************************************************************
!
      USE declarations_tomawac, ONLY : deupi,gravit,cimpli, freq, teta,
     &    t0,t1
!FROM TOMAWAC MODULE
! CIMPLI          IMPLICITATION COEFFICIENT FOR SOURCE TERMS
!
      USE interface_tomawac, ex_qwindl => qwindl
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)             :: NF,NDIRE,NPOIN2
      DOUBLE PRECISION, INTENT(INOUT) :: FPMO(npoin2),FPMN(npoin2)
      DOUBLE PRECISION, INTENT(IN)    :: TWOLD(npoin2),TWNEW(npoin2)
      DOUBLE PRECISION, INTENT(IN)    :: USNEW(npoin2),USOLD(npoin2)
      DOUBLE PRECISION, INTENT(INOUT) :: USO(npoin2,ndire)
      DOUBLE PRECISION, INTENT(INOUT) :: USN(npoin2,ndire)
      DOUBLE PRECISION, INTENT(INOUT) :: TSTOT(npoin2,ndire,nf)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER JP,JF,IP
      DOUBLE PRECISION C1,C2,DIREC,ALPHAN,ALPHAO,SURFREQ4
      DOUBLE PRECISION :: COSDIREC , SINDIREC
      DOUBLE PRECISION, DIMENSION(:), POINTER ::COSTW,SINTW,
     &    expfpmo,expfpmn
!
!-----------------------------------------------------------------------
!
      costw=>t0
      sintw=>t1
      expfpmo=>t0
      expfpmn=>t1

      c1 = 1.5d-3/gravit**2
      c2 = gravit/(deupi*28.d0)
!
!     ARRAYS DEPENDING ONLY ON POINTS
!
! ABR: ADDED EXPONETIAL HERE
      DO ip=1,npoin2
        fpmo(ip)=exp(-(c2/max(usold(ip),1.d-20))**4)
      ENDDO
      DO ip=1,npoin2
        fpmn(ip)=exp(-(c2/max(usnew(ip),1.d-20))**4)
      ENDDO

!
!     ARRAYS DEPENDING ONLY ON POINTS AND DIRECTIONS
!     COULD BE OPTIMISED MORE BY DECOMPOSING THE COS...
!
! abr: done
      DO ip=1,npoin2
        costw(ip)=cos(twold(ip))
      ENDDO
      DO ip=1,npoin2
        sintw(ip)=sin(twold(ip))
      ENDDO

      DO jp=1,ndire
        direc=teta(jp)
        cosdirec = cos(direc)
        sindirec = sin(direc)
        DO ip=1,npoin2
          uso(ip,jp)=c1*(max(usold(ip)*(cosdirec*costw(ip)+
     &                                 sindirec*sintw(ip)),0.d0))**4
        ENDDO
      ENDDO

      DO ip=1,npoin2
        costw(ip)=cos(twnew(ip))
      ENDDO
      DO ip=1,npoin2
        sintw(ip)=sin(twnew(ip))
      ENDDO

      DO jp=1,ndire
        direc=teta(jp)
        cosdirec = cos(direc)
        sindirec = sin(direc)
        DO ip=1,npoin2
          usn(ip,jp)=c1*(max(usnew(ip)*(cosdirec*costw(ip)+
     &                                 sindirec*sintw(ip)),0.d0))**4
        ENDDO
      ENDDO


!
!     LOOP ON THE DISCRETISED FREQUENCIES
!
      DO jf=1,nf
        surfreq4=1.d0/freq(jf)**4
        DO ip=1,npoin2
            expfpmo(ip)= fpmo(ip)**surfreq4
        ENDDO
        DO ip=1,npoin2
            expfpmn(ip)= fpmn(ip)**surfreq4
        ENDDO
        DO jp=1,ndire
          DO ip=1,npoin2
            alphao=uso(ip,jp)*expfpmo(ip)
            alphan=usn(ip,jp)*expfpmn(ip)
!           TAKES THE SOURCE TERM INTO ACCOUNT
            tstot(ip,jp,jf) = tstot(ip,jp,jf)
     &                      + (alphao + cimpli*(alphan-alphao))
          ENDDO
        ENDDO
      ENDDO
!
!-----------------------------------------------------------------------
!
      RETURN
      END