predif.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE predif
!                       *****************
!
     &(cx    , cy    , ikle2 , ifabor, elt   , eta   , xk    ,
     & cg    , itr01 , npoin3, npoin2, nelem2, ndire , nf    ,
     & couran, f     , rx    , ry    , rxx   , ryy   , neigb )
!
!***********************************************************************
! TOMAWAC   V6P3                                   25/06/2012
!***********************************************************************
!
!brief    PREPARES DIFFRACTION.
!+
!+            COMPUTES THE ADVECTION FIELD; TRACES BACK THE
!+                CHARACTERISTICS.
!
!history  E. KRIEZI (LNH)
!+        04/12/2006
!+        V5P5
!+
!
!history  G.MATTAROLO (EDF - LNHE)
!+        23/06/2012
!+        V6P2
!+   Modification for V6P2
!+   Taking into account both Mean Sloe Equation model (Berkhoff,1972)
!+      and Revised Mild Slope Equation model (Porter,2003)
!
!history  J-M HERVOUET (EDF R&D, LNHE)
!+        21/03/2013
!+        V6P3
!+   Call CONWAC added before call to DIFFRAC and DIFFRAC does only the
!+   modification of the velocities.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| CG             |-->| DISCRETIZED GROUP VELOCITY
!| COURAN         |-->| LOGICAL INDICATING IF THERE IS A CURRENT
!| CX             |<->| ADVECTION FIELD ALONG X(OR PHI)
!| CY             |<->| ADVECTION FIELD ALONG Y(OR LAMBDA)
!| ELT            |<->| NUMBERS OF THE ELEMENTS 2D OF THE
!|                |   | POINTS TO BE ADVECTED
!| ETA            |<->| NUMBERS OF THE LAYERS OF THE
!|                |   | POINTS TO BE ADVECTED
!| F              |<->| VARIANCE DENSITY DIRECTIONAL SPECTRUM
!| IFABOR         |-->| ELEMENTS BEHIND THE EDGES OF A TRIANGLE
!|                |   | IF NEGATIVE OR ZERO, THE EDGE IS A LIQUID,
!|                |   | SOLID OR PERIODIC BOUNDARY
!| IKLE2          |-->| TRANSITION BETWEEN LOCAL AND GLOBAL NUMBERING
!|                |   | OF THE 2D MESH
!| ITR01          |<->| WORK TABLE
!| NEIGB          |-->| NEIGHBOUR POINTS FOR MESHFREE METHOD
!| NELEM2         |-->| NUMBER OF ELEMENTS IN 2D MESH
!| NF             |-->| NUMBER OF FREQUENCIES
!| NDIRE          |-->| NUMBER OF DIRECTIONS
!| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
!| NPOIN3         |-->| NPOIN2*NDIRE
!| RX             |-->| ARRAY USED IN THE MESHFREE TECHNIQUE
!| RXX            |-->| ARRAY USED IN THE MESHFREE TECHNIQUE
!| RY             |-->| ARRAY USED IN THE MESHFREE TECHNIQUE
!| RYY            |-->| ARRAY USED IN THE MESHFREE TECHNIQUE
!| SHP            |<->| BARYCENTRIC COORDINATES OF THE NODES IN
!|                |   | THEIR ASSOCIATED 2D ELEMENT "ELT"
!| SHZ            |<->| BARYCENTRIC COORDINATES ALONG TETA OF THE
!|                |   | NODES IN THEIR ASSOCIATED LAYER "ETA"
!| SINTET         |-->| SINE OF TETA ANGLE
!| TETA           |-->| DISCRETIZED DIRECTIONS
!| TRA01          |<->| WORK TABLE
!| XK             |-->| DISCRETIZED WAVE NUMBER
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief
      USE declarations_tomawac, ONLY : promin, steta, sct, dt, depth, 
     &             mesh3d, mesh  ,sshp1, sshz, tb, ielm3, isub, maxnsp
      USE declarations_special
      USE interface_tomawac, ex_predif => predif
      IMPLICIT NONE
!
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER,INTENT(IN)    :: NPOIN3,NPOIN2,NELEM2,NDIRE,NF
      INTEGER,INTENT(IN)    :: IKLE2(nelem2,3)
      INTEGER,INTENT(IN)    :: NEIGB(npoin2,maxnsp)
      INTEGER,INTENT(INOUT) :: IFABOR(nelem2,7)
      INTEGER,INTENT(INOUT) :: ELT(npoin3,nf), ETA(npoin3,nf)
      INTEGER,INTENT(INOUT) :: ITR01(npoin3,3)
      DOUBLE PRECISION,INTENT(IN) :: RX(maxnsp,npoin2),RY(maxnsp,npoin2)
      DOUBLE PRECISION,INTENT(IN) :: RXX(maxnsp,npoin2)
      DOUBLE PRECISION,INTENT(IN) :: RYY(maxnsp,npoin2)
      DOUBLE PRECISION,INTENT(IN) :: XK(npoin2,nf),CG(npoin2,nf)
      DOUBLE PRECISION,INTENT(IN) :: F(npoin2,ndire,nf)
      LOGICAL,INTENT(IN) :: COURAN
      TYPE(bief_obj), INTENT(INOUT) :: CX,CY
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER IFF,IEL,I1,I2,I3
      TYPE(bief_obj) :: BID
      TYPE(slvcfg)   :: SLVBID
      INTEGER :: SIZ_ISUB, JF_ISUB

!
!----------------------------------------------------------------------
!
      IF (.NOT.couran) THEN
!
!       RELATIVE = ABSOLUTE => ADVECTION IN 3D
!       SEPARATES OUT THE FREQUENCIES
!
        DO iff=1,nf
!
!         COMPUTES THE ADVECTION FIELD
!
          CALL conwac
     &(cx%R, cy%R, sct%R, xk, cg, npoin2, ndire, iff, nf)
!
!         MODIFIESS THE ADVECTION FIELD WITH DIFFRACTION
!
          CALL diffrac
     &  (cx%R, cy%R, sct%R, xk, cg, npoin2, ndire, iff, nf,
     &   f, rx, ry, rxx, ryy, neigb)
!
          DO iel=1,nelem2
            i1=ikle2(iel,1)
            i2=ikle2(iel,2)
            i3=ikle2(iel,3)
            IF(depth(i1).LT.promin.AND.depth(i2).LT.promin.AND.
     &         ifabor(iel,1).GT.0) ifabor(iel,1)=-1
            IF(depth(i2).LT.promin.AND.depth(i3).LT.promin.AND.
     &         ifabor(iel,2).GT.0) ifabor(iel,2)=-1
            IF(depth(i3).LT.promin.AND.depth(i1).LT.promin.AND.
     &         ifabor(iel,3).GT.0) ifabor(iel,3)=-1
          ENDDO
!
          WRITE(lu,*) 'FREQUENCE :',iff
!
          IF(ncsize.GT.1) THEN
            siz_isub = npoin3
            jf_isub = iff
          ELSE
            siz_isub = 1
            jf_isub = 1
          ENDIF
          CALL charac(sshz%ADR(iff)%P,sshz%ADR(iff)%P,0,
     &                cx,cy,sct,sct,steta,steta,dt,mesh3d%IFABOR,ielm3,
     &                npoin2,ndire,1,1,.false.,sshp1%ADR(iff)%P,
     &                sshz%ADR(iff)%P,sshz%ADR(iff)%P,tb,
     &                elt(1,iff),eta(1,iff),eta(1,iff),itr01,
     &                isub((jf_isub-1)*siz_isub+1:jf_isub*siz_isub),
     &                itr01(1,2),mesh3d,nelem2,nelem2,
     &                mesh%IKLE,
     &                mesh%SURDET,bid,bid,slvbid,0.d0,.false.,3,bid,1,
!                     A POSTERIORI INTERPOLATION
     &                .true.,
!                     AND PERIODICITY
     &                .true.)
!
        ENDDO !  IFF
!
      ELSE
!
!   ---------------------------------------------------------------
!
!   IN A RELATIVE REFERENCE SYSTEM => ADVECTION IN 4D
!   IT IS NO LONGER POSSIBLE TO SEPARATE THE FREQUENCIES OUT
        WRITE(lu,*) ''
        WRITE(lu,*) '***************************************'
        WRITE(lu,*) ' ATTENTION : DIFFRACTION IS NOT TAKEN  '
        WRITE(lu,*) ' INTO ACCOUNT IF CURRENTS OR VARYING   '
        WRITE(lu,*) ' WATER LEVELS ARE CONSIDERED           '
        WRITE(lu,*) ' ONE HAS TO CHOOSE BETWEEN CURRENT AND '
        WRITE(lu,*) ' DIFFRACTION                           '
        WRITE(lu,*) '***************************************'
        CALL plante(1)
        stop
!
      ENDIF
!
!----------------------------------------------------------------------
!
      RETURN
      END