spread.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\spread.f
00002 !
00062                      SUBROUTINE SPREAD
00063 !                    *****************
00064 !
00065      &( DIRSPR, F     , COSTET, SINTET, NPLAN , FREQ  , DFREQ , NF    ,
00066      &  NPOIN2, TAILF , COSMOY, SINMOY, VARIAN, TAUXC , TAUXS , TAUXE )
00067 !
00068 !***********************************************************************
00069 ! TOMAWAC   V6P1                                   28/06/2011
00070 !***********************************************************************
00071 !
00072 !
00073 !
00074 !
00075 !
00076 !
00077 !
00078 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00079 !| COSMOY         |<--| WORK TABLE
00080 !| COSTET         |<--| WORK TABLE
00081 !| DFREQ          |-->| FREQUENCY STEPS BETWEEN DISCRETIZED FREQUENCIES
00082 !| DIRSPR         |<--| MEAN DIRECTIONAL SPREAD
00083 !| F              |-->| VARIANCE DENSITY DIRECTIONAL SPECTRUM
00084 !| FREQ           |-->| DISCRETIZED FREQUENCIES
00085 !| NF             |-->| NUMBER OF FREQUENCIES
00086 !| NPLAN          |-->| NUMBER OF DIRECTIONS
00087 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00088 !| SINMOY         |<--| WORK TABLE
00089 !| SINTET         |-->| SINE OF TETA ANGLE
00090 !| TAILF          |-->| SPECTRUM QUEUE FACTOR
00091 !| TAUXC          |<--| WORK TABLE
00092 !| TAUXE          |<--| WORK TABLE
00093 !| TAUXS          |<--| WORK TABLE
00094 !| VARIAN         |<--| WORK TABLE
00095 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00096 !
00097       USE DECLARATIONS_TOMAWAC, ONLY : DEUPI,GRADEG
00098 !
00099       IMPLICIT NONE
00100 !
00101 !.....VARIABLES IN ARGUMENT
00102 !     """"""""""""""""""""
00103       INTEGER  NF    , NPLAN , NPOIN2
00104       DOUBLE PRECISION TAILF
00105       DOUBLE PRECISION DIRSPR(NPOIN2), SINMOY(NPOIN2), COSMOY(NPOIN2)
00106       DOUBLE PRECISION TAUXS (NPOIN2), TAUXC (NPOIN2), TAUXE (NPOIN2)
00107       DOUBLE PRECISION COSTET(NPLAN) , SINTET(NPLAN)
00108       DOUBLE PRECISION FREQ(NF), DFREQ(NF)
00109       DOUBLE PRECISION F(NPOIN2,NPLAN,NF), VARIAN(NPOIN2)
00110 !
00111 !.....LOCAL VARIABLES
00112 !     """""""""""""""""
00113       INTEGER  IP    , JP    , JF
00114       DOUBLE PRECISION AUXC  , AUXS  , DFDTET, DTETAR, AUXI
00115       DOUBLE PRECISION SEUIL , COEFT
00116 !
00117 !
00118       SEUIL=1.D-20
00119       DTETAR=DEUPI/DBLE(NPLAN)
00120 !
00121       DO IP=1,NPOIN2
00122         COSMOY(IP)=0.D0
00123         SINMOY(IP)=0.D0
00124         VARIAN(IP)=0.D0
00125       ENDDO ! IP
00126 !
00127 !-----C-------------------------------------------------------C
00128 !-----C  SUMS UP THE DISCRETISED PART OF THE SPECTRUM         C
00129 !-----C-------------------------------------------------------C
00130       DO JF=1,NF
00131 !
00132         DFDTET=DFREQ(JF)*DTETAR
00133 !
00134         DO IP=1,NPOIN2
00135           TAUXC(IP)=0.D0
00136           TAUXS(IP)=0.D0
00137           TAUXE(IP)=0.D0
00138         ENDDO ! IP
00139 !
00140         DO JP=1,NPLAN
00141           AUXC=COSTET(JP)*DFDTET
00142           AUXS=SINTET(JP)*DFDTET
00143           DO IP=1,NPOIN2
00144             TAUXC(IP)=TAUXC(IP)+F(IP,JP,JF)*AUXC
00145             TAUXS(IP)=TAUXS(IP)+F(IP,JP,JF)*AUXS
00146             TAUXE(IP)=TAUXE(IP)+F(IP,JP,JF)*DFDTET
00147           ENDDO ! IP
00148         ENDDO ! JP
00149 !
00150         DO IP=1,NPOIN2
00151           COSMOY(IP)=COSMOY(IP)+TAUXC(IP)
00152           SINMOY(IP)=SINMOY(IP)+TAUXS(IP)
00153           VARIAN(IP)=VARIAN(IP)+TAUXE(IP)
00154         ENDDO ! IP
00155 !
00156       ENDDO ! JF
00157 !
00158 !-----C-------------------------------------------------------------C
00159 !-----C  TAKES INTO ACCOUNT THE HIGH FREQUENCY PART (OPTIONAL)      C
00160 !-----C-------------------------------------------------------------C
00161       IF (TAILF.GT.1.D0) THEN
00162         COEFT=FREQ(NF)/((TAILF-1.D0)*DFREQ(NF))
00163         DO IP=1,NPOIN2
00164           COSMOY(IP)=COSMOY(IP)+TAUXC(IP)*COEFT
00165           SINMOY(IP)=SINMOY(IP)+TAUXS(IP)*COEFT
00166           VARIAN(IP)=VARIAN(IP)+TAUXE(IP)*COEFT
00167         ENDDO ! IP
00168       ENDIF
00169 !
00170 !-----C-------------------------------------------------------------C
00171 !-----C  COMPUTES THE DIRECTIONAL WIDTH                             C
00172 !-----C-------------------------------------------------------------C
00173       DO IP=1,NPOIN2
00174         IF (VARIAN(IP).GT.SEUIL) THEN
00175           AUXS=SINMOY(IP)/VARIAN(IP)
00176           AUXC=COSMOY(IP)/VARIAN(IP)
00177           AUXI=MIN(DSQRT(AUXS*AUXS+AUXC*AUXC),1.D0)
00178           DIRSPR(IP)=DSQRT(2.D0*(1.D0-AUXI))*GRADEG
00179         ELSE
00180           DIRSPR(IP)=SEUIL
00181         ENDIF
00182       ENDDO ! IP
00183 !
00184       RETURN
00185       END

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