fsprd3.f

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

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