sumplatb_mod.F90

Go to the documentation of this file.

MODULE sumplatb_mod
CONTAINS
SUBROUTINE sumplatb(KDGSA,KDGL,KPROCA,KLOENG,LDSPLIT,&
                    &kmediap,krestm,kindic,klast)

!**** *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

!     Explicit arguments - output:
!     -------------------- 
!                          KMEDIAP    -mean number of grid points per PE
!                          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.
!     -------
!        K. YESSAD (after old version of sumplat.F).

!     Modifications.
!     --------------
!        Original : 98-12-07
!     ------------------------------------------------------------------


USE parkind1  ,ONLY : jpim     ,jprb

USE abort_trans_mod

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)
LOGICAL,INTENT(IN)  :: LDSPLIT
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)

!     * LOCAL:
INTEGER(KIND=JPIM) :: IPP1(kproca),ILAST1(kproca)
INTEGER(KIND=JPIM) :: IPP(kproca)
INTEGER(KIND=JPIM) :: IFIRST(kproca)

!     LOCAL INTEGER SCALARS
INTEGER(KIND=JPIM) :: ICOMP, IGL, IMAXI, IMAXIOL, IMEDIA, ITOT, JA, JGL,&
            &ILAST,IREST,ILIMIT,IFRST
LOGICAL   :: LLDONE

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

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

!     * Computation of KMEDIAP and KRESTM.

imedia = sum(kloeng(kdgsa:kdgl))
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,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

ELSE

  kindic(:) = 0

  imaxi = kmediap-1
  imaxiol = huge(imaxiol)
  DO
    ilimit = imaxi
    imaxi = 0
    ifrst = kdgl
    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

ENDIF

END SUBROUTINE sumplatb
END MODULE sumplatb_mod