frem01.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE frem01
!                   *****************
!
     &( fm01  , f     , nf    , ndire , npoin2)
!
!***********************************************************************
! TOMAWAC   V6P1                                   15/06/2011
!***********************************************************************
!
!brief    COMPUTES THE MEAN SPECTRAL FREQUENCY FM01 FOR ALL
!+                THE NODES IN THE 2D MESH. THIS FREQUENCY IS DEFINED
!+                FROM THE M0 AND M1 SPECTRAL MOMENTUM.
!code
!+                     SOMME(  F(FREQ,TETA)*FREQ DFREQ DTETA  )
!+             FM01 =  ----------------------------------------
!+                     SOMME(  F(FREQ,TETA) DFREQ DTETA  )
!
!note     THE HIGH-FREQUENCY PART OF THE SPECTRUM IS ONLY CONSIDERED
!+         IF THE TAIL FACTOR (TAILF) IS STRICTLY GREATER THAN 2.
!
!history  P. THELLIER; M. BENOIT
!+        09/02/95
!+        V1P0
!+   CREATED
!
!history  M. BENOIT
!+        05/07/96
!+        V1P2
!+   MODIFIED
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!history  G.MATTAROLO (EDF - LNHE)
!+        15/06/2011
!+        V6P1
!+   Translation of French names of the variables in argument
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| AUX1           |<->| WORK TABLE
!| AUX2           |<->| WORK TABLE
!| DFREQ          |-->| FREQUENCY STEPS BETWEEN DISCRETIZED FREQUENCIES
!| F              |-->| VARIANCE DENSITY DIRECTIONAL SPECTRUM
!| FM01           |<--| MEAN FREQUENCIES F01
!| FREQ           |-->| DISCRETIZED FREQUENCIES
!| NF             |-->| NUMBER OF FREQUENCIES
!| NDIRE          |-->| NUMBER OF DIRECTIONS
!| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
!| TAILF          |-->| SPECTRUM QUEUE FACTOR
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_tomawac, ONLY : deupi, freq, dfreq, tailf
!
      USE interface_tomawac, ex_frem01 => frem01
      IMPLICIT NONE
!
!.....VARIABLES IN ARGUMENT
!     """"""""""""""""""""
      INTEGER,          INTENT(IN) ::  NF    , NDIRE , NPOIN2
      DOUBLE PRECISION, INTENT(IN) :: F(npoin2,ndire,nf)
      DOUBLE PRECISION, INTENT(INOUT) :: FM01(npoin2)
!
!.....LOCAL VARIABLES
!     """""""""""""""""
      INTEGER  JP    , JF    , IP
      DOUBLE PRECISION SEUIL , DTETAR, AUX3  , AUX4, AUX1, AUX2
!
!
      seuil = 1.d-20
      dtetar= deupi/dble(ndire)
      DO ip = 1,npoin2
        aux1 = 0.d0
        aux2 = 0.d0
!
!-----C-------------------------------------------------------C
!-----C SUMS UP THE CONTRIBUTIONS FOR THE DISCRETISED PART OF THE SPECTRUM     C
!-----C-------------------------------------------------------C
        DO jf = 1,nf-1
          aux3=dtetar*dfreq(jf)
          aux4=aux3*freq(jf)
          DO jp = 1,ndire
            aux1 = aux1 + f(ip,jp,jf)*aux4
            aux2 = aux2 + f(ip,jp,jf)*aux3
          ENDDO                ! JP
        ENDDO                   ! JF
!
!-----C-------------------------------------------------------------C
!-----C (OPTIONALLY) TAKES INTO ACCOUNT THE HIGH-FREQUENCY PART     C
!-----C-------------------------------------------------------------C
        IF (tailf.GT.2.d0) THEN
          aux3=dtetar*(dfreq(nf)+freq(nf)/(tailf-1.d0))
          aux4=dtetar*(dfreq(nf)+freq(nf)/(tailf-2.d0))*freq(nf)
        ELSE
          aux3=dtetar*dfreq(nf)
          aux4=aux3*freq(nf)
        ENDIF
        DO jp = 1,ndire
          aux1 = aux1 + f(ip,jp,nf)*aux4
          aux2 = aux2 + f(ip,jp,nf)*aux3
        ENDDO                   ! JP
!
!-----C-------------------------------------------------------------C
!-----C COMPUTES THE MEAN FREQUENCY                                 C
!-----C-------------------------------------------------------------C
        IF (aux2.LT.seuil) THEN
          fm01(ip) = seuil
        ELSE
          fm01(ip) = aux1/aux2
        ENDIF
      ENDDO ! IP
!
      RETURN
      END