SUBROUTINE TRMTOS_SPEC(YDSPEC,YDCOLS)

!     Purpose
!     -------
!       Transpose SPECTRAL_FIELD type data into distribution by
!       columns (SPECTRAL_COLS 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_FIELD), INTENT(IN)    :: YDSPEC
TYPE(SPECTRAL_COLS),  INTENT(INOUT) :: YDCOLS

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

#include "abor1.intfb.h"

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

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

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

! Pack data
  ii=0
  DO jp=1,NPRTRV
    ioffs(jp)=ii
    DO jf=1,YDSPEC%ns3d
      DO js=YDCOLS%NPTRSV(jp),YDCOLS%NPTRSV(jp+1)-1
        DO jl=1,YDSPEC%NFLEVL
          ii=ii+1
          ZBUFS(ii)=YDSPEC%SP3D(jl,js,jf)
        ENDDO
      ENDDO
    ENDDO
    DO jf=1,YDSPEC%ns2d
      DO js=YDCOLS%NPTRSV(jp),YDCOLS%NPTRSV(jp+1)-1
        ii=ii+1
        ZBUFS(ii)=YDSPEC%SP2D(js,jf)
      ENDDO
    ENDDO
    ilens(jp)=ii-ioffs(jp)
  ENDDO

  ilenr(:)=YDSPEC%numll(:)*YDSPEC%ns3d+YDSPEC%ns2l(:)
  ilenr(:)=YDCOLS%nspec2v*ilenr(:)
  ioffr(1)=0
  DO jp=2,NPRTRV
    ioffr(jp)=ioffr(jp-1)+ilenr(jp-1)
  ENDDO

  IF (ii/=YDSPEC%nspsizel) CALL ABOR1('TRMTOS_SPEC: Error packing')

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

! Unpack 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
          YDCOLS%SP3V(jl,js,jf)=ZBUFR(ii)
        ENDDO
      ENDDO
    ENDDO
    DO jf=1,YDSPEC%ns2l(jp)
      DO js=1,YDCOLS%NSPEC2V
        ii=ii+1
        YDCOLS%SP2V(js,jf)=ZBUFR(ii)
      ENDDO
    ENDDO
  ENDDO

  IF (ii/=YDCOLS%nsizel) CALL ABOR1('TRMTOS_SPEC: Error unpacking')

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

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