MODULE SUMP_TRANS_PRELEG_MOD CONTAINS SUBROUTINE SUMP_TRANS_PRELEG ! Set up distributed environment for the transform package (part 1) USE PARKIND1 ,ONLY : JPIM ,JPRB USE TPM_GEN USE TPM_DIM USE TPM_DISTR USE SUWAVEDI_MOD USE ABORT_TRANS_MOD IMPLICIT NONE INTEGER(KIND=JPIM) :: JA,JJ,JM,JMLOC,ILATPP,IRESTL,IMLOC,IDT,INM INTEGER(KIND=JPIM) :: IMYMS(R%NSMAX+1),INUMTPP(NPRTRW) INTEGER(KIND=JPIM) :: IDUMI1,IDUMI2,IDUMI3 INTEGER(KIND=JPIM) :: IDUM2(0:R%NSMAX), IDUM3(NPRTRW+1), IDUM4(R%NSMAX+1) LOGICAL :: LLP1,LLP2 ! ------------------------------------------------------------------ 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) IF (D%NUMP == 0) THEN WRITE(NERR,'("SUMP: NPRTRW TOO LARGE FOR SPECTRAL RESOLUTION",/,& &"NOTE MAX VALUE FOR Tnnn CASE IS nnn+1",/,& &"MORE PROCESSORS CAN BE USED BY INCREASING NPRTRV")') CALL ABORT_TRANS('NPRTRW TOO LARGE FOR SPECTRAL RESOLUTION') ENDIF ALLOCATE(D%NLATLS(NPRTRW)) IF(LLP2)WRITE(NOUT,9) 'D%NLATLS',SIZE(D%NLATLS ),SHAPE(D%NLATLS ) ALLOCATE(D%NLATLE(NPRTRW)) IF(LLP2)WRITE(NOUT,9) 'D%NLATLE',SIZE(D%NLATLE ),SHAPE(D%NLATLE ) D%NLATLS(:) = 9999 D%NLATLE(:) = -1 ILATPP = R%NDGNH/NPRTRW IRESTL = R%NDGNH-NPRTRW*ILATPP DO JA=1,NPRTRW IF (JA > IRESTL) THEN D%NLATLS(JA) = IRESTL*(ILATPP+1)+(JA-IRESTL-1)*ILATPP+1 D%NLATLE(JA) = D%NLATLS(JA)+ILATPP-1 ELSE D%NLATLS(JA) = (JA-1)*(ILATPP+1)+1 D%NLATLE(JA) = D%NLATLS(JA)+ILATPP ENDIF ENDDO IF (LLP1) THEN WRITE(NOUT,'('' D%NLATLS '')') WRITE(NOUT,'(20(1X,I4))')(D%NLATLS(JJ),JJ=1,NPRTRW) WRITE(NOUT,'('' D%NLATLE '')') WRITE(NOUT,'(20(1X,I4))')(D%NLATLE(JJ),JJ=1,NPRTRW) 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 ! ------------------------------------------------------------------ 9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8) END SUBROUTINE SUMP_TRANS_PRELEG END MODULE SUMP_TRANS_PRELEG_MOD