! #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