fsprd2.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\fsprd2.f
00002 !
00067                      SUBROUTINE FSPRD2
00068 !                    *****************
00069 !
00070      &( FRA   , DIREC , NPLAN , SPRED1, TETA1 , SPRED2, TETA2 , XLAMDA)
00071 !
00072 !***********************************************************************
00073 ! TOMAWAC   V6P1                                   15/06/2011
00074 !***********************************************************************
00075 !
00076 !
00077 !
00078 !
00079 !
00080 !
00081 !
00082 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00083 !| DEUPI          |-->| 2.PI
00084 !| DIREC          |-->| DISCRETIZED DIRECTION
00085 !| FRA            |<--| DIRECTIONAL SPREADING FUNCTION VALUES
00086 !| NPLAN          |-->| NUMBER OF DIRECTIONS
00087 !| SPRED1         |-->| DIRECTIONAL SPREAD 1
00088 !| SPRED2         |-->| DIRECTIONAL SPREAD 1
00089 !| TETA1          |-->| MAIN DIRECTION 1
00090 !| TETA2          |-->| MAIN DIRECTION 2
00091 !| XLAMDA         |-->| WEIGHTING FACTOR FOR FRA
00092 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00093 !
00094       USE DECLARATIONS_TOMAWAC, ONLY : PI,DEUPI
00095 !
00096       IMPLICIT NONE
00097 !
00098 !.....VARIABLES IN ARGUMENT
00099 !     """"""""""""""""""""
00100       INTEGER  NPLAN
00101       DOUBLE PRECISION SPRED1, TETA1 , SPRED2, TETA2 , XLAMDA
00102       DOUBLE PRECISION FRA(NPLAN)    , DIREC(NPLAN)
00103 !
00104 !.....LOCAL VARIABLES
00105 !     """""""""""""""""
00106       INTEGER  JP
00107       DOUBLE PRECISION DELT1 , DELT2 , FTH   , FRA1  , FRA2  , ARGUM
00108       DOUBLE PRECISION C1    , C2
00109 !
00110       IF (SPRED1.GT.1.D-4) THEN
00111         DELT1 = 1.D0/(SPRED1*SQRT(DEUPI))
00112         C1    = -0.5/(SPRED1*SPRED1)
00113       ELSE
00114         DELT1 = 0.D0
00115         C1    = 0.D0
00116       ENDIF
00117       IF (SPRED2.GT.1.D-4) THEN
00118         DELT2 = 1.D0/(SPRED2*SQRT(DEUPI))
00119         C2    = -0.5/(SPRED2*SPRED2)
00120       ELSE
00121         DELT2 = 0.D0
00122         C2    = 0.D0
00123       ENDIF
00124 !
00125       DO JP=1,NPLAN
00126         FTH = DIREC(JP)
00127 !
00128         ARGUM = FTH-TETA1
00129         DO WHILE(ARGUM.LT.-PI)
00130           ARGUM=ARGUM+DEUPI
00131         ENDDO
00132         DO WHILE(ARGUM.GT.PI)
00133           ARGUM=ARGUM-DEUPI
00134         ENDDO
00135         FRA1=DELT1*EXP(MAX(-10.D0,C1*ARGUM*ARGUM))
00136 !
00137         ARGUM = FTH-TETA2
00138         DO WHILE(ARGUM.LT.-PI)
00139           ARGUM=ARGUM+DEUPI
00140         ENDDO
00141         DO WHILE(ARGUM.GT.PI)
00142           ARGUM=ARGUM-DEUPI
00143         ENDDO
00144         FRA2=DELT2*EXP(MAX(-10.D0,C2*ARGUM*ARGUM))
00145 !
00146         FRA(JP)=XLAMDA*FRA1+(1.D0-XLAMDA)*FRA2
00147         IF (FRA(JP).LT.1.D-10) FRA(JP)=0.D0
00148       ENDDO ! JP
00149 !
00150       RETURN
00151       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0