kmoye2.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE kmoye2
!                       *****************
!
     &( xkmoy , xk    , f     , nf    , ndire ,
     &  npoin2, aux1  , aux2  , aux3  )
!
!**********************************************************************
!  TOMAWAC - V1.0    P. THELLIER & M. BENOIT (EDF/DER/LNH)  -  04/04/95
!**********************************************************************
!
!  FONCTION : CALCUL DU NOMBRE D'ONDE MOYEN EN TOUS LES POINTS DU
!  ********   MAILLAGE SPATIAL 2D.
!
!  ARGUMENTS :
!  ***********
!  +-------------+----+--------------------------------------------+
!  ! NOM         !MODE! SIGNIFICATION - OBSERVATIONS               !
!  +-------------+----+--------------------------------------------+
!  ! XKMOY(-)    !<-- ! TABLEAU DES NOMBRES D'ONDE MOYEN           !
!  ! XK(-,-)     ! -->! TABLEAU DES NOMBRES D'ONDE                 !
!  ! F(-,-,-)    ! -->! SPECTRE DIRECTIONNEL                       !
!  ! FREQ(-)     ! -->! TABLEAU DES FREQUENCES DE DISCRETISATION   !
!  ! DFREQ(-)    ! -->! TABLEAU DES PAS DE FREQUENCE               !
!  ! TAILF       ! -->! FACTEUR DE QUEUE (TAILF = 4 OU 5)          !
!  ! NF          ! -->! NOMBRE DE FREQUENCES DE DISCRETISATION     !
!  ! NDIRE       ! -->! NOMBRE DE DIRECTIONS DE DISCRETISATION     !
!  ! NPOIN2      ! -->! NOMBRE DE POINTS DU MAILLAGE SPATIAL       !
!  ! AUX1(-)     !<-->! TABLEAU DE TRAVAIL (DIMENSION NPOIN2)      !
!  ! AUX2(-)     !<-->! TABLEAU DE TRAVAIL (DIMENSION NPOIN2)      !
!  ! AUX3(-)     !<-->! TABLEAU DE TRAVAIL (DIMENSION NPOIN2)      !
!  +-------------+----+--------------------------------------------+
!  ! MODE   (-> : NON-MODIFIE)  (<-> : MODIFIE)  (<- : INITIALISE) !
!  +---------------------------------------------------------------+
!
!  APPELS :    - PROGRAMME(S) APPELANT  :  SEMIMP, PRE2D
!  ********    - PROGRAMME(S) APPELE(S) :    -
!
!  REMARQUES :
!  ***********
!  - LA PARTIE HAUTES-FREQUENCES DU SPECTRE N'EST PRISE EN COMPTE QUE
!    SI LE FACTEUR DE QUEUE (TAILF) EST STRICTEMENT SUPERIEUR A 1.
!
!**********************************************************************
!
      USE declarations_tomawac, ONLY : freq, dfreq, tailf
      USE interface_tomawac, ex_kmoye2 => kmoye2
      IMPLICIT NONE
!
!.....VARIABLES TRANSMISES
!     """"""""""""""""""""
      INTEGER, INTENT(IN)             :: NF, NDIRE, NPOIN2
      DOUBLE PRECISION, INTENT(IN)    :: F(npoin2,ndire,nf)
      DOUBLE PRECISION, INTENT(IN)    :: XK(npoin2,nf)
      DOUBLE PRECISION, INTENT(INOUT) :: AUX1(npoin2) , AUX2(npoin2)
      DOUBLE PRECISION, INTENT(INOUT) :: AUX3(npoin2)
      DOUBLE PRECISION, INTENT(INOUT) :: XKMOY(npoin2)
!
!.....VARIABLES LOCALES
!     """""""""""""""""
      INTEGER  IDIRE , JF    , IP
      DOUBLE PRECISION COEFF , PI    , SEUIL , CTE1  , CTE2  , AUX4
!
!
      pi = 4.d0 * atan( 1.d0 )
      seuil = 1.d-20
      coeff = sqrt(9.806d0)/(2.d0*pi)
      DO ip = 1,npoin2
        aux1(ip) = 0.d0
        aux2(ip) = 0.d0
      END DO
!
!.....SOMMATIONS SUR LA PARTIE DISCRETISEE DU SPECTRE.
!     """"""""""""""""""""""""""""""""""""""""""""""""
      DO 20 jf = 1,nf
        aux4=dfreq(jf)
!
        DO 15 ip=1,npoin2
          aux3(ip) = 0.d0
   15   CONTINUE
        DO 10 idire = 1, ndire
          DO 5 ip=1,npoin2
            aux3(ip) = aux3(ip) + f(ip,idire,jf)
    5     CONTINUE
   10   CONTINUE
!
        DO 25 ip = 1,npoin2
          aux1(ip)=aux1(ip)+aux3(ip)*sqrt(xk(ip,jf))*aux4
          aux2(ip)=aux2(ip)+aux3(ip)*aux4
   25   CONTINUE
!
   20 CONTINUE
!
!.....PRISE EN COMPTE EVENTUELLE DE LA PARTIE HAUTES FREQUENCES.
!     """"""""""""""""""""""""""""""""""""""""""""""""""""""""""
      IF (tailf.GT.1.d0) THEN
        cte1=freq(nf)**2/(tailf-2.d0)/coeff
        cte2=freq(nf)/(tailf-1.d0)
      ELSE
        cte1=0.d0
        cte2=0.d0
      ENDIF
      DO 45 ip=1,npoin2
        aux1(ip) = aux1(ip) + aux3(ip)*cte1
        aux2(ip) = aux2(ip) + aux3(ip)*cte2
   45 CONTINUE
!
!.....CALCUL DU NOMBRE D'ONDE MOYEN.
!     """"""""""""""""""""""""""""""
      DO 50 ip=1,npoin2
        IF (aux2(ip).LT.seuil) THEN
          xkmoy(ip) = 1.d0
        ELSE
          xkmoy(ip) = (aux1(ip)/aux2(ip))**2
        ENDIF
   50 CONTINUE
!
      RETURN
      END