! (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 SUEMPLATB_MOD
CONTAINS
SUBROUTINE SUEMPLATB(KDGSA,KDGL,KPROCA,KLOENG,LDSPLIT,&
 & PWEIGHT,LDWEIGHTED_DISTR,PMEDIAP,KPROCAGP,&
 & KMEDIAP,KRESTM,KINDIC,KLAST,KDGUX)  

!**** *SUMPLATB * - Routine to initialize parallel environment

!     Purpose.
!     --------

!**   Interface.
!     ----------
!        *CALL* *SUMPLATB *

!     Explicit arguments - input :
!     -------------------- 
!                          KDGSA      -first latitude (grid-space)
!                                      (may be different from NDGSAG)
!                          KDGL       -last  latitude
!                          KPROCA     -number of processors in A direction
!                          KLOENG     -actual number of longitudes per latitude.
!                          LDSPLIT    -true for latitudes shared between sets
!                          KDGUX      -last latitude for meaningful computations
!                                      (suggested to pass NDGUX in gp-space, NDGL in Fourier space
!                                       for having a good load-balance)
!                          PWEIGHT    -weight per grid-point if weighted distribution
!                          LDWEIGHTED_DISTR -true if weighted distribution`

!     Explicit arguments - output:
!     -------------------- 
!                          KMEDIAP    -mean number of grid points per PE
!                          KPROCAGP   -number of grid points per A set
!                          KRESTM     -number of PEs with one extra point
!                          KINDIC     -intermediate quantity for 'sumplat'
!                          KLAST      -intermediate quantity for 'sumplat'
!                          PMEDIAP    -mean weight per PE if weighted distribution

!        Implicit arguments :
!        --------------------

!     Method.
!     -------
!        See documentation

!     Externals.   NONE.
!     ----------

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        K. YESSAD (after old version of sumplat.F).

!     Modifications.
!     --------------
!        Original : 98-12-07
!         G. Radnoti: 03-03-03: Semi-merge with sumplatb, only difference:
!                               NS-partitioning according to NDGUX
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        A.Bogatchev   21-Sep-2010 phasing CY37
!     ------------------------------------------------------------------

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

USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS
!

IMPLICIT NONE

!     * DUMMY:
INTEGER(KIND=JPIM),INTENT(IN)  :: KDGSA
INTEGER(KIND=JPIM),INTENT(IN)  :: KDGL
INTEGER(KIND=JPIM),INTENT(IN)  :: KPROCA
INTEGER(KIND=JPIM),INTENT(IN)  :: KLOENG(KDGSA:KDGL)
REAL(KIND=JPRD),INTENT(IN)     :: PWEIGHT(:)
LOGICAL,INTENT(IN)  :: LDSPLIT
LOGICAL,INTENT(INOUT)  :: LDWEIGHTED_DISTR
INTEGER(KIND=JPIM),INTENT(IN)  :: KDGUX
INTEGER(KIND=JPIM),INTENT(OUT)  :: KMEDIAP
INTEGER(KIND=JPIM),INTENT(OUT)  :: KRESTM
INTEGER(KIND=JPIM),INTENT(OUT)  :: KINDIC(KPROCA)
INTEGER(KIND=JPIM),INTENT(OUT)  :: KLAST(KPROCA)
INTEGER(KIND=JPIM),INTENT(IN)  :: KPROCAGP(KPROCA)
REAL(KIND=JPRD),INTENT(IN)     :: PMEDIAP

INTEGER(KIND=JPIM) :: IPP1(KPROCA),ILAST1(KPROCA)
INTEGER(KIND=JPIM) :: IPP(KPROCA)
INTEGER(KIND=JPIM) :: IFIRST(KPROCA)

INTEGER(KIND=JPIM) :: ICOMP, IGL, IMAXI, IMAXIOL, IMEDIA, ITOT, JA, JGL,&
 & ILAST,IREST,ILIMIT,IFRST
LOGICAL   :: LLDONE
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE

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

!*       1.    COMPUTATION OF KMEDIAP, KRESTM, KINDIC, KLAST.
!              ----------------------------------------------

!     * Computation of KMEDIAP and KRESTM.

IF (LHOOK) CALL DR_HOOK('SUEMPLATB_MOD:SUEMPLATB',0,ZHOOK_HANDLE)
IF (LDWEIGHTED_DISTR) THEN
  CALL ABORT_TRANS ('SUMPLATBEQ: ALADIN CODE IS NOT PREPARED FOR WEIGHTED DISTRIBUTION')
ENDIF
IMEDIA = SUM(KLOENG(KDGSA:KDGUX))
KMEDIAP = IMEDIA / KPROCA
IF (KMEDIAP  <  KLOENG(KDGL/2)) THEN
  CALL ABORT_TRANS ('SUMPLATB: KPROCA TOO BIG FOR THIS RESOLUTION')
ENDIF
KRESTM = IMEDIA - KMEDIAP * KPROCA
IF (KRESTM  >  0) KMEDIAP = KMEDIAP + 1

!     * Computation of intermediate quantities KINDIC and KLAST

IF (LDSPLIT) THEN

  IREST = 0
  ILAST =0
  DO JA=1,KPROCA
    IF (JA  <=  KRESTM .OR. KRESTM  ==  0) THEN
      ICOMP = KMEDIAP
    ELSE
      ICOMP = KMEDIAP - 1
    ENDIF
    ITOT = IREST
    IGL = ILAST+1
    DO JGL=IGL,KDGUX
      ILAST = JGL
      IF(ITOT+KLOENG(JGL) < ICOMP) THEN
        ITOT = ITOT+KLOENG(JGL)
      ELSEIF(ITOT+KLOENG(JGL) == ICOMP) THEN
        IREST = 0
        KLAST(JA) = JGL 
        KINDIC(JA) = 0
        EXIT
      ELSE
        IREST =  KLOENG(JGL) -(ICOMP-ITOT)
        KLAST(JA) = JGL 
        KINDIC(JA) = JGL
        EXIT
      ENDIF
    ENDDO
  ENDDO
  KLAST(KPROCA)=KDGL
  KINDIC(KPROCA)=0
ELSE

  KINDIC(:) = 0

  IMAXI = KMEDIAP-1
  IMAXIOL = HUGE(IMAXIOL)
  DO
    ILIMIT = IMAXI
    IMAXI = 0
    IFRST = KDGUX
    ILAST1(:) = 0
    IPP1(:) = 0
    DO JA=KPROCA,1,-1
      IGL = IFRST
      LATS:DO JGL=IGL,1,-1
        IF (IPP1(JA) < ILIMIT .OR. JA == 1) THEN
          IFRST = JGL-1
          IPP1(JA) = IPP1(JA) + KLOENG(JGL)
          IF(ILAST1(JA)  ==  0) ILAST1(JA) = JGL
        ELSE
          EXIT LATS
        ENDIF
      ENDDO LATS
      IMAXI = MAX (IMAXI,IPP1(JA))
    ENDDO
    IF(IMAXI >= IMAXIOL) EXIT
    KLAST(:) = ILAST1(:)
    IPP(:) = IPP1(:)
    IMAXIOL = IMAXI
  ENDDO

!       make the distribution more uniform
!       ----------------------------------

  IFIRST(1) = 0
  IF (KLAST(1) > 0) IFIRST(1) = 1
  DO JA=2,KPROCA
    IF (IPP(JA) > 0) THEN
      IFIRST(JA) = KLAST(JA-1)+1
    ELSE
      IFIRST(JA) = 0
    ENDIF
  ENDDO

  LLDONE = .FALSE.
  DO WHILE( .NOT.LLDONE )
    LLDONE = .TRUE.

    DO JA=1,KPROCA-1
      IF (IPP(JA) > IPP(JA+1)) THEN
        IF (IPP(JA)-IPP(JA+1)  >  IPP(JA+1) + 2 *&
           & KLOENG(KLAST(JA)) -IPP(JA) ) THEN  
          IPP(JA) = IPP(JA) - KLOENG(KLAST(JA))
          IPP(JA+1) = IPP(JA+1) + KLOENG(KLAST(JA))
          IF (KLAST(JA+1)  ==  0) KLAST(JA+1) = KLAST(JA)
          IFIRST(JA+1) = KLAST(JA)
          KLAST(JA) = KLAST(JA) - 1
          IF (KLAST(JA) == 0) IFIRST(JA) = 0
          LLDONE = .FALSE.
        ENDIF
      ELSE
        IF( IFIRST(JA+1) > 0 )THEN
          IF (IPP(JA+1)-IPP(JA)  >=  IPP(JA) + 2 *&
             & KLOENG(IFIRST(JA+1)) -IPP(JA+1) ) THEN  
            IPP(JA) = IPP(JA) + KLOENG(IFIRST(JA+1))
            IPP(JA+1) = IPP(JA+1) - KLOENG(IFIRST(JA+1))
            KLAST(JA) = IFIRST(JA+1)
            IF (IFIRST(JA) == 0) IFIRST(JA) = KLAST(JA)
            IF (KLAST(JA+1)  ==  KLAST(JA)) THEN
              KLAST(JA+1) = 0
              IFIRST(JA+1) = 0
            ELSE
              IFIRST(JA+1) = IFIRST(JA+1) + 1
            ENDIF
            LLDONE = .FALSE.
          ENDIF
        ENDIF
      ENDIF
    ENDDO
  ENDDO
  KLAST(KPROCA)=KDGL
ENDIF

IF (LHOOK) CALL DR_HOOK('SUEMPLATB_MOD:SUEMPLATB',1,ZHOOK_HANDLE)
END SUBROUTINE SUEMPLATB
END MODULE SUEMPLATB_MOD
