source: LMDZ6/branches/contrails/libf/phylmd/rrtm/sump_trans_preleg_mod.F90 @ 5452

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