transf.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE transf
!                   *****************
!
     &( fa    , fr    , xk    , knew  , newf  , newf1 , taux1 , taux2 ,
     &  npoin2, ndire , nf   )
!
!***********************************************************************
! TOMAWAC   V6P1                                   28/06/2011
!***********************************************************************
!
!brief    CONVERTS A SPECTRUM SPECIFIED IN RELATIVE
!+                FREQUENCY FR(-,-,-) INTO A SPECTRUM IN ABSOLUTE
!+                FREQUENCY FA(-,-,-).
!
!history  M. BENOIT (LNHE)
!+        12/01//2006
!+        V5P6
!+
!
!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)
!+        28/06/2011
!+        V6P1
!+   Translation of French names of the variables in argument
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| COSTET         |-->| COSINE OF TETA ANGLE
!| DFREQ          |-->| FREQUENCY STEPS BETWEEN DISCRETIZED FREQUENCIES
!| FA             |<--| DIRECTIONAL SPECTRUM IN ABSOLUTE FREQUENCIES
!| FR             |-->| DIRECTIONAL SPECTRUM IN RELATIVE FREQUENCIES
!| FREQ           |-->| DISCRETIZED FREQUENCIES
!| GRADEB         |-->| N.OF FIRST ITERATION FOR GRAPHICS PRINTOUTS
!| GRAPRD         |-->| PERIOD FOR GRAPHIC PRINTOUTS
!| KNEW           |<->| WORK TABLE
!| LT             |-->| NUMBER OF THE TIME STEP CURRENTLY SOLVED
!| NEWF           |<->| WORK TABLE
!| NEWF1          |<->| WORK TABLE
!| NF             |-->| NUMBER OF FREQUENCIES
!| NDIRE          |-->| NUMBER OF DIRECTIONS
!| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
!| RAISF          |-->| RAISON FREQUENTIELLE
!| SINTET         |-->| SINE OF TETA ANGLE
!| TAUX1          |<->| WORK TABLE
!| TAUX2          |<->| WORK TABLE
!| UC             |-->| CURRENT VELOCITY ALONG X AT THE MESH POINTS
!| VC             |-->| CURRENT VELOCITY ALONG Y AT THE MESH POINTS
!| XK             |-->| DISCRETIZED WAVE NUMBER
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_tomawac, ONLY : freq, dfreq, costet, sintet,
     &       usdpi, uc, vc, raisf
      USE bief, ONLY: ov
!
      USE interface_tomawac, ex_transf => transf
      IMPLICIT NONE
!
!.....VARIABLES IN ARGUMENT
!     """"""""""""""""""""
      INTEGER, INTENT(IN)    :: NPOIN2, NDIRE, NF
      INTEGER, INTENT(INOUT) :: KNEW(npoin2),NEWF(npoin2), NEWF1(npoin2)
      DOUBLE PRECISION, INTENT(IN)    :: FR(npoin2,ndire,nf)
      DOUBLE PRECISION, INTENT(IN)    :: XK(npoin2,nf)
      DOUBLE PRECISION, INTENT(INOUT) :: TAUX1(npoin2),TAUX2(npoin2)
      DOUBLE PRECISION, INTENT(INOUT) :: FA(npoin2,ndire,nf)
!
!.....LOCAL VARIABLES
!     """""""""""""""""
      INTEGER          IP    , JP    , JF   , NEWM  , NEWM1 , KH
      DOUBLE PRECISION F0    , UK    , AUXI , Z
      DOUBLE PRECISION FNEW  , UNSLRF
!
!-----------------------------------------------------------------------
!     CHANGES ONLY THE END DATES
!-----------------------------------------------------------------------
!!
!-----------------------------------------------------------------------
!
      f0=freq(1)
      unslrf=1.d0/log(raisf)
!
      CALL ov('X=C     ', x=fa, c=0.d0, dim1=npoin2*ndire*nf)
!
      DO jf=1,nf
        DO jp=1,ndire
          DO ip=1,npoin2
!           ---------------------------------------------------------
!           COMPUTES THE DIFFERENCE BETWEEN ABSOLUTE AND RELATIVE FREQUENCIES
!                                            -> ->
!                 Z = FREQ_ABS - FREQ_REL = (K .U)/(2.PI)
!           THE SPECTRUM IS PROJECTED ONTO THE ABSOLUTE FREQUENCIES
!           ONLY IF THE RELATIVE VARIATION Z/FREQ_REL IS SIGNIFICANT
!           ---------------------------------------------------------
            uk=sintet(jp)*uc(ip)+costet(jp)*vc(ip)
!
            z=uk*xk(ip,jf)*usdpi
!
            IF(abs(z)/freq(jf).LT.1.d-3) THEN
              knew(ip)=jp
              newf(ip)=jf
              newf1(ip)=-1
              taux1(ip)=fr(ip,jp,jf)
              taux2(ip)=0.d0
            ELSE
!
!             -------------------------------------------------------
!             COMPUTES FNEW AND KNEW
!             -------------------------------------------------------
!
              fnew = freq(jf)+z
              IF(fnew.GT.0.d0) THEN
                knew(ip)=jp
              ELSE
                knew(ip)=1+mod(jp+ndire/2-1,ndire)
                fnew=0.d0
              ENDIF
!
!             -------------------------------------------------------
!             COMPUTES NEWF: INDEX OF THE DISCRETISED FREQUENCY
!             IMMEDIATELY LOWER THAN FNEW
!             -------------------------------------------------------
!
              IF(fnew.LT.f0/raisf) THEN
                newf(ip)=-1
              ELSE
                newf(ip)=int(1.d0+log(fnew/f0)*unslrf)
              ENDIF
!
!             -------------------------------------------------------
!             COMPUTES THE COEFFICIENTS AND INDICES FOR THE PROJECTION
!             -------------------------------------------------------
!
              IF((newf(ip).LT.nf).AND.(newf(ip).GE.1)) THEN
                newf1(ip)=newf(ip)+1
                auxi=fr(ip,jp,jf)*dfreq(jf)
     &               /(freq(newf1(ip))-freq(newf(ip)))
                taux1(ip)=auxi*(freq(newf1(ip))-fnew)/dfreq(newf(ip))
                taux2(ip)=auxi*(fnew-freq(newf(ip)))/dfreq(newf1(ip))
              ELSEIF (newf(ip).EQ.0) THEN
                auxi=fr(ip,jp,jf)*dfreq(jf)/(f0*(1.d0-1.d0/raisf))
                taux2(ip)=auxi*(fnew-f0/raisf)/dfreq(1)
                newf(ip)=-1
                newf1(ip)= 1
              ELSEIF (newf(ip).EQ.nf) THEN
                auxi=fr(ip,jp,jf)*dfreq(jf)/(freq(nf)*(raisf-1.d0))
                taux1(ip)=auxi*(freq(nf)*raisf-fnew)/dfreq(nf)
                newf1(ip)=-1
              ELSE
                newf(ip)=-1
                newf1(ip)=-1
              ENDIF
!
            ENDIF
!
          ENDDO
!
!
!         -------------------------------------------------------
!         PROJECTS THE SPECTRUM
!         -------------------------------------------------------
!
          DO ip=1,npoin2
            newm =newf(ip)
            newm1=newf1(ip)
            kh=knew(ip)
            IF(newm .NE.-1) fa(ip,kh,newm )=fa(ip,kh,newm )+taux1(ip)
            IF(newm1.NE.-1) fa(ip,kh,newm1)=fa(ip,kh,newm1)+taux2(ip)
          ENDDO
!
        ENDDO
!
      ENDDO
!
      RETURN
      END