SUBROUTINE TRLTOM_DIL(KDGLG,KDGLL,KNSMIN,KNUMP,KTYP,&
 & KPNM,KPNML,KRDEB,KNPROCM,KMYMS,KGLG,KGLG0,KDGNHL0,&
 & PTAB_IN,PTAB_OUT)

!**** *TRLTOM_DIL* - transposition from latitude distribution to
!                    zonal wavenumber distribution, designed for
!                    configuration 911.

!                    The truncation is assumed to be triangular.

!     Purpose.
!     --------
!      see above.

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

!        Explicit arguments :
!        --------------------

!         INPUT:
!          KDGLG     : DM-global number of latitudes.
!                      N or N&S hemispheres according to KTYP.
!          KDGLL     : DM-local number of latitudes.
!                      N or N&S hemispheres according to KTYP.
!          KNSMIN    : Lower truncation.
!          KNUMP     : Number of spectral waves handled by this proc.
!          KTYP      : 1: only the Northern hemosphere is treated.
!                      2: both hemispheres are treated.
!          KPNM      : second dimension for PTAB_IN (computed in SUDIL).
!          KPNML     : second dimension for PTAB_OUT (computed in SUMP_DILB).
!          KRDEB     : Index array for PTAB_IN (computed in SUDIL).
!          KNPROCM   : KNPROCM(JM): the processor which treats the zonal
!                      wavenumber m=JM.
!          KMYMS     : Actual wave numbers handled by this processor.
!          KGLG      : gives the DM-global latitude from the DM-local one
!                      (current processor only).
!                      Contains the N and S hemispheres in all cases.
!          KGLG0     : gives the DM-global latitude from the DM-local one
!                      (all processors).
!                      Contains the N and S hemispheres in all cases.
!          KDGNHL0   : DM-local number of latitudes for all procs
!                      (North hem. only).
!          PTAB_IN   : Input data.

!         OUTPUT:
!          PTAB_OUT  : Output data.

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

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

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

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

!     Author.
!     -------
!        K. Yessad (CNRM/GMAP)

!     Modifications.
!     --------------
!        Original : July 2005
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
 
USE YOMCT0    ,ONLY : NPRTRW
USE YOMMP     ,ONLY : MYSETW
USE YOMTAG    ,ONLY : MTAGLM

USE MPL_MODULE

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)  :: KDGLG
INTEGER(KIND=JPIM),INTENT(IN)  :: KDGLL
INTEGER(KIND=JPIM),INTENT(IN)  :: KNSMIN
INTEGER(KIND=JPIM),INTENT(IN)  :: KNUMP
INTEGER(KIND=JPIM),INTENT(IN)  :: KTYP
INTEGER(KIND=JPIM),INTENT(IN)  :: KPNM
INTEGER(KIND=JPIM),INTENT(IN)  :: KPNML
INTEGER(KIND=JPIM),INTENT(IN)  :: KRDEB(0:KNSMIN+1)
INTEGER(KIND=JPIM),INTENT(IN)  :: KNPROCM(0:KNSMIN)
INTEGER(KIND=JPIM),INTENT(IN)  :: KMYMS(KNSMIN+1)
INTEGER(KIND=JPIM),INTENT(IN)  :: KGLG(KDGLG*(3-KTYP))
INTEGER(KIND=JPIM),INTENT(IN)  :: KGLG0(KDGLG*(3-KTYP),NPRTRW)
INTEGER(KIND=JPIM),INTENT(IN)  :: KDGNHL0(NPRTRW)
REAL(KIND=JPRB)   ,INTENT(IN)  :: PTAB_IN(KDGLL,KPNM)
REAL(KIND=JPRB)   ,INTENT(OUT) :: PTAB_OUT(KDGLG,KPNML)

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

INTEGER(KIND=JPIM) :: ITAG, ISE, ILENGTH, IMGLO
INTEGER(KIND=JPIM) :: JROC_TARGET, JROC_ORIGIN, JMGLO, JSE, JGLLOC, JMLOC

REAL(KIND=JPRB),ALLOCATABLE :: ZTAB_IN(:)
REAL(KIND=JPRB),ALLOCATABLE :: ZTAB_RECV(:)

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

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

ITAG = MTAGLM

! * Current distribution (ex given for nprtrw=3):

!        PROC1               PROC2               PROC3

!        M1  M2  M3          M1  M2  M3          M1  M2  M3
!   L1   *   *   *      L1                  L1
!   L2                  L2   *   *   *      L2
!   L3                  L3                  L3   *   *   *

DO JROC_ORIGIN=1,NPRTRW

  ! * The current processor sends data to the other processors:
  !   (in our example
  !    PROC1 sends (L1,M2) to PROC2 and (L1,M3) to PROC3
  !    PROC2 sends (L2,M1) to PROC1 and (L2,M3) to PROC3
  !    PROC3 sends (L3,M1) to PROC1 and (L3,M2) to PROC2)

  IF (JROC_ORIGIN == MYSETW) THEN
    DO JROC_TARGET=1,NPRTRW
      IF (JROC_TARGET /= MYSETW) THEN

        ! * Compute the number of spectral coefficients to be sent:
        ISE=0
        DO JMGLO=0,KNSMIN
          IF (KNPROCM(JMGLO) == JROC_TARGET) THEN
            DO JSE=KRDEB(JMGLO),KRDEB(JMGLO+1)-1
              ISE=ISE+1 
            ENDDO
          ENDIF
        ENDDO
        ILENGTH=ISE

        ! * Allocate ZTAB_IN:
        ALLOCATE(ZTAB_IN(ILENGTH))

        DO JGLLOC=1,KDGLL

          ! * Fill ZTAB_IN:
          ISE=0
          DO JMGLO=0,KNSMIN
            IF (KNPROCM(JMGLO) == JROC_TARGET) THEN
              DO JSE=KRDEB(JMGLO),KRDEB(JMGLO+1)-1
                ISE=ISE+1 
                ZTAB_IN(ISE)=PTAB_IN(JGLLOC,JSE)
              ENDDO
            ENDIF
          ENDDO

          ! * Send the content of ZTAB_IN to proc number JROC_TARGET:
          CALL MPL_SEND(ZTAB_IN(1:ILENGTH),KDEST=JROC_TARGET,&
            &KTAG=ITAG+(JROC_TARGET+MYSETW*NPRTRW)*KDGLG+KGLG(JGLLOC),&
            &CDSTRING='TRLTOM_DIL:')

        ENDDO

        ! * Deallocate ZTAB_IN:
        IF (ALLOCATED(ZTAB_IN)) DEALLOCATE(ZTAB_IN)

      ENDIF
    ENDDO
  ENDIF

  ! * MPL_BARRIER.

  CALL MPL_BARRIER(CDSTRING='TRLTOM_DIL:')

  ! * The current processor receives data from the other processors:
  !   (in our example
  !    PROC1 receives (L2,M1) from PROC2 and (L3,M1) from PROC3
  !    PROC2 receives (L1,M2) from PROC1 and (L3,M2) from PROC3
  !    PROC3 receives (L1,M3) from PROC1 and (L2,M3) from PROC2)

  IF (JROC_ORIGIN /= MYSETW) THEN

    ! * Allocate ZTAB_RECV:
    ALLOCATE(ZTAB_RECV(KPNML))

    DO JGLLOC=1,KTYP*KDGNHL0(JROC_ORIGIN)

      ! * Receive the content of ZTAB_RECV from proc number JROC_ORIGIN:
      CALL MPL_RECV(ZTAB_RECV(1:KPNML),KSOURCE=JROC_ORIGIN,&
        &KTAG=ITAG+(MYSETW+JROC_ORIGIN*NPRTRW)*KDGLG+KGLG0(JGLLOC,JROC_ORIGIN),&
        &CDSTRING='TRLTOM_DIL:')

      ! * Transfer the content of ZTAB_RECV into PTAB_OUT:
      PTAB_OUT(KGLG0(JGLLOC,JROC_ORIGIN),1:KPNML)=ZTAB_RECV(1:KPNML)

    ENDDO

    ! * Deallocate ZTAB_RECV:
    IF (ALLOCATED(ZTAB_RECV)) DEALLOCATE(ZTAB_RECV)

  ENDIF

  ! * MPL_BARRIER.

  CALL MPL_BARRIER(CDSTRING='TRLTOM_DIL:')

ENDDO

! * At this stage:

!   We have still the following data in PTAB_IN in our example:

!        PROC1               PROC2               PROC3

!        M1  M2  M3          M1  M2  M3          M1  M2  M3
!   L1   *   *   *      L1                  L1
!   L2                  L2   *   *   *      L2
!   L3                  L3                  L3   *   *   *

!   We have the following data in PTAB_OUT in our example:

!        PROC1               PROC2               PROC3

!        M1  M2  M3          M1  M2  M3          M1  M2  M3
!   L1                  L1       *          L1           *
!   L2   *              L2                  L2           *
!   L3   *              L3       *          L3            

! * Now we do the final memory transfer from PTAB_IN to PTAB_OUT:
!   (in our example
!    PROC1 transfers (L1,M1) from PTAB_IN to PTAB_OUT
!    PROC2 transfers (L2,M2) from PTAB_IN to PTAB_OUT
!    PROC3 transfers (L3,M3) from PTAB_IN to PTAB_OUT)

ISE=0
DO JMLOC=1,KNUMP
  IMGLO=KMYMS(JMLOC)
  DO JSE=KRDEB(IMGLO),KRDEB(IMGLO+1)-1
    ISE=ISE+1
    DO JGLLOC=1,KDGLL
      PTAB_OUT(KGLG(JGLLOC),ISE)=PTAB_IN(JGLLOC,JSE)
    ENDDO
  ENDDO
ENDDO

! * At this stage:

!   We have the following data in PTAB_OUT in our example:

!        PROC1               PROC2               PROC3

!        M1  M2  M3          M1  M2  M3          M1  M2  M3
!   L1   *              L1       *          L1           *
!   L2   *              L2       *          L2           *
!   L3   *              L3       *          L3           *

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

IF (LHOOK) CALL DR_HOOK('TRLTOM_DIL',1,ZHOOK_HANDLE)
END SUBROUTINE TRLTOM_DIL
