SUBROUTINE TRSTOM_SPEC(YDCOLS,YDSPEC)

!     Purpose
!     -------
!       Transpose spectral data distributed by columns (SPECTRAL_COLS
!       type) into SPECTRAL_FIELDS type.

!     Author
!     ------
!       Y. Tremolet

!     Modifications
!     -------------
!        Original   : 04-Feb-04
! ------------------------------------------------------------------

USE PARKIND1, ONLY: JPIM, JPRB
USE YOMHOOK , ONLY: LHOOK, DR_HOOK
USE YOMCT0  , ONLY: NPRTRV
USE SPECTRAL_FIELDS_MOD
USE SPECTRAL_COLUMNS_MIX
USE MPL_MODULE

IMPLICIT NONE

TYPE(SPECTRAL_COLS),  INTENT(IN)    :: YDCOLS
TYPE(SPECTRAL_FIELD), INTENT(INOUT) :: YDSPEC

INTEGER(KIND=JPIM) :: ilens(NPRTRV),ilenr(NPRTRV),ioffs(NPRTRV),ioffr(NPRTRV)
INTEGER(KIND=JPIM) :: ii,jp,jf,js,jl,jb
REAL(KIND=JPRB), ALLOCATABLE :: ZBUFS(:), ZBUFR(:)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

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

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

IF (NPRTRV==1) THEN
  YDSPEC%SP3D(:,:,:)=YDCOLS%SP3V(:,:,:)
  IF (YDSPEC%ns2d>0) THEN
    YDSPEC%SP2D(:,:)=YDCOLS%SP2V(:,:)
  ENDIF
ELSE
! Allocate work space
  ALLOCATE(ZBUFS(YDCOLS%nsizel))
  ALLOCATE(ZBUFR(YDSPEC%nspsizel))

! Pack data
  ii=0
  DO jp=1,NPRTRV
    DO jf=1,YDSPEC%ns3d
      DO js=1,YDCOLS%NSPEC2V
        DO jl=YDCOLS%NPTRLL(jp),YDCOLS%NPTRLL(jp+1)-1
          ii=ii+1
          ZBUFS(ii)=YDCOLS%SP3V(jl,js,jf)
        ENDDO
      ENDDO
    ENDDO
    DO jf=1,YDSPEC%ns2l(jp)
      DO js=1,YDCOLS%NSPEC2V
        ii=ii+1
        ZBUFS(ii)=YDCOLS%SP2V(js,jf)
      ENDDO
    ENDDO
  ENDDO
  IF (ii/=YDCOLS%nsizel) CALL ABOR1('TRSTOM_SPEC: Error packing')

  ilens(:)=YDSPEC%numll(:)*YDSPEC%ns3d+YDSPEC%ns2l(:)
  ilens(:)=YDCOLS%nspec2v*ilens(:)

  DO jp=1,NPRTRV
    ii=YDCOLS%NPTRSV(jp+1)-YDCOLS%NPTRSV(jp)
    ilenr(jp)=(YDSPEC%ns3d*YDSPEC%NFLEVL+YDSPEC%ns2d)*ii
  ENDDO

  ioffs(1)=0
  ioffr(1)=0
  DO jb=2,NPRTRV
    ioffs(jb)=ioffs(jb-1)+ilens(jb-1)
    ioffr(jb)=ioffr(jb-1)+ilenr(jb-1)
  ENDDO

! Communicate data
  CALL MPL_ALLTOALLV(zbufs,ilens,zbufr,ilenr,&
   & KSENDDISPL=ioffs,KRECVDISPL=ioffr,KCOMM=MPL_ALL_LEVS_COMM,&
   & CDSTRING='TRSTOM_SPEC:')

! Unpack data
  ii=0
  DO jp=1,NPRTRV
    DO jf=1,YDSPEC%ns3d
      DO js=YDCOLS%NPTRSV(jp),YDCOLS%NPTRSV(jp+1)-1
        DO jl=1,YDSPEC%NFLEVL
          ii=ii+1
          YDSPEC%SP3D(jl,js,jf)=ZBUFR(ii)
        ENDDO
      ENDDO
    ENDDO
    DO jf=1,YDSPEC%ns2d
      DO js=YDCOLS%NPTRSV(jp),YDCOLS%NPTRSV(jp+1)-1
        ii=ii+1
        YDSPEC%SP2D(js,jf)=ZBUFR(ii)
      ENDDO
    ENDDO
  ENDDO
  IF (ii/=YDSPEC%nspsizel) CALL ABOR1('TRSTOM_SPEC: Error unpacking')

! Clean-up
  DEALLOCATE(ZBUFS)
  DEALLOCATE(ZBUFR)
ENDIF

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