sumplat_mod.F90

Go to the documentation of this file.

MODULE sumplat_mod
CONTAINS
SUBROUTINE sumplat(KDGL,KPROC,KPROCA,KMYSETA,LDSPLIT,LDEQ_REGIONS,&
                   &kfrstlat,klstlat,kfrstloff,kptrlat,&
                   &kptrfrstlat,kptrlstlat,kptrfloff,&
                   &kmediap,krestm,ldsplitlat)

!**** *SUMPLAT * - Initialize gridpoint distrbution in N-S direction

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


!**   Interface.
!     ----------
!        *CALL* *SUMPLAT *

!     Explicit arguments - input :
!     -------------------- 
!                          KDGL       -last  latitude
!                          KPROC      -total number of processors
!                          KPROCA     -number of processors in A direction
!                          KMYSETA    -process number in A direction
!                          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
!                          KFRSTLAT   -first latitude row on processor
!                          KLSTLAT    -last  latitude row on processor
!                          KFRSTLOFF  -offset for first latitude in set
!                          KPTRLAT    -pointer to start of latitude    
!                          KPTRFRSTLAT-pointer to first latitude
!                          KPTRLSTLAT -pointer to last  latitude
!                          KPTRFLOFF  -offset for pointer to first latitude
!                          LDSPLITLAT -true for latitudes which are split

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


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

!     Externals.   SUMPLATB and SUEMPLATB.
!     ----------

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

!     Author.
!     -------
!        MPP Group *ECMWF*

!     Modifications.
!     --------------
!        Original : 95-10-01
!        David Dent:97-06-02 parameters KFRSTLAT etc added
!        JF. Estrade:97-11-13 Adaptation to ALADIN case
!        J.Boutahar: 98-07-06  phasing with CY19
!        Modified 98-08-10 by K. YESSAD: removal of LRPOLE option + cleanings
!         (correct computation of extrapolar latitudes for KPROCL).
!        Modified 98-12-07 by K. YESSAD and C. FISCHER: cleaning.
!         - merge old sumplat.F and suemplat.F
!         - gather 'lelam' code and 'not lelam' code.
!         - clean (useless duplication of variables, non doctor features).
!         - remodularise according to lelam/not lelam
!           -> lelam features in new routine suemplatb.F,
!              not lelam features in new routine sumplatb.F
!     ------------------------------------------------------------------

USE parkind1  ,ONLY : jpim     ,jprb

USE tpm_geometry
USE tpm_distr

USE sumplatb_mod
USE sumplatbeq_mod

IMPLICIT NONE


!     * DUMMY:
INTEGER(KIND=JPIM),INTENT(OUT) :: KMEDIAP
INTEGER(KIND=JPIM),INTENT(OUT) :: KRESTM
INTEGER(KIND=JPIM),INTENT(IN)  :: KDGL
INTEGER(KIND=JPIM),INTENT(IN)  :: KPROC
INTEGER(KIND=JPIM),INTENT(IN)  :: KPROCA
INTEGER(KIND=JPIM),INTENT(IN)  :: KMYSETA
INTEGER(KIND=JPIM),INTENT(OUT) :: KFRSTLAT(:)
INTEGER(KIND=JPIM),INTENT(OUT) :: KLSTLAT(:)
INTEGER(KIND=JPIM),INTENT(OUT) :: KFRSTLOFF
INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRLAT(:)
INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRFRSTLAT(:)
INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRLSTLAT(:)
INTEGER(KIND=JPIM),INTENT(OUT) :: KPTRFLOFF
LOGICAL,INTENT(IN)  :: LDSPLIT
LOGICAL,INTENT(IN)  :: LDEQ_REGIONS
LOGICAL,INTENT(OUT) :: LDSPLITLAT(:)

!     * LOCAL:
! === END OF INTERFACE BLOCK ===
INTEGER(KIND=JPIM) :: INDIC(kproca),ILAST(kproca)

!     LOCAL INTEGER SCALARS
INTEGER(KIND=JPIM) :: IPTRLATITUDE,  JA, JGL


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

!*       1.    CODE DEPENDING ON 'LELAM': COMPUTATION OF
!              KMEDIAP, KRESTM, INDIC, ILAST.
!              -----------------------------------------


IF( ldeq_regions )THEN
  CALL sumplatbeq(1,kdgl,kproc,kproca,g%NLOEN,ldsplit,ldeq_regions,&
   &kmediap,krestm,indic,ilast)
ELSE
  CALL sumplatb(1,kdgl,kproca,g%NLOEN,ldsplit,&
   &kmediap,krestm,indic,ilast)
ENDIF

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

!*       2.    CODE NOT DEPENDING ON 'LELAM': COMPUTATION OF
!              KFRSTLAT TO LDSPLITLAT.
!              ---------------------------------------------


!     * Computation of first and last latitude of processor sets
!       -----------  in grid-point-space -----------------------

kfrstlat(1) = 1
klstlat(kproca) = kdgl
DO ja=1,kproca-1
!!$  IF(MYPROC==1)THEN
!!$    WRITE(0,'("SUMPLAT_MOD: JA=",I3," ILAST=",I3," INDIC=",I3)')&
!!$    &JA,ILAST(JA),INDIC(JA)
!!$  ENDIF
  IF ((.NOT. ldsplit) .OR. indic(ja) == 0) THEN
    kfrstlat(ja+1) = ilast(ja) + 1
    klstlat(ja) = ilast(ja)
  ELSE
    kfrstlat(ja+1) = indic(ja)
    klstlat(ja) = indic(ja)
  ENDIF
ENDDO
kfrstloff=kfrstlat(kmyseta)-1

!     * Initialise following data structures:-
!       NPTRLAT     (pointer to the start of each latitude)
!       LSPLITLAT   (TRUE if latitude is split over two A sets)
!       NPTRFRSTLAT (pointer to the first latitude of each A set)
!       NPTRLSTLAT  (pointer to the last  latitude of each A set)

DO jgl=1,kdgl
  kptrlat(jgl)=-999
  ldsplitlat(jgl)=.false.
ENDDO
iptrlatitude=0
DO ja=1,kproca
  DO jgl=kfrstlat(ja),klstlat(ja)
    iptrlatitude=iptrlatitude+1
    ldsplitlat(jgl)=.true.
    IF( kptrlat(jgl) == -999 )THEN
      kptrlat(jgl)=iptrlatitude
      ldsplitlat(jgl)=.false.
    ENDIF
  ENDDO
ENDDO
DO ja=1,kproca
  IF( ldsplitlat(kfrstlat(ja)) .AND. ja /= 1)THEN
    kptrfrstlat(ja)=kptrlat(kfrstlat(ja))+1
  ELSE
    kptrfrstlat(ja)=kptrlat(kfrstlat(ja))
  ENDIF
  IF( ldsplitlat(klstlat(ja)) .AND. ja == kproca)THEN
    kptrlstlat(ja)=kptrlat(klstlat(ja))+1
  ELSE
    kptrlstlat(ja)=kptrlat(klstlat(ja))
  ENDIF
ENDDO
kptrfloff=kptrfrstlat(kmyseta)-1
!!$IF(MYPROC==1)THEN
!!$  DO JGL=1,KDGL
!!$    WRITE(0,'("SUMPLAT_MOD: JGL=",I3," KPTRLAT=",I3," LDSPLITLAT=",L4)')&
!!$    & JGL,KPTRLAT(JGL),LDSPLITLAT(JGL)
!!$  ENDDO
!!$  DO JA=1,KPROCA
!!$    WRITE(0,'("SUMPLAT_MOD: JA=",I3," KFRSTLAT=",I3," KLSTLAT=",I3,&
!!$    & " KPTRFRSTLAT=",I3," KPTRLSTLAT=",I3)')&
!!$    & JA,KFRSTLAT(JA),KLSTLAT(JA),KPTRFRSTLAT(JA),KPTRLSTLAT(JA)
!!$  ENDDO
!!$ENDIF

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

END SUBROUTINE sumplat
END MODULE sumplat_mod