sumplatbeq_mod.F90

Go to the documentation of this file.

MODULE sumplatbeq_mod
CONTAINS
SUBROUTINE sumplatbeq(KDGSA,KDGL,KPROC,KPROCA,KLOENG,LDSPLIT,LDEQ_REGIONS,&
                    &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

!     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.
!     -------
!        G. Mozdzynski

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


USE parkind1  ,ONLY : jpim     ,jprb

USE tpm_distr
USE eq_regions_mod
USE abort_trans_mod

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

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

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

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

!     * Computation of KMEDIAP and KRESTM.

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)=",I3)')&
      &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

!     * Computation of intermediate quantities KINDIC and KLAST

IF (ldsplit) THEN

  irest = 0
  ilast =0
  ipe=0
  DO ja=1,kproca
    icomp=0
    DO jb=1,n_regions(ja)
      ipe=ipe+1
      IF (ipe  <=  krestm .OR. krestm  ==  0) THEN
        icomp = icomp + kmediap
      ELSE
        icomp = icomp + (kmediap-1)
      ENDIF
    ENDDO
    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
  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