vitfon.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE vitfon
!                   *****************
!
     &(vifond, f, xk , nf    , npoin2, ndire )
!
!***********************************************************************
! TOMAWAC   V6P1                                   29/06/2011
!***********************************************************************
!
!brief    COMPUTES THE MAXIMUM ORBITAL VELOCITY NEAR THE BOTTOM
!+               (AVERAGE VELOCITY ON THE SPECTRUM).
!
!history  M. BENOIT
!+        05/07/96
!+        V1P2
!+
!
!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)
!+        29/06/2011
!+        V6P1
!+   Translation of French names of the variables in argument
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| BETA           |<->| WORK TABLE
!| DEPTH          |-->| WATER DEPTH
!| DFREQ          |-->| FREQUENCY STEPS BETWEEN DISCRETIZED FREQUENCIES
!| F              |-->| VARIANCE DENSITY DIRECTIONAL SPECTRUM
!| NF             |-->| NUMBER OF FREQUENCIES
!| NDIRE          |-->| NUMBER OF DIRECTIONS
!| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
!| UWBM           |<--| MAXIMUM ORBITAL VELOCITY NEAR THE BOTTOM
!| XK             |-->| DISCRETIZED WAVE NUMBER
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_tomawac, ONLY : deupi,gravit, dfreq, depth
!
      USE interface_tomawac, ex_vitfon => vitfon
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      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) :: VIFOND(npoin2)
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER  IP    , JP    , JF
      DOUBLE PRECISION DTETAR, DEUKD , COEF , BETAA
!
!-----------------------------------------------------------------------
!
      dtetar=deupi/float(ndire)
!
      DO ip = 1,npoin2
        vifond(ip) = 0.d0
!
!     SUMS UP THE DISCRETISED PART OF THE SPECTRUM
!
        DO jf = 1,nf
          coef=2.d0*gravit*dfreq(jf)*dtetar
          deukd = min(2.d0*depth(ip)*xk(ip,jf),7.d2)
          betaa = coef*xk(ip,jf)/sinh(deukd)
          DO jp = 1,ndire
            vifond(ip) = vifond(ip) + f(ip,jp,jf)*betaa
          ENDDO
        ENDDO
!
        IF (vifond(ip).GE.0) THEN
          vifond(ip) = sqrt(vifond(ip))
        ELSE
          WRITE(*,*) 'VITESSE NEGATIVE'
          CALL plante(0)
        ENDIF
      ENDDO
!
!-----------------------------------------------------------------------
!
      RETURN
      END