fsprd1.f

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

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