R/Rcomm.R

Defines functions mpi.comm.c2f mpi.intercomm.merge mpi.comm.is.null mpi.comm.get.parent mpi.comm.spawn mpi.comm.disconnect mpi.abort mpi.comm.free mpi.comm.remote.size mpi.comm.dup mpi.comm.size mpi.comm.rank mpi.comm.test.inter mpi.comm.set.errhandler mpi.barrier

Documented in mpi.abort mpi.barrier mpi.comm.c2f mpi.comm.disconnect mpi.comm.dup mpi.comm.free mpi.comm.get.parent mpi.comm.is.null mpi.comm.rank mpi.comm.remote.size mpi.comm.set.errhandler mpi.comm.size mpi.comm.spawn mpi.comm.test.inter mpi.intercomm.merge

### Copyright (C) 2002 Hao Yu 
mpi.barrier <- function(comm=1){
    .Call("mpi_barrier", as.integer(comm),PACKAGE = "Rmpi")
}

mpi.comm.set.errhandler <- function(comm=1){
    .Call("mpi_comm_set_errhandler", as.integer(comm),
    PACKAGE = "Rmpi")
}

mpi.comm.test.inter <- function(comm=2){
    if(mpi.comm.is.null(comm))
        stop("NULL communicator")
    .Call("mpi_comm_test_inter",as.integer(comm),PACKAGE = "Rmpi")
}

mpi.comm.rank <- function(comm=1){
    .Call("mpi_comm_rank", as.integer(comm),PACKAGE = "Rmpi")
}

mpi.comm.size <- function(comm=1){
    if (.Call("mpi_comm_is_null", as.integer(comm),
        PACKAGE = "Rmpi")==1)
        0
    else 
        .Call("mpi_comm_size",as.integer(comm),PACKAGE = "Rmpi")
}

mpi.comm.dup <- function(comm, newcomm){
        .Call("mpi_comm_dup", as.integer(comm), as.integer(newcomm),
    PACKAGE = "Rmpi")
}

mpi.comm.remote.size <- function(comm=2){
    .Call("mpi_comm_remote_size", as.integer(comm),PACKAGE = "Rmpi")
}

mpi.comm.free <- function(comm=1){
    if (mpi.comm.size(comm)==0){
    tmp<-paste("It seems no members(slaves) associated with comm", comm)
    stop(tmp)
     }
     .Call("mpi_comm_free",as.integer(comm),PACKAGE = "Rmpi")
}

mpi.abort <- function(comm=1){
    if (mpi.comm.size(comm)==0){
    tmp<-paste("It seems no members(slaves) associated with comm", comm)
    stop(tmp)
     }
     .Call("mpi_abort",as.integer(comm),PACKAGE = "Rmpi")
}

mpi.comm.disconnect <- function(comm=1){
    if (mpi.comm.size(comm)==0){
    tmp<-paste("It seems no members(slaves) associated with comm", comm)
    stop(tmp)
     }
     if (!is.loaded("mpi_comm_disconnect"))
        stop("MPI_Comm_disconnect is not supported.")
     .Call("mpi_comm_disconnect",as.integer(comm),PACKAGE = "Rmpi")
}

mpi.comm.spawn <- function(slave, 
            slavearg=character(0), 
            nslaves=mpi.universe.size(),
            info=0,
            root=0, 
            intercomm=2,
			quiet=FALSE){
        if (!is.loaded("mpi_comm_spawn"))
            stop("MPI_Comm_spawn is not supported.")

    if (!is.character(slave))
        stop("character argument (slave) expected")
    #if (nslaves > mpi.universe.size()){
    #            tmp <- paste("Number of R slaves is over",
    #                    mpi.universe.size(),": maximum CPUs.")
    #            warning(tmp)
    #    }
    else if (nslaves <= 0)
        stop("Choose a positive number of slaves.")
    .Call("mpi_comm_spawn",
                as.character(slave),
                as.character(slavearg),
                as.integer(nslaves),
        as.integer(info),
        as.integer(root),
        as.integer(intercomm),
		as.integer(quiet),
		PACKAGE = "Rmpi")
}

mpi.comm.get.parent <- function(comm=2){
    if (!is.loaded("mpi_comm_get_parent"))
        stop("MPI_Comm_get_parent is not supported.")
    .Call("mpi_comm_get_parent", as.integer(comm),PACKAGE = "Rmpi")
}

mpi.comm.is.null <- function(comm){
    as.logical(.Call("mpi_comm_is_null", as.integer(comm),
    PACKAGE = "Rmpi"))
}

mpi.intercomm.merge <- function(intercomm=2,high=0,comm=1){
    .Call("mpi_intercomm_merge", as.integer(intercomm),
                     as.integer(high),
                     as.integer(comm),PACKAGE = "Rmpi")
}

mpi.comm.c2f <- function(comm=1){
    .Call("mpi_comm_c2f", as.integer(comm),PACKAGE = "Rmpi")
}

Try the Rmpi package in your browser

Any scripts or data that you put into this service are public.

Rmpi documentation built on Nov. 13, 2018, 9:03 a.m.