propa.f

Go to the documentation of this file.

!                   ****************
                    SUBROUTINE propa
!                   ****************
!
     &(f,     b,  elt,    eta,   fre,   npoin3, npoin2,
     & ndire, nf, couran, tra01)
!
!***********************************************************************
! TOMAWAC   V7P0
!***********************************************************************
!
!brief    ADVECTION STEP.
!+                INTERPOLATES AT THE FOOT OF THE CHARACTERISTICS.
!
!history  F. MARCOS (LNH)
!+        05/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  J-M HERVOUET (EDF LAB, LNHE)
!+        25/11/2014
!+        V7P0
!+   Bug corrected: size of array WSHZ for POST_INTERP was not correct
!+   in the call, as TRA01(1,2), TRA01(1,4) was needed.
!+   Moreover the real size of TRA01 is (NPOIN3,6), not (NPOIN3,8), see
!+   point_tomawac.f. Intent completed.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| B              |-->| JACOBIAN TO TRANSFORM N(KX,KY) INTO F(FR,TETA)
!| COURAN         |-->| LOGICAL INDICATING IF THERE IS A CURRENT
!| ELT            |-->| NUMBERS OF THE ELEMENTS 2D OF THE
!|                |   | POINTS TO BE ADVECTED
!| ETA            |-->| NUMBERS OF THE LAYERS OF THE
!|                |   | POINTS TO BE ADVECTED
!| F              |<->| WAVE ACTION DENSITY OR VARIANCE DENSITY
!|                |   | DIRECTIONAL SPECTRUM
!| FRE            |-->| NUMBER OF THE FREQUENCIES OF THE
!|                |   | POINTS TO BE ADVECTED
!| IKLE_EXT       |-->| TRANSITION BETWEEN LOCAL AND GLOBAL NUMBERING
!|                |   | OF THE 2D MESH (IN AN EXTENDED FORM)
!| 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"
!| TRA01          |<->| WORK TABLE
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief
      USE interface_tomawac, ex_propa => propa
      USE streamline, ONLY : post_interp
      USE declarations_telemac, ONLY : namecode
      USE declarations_tomawac, ONLY : sshp1, sshz, sshf, t3_01, t3_02,
     &     ststot, itr01, ikle_ext, isub, mesh3d
!     STSTOT IS HERE A WORK TABLE
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: NPOIN3,NPOIN2,NDIRE,NF
!
      DOUBLE PRECISION, INTENT(INOUT) :: F(npoin2,ndire,nf)
      DOUBLE PRECISION, INTENT(IN)    :: B(npoin2,nf)
      DOUBLE PRECISION, INTENT(INOUT) :: TRA01(npoin3,nf)
      INTEGER, INTENT(INOUT) :: ELT(npoin3,nf),ETA(npoin3,nf)
      INTEGER, INTENT(INOUT) :: FRE(*)
      LOGICAL, INTENT(IN)            :: COURAN
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER IFF,I,I3,IDIRE
      INTEGER :: SIZ_ISUB, SIZ_FRE, JF_ISUB, JF_FRE
      INTEGER, ALLOCATABLE :: TMP_ISUB(:)
!
!----------------------------------------------------------------------
!
!     WITH CURRENT ALL FUNCTION MUST BE BUILT BEFORE INTERPOLATION
!     AS ALL FREQUENCIES WILL BE USED TOGETHER
!
      IF(couran) THEN
        DO iff=1,nf
          DO idire=1,ndire
            DO i=1,npoin2
              i3=i+(idire-1)*npoin2+(iff-1)*npoin3
              ststot%R(i3)=f(i,idire,iff)*b(i,iff)
            ENDDO
          ENDDO
        ENDDO
      ENDIF
!
!     NOW FREQUENCY PER FREQUENCY
!
      DO iff=1,nf
!
!       COPY OF F*B INTO T3_01=TRA02 ?
!
        IF(.NOT.couran) THEN
          DO idire=1,ndire
            DO i=1,npoin2
              i3=i+(idire-1)*npoin2
              ststot%R(i3)=f(i,idire,iff)*b(i,iff)
            ENDDO
          ENDDO
        ENDIF
!
        IF(ncsize.GT.1) THEN
          siz_isub = npoin3
          jf_isub = iff
        ELSE
          siz_isub = 1
          jf_isub = 1
        ENDIF
        IF(couran.OR.namecode(1:7).EQ.'TELEMAC') THEN
          siz_fre = npoin3
          jf_fre = iff
        ELSE
          siz_fre = 1
          jf_fre = 1
        ENDIF
        ! Memory optimisation (intel debug)
        ALLOCATE(tmp_isub(siz_isub))
        tmp_isub = isub((jf_isub-1)*siz_isub+1:jf_isub*siz_isub)
        CALL post_interp(ststot,t3_02,sshp1%ADR(iff)%P%R,
     &                   sshz%ADR(iff)%P%R,sshf%ADR(iff)%P%R,
     &                   ikle_ext%I,ikle_ext%DIM1,1,
     &                   npoin2,elt(1,iff),eta(1,iff),
     &                   fre((jf_fre-1)*siz_fre+1:jf_fre*siz_fre),
     &                   tmp_isub,
     &                   3,ndire,41,npoin3,
     &                   npoin2,tra01,tra01(1,4),
     &                   t3_01%R,itr01(1:npoin3),
     &                   itr01(npoin3+1:2*npoin3),
     &                   itr01(2*npoin3+1:3*npoin3),
     &                   npoin3,
     &                   .true.,
!                      PERIODICITY
     &                   couran)
!                        4D
        DEALLOCATE(tmp_isub)
!
        IF(ncsize.GT.1) CALL parcom(t3_02,1,mesh3d)
!
!       FINAL COMPUTATION OF F
!
        DO idire=1,ndire
          DO i=1,npoin2
            i3=i+(idire-1)*npoin2
!           MAX(..,0.D0) SEEMS NECESSARY, WHERE F BECOMES < 0 ??
            f(i,idire,iff)=max(t3_02%R(i3)/b(i,iff),0.d0)
          ENDDO
        ENDDO
!
      ENDDO
!
!-----------------------------------------------------------------------
!
      RETURN
      END