sump_trans_preleg_mod.F90

Go to the documentation of this file.

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