SUBROUTINE TRMTOV(KCPEC2,KCPEC2V,KPTRCV,PSPVOR,PSPDIV,PSPT,PSPSP,&
 & PSPVORG,PSPDIVG,PSPTG,PSPSPG,KBUFLEN,KSIGN,&
 & KMODE)  

!**** *trmtov * - Transposition of spectral coefficients
!                 to vertical columns for a subset of the
!                 spectral coefficients.
!                 This routine is needed during NMI computations 
!                 when vertical modes are distributed among PE's.

!     Purpose.
!     --------
!              Transpose data from SPXX arrays to SPxxG arrays.
!              The normal mode calculations require vertical
!              columns of SPT, SPVOR, SPDIV, and possibly SPSP.

!**   Interface.
!     ----------
!        *call* *TRMTOV(...)*

!        Explicit arguments :  KCPEC2,KCPEC2V   - dimensions
!        --------------------  KPTRCV           - spectral column offset
!                              PSPVOR, PSPVORG  - Vorticity
!                              PSPDIV, PSPDIVG  - Divergence
!                              PSPT, PSPTG      - Temperature
!                              PSPSP, PSPSPG    - ln(surface pressure)
!                              KBUFLEN     - communication buffer length

!                              KSIGN  - = +1 FOR TRANSFORMS FROM NORMAL MODE
!                                            SPACE TO PHYSICAL SPACE,
!                                       = -1 FOR TRANSFORMS FROM PHYSICAL SPACE
!                                            TO NORMAL MODE SPACE.
!                              If KMODE=1 PSPSP, PSPSPG are not needed

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

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

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

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

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

!     Modifications.
!     --------------
!        Original: 95-10-01 
!        Modified: 00-09-01 by D.Dent : MPE to MPL conversion
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NFLEVL   ,NFLEVG
USE YOMCT0   , ONLY : NPROC    ,NPRTRV
USE YOMMP    , ONLY : NPRCIDS  ,MYSETV   ,NUMLL    ,&
 & NPTRLL   ,MYLEVS  ,NPSURF   ,NPSP     ,MYSETW  
USE YOMTAG   , ONLY : MTAGMV
USE YOMCT3   , ONLY : NSTEP
USE YOMNMIA  , ONLY : NITNMI
USE YOMLUN   , ONLY : NULOUT
USE MPL_MODULE

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KCPEC2
INTEGER(KIND=JPIM),INTENT(IN)    :: KCPEC2V 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPTRCV(NPRTRV+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPVOR(NFLEVL,KCPEC2) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPDIV(NFLEVL,KCPEC2) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPT(NFLEVL,KCPEC2) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPSP(KCPEC2) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPVORG(NFLEVG,KCPEC2V) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPDIVG(NFLEVG,KCPEC2V) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPTG(NFLEVG,KCPEC2V) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPSPG(KCPEC2V) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KBUFLEN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSIGN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KMODE 
! Fields are INput or OUTput depending on KSIGN
REAL(KIND=JPRB) :: ZCOMBUF(KBUFLEN)

INTEGER(KIND=JPIM) ::  IL, ILRECV, INSFREC, IOFF, IPOS, IRECV,&
 & IRECVSET, ISEND, ISENDSET, ITAG, &
 & JL, JLOC, JROC, JSP  
!     INTEGER FUNCTIONS
INTEGER(KIND=JPIM) :: MYSENDSET,MYRECVSET
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

!*       1.    TRANSFORM TO NORMAL MODE SPACE
!              ------------------------------

IF (LHOOK) CALL DR_HOOK('TRMTOV',0,ZHOOK_HANDLE)
IF( KSIGN == -1 )THEN

!  Transpose data treated on local processor

  ITAG=MTAGMV+NITNMI+NSTEP
  IOFF=KPTRCV(MYSETV)-1
  DO JSP=1,KCPEC2V
    DO JLOC=1,NFLEVL
      IL=MYLEVS(JLOC)
      PSPVORG(IL,JSP)=PSPVOR(JLOC,JSP+IOFF)
      PSPDIVG(IL,JSP)=PSPDIV(JLOC,JSP+IOFF)
      PSPTG(IL,JSP)=PSPT(JLOC,JSP+IOFF)
    ENDDO
  ENDDO
  IF( NPSP == 1.AND.KMODE /= 1 )THEN
    DO JSP=1,KCPEC2V
      PSPSPG(JSP)=PSPSP(JSP+IOFF)
    ENDDO
  ENDIF

!   Communicate with other processors

  DO JROC=1,NPRTRV-1

!    copy data to be sent into communication buffer

    ISENDSET=MYSENDSET(NPRTRV,MYSETV,JROC)
    CALL SET2PE(ISEND,0,0,MYSETW,ISENDSET)

    IPOS=0
    DO JSP=KPTRCV(ISENDSET),KPTRCV(ISENDSET+1)-1
      DO JLOC=1,NFLEVL
        IPOS=IPOS+1
        ZCOMBUF(IPOS)=PSPVOR(JLOC,JSP)
        IPOS=IPOS+1
        ZCOMBUF(IPOS)=PSPDIV(JLOC,JSP)
        IPOS=IPOS+1
        ZCOMBUF(IPOS)=PSPT(JLOC,JSP)
      ENDDO
    ENDDO

    IF( NPSP == 1.AND.KMODE /= 1 )THEN
      DO JSP=KPTRCV(ISENDSET),KPTRCV(ISENDSET+1)-1
        IPOS=IPOS+1
        ZCOMBUF(IPOS)=PSPSP(JSP)
      ENDDO
    ENDIF

    IF( IPOS > 0 )THEN
      IF( IPOS > KBUFLEN ) CALL ABOR1(&
       & 'TRMTOV: MESSAGE LONGER THAN KBUFLEN')  
      CALL MPL_SEND(ZCOMBUF(1:IPOS),KDEST=NPRCIDS(ISEND), &
       & KTAG=ITAG,CDSTRING='TRMTOV:')  
    ENDIF

    IRECVSET=MYRECVSET(NPRTRV,MYSETV,JROC)
    CALL SET2PE(IRECV,0,0,MYSETW,IRECVSET)

    IF( KPTRCV(MYSETV) < KPTRCV(MYSETV+1) )THEN

!*            receive message (if not empty)

      CALL MPL_RECV(ZCOMBUF(1:KBUFLEN),KSOURCE=NPRCIDS(IRECV), &
       & KTAG=ITAG,KOUNT=ILRECV,CDSTRING='TRMTOV:')  

!*             copy data from buffer into global vertical arrays

      IPOS=0
      DO JSP=1,KCPEC2V
        DO JL=NPTRLL(IRECVSET),NPTRLL(IRECVSET+1)-1
          IPOS=IPOS+1
          PSPVORG(JL,JSP)=ZCOMBUF(IPOS)
          IPOS=IPOS+1
          PSPDIVG(JL,JSP)=ZCOMBUF(IPOS)
          IPOS=IPOS+1
          PSPTG(JL,JSP)=ZCOMBUF(IPOS)
        ENDDO
      ENDDO

      IF( NPSURF(IRECVSET) == 1.AND.KMODE /= 1 )THEN
        DO JSP=1,KCPEC2V
          IPOS=IPOS+1
          PSPSPG(JSP)=ZCOMBUF(IPOS)
        ENDDO
      ENDIF

      IF( ILRECV /= IPOS )THEN
        WRITE(NULOUT,*) MYSETV,' receiving ',ILRECV,'expected',IPOS
        CALL ABOR1('TRMTOV: RECEIVED MESSAGE NOT CORRECT LENGTH')
      ENDIF
    ENDIF

  ENDDO

! Perform barrier synchronisation to guarantee all processors have
! completed communication

  IF( NPROC > 1 )THEN
    CALL MPL_BARRIER(CDSTRING='TRMTOV:')
  ENDIF

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

!*       2.   TRANSFORM TO PHYSICAL SPACE
!             ---------------------------

ELSEIF( KSIGN == +1 )THEN

!  Transpose data treated on local processor

  ITAG=MTAGMV+100+NITNMI+NSTEP
  IOFF=KPTRCV(MYSETV)-1
  DO JSP=1,KCPEC2V
    DO JLOC=1,NFLEVL
      IL=MYLEVS(JLOC)
      PSPVOR(JLOC,JSP+IOFF)=PSPVORG(IL,JSP)
      PSPDIV(JLOC,JSP+IOFF)=PSPDIVG(IL,JSP)
      PSPT(JLOC,JSP+IOFF)=PSPTG(IL,JSP)
    ENDDO
  ENDDO
  IF( NPSP == 1.AND.KMODE /= 1 )THEN
    DO JSP=1,KCPEC2V
      PSPSP(JSP+IOFF)=PSPSPG(JSP)
    ENDDO
  ENDIF

!   Communicate with other processors

  DO JROC=1,NPRTRV-1

!    copy data to be sent into communication buffer

    ISENDSET=MYSENDSET(NPRTRV,MYSETV,JROC)
    CALL SET2PE(ISEND,0,0,MYSETW,ISENDSET)

    IPOS=0
    DO JSP=1,KCPEC2V
      DO JL=NPTRLL(ISENDSET),NPTRLL(ISENDSET+1)-1
        IPOS=IPOS+1
        ZCOMBUF(IPOS)=PSPVORG(JL,JSP)
        IPOS=IPOS+1
        ZCOMBUF(IPOS)=PSPDIVG(JL,JSP)
        IPOS=IPOS+1
        ZCOMBUF(IPOS)=PSPTG(JL,JSP)
      ENDDO
    ENDDO

    IF( NPSURF(ISENDSET) == 1.AND.KMODE /= 1 )THEN
      DO JSP=1,KCPEC2V
        IPOS=IPOS+1
        ZCOMBUF(IPOS)=PSPSPG(JSP)
      ENDDO
    ENDIF
      
    IF( IPOS > 0 )THEN
      IF( IPOS > KBUFLEN ) CALL ABOR1(&
       & 'TRMTOV: MESSAGE LONGER THAN KBUFLEN')  
      CALL MPL_SEND(ZCOMBUF(1:IPOS),KDEST=NPRCIDS(ISEND), &
       & KTAG=ITAG,CDSTRING='TRMTOV:')  
    ENDIF

    IRECVSET=MYRECVSET(NPRTRV,MYSETV,JROC)
    CALL SET2PE(IRECV,0,0,MYSETW,IRECVSET)
    INSFREC=KPTRCV(IRECVSET+1)-KPTRCV(IRECVSET)
    IF( (NUMLL(MYSETV) > 0.OR.NPSP == 1).AND.INSFREC > 0) THEN

!*            receive message (if not empty)

      CALL MPL_RECV(ZCOMBUF(1:KBUFLEN),KSOURCE=NPRCIDS(IRECV),&
       & KTAG=ITAG,KOUNT=ILRECV,CDSTRING='TRMTOV:')  

!*            copy data from buffer into global vertical arrays

      IPOS=0
      DO JSP=KPTRCV(IRECVSET),KPTRCV(IRECVSET+1)-1
        DO JL=1,NFLEVL
          IPOS=IPOS+1
          PSPVOR(JL,JSP)=ZCOMBUF(IPOS)
          IPOS=IPOS+1
          PSPDIV(JL,JSP)=ZCOMBUF(IPOS)
          IPOS=IPOS+1
          PSPT(JL,JSP)=ZCOMBUF(IPOS)
        ENDDO
      ENDDO

      IF( NPSP == 1.AND.KMODE /= 1 )THEN
        DO JSP=KPTRCV(IRECVSET),KPTRCV(IRECVSET+1)-1
          IPOS=IPOS+1
          PSPSP(JSP)=ZCOMBUF(IPOS)
        ENDDO
      ENDIF

      IF( ILRECV /= IPOS )THEN
        WRITE(NULOUT,*) MYSETV,' receiving ',ILRECV,'expected',IPOS
        CALL ABOR1('TRMTOV: RECEIVED MESSAGE NOT CORRECT LENGTH')
      ENDIF
    ENDIF

  ENDDO

! Perform barrier synchronisation to guarantee all processors have
! completed communication

  IF( NPROC > 1 )THEN
    CALL MPL_BARRIER(CDSTRING='TRMTOV:')
  ENDIF

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

ENDIF

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