! (C) Copyright 2001- ECMWF.
! (C) Copyright 2001- Meteo-France.
! 
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
! In applying this licence, ECMWF does not waive the privileges and immunities
! granted to it by virtue of its status as an intergovernmental organisation
! nor does it submit to any jurisdiction.
! 


MODULE SUEMP_TRANS_MOD
CONTAINS
SUBROUTINE SUEMP_TRANS

! Set up distributed environment for the transform package (part 2)
!        R. El Khatib 09-Aug-2013 Allow LEQ_REGIONS

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

USE TPM_GEN         ,ONLY : NOUT, NPRINTLEV
USE TPM_DIM         ,ONLY : R
USE TPM_GEOMETRY    ,ONLY : G
USE TPM_DISTR       ,ONLY : D, LEQ_REGIONS, NPRTRNS, NPRTRV, NPRTRW, MYSETW, NPROC, MYPROC
USE TPMALD_DIM      ,ONLY : RALD
!USE TPMALD_DISTR
!USE SUWAVEDI_MOD
!USE PE2SET_MOD
USE SUMPLATF_MOD    ,ONLY : SUMPLATF
USE SUEMPLAT_MOD    ,ONLY : SUEMPLAT
USE SUESTAONL_MOD   ,ONLY : SUESTAONL
USE MYSENDSET_MOD   ,ONLY : MYSENDSET
USE MYRECVSET_MOD   ,ONLY : MYRECVSET
USE EQ_REGIONS_MOD  ,ONLY : MY_REGION_EW, MY_REGION_NS,           &
     &                      N_REGIONS, N_REGIONS_EW, N_REGIONS_NS
!

IMPLICIT NONE

INTEGER(KIND=JPIM) :: JM,JMLOC
INTEGER(KIND=JPIM) :: JGL,IGL,IPLAT,ISENDSET,IRECVSET,JML,IPOS,IM
INTEGER(KIND=JPIM) :: I1,I2,I3,IAUX0,IAUX1,JA1
INTEGER(KIND=JPIM) :: IGPTOT,IMEDIAP,IRESTM,JA,JB,IOFF
INTEGER(KIND=JPIM), ALLOCATABLE :: IGPTOTL(:,:)

REAL(KIND=JPRD) :: ZMEDIAP

LOGICAL    :: LLP1,LLP2
REAL(KIND=JPRD),ALLOCATABLE :: ZDUM(:)
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE

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

IF (LHOOK) CALL DR_HOOK('SUEMP_TRANS_MOD:SUEMP_TRANS',0,ZHOOK_HANDLE)
LLP1 = NPRINTLEV>0
LLP2 = NPRINTLEV>1
IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE SUEMP_TRANS ==='

IF(.NOT.D%LGRIDONLY) THEN
        
ALLOCATE(D%NULTPP(NPRTRNS))
IF(LLP2)WRITE(NOUT,9) 'D%NULTPP   ',SIZE(D%NULTPP   ),SHAPE(D%NULTPP   )
ALLOCATE(D%NPTRLS(NPRTRNS))
IF(LLP2)WRITE(NOUT,9) 'D%NPTRLS   ',SIZE(D%NPTRLS   ),SHAPE(D%NPTRLS   )
ALLOCATE(D%NPROCL(R%NDGL))
IF(LLP2)WRITE(NOUT,9) 'D%NPROCL   ',SIZE(D%NPROCL   ),SHAPE(D%NPROCL   )

CALL SUMPLATF(R%NDGL,NPRTRNS,MYSETW,D%NULTPP,D%NPROCL,D%NPTRLS)
D%NDGL_FS = D%NULTPP(MYSETW)

! Help arrays for spectral to fourier space transposition
ALLOCATE(D%NLTSGTB (NPRTRNS+1))
IF(LLP2)WRITE(NOUT,9) 'D%NLTSGTB ',SIZE(D%NLTSGTB),SHAPE(D%NLTSGTB)
ALLOCATE(D%NLTSFTB (NPRTRNS+1))
IF(LLP2)WRITE(NOUT,9) 'D%NLTSFTB ',SIZE(D%NLTSFTB),SHAPE(D%NLTSFTB)
ALLOCATE(D%NSTAGT0B(NPRTRNS+1))
IF(LLP2)WRITE(NOUT,9) 'D%NSTAGT0B ',SIZE(D%NSTAGT0B),SHAPE(D%NSTAGT0B)
ALLOCATE(D%NSTAGT1B(NPRTRNS+1))
IF(LLP2)WRITE(NOUT,9) 'D%NSTAGT1B ',SIZE(D%NSTAGT1B),SHAPE(D%NSTAGT1B)
ALLOCATE(D%MSTABF  (NPRTRNS+1))
IF(LLP2)WRITE(NOUT,9) 'D%MSTABF ',SIZE(D%MSTABF),SHAPE(D%MSTABF)

D%NLTSGTB(:) = 0
DO JGL=1,D%NDGL_FS
  IGL = D%NPTRLS(MYSETW)+JGL-1
  DO JM=0,G%NMEN(IGL)
    D%NLTSGTB(D%NPROCM(JM)) = D%NLTSGTB(D%NPROCM(JM))+1
  ENDDO
ENDDO
DO JA=1,NPRTRW
  IPLAT = 0
  DO JGL=1,D%NULTPP(JA)
    IGL = D%NPTRLS(JA)+JGL-1
    DO JM=1,D%NUMP
      IF(IGL > R%NDGNH-G%NDGLU(D%MYMS(JM)) .AND. IGL <= R%NDGNH+G%NDGLU(D%MYMS(JM))) THEN
        IPLAT = IPLAT + 1
      ENDIF
    ENDDO
  ENDDO
  D%NLTSFTB(JA) = IPLAT
ENDDO

DO JA=1,NPRTRW-1
  ISENDSET = MYSENDSET(NPRTRW,MYSETW,JA)
  IRECVSET = MYRECVSET(NPRTRW,MYSETW,JA)
  D%MSTABF(IRECVSET) = ISENDSET
ENDDO
D%MSTABF(MYSETW) = MYSETW

ALLOCATE(D%NPNTGTB0(0:RALD%NMSMAX,D%NDGL_FS))
IF(LLP2)WRITE(NOUT,9) 'D%NPNTGTB0 ',SIZE(D%NPNTGTB0 ),SHAPE(D%NPNTGTB0 )
ALLOCATE(D%NPNTGTB1(D%NUMP,R%NDGL))
IF(LLP2)WRITE(NOUT,9) 'D%NPNTGTB1 ',SIZE(D%NPNTGTB1 ),SHAPE(D%NPNTGTB1 )

DO JA=1,NPRTRW
  IPOS = 0
  DO JGL=1,D%NULTPP(MYSETW)
    IGL = D%NPTRLS(MYSETW) + JGL - 1
    DO JML=D%NPTRMS(JA),D%NPTRMS(JA)+D%NUMPP(JA)-1
      IM = D%NALLMS(JML)
      IF (IM  <=  G%NMEN(IGL)) THEN
        D%NPNTGTB0(IM,JGL) = IPOS
        IPOS = IPOS+1
      ELSE
        D%NPNTGTB0(IM,JGL) = -99
      ENDIF
    ENDDO
  ENDDO
ENDDO

DO JA=1,NPRTRW
  IPOS = 0
  DO JGL=1,D%NULTPP(JA)
    IGL = D%NPTRLS(JA) + JGL - 1
    DO JM=1,D%NUMP
      IM = D%MYMS(JM)
      IF (IM  <=  G%NMEN(IGL)) THEN
        D%NPNTGTB1(JM,IGL) = IPOS
        IPOS = IPOS+1
      ELSE
        D%NPNTGTB1(JM,IGL) = -99
      ENDIF
    ENDDO
  ENDDO
ENDDO

IAUX0 = 0
IAUX1 = 0
DO JA=1,NPRTRNS-1
  I1 = MYSENDSET(NPRTRNS,MYSETW,JA)
  I2 = MYRECVSET(NPRTRNS,MYSETW,JA)
  DO JA1=1,NPRTRNS-1
    IF(MYSENDSET(NPRTRNS,MYSETW,JA1) == I2) I3 =MYRECVSET(NPRTRNS,MYSETW,JA1)
  ENDDO
  IAUX0 = MAX(D%NLTSFTB(I1),D%NLTSGTB(I2),IAUX0)
  IAUX1 = MAX(D%NLTSGTB(I2),D%NLTSFTB(I3),IAUX1)
ENDDO
IAUX0 = MAX(D%NLTSGTB(MYSETW),IAUX0)
IAUX1 = MAX(D%NLTSGTB(MYSETW),IAUX1)
DO JA=1,NPRTRNS+1
  D%NSTAGT0B(JA) = (JA-1)*IAUX0
  D%NSTAGT1B(JA) = (JA-1)*IAUX1
ENDDO
D%NLENGT0B = IAUX0*NPRTRNS
D%NLENGT1B = IAUX1*NPRTRNS

ENDIF

! GRIDPOINT SPACE

ALLOCATE(D%NFRSTLAT(N_REGIONS_NS))
IF(LLP2)WRITE(NOUT,9) 'D%NFRSTLAT ',SIZE(D%NFRSTLAT ),SHAPE(D%NFRSTLAT )
ALLOCATE(D%NLSTLAT(N_REGIONS_NS))
IF(LLP2)WRITE(NOUT,9) 'D%NLSTLAT  ',SIZE(D%NLSTLAT  ),SHAPE(D%NLSTLAT  )
ALLOCATE(D%NPTRLAT(R%NDGL))
IF(LLP2)WRITE(NOUT,9) 'D%NPTRLAT  ',SIZE(D%NPTRLAT  ),SHAPE(D%NPTRLAT  )
ALLOCATE(D%NPTRFRSTLAT(N_REGIONS_NS))
IF(LLP2)WRITE(NOUT,9) 'D%NPTRFRSTLAT',SIZE(D%NPTRFRSTLAT),SHAPE(D%NPTRFRSTLAT)
ALLOCATE(D%NPTRLSTLAT(N_REGIONS_NS))
IF(LLP2)WRITE(NOUT,9)'D%NPTRLSTLAT',SIZE(D%NPTRLSTLAT),SHAPE(D%NPTRLSTLAT)
ALLOCATE(D%LSPLITLAT(R%NDGL))
IF(LLP2)WRITE(NOUT,9) 'D%LSPLITLAT',SIZE(D%LSPLITLAT),SHAPE(D%LSPLITLAT)
ALLOCATE(D%NPROCA_GP(N_REGIONS_NS))
IF(LLP2)WRITE(NOUT,9) 'D%NPROCA_GP',SIZE(D%NPROCA_GP),SHAPE(D%NPROCA_GP)


IF(.NOT.D%LWEIGHTED_DISTR) THEN
  ALLOCATE(ZDUM(1))
  CALL SUEMPLAT(R%NDGL,NPROC,N_REGIONS_NS,MY_REGION_NS,D%LSPLIT, LEQ_REGIONS,&
  & D%NFRSTLAT,D%NLSTLAT,D%NFRSTLOFF,D%NPTRLAT,&
  & D%NPTRFRSTLAT,D%NPTRLSTLAT,D%NPTRFLOFF,&
  & ZDUM,D%LWEIGHTED_DISTR,ZMEDIAP,D%NPROCA_GP,&
  & IMEDIAP,IRESTM,D%LSPLITLAT,MYPROC,G%NLOEN,RALD%NDGUX)
ELSE
 CALL SUEMPLAT(R%NDGL,NPROC,N_REGIONS_NS,MY_REGION_NS,D%LSPLIT, LEQ_REGIONS,&
  & D%NFRSTLAT,D%NLSTLAT,D%NFRSTLOFF,D%NPTRLAT,&
  & D%NPTRFRSTLAT,D%NPTRLSTLAT,D%NPTRFLOFF,&
  & D%RWEIGHT,D%LWEIGHTED_DISTR,ZMEDIAP,D%NPROCA_GP,&
  & IMEDIAP,IRESTM,D%LSPLITLAT,MYPROC,G%NLOEN,RALD%NDGUX)  
ENDIF
D%NDGL_GP = D%NLSTLAT(MY_REGION_NS)-D%NFRSTLOFF

IF (LLP1) THEN
  IF(.NOT.D%LGRIDONLY) THEN      
  WRITE(NOUT,FMT='(/'' OUTPUT FROM ROUTINE SUEMPLAT: ''/)')
  WRITE(NOUT,FMT='('' D%NULTPP '')')
  WRITE(NOUT,FMT='(20(1X,I4))') D%NULTPP(1:NPRTRNS)
  WRITE(NOUT,FMT='('' D%NPROCL '')')
  WRITE(NOUT,FMT='(20(1X,I4))') D%NPROCL(1:R%NDGL)
  ENDIF
  WRITE(NOUT,FMT='('' D%NFRSTLAT '')')
  WRITE(NOUT,FMT='(20(1X,I4))') D%NFRSTLAT(1:N_REGIONS_NS)
  WRITE(NOUT,FMT='('' D%NLSTLAT '')')
  WRITE(NOUT,FMT='(20(1X,I4))') D%NLSTLAT(1:N_REGIONS_NS)
  WRITE(NOUT,FMT='('' D%NFRSTLOFF  D%NPTRFLOFF '')')
  WRITE(NOUT,FMT='(2(1X,I6))') D%NFRSTLOFF, D%NPTRFLOFF
  WRITE(NOUT,FMT='('' D%NPTRLAT '')')
  WRITE(NOUT,FMT='(20(1X,I4))') D%NPTRLAT(1:R%NDGL)
  WRITE(NOUT,FMT='('' D%LSPLITLAT '')')
  WRITE(NOUT,FMT='(50(1X,L1))') D%LSPLITLAT(1:R%NDGL)
  WRITE(NOUT,FMT='('' D%NPTRFRSTLAT '')')
  WRITE(NOUT,FMT='(20(1X,I4))') D%NPTRFRSTLAT(1:N_REGIONS_NS)
  WRITE(NOUT,FMT='('' D%NPTRLSTLAT '')')
  WRITE(NOUT,FMT='(20(1X,I4))') D%NPTRLSTLAT(1:N_REGIONS_NS)
  WRITE(NOUT,FMT='(/)')
ENDIF
ALLOCATE(D%NSTA(R%NDGL+N_REGIONS_NS-1,N_REGIONS_EW))
IF(LLP2)WRITE(NOUT,9) 'D%NSTA     ',SIZE(D%NSTA     ),SHAPE(D%NSTA     )
ALLOCATE(D%NONL(R%NDGL+N_REGIONS_NS-1,N_REGIONS_EW))
IF(LLP2)WRITE(NOUT,9) 'D%NONL     ',SIZE(D%NONL     ),SHAPE(D%NONL     )

IF(.NOT.D%LWEIGHTED_DISTR) THEN
 CALL SUESTAONL(IMEDIAP,IRESTM,D%LWEIGHTED_DISTR,ZDUM,ZMEDIAP,D%NPROCA_GP)
ELSE
 CALL SUESTAONL(IMEDIAP,IRESTM,D%LWEIGHTED_DISTR,D%RWEIGHT,ZMEDIAP,D%NPROCA_GP)
ENDIF
!  IGPTOTL is the number of grid points in each individual processor
ALLOCATE(IGPTOTL(N_REGIONS_NS,N_REGIONS_EW))
IGPTOTL(:,:)=0
DO JA=1,N_REGIONS_NS
  DO JB=1,N_REGIONS(JA)
    IGPTOT = 0
    DO JGL=D%NPTRFRSTLAT(JA),D%NPTRLSTLAT(JA)
      IGPTOT = IGPTOT+D%NONL(JGL,JB)
    ENDDO
    IGPTOTL(JA,JB) = IGPTOT
  ENDDO
ENDDO
D%NGPTOT = IGPTOTL(MY_REGION_NS,MY_REGION_EW)
D%NGPTOTMX = MAXVAL(IGPTOTL)
D%NGPTOTG = SUM(IGPTOTL)
ALLOCATE(D%NGPTOTL(N_REGIONS_NS,N_REGIONS_EW))
IF(LLP2)WRITE(NOUT,9) 'D%NGPTOTL     ',SIZE(D%NGPTOTL ),SHAPE(D%NGPTOTL  )
D%NGPTOTL(:,:) = IGPTOTL(:,:)

IF(.NOT.D%LGRIDONLY) THEN
ALLOCATE(D%NSTAGTF(D%NDGL_FS))
IF(LLP2)WRITE(NOUT,9) 'D%NSTAGTF     ',SIZE(D%NSTAGTF ),SHAPE(D%NSTAGTF  )
IOFF = 0
DO JGL=1,D%NDGL_FS
  D%NSTAGTF(JGL) = IOFF
  IGL = D%NPTRLS(MYSETW) + JGL - 1
  IOFF = IOFF + G%NLOEN(IGL)+3+R%NNOEXTZL
ENDDO
D%NLENGTF = IOFF
ENDIF

IF(ALLOCATED(ZDUM)) DEALLOCATE(ZDUM)
DEALLOCATE(IGPTOTL)
IF (LHOOK) CALL DR_HOOK('SUEMP_TRANS_MOD:SUEMP_TRANS',1,ZHOOK_HANDLE)

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

END SUBROUTINE SUEMP_TRANS
END MODULE SUEMP_TRANS_MOD

