sump_trans0_mod.F90 Source File


This file depends on

sourcefile~~sump_trans0_mod.f90~2~~EfferentGraph sourcefile~sump_trans0_mod.f90~2 sump_trans0_mod.F90 sourcefile~abort_trans_mod.f90 abort_trans_mod.F90 sourcefile~sump_trans0_mod.f90~2->sourcefile~abort_trans_mod.f90 sourcefile~eq_regions_mod.f90 eq_regions_mod.F90 sourcefile~sump_trans0_mod.f90~2->sourcefile~eq_regions_mod.f90 sourcefile~pe2set_mod.f90 pe2set_mod.F90 sourcefile~sump_trans0_mod.f90~2->sourcefile~pe2set_mod.f90 sourcefile~tpm_distr.f90 tpm_distr.F90 sourcefile~sump_trans0_mod.f90~2->sourcefile~tpm_distr.f90 sourcefile~tpm_gen.f90 tpm_gen.F90 sourcefile~sump_trans0_mod.f90~2->sourcefile~tpm_gen.f90 sourcefile~abort_trans_mod.f90->sourcefile~tpm_distr.f90 sourcefile~abort_trans_mod.f90->sourcefile~tpm_gen.f90 sourcefile~parkind_ectrans.f90 parkind_ectrans.F90 sourcefile~eq_regions_mod.f90->sourcefile~parkind_ectrans.f90 sourcefile~pe2set_mod.f90->sourcefile~abort_trans_mod.f90 sourcefile~pe2set_mod.f90->sourcefile~eq_regions_mod.f90 sourcefile~pe2set_mod.f90->sourcefile~tpm_distr.f90 sourcefile~tpm_gen.f90->sourcefile~parkind_ectrans.f90

Source Code

! (C) Copyright 2000- ECMWF.
! (C) Copyright 2000- 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 SUMP_TRANS0_MOD
CONTAINS
SUBROUTINE SUMP_TRANS0

! Set up distributed environment for the transform package (part 0)

USE PARKIND1        ,ONLY : JPIM
USE MPL_MODULE      ,ONLY : MPL_GROUPS_CREATE, MPL_MYRANK, MPL_NPROC

USE TPM_GEN         ,ONLY : NOUT, LMPOFF, NPRINTLEV
USE TPM_DISTR       ,ONLY : LEQ_REGIONS, MTAGDISTGP, MTAGDISTSP, MTAGGL, &
     &                      MTAGLETR, MTAGLG, MTAGLM, MTAGML, MTAGPART,  &
     &                      MYSETV, MYSETW, NPRCIDS,                     &
     &                      NPRGPEW, NPRGPNS, NPRTRNS, NPRTRV, NPRTRW,   &
     &                      MYPROC, NPROC

USE EQ_REGIONS_MOD  ,ONLY : EQ_REGIONS, MY_REGION_EW, MY_REGION_NS,      &
     &                      N_REGIONS, N_REGIONS_EW, N_REGIONS_NS
USE PE2SET_MOD      ,ONLY : PE2SET
USE ABORT_TRANS_MOD ,ONLY : ABORT_TRANS

IMPLICIT NONE

LOGICAL :: LLP1,LLP2
INTEGER(KIND=JPIM) :: IPROC,JJ

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

LLP1 = NPRINTLEV>0
LLP2 = NPRINTLEV>1
IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE SUMP_TRANS0 ==='


NPROC = NPRGPNS*NPRGPEW
NPRTRNS = NPRTRW
IF(MOD(NPROC,NPRTRW) /= 0 .OR. NPRTRW > NPROC) THEN
  CALL ABORT_TRANS('SUMP_TRANS0: NPROC INCONSISTENT WITH NPRTRW')
ENDIF
NPRTRV = NPROC/NPRTRW
IF(LLP1) WRITE(NOUT,*)'NPROC =',NPROC,' NPRGPNS=',NPRGPNS,' NPRGPEW=',&
 & NPRGPEW,' NPRTRW=',NPRTRW,' NPRTRV=',NPRTRV

IF(NPROC > 1 ) THEN
  IPROC = MPL_NPROC()
  IF(IPROC /= NPROC) THEN
    WRITE(NOUT,*) 'SUMP_TRANS0: NPROC=',NPROC,' BUT MPL_NPROC RETURNS',&
                 &  IPROC
    CALL ABORT_TRANS('SUMP_TRANS0: NPROC INCONSISTENT WITH MPL_NPROC')
  ENDIF
  MYPROC = MPL_MYRANK()
ELSE
  MYPROC = 1
ENDIF

IF (MYPROC > NPROC) THEN
  CALL ABORT_TRANS('SUMP_TRANS0: INCONSISTENCY IN NUMBER OF PROCESSORS USED')
ENDIF

IF( LEQ_REGIONS )THEN
  ALLOCATE(N_REGIONS(NPROC+2))
  N_REGIONS(:)=0
  CALL EQ_REGIONS(NPROC)
ELSE
  N_REGIONS_NS=NPRGPNS
  ALLOCATE(N_REGIONS(N_REGIONS_NS))
  N_REGIONS(:)=NPRGPEW
  N_REGIONS_EW=NPRGPEW
ENDIF
CALL PE2SET(MYPROC,MY_REGION_NS,MY_REGION_EW,MYSETW,MYSETV)
IF(LLP1) WRITE(NOUT,*)'MYPROC=',MYPROC,'MY_REGION_NS =',MY_REGION_NS,&
 & ' MY_REGION_EW=',MY_REGION_EW,' MYSETW=',MYSETW,' MYSETV=',MYSETV


ALLOCATE(NPRCIDS(NPROC))
IF(LLP2)WRITE(NOUT,9) 'NPRCIDS   ',SIZE(NPRCIDS   ),SHAPE(NPRCIDS   )
DO JJ=1,NPROC
  NPRCIDS(JJ) = JJ
ENDDO

! Message passing tags

MTAGLETR = 18000
MTAGML   = 19000
MTAGLG   = 20000
MTAGPART = 21000
MTAGDISTSP = 22000
MTAGGL   = 23000
MTAGLM   = 24000
MTAGDISTGP = 25000

! Create communicators for MPI groups

IF (.NOT.LMPOFF) THEN
  CALL MPL_GROUPS_CREATE(NPRTRW, NPRTRV)
ENDIF

! Setup labels for timing package (gstats)

! CF ifs/utility    GSTATS_OUTPUT_IFS

!     ------------------------------------------------------------------
9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
 
END SUBROUTINE SUMP_TRANS0
END MODULE SUMP_TRANS0_MOD