fdissk.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE fdissk
!                       *****************
     &  (fdk,  npoin2, ndire,fs,ztel,nz,hsmjt,fznorm,nf)
! WAVE-ENHANCED MIXING
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FS             |-->| VARIANCE DENSITY DIRECTIONAL SPECTRUM
!| FDK            |<--|
!| FZNORM               WORK ARRAY
!| HSMJT                WORK ARRAY
!| NF             |-->| NUMBER OF FREQUENCIES
!| NDIRE          |-->| NUMBER OF DIRECTIONS
!| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
!| NZ             |-->| NUMBER OF PLAN IN TELEMAC3D
!| XK             |-->| DISCRETIZED WAVE NUMBER
!| ZTEL           |-->| ELEVATION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      USE bief
      USE declarations_tomawac, ONLY : deupi,gravit,dfreq,depth,betabr
      USE interface_tomawac, ex_fdissk => fdissk

      IMPLICIT NONE

!.....VARIABLES IN ARGUMENT
!     """"""""""""""""""""
      INTEGER, INTENT(IN)  :: NZ
      INTEGER, INTENT(IN) :: NPOIN2, NDIRE, NF
      DOUBLE PRECISION, INTENT(IN) :: FS(npoin2,ndire,nf)
      DOUBLE PRECISION, INTENT(IN) :: HSMJT(npoin2)
      DOUBLE PRECISION, INTENT(INOUT) :: FDK(npoin2,nz)
      DOUBLE PRECISION, INTENT(IN) :: ZTEL(npoin2,nz)
      DOUBLE PRECISION, INTENT(INOUT) :: FZNORM(npoin2)
!     """""""""""""""""
!.....LOCAL VARIABLES
!     """""""""""""""""
      INTEGER  JP    , JF    , IP,  INZ
      DOUBLE PRECISION DTETAR, AUX1,AUXZ
!
      deupi=6.283185307d0
      IF (ndire.EQ.0) THEN
        WRITE(lu,*) 'FDISSK : NDIRE DIR eq 0 '
        CALL plante(1)
      ENDIF
      dtetar=deupi/dble(ndire)

      DO ip=1,npoin2
        fznorm(ip) = 0.d0
        DO inz=1,nz
          fdk(ip,inz) = 0.d0
        ENDDO
      ENDDO

      DO ip=1,npoin2
        DO inz=1,nz
          auxz=(ztel(ip,nz)-ztel(ip,1))
!TYPE II
          IF (hsmjt(ip) .NE.0) THEN
            fznorm(ip)=fznorm(ip)+(1.d0-tanh(sqrt(2.d0)
     & /(1.2d0*hsmjt(ip))*((depth(ip))-ztel(ip,inz)))
     & **2.d0)*auxz
          ENDIF

!TYPE I
!           FZNORM(IP,NZ)=FZNORM(IP,NZ)+(COSH(SQRT(2.D0)
!      & /(1.2D0*HSMJT(IP))*(ZTEL(IP,INZ)-ZFJ(IP))))*AUXZ

        ENDDO
      ENDDO
!
      DO jp=1,ndire
        DO jf=1,nf
          aux1=dfreq(jf)*dtetar
          DO ip=1,npoin2
            IF (fznorm(ip).NE.0) THEN
              DO inz=1,nz
!   type II shape
                fdk(ip,inz)=fdk(ip,inz)+(0.03d0
     & *(1.d0-tanh(sqrt(2.d0)/(1.2d0*hsmjt(ip))
     & *((depth(ip))-ztel(ip,inz)))**2.d0)/fznorm(ip)
     & *depth(ip)*hsmjt(ip)/sqrt(2.d0)*(fs(ip,jp,jf)*abs(betabr(ip))
     & *gravit)**(1./3.))*aux1
              ENDDO
            ENDIF
          ENDDO
        ENDDO
      ENDDO

! !
! ! type I shape

!
!             FDK(IP,INZ)=FDK(IP,INZ)+(0.03D0
!      & *(COSH(SQRT(2.D0)/(1.2D0*HSMJT(IP))
!      & *(ZTEL(IP,INZ)-ZFJ(IP))))/(FZNORM(IP,NZ))*DEPTH1(IP)
!      & *HSMJT(IP)/SQRT(2.D0)*(FS(IP,JP,JF)*ABS(BETA(IP))
!      & *GRAVIT)**(1./3.))*AUX1

      RETURN
      END