fsprd2.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE fsprd2
!                   *****************
!
     &( fra   , ndire , spred1, teta1 , spred2, teta2 , xlamda)
!
!***********************************************************************
! TOMAWAC   V6P1                                   15/06/2011
!***********************************************************************
!
!brief    COMPUTES THE BIMODAL DIRECTIONAL SPREADING FUNCTION
!+                FOR A RANGE OF DIRECTIONS.
!code
!+           EXP -0.5((T-T0)/S)**2  WHERE T IN (T0-PI/2;T0+PI/2)
!
!history  M. BENOIT
!+        10/01/96
!+        V1P0
!+   CREATED
!
!history  M. BENOIT
!+        07/11/96
!+        V1P2
!+   MODIFIED
!
!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)
!+        15/06/2011
!+        V6P1
!+   Translation of French names of the variables in argument
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| DEUPI          |-->| 2.PI
!| FRA            |<--| DIRECTIONAL SPREADING FUNCTION VALUES
!| NDIRE          |-->| NUMBER OF DIRECTIONS
!| SPRED1         |-->| DIRECTIONAL SPREAD 1
!| SPRED2         |-->| DIRECTIONAL SPREAD 1
!| TETA1          |-->| MAIN DIRECTION 1
!| TETA2          |-->| MAIN DIRECTION 2
!| XLAMDA         |-->| WEIGHTING FACTOR FOR FRA
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_tomawac, ONLY : pi,deupi, teta
!
      USE interface_tomawac, ex_fsprd2 => fsprd2
      IMPLICIT NONE
!
!.....VARIABLES IN ARGUMENT
!     """"""""""""""""""""
      INTEGER,INTENT(IN)             :: NDIRE
      DOUBLE PRECISION,INTENT(IN)    :: SPRED1, TETA1 , SPRED2, TETA2
      DOUBLE PRECISION,INTENT(IN)    :: XLAMDA
      DOUBLE PRECISION,INTENT(INOUT) :: FRA(ndire)
!
!.....LOCAL VARIABLES
!     """""""""""""""""
      INTEGER  JP
      DOUBLE PRECISION DELT1 , DELT2 , FTH   , FRA1  , FRA2  , ARGUM
      DOUBLE PRECISION C1    , C2
!
      IF (spred1.GT.1.d-4) THEN
        delt1 = 1.d0/(spred1*sqrt(deupi))
        c1    = -0.5/(spred1*spred1)
      ELSE
        delt1 = 0.d0
        c1    = 0.d0
      ENDIF
      IF (spred2.GT.1.d-4) THEN
        delt2 = 1.d0/(spred2*sqrt(deupi))
        c2    = -0.5/(spred2*spred2)
      ELSE
        delt2 = 0.d0
        c2    = 0.d0
      ENDIF
!
      DO jp=1, ndire
        fth = teta(jp)
!
        argum = fth-teta1
        DO WHILE(argum.LT.-pi)
          argum=argum+deupi
        ENDDO
        DO WHILE(argum.GT.pi)
          argum=argum-deupi
        ENDDO
        fra1=delt1*exp(max(-10.d0,c1*argum*argum))
!
        argum = fth-teta2
        DO WHILE(argum.LT.-pi)
          argum=argum+deupi
        ENDDO
        DO WHILE(argum.GT.pi)
          argum=argum-deupi
        ENDDO
        fra2=delt2*exp(max(-10.d0,c2*argum*argum))
!
        fra(jp)=xlamda*fra1+(1.d0-xlamda)*fra2
        IF (fra(jp).LT.1.d-10) fra(jp)=0.d0
      ENDDO ! JP
!
      RETURN
      END