vitfon.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\vitfon.f
00002 !
00057                      SUBROUTINE VITFON
00058 !                    *****************
00059 !
00060      &(UWBM,F, XK , DEPTH , DFREQ , NF    , NPOIN2, NPLAN ,BETA  )
00061 !
00062 !***********************************************************************
00063 ! TOMAWAC   V6P1                                   29/06/2011
00064 !***********************************************************************
00065 !
00066 !
00067 !
00068 !
00069 !
00070 !
00071 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00072 !| BETA           |<->| WORK TABLE
00073 !| DEPTH          |-->| WATER DEPTH
00074 !| DFREQ          |-->| FREQUENCY STEPS BETWEEN DISCRETIZED FREQUENCIES
00075 !| F              |-->| VARIANCE DENSITY DIRECTIONAL SPECTRUM
00076 !| NF             |-->| NUMBER OF FREQUENCIES
00077 !| NPLAN          |-->| NUMBER OF DIRECTIONS
00078 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00079 !| UWBM           |<--| MAXIMUM ORBITAL VELOCITY NEAR THE BOTTOM
00080 !| XK             |-->| DISCRETIZED WAVE NUMBER
00081 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00082 !
00083       USE DECLARATIONS_TOMAWAC, ONLY : DEUPI,GRAVIT
00084 !
00085       IMPLICIT NONE
00086 !
00087 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00088 !
00089       INTEGER, INTENT(IN)             :: NF,NPLAN,NPOIN2
00090       DOUBLE PRECISION, INTENT(INOUT) :: UWBM(NPOIN2),BETA(NPOIN2)
00091       DOUBLE PRECISION, INTENT(IN)    :: F(NPOIN2,NPLAN,NF)
00092       DOUBLE PRECISION, INTENT(IN)    :: XK(NPOIN2,NF)
00093       DOUBLE PRECISION, INTENT(IN)    :: DEPTH(NPOIN2),DFREQ(NF)
00094 !
00095 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00096 !
00097       INTEGER  IP    , JP    , JF
00098       DOUBLE PRECISION DTETAR, DEUKD , COEF
00099 !
00100       INTRINSIC SQRT,SINH,MIN
00101 !
00102 !-----------------------------------------------------------------------
00103 !
00104       DTETAR=DEUPI/FLOAT(NPLAN)
00105 !
00106       DO IP = 1,NPOIN2
00107         UWBM(IP) = 0.D0
00108       ENDDO
00109 !
00110 !     SUMS UP THE DISCRETISED PART OF THE SPECTRUM
00111 !
00112       DO JF = 1,NF
00113         COEF=2.D0*GRAVIT*DFREQ(JF)*DTETAR
00114         DO IP = 1,NPOIN2
00115           DEUKD = MIN(2.D0*DEPTH(IP)*XK(IP,JF),7.D2)
00116           BETA(IP) = COEF*XK(IP,JF)/SINH(DEUKD)
00117         ENDDO
00118         DO JP = 1,NPLAN
00119           DO IP=1,NPOIN2
00120             UWBM(IP) = UWBM(IP) + F(IP,JP,JF)*BETA(IP)
00121           ENDDO
00122         ENDDO
00123       ENDDO
00124 !
00125       DO IP=1,NPOIN2
00126         UWBM(IP) = SQRT(UWBM(IP))
00127       ENDDO
00128 !
00129 !-----------------------------------------------------------------------
00130 !
00131       RETURN
00132       END

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