perale.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\artemis\perale.f
00002 !
00064                      SUBROUTINE PERALE
00065 !                    *****************
00066 !
00067      &(PALE,GAMMA,PERPIC,NPALE,TRA01,NPOIN,PRIVE,NPRIV,PMIN,PMAX)
00068 !
00069 !***********************************************************************
00070 ! ARTEMIS   V6P3                                  21/08/2010
00071 !***********************************************************************
00072 !
00073 !
00074 !
00075 !
00076 !
00077 !
00078 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00079 !| GAMMA          |-->| COEFFICIENT IN THE SPECTRUM FORMULA
00080 !| NPALE          |-->| NUMBER OF DISCRETISATION PERIOD
00081 !| NPOIN          |-->| NUMBER OF POINTS
00082 !| NPRIV          |<->| NUMBER OF PRIVATE TABLES
00083 !| PALE           |<--| PERIODS FOR SPECTRUM DISCRETISATION
00084 !| PERPIC         |-->| PEAK PERIOD FOR SPECTRUM
00085 !| PMAX           |-->| MAXIMUM FREQUENCY FOR SPECTRUM
00086 !| PMIN           |-->| MINIMUM FREQUENCY FOR SPECTRUM
00087 !| PRIVE          |<->| USER PRIVATE TABLE
00088 !| TRA01          |<->| WORK STRUCTURE
00089 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00090 !
00091       USE INTERFACE_ARTEMIS, ONLY: SPE
00092       USE BIEF
00093 !
00094       IMPLICIT NONE
00095       INTEGER LNG,LU
00096       COMMON/INFO/LNG,LU
00097 !
00098       INTEGER NPALE,NPOIN,NPRIV,NPAS,I,K
00099 !
00100       DOUBLE PRECISION PALE(NPALE),TRA01(NPOIN)
00101       DOUBLE PRECISION PERPIC,GAMMA ,SUMB  ,SUMICI   ,DF    ,VAR
00102       DOUBLE PRECISION PMIN  ,PMAX  ,FMIN  ,FMAX
00103       DOUBLE PRECISION B     ,B1    ,B2
00104 !
00105       TYPE(BIEF_OBJ) :: PRIVE
00106 !
00107       DOUBLE PRECISION FP,GAM,DELTA
00108       COMMON /COEFHE/ FP,GAM,DELTA
00109 !
00110       INTRINSIC LOG,FLOAT
00111 !
00112 !-----------------------------------------------------------------------
00113 !
00114 ! PEAK FREQUENCY
00115       FP   = 1.D0 / PERPIC
00116       FMIN = 1.D0 / PMAX
00117       FMAX = 1.D0 / PMIN
00118       IF (FMAX.GE.99.D0) THEN
00119         FMAX = 2.5D0 * FP
00120       ENDIF
00121 !
00122 ! GAMMA IS IN THE COMMON STATEMENT OF FUNCTION SPE (CANNOT BE
00123 ! CALLED GAMMA BECAUSE IT IS AN ARGUMENT OF THIS SUBROUTINE)
00124       GAM  = GAMMA
00125 !
00126 !-----------------------------------------------------------------------
00127 !
00128       IF (GAMMA.GT.0.99D0 .AND. GAMMA.LT.1.01D0) THEN
00129 !
00130 !
00131 !        PIERSON-MOSKOWITZ SPECTRUM
00132 !        ----------------------------
00133 !
00134         B1 = EXP(-1.25D0 * (FP/FMAX)**4)
00135         B2 = EXP(-1.25D0 * (FP/FMIN)**4)
00136         B  = B1 - B2
00137         DO I=1,NPALE
00138           PALE(NPALE-I+1) = PERPIC *
00139      &    (-0.8D0*LOG( B2 + B*FLOAT(2*I-1)/FLOAT(2*NPALE) ))**(0.25D0)
00140         ENDDO
00141 !
00142       ELSE
00143 !
00144 !
00145 !        JONSWAP SPECTRUM
00146 !        ------------------
00147 !
00148 !        THE FREQUENCIES LIMITING THE SPECTRUM TO THE LEFT AND RIGHT
00149 !        ARE GIVEN BY KEYWORDS IN THE ARGUMENTS
00150 !
00151         IF (FMAX.LE.FP) THEN
00152           FMAX = 2.5D0 * FP
00153           WRITE(LU,110) FMAX
00154  110      FORMAT(/,1X,'(PERALE) : FMAX < FP ??? =>',1X,
00155      &          'CORRECTION : FMAX =',1X,F5.3,' HZ',/)
00156         ENDIF
00157 !
00158 !       NUMBER OF INTEGRATION INTERVALS FOR THE TRAPEZOIDS METHOD
00159 !
00160         NPAS = 2000*NPALE
00161 !
00162 !       WIDTH OF AN INTEGRATION INTERVAL
00163 !
00164         DF = (FMAX-FMIN)/FLOAT(NPAS)
00165 !
00166 !       COEFFICIENT FOR THE FUNCTION OF THE SPECTRUM (COMPUTED HERE
00167 !       SO THAT IT'S NOT RECOMPUTED WHEN CALLS SPE)
00168 !
00169         DELTA = 0.0624D0 * FP**4 /
00170      &           ( 0.230D0 + 0.0336D0*GAM - 0.185D0 / (1.9D0+GAM) )
00171 !
00172 !       SURFACE OF THE SPECTRUM (TRAPEZOIDS METHOD)
00173 !
00174         SUMB = (SPE(FMIN) + SPE(FMAX))/2.D0
00175         DO I = 2,NPAS-1
00176           SUMB = SUMB + SPE(FMIN+FLOAT(I)*DF)
00177         ENDDO
00178 !
00179 !       DIVIDES THE SPECTRUM INTO 2*NPALE BANDS OF EQUAL ENERGY
00180 !
00181         SUMB = SUMB/FLOAT(2*NPALE)
00182 !
00183 !       IDENTIFIES THE FREQUENCIES EVERY (2*I-1)*SUMB (I=1,NPALE)
00184 !
00185         SUMICI = SPE(FMIN)/2.D0
00186         I   = 1
00187         DO K=1,NPAS
00188           VAR = SPE(FMIN+DF*FLOAT(K))
00189           SUMICI = SUMICI + VAR/2.D0
00190           IF (SUMICI.GT.SUMB*FLOAT(2*I-1)) THEN
00191             PALE(NPALE-I+1) = 1.D0 / ( FMIN + DF*(FLOAT(K)-0.5D0) )
00192             I = I + 1
00193             IF (I.GT.NPALE) RETURN
00194           ENDIF
00195             SUMICI = SUMICI + VAR/2.D0
00196         ENDDO
00197 !
00198 !
00199       ENDIF
00200 !
00201 !-----------------------------------------------------------------------
00202 !
00203       RETURN
00204       END

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