MODULE SUMP_TRANS_PRELEG_MOD
CONTAINS
SUBROUTINE SUMP_TRANS_PRELEG

! Set up distributed environment for the transform package (part 1)

USE PARKIND1  ,ONLY : JPIM     ,JPRB

USE TPM_GEN
USE TPM_DIM 
USE TPM_DISTR

USE SUWAVEDI_MOD
USE ABORT_TRANS_MOD

IMPLICIT NONE

INTEGER(KIND=JPIM) :: JA,JJ,JM,JMLOC,ILATPP,IRESTL,IMLOC,IDT,INM

INTEGER(KIND=JPIM) :: IMYMS(R%NSMAX+1),INUMTPP(NPRTRW)
INTEGER(KIND=JPIM) :: IDUMI1,IDUMI2,IDUMI3
INTEGER(KIND=JPIM) :: IDUM2(0:R%NSMAX), IDUM3(NPRTRW+1), IDUM4(R%NSMAX+1)

LOGICAL :: LLP1,LLP2

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

IF(.NOT.D%LGRIDONLY) THEN

LLP1 = NPRINTLEV>0
LLP2 = NPRINTLEV>1
IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE SUMP_TRANS_PRELEG ==='

!*       1.    Initialize partitioning of wave numbers to PEs ! 
!             ----------------------------------------------

  ALLOCATE(D%NASM0(0:R%NSMAX))
  IF(LLP2)WRITE(NOUT,9) 'D%NASM0 ',SIZE(D%NASM0   ),SHAPE(D%NASM0   )
  ALLOCATE(D%NATM0(0:R%NTMAX))
  IF(LLP2)WRITE(NOUT,9) 'D%NATM0 ',SIZE(D%NATM0   ),SHAPE(D%NATM0   )
  ALLOCATE(D%NUMPP(NPRTRW))
  IF(LLP2)WRITE(NOUT,9) 'D%NUMPP ',SIZE(D%NUMPP   ),SHAPE(D%NUMPP   )
  ALLOCATE(D%NPOSSP(NPRTRW+1))
  IF(LLP2)WRITE(NOUT,9) 'D%NPOSSP',SIZE(D%NPOSSP  ),SHAPE(D%NPOSSP  )
  ALLOCATE(D%NPROCM(0:R%NSMAX))
  IF(LLP2)WRITE(NOUT,9) 'D%NPROCM',SIZE(D%NPROCM  ),SHAPE(D%NPROCM  )
  ALLOCATE(D%NPTRMS(NPRTRW))
  IF(LLP2)WRITE(NOUT,9) 'D%NPTRMS   ',SIZE(D%NPTRMS   ),SHAPE(D%NPTRMS   )
  ALLOCATE(D%NALLMS(R%NSMAX+1))
  IF(LLP2)WRITE(NOUT,9) 'D%NALLMS   ',SIZE(D%NALLMS   ),SHAPE(D%NALLMS   )
  ALLOCATE(D%NDIM0G(0:R%NSMAX))
  IF(LLP2)WRITE(NOUT,9) 'D%NDIM0G   ',SIZE(D%NDIM0G   ),SHAPE(D%NDIM0G   )

  CALL SUWAVEDI(R%NSMAX,R%NTMAX,NPRTRW,MYSETW,&
      &D%NASM0,D%NSPOLEGL,D%NPROCM,D%NUMPP,&
      &D%NSPEC,D%NSPEC2,D%NSPEC2MX,D%NPOSSP,IMYMS,&
      &D%NPTRMS,D%NALLMS,D%NDIM0G)
  CALL SUWAVEDI(R%NTMAX,R%NTMAX,NPRTRW,MYSETW,&
      &KASM0=D%NATM0,KUMPP=INUMTPP,KSPEC2=D%NTPEC2)

  D%NUMP  = D%NUMPP (MYSETW)
  ALLOCATE(D%MYMS(D%NUMP))
  IF(LLP2)WRITE(NOUT,9) 'D%MYMS    ',SIZE(D%MYMS   ),SHAPE(D%MYMS   )
  D%MYMS(:) = IMYMS(1:D%NUMP)
  D%NUMTP = INUMTPP(MYSETW)
  
  ALLOCATE(D%NLATLS(NPRTRW))
  IF(LLP2)WRITE(NOUT,9) 'D%NLATLS',SIZE(D%NLATLS   ),SHAPE(D%NLATLS )
  ALLOCATE(D%NLATLE(NPRTRW))
  IF(LLP2)WRITE(NOUT,9) 'D%NLATLE',SIZE(D%NLATLE   ),SHAPE(D%NLATLE )

  D%NLATLS(:) = 9999
  D%NLATLE(:) = -1

  ILATPP = R%NDGNH/NPRTRW
  IRESTL  = R%NDGNH-NPRTRW*ILATPP
  DO JA=1,NPRTRW
    IF (JA > IRESTL) THEN
      D%NLATLS(JA) = IRESTL*(ILATPP+1)+(JA-IRESTL-1)*ILATPP+1
      D%NLATLE(JA) = D%NLATLS(JA)+ILATPP-1
    ELSE
      D%NLATLS(JA) = (JA-1)*(ILATPP+1)+1
      D%NLATLE(JA) = D%NLATLS(JA)+ILATPP
    ENDIF
  ENDDO

  IF (LLP1) THEN
    WRITE(NOUT,'('' D%NLATLS '')')
    WRITE(NOUT,'(20(1X,I4))')(D%NLATLS(JJ),JJ=1,NPRTRW)
    WRITE(NOUT,'('' D%NLATLE '')')
    WRITE(NOUT,'(20(1X,I4))')(D%NLATLE(JJ),JJ=1,NPRTRW)
  ENDIF

  ALLOCATE(D%NPMT(0:R%NSMAX))
  IF(LLP2)WRITE(NOUT,9) 'D%NPMT   ',SIZE(D%NPMT   ),SHAPE(D%NPMT   )
  ALLOCATE(D%NPMS(0:R%NSMAX))
  IF(LLP2)WRITE(NOUT,9) 'D%NPMS   ',SIZE(D%NPMS   ),SHAPE(D%NPMS   )
  ALLOCATE(D%NPMG(0:R%NSMAX))
  IF(LLP2)WRITE(NOUT,9) 'D%NPMG   ',SIZE(D%NPMG   ),SHAPE(D%NPMG   )
  IDT = R%NTMAX-R%NSMAX
  INM = 0
  DO JMLOC=1,D%NUMP
    IMLOC = D%MYMS(JMLOC)
    D%NPMT(IMLOC) = INM
    D%NPMS(IMLOC) = INM+IDT
    INM = INM+R%NTMAX+2-IMLOC
  ENDDO
  INM = 0
  DO JM=0,R%NSMAX
    D%NPMG(JM) = INM
    INM = INM+R%NTMAX+2-JM
  ENDDO

  D%NLEI3D = (R%NLEI3-1)/NPRTRW+1

ENDIF

!     ------------------------------------------------------------------
9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)

END SUBROUTINE SUMP_TRANS_PRELEG
END MODULE SUMP_TRANS_PRELEG_MOD
