#' procgrid
#'
#' "Optimal" process grid when nprow and npcol are empty
#'
#' For advanced users only. See pbdDMAT for high-level functions.
#'
#' @param nprocs
#' Number of processors.
#' @return A list contains nprow and npcol.
#'
#' @examples
#' spmd.code <- "
#' suppressMessages(library(pbdMPI))
#' suppressMessages(library(pbdBASE))
#' init.grid()
#'
#' opt <- base.procgrid(4)
#' comm.print(opt)
#'
#' opt <- base.procgrid(6)
#' comm.print(opt)
#'
#' opt <- base.procgrid(8)
#' comm.print(opt)
#'
#' finalize()
#' "
#' pbdMPI::execmpi(spmd.code = spmd.code, nranks = 1L)
#'
#' @useDynLib pbdBASE R_optimal_grid
#' @export
base.procgrid <- function(nprocs)
{
.Call(R_optimal_grid, as.integer(nprocs))
}
procgrid <- base.procgrid
#' blacs_init
#'
#' BLACS grid initialization.
#'
#' For advanced users only. See pbdDMAT for high-level functions.
#'
#' @param ICTXT
#' BLACS context.
#' @param NPROW,NPCOL
#' Number of process rows/cols.
#' @param ...
#' Additional arguments.
#' @param quiet
#' Verbose initialization or not.
#' @return None
#'
#' @useDynLib pbdBASE R_blacs_init
#' @name gridinit
#' @rdname gridinit
#' @export
base.blacs_init <- function(ICTXT, NPROW, NPCOL, ..., quiet = FALSE)
{
if (missing(ICTXT))
ICTXT <- base.minctxt(after=-1)
else if (!isint(x=ICTXT) || ICTXT < 0)
pbdMPI::comm.stop("ICTXT must be a non-negative integer")
# pbdMPI::init() # initialize pbdMPI communicator
nprocs <- pbdMPI::comm.size()
if (missing(NPROW) && missing(NPCOL)){
procs <- base.procgrid(nprocs=nprocs)
NPROW <- as.integer(procs$nprow)
NPCOL <- as.integer(procs$npcol)
}
else if (missing(NPROW) && !missing(NPCOL))
pbdMPI::comm.stop("You must also provide a value for 'NPROW'")
else if (!missing(NPROW) && missing(NPCOL))
pbdMPI::comm.stop("You must also provide a value for 'NPCOL'")
else if (!isint(x=NPROW) || !isint(x=NPCOL))
pbdMPI::comm.stop("'NPROW' and 'NPCOL' must be integers")
else if (NPROW*NPCOL > nprocs)
pbdMPI::comm.stop(paste("Error: grid size of ", NPROW, "x", NPCOL, " is not possible with ", nprocs, " processes", sep=""))
nm <- paste(".__blacs_gridinfo_", ICTXT, sep="")
if (exists(nm, envir=.pbdBASEEnv)){
pbdMPI::comm.warning(paste("Context", ICTXT, "is already in use. No new grid created"))
return( invisible(1) )
}
value <- .Call(R_blacs_init, as.integer(NPROW), as.integer(NPCOL), as.integer(ICTXT))
assign(x=nm, value=value, envir=.pbdBASEEnv)
set.comm.from.ICTXT(value$ICTXT, .pbd_env$SPMD.CT$comm)
if (ICTXT==0 && !quiet)
pbdMPI::comm.cat(sprintf("%s", paste("Using ", NPROW, "x", NPCOL, " for the default grid size\n\n", sep="")), quiet=TRUE)
else if (ICTXT > 0 && !quiet)
pbdMPI::comm.cat(sprintf("%s", paste("Grid ICTXT=", ICTXT, " of size ", NPROW, "x", NPCOL, " successfully created\n", sep="")), quiet=TRUE)
if (!exists(".__blacs_initialized", envir=.pbdBASEEnv))
assign(x=".__blacs_initialized", value=TRUE, envir=.pbdBASEEnv)
invisible(0)
}
#' @rdname gridinit
#' @export
blacs_init <- base.blacs_init
#' @rdname gridinit
#' @export
blacs_gridinit <- base.blacs_init
#' Creating Grid From A System Context
#'
#' Creates a grid from a System Context obtained from a call to `sys2blacs_handle`.
#' @param NPROW
#' Number of rows in the process grid
#' @param NPCOL
#' Number of columns in the process grid
#' @param SYSCTXT
#' System context obtained from a call to `sys2blacs_handle`
#' @param nprocs
#' Number of processors in the communicator
#' @param comm
#' An MPI (not BLACS) communicator.
#'
#' @return A blacs context number
#'
#' @useDynLib pbdBASE R_blacs_gridinit
#' @export
base.blacs_gridinit <- function(SYSCTXT, NPROW, NPCOL, nprocs = pbdMPI::comm.size(comm), comm = .pbd_env$SPMD.CT$comm)
{
if (missing(NPROW) && missing(NPCOL)){
procs <- base.procgrid(nprocs=nprocs)
NPROW <- as.integer(procs$nprow)
NPCOL <- as.integer(procs$npcol)
}
else if (missing(NPROW) && !missing(NPCOL))
pbdMPI::comm.stop("You must also provide a value for 'NPROW'")
else if (!missing(NPROW) && missing(NPCOL))
pbdMPI::comm.stop("You must also provide a value for 'NPCOL'")
else if (!isint(x=NPROW) || !isint(x=NPCOL))
pbdMPI::comm.stop("'NPROW' and 'NPCOL' must be integers")
else if (NPROW*NPCOL > nprocs)
pbdMPI::comm.stop(paste("Error: grid size of ", NPROW, "x", NPCOL, " is not possible with ", nprocs, " processes", sep=""))
value <- .Call('R_blacs_gridinit', as.integer(NPROW), as.integer(NPCOL), as.integer(SYSCTXT))
nm <- paste(".__blacs_gridinfo_", value$ICTXT, sep="")
set.comm.from.ICTXT(value$ICTXT, comm)
assign(x=nm, value=value, envir=.pbdBASEEnv)
if (!exists(".__blacs_initialized", envir=.pbdBASEEnv))
assign(x=".__blacs_initialized", value=TRUE, envir=.pbdBASEEnv)
value$ICTXT
}
set.comm.from.ICTXT <- function(ICTXT, comm)
{
if(!exists("comm.ctxt.map", envir = .pbdBASEEnv))
.pbdBASEEnv$comm.ctxt.map <- list()
.pbdBASEEnv$comm.ctxt.map[[ICTXT + 1L]] <- comm
}
#' Getting Communicator From BLACS Context
#'
#' Blacs context are associated with a certain communicator. It can be useful to retrieve this communicator to manipulate the matrix accordingly.
#' @param ICTXT a BLACS context
#' @return A communicator
#' @export
get.comm.from.ICTXT <- function(ICTXT)
{
if (!exists("comm.ctxt.map", envir = .pbdBASEEnv))
{
pbdMPI::comm.warning("No context seem to have been setup")
return(NULL)
}
comm <- .pbdBASEEnv$comm.ctxt.map[[ICTXT + 1L]]
if (is.null(comm))
pbdMPI::comm.warning(sprintf("Context: %i is not set", ICTXT))
comm
}
#' Initialize Process Grid
#'
#' Manages the creation of BLACS context grids.
#'
#' \code{blacs_init()} is for experienced users only. It is a shallow
#' wrapper of the BLACS routine \code{BLACS_INIT}, with the addition of
#' creating the \code{.__blacs_gridinfo_ICTXT} objects, as described below.
#'
#' The remainder of this section applies only to \code{init.grid()}.
#'
#' If \code{ICTXT} is missing, three variables will be created in the
#' \code{.pbdBASEEnv} environment:
#'
#' \code{.__blacs_gridinfo_0}
#'
#' \code{.__blacs_gridinfo_1}
#'
#' \code{.__blacs_gridinfo_2}
#'
#' These variables store the BLACS process grid information for the BLACS
#' context corresponding to the trailing digit of the variable. Most users
#' should invoke \code{init.grid()} in this fashion, namely with ICTXT missing,
#' and only do so once.
#'
#' Contexts 0, 1, and 2 are reserved. Additional custom contexts are possible
#' to create, but they must be integers >= 3.
#'
#' Context 0 is the ``full'' process grid of \code{NPROW} by \code{NPCOL}
#' processes; contexts 1 is the process grid consisting of 1 process row and
#' \code{NPROW}*\code{NPCOL} processes columns; context 2 is the process grid
#' consisting of \code{NPROW}*\code{NPCOL} processes rows and 1 process column.
#' These contexts can be redundant depending on the number of prcesses
#' available.
#'
#' BLACS contexts have important internal use, and advanced users familiar with
#' ScaLAPACK might find some advantage in directly manipulating these process
#' grids. Most users should not need to directly manage BLACS contexts, in this
#' function or elsewhere.
#'
#' If the \code{NPROW} and \code{NPCOL} values are missing, then a best process
#' grid will be chosen for the user based on the total available number of
#' processes. Here ``best'' means as close to a square grid as possible.
#'
#' The variables \code{.__blacs_gridinfo_ICTXT} are just storage mechanisms to
#' avoid needing to directly invoke the BLACS routine \code{BLACS_GRIDINFO}.
#'
#' Additionally, another variable is created in the \code{.pbdBASEEnv}
#' environment, namely \code{.__blacs_initialized}. Its existence is to alert
#' \code{finalize()} to shut down BLACS communicators, if necessary, to prevent
#' memory leaks.
#'
#' @param NPROW
#' number of process rows. Can be missing; see details.
#' @param NPCOL
#' number of process columns. Can be missing; see details.
#' @param ICTXT
#' BLACS context number.
#' @param quiet
#' logical; controls whether or not information about grid size
#' should be printed.
#'
#' @return
#' Silently returns 0 when successful. Additionally, several variables
#' are created in the \code{.pbdBASEEnv} environment. See Details section.
#'
#' @keywords BLACS
#'
#' @examples
#' spmd.code <- "
#' suppressMessages(library(pbdMPI))
#' suppressMessages(library(pbdBASE))
#' init.grid()
#'
#' ### Do something here. For example, below.
#' comm.print(ls(.pbdBASEEnv))
#'
#' finalize()
#' "
#' pbdMPI::execmpi(spmd.code = spmd.code, nranks = 2L)
#'
#' @name InitGrid
#' @rdname init.grid
#' @export
init.grid <- function(NPROW, NPCOL, ICTXT, quiet = FALSE)
{
# initialize pbdMPI communicator
pbdMPI::init()
# determine the ICTXT if it is missing
if (missing(ICTXT)){
ICTXT <- base.minctxt(after=-1)
} else if (ICTXT==0 || ICTXT==1 || ICTXT==2){
pbdMPI::comm.stop("Contexts 0, 1, and 2 are reserved; use 3 or above.")
}
# determine number processor rows/columns
if (missing(NPROW) && missing(NPCOL)){
if (exists(".__blacs_gridinfo_0")){
pbdMPI::comm.warning("Context 0 is already initialized. No new grid created")
return( invisible(1) )
}
} else if (missing(NPROW) || missing(NPCOL)){
pbdMPI::comm.stop("You must supply either both 'NPROW' and 'NPCOL' or neither.")
}
# initialize grid
base.blacs_init(ICTXT=ICTXT, NPROW=NPROW, NPCOL=NPCOL, quiet=quiet)
if (ICTXT==0){
if (missing(NPROW) && missing(NPCOL)){
nprocs <- pbdMPI::comm.size()
procs <- base.procgrid(nprocs=nprocs)
NPROW <- as.integer(procs$nprow)
NPCOL <- as.integer(procs$npcol)
}
base.blacs_init(ICTXT=1L, NPROW=1, NPCOL=NPROW*NPCOL, quiet=TRUE)
base.blacs_init(ICTXT=2L, NPROW=NPROW*NPCOL, NPCOL=1, quiet=TRUE)
}
invisible(0)
}
#' Context Within a Given Communicator
#'
#' Creates a context that will be valid for a given communicator
#' @param comm Communicator for which you want to set the BLACS context
#' @return A system handle, i.e. the system context number. System contexts can be used to have ScalaPACK methods run in different communicators.
#' @seealso base.free_blacs_system_handle, base.blacs_gridinit
#'
#' @useDynLib pbdBASE R_sys2blacs_handle
#' @export
sys2blacs.handle <- function(comm)
{
.Call("R_sys2blacs_handle", comm, PACKAGE="pbdBASE")
}
#' gridexit
#'
#' Frees a BLACS context.
#'
#' For advanced users only. See pbdDMAT for high-level functions.
#'
#' The function frees the requested BLACS context. It is a trivial wrapper for
#' the BLACS routine \code{BLACS_GRIDEXIT}. Also removes the object
#' \code{.__blacs_gridinfo_ICTXT}.
#'
#' Contexts 0, 1, and 2 can not be freed in this way unless the argument
#' \code{override=FALSE}. This will probably break something and I do not
#' recommend it.
#'
#' @param ICTXT
#' BLACS context number.
#' @param override
#' logical; if TRUE, ignores normal check preventing the
#' closing of \code{ICTXT} values of 0, 1, and 2. This could cause things
#' to go crazy and I do not recommend it.
#'
#' @return
#' Silently returns 0 when successful. Silently returns 1 when
#' requested \code{ICTXT} does not exist.
#'
#' @keywords BLACS
#'
#' @useDynLib pbdBASE R_blacs_gridexit
#' @name gridexit
#' @rdname gridexit
#' @export
base.gridexit <- function(ICTXT, override=FALSE)
{
base.valid_context(ICTXT=ICTXT, override=override)
blacs_ <- base.blacs(ICTXT=ICTXT)
FCTXT <- blacs_$ICTXT
if (blacs_$MYROW != -1 && blacs_$MYCOL != -1)
.Call("R_blacs_gridexit", as.integer(FCTXT), PACKAGE="pbdBASE")
rm(list = paste(".__blacs_gridinfo_", ICTXT, sep=""), envir=.pbdBASEEnv)
invisible(0)
}
#' Free Blacs System Handle
#'
#' @param SHANDLE A system handle. Obtained via a call to `sys2blacs.handle`
#' @return None
#'
#' @useDynLib pbdBASE R_free_blacs_system_handle
#' @export
base.free_blacs_system_handle <- function(SHANDLE)
{
.Call("R_free_blacs_system_handle", as.integer(SHANDLE), PACKAGE = "pbdBASE")
invisible(0)
}
#' @rdname gridexit
#' @export
gridexit <- base.gridexit
#' BLACS Exit
#'
#' Shuts down all BLACS communicators.
#'
#' If the user wishes to shut down BLACS communicators but still have access to
#' MPI, then call this function with \code{CONT=TRUE}. Calling
#' \code{blacsexit(CONT=FALSE)} will shut down all MPI communicators,
#' equivalent to calling
#'
#' \code{> blacsexit(CONT=TRUE)} \code{> finalize(mpi.finalize=TRUE)}
#'
#' This function is automatically invoked if BLACS communicators are running
#' and \code{finalize()} is called.
#'
#' @param CONT
#' logical; determines whether or not to shut down \emph{all} MPI
#' communicators
#'
#' @return
#' Has an invisible return of 0 when successful.
#'
#' @keywords BLACS
#'
#' @examples
#' spmd.code <- "
#' suppressMessages(library(pbdMPI))
#' suppressMessages(library(pbdBASE))
#' init.grid()
#'
#' ### Do something with BLACS here.
#'
#' ### Don't use this unless you know what to do after this.
#' # blacsexit()
#'
#' ### Then, do others without BLACS here.
#'
#' finalize() # This should be off since blacexit().
#' "
#' pbdMPI::execmpi(spmd.code = spmd.code, nranks = 2L)
#'
#' @useDynLib pbdBASE R_blacs_exit
#' @name blacsexit
#' @rdname blacsexit
#' @export
base.blacsexit <- function(CONT=TRUE)
{
.Call("R_blacs_exit", as.integer(CONT), PACKAGE="pbdBASE")
invisible(0)
}
#' @rdname blacsexit
#' @export
blacsexit <- base.blacsexit
#' Finalizer
#'
#' A replacement for \code{pbdMPI::finalize()} that automatically
#' shuts BLACS communicators down.
#'
#' @param mpi.finalize
#' If MPI should be shut down.
#' @return None
#'
#' @name finalizer
#' @rdname finalizer
#' @export
base.finalize <- function(mpi.finalize=.pbd_env$SPMD.CT$mpi.finalize)
{
if (exists(".__blacs_initialized", envir = .pbdBASEEnv)){
base.blacsexit(CONT=TRUE)
rm(list = ".__blacs_initialized", envir = .pbdBASEEnv)
}
pbdMPI::finalize(mpi.finalize=mpi.finalize)
}
#' @rdname finalizer
#' @export
finalize <- base.finalize
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.