frem02.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\frem02.f
00002 !
00073                      SUBROUTINE FREM02
00074 !                    *****************
00075 !
00076      &( FM02  , F     , FREQ  , DFREQ , TAILF , NF    , NPLAN , NPOIN2,
00077      &  AUX1  , AUX2  )
00078 !
00079 !***********************************************************************
00080 ! TOMAWAC   V6P1                                   15/06/2011
00081 !***********************************************************************
00082 !
00083 !
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !
00090 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00091 !| AUX1           |<->| WORK TABLE
00092 !| AUX2           |<->| WORK TABLE
00093 !| DFREQ          |-->| FREQUENCY STEPS BETWEEN DISCRETIZED FREQUENCIES
00094 !| F              |-->| VARIANCE DENSITY DIRECTIONAL SPECTRUM
00095 !| FM02           |<--| MEAN FREQUENCIES F02
00096 !| FREQ           |-->| DISCRETIZED FREQUENCIES
00097 !| NF             |-->| NUMBER OF FREQUENCIES
00098 !| NPLAN          |-->| NUMBER OF DIRECTIONS
00099 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00100 !| TAILF          |-->| SPECTRUM QUEUE FACTOR
00101 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00102 !
00103       USE DECLARATIONS_TOMAWAC, ONLY : DEUPI
00104 !
00105       IMPLICIT NONE
00106 !
00107 !.....VARIABLES IN ARGUMENT
00108 !     """"""""""""""""""""
00109       INTEGER  NF    , NPLAN , NPOIN2
00110       DOUBLE PRECISION TAILF
00111       DOUBLE PRECISION F(NPOIN2,NPLAN,NF)
00112       DOUBLE PRECISION FREQ(NF), DFREQ(NF), FM02(NPOIN2)
00113       DOUBLE PRECISION AUX1(NPOIN2), AUX2(NPOIN2)
00114 !
00115 !.....LOCAL VARIABLES
00116 !     """""""""""""""""
00117       INTEGER  JP    , JF    , IP
00118       DOUBLE PRECISION SEUIL , DTETAR, AUX3  , AUX4
00119 !
00120 !
00121       SEUIL = 1.D-20
00122       DTETAR= DEUPI/DBLE(NPLAN)
00123       DO IP = 1,NPOIN2
00124         AUX1(IP) = 0.D0
00125         AUX2(IP) = 0.D0
00126       ENDDO
00127 !
00128 !-----C-------------------------------------------------------C
00129 !-----C SUMS UP THE CONTRIBUTIONS FOR THE DISCRETISED PART OF THE SPECTRUM     C
00130 !-----C-------------------------------------------------------C
00131       DO JF = 1,NF-1
00132         AUX3=DTETAR*DFREQ(JF)
00133         AUX4=AUX3*FREQ(JF)**2
00134         DO JP = 1,NPLAN
00135           DO IP=1,NPOIN2
00136             AUX1(IP) = AUX1(IP) + F(IP,JP,JF)*AUX4
00137             AUX2(IP) = AUX2(IP) + F(IP,JP,JF)*AUX3
00138           ENDDO ! IP
00139         ENDDO ! JP
00140       ENDDO ! JF
00141 !
00142 !-----C-------------------------------------------------------------C
00143 !-----C (OPTIONALLY) TAKES INTO ACCOUNT THE HIGH-FREQUENCY PART     C
00144 !-----C-------------------------------------------------------------C
00145       IF (TAILF.GT.3.D0) THEN
00146         AUX3=DTETAR*(DFREQ(NF)+FREQ(NF)/(TAILF-1.D0))
00147         AUX4=DTETAR*(DFREQ(NF)+FREQ(NF)/(TAILF-3.D0))*FREQ(NF)**2
00148       ELSE
00149         AUX3=DTETAR*DFREQ(NF)
00150         AUX4=AUX3*FREQ(NF)**2
00151       ENDIF
00152       DO JP = 1,NPLAN
00153         DO IP=1,NPOIN2
00154           AUX1(IP) = AUX1(IP) + F(IP,JP,NF)*AUX4
00155           AUX2(IP) = AUX2(IP) + F(IP,JP,NF)*AUX3
00156         ENDDO ! IP
00157       ENDDO ! JP
00158 !
00159 !-----C-------------------------------------------------------------C
00160 !-----C COMPUTES THE MEAN FREQUENCY                                 C
00161 !-----C-------------------------------------------------------------C
00162       DO IP=1,NPOIN2
00163         IF (AUX2(IP).LT.SEUIL) THEN
00164           FM02(IP) = SEUIL
00165         ELSE
00166           FM02(IP) = SQRT(AUX1(IP)/AUX2(IP))
00167         ENDIF
00168       ENDDO ! IP
00169 !
00170       RETURN
00171       END

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