MODULE EDIR_TRANS_CTL_MOD
CONTAINS
SUBROUTINE EDIR_TRANS_CTL(KF_UV_G,KF_SCALARS_G,KF_GP,KF_FS,KF_UV,KF_SCALARS,&
 & PSPVOR,PSPDIV,PSPSCALAR,KVSETUV,KVSETSC,PGP,&
 & PSPSC3A,PSPSC3B,PSPSC2,KVSETSC3A,KVSETSC3B,KVSETSC2,PGPUV,PGP3A,PGP3B,PGP2,&
 & PMEANU,PMEANV,AUX_PROC)

!**** *EDIR_TRANS_CTL* - Control routine for direct spectral transform.

!     Purpose.
!     --------
!        Control routine for the direct spectral transform

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

!     Explicit arguments :
!     --------------------
!     KF_UV_G      - global number of spectral u-v fields
!     KF_SCALARS_G - global number of scalar spectral fields
!     KF_GP        - total number of output gridpoint fields
!     KF_FS        - total number of fields in fourier space
!     KF_UV        - local number of spectral u-v fields
!     KF_SCALARS   - local number of scalar spectral fields
!     PSPVOR(:,:)  - spectral vorticity
!     PSPDIV(:,:)  - spectral divergence
!     PSPSCALAR(:,:) - spectral scalarvalued fields
!     KVSETUV(:)  - indicating which 'b-set' in spectral space owns a
!                   vor/div field. Equivalant to NBSETLEV in the IFS.
!                   The length of KVSETUV should be the GLOBAL number
!                   of u/v fields which is the dimension of u and v releated
!                   fields in grid-point space.
!     KVESETSC(:) - indicating which 'b-set' in spectral space owns a
!                   scalar field. As for KVSETUV this argument is required
!                   if the total number of processors is greater than
!                   the number of processors used for distribution in
!                   spectral wave space.
!    PMEANU,PMEANV - mean winds
!    AUX_PROC        - optional external procedure for biperiodization of
!            aux.fields
!     PGP(:,:,:)  - gridpoint fields

!                  The ordering of the output fields is as follows (all
!                  parts are optional depending on the input switches):

!       u             : KF_UV_G fields
!       v             : KF_UV_G fields
!       scalar fields : KF_SCALARS_G fields

!     Method.
!     -------

!     Externals.  SHUFFLE     - reshuffle fields for load balancing
!     ----------  FIELD_SPLIT - split fields in NPROMATR packets
!                 LTDIR_CTL   - control of Legendre transform
!                 FTDIR_CTL   - control of Fourier transform

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

!     Modifications.
!     --------------
!        Original : 01-01-03
!        G. Radnoti 01-03-13 adaptation to aladin
!     01-08-28 : G. Radnoti & R. El Khatib Fix for NPROMATR /= 0
!     02-09-30 : P. Smolikova AUX_PROC for d4 in NH
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!    ------------------------------------------------------------------

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

USE TPM_GEN         ,ONLY : NPROMATR
USE TPM_TRANS       ,ONLY : GROWING_ALLOCATION


USE ELTDIR_MOD
USE TRLTOM_PACK_UNPACK, ONLY : TRLTOM_PACK, TRLTOM_PACK_HANDLE, PREPARE_TRLTOM_PACK
USE TRLTOM_MOD
USE FTDIR_MOD
USE EFTDIR_MOD
USE TRGTOL_MOD
USE BUFFERED_ALLOCATOR_MOD

IMPLICIT NONE

! Declaration of arguments

INTEGER(KIND=JPIM), INTENT(IN) :: KF_UV_G
INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCALARS_G
INTEGER(KIND=JPIM), INTENT(IN) :: KF_GP
INTEGER(KIND=JPIM), INTENT(IN) :: KF_FS
INTEGER(KIND=JPIM), INTENT(IN) :: KF_UV
INTEGER(KIND=JPIM), INTENT(IN) :: KF_SCALARS
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(OUT) :: PSPVOR(:,:)
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(OUT) :: PSPDIV(:,:)
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(OUT) :: PSPSCALAR(:,:)
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(OUT) :: PSPSC3A(:,:,:)
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(OUT) :: PSPSC3B(:,:,:)
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(OUT) :: PSPSC2(:,:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN)  :: KVSETUV(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN)  :: KVSETSC(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN)  :: KVSETSC3A(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN)  :: KVSETSC3B(:)
INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN)  :: KVSETSC2(:)
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(IN)  :: PGP(:,:,:)
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(IN)  :: PGPUV(:,:,:,:)
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(IN)  :: PGP3A(:,:,:,:)
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(IN)  :: PGP3B(:,:,:,:)
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(IN)  :: PGP2(:,:,:)
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(OUT) :: PMEANU(:)
REAL(KIND=JPRB)    ,OPTIONAL, INTENT(OUT) :: PMEANV(:)
EXTERNAL AUX_PROC
OPTIONAL AUX_PROC

! Local variables

REAL(KIND=JPRB), POINTER :: FOUBUF(:), FOUBUF_IN(:), PREEL(:), PREEL_COMPLEX(:)
TYPE(BUFFERED_ALLOCATOR) :: ALLOCATOR
TYPE(FTDIR_HANDLE) :: HFTDIR
TYPE(ELTDIR_HANDLE) :: HELTDIR
TYPE(TRLTOM_HANDLE) :: HTRLTOM
TYPE(TRLTOM_PACK_HANDLE) :: HTRLTOM_PACK
TYPE(TRGTOL_HANDLE) :: HTRGTOL
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE

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

! Perform transform

IF (LHOOK) CALL DR_HOOK('EDIR_TRANS_CTL_MOD:EDIR_TRANS_CTL',0,ZHOOK_HANDLE)
IF(NPROMATR > 0) THEN
  print *, "This is currently not supported and/or tested (NPROMATR > 0)"
  stop 24
ENDIF


! Prepare everything
ALLOCATOR = MAKE_BUFFERED_ALLOCATOR()
HTRGTOL = PREPARE_TRGTOL(ALLOCATOR,KF_GP,KF_FS)  ! ZCOMBUFR, ZCOMBUFS and PREEL
IF (KF_FS > 0) THEN
  HFTDIR = PREPARE_FTDIR(ALLOCATOR,KF_FS)   ! PREEL_COMPLEX
  HTRLTOM_PACK = PREPARE_TRLTOM_PACK(ALLOCATOR, KF_FS) ! FOUBUF_IN
  HTRLTOM = PREPARE_TRLTOM(ALLOCATOR, KF_FS) ! FOUBUF
  HELTDIR = PREPARE_ELTDIR(ALLOCATOR, KF_FS, KF_UV)
ENDIF

CALL INSTANTIATE_ALLOCATOR(ALLOCATOR, GROWING_ALLOCATION)

! from the PGP arrays to PREEL_REAL
CALL TRGTOL(ALLOCATOR,HTRGTOL,PREEL,KF_FS,KF_GP,KF_UV_G,KF_SCALARS_G,&
 & KVSETUV=KVSETUV,KVSETSC=KVSETSC,&
 & KVSETSC3A=KVSETSC3A,KVSETSC3B=KVSETSC3B,KVSETSC2=KVSETSC2,&
 & PGP=PGP,PGPUV=PGPUV,PGP3A=PGP3A,PGP3B=PGP3B,PGP2=PGP2)

IF (KF_FS > 0) THEN

  ! fourier transform from PREEL_REAL to PREEL_COMPLEX (in-place!)
  CALL GSTATS(1640,0)
  CALL EFTDIR(ALLOCATOR,HFTDIR,PREEL,PREEL_COMPLEX,KF_FS,AUX_PROC=AUX_PROC)
  CALL GSTATS(1640,1)

  CALL GSTATS(153,0)
  CALL TRLTOM_PACK(ALLOCATOR,HTRLTOM_PACK,PREEL_COMPLEX,FOUBUF_IN,KF_FS)    ! formerly known as efourier_out
  CALL TRLTOM(ALLOCATOR,HTRLTOM,FOUBUF_IN,FOUBUF,KF_FS)
  CALL GSTATS(153,1)

  CALL ELTDIR(ALLOCATOR,HELTDIR,KF_FS,KF_UV,KF_SCALARS,FOUBUF, &
        & PSPVOR,PSPDIV,PSPSCALAR,&
        & PSPSC3A,PSPSC3B,PSPSC2, &
        & PSPMEANU=PMEANU,PSPMEANV=PMEANV)

ENDIF

IF (LHOOK) CALL DR_HOOK('EDIR_TRANS_CTL_MOD:EDIR_TRANS_CTL',1,ZHOOK_HANDLE)

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

END SUBROUTINE EDIR_TRANS_CTL
END MODULE EDIR_TRANS_CTL_MOD
