ecearth3/sources/tm5mp/base/distributed_grids.F90

!
#define TRACEBACK write (gol,'("in ",a," (",a,", line",i5,")")') rname, __FILE__, __LINE__; call goErr
#define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if
#define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if
!
#include "tm5.inc"

!-----------------------------------------------------------------------------
!                    TM5                                                     !
!-----------------------------------------------------------------------------
!BOP
!
! !MODULE:      TM5_DISTGRID
!
! !DESCRIPTION: hold, initialize, and finalize the distributed grid objects
!               for each region of the model. 
!\\
!\\
! !INTERFACE: 
!
MODULE TM5_DISTGRID
  !
  ! !USES:
  !
  USE GO,       ONLY : gol, goPr, goErr
  USE partools, ONLY : npes, myid
  USE dims,     ONLY : nregions_all
  USE domain_decomp
  
  IMPLICIT NONE
  !
  ! !PUBLIC DATA MEMBERS:
  !
  TYPE(DIST_GRID), ALLOCATABLE :: DGRID(:)  ! Distributed grid object for each regions
  !
  ! !PRIVATE DATA MEMBERS:
  !  
  CHARACTER(len=*), PARAMETER, PRIVATE ::  mname = 'TM5_DistGrid'
  !
  ! !REVISION HISTORY: 
  !   18 Jan 2012 - P. Le Sager - v0
  !
  ! !REMARKS:
  ! 
  !   (1) TM5_DGRID_INIT, TM5_DGRID_DONE are public life cycle method 
  !   (2) inherits all public routines from DOMAIN_DECOMP (and keep them public)  
  !EOP
  !------------------------------------------------------------------------

CONTAINS

  !--------------------------------------------------------------------------
  !                    TM5                                                  !
  !--------------------------------------------------------------------------
  !BOP
  !
  ! !IROUTINE:  dgrid_Init
  !
  ! !DESCRIPTION: 
  !\\
  !\\
  ! !INTERFACE:
  !
  SUBROUTINE TM5_DGRID_INIT( rcfile, status )
    !
    ! !USES:
    !
    use GO,       only : TrcFile, Init, Done, ReadRc
    use dims,     only : okdebug
    USE partools, ONLY : TM5_MPI_INIT2
    !
    ! !INPUT PARAMETERS:
    !
    character(len=*), intent(in)      ::  rcfile
    !
    ! !OUTPUT PARAMETERS:
    !
    integer,         intent(out)      ::  status
    !
    ! !REVISION HISTORY: 
    !   18 Jan 2012 - P. Le Sager -
    !
    !EOP
    !------------------------------------------------------------------------
    !BOC

    character(len=*), parameter ::  rname = mname//'/TM5_DGrid_Init'

    integer         :: id, n, npe_lon, npe_lat
    type(TrcFile)   :: rcF
    
    ! distributed grids
    allocate(dgrid(nregions_all))


    ! get nprocs on each direction from rcfile
    ! ---------------------------------------

    call Init( rcF, rcfile, status )
    IF_NOTOK_RETURN(status=1)

    call ReadRc( rcF, 'par.nx', npe_lon, status )
    IF_NOTOK_RETURN(status=1)

    call ReadRc( rcF, 'par.ny', npe_lat, status )
    IF_NOTOK_RETURN(status=1)

    call Done( rcF, status )
    IF_NOTOK_RETURN(status=1)

    ! Sanity check (temporary: npes will be entirely determined by par.nx
    ! and par.ny in the future, when submit script reads them)
    if (npes /= npe_lat*npe_lon) then
       status=1
       write(gol,'("ERROR : total #proc (",i3,") .NE. Xproc*Yproc (",i3,"*",i3,")")') &
            npes, npe_lat, npe_lon; call goErr
       IF_NOTOK_RETURN(status=1)
    endif

    
    ! finish initialization of communicators
    ! ---------------------------------------    
    call TM5_MPI_INIT2( npe_lon, npe_lat, status )
    IF_NOTOK_RETURN(status=1)

    
    ! initialize distributed grid objects
    ! ---------------------------------------    
    do n=1,nregions_all

       CALL INIT_DISTGRID( dgrid(n), n, myid, npe_lon, npe_lat, halo=2, status=status )
       IF_NOTOK_RETURN(status=1)

       if (okdebug) then 
          ! Test MPI domain decomposition communications
          call testcomm( dgrid(n), 0, status)
          IF_NOTOK_RETURN(status=1)
          call testcomm( dgrid(n), 1, status) 
          IF_NOTOK_RETURN(status=1)
          call testcomm( dgrid(n), 2, status) 
          IF_NOTOK_RETURN(status=1)
          call print_distgrid( dgrid(n) )
         end if
    end do

    status = 0

  END SUBROUTINE TM5_DGRID_INIT
  !EOC


  !--------------------------------------------------------------------------
  !                    TM5                                                  !
  !--------------------------------------------------------------------------
  !BOP
  !
  ! !IROUTINE:  DGRID_DONE
  !
  ! !DESCRIPTION: 
  !\\
  !\\
  ! !INTERFACE:
  !
  SUBROUTINE TM5_DGRID_DONE( status )
    !
    ! !OUTPUT PARAMETERS:
    !
    integer, intent(out)          ::  status
    !
    ! !REVISION HISTORY: 
    !   18 Jan 2012 - P. Le Sager -
    !
    !EOP
    !------------------------------------------------------------------------
    !BOC

    character(len=*), parameter ::  rname = mname//'/TM5_DGrid_Done'
    integer :: n

    do n=1,nregions_all

       call Done_DistGrid( dgrid(n), status )
       IF_NOTOK_RETURN(status=1)

    end do

    deallocate( dgrid )

    status = 0

  END SUBROUTINE TM5_DGRID_DONE
  !EOC


END MODULE TM5_DISTGRID