MODULE SUEMP_TRANS_PRELEG_MOD
CONTAINS
SUBROUTINE SUEMP_TRANS_PRELEG

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

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

USE TPM_GEN         ,ONLY : NOUT, NPRINTLEV
USE TPM_DIM         ,ONLY : R
USE TPM_DISTR       ,ONLY : D, NPRTRW, NPRTRV, MYSETW

USE TPMALD_DISTR    ,ONLY : DALD
USE TPMALD_DIM      ,ONLY : RALD
USE TPMALD_FIELDS   ,ONLY : FALD
USE TPMALD_GEO      ,ONLY : GALD

!USE SUWAVEDI_MOD
!USE ABORT_TRANS_MOD

IMPLICIT NONE

INTEGER(KIND=JPIM) :: JA,JM,JMLOC,JW,JV,ILATPP,IRESTL,IMLOC,IDT,INM,JN,IM,ILAST

LOGICAL :: LLP1,LLP2

INTEGER(KIND=JPIM) :: ISPEC(NPRTRW),IMYMS(RALD%NMSMAX+1),IKNTMP(0:RALD%NMSMAX)
INTEGER(KIND=JPIM) :: IKMTMP(0:R%NSMAX),ISPEC2P
INTEGER(KIND=JPIM) :: IC(NPRTRW)
INTEGER(KIND=JPIM) :: IMDIM,IL,IND,IK,IPOS,IKM
REAL(KIND=JPRB) :: ZLEPDIM
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE

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

IF (LHOOK) CALL DR_HOOK('SUEMP_TRANS_PRELEG_MOD:SUEMP_TRANS_PRELEG',0,ZHOOK_HANDLE)

IF(.NOT.D%LGRIDONLY) THEN
        
LLP1 = NPRINTLEV>0
LLP2 = NPRINTLEV>1
IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE SUEMP_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(DALD%NESM0(0:RALD%NMSMAX))
IF(LLP2)WRITE(NOUT,9) 'DALD%NESM0 ',SIZE(DALD%NESM0   ),SHAPE(DALD%NESM0   )

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:RALD%NMSMAX))
IF(LLP2)WRITE(NOUT,9) 'D%NPROCM',SIZE(D%NPROCM  ),SHAPE(D%NPROCM  )

ALLOCATE(DALD%NPME(0:RALD%NMSMAX))
IF(LLP2)WRITE(NOUT,9) 'DALD%NPME',SIZE(DALD%NPME),SHAPE(DALD%NPME)
ALLOCATE(DALD%NCPL2M(0:RALD%NMSMAX))
IF(LLP2)WRITE(NOUT,9) 'DALD%NCPL2M',SIZE(DALD%NCPL2M),SHAPE(DALD%NCPL2M)
CALL ELLIPS(R%NSMAX,RALD%NMSMAX,IKNTMP,IKMTMP)
DALD%NPME(0)=1
DO JM=1,RALD%NMSMAX
  DALD%NPME(JM)=DALD%NPME(JM-1)+IKNTMP(JM-1)+1
ENDDO
DO JM=0,RALD%NMSMAX
  DALD%NCPL2M(JM) = 2*(IKNTMP(JM)+1)
ENDDO
ALLOCATE(FALD%RLEPINM(R%NSPEC_G/2))
IF(LLP2)WRITE(NOUT,9) 'FALD%RLEPINM',SIZE(FALD%RLEPINM),SHAPE(FALD%RLEPINM)
DO JM=0,RALD%NMSMAX
  DO JN=1,IKNTMP(JM)
    ZLEPDIM=-((REAL(JM,JPRB)**2)*(GALD%EXWN**2)+&
     & (REAL(JN,JPRB)**2)*(GALD%EYWN**2))  
    FALD%RLEPINM(DALD%NPME(JM)+JN)=1./ZLEPDIM
  ENDDO
ENDDO
DO JM=1,RALD%NMSMAX
  ZLEPDIM=-(REAL(JM,JPRB)**2)*(GALD%EXWN**2)
  FALD%RLEPINM(DALD%NPME(JM))=1./ZLEPDIM
ENDDO
FALD%RLEPINM(DALD%NPME(0))=0.

D%NUMPP(:) = 0
ISPEC(:) = 0
DALD%NESM0(:)=-99

IMDIM = 0
IL = 1
IND = 1
IK  = 0
IPOS = 1
DO JM=0,RALD%NMSMAX
  IK = IK + IND
  IF (IK > NPRTRW) THEN
    IK = NPRTRW
    IND = -1
  ELSEIF (IK < 1) THEN
    IK = 1
    IND = 1
  ENDIF

  IKM =DALD%NCPL2M(JM)/2 -1
  D%NPROCM(JM) = IK
  ISPEC(IK) = ISPEC(IK)+IKM+1
  D%NUMPP(IK) = D%NUMPP(IK)+1
  IF (IK == MYSETW) THEN
    IMDIM = IMDIM + IKM+1
    IMYMS(IL) = JM
    DALD%NESM0(JM) = IPOS
    IPOS = IPOS+(IKM+1)*4
    IL = IL+1
  ENDIF
ENDDO
D%NPOSSP(1) = 1
ISPEC2P = 4*ISPEC(1)
D%NSPEC2MX = ISPEC2P
DO JA=2,NPRTRW
  D%NPOSSP(JA) = D%NPOSSP(JA-1)+ISPEC2P
  ISPEC2P = 4*ISPEC(JA)
  D%NSPEC2MX=MAX(D%NSPEC2MX,ISPEC2P)
ENDDO
D%NPOSSP(NPRTRW+1) = D%NPOSSP(NPRTRW)+ISPEC2P

D%NSPEC2 = 4*IMDIM
D%NSPEC=D%NSPEC2

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 = D%NUMP 

! pointer to the first wave number of a given wave-set in NALLMS array
ALLOCATE(D%NPTRMS(NPRTRW))
IF(LLP2)WRITE(NOUT,9) 'D%NPTRMS   ',SIZE(D%NPTRMS   ),SHAPE(D%NPTRMS   )
D%NPTRMS(:) = 1
DO JA=2,NPRTRW
  D%NPTRMS(JA) = D%NPTRMS(JA-1)+D%NUMPP(JA-1)
ENDDO
!  D%NALLMS :  wave numbers for all wave-set concatenated together to give all
!            wave numbers in wave-set order.
ALLOCATE(D%NALLMS(RALD%NMSMAX+1))
IF(LLP2)WRITE(NOUT,9) 'D%NALLMS   ',SIZE(D%NALLMS   ),SHAPE(D%NALLMS   )
IC(:) = 0
DO JM=0,RALD%NMSMAX
  D%NALLMS(IC(D%NPROCM(JM))+D%NPTRMS(D%NPROCM(JM))) = JM
  IC(D%NPROCM(JM)) = IC(D%NPROCM(JM))+1
ENDDO
ALLOCATE(D%NDIM0G(0:RALD%NMSMAX))
IF(LLP2)WRITE(NOUT,9) 'D%NDIM0G   ',SIZE(D%NDIM0G   ),SHAPE(D%NDIM0G   )
IPOS = 1
DO JA=1,NPRTRW
  DO JMLOC=1,D%NUMPP(JA)
    IM = D%NALLMS(D%NPTRMS(JA)+JMLOC-1)
    D%NDIM0G(IM) = IPOS
    IPOS = IPOS+2*DALD%NCPL2M(IM)
  ENDDO
ENDDO

ALLOCATE(D%NLATLS(NPRTRW,NPRTRV))
IF(LLP2)WRITE(NOUT,9) 'D%NLATLS',SIZE(D%NLATLS   ),SHAPE(D%NLATLS )
ALLOCATE(D%NLATLE(NPRTRW,NPRTRV))
IF(LLP2)WRITE(NOUT,9) 'D%NLATLE',SIZE(D%NLATLE   ),SHAPE(D%NLATLE )

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

ILATPP = R%NDGL/NPRTRW
IRESTL  = R%NDGL-NPRTRW*ILATPP
DO JW=1,NPRTRW
  IF (JW > IRESTL) THEN
    D%NLATLS(JW,1) = IRESTL*(ILATPP+1)+(JA-IRESTL-1)*ILATPP+1
    D%NLATLE(JW,1) = D%NLATLS(JW,1)+ILATPP-1
  ELSE
    D%NLATLS(JW,1) = (JA-1)*(ILATPP+1)+1
    D%NLATLE(JW,1) = D%NLATLS(JW,1)+ILATPP
  ENDIF
ENDDO
ILAST=0
DO JW=1,NPRTRW
  ILATPP = (D%NLATLE(JW,1)-D%NLATLS(JW,1)+1)/NPRTRV
  IRESTL  = (D%NLATLE(JW,1)-D%NLATLS(JW,1)+1)-NPRTRV*ILATPP
  DO JV=1,NPRTRV
    IF (JV > IRESTL) THEN
      D%NLATLS(JW,JV) = IRESTL*(ILATPP+1)+(JV-IRESTL-1)*ILATPP+1+ILAST
      D%NLATLE(JW,JV) = D%NLATLS(JW,JV)+ILATPP-1
    ELSE
      D%NLATLS(JW,JV) = (JV-1)*(ILATPP+1)+1+ILAST
      D%NLATLE(JW,JV) = D%NLATLS(JW,JV)+ILATPP
    ENDIF
  ENDDO
  ILAST=D%NLATLE(JW,NPRTRV)
ENDDO
IF (LLP1) THEN
  DO JW=1,NPRTRW
    DO JV=1,NPRTRV
      WRITE(NOUT,'(" JW=",I6," JV=",I6," D%NLATLS=",I6," D%NLATLE=",I6)')&
         & JW,JV,D%NLATLS(JW,JV),D%NLATLE(JW,JV)
    ENDDO
  ENDDO
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)

  INM = INM+R%NTMAX+2-IMLOC
ENDDO
INM = 0
DO JM=0,R%NSMAX

  INM = INM+R%NTMAX+2-JM
ENDDO

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

ENDIF

IF (LHOOK) CALL DR_HOOK('SUEMP_TRANS_PRELEG_MOD:SUEMP_TRANS_PRELEG',1,ZHOOK_HANDLE)

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

END SUBROUTINE SUEMP_TRANS_PRELEG
END MODULE SUEMP_TRANS_PRELEG_MOD
