! (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_TRANS_PRELEG_MOD CONTAINS SUBROUTINE SUMP_TRANS_PRELEG ! Set up distributed environment for the transform package (part 1) USE EC_PARKIND ,ONLY : JPIM USE TPM_GEN ,ONLY : NOUT, NPRINTLEV USE TPM_DIM ,ONLY : R USE TPM_DISTR ,ONLY : D, NPRTRW, NPRTRV, MYSETW USE SUWAVEDI_MOD ,ONLY : SUWAVEDI ! IMPLICIT NONE INTEGER(KIND=JPIM) :: JW,JV,JM,JMLOC,ILATPP,IRESTL,IMLOC,IDT,INM,ILAST INTEGER(KIND=JPIM) :: IMYMS(R%NSMAX+1),INUMTPP(NPRTRW) LOGICAL :: LLP1,LLP2 ! ------------------------------------------------------------------ IF(.NOT.D%LGRIDONLY) THEN LLP1 = NPRINTLEV>0 LLP2 = NPRINTLEV>1 IF(LLP1) WRITE(NOUT,*) '=== ENTER ROUTINE SUMP_TRANS_PRELEG ===' !* 1. Initialize partitioning of wave numbers to PEs ! ! ---------------------------------------------- ALLOCATE(D%NASM0(0:R%NSMAX)) IF(LLP2)WRITE(NOUT,9) 'D%NASM0 ',SIZE(D%NASM0 ),SHAPE(D%NASM0 ) ALLOCATE(D%NATM0(0:R%NTMAX)) IF(LLP2)WRITE(NOUT,9) 'D%NATM0 ',SIZE(D%NATM0 ),SHAPE(D%NATM0 ) ALLOCATE(D%NUMPP(NPRTRW)) IF(LLP2)WRITE(NOUT,9) 'D%NUMPP ',SIZE(D%NUMPP ),SHAPE(D%NUMPP ) ALLOCATE(D%NPOSSP(NPRTRW+1)) IF(LLP2)WRITE(NOUT,9) 'D%NPOSSP',SIZE(D%NPOSSP ),SHAPE(D%NPOSSP ) ALLOCATE(D%NPROCM(0:R%NSMAX)) IF(LLP2)WRITE(NOUT,9) 'D%NPROCM',SIZE(D%NPROCM ),SHAPE(D%NPROCM ) ALLOCATE(D%NPTRMS(NPRTRW)) IF(LLP2)WRITE(NOUT,9) 'D%NPTRMS ',SIZE(D%NPTRMS ),SHAPE(D%NPTRMS ) ALLOCATE(D%NALLMS(R%NSMAX+1)) IF(LLP2)WRITE(NOUT,9) 'D%NALLMS ',SIZE(D%NALLMS ),SHAPE(D%NALLMS ) ALLOCATE(D%NDIM0G(0:R%NSMAX)) IF(LLP2)WRITE(NOUT,9) 'D%NDIM0G ',SIZE(D%NDIM0G ),SHAPE(D%NDIM0G ) CALL SUWAVEDI(R%NSMAX,R%NTMAX,NPRTRW,MYSETW,& &D%NASM0,D%NSPOLEGL,D%NPROCM,D%NUMPP,& &D%NSPEC,D%NSPEC2,D%NSPEC2MX,D%NPOSSP,IMYMS,& &D%NPTRMS,D%NALLMS,D%NDIM0G) CALL SUWAVEDI(R%NTMAX,R%NTMAX,NPRTRW,MYSETW,& &KASM0=D%NATM0,KUMPP=INUMTPP,KSPEC2=D%NTPEC2) D%NUMP = D%NUMPP (MYSETW) ALLOCATE(D%MYMS(D%NUMP)) IF(LLP2)WRITE(NOUT,9) 'D%MYMS ',SIZE(D%MYMS ),SHAPE(D%MYMS ) D%MYMS(:) = IMYMS(1:D%NUMP) D%NUMTP = INUMTPP(MYSETW) ALLOCATE(D%NLATLS(NPRTRW,NPRTRV)) IF(LLP2)WRITE(NOUT,9) 'D%NLATLS',SIZE(D%NLATLS ),SHAPE(D%NLATLS ) ALLOCATE(D%NLATLE(NPRTRW,NPRTRV)) IF(LLP2)WRITE(NOUT,9) 'D%NLATLE',SIZE(D%NLATLE ),SHAPE(D%NLATLE ) D%NLATLS(:,:) = 999999 D%NLATLE(:,:) = -1 ILATPP = R%NDGNH/NPRTRW IRESTL = R%NDGNH-NPRTRW*ILATPP DO JW=1,NPRTRW IF (JW > IRESTL) THEN D%NLATLS(JW,1) = IRESTL*(ILATPP+1)+(JW-IRESTL-1)*ILATPP+1 D%NLATLE(JW,1) = D%NLATLS(JW,1)+ILATPP-1 ELSE D%NLATLS(JW,1) = (JW-1)*(ILATPP+1)+1 D%NLATLE(JW,1) = D%NLATLS(JW,1)+ILATPP ENDIF ENDDO ILAST=0 DO JW=1,NPRTRW ILATPP = (D%NLATLE(JW,1)-D%NLATLS(JW,1)+1)/NPRTRV IRESTL = (D%NLATLE(JW,1)-D%NLATLS(JW,1)+1)-NPRTRV*ILATPP DO JV=1,NPRTRV IF (JV > IRESTL) THEN D%NLATLS(JW,JV) = IRESTL*(ILATPP+1)+(JV-IRESTL-1)*ILATPP+1+ILAST D%NLATLE(JW,JV) = D%NLATLS(JW,JV)+ILATPP-1 ELSE D%NLATLS(JW,JV) = (JV-1)*(ILATPP+1)+1+ILAST D%NLATLE(JW,JV) = D%NLATLS(JW,JV)+ILATPP ENDIF ENDDO ILAST=D%NLATLE(JW,NPRTRV) ENDDO IF (LLP1) THEN DO JW=1,NPRTRW DO JV=1,NPRTRV WRITE(NOUT,'(" JW=",I6," JV=",I6," D%NLATLS=",I6," D%NLATLE=",I6)')& & JW,JV,D%NLATLS(JW,JV),D%NLATLE(JW,JV) ENDDO ENDDO ENDIF ALLOCATE(D%NPMT(0:R%NSMAX)) IF(LLP2)WRITE(NOUT,9) 'D%NPMT ',SIZE(D%NPMT ),SHAPE(D%NPMT ) ALLOCATE(D%NPMS(0:R%NSMAX)) IF(LLP2)WRITE(NOUT,9) 'D%NPMS ',SIZE(D%NPMS ),SHAPE(D%NPMS ) ALLOCATE(D%NPMG(0:R%NSMAX)) IF(LLP2)WRITE(NOUT,9) 'D%NPMG ',SIZE(D%NPMG ),SHAPE(D%NPMG ) IDT = R%NTMAX-R%NSMAX INM = 0 DO JMLOC=1,D%NUMP IMLOC = D%MYMS(JMLOC) D%NPMT(IMLOC) = INM D%NPMS(IMLOC) = INM+IDT INM = INM+R%NTMAX+2-IMLOC ENDDO INM = 0 DO JM=0,R%NSMAX D%NPMG(JM) = INM INM = INM+R%NTMAX+2-JM ENDDO D%NLEI3D = (R%NLEI3-1)/NPRTRW+1 ENDIF ! ------------------------------------------------------------------ 9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8) END SUBROUTINE SUMP_TRANS_PRELEG END MODULE SUMP_TRANS_PRELEG_MOD