prepro.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE prepro
!                   *****************
!
     &( cx    , cy    , ikle2 , ifabor, elt   , eta   , fre   ,
     &  xk    , cg    , itr01 , npoin3, npoin2, nelem2, ndire ,
     &  nf    , couran)
!
!***********************************************************************
! TOMAWAC   V6P3                                   25/06/2012
!***********************************************************************
!
!brief    PREPARES ADVECTION.
!+
!+            COMPUTES THE ADVECTION FIELD; TRACES BACK THE
!+                CHARACTERISTICS.
!
!history  F. MARCOS (LNH)
!+        04/12/95
!+        V1P0
!+
!
!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)
!+        23/06/2011
!+        V6P1
!+   Translation of French names of the variables in argument
!
!history  G.MATTAROLO (EDF - LNHE)
!+        23/06/2012
!+        V6P2
!+   Modifications : possibility of taking into account diffraction
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| 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
!| FRE            |<->| NUMBER OF THE FREQUENCIES OF THE
!|                |   | POINTS TO BE ADVECTED
!| 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
!| ISUB           |<->| ARRIVAL SUB-DOMAIN OF CHARACTERISTICS
!| ITR01          |<->| WORK TABLE
!| MESH           |-->| 2D MESH
!| MESH3D         |-->| 3D MESH
!| 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
!| SHF            |<->| BARYCENTRIC COORDINATES ALONG F OF THE
!|                |   | NODES IN THEIR ASSOCIATED FREQUENCIES "FRE"
!| 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"
!| XK             |-->| DISCRETIZED WAVE NUMBER
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief
      USE interface_tomawac, ex_prepro => prepro
      USE declarations_telemac, ONLY : namecode
!
      USE declarations_tomawac, ONLY : promin, depth, dt, steta, sfr,
     &   sct,scf, sshp1, sshz,  sshf, ielm3, tb, mesh  , mesh3d, sisub
      USE declarations_special
      IMPLICIT NONE
!
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)    :: NPOIN3,NPOIN2,NELEM2,NDIRE,NF
      DOUBLE PRECISION, INTENT(IN) :: XK(npoin2,nf),CG(npoin2,nf)
      INTEGER, INTENT(INOUT) :: ELT(npoin3,nf),ETA(npoin3,nf)
      INTEGER, INTENT(INOUT) :: FRE(*)
      INTEGER, INTENT(IN)    :: IKLE2(nelem2,3)
      INTEGER, INTENT(INOUT) :: ITR01(npoin3,3),IFABOR(nelem2,7)
      LOGICAL, INTENT(IN)    :: COURAN
      TYPE(bief_obj), INTENT(INOUT) :: CX,CY
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER JF,IEL,I1,I2,I3
      TYPE(bief_obj) :: BID
      TYPE(slvcfg) :: SLVBID
      INTEGER :: SIZ_ISUB, SIZ_FRE, JF_ISUB, JF_FRE
      INTEGER, ALLOCATABLE :: TMP_ISUB(:)
!
!----------------------------------------------------------------------
!
      IF(.NOT.couran) THEN
!
!   -------------------------------------------------------------------
!
!   RELATIVE = ABSOLUTE => ADVECTION IN 3D
!   SEPARATES OUT THE FREQUENCIES
!
        DO jf=1,nf
!
!      ---------------------------------------------------------------
!
!      COMPUTES THE ADVECTION FIELD
!
          CALL conwac
     &( cx%R, cy%R, sct%R, xk, cg, npoin2, ndire, jf, nf)
!
!      ----------------------------------------------------------------
!
          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 :',jf
!
          IF(ncsize.GT.1) THEN
            siz_isub = npoin3
            jf_isub = jf
          ELSE
            siz_isub = 1
            jf_isub = 1
          ENDIF
          ! Manually creating contiguous temporary array
          ALLOCATE(tmp_isub(siz_isub))
          tmp_isub = sisub%I((jf_isub-1)*siz_isub+1:jf_isub*siz_isub)
          CALL charac(sshz%ADR(jf)%P,sshz%ADR(jf)%P,0,
     &            cx,cy,sct,sct,steta,steta,dt,mesh3d%IFABOR,ielm3,
     &            npoin2,ndire,1,1,.false.,sshp1%ADR(jf)%P,
     &            sshz%ADR(jf)%P,sshz%ADR(jf)%P,tb,
     &            elt(1:npoin3,jf),eta(1:npoin3,jf),eta(1:npoin3,jf),
     &            itr01(1:npoin3,1),
     &            tmp_isub,
     &            itr01(1:npoin3,2),mesh3d,nelem2,nelem2,
     &            mesh%IKLE,
     &            mesh%SURDET,
     &            bid,bid,slvbid,0.d0,.false.,3,bid,1,
!                 A POSTERIORI INTERPOLATION
     &            .true.,
!                 AND PERIODICITY
     &            .true.)
          sisub%I((jf_isub-1)*siz_isub+1:jf_isub*siz_isub) = tmp_isub
          DEALLOCATE(tmp_isub)
!
        ENDDO ! JF
!
      ELSE
!
!   ---------------------------------------------------------------
!
!   IN A RELATIVE REFERENCE SYSTEM => ADVECTION IN 4D
!   IT IS NO LONGER POSSIBLE TO SEPARATE THE FREQUENCIES OUT
!
        DO jf=1,nf
!
          CALL conw4d(cx%R,cy%R,sct%R,scf%R, xk,cg,npoin2,ndire,
     &                jf,nf)
!
        ENDDO
!
        DO jf=1,nf
!
          IF(ncsize.GT.1) THEN
            siz_isub = npoin3
            jf_isub = jf
          ELSE
            siz_isub = 1
            jf_isub = 1
          ENDIF
          IF(couran.OR.namecode(1:7).EQ.'TELEMAC') THEN
            siz_fre = npoin3
            jf_fre = jf
          ELSE
            siz_fre = 1
            jf_fre = 1
          ENDIF
          ! Manually creating contiguous temporary array
          ALLOCATE(tmp_isub(siz_isub))
          tmp_isub = sisub%I((jf_isub-1)*siz_isub+1:jf_isub*siz_isub)
          CALL charac(sshz%ADR(jf)%P,sshz%ADR(jf)%P,0,
     &                cx,cy,sct,scf,steta,sfr,dt,mesh3d%IFABOR,ielm3,
     &                npoin2,ndire,jf,nf,.false.,sshp1%ADR(jf)%P,
     &                sshz%ADR(jf)%P,sshf%ADR(jf)%P,tb,
     &                elt(1:npoin3,jf),eta(1:npoin3,jf),
     &                fre((jf_fre-1)*siz_fre+1:jf_fre*siz_fre),
     &                itr01(1:npoin3,1),
     &                tmp_isub,
     &                itr01(1:npoin3,2),mesh3d,nelem2,nelem2,
     &                mesh%IKLE, mesh%SURDET,
     &                bid,bid,slvbid,0.d0,.false.,3,bid,1,
!                     A POSTERIORI INTERPOLATION
     &                .true.,
!                     AND PERIODICITY
     &                .true.,
!                     AND 4D
     &                .true.)
          sisub%I((jf_isub-1)*siz_isub+1:jf_isub*siz_isub) = tmp_isub
          DEALLOCATE(tmp_isub)
!
        ENDDO
!
      ENDIF
!
!----------------------------------------------------------------------
!
      RETURN
      END