int main(int argc, char **argv)
{
MPI_Group basegroup;
MPI_Group g1;
MPI_Comm comm, newcomm;
int rank, size;
int worldrank;
int errs = 0, errclass, mpi_errno;
MTest_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &worldrank);
comm = MPI_COMM_WORLD;
MPI_Comm_group(comm, &basegroup);
MPI_Comm_rank(comm, &rank);
MPI_Comm_size(comm, &size);
MPI_Errhandler_set(MPI_COMM_WORLD, MPI_ERRORS_RETURN);
MPI_Comm_split(comm, 0, size - rank, &newcomm);
MPI_Comm_group(newcomm, &g1);
/* Checking group_intersection for NULL variable */
mpi_errno = MPI_Group_intersection(basegroup, g1, NULL);
MPI_Error_class(mpi_errno, &errclass);
if (errclass != MPI_ERR_ARG)
++errs;
MPI_Comm_free(&comm);
MPI_Comm_free(&newcomm);
MPI_Group_free(&basegroup);
MPI_Group_free(&g1);
MTest_Finalize(errs);
return 0;
}
dart_ret_t dart_group_intersect(
const dart_group_t *g1,
const dart_group_t *g2,
dart_group_t *gout)
{
return MPI_Group_intersection(
g1 -> mpi_group,
g2 -> mpi_group,
&(gout -> mpi_group));
}
JNIEXPORT jlong JNICALL Java_mpi_Group_intersection(
JNIEnv *env, jclass jthis, jlong group1, jlong group2)
{
MPI_Group newGroup;
int rc = MPI_Group_intersection(
(MPI_Group)group1, (MPI_Group)group2, &newGroup);
ompi_java_exceptionCheck(env, rc);
return (jlong)newGroup;
}
/*
* Class: mpi_Group
* Method: intersection
* Signature: (Lmpi/Group;Lmpi/Group;)J
*/
JNIEXPORT jlong JNICALL Java_mpi_Group_intersection(JNIEnv *env, jclass jthis,
jobject group1, jobject group2)
{
MPI_Group newgroup;
ompi_java_clearFreeList(env) ;
MPI_Group_intersection((MPI_Group)((*env)->GetLongField(env,group1,ompi_java.GrouphandleID)),
(MPI_Group)((*env)->GetLongField(env,group2,ompi_java.GrouphandleID)),
&newgroup);
return (jlong)newgroup;
}
static VALUE group_intersection(VALUE self, VALUE rgrp2)
{
int rv;
MPI_Group *grp1, *grp2, *newgrp;
Data_Get_Struct(self, MPI_Group, grp1);
Data_Get_Struct(grp2, MPI_Group, grp2);
newgrp = ALLOC(MPI_Group);
rv = MPI_Group_intersection(*grp1, *grp2, newgrp);
mpi_exception(rv);
return group_new(newgrp);
}
int foMPI_Win_create(void *base, MPI_Aint size, int disp_unit, MPI_Info info, MPI_Comm comm, foMPI_Win *win) {
int i;
int* temp;
MPI_Group group_comm_world, group;
foMPI_Win_struct_t win_info;
assert( size >= 0 );
assert( disp_unit > 0 );
/* allocate the window */
void * memptr;
_foMPI_ALIGNED_ALLOC(&memptr, sizeof(foMPI_Win_desc_t) )
*win = memptr;
assert(*win != NULL);
/**transition info. As soon as an foMPI Communicator is implemented update this UGNI use this*/
(*win)->fompi_comm = glob_info.comm_world;
/* the window communicator specific informations */
(*win)->comm = comm;
MPI_Comm_size( comm, &((*win)->commsize) );
MPI_Comm_rank( comm, &((*win)->commrank) );
/* get all ranks from the members of the group */
(*win)->group_ranks = _foMPI_ALLOC((*win)->commsize * sizeof(int32_t));
assert((*win)->group_ranks != NULL);
temp = _foMPI_ALLOC((*win)->commsize * sizeof(int));
assert( temp != NULL );
for( i=0 ; i<(*win)->commsize ; i++) {
temp[i] = i;
}
MPI_Comm_group(comm, &group);
MPI_Comm_group(MPI_COMM_WORLD, &group_comm_world);
MPI_Group_translate_ranks(group, (*win)->commsize, &temp[0], group_comm_world, &((*win)->group_ranks[0]));
_foMPI_FREE(temp);
MPI_Group_free(&group_comm_world);
#ifdef UGNI
gni_return_t status_gni;
#ifdef _foMPI_UGNI_WIN_RELATED_SRC_CQ
/*
* Create the source completion queue.
* nic_handle is the NIC handle that this completion queue will be
* associated with.
* number_of_cq_entries is the size of the completion queue.
* zero is the delay count is the number of allowed events before an
* interrupt is generated.
* GNI_CQ_NOBLOCK states that the operation mode is non-blocking.
* NULL states that no user supplied callback function is defined.
* NULL states that no user supplied pointer is passed to the callback
* function.
* cq_handle is the handle that is returned pointing to this newly
* created completion queue.
*/
(*win)->number_of_source_cq_entries = _foMPI_NUM_SRC_CQ_ENTRIES;
status_gni = GNI_CqCreate((*win)->fompi_comm->nic_handle, (*win)->number_of_source_cq_entries , 0,
_foMPI_SRC_CQ_MODE, NULL, NULL, &((*win)->source_cq_handle));
_check_gni_status(status_gni, GNI_RC_SUCCESS, (char*) __FILE__, __LINE__);
_foMPI_TRACE_LOG(3, "GNI_CqCreate source with %i entries\n", (*win)->number_of_source_cq_entries);
#endif
(*win)->counter_ugni_nbi = 0;
/*
* Create the destination_completion queue.
* nic_handle is the NIC handle that this completion queue will be
* associated with.
* number_of_dest_cq_entries is the size of the completion queue.
* zero is the delay count is the number of allowed events before
* an interrupt is generated.
* GNI_CQ_NOBLOCK states that the operation mode is non-blocking.
* NULL states that no user supplied callback function is defined.
* NULL states that no user supplied pointer is passed to the
* callback function.
* destination_cq_handle is the handle that is returned pointing to
* this newly created completion queue.
*/
(*win)->number_of_dest_cq_entries = _foMPI_NUM_DST_CQ_ENTRIES;
//we try to use the handler instead of only the dispatcher trying to decrease the latency of the notification
#ifdef NOTIFICATION_SOFTWARE_AGENT
// status_gni = GNI_CqCreate(glob_info.comm_world->nic_handle, (*win)->number_of_dest_cq_entries, 0,
// foMPI_DST_CQ_MODE, &foMPI_NotificationHandler, (*win), &((*win)->destination_cq_handle));
#else
//TODO: substitute comme world with foMPI_Comm
status_gni = GNI_CqCreate((*win)->fompi_comm->nic_handle, (*win)->number_of_dest_cq_entries, 0,
_foMPI_DST_CQ_MODE, NULL, NULL, &((*win)->destination_cq_handle));
#endif
_check_gni_status(status_gni, GNI_RC_SUCCESS, (char*) __FILE__, __LINE__);
_foMPI_TRACE_LOG(3 , "GNI_CqCreate destination with %i entries\n",(*win)->number_of_dest_cq_entries);
/*init backup_queue*/
(*win)->destination_cq_discarded = _fompi_notif_uq_init();
_foMPI_TRACE_LOG(3, "fompi_oset Created \n");
#endif
#ifdef XPMEM
/* get communicator for all onnode processes that are part of the window */
MPI_Group_intersection( glob_info.onnode_group, group /* window group */, &((*win)->win_onnode_group) );
MPI_Comm_create( comm, (*win)->win_onnode_group, &((*win)->win_onnode_comm) );
/* mapping of the global ranks (of the window communicator */
MPI_Group_size( (*win)->win_onnode_group, &((*win)->onnode_size) );
temp = _foMPI_ALLOC( (*win)->onnode_size * sizeof(int));
assert( temp != NULL );
(*win)->onnode_ranks = _foMPI_ALLOC( (*win)->onnode_size * sizeof(int));
assert( (*win)->onnode_ranks != NULL );
for( i=0 ; i<(*win)->onnode_size ; i++) {
temp[i] = i;
}
MPI_Group_translate_ranks((*win)->win_onnode_group, (*win)->onnode_size, &temp[0], group, &((*win)->onnode_ranks[0]) );
for( i=1 ; i<(*win)->onnode_size ; i++ ) {
if( (*win)->onnode_ranks[i] != ( (*win)->onnode_ranks[i-1]+1 ) ) {
break;
}
}
if (i == (*win)->onnode_size) {
(*win)->onnode_lower_bound = (*win)->onnode_ranks[0];
(*win)->onnode_upper_bound = (*win)->onnode_ranks[(*win)->onnode_size-1];
_foMPI_FREE( (*win)->onnode_ranks );
} else {
(*win)->onnode_lower_bound = -1;
(*win)->onnode_upper_bound = -1;
}
//NOTIFICATION QUEUE
/*init data structure and export*/
int exp_size;
xpmem_notif_init_queue(*win,(*win)->onnode_size);
/*export memory and save into the segment descriptor to send to others on-node PEs*/
(*win)->xpmem_segdesc.notif_queue = foMPI_export_memory_xpmem((*win)->xpmem_notif_queue, sizeof(fompi_xpmem_notif_queue_t));
(*win)->xpmem_segdesc.notif_queue_state = foMPI_export_memory_xpmem((void*)((*win)->xpmem_notif_state_lock),sizeof(fompi_xpmem_notif_state_t) + (*win)->onnode_size * sizeof(lock_flags_t));
_foMPI_FREE( temp );
#endif
MPI_Group_free(&group);
/* allocate the memory for the remote window information */
_foMPI_ALIGNED_ALLOC(&memptr, (*win)->commsize * sizeof(foMPI_Win_struct_t) )
(*win)->win_array = memptr ;
assert((*win)->win_array != NULL);
/* set the information for the remote processes */
if ( (base != NULL) && (size > 0) ) {
win_info.base = base;
_foMPI_mem_register( base, (uint64_t) size, &(win_info.seg), *win );
#ifdef XPMEM
(*win)->xpmem_segdesc.base = foMPI_export_memory_xpmem(base, size);
#endif
} else {
win_info.base = NULL;
#ifdef XPMEM
(*win)->xpmem_segdesc.base.seg = -1;
#endif
}
win_info.size = size;
win_info.disp_unit = disp_unit;
win_info.win_ptr = *win;
_foMPI_mem_register( *win, (uint64_t) sizeof(foMPI_Win_desc_t), &(win_info.win_ptr_seg), *win );
#ifdef XPMEM
(*win)->xpmem_segdesc.win_ptr = foMPI_export_memory_xpmem(*win, sizeof(foMPI_Win_desc_t));
#endif
/* PCSW matching */
_foMPI_ALIGNED_ALLOC(&memptr, (*win)->commsize * sizeof(uint64_t) )
win_info.pscw_matching_exposure = memptr;
assert( win_info.pscw_matching_exposure != NULL );
_foMPI_ALIGNED_ALLOC(&memptr, (*win)->commsize * sizeof(uint32_t))
(*win)->pscw_matching_access = memptr ;
assert( (*win)->pscw_matching_access != NULL );
for( i=0 ; i<(*win)->commsize ; i++ ){
win_info.pscw_matching_exposure[i] = 0;
(*win)->pscw_matching_access[i] = 0;
}
_foMPI_mem_register( win_info.pscw_matching_exposure, (uint64_t) (*win)->commsize * sizeof(uint64_t), &(win_info.pscw_matching_exposure_seg), *win );
#ifdef XPMEM
(*win)->xpmem_segdesc.pscw_matching_exposure = foMPI_export_memory_xpmem( win_info.pscw_matching_exposure, (*win)->commsize * sizeof(uint64_t) );
#endif
/* lock synchronisation */
(*win)->mutex = foMPI_MUTEX_NONE;
(*win)->lock_mutex = 0; /* no current access */
if ( (*win)->commrank == MASTER ) {
(*win)->lock_all_mutex = 0; /* no current access */
}
(*win)->local_exclusive_count = 0;
(*win)->excl_locks = NULL;
/* management of rma operations */
(*win)->nbi_counter = 0;
(*win)->name = NULL;
(*win)->create_flavor = foMPI_WIN_FLAVOR_CREATE;
MPI_Allgather( &win_info, sizeof(foMPI_Win_struct_t), MPI_BYTE, &((*win)->win_array[0]), sizeof(foMPI_Win_struct_t), MPI_BYTE, comm );
#ifdef XPMEM
/* exchange the exposure infos with the onnode processes */
(*win)->xpmem_array = _foMPI_ALLOC( (*win)->onnode_size * sizeof(fompi_xpmem_addr_t) );
assert( (*win)->xpmem_array != NULL );
fompi_xpmem_info_t* xpmem_temp = _foMPI_ALLOC( (*win)->onnode_size * sizeof(fompi_xpmem_info_t) );
MPI_Allgather( &((*win)->xpmem_segdesc), sizeof(fompi_xpmem_info_t), MPI_BYTE, &(xpmem_temp[0]), sizeof(fompi_xpmem_info_t), MPI_BYTE, (*win)->win_onnode_comm );
/* map the onnode memory */
for( i=0 ; i<(*win)->onnode_size ; i++ ) {
if (xpmem_temp[i].base.seg != -1) {
(*win)->xpmem_array[i].base = foMPI_map_memory_xpmem( xpmem_temp[i].base, (*win)->win_array[foMPI_onnode_rank_local_to_global( i, (*win) )].size,
&((*win)->xpmem_array[i].base_apid), &((*win)->xpmem_array[i].base_offset) );
} else {
(*win)->xpmem_array[i].base_apid = -1;
}
(*win)->xpmem_array[i].win_ptr = foMPI_map_memory_xpmem( xpmem_temp[i].win_ptr, sizeof(foMPI_Win_desc_t), &((*win)->xpmem_array[i].win_ptr_apid), &((*win)->xpmem_array[i].win_ptr_offset) );
(*win)->xpmem_array[i].pscw_matching_exposure = foMPI_map_memory_xpmem( xpmem_temp[i].pscw_matching_exposure, (*win)->commsize * sizeof(uint64_t),
&((*win)->xpmem_array[i].pscw_matching_exposure_apid), &((*win)->xpmem_array[i].pscw_matching_exposure_offset) );
//notifications
(*win)->xpmem_array[i].notif_queue = foMPI_map_memory_xpmem( xpmem_temp[i].notif_queue, sizeof(fompi_xpmem_notif_queue_t), &((*win)->xpmem_array[i].notif_queue_apid), &((*win)->xpmem_array[i].notif_queue_offset) );
(*win)->xpmem_array[i].notif_queue_state = foMPI_map_memory_xpmem( xpmem_temp[i].notif_queue_state, (*win)->onnode_size * sizeof(lock_flags_t), &((*win)->xpmem_array[i].notif_queue_state_apid), &((*win)->xpmem_array[i].notif_queue_state_offset) );
}
_foMPI_FREE( xpmem_temp );
#endif
return MPI_SUCCESS;
}
value caml_mpi_group_intersection(value group1, value group2)
{
MPI_Group group;
MPI_Group_intersection(Group_val(group1), Group_val(group2), &group);
return caml_mpi_alloc_group(group);
}
static void Init_mpi(int targc,char *targv[]) {
# ifndef HOSTNAME_LEN
# define HOSTNAME_LEN 96
# endif
int argc = targc;
char **argv = targv;
int i,j,np,me,nc,nd,ndpn;
int np_local,me_local;
int nnodes,mynode,master;
int icp,ids,cpus,myds,ext;
int *ranks,*disp,*world;
int *ranks_local;
int me_mpi,me_ddi,rbn;
MPI_Group Comm_World_grp;
MPI_Group SMP_World_grp;
MPI_Group SMP_Compute_grp;
MPI_Group DDI_World_grp;
MPI_Group DDI_Compute_grp;
MPI_Comm SMP_World_comm;
MPI_Comm SMP_Compute_comm;
MPI_Comm SMP_Masters_comm;
MPI_Comm DDI_World_comm;
MPI_Comm DDI_Compute_comm;
char hostname[HOSTNAME_LEN],*c,*hostnames;
DDI_Comm *comm = (DDI_Comm *) &gv(ddi_base_comm);
int threadLevel;
# ifdef WINDOWS
/* ------------------------------ *\
Initialize Windows Sockets 2.2
\* ------------------------------ */
WORD wVersionRequested;
WSADATA wsaData;
wVersionRequested = MAKEWORD(2, 2);
WSAStartup(wVersionRequested, &wsaData);
# endif
/* -------------- *\
Initialize MPI
\* -------------- */
if(MPI_Init_thread(&argc, &argv, MPI_THREAD_MULTIPLE, &threadLevel) != MPI_SUCCESS) {
fprintf(stdout," DDI: MPI_Init failed.\n");
fflush(stdout); exit(911);
}
/* -------------------------------- *\
* Initialize DDI working directory
\* -------------------------------- */
Init_scratch(argc,argv);
/* ------------------------------------------ *\
Determine Rank and Number of MPI Processes
\* ------------------------------------------ */
MPI_Comm_size(MPI_COMM_WORLD,&np);
MPI_Comm_rank(MPI_COMM_WORLD,&me);
/* -------------------------------------- *\
For debugging purposes, set gv(myproc)
\* -------------------------------------- */
comm->me = me;
DEBUG_ROOT(LVL1,(stdout," DDI: MPI initialized. %i MPI processes.\n",np))
/* ---------------------------------------------------- *\
MPI-1 requires data servers unless it is using LAPI.
MPI-2 does not require data servers at all.
----------------------------------------------------
nc = 0 ==> standard data server model (cp:ds::1:1).
nc = np ==> specialized model such as LAPI || MPI-2.
\* ---------------------------------------------------- */
nc = 0;
# if defined DDI_LAPI || defined DDI_MPI2 || defined CRAY_MPI
nc = np;
# endif
/* ------------------------------------------ *\
Standard MPI-1 model (nc=0) ==> cp:ds::1:1
\* ------------------------------------------ */
if(nc == 0) {
if((np % 2) && (me == 0)) {
fprintf(stdout," Error: Expecting an even number of MPI processes (cp:ds::1:1).\n");
Fatal_error(911);
}
nc = nd = np/2;
}
/* ------------------------------------------------ *\
MPI-2 or MPI-1/LAPI model (nc=np) ==> cp:ds::1:0
\* ------------------------------------------------ */
if(nc == np) nd = 0;
/* ------------------------------------------------------------- *\
Check to make sure the job complies with compile time limits.
\* ------------------------------------------------------------- */
if(nc > MAX_PROCESSORS) {
if(me == 0) {
fprintf(stdout," DDI: \"Houston, we have a problem.\"\n");
fprintf(stdout," DDI: MAX_NODES = %i\n",MAX_NODES);
fprintf(stdout," DDI: MAX_SMP_PROCS = %i\n",MAX_SMP_PROCS);
fprintf(stdout," DDI: MAX_PROCESSORS = MAX_NODES * MAX_SMP_PROCS = %i\n",MAX_PROCESSORS);
fprintf(stdout," DDI: MPI reports %i processes ==> %i processors.\n",np,nc);
fprintf(stdout," DDI: Please correct the limits and recompile DDI.\n");
fflush(stdout);
}
MPI_Barrier(MPI_COMM_WORLD);
MPI_Finalize();
exit(0);
}
/* ------------------------------------------------------------------- *\
Non-Standard MPI-1 Model (nc < np && ((nc | np) || (np-nc | np)))
Can be used to vary the number of data server per node by assigning
a number of data servers each compute process or a number of data
server per node. This code has not been implemented.
\* ------------------------------------------------------------------- */
if(nc != nd && nc != np) {
fprintf(stdout," DDI: This should never have been executed.\n");
Fatal_error(911);
}
/* ---------------------------------- *\
System command to get the hostname
\* ---------------------------------- */
gethostname(hostname,HOSTNAME_LEN);
DEBUG_OUT(LVL4,(stdout," MPI Process %i: hostname=%s\n",me,hostname))
/* -------------------------------------------- *\
Gather all the hostnames into a single array
\* -------------------------------------------- */
hostnames = (char *) Malloc(np*HOSTNAME_LEN);
MPI_Allgather(hostname, HOSTNAME_LEN,MPI_BYTE,
hostnames,HOSTNAME_LEN,MPI_BYTE,MPI_COMM_WORLD);
/* -------------------------------------- *\
Determine all MPI Process on "my" node
\* -------------------------------------- */
ranks = (int *) Malloc(np*sizeof(int));
for(i=0,np_local=0,c=hostnames; i<np; i++,c+=HOSTNAME_LEN) {
if(strcmp(hostname,c) == 0) ranks[np_local++] = i;
}
DEBUG_OUT(LVL4,(stdout," MPI Process %i: %i local MPI processes.\n",me,np_local))
ranks_local = (int *) Malloc(np_local*sizeof(int));
memcpy(ranks_local,ranks,np_local*sizeof(int));
/* ----------------------------- *\
Create SMP_World communicator
\* ----------------------------- */
MPI_Comm_group(MPI_COMM_WORLD,&Comm_World_grp);
MPI_Group_incl(Comm_World_grp,np_local,ranks_local,&SMP_World_grp);
MPI_Comm_create(MPI_COMM_WORLD,SMP_World_grp,&SMP_World_comm);
MPI_Barrier(MPI_COMM_WORLD);
DEBUG_ROOT(LVL3,(stdout," DDI: SMP_World_comm created.\n"))
/* ------------------------------ *\
Create SMP_Master communicator
\* ------------------------------ */
MPI_Comm_rank(SMP_World_comm,&me_local);
master = 0;
if(me_local == 0) master = 1;
MPI_Comm_split(MPI_COMM_WORLD,master,0,&SMP_Masters_comm);
MPI_Barrier(MPI_COMM_WORLD);
DEBUG_ROOT(LVL3,(stdout," DDI: SMP_Master_comm created.\n"))
/* --------------------------------------------------------------------------- *\
Create Compute_comm and World_comm communicators
================================================
First gather the node information, then sort that information by node (not
guarenteed to be sorted). Next assign compute processes and data servers
(if they exist), and finally create the communicators.
\* --------------------------------------------------------------------------- */
MPI_Comm_size(SMP_Masters_comm,&nnodes);
MPI_Comm_rank(SMP_Masters_comm,&mynode);
MPI_Bcast(&nnodes,1,MPI_INT,0,SMP_World_comm);
MPI_Bcast(&mynode,1,MPI_INT,0,SMP_World_comm);
MPI_Barrier(MPI_COMM_WORLD);
DEBUG_ROOT(LVL3,(stdout," DDI: There are %i nodes.\n",nnodes))
/* --------------------------------------- *\
Check compile-time limits for MAX_NODES
\* --------------------------------------- */
if(nnodes > MAX_NODES) {
if(me == 0) {
fprintf(stdout," DDI: MAX_NODES = %i\n",MAX_NODES);
fprintf(stdout," DDI: MPI topology suggests %i nodes.\n",nnodes);
fprintf(stdout," DDI: Increase MAX_NODES and recompile DDI.\n");
fflush(stdout);
}
MPI_Barrier(MPI_COMM_WORLD);
MPI_Finalize();
exit(0);
}
/* ----------------------- *\
Gather node information
\* ----------------------- */
np_by_node = (int *) Malloc(nnodes*sizeof(int));
ranks_by_node = (int **) Malloc(nnodes*sizeof(int*));
if(me_local == 0) {
DEBUG_OUT(LVL4,(stdout," MPI Process %i: Node %i master.\n",me,mynode))
MPI_Allgather(&np_local,1,MPI_INT,np_by_node,1,MPI_INT,SMP_Masters_comm);
for(i=0,j=0; i<nnodes; i++) j += np_by_node[i];
if(j != np) {
fprintf(stdout,"ddi_init: got j= %i, expected np= %i\n",j,np);
fprintf(stdout," DDI Error: Sum of PPN over all nodes != NP\n");
Fatal_error(911);
}
disp = (int *) Malloc(nnodes*sizeof(int));
for(i=1,disp[0]=0; i<nnodes; i++) disp[i] = disp[i-1] + np_by_node[i-1];
MPI_Allgatherv(ranks_local,np_local,MPI_INT,ranks,np_by_node,disp,MPI_INT,
SMP_Masters_comm);
free(disp);
}
MPI_Bcast(np_by_node,nnodes,MPI_INT,0,SMP_World_comm);
MPI_Bcast(ranks,np,MPI_INT,0,SMP_World_comm);
MPI_Barrier(MPI_COMM_WORLD);
DEBUG_ROOT(LVL3,(stdout," DDI: Node topology determined.\n"))
ranks_by_node[0] = ranks;
for(i=1; i<nnodes; i++) ranks_by_node[i] = (ranks_by_node[i-1] + np_by_node[i-1]);
/* --------------------------------------------------------------------------- *\
Each MPI process has a list of MPI ranks sorted by node. The list of ranks
for a particular node is sorted from lowest to highest rank, where the rank
corresponds to the value in MPI_COMM_WORLD communicator. Next determine the
number of compute processes/node. Data servers/node can be inferred.
\* --------------------------------------------------------------------------- */
nc_by_node = (int *) Malloc(nnodes*sizeof(int));
nd_by_node = (int *) Malloc(nnodes*sizeof(int));
if(nc == nd) {
/* ------------------------------------------------------------- *\
There are a given number of data servers per compute process.
Now the ratio must be 1:1. CP:DS:1:N not implemented (yet).
\* ------------------------------------------------------------- */
j = nd/nc + 1; /* j represents the number of MPI process per compute process */
for(i=0; i<nnodes; i++) {
if((np_by_node[i] % j)) {
fprintf(stdout," DDI: For every CP requested there should be %i MPI processes.\n",j);
fprintf(stdout," DDI Error: np on node %i is not divisible by %i.\n",i,j);
Fatal_error(911);
}
nc_by_node[i] = np_by_node[i] / j;
nd_by_node[i] = np_by_node[i] - nc_by_node[i];
}
}
if(nc == np) {
# if defined CRAY_MPI
/* ------------------------------------------------------------- *\
The environmental variable DDI_DS_PER_NODE is used to control
the number of MPI processes that become data servers.
\* ------------------------------------------------------------- */
if(me == 0) {
if(getenv("DDI_DS_PER_NODE")) {
ndpn = atoi(getenv("DDI_DS_PER_NODE"));
} else {
ndpn = 1;
}
if(nnodes == 1) ndpn = 0;
fprintf(stdout,"MPI is using %i data servers/node. (DDI_DS_PER_NODE)\n",ndpn);
}
MPI_Bcast(&ndpn,1,MPI_INT,0,MPI_COMM_WORLD);
/* -------------------------------------------------------- *\
If DDI_DS_PER_NODE is invalid, then shutdown gracefully.
\* -------------------------------------------------------- */
if(ndpn < 0 || ndpn > MAX_SMP_PROCS-1) {
if(me == 0) {
fprintf(stdout,"%s: DDI_DS_PER_NODE=%i is invalid.\n",
DDI_Id(),ndpn);
fprintf(stdout,"%s: The value must between 0 and %i.\n",
DDI_Id(),MAX_SMP_PROCS-1);
fflush(stdout);
sleep(1);
}
MPI_Finalize();
}
nd = nnodes*ndpn;
nc = np - nd;
# endif
/* --------------------------------------------- *\
MPI-2 or MPI-1/LAPI model ==> no data servers
\* --------------------------------------------- */
for(i=0; i<nnodes; i++) {
nc_by_node[i] = np_by_node[i];
nd_by_node[i] = 0;
# if defined CRAY_MPI
nc_by_node[i] = np_by_node[i]-ndpn;
nd_by_node[i] = ndpn;
/* ------------------------------------------- *\
Sanity check - Ensure >1 CP exists per node
\* ------------------------------------------- */
if(nc_by_node[i] <= 0) {
if(me == 0) {
fprintf(stdout,
" ERROR: There are no CPs assigned to node %i.\n",i);
fprintf(stdout,
" The total number of processes on node %i = %i.\n",
i,np_by_node[i]);
fprintf(stdout,
" Attempted to reserve %i processes as data servers.\n",
ndpn);
fflush(stdout);
sleep(1);
}
MPI_Finalize();
}
# endif
}
}
gv(np) = np;
gv(nc) = nc;
gv(nd) = nd;
DEBUG_ROOT(LVL3,(stdout," DDI: There are %i DDI compute processes.\n",nc))
DEBUG_ROOT(LVL3,(stdout," DDI: There are %i DDI data servers.\n",nd))
/* -------------------------------------------------------------------- *\
Create a list of ranks that will eventually become the communicators
\* -------------------------------------------------------------------- */
world = (int *) Malloc(np*sizeof(int));
for(i=0,icp=0,ids=nc; i<nnodes; i++) {
for(j=0; j<np_by_node[i]; j++) {
if(j<nc_by_node[i]) world[icp++] = ranks_by_node[i][j];
else world[ids++] = ranks_by_node[i][j];
}
}
MPI_Barrier(MPI_COMM_WORLD);
DEBUG_OUT(LVL4,(stdout," MPI Process %i: nc=%i; np=%i.\n",me,nc,np))
/* ------------------------------------ *\
Create DDI_Compute_comm communicator
\* ------------------------------------ */
MPI_Group_incl(Comm_World_grp,nc,world,&DDI_Compute_grp);
MPI_Comm_create(MPI_COMM_WORLD,DDI_Compute_grp,&DDI_Compute_comm);
/* ---------------------------------- *\
Create DDI_World_comm communicator
\* ---------------------------------- */
MPI_Group_incl(Comm_World_grp,np,world,&DDI_World_grp);
MPI_Comm_create(MPI_COMM_WORLD,DDI_World_grp,&DDI_World_comm);
/* ------------------------------------ *\
Create SMP_Compute_comm communicator
\* ------------------------------------ */
MPI_Group_intersection(DDI_Compute_grp,SMP_World_grp,&SMP_Compute_grp);
MPI_Comm_create(MPI_COMM_WORLD,SMP_Compute_grp,&SMP_Compute_comm);
DEBUG_ROOT(LVL3,(stdout," DDI: finished forming communicators.\n"))
/* ------------------------------------ *\
Finished creating MPI communicators.
Initialize internal DDI structures.
\* ------------------------------------ */
MPI_Comm_rank(DDI_World_comm,&me);
comm->np = nc;
comm->me = me;
comm->nn = nnodes;
comm->my = mynode;
MPI_Comm_rank(MPI_COMM_WORLD,&me_mpi);
MPI_Comm_rank(DDI_World_comm,&me_ddi);
DEBUG_OUT(LVL3,(stdout," MPI Process %i = DDI Process %i\n",me_mpi,me_ddi))
comm->id = DDI_COMM_WORLD;
comm->smp_comm = SMP_Compute_comm;
comm->world_comm = DDI_World_comm;
comm->compute_comm = DDI_Compute_comm;
comm->node_comm = SMP_Masters_comm;
comm->smp_world = SMP_World_comm;
# if !defined USE_SYSV
comm->nn = nc;
comm->my = me;
if(comm->my >= nc) comm->my -= nc;
comm->smp_comm = MPI_COMM_SELF;
comm->node_comm = DDI_Compute_comm;
# endif
/* -------------------------------------------------------------------- *\
Check for network extention. The extension would be appended to the
hostname if it becomes necessary to form a TCP/IP socket to the host
\* -------------------------------------------------------------------- */
# ifdef DDI_SOC
for(i=0,ext=0; i<argc && strcmp("-netext",argv[i]) != 0; i++);
if(i != argc) ext = ++i;
# endif
/* ---------------------------------------------------------------- *\
Scan through the list of hostnames and extract the node topology
\* ---------------------------------------------------------------- */
MPI_Allgather(hostname, HOSTNAME_LEN,MPI_BYTE,
hostnames,HOSTNAME_LEN,MPI_BYTE,DDI_World_comm);
MPI_Allgather(&me,1,MPI_INT,ranks_local,1,MPI_INT,SMP_World_comm);
if(me_local == 0) {
disp = (int *) Malloc(nnodes*sizeof(int));
for(i=1,disp[0]=0; i<nnodes; i++) disp[i] = disp[i-1] + np_by_node[i-1];
MPI_Allgatherv(ranks_local,np_local,MPI_INT,ranks,np_by_node,disp,MPI_INT,
SMP_Masters_comm);
free(disp);
}
MPI_Bcast(ranks,np,MPI_INT,0,SMP_World_comm);
for(i=0; i<nnodes; i++) {
cpus = nc_by_node[i];
master = ranks_by_node[i][0];
/* --------------------------------------------------------------- *\
For each node, one data server is chosen from the all the data
servers on that node in a round-robin manner based on the rank
of the process.
\* --------------------------------------------------------------- */
if(nd_by_node[i]) myds = cpus + (me % nd_by_node[i]);
else myds = -1;
/* --------------------------------------------------------------- *\
Using LAPI or MPI-2, we have no data servers, but we still need
to know which compute process to interrupt to get, put, or acc!
\* --------------------------------------------------------------- */
# if defined DDI_LAPI
myds = (me % nc_by_node[i]);
# endif
/* ------------------------------------------------------ *\
Sanity check: myds must correspond to a rank on node i
\* ------------------------------------------------------ */
/* 1st bit of next line was 'i<nd', changed by Ryan to 'nd', May 2010 */
if(nd && (myds < 0 || myds >= np_by_node[i])) {
if(me == 0) {
fprintf(stdout," ERROR: Unable to assign a DS for node %i.\n",i);
fprintf(stdout," Please report this error to:\n");
fprintf(stdout," [email protected] and/or\n");
fprintf(stdout," [email protected]\n");
fprintf(stdout," myds=%i; np_by_node[%i]=%i\n",
myds,i,np_by_node[i]);
fflush(stdout);
# if defined WINDOWS
Sleep(1*1000);
# else
sleep(1);
# endif
}
MPI_Finalize();
}
/* ----------------------------------------------------- *\
For each remote node, assign a data server rank
\* ----------------------------------------------------- */
if(nd) gv(ddinodes)[i].myds = ranks_by_node[i][myds];
else gv(ddinodes)[i].myds = -1;
/* --------------------------------- *\
Save these values in gv(ddinodes)
\* --------------------------------- */
gv(ddinodes)[i].cpus = cpus;
gv(ddinodes)[i].nodemaster = master;
/* ----------------------------------------------------------------- *\
Dig up the hostname of the node and append any network extensions
\* ----------------------------------------------------------------- */
# ifdef DDI_SOC
c = (hostnames + master*HOSTNAME_LEN);
if(ext) strcat(c,argv[ext]);
# endif
/* ------------------------------------------------------------------- *\
All DDI processes on the node share the same node rank and hostname
\* ------------------------------------------------------------------- */
for(j=0; j<np_by_node[i]; j++) {
rbn = ranks_by_node[i][j];
gv(ddiprocs)[rbn].node = i;
# ifdef DDI_SOC
gv(ddiprocs)[rbn].hostname = (char *) strdup(c);
# endif
# if !defined USE_SYSV
gv(ddiprocs)[rbn].node = rbn;
if(rbn >= comm->np) gv(ddiprocs)[rbn].node -= comm->np;
# endif
}
}
/* ------------------------- *\
Free any Malloc'ed Memory
\* ------------------------- */
free(hostnames);
free(world);
free(ranks_local);
/* ---------------------------- *\
Do NOT free global variables
\* ---------------------------- */
/* --- moved to ddi_finalize
free(ranks);
free(np_by_node);
free(nc_by_node);
free(nd_by_node);
free(ranks_by_node);
*/
/* ---------------------------------- *\
Synchronize processes and continue
\* ---------------------------------- */
MPI_Barrier(MPI_COMM_WORLD);
DEBUG_ROOT(LVL3,(stdout," DDI: Init_mpi finished.\n"))
}
int main( int argc, char **argv )
{
int errs=0, toterr;
MPI_Group basegroup;
MPI_Group g1, g2, g3, g4, g5, g6, g7, g8, g9, g10;
MPI_Group g3a, g3b;
MPI_Comm comm, newcomm, splitcomm, dupcomm;
int i, grp_rank, rank, grp_size, size, result;
int nranks, *ranks, *ranks_out;
int range[1][3];
int worldrank;
MPI_Init( &argc, &argv );
MPI_Comm_rank( MPI_COMM_WORLD, &worldrank );
comm = MPI_COMM_WORLD;
MPI_Comm_group( comm, &basegroup );
MPI_Comm_rank( comm, &rank );
MPI_Comm_size( comm, &size );
/* Get the basic information on this group */
MPI_Group_rank( basegroup, &grp_rank );
if (grp_rank != rank) {
errs++;
fprintf( stdout, "group rank %d != comm rank %d\n", grp_rank, rank );
}
MPI_Group_size( basegroup, &grp_size );
if (grp_size != size) {
errs++;
fprintf( stdout, "group size %d != comm size %d\n", grp_size, size );
}
/* Form a new communicator with inverted ranking */
MPI_Comm_split( comm, 0, size - rank, &newcomm );
MPI_Comm_group( newcomm, &g1 );
ranks = (int *)malloc( size * sizeof(int) );
ranks_out = (int *)malloc( size * sizeof(int) );
for (i=0; i<size; i++) ranks[i] = i;
nranks = size;
MPI_Group_translate_ranks( g1, nranks, ranks, basegroup, ranks_out );
for (i=0; i<size; i++) {
if (ranks_out[i] != (size - 1) - i) {
errs++;
fprintf( stdout, "Translate ranks got %d expected %d\n",
ranks_out[i], (size - 1) - i );
}
}
/* Check Compare */
MPI_Group_compare( basegroup, g1, &result );
if (result != MPI_SIMILAR) {
errs++;
fprintf( stdout, "Group compare should have been similar, was %d\n",
result );
}
MPI_Comm_dup( comm, &dupcomm );
MPI_Comm_group( dupcomm, &g2 );
MPI_Group_compare( basegroup, g2, &result );
if (result != MPI_IDENT) {
errs++;
fprintf( stdout, "Group compare should have been ident, was %d\n",
result );
}
MPI_Comm_split( comm, rank < size/2, rank, &splitcomm );
MPI_Comm_group( splitcomm, &g3 );
MPI_Group_compare( basegroup, g3, &result );
if (result != MPI_UNEQUAL) {
errs++;
fprintf( stdout, "Group compare should have been unequal, was %d\n",
result );
}
/* Build two groups that have this process and one other, but do not
have the same processes */
ranks[0] = rank;
ranks[1] = (rank + 1) % size;
MPI_Group_incl( basegroup, 2, ranks, &g3a );
ranks[1] = (rank + size - 1) % size;
MPI_Group_incl( basegroup, 2, ranks, &g3b );
MPI_Group_compare( g3a, g3b, &result );
if (result != MPI_UNEQUAL) {
errs++;
fprintf( stdout, "Group compare of equal sized but different groups should have been unequal, was %d\n", result );
}
/* Build two new groups by excluding members; use Union to put them
together again */
/* Exclude 0 */
for (i=0; i<size; i++) ranks[i] = i;
MPI_Group_excl( basegroup, 1, ranks, &g4 );
/* Exclude 1-(size-1) */
MPI_Group_excl( basegroup, size-1, ranks+1, &g5 );
MPI_Group_union( g5, g4, &g6 );
MPI_Group_compare( basegroup, g6, &result );
if (result != MPI_IDENT) {
int usize;
errs++;
/* See ordering requirements on union */
fprintf( stdout, "Group excl and union did not give ident groups\n" );
fprintf( stdout, "[%d] result of compare was %d\n", rank, result );
MPI_Group_size( g6, &usize );
fprintf( stdout, "Size of union is %d, should be %d\n", usize, size );
}
MPI_Group_union( basegroup, g4, &g7 );
MPI_Group_compare( basegroup, g7, &result );
if (result != MPI_IDENT) {
int usize;
errs++;
fprintf( stdout, "Group union of overlapping groups failed\n" );
fprintf( stdout, "[%d] result of compare was %d\n", rank, result );
MPI_Group_size( g7, &usize );
fprintf( stdout, "Size of union is %d, should be %d\n", usize, size );
}
/* Use range_excl instead of ranks */
/* printf ("range excl\n" ); fflush( stdout ); */
range[0][0] = 1;
range[0][1] = size-1;
range[0][2] = 1;
MPI_Group_range_excl( basegroup, 1, range, &g8 );
/* printf( "out of range excl\n" ); fflush( stdout ); */
MPI_Group_compare( g5, g8, &result );
/* printf( "out of compare\n" ); fflush( stdout ); */
if (result != MPI_IDENT) {
errs++;
fprintf( stdout, "Group range excl did not give ident groups\n" );
}
/* printf( "intersection\n" ); fflush( stdout ); */
MPI_Group_intersection( basegroup, g4, &g9 );
MPI_Group_compare( g9, g4, &result );
if (result != MPI_IDENT) {
errs++;
fprintf( stdout, "Group intersection did not give ident groups\n" );
}
/* Exclude EVERYTHING and check against MPI_GROUP_EMPTY */
/* printf( "range excl all\n" ); fflush( stdout ); */
range[0][0] = 0;
range[0][1] = size-1;
range[0][2] = 1;
MPI_Group_range_excl( basegroup, 1, range, &g10 );
/* printf( "done range excl all\n" ); fflush(stdout); */
MPI_Group_compare( g10, MPI_GROUP_EMPTY, &result );
/* printf( "done compare to MPI_GROUP_EMPTY\n" ); fflush(stdout); */
if (result != MPI_IDENT) {
errs++;
fprintf( stdout,
"MPI_GROUP_EMPTY didn't compare against empty group\n");
}
/* printf( "freeing groups\n" ); fflush( stdout ); */
MPI_Group_free( &basegroup );
MPI_Group_free( &g1 );
MPI_Group_free( &g2 );
MPI_Group_free( &g3 );
MPI_Group_free( &g3a );
MPI_Group_free( &g3b );
MPI_Group_free( &g4 );
MPI_Group_free( &g5 );
MPI_Group_free( &g6 );
MPI_Group_free( &g7 );
MPI_Group_free( &g8 );
MPI_Group_free( &g9 );
MPI_Group_free( &g10 );
MPI_Comm_free( &dupcomm );
MPI_Comm_free( &splitcomm );
MPI_Comm_free( &newcomm );
MPI_Allreduce( &errs, &toterr, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD );
if (worldrank == 0) {
if (toterr == 0)
printf( " No Errors\n" );
else
printf( "Found %d errors in MPI Group routines\n", toterr );
}
MPI_Finalize();
return toterr;
}
FORT_DLL_SPEC void FORT_CALL mpi_group_intersection_ ( MPI_Fint *v1, MPI_Fint *v2, MPI_Fint *v3, MPI_Fint *ierr ){
*ierr = MPI_Group_intersection( *v1, *v2, v3 );
}
int
main (int argc, char **argv)
{
int nprocs = -1;
int rank = -1;
int comm = MPI_COMM_WORLD;
char processor_name[128];
int namelen = 128;
int i;
int ranks[2], ranges[1][3];
MPI_Group newgroup[GROUP_CONSTRUCTOR_COUNT];
MPI_Group newgroup2[GROUP_CONSTRUCTOR_COUNT];
MPI_Comm temp;
MPI_Comm intercomm = MPI_COMM_NULL;
/* init */
MPI_Init (&argc, &argv);
MPI_Comm_size (comm, &nprocs);
MPI_Comm_rank (comm, &rank);
MPI_Get_processor_name (processor_name, &namelen);
printf ("(%d) is alive on %s\n", rank, processor_name);
fflush (stdout);
ranks[0] = 0;
ranks[1] = 1;
ranges[0][0] = 0;
ranges[0][1] = 2;
ranges[0][2] = 2;
MPI_Barrier (comm);
if (nprocs < 3) {
printf ("requires at least 3 tasks\n");
}
else {
/* create the groups */
if (GROUP_CONSTRUCTOR_COUNT > 0)
MPI_Comm_group (MPI_COMM_WORLD, &newgroup[0]);
if (GROUP_CONSTRUCTOR_COUNT > 1)
MPI_Group_incl (newgroup[0], 2, ranks, &newgroup[1]);
if (GROUP_CONSTRUCTOR_COUNT > 2)
MPI_Group_excl (newgroup[0], 2, ranks, &newgroup[2]);
if (GROUP_CONSTRUCTOR_COUNT > 3)
MPI_Group_range_incl (newgroup[0], 1, ranges, &newgroup[3]);
if (GROUP_CONSTRUCTOR_COUNT > 4)
MPI_Group_range_excl (newgroup[0], 1, ranges, &newgroup[4]);
if (GROUP_CONSTRUCTOR_COUNT > 5)
MPI_Group_union (newgroup[1], newgroup[3], &newgroup[5]);
if (GROUP_CONSTRUCTOR_COUNT > 6)
MPI_Group_intersection (newgroup[5], newgroup[2], &newgroup[6]);
if (GROUP_CONSTRUCTOR_COUNT > 7)
MPI_Group_difference (newgroup[5], newgroup[2], &newgroup[7]);
if (GROUP_CONSTRUCTOR_COUNT > 8) {
/* need lots of stuff for this constructor... */
MPI_Comm_split (MPI_COMM_WORLD, rank % 3, nprocs - rank, &temp);
if (rank % 3) {
MPI_Intercomm_create (temp, 0, MPI_COMM_WORLD,
(((nprocs % 3) == 2) && ((rank % 3) == 2)) ?
nprocs - 1 : nprocs - (rank % 3) - (nprocs % 3),
INTERCOMM_CREATE_TAG, &intercomm);
MPI_Comm_remote_group (intercomm, &newgroup[8]);
MPI_Comm_free (&intercomm);
}
else {
MPI_Comm_group (temp, &newgroup[8]);
}
MPI_Comm_free (&temp);
}
}
MPI_Barrier (comm);
printf ("(%d) Finished normally\n", rank);
MPI_Finalize ();
}
void declareBindings (void)
{
/* === Point-to-point === */
void* buf;
int count;
MPI_Datatype datatype;
int dest;
int tag;
MPI_Comm comm;
MPI_Send (buf, count, datatype, dest, tag, comm); // L12
int source;
MPI_Status status;
MPI_Recv (buf, count, datatype, source, tag, comm, &status); // L15
MPI_Get_count (&status, datatype, &count);
MPI_Bsend (buf, count, datatype, dest, tag, comm);
MPI_Ssend (buf, count, datatype, dest, tag, comm);
MPI_Rsend (buf, count, datatype, dest, tag, comm);
void* buffer;
int size;
MPI_Buffer_attach (buffer, size); // L22
MPI_Buffer_detach (buffer, &size);
MPI_Request request;
MPI_Isend (buf, count, datatype, dest, tag, comm, &request); // L25
MPI_Ibsend (buf, count, datatype, dest, tag, comm, &request);
MPI_Issend (buf, count, datatype, dest, tag, comm, &request);
MPI_Irsend (buf, count, datatype, dest, tag, comm, &request);
MPI_Irecv (buf, count, datatype, source, tag, comm, &request);
MPI_Wait (&request, &status);
int flag;
MPI_Test (&request, &flag, &status); // L32
MPI_Request_free (&request);
MPI_Request* array_of_requests;
int index;
MPI_Waitany (count, array_of_requests, &index, &status); // L36
MPI_Testany (count, array_of_requests, &index, &flag, &status);
MPI_Status* array_of_statuses;
MPI_Waitall (count, array_of_requests, array_of_statuses); // L39
MPI_Testall (count, array_of_requests, &flag, array_of_statuses);
int incount;
int outcount;
int* array_of_indices;
MPI_Waitsome (incount, array_of_requests, &outcount, array_of_indices,
array_of_statuses); // L44--45
MPI_Testsome (incount, array_of_requests, &outcount, array_of_indices,
array_of_statuses); // L46--47
MPI_Iprobe (source, tag, comm, &flag, &status); // L48
MPI_Probe (source, tag, comm, &status);
MPI_Cancel (&request);
MPI_Test_cancelled (&status, &flag);
MPI_Send_init (buf, count, datatype, dest, tag, comm, &request);
MPI_Bsend_init (buf, count, datatype, dest, tag, comm, &request);
MPI_Ssend_init (buf, count, datatype, dest, tag, comm, &request);
MPI_Rsend_init (buf, count, datatype, dest, tag, comm, &request);
MPI_Recv_init (buf, count, datatype, source, tag, comm, &request);
MPI_Start (&request);
MPI_Startall (count, array_of_requests);
void* sendbuf;
int sendcount;
MPI_Datatype sendtype;
int sendtag;
void* recvbuf;
int recvcount;
MPI_Datatype recvtype;
MPI_Datatype recvtag;
MPI_Sendrecv (sendbuf, sendcount, sendtype, dest, sendtag,
recvbuf, recvcount, recvtype, source, recvtag,
comm, &status); // L67--69
MPI_Sendrecv_replace (buf, count, datatype, dest, sendtag, source, recvtag,
comm, &status); // L70--71
MPI_Datatype oldtype;
MPI_Datatype newtype;
MPI_Type_contiguous (count, oldtype, &newtype); // L74
int blocklength;
{
int stride;
MPI_Type_vector (count, blocklength, stride, oldtype, &newtype); // L78
}
{
MPI_Aint stride;
MPI_Type_hvector (count, blocklength, stride, oldtype, &newtype); // L82
}
int* array_of_blocklengths;
{
int* array_of_displacements;
MPI_Type_indexed (count, array_of_blocklengths, array_of_displacements,
oldtype, &newtype); // L87--88
}
{
MPI_Aint* array_of_displacements;
MPI_Type_hindexed (count, array_of_blocklengths, array_of_displacements,
oldtype, &newtype); // L92--93
MPI_Datatype* array_of_types;
MPI_Type_struct (count, array_of_blocklengths, array_of_displacements,
array_of_types, &newtype); // L95--96
}
void* location;
MPI_Aint address;
MPI_Address (location, &address); // L100
MPI_Aint extent;
MPI_Type_extent (datatype, &extent); // L102
MPI_Type_size (datatype, &size);
MPI_Aint displacement;
MPI_Type_lb (datatype, &displacement); // L105
MPI_Type_ub (datatype, &displacement);
MPI_Type_commit (&datatype);
MPI_Type_free (&datatype);
MPI_Get_elements (&status, datatype, &count);
void* inbuf;
void* outbuf;
int outsize;
int position;
MPI_Pack (inbuf, incount, datatype, outbuf, outsize, &position, comm); // L114
int insize;
MPI_Unpack (inbuf, insize, &position, outbuf, outcount, datatype,
comm); // L116--117
MPI_Pack_size (incount, datatype, comm, &size);
/* === Collectives === */
MPI_Barrier (comm); // L121
int root;
MPI_Bcast (buffer, count, datatype, root, comm); // L123
MPI_Gather (sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype,
root, comm); // L124--125
int* recvcounts;
int* displs;
MPI_Gatherv (sendbuf, sendcount, sendtype,
recvbuf, recvcounts, displs, recvtype,
root, comm); // L128--130
MPI_Scatter (sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype,
root, comm); // L131--132
int* sendcounts;
MPI_Scatterv (sendbuf, sendcounts, displs, sendtype,
recvbuf, recvcount, recvtype, root, comm); // L134--135
MPI_Allgather (sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype,
comm); // L136--137
MPI_Allgatherv (sendbuf, sendcount, sendtype,
recvbuf, recvcounts, displs, recvtype,
comm); // L138--140
MPI_Alltoall (sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype,
comm); // L141--142
int* sdispls;
int* rdispls;
MPI_Alltoallv (sendbuf, sendcounts, sdispls, sendtype,
recvbuf, recvcounts, rdispls, recvtype,
comm); // L145--147
MPI_Op op;
MPI_Reduce (sendbuf, recvbuf, count, datatype, op, root, comm); // L149
#if 0
MPI_User_function function;
int commute;
MPI_Op_create (function, commute, &op); // L153
#endif
MPI_Op_free (&op); // L155
MPI_Allreduce (sendbuf, recvbuf, count, datatype, op, comm);
MPI_Reduce_scatter (sendbuf, recvbuf, recvcounts, datatype, op, comm);
MPI_Scan (sendbuf, recvbuf, count, datatype, op, comm);
/* === Groups, contexts, and communicators === */
MPI_Group group;
MPI_Group_size (group, &size); // L162
int rank;
MPI_Group_rank (group, &rank); // L164
MPI_Group group1;
int n;
int* ranks1;
MPI_Group group2;
int* ranks2;
MPI_Group_translate_ranks (group1, n, ranks1, group2, ranks2); // L170
int result;
MPI_Group_compare (group1, group2, &result); // L172
MPI_Group newgroup;
MPI_Group_union (group1, group2, &newgroup); // L174
MPI_Group_intersection (group1, group2, &newgroup);
MPI_Group_difference (group1, group2, &newgroup);
int* ranks;
MPI_Group_incl (group, n, ranks, &newgroup); // L178
MPI_Group_excl (group, n, ranks, &newgroup);
extern int ranges[][3];
MPI_Group_range_incl (group, n, ranges, &newgroup); // L181
MPI_Group_range_excl (group, n, ranges, &newgroup);
MPI_Group_free (&group);
MPI_Comm_size (comm, &size);
MPI_Comm_rank (comm, &rank);
MPI_Comm comm1;
MPI_Comm comm2;
MPI_Comm_compare (comm1, comm2, &result);
MPI_Comm newcomm;
MPI_Comm_dup (comm, &newcomm);
MPI_Comm_create (comm, group, &newcomm);
int color;
int key;
MPI_Comm_split (comm, color, key, &newcomm); // L194
MPI_Comm_free (&comm);
MPI_Comm_test_inter (comm, &flag);
MPI_Comm_remote_size (comm, &size);
MPI_Comm_remote_group (comm, &group);
MPI_Comm local_comm;
int local_leader;
MPI_Comm peer_comm;
int remote_leader;
MPI_Comm newintercomm;
MPI_Intercomm_create (local_comm, local_leader, peer_comm, remote_leader, tag,
&newintercomm); // L204--205
MPI_Comm intercomm;
MPI_Comm newintracomm;
int high;
MPI_Intercomm_merge (intercomm, high, &newintracomm); // L209
int keyval;
#if 0
MPI_Copy_function copy_fn;
MPI_Delete_function delete_fn;
void* extra_state;
MPI_Keyval_create (copy_fn, delete_fn, &keyval, extra_state); // L215
#endif
MPI_Keyval_free (&keyval); // L217
void* attribute_val;
MPI_Attr_put (comm, keyval, attribute_val); // L219
MPI_Attr_get (comm, keyval, attribute_val, &flag);
MPI_Attr_delete (comm, keyval);
/* === Environmental inquiry === */
char* name;
int resultlen;
MPI_Get_processor_name (name, &resultlen); // L226
MPI_Errhandler errhandler;
#if 0
MPI_Handler_function function;
MPI_Errhandler_create (function, &errhandler); // L230
#endif
MPI_Errhandler_set (comm, errhandler); // L232
MPI_Errhandler_get (comm, &errhandler);
MPI_Errhandler_free (&errhandler);
int errorcode;
char* string;
MPI_Error_string (errorcode, string, &resultlen); // L237
int errorclass;
MPI_Error_class (errorcode, &errorclass); // L239
MPI_Wtime ();
MPI_Wtick ();
int argc;
char** argv;
MPI_Init (&argc, &argv); // L244
MPI_Finalize ();
MPI_Initialized (&flag);
MPI_Abort (comm, errorcode);
}
FC_FUNC( mpi_group_intersection, MPI_GROUP_INTERSECTION )
(int *group1, int *group2, int *newgroup, int *ierror)
{
*ierror= MPI_Group_intersection(*group1,*group2,newgroup);
}
