! (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 TRMTOL_MOD CONTAINS SUBROUTINE TRMTOL(PFBUF_IN, PFBUF, KFIELD) !**** *trmtol * - transposition in Fourier space ! Purpose. ! -------- ! Transpose Fourier buffer data from partitioning ! over wave numbers to partitioning over latitudes. ! It is called between direct FFT and direct Legendre ! transform. ! This routine is the inverse of TRLTOM. !** Interface. ! ---------- ! *call* *trmtol(...)* ! 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-17 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-31 add barrien synchronisation under LSYNC_TRANS ! ------------------------------------------------------------------ USE PARKIND1, ONLY: JPIM, JPRB USE YOMHOOK, ONLY: LHOOK, DR_HOOK, JPHOOK USE MPL_MODULE, ONLY: MPL_ALLTOALLV, MPL_ALL_MS_COMM USE TPM_DISTR, ONLY: D, MYSETW, NPRTRW, NPROC 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) :: J, ILEN, ISTA REAL(KIND=JPHOOK) :: ZHOOK_HANDLE REAL(KIND=JPHOOK) :: ZHOOK_HANDLE_BAR REAL(KIND=JPHOOK) :: ZHOOK_HANDLE_BAR2 ! ------------------------------------------------------------------ IF (LHOOK) CALL DR_HOOK('TRMTOL', 0, ZHOOK_HANDLE) DO J = 1, NPRTRW ILENS(J) = D%NLTSFTB(J) * KFIELD IOFFS(J) = D%NSTAGT0B(J) * KFIELD ILENR(J) = D%NLTSGTB(J) * KFIELD IOFFR(J) = D%NSTAGT0B(D%MSTABF(J)) * KFIELD ENDDO IF (NPROC > 1) THEN IF (LHOOK) CALL DR_HOOK('TRMTOL_BAR', 0, ZHOOK_HANDLE_BAR) CALL GSTATS_BARRIER(764) IF (LHOOK) CALL DR_HOOK('TRMTOL_BAR', 1, ZHOOK_HANDLE_BAR) CALL GSTATS(807, 0) CALL MPL_ALLTOALLV(PSENDBUF=PFBUF_IN, KSENDCOUNTS=ILENS, PRECVBUF=PFBUF, KRECVCOUNTS=ILENR, & & KSENDDISPL=IOFFS, KRECVDISPL=IOFFR, KCOMM=MPL_ALL_MS_COMM, CDSTRING='TRMTOL:') CALL GSTATS(807, 1) IF (LHOOK) CALL DR_HOOK('TRMTOL_BAR2', 0, ZHOOK_HANDLE_BAR2) CALL GSTATS_BARRIER2(764) IF (LHOOK) CALL DR_HOOK('TRMTOL_BAR2', 1, ZHOOK_HANDLE_BAR2) ELSE ILEN = D%NLTSGTB(MYSETW) * KFIELD ISTA = D%NSTAGT0B(MYSETW) * KFIELD + 1 CALL GSTATS(1608, 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(1608, 1) ENDIF IF (LHOOK) CALL DR_HOOK('TRMTOL', 1, ZHOOK_HANDLE) ! ------------------------------------------------------------------ END SUBROUTINE TRMTOL END MODULE TRMTOL_MOD