sump_trans_preleg_mod.F90 Source File


This file depends on

sourcefile~~sump_trans_preleg_mod.f90~~EfferentGraph sourcefile~sump_trans_preleg_mod.f90 sump_trans_preleg_mod.F90 sourcefile~suwavedi_mod.f90 suwavedi_mod.F90 sourcefile~sump_trans_preleg_mod.f90->sourcefile~suwavedi_mod.f90 sourcefile~tpm_dim.f90 tpm_dim.F90 sourcefile~sump_trans_preleg_mod.f90->sourcefile~tpm_dim.f90 sourcefile~tpm_distr.f90 tpm_distr.F90 sourcefile~sump_trans_preleg_mod.f90->sourcefile~tpm_distr.f90 sourcefile~tpm_gen.f90 tpm_gen.F90 sourcefile~sump_trans_preleg_mod.f90->sourcefile~tpm_gen.f90 sourcefile~parkind_ectrans.f90 parkind_ectrans.F90 sourcefile~tpm_gen.f90->sourcefile~parkind_ectrans.f90

Files dependent on this one

sourcefile~~sump_trans_preleg_mod.f90~~AfferentGraph sourcefile~sump_trans_preleg_mod.f90 sump_trans_preleg_mod.F90 sourcefile~setup_trans.f90 setup_trans.F90 sourcefile~setup_trans.f90->sourcefile~sump_trans_preleg_mod.f90 sourcefile~setup_trans.f90~2 setup_trans.F90 sourcefile~setup_trans.f90~2->sourcefile~sump_trans_preleg_mod.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_TRANS_PRELEG_MOD
CONTAINS
SUBROUTINE SUMP_TRANS_PRELEG

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

USE PARKIND1     ,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
!USE ABORT_TRANS_MOD
!

IMPLICIT NONE

INTEGER(KIND=JPIM) :: JW,JV,JJ,JM,JMLOC,ILATPP,IRESTL,IMLOC,IDT,INM,ILAST

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

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

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