kmoyen.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\kmoyen.f
00002 !
00070                      SUBROUTINE KMOYEN
00071 !                    *****************
00072 !
00073      &(XKMOY,XK,F,FREQ,DFREQ,TAILF,NF,NPLAN,NPOIN2,AUX1,AUX2,AUX3)
00074 !
00075 !***********************************************************************
00076 ! TOMAWAC   V6P3                                   20/06/2011
00077 !***********************************************************************
00078 !
00079 !
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00087 !| AUX1           |<->| WORK TABLE
00088 !| AUX2           |<->| WORK TABLE
00089 !| AUX3           |<->| WORK TABLE
00090 !| DFREQ          |-->| FREQUENCY STEPS BETWEEN DISCRETIZED FREQUENCIES
00091 !| F              |---| VARIANCE DENSITY DIRECTIONAL SPECTRUM
00092 !| FREQ           |-->| DISCRETIZED FREQUENCIES
00093 !| NF             |-->| NUMBER OF FREQUENCIES
00094 !| NPLAN          |-->| NUMBER OF DIRECTIONS
00095 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00096 !| TAILF          |-->| SPECTRUM QUEUE FACTOR
00097 !| XK             |-->| DISCRETIZED WAVE NUMBER
00098 !| XKMOY          |<--| AVERAGE WAVE NUMBER
00099 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00100 !
00101       USE DECLARATIONS_TOMAWAC, ONLY : DEUPI,GRAVIT
00102 !
00103       IMPLICIT NONE
00104 !
00105       INTEGER LNG,LU
00106       COMMON/INFO/ LNG,LU
00107 !
00108 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00109 !
00110       INTEGER, INTENT(IN)             :: NF,NPLAN,NPOIN2
00111       DOUBLE PRECISION, INTENT(IN)    :: TAILF
00112       DOUBLE PRECISION, INTENT(IN)    :: F(NPOIN2,NPLAN,NF)
00113       DOUBLE PRECISION, INTENT(IN)    :: XK(NPOIN2,NF)
00114       DOUBLE PRECISION, INTENT(IN)    :: FREQ(NF),DFREQ(NF)
00115       DOUBLE PRECISION, INTENT(INOUT) :: AUX1(NPOIN2),AUX2(NPOIN2)
00116       DOUBLE PRECISION, INTENT(INOUT) :: AUX3(NPOIN2)
00117       DOUBLE PRECISION, INTENT(INOUT) :: XKMOY(NPOIN2)
00118 !
00119 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00120 !
00121       INTEGER  IPLAN , JF    , IP
00122       DOUBLE PRECISION COEFF , SEUIL , CTE1  , CTE2  , AUX4
00123 !
00124 !-----------------------------------------------------------------------
00125 !
00126       SEUIL = 1.D-20
00127       COEFF = SQRT(GRAVIT)/DEUPI
00128 !
00129       DO IP = 1,NPOIN2
00130         AUX1(IP) = 0.D0
00131         AUX2(IP) = 0.D0
00132       ENDDO
00133 !
00134 !     SUMS UP THE CONTRIBUTIONS FOR THE DISCRETISED PART OF THE SPECTRUM
00135 !
00136       DO JF = 1,NF
00137 !
00138         AUX4=DFREQ(JF)
00139 !
00140         DO IP=1,NPOIN2
00141           AUX3(IP) = 0.D0
00142         ENDDO
00143         DO IPLAN = 1,NPLAN
00144           DO IP=1,NPOIN2
00145             AUX3(IP) = AUX3(IP) + F(IP,IPLAN,JF)
00146           ENDDO
00147         ENDDO
00148 !
00149         DO IP = 1,NPOIN2
00150           AUX1(IP)=AUX1(IP)+AUX3(IP)*AUX4
00151           AUX2(IP)=AUX2(IP)+AUX3(IP)/SQRT(XK(IP,JF))*AUX4
00152         ENDDO
00153 !
00154       ENDDO
00155 !
00156 !     (OPTIONALLY) TAKES INTO ACCOUNT THE HIGH-FREQUENCY PART
00157 !
00158       IF(TAILF.GT.1.D0) THEN
00159         CTE1=FREQ(NF)/(TAILF-1.D0)
00160         CTE2=COEFF/TAILF
00161         DO IP=1,NPOIN2
00162           AUX1(IP) = AUX1(IP) + AUX3(IP)*CTE1
00163           AUX2(IP) = AUX2(IP) + AUX3(IP)*CTE2
00164         ENDDO
00165       ENDIF
00166 !
00167 !     COMPUTES THE AVERAGE WAVE NUMBER
00168 !
00169       DO IP=1,NPOIN2
00170         IF(AUX2(IP).LT.SEUIL) THEN
00171 !         XKMOY(IP) = 1.D0
00172 !         JMH ON 18/01/2013 : ARITHMETIC AVERAGE WHEN ENERGY WEIGHTED
00173 !                             AVERAGE IS NOT POSSIBLE
00174           XKMOY(IP)=XK(IP,1)
00175           DO JF=2,NF
00176             XKMOY(IP)=XKMOY(IP)+XK(IP,JF)
00177           ENDDO
00178           XKMOY(IP)=XKMOY(IP)/NF
00179         ELSE
00180           XKMOY(IP) = (AUX1(IP)/AUX2(IP))**2
00181         ENDIF
00182       ENDDO
00183 !
00184 !-----------------------------------------------------------------------
00185 !
00186       RETURN
00187       END

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