eftinvad_mod.F90 Source File


This file depends on

sourcefile~~eftinvad_mod.f90~~EfferentGraph sourcefile~eftinvad_mod.f90 eftinvad_mod.F90 sourcefile~abort_trans_mod.f90 abort_trans_mod.F90 sourcefile~eftinvad_mod.f90->sourcefile~abort_trans_mod.f90 sourcefile~tpm_dim.f90 tpm_dim.F90 sourcefile~eftinvad_mod.f90->sourcefile~tpm_dim.f90 sourcefile~tpm_distr.f90 tpm_distr.F90 sourcefile~eftinvad_mod.f90->sourcefile~tpm_distr.f90 sourcefile~tpm_fftw.f90 tpm_fftw.F90 sourcefile~eftinvad_mod.f90->sourcefile~tpm_fftw.f90 sourcefile~tpm_geometry.f90 tpm_geometry.F90 sourcefile~eftinvad_mod.f90->sourcefile~tpm_geometry.f90 sourcefile~tpm_gen.f90 tpm_gen.F90 sourcefile~abort_trans_mod.f90->sourcefile~tpm_gen.f90

Files dependent on this one

sourcefile~~eftinvad_mod.f90~~AfferentGraph sourcefile~eftinvad_mod.f90 eftinvad_mod.F90 sourcefile~eftinv_ctlad_mod.f90 eftinv_ctlad_mod.F90 sourcefile~eftinv_ctlad_mod.f90->sourcefile~eftinvad_mod.f90 sourcefile~einv_trans_ctlad_mod.f90 einv_trans_ctlad_mod.F90 sourcefile~einv_trans_ctlad_mod.f90->sourcefile~eftinv_ctlad_mod.f90 sourcefile~einv_transad.f90 einv_transad.F90 sourcefile~einv_transad.f90->sourcefile~einv_trans_ctlad_mod.f90

Source Code

! (C) Copyright 2001- ECMWF.
! (C) Copyright 2001- Meteo-France.
! 
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
! In applying this licence, ECMWF does not waive the privileges and immunities
! granted to it by virtue of its status as an intergovernmental organisation
! nor does it submit to any jurisdiction.
! 


MODULE EFTINVAD_MOD
CONTAINS
SUBROUTINE EFTINVAD(PREEL,KFIELDS,KGL)

!**** *EFTINVAD - Inverse Fourier transform - adjoint

!     Purpose. Routine for Fourier to Grid-point transform
!     --------

!**   Interface.
!     ----------
!        CALL EFTINVAD(..)

!        Explicit arguments :  PREEL   - Fourier/grid-point array
!        --------------------  KFIELDS - number of fields

!     Method.
!     -------

!     Externals.  FFT992 - FFT routine
!     ----------

!     Author.
!     -------
!        Mats Hamrud *ECMWF*

!     Modifications.
!     --------------
!        Original : 00-03-03
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        D. Degrauwe  (Feb 2012): Alternative extension zone (E')
!        R. El Khatib 01-Sep-2015 support for FFTW transforms
!        R. El Khatib  08-Jun-2023 LALL_FFTW for better flexibility
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM, JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK, JPHOOK

USE TPM_DISTR       ,ONLY : D, MYSETW
USE TPM_DIM         ,ONLY : R
USE TPM_GEOMETRY    ,ONLY : G
#ifdef WITH_FFT992
USE TPM_FFT         ,ONLY : T
USE TPMALD_FFT, ONLY :: TALD
#endif
USE TPM_FFTW        ,ONLY : TW, EXEC_FFTW
USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS
!

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN) :: KFIELDS,KGL
REAL(KIND=JPRB), INTENT(OUT)  :: PREEL(:,:)

INTEGER(KIND=JPIM) :: IGLG,IST,ILEN,IJUMP,JJ,JF,ILOEN
INTEGER(KIND=JPIM) :: IOFF,IRLEN,ICLEN,ITYPE

REAL(KIND=JPRB) :: ZNORM
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE

!     ------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('EFTINVAD_MOD:EFTINVAD',0,ZHOOK_HANDLE)

ITYPE =-1
IJUMP = 1
IGLG  = D%NPTRLS(MYSETW)+KGL-1
ILOEN = G%NLOEN(IGLG)+R%NNOEXTZL
IST   = 2*(G%NMEN(IGLG)+1)+1
ILEN  = ILOEN+3-IST
IOFF  = D%NSTAGTF(KGL)+1

!  ! Change of metric (not in forward routine)
  
#ifdef WITH_FFT992
IF( TALD%LFFT992 )THEN

  CALL FFT992(PREEL(1,IOFF),T%TRIGS(1,KGL),&
    &T%NFAX(1,KGL),KFIELDS,IJUMP,ILOEN,KFIELDS,ITYPE)

ELSE
#endif

  IRLEN=G%NLOEN(IGLG)+R%NNOEXTZL
  ICLEN=(IRLEN/2+1)*2
  CALL EXEC_FFTW(ITYPE,IRLEN,ICLEN,IOFF,KFIELDS,TW%LALL_FFTW,PREEL)

#ifdef WITH_FFT992
ENDIF
#endif

ZNORM=2.0_JPRB*REAL(ILOEN,JPRB)
DO JJ=1,1
  DO JF=1,KFIELDS
    PREEL(JF,IOFF-1+JJ) = (ZNORM/2.0_JPRB) * PREEL(JF,IOFF-1+JJ)
  ENDDO
ENDDO

DO JJ=3,ILOEN+1
  DO JF=1,KFIELDS
    PREEL(JF,IOFF-1+JJ) = ZNORM * PREEL(JF,IOFF-1+JJ)
  ENDDO
ENDDO

DO JJ=1,ILEN
  DO JF=1,KFIELDS
    PREEL(JF,IST+IOFF-1+JJ-1) = 0.0_JPRB
  ENDDO
ENDDO
IF (LHOOK) CALL DR_HOOK('EFTINVAD_MOD:EFTINVAD',1,ZHOOK_HANDLE)

!     ------------------------------------------------------------------

END SUBROUTINE EFTINVAD
END MODULE EFTINVAD_MOD