dirale.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\artemis\dirale.f
00002 !
00069                      SUBROUTINE DIRALE
00070 !                    *****************
00071 !
00072      &(DALE,EXPOS,TETAH,TETMIN,TETMAX,NDALE,TRA01,NPOIN,PRIVE,NPRIV)
00073 !
00074 !***********************************************************************
00075 ! ARTEMIS   V6P1                                   21/08/2010
00076 !***********************************************************************
00077 !
00078 !
00079 !
00080 !
00081 !
00082 !
00083 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00084 !| DALE           |<--| DIRECTIONS FOR SPECTRUM DISCRETISATION
00085 !| EXPOS          |-->| COEFFICIENT FOR THE SPECTRUM FORMULA
00086 !| NDALE          |-->| NUMBER OF DISCRETISATION BAND
00087 !| NPOIN          |-->| NUMBER OF POINTS
00088 !| NPRIV          |<->| NUMBER OF PRIVATE TABLES
00089 !| PRIVE          |<->| PRIVATE TABLE
00090 !| TETAH          |-->| MAIN DIRECTION OF THE PROPAGATION
00091 !| TETMAX         |-->| MAXIMUM VALUE FOR THE PROPAGATION ANGLE
00092 !| TETMIN         |-->| MAXIMUM VALUE FOR THE PROPAGATION ANGLE
00093 !| TRA01          |<->| WORK STRUCTURE
00094 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00095 !
00096       USE BIEF
00097       USE INTERFACE_ARTEMIS, ONLY: SPD
00098 !
00099       IMPLICIT NONE
00100       INTEGER LNG,LU
00101       COMMON/INFO/LNG,LU
00102 !
00103       INTEGER NDALE,NPOIN,NPAS,I,K,NPRIV
00104 !
00105       DOUBLE PRECISION DALE(NDALE),TRA01(NPOIN)
00106       DOUBLE PRECISION EXPOS,TETMIN,TETMAX,TETAH,DTETA,SUMB,VAR,SUMICI
00107 !
00108       TYPE(BIEF_OBJ) :: PRIVE
00109 !
00110       DOUBLE PRECISION EXPO
00111       COMMON /COEFHD/ EXPO
00112 !
00113 !-----------------------------------------------------------------------
00114 !
00115 ! EXPOS IS IN THE COMMON STATEMENT OF FUNCTION SPD (CANNOT BE
00116 ! CALLED EXPOS BECAUSE IT IS AN ARGUMENT OF THIS SUBROUTINE)
00117       EXPO = EXPOS
00118 !
00119 !-----------------------------------------------------------------------
00120 !
00121 !     NUMBER OF INTEGRATION INTERVALS FOR THE TRAPEZOIDS METHOD
00122       NPAS = 2000*NDALE
00123 !
00124 !     WIDTH OF AN INTEGRATION INTERVAL
00125       DTETA = (TETMAX-TETMIN)/FLOAT(NPAS)
00126 !
00127 !     SURFACE OF THE SPECTRUM
00128       SUMB = (SPD(TETMIN-TETAH) + SPD(TETMAX-TETAH))/2.D0
00129       DO I = 2,NPAS-1
00130         SUMB = SUMB + SPD(TETMIN-TETAH+FLOAT(I)*DTETA)
00131       ENDDO
00132 !
00133 !     DIVIDES THE SPECTRUM INTO 2*NDALE BANDS OF EQUAL ENERGY
00134       SUMB = SUMB/FLOAT(2*NDALE)
00135 !
00136 !     IDENTIFIES THE ANGLES EVERY (2*I-1)*SUMB (I=1,NDALE)
00137       SUMICI = SPD(TETMIN-TETAH)/2.D0
00138       I   = 1
00139       DO K=1,NPAS
00140         VAR = SPD(TETMIN-TETAH+DTETA*FLOAT(K))
00141         SUMICI = SUMICI + VAR/2.D0
00142         IF (SUMICI.GE.SUMB*FLOAT(2*I-1)) THEN
00143           DALE(I) =  TETMIN + DTETA*(FLOAT(K)-0.5D0)
00144           I = I + 1
00145           IF (I.GT.NDALE) RETURN
00146         ENDIF
00147         SUMICI = SUMICI + VAR/2.D0
00148       ENDDO
00149 !
00150 !-----------------------------------------------------------------------
00151 !
00152       RETURN
00153       END SUBROUTINE

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