! (C) Copyright 1995- ECMWF.
! (C) Copyright 1995- 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 TRLTOM_MOD
CONTAINS
SUBROUTINE TRLTOM(PFBUF_IN,PFBUF,KFIELD)

!**** *TRLTOM * - transposition in Fourierspace

!     Purpose.
!     --------
!              Transpose Fourier coefficients from partitioning
!              over latitudes to partitioning over wave numbers
!              This is done between inverse Legendre Transform
!              and inverse FFT.
!              This is the inverse routine of TRMTOL.

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

!        Explicit arguments : PFBUF  - Fourier coefficient buffer. It is
!        --------------------          used for both input and output.

!                             KFIELD - Number of fields communicated

!        Implicit arguments :
!        --------------------

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        MPP Group *ECMWF*

!     Modifications.
!     --------------
!        Original : 95-10-01
!        Modified : 97-06-18 G. Mozdzynski - control MPI mailbox use
!                                            (NCOMBFLEN) for nphase.eq.1
!        Modified : 99-05-28  D.Salmond - Optimise copies.
!        Modified : 00-02-02  M.Hamrud  - Remove NPHASE
!        D.Salmond : 01-11-23 LIMP_NOOLAP Option for non-overlapping message
!                             passing and buffer packing
!        G.Mozdzynski : 08-01-01 Cleanup
!        Y.Seity   : 07-08-30 Add barrier synchonisation under LSYNC_TRANS
!     ------------------------------------------------------------------

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

USE MPL_MODULE  ,ONLY : MPL_ALLTOALLV, MPL_BARRIER, MPL_ALL_MS_COMM, MPL_MYRANK, MPL_WAIT, JP_NON_BLOCKING_STANDARD

USE TPM_DISTR       ,ONLY : D, MTAGLM, MYSETW, NPRTRW, NPROC
!USE TPM_GEN         ,ONLY : LSYNC_TRANS

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)  :: KFIELD
REAL(KIND=JPRB)   ,INTENT(INOUT)  :: PFBUF(:)
REAL(KIND=JPRB)   ,INTENT(INOUT)  :: PFBUF_IN(:)

INTEGER(KIND=JPIM) :: ILENS(NPRTRW),IOFFS(NPRTRW),ILENR(NPRTRW),IOFFR(NPRTRW)

INTEGER(KIND=JPIM) :: ITAG, J, ILEN, ISTA

REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE_BAR
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE_BAR2

!INTEGER(KIND=JPIM) :: IREQ

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

IF (LHOOK) CALL DR_HOOK('TRLTOM',0,ZHOOK_HANDLE)


ITAG = MTAGLM

DO J=1,NPRTRW
  ILENS(J) = D%NLTSGTB(J)*KFIELD
  IOFFS(J) = D%NSTAGT1B(D%MSTABF(J))*KFIELD
  ILENR(J) = D%NLTSFTB(J)*KFIELD
  IOFFR(J) = D%NSTAGT1B(J)*KFIELD
ENDDO

IF(NPROC > 1) THEN
  IF (LHOOK) CALL DR_HOOK('TRLTOM_BAR',0,ZHOOK_HANDLE_BAR)
  CALL GSTATS_BARRIER(763)
  IF (LHOOK) CALL DR_HOOK('TRLTOM_BAR',1,ZHOOK_HANDLE_BAR)
  CALL GSTATS(806,0)
! IF (LSYNC_TRANS) THEN
!   CALL MPL_BARRIER(CDSTRING='TRLTOM:')
! ENDIF

  CALL MPL_ALLTOALLV(PSENDBUF=PFBUF_IN,KSENDCOUNTS=ILENS,&
   & PRECVBUF=PFBUF,KRECVCOUNTS=ILENR,KSENDDISPL=IOFFS,KRECVDISPL=IOFFR,&
   & KCOMM=MPL_ALL_MS_COMM,CDSTRING='TRLTOM:')
!Faster on Cray - because of peculiarity of their MPICH
! CALL MPL_ALLTOALLV(PSENDBUF=PFBUF_IN,KSENDCOUNTS=ILENS,&
!  & PRECVBUF=PFBUF,KRECVCOUNTS=ILENR,KSENDDISPL=IOFFS,KRECVDISPL=IOFFR,&
!  & KMP_TYPE=JP_NON_BLOCKING_STANDARD,KREQUEST=IREQ,&
!  & KCOMM=MPL_ALL_MS_COMM,CDSTRING='TRLTOM:')
! CALL MPL_WAIT(KREQUEST=IREQ,CDSTRING='TRLTOM: WAIT')

  CALL GSTATS(806,1)
  IF (LHOOK) CALL DR_HOOK('TRLTOM_BAR2',0,ZHOOK_HANDLE_BAR2)
  CALL GSTATS_BARRIER2(763)
  IF (LHOOK) CALL DR_HOOK('TRLTOM_BAR2',1,ZHOOK_HANDLE_BAR2)
ELSE
  ILEN = D%NLTSGTB(MYSETW)*KFIELD
  ISTA = D%NSTAGT1B(MYSETW)*KFIELD+1
  CALL GSTATS(1607,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(J)
  DO J=ISTA,ISTA+ILEN-1
    PFBUF(J) = PFBUF_IN(J)
  ENDDO
!$OMP END PARALLEL DO
  CALL GSTATS(1607,1)
ENDIF

IF (LHOOK) CALL DR_HOOK('TRLTOM',1,ZHOOK_HANDLE)

!     ------------------------------------------------------------------
END SUBROUTINE TRLTOM
END MODULE TRLTOM_MOD
