fpread.f

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

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