! (C) Copyright 2006- ECMWF.
! (C) Copyright 2006- 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 SUMPLATBEQ_MOD
CONTAINS
SUBROUTINE SUMPLATBEQ(KDGSA,KDGL,KPROC,KPROCA,KLOENG,LDSPLIT,LDEQ_REGIONS,&
                    &PWEIGHT,LDWEIGHTED_DISTR,PMEDIAP,KPROCAGP,&
                    &KMEDIAP,KRESTM,KINDIC,KLAST)

!**** *SUMPLATBEQ * - Routine to initialize parallel environment
!                     (latitude partitioning for LEQ_REGIONS=T)

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


!**   Interface.
!     ----------
!        *CALL* *SUMPLATBEQ *

!     Explicit arguments - input :
!     --------------------
!                          KDGSA      -first latitude (grid-space)
!                                      (may be different from NDGSAG)
!                          KDGL       -last  latitude
!                          KPROC      -total number of processors
!                          KPROCA     -number of processors in A direction
!                          KLOENG     -actual number of longitudes per latitude.
!                          LDSPLIT    -true for latitudes shared between sets
!                          LDEQ_REGIONS -true if eq_regions partitioning
!                          PWEIGHT    -weight per grid-point if weighted distribution
!                          LDWEIGHTED_DISTR -true if weighted distribution

!     Explicit arguments - output:
!     --------------------
!                          PMEDIAP    -mean weight per PE if weighted distribution
!                          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'

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


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

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

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

!     Author.
!     -------
!        G. Mozdzynski

!     Modifications.
!     --------------
!        Original : April 2006
!     ------------------------------------------------------------------


USE EC_PARKIND      ,ONLY : JPIM     ,JPRD

USE TPM_DISTR       ,ONLY : MYPROC
USE EQ_REGIONS_MOD  ,ONLY : N_REGIONS
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)  :: KPROC
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(IN)  :: LDEQ_REGIONS
LOGICAL,INTENT(INOUT)  :: LDWEIGHTED_DISTR
REAL(KIND=JPRD),INTENT(OUT)     :: PMEDIAP
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(OUT)  :: KPROCAGP(KPROCA)

!     * LOCAL:

!     LOCAL INTEGER SCALARS
INTEGER(KIND=JPIM) :: ICOMP, IGL, IMAXI, IMEDIA, IMEDIAP, ITOT, JA, JB, IA, JGL,&
            &ILAST,IREST,IPE,I2REGIONS,IGP
REAL(KIND=JPRD) :: ZMEDIA, ZCOMP
LOGICAL   :: LLDONE

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

!*       1.    COMPUTATION OF KMEDIAP, KRESTM, KINDIC, KLAST.
!              ----------------------------------------------
100 CONTINUE
!     * Computation of KMEDIAP and KRESTM.

IF (.NOT.LDWEIGHTED_DISTR) THEN

  IMEDIA = SUM(KLOENG(KDGSA:KDGL))
  KMEDIAP = IMEDIA / KPROC

  IF( KPROC > 1 )THEN
! test if KMEDIAP is too small and no more than 2 asets would be required
! for the first latitude
    IF( LDSPLIT )THEN
      I2REGIONS=N_REGIONS(1)+N_REGIONS(2)
      IF( KMEDIAP < (KLOENG(KDGSA)-1)/I2REGIONS+1 )THEN
        WRITE(0,'("SUMPLATBEQ: KMEDIAP=",I6," I2REGIONS=",I3," KLOENG(KDGSA)=",I4)')&
        &KMEDIAP,I2REGIONS,KLOENG(KDGSA)
        CALL ABORT_TRANS ('SUMPLATBEQ: NPROC TOO BIG FOR THIS RESOLUTION, LDSPLIT=T')
      ENDIF
    ELSE
! test for number asets too large for the number of latitudes
      IF( KPROCA > KDGL )THEN
        WRITE(0,'("SUMPLATBEQ: KMEDIAP=",I6," KPROCA=",I4," KDGL=",I4)')&
        &KMEDIAP,KPROCA,KDGL
        CALL ABORT_TRANS ('SUMPLATBEQ: NPROC TOO BIG FOR THIS RESOLUTION, LDSPLIT=F')
      ENDIF
    ENDIF
  ENDIF

  KRESTM = IMEDIA - KMEDIAP * KPROC
  IF (KRESTM  >  0) KMEDIAP = KMEDIAP + 1

ELSE

  ZMEDIA = SUM(PWEIGHT(:))
  PMEDIAP = ZMEDIA / KPROC

ENDIF

!     * Computation of intermediate quantities KINDIC and KLAST

IF (LDSPLIT) THEN

  KPROCAGP(:)=0
  IREST = 0
  ILAST =0
  IPE=0
  ZCOMP=0
  IGP=0
  DO JA=1,KPROCA
    ICOMP=0
    DO JB=1,N_REGIONS(JA)
      IF( LDWEIGHTED_DISTR )THEN
        DO WHILE ( ( JA == KPROCA .OR. ZCOMP < PMEDIAP ) .AND. IGP < SIZE(PWEIGHT) )
          IGP = IGP + 1
          ICOMP = ICOMP + 1
          ZCOMP = ZCOMP + PWEIGHT(IGP)
        ENDDO
        ZCOMP = ZCOMP - PMEDIAP
      ELSE
        IPE=IPE+1
        IF (IPE  <=  KRESTM .OR. KRESTM  ==  0) THEN
          ICOMP = ICOMP + KMEDIAP
        ELSE
          ICOMP = ICOMP + (KMEDIAP-1)
        ENDIF
      ENDIF
    ENDDO
    KPROCAGP(JA)=ICOMP
    ITOT = IREST
    IGL = ILAST+1
    DO JGL=IGL,KDGL
      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
  IF( LDWEIGHTED_DISTR )THEN
    IF( KLAST(KPROCA) /= KDGL )THEN
      DO JA=1,KPROCA
        IF( MYPROC == 1 )THEN
          WRITE(0,'("SUMPLATBEQ_MOD: JA=",I3," KLAST=",I3," KINDIC=",I3)')&
          &JA,KLAST(JA),KINDIC(JA)
        ENDIF
      ENDDO
      WRITE(0,'("SUMPLATBEQ: LWEIGHTED_DISTR=T FAILED TO PARTITION GRID, REVERTING TO ",&
      & " LWEIGHTED_DISTR=F PARTITIONING")')
      LDWEIGHTED_DISTR=.FALSE.
      GOTO 100
    ENDIF
  ENDIF
  IF( SUM(KPROCAGP(:)) /= SUM(KLOENG(KDGSA:KDGL)) )THEN
    IF( MYPROC == 1 )THEN
      WRITE(0,'("SUM(KPROCAGP(:))=",I12)')SUM(KPROCAGP(:))
      WRITE(0,'("SUM(KLOENG(:))=",I12)')SUM(KLOENG(KDGSA:KDGL))
    ENDIF
    CALL ABORT_TRANS ('SUMPLATBEQ: PROBLEM IN PARTITIONING ')
  ENDIF

ELSE

  IF( LDWEIGHTED_DISTR )THEN
    CALL ABORT_TRANS ('SUMPLATBEQ: LSPLIT=F NOT SUPPORTED FOR WEIGHTED DISTRIBUTION ')
  ENDIF

  KINDIC(:) = 0
  LLDONE=.FALSE.
  IMEDIAP=KMEDIAP
  IF( MYPROC == 1 )THEN
    WRITE(0,'("SUMPLATBEQ: IMEDIAP=",I6)')IMEDIAP
  ENDIF
  DO WHILE(.NOT.LLDONE)
!   loop until a satisfactory distribution can be found
    IA=1
    IMAXI=IMEDIAP*N_REGIONS(IA)
    DO JGL=1,KDGL
      KLAST(IA)=JGL
      IMAXI=IMAXI-KLOENG(JGL)
      IF( IA == KPROCA .AND. JGL == KDGL )THEN
        IF( MYPROC == 1 )THEN
          WRITE(0,'("SUMPLATBEQ: EXIT 1")')
        ENDIF
        EXIT
      ENDIF
      IF( IA == KPROCA .AND. JGL < KDGL )THEN
        IF( MYPROC == 1 )THEN
          WRITE(0,'("SUMPLATBEQ: EXIT 2")')
        ENDIF
        KLAST(KPROCA)=KDGL
        EXIT
      ENDIF
      IF( IA < KPROCA .AND. JGL == KDGL )THEN
        DO JA=KPROCA,IA+1,-1
          KLAST(JA)=KDGL+JA-KPROCA
        ENDDO
        DO JA=KPROCA,2,-1
          IF( KLAST(JA) <= KLAST(JA-1) )THEN
            KLAST(JA-1)=KLAST(JA)-1
          ENDIF
        ENDDO
        IF( MYPROC == 1 )THEN
          WRITE(0,'("SUMPLATBEQ: EXIT 3")')
        ENDIF
        EXIT
      ENDIF
      IF( IMAXI <= 0 )THEN
        IA=IA+1
        IMAXI=IMAXI+IMEDIAP*N_REGIONS(IA)
      ENDIF
    ENDDO
    IF( KPROCA > 1 .AND. KLAST(KPROCA) == KLAST(KPROCA-1) )THEN
      IMEDIAP=IMEDIAP-1
      IF( MYPROC == 1 )THEN
        WRITE(0,'("SUMPLATBEQ: REDUCING IMEDIAP=",I6)')IMEDIAP
      ENDIF
      IF( IMEDIAP <= 0 )THEN
        CALL ABORT_TRANS ('SUMPLATBEQ: PROBLEM PARTITIONING WITH LSPLIT=F, IMEDIAP <= 0')
      ENDIF
    ELSE
      LLDONE=.TRUE.
    ENDIF
  ENDDO
ENDIF

END SUBROUTINE SUMPLATBEQ
END MODULE SUMPLATBEQ_MOD
