SUBROUTINE TRNTOM(KCEFRE,KNCMAX,KFLDSUR,KNACM0,KNPROCM,PTAB)

!-----------------------------------------------------------------------
!       Transposition of the buffer in the sense horizontal to vertical
!       Called by the subroutine trageo

!     Author:
!     ------
!       Bouchaib Radi

!     Modifications.
!     --------------
!       Nettoyage et passage en MPE par V. SARAVANE : OCTOBRE 1995
!       Ajout de ksefre , J. F. Estrade : novembre 95
!       Doctorizing , M.Hamrud,L.Isaksen :February 96
!       M.Hamrud   : 00-02-02  Removal of MYSENDA etc.
!       D.Dent     : 00-09-01  MPE to MPL conversion
!       M.Hamrud      01-Oct-2003 CY28 Cleaning
!       K.Yessad   : Jan 2004  Debug
!------------------------------------------------------------------------

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

USE YOMMP    , ONLY : NPRCIDS  ,MYPROC   ,MYSETV   ,MYSETW
USE YOMCT0   , ONLY : NPRTRW
USE YOMTAG   , ONLY : MTAGNM
USE MPL_MODULE

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KCEFRE 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLDSUR 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNCMAX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNACM0(0:KNCMAX)
INTEGER(KIND=JPIM),INTENT(IN)    :: KNPROCM(0:KNCMAX)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTAB(KFLDSUR,KCEFRE) 

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

REAL(KIND=JPRB) :: ZBUF(KFLDSUR+KCEFRE)
INTEGER(KIND=JPIM) :: IBFLEN, ILRECV, IPOS, IRECV, &
 & ISEND, ISP, JFL, JJPROC, JM, JN,IRECVSETA,ISENDSETA  
INTEGER(KIND=JPIM) :: MYSENDSET,MYRECVSET
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"
#include "set2pe.intfb.h"

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

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

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

IBFLEN = KFLDSUR+KCEFRE

DO JJPROC=1,NPRTRW-1

  ISENDSETA=MYSENDSET(NPRTRW,MYSETW,JJPROC)
  CALL SET2PE(ISEND,0,0,ISENDSETA,MYSETV)

! Transpose data used on local processor

  IPOS = 0
  DO JN=0,KNCMAX
    IF (KNPROCM(JN)  ==  MYPROC) THEN
      DO JM=0,JN
        IF (KNPROCM(JM)  ==  ISEND) THEN
          IF (JM  ==  0) THEN
            DO JFL=1,KFLDSUR
              IPOS = IPOS+1
              ZBUF(IPOS) = PTAB(JFL,KNACM0(0)+JN*2)
            ENDDO
          ELSE
            DO JFL=1,KFLDSUR
              ISP = KNACM0(JM)+(JN-JM)*2
              IPOS = IPOS+1
              ZBUF(IPOS) = PTAB(JFL,ISP)
              IPOS = IPOS + 1
              ZBUF(IPOS) = PTAB(JFL,ISP+1)
            ENDDO
          ENDIF
        ENDIF
      ENDDO
    ENDIF
  ENDDO

! Send message (if not empty)

  IF (IPOS > 0) THEN
    IF (IPOS > IBFLEN) CALL ABOR1(' TRNTOM : MESSAGE LONGER THAN IBFLEN')
    CALL MPL_SEND(ZBUF(1:IPOS),KDEST=NPRCIDS(ISEND), &
     & KTAG=MTAGNM,CDSTRING='TRNTOM:')  
  ENDIF

! Receive message (if not empty)

  IRECVSETA=MYRECVSET(NPRTRW,MYSETW,JJPROC)
  CALL SET2PE(IRECV,0,0,IRECVSETA,MYSETV)
  CALL MPL_RECV(ZBUF(1:IBFLEN),KSOURCE=NPRCIDS(IRECV),KTAG=MTAGNM, &
   & KOUNT=ILRECV,CDSTRING='TRNTOM:')  

! Copy data from global buffer

  IPOS = 0
  DO JM=0,KNCMAX
    IF (KNPROCM(JM)  ==  MYPROC ) THEN
      DO JN=JM,KNCMAX
        IF (KNPROCM(JN)  ==  IRECV) THEN
          IF (JM  ==  0) THEN
            DO JFL=1,KFLDSUR
              IPOS = IPOS +1
              PTAB(JFL,KNACM0(0)+JN*2) = ZBUF(IPOS)
            ENDDO
          ELSE
            DO JFL=1,KFLDSUR
              ISP = KNACM0(JM)+(JN-JM)*2
              IPOS = IPOS+1
              PTAB(JFL,ISP) = ZBUF(IPOS)
              IPOS = IPOS+1
              PTAB(JFL,ISP+1) = ZBUF(IPOS)
            ENDDO
          ENDIF
        ENDIF
      ENDDO
    ENDIF
  ENDDO

  IF(ILRECV /= IPOS) THEN
    CALL ABOR1('TRNTOM: RECEIVED MESSAGE LENGTH DOES NOT MATCH')
  ENDIF

ENDDO

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

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

