void H5input::LoadParticles(int ndim, int rank, int nproc, const int *dimns, double *L, MPI_Comm CART_COMM){
int h5nspec;
int ranks_rdr[1] = {0};
int *ranks_rst;
long long offset;
long long nop;
h5_int64_t *h5npart;
double *q;
double *x;
double *y;
double *z;
double *u;
double *v;
double *w;
std::stringstream sstm;
MPI_Comm READER_COMM;
MPI_Group org_grp;
MPI_Group reader_grp;
part = new H5hutpart[nspec];
/* -------------------------------------------------- */
/* Create a new communicator for the reader processor */
/* This way only processor 0 reads the whole file. */
/* It would be better if each processor read one part */
/* of the file...currently not possible with H5hut. */
/* -------------------------------------------------- */
MPI_Comm_group (CART_COMM, &org_grp);
ranks_rst = new int[nproc-1];
for (int i=0; i<nproc-1; i++) ranks_rst[i] = i;
if (rank==0) MPI_Group_incl (org_grp, 1, ranks_rdr, &reader_grp);
else MPI_Group_incl (org_grp, nproc-1, ranks_rst, &reader_grp);
delete [] ranks_rst;
MPI_Comm_create(CART_COMM, reader_grp, &READER_COMM);
if (rank==0) {
/* -------------- */
/* Open HDF5 file */
/* -------------- */
std::stringstream filenmbr;
std::string filename;
filenmbr << std::setfill('0') << std::setw(6) << recycle;
filename = basename + "-Partcl" + "_" + filenmbr.str() + ".h5";
partfile = H5OpenFile(filename.c_str(), H5_O_RDONLY, READER_COMM);
H5SetStep(partfile, 0);
H5ReadStepAttribInt32(partfile, "nspec", &h5nspec);
if (nspec!=h5nspec) {
std::cout << "[H5hut-io]" << "ERROR in ReadParallelParticles: the number of species in the initial file" << std::endl;
std::cout << "[H5hut-io]" << " does not match the number of species requested." << std::endl;
abort();
}
h5npart = new h5_int64_t[nspec];
nop = 0;
for (int i=0; i<nspec; i++) {
sstm << "npart_" << i;
std::string nparti = sstm.str();
H5ReadStepAttribInt64(partfile, nparti.c_str(), &h5npart[i]);
sstm.str("");
nop += h5npart[i];
}
q = new double[nop];
x = new double[nop];
y = new double[nop];
z = new double[nop];
u = new double[nop];
v = new double[nop];
w = new double[nop];
offset = 0;
for (int i=0; i<nspec; i++) {
std::cout << "[H5hut-io]" << " Reading a total of " << h5npart[i] << " particles of species " << i << std::endl;
sstm << "q_" << i;
std::string dtset = sstm.str();
H5PartReadDataFloat64(partfile,dtset.c_str(),q+offset);
sstm.str("");
sstm << "x_" << i;
dtset = sstm.str();
H5PartReadDataFloat64(partfile,dtset.c_str(),x+offset);
sstm.str("");
sstm << "y_" << i;
dtset = sstm.str();
H5PartReadDataFloat64(partfile,dtset.c_str(),y+offset);
sstm.str("");
sstm << "z_" << i;
dtset = sstm.str();
H5PartReadDataFloat64(partfile,dtset.c_str(),z+offset);
sstm.str("");
sstm << "u_" << i;
dtset = sstm.str();
H5PartReadDataFloat64(partfile,dtset.c_str(),u+offset);
sstm.str("");
sstm << "v_" << i;
dtset = sstm.str();
H5PartReadDataFloat64(partfile,dtset.c_str(),v+offset);
sstm.str("");
sstm << "w_" << i;
dtset = sstm.str();
H5PartReadDataFloat64(partfile,dtset.c_str(),w+offset);
sstm.str("");
offset += h5npart[i];
}
H5CloseFile(partfile);
FindLocalParticles(nproc, ndim, h5npart, nop, dimns, L, CART_COMM, q, x, y, z, u, v, w);
delete [] q;
delete [] x;
delete [] y;
delete [] z;
delete [] u;
delete [] v;
delete [] w;
delete [] h5npart;
}
}
HYPRE_Int hypre_seqAMGSetup( hypre_ParAMGData *amg_data,
HYPRE_Int p_level,
HYPRE_Int coarse_threshold)
{
/* Par Data Structure variables */
hypre_ParCSRMatrix **Par_A_array = hypre_ParAMGDataAArray(amg_data);
MPI_Comm comm = hypre_ParCSRMatrixComm(Par_A_array[0]);
MPI_Comm new_comm, seq_comm;
hypre_ParCSRMatrix *A_seq = NULL;
hypre_CSRMatrix *A_seq_diag;
hypre_CSRMatrix *A_seq_offd;
hypre_ParVector *F_seq = NULL;
hypre_ParVector *U_seq = NULL;
hypre_ParCSRMatrix *A;
HYPRE_Int **dof_func_array;
HYPRE_Int num_procs, my_id;
HYPRE_Int not_finished_coarsening;
HYPRE_Int level;
HYPRE_Solver coarse_solver;
/* misc */
dof_func_array = hypre_ParAMGDataDofFuncArray(amg_data);
/*MPI Stuff */
hypre_MPI_Comm_size(comm, &num_procs);
hypre_MPI_Comm_rank(comm,&my_id);
/*initial */
level = p_level;
not_finished_coarsening = 1;
/* convert A at this level to sequential */
A = Par_A_array[level];
{
double *A_seq_data = NULL;
HYPRE_Int *A_seq_i = NULL;
HYPRE_Int *A_seq_offd_i = NULL;
HYPRE_Int *A_seq_j = NULL;
double *A_tmp_data = NULL;
HYPRE_Int *A_tmp_i = NULL;
HYPRE_Int *A_tmp_j = NULL;
HYPRE_Int *info, *displs, *displs2;
HYPRE_Int i, j, size, num_nonzeros, total_nnz, cnt;
hypre_CSRMatrix *A_diag = hypre_ParCSRMatrixDiag(A);
hypre_CSRMatrix *A_offd = hypre_ParCSRMatrixOffd(A);
HYPRE_Int *col_map_offd = hypre_ParCSRMatrixColMapOffd(A);
HYPRE_Int *A_diag_i = hypre_CSRMatrixI(A_diag);
HYPRE_Int *A_offd_i = hypre_CSRMatrixI(A_offd);
HYPRE_Int *A_diag_j = hypre_CSRMatrixJ(A_diag);
HYPRE_Int *A_offd_j = hypre_CSRMatrixJ(A_offd);
double *A_diag_data = hypre_CSRMatrixData(A_diag);
double *A_offd_data = hypre_CSRMatrixData(A_offd);
HYPRE_Int num_rows = hypre_CSRMatrixNumRows(A_diag);
HYPRE_Int first_row_index = hypre_ParCSRMatrixFirstRowIndex(A);
hypre_MPI_Group orig_group, new_group;
HYPRE_Int *ranks, new_num_procs, *row_starts;
info = hypre_CTAlloc(HYPRE_Int, num_procs);
hypre_MPI_Allgather(&num_rows, 1, HYPRE_MPI_INT, info, 1, HYPRE_MPI_INT, comm);
ranks = hypre_CTAlloc(HYPRE_Int, num_procs);
new_num_procs = 0;
for (i=0; i < num_procs; i++)
if (info[i])
{
ranks[new_num_procs] = i;
info[new_num_procs++] = info[i];
}
MPI_Comm_group(comm, &orig_group);
hypre_MPI_Group_incl(orig_group, new_num_procs, ranks, &new_group);
MPI_Comm_create(comm, new_group, &new_comm);
hypre_MPI_Group_free(&new_group);
hypre_MPI_Group_free(&orig_group);
if (num_rows)
{
/* alloc space in seq data structure only for participating procs*/
HYPRE_BoomerAMGCreate(&coarse_solver);
HYPRE_BoomerAMGSetMaxRowSum(coarse_solver,
hypre_ParAMGDataMaxRowSum(amg_data));
HYPRE_BoomerAMGSetStrongThreshold(coarse_solver,
hypre_ParAMGDataStrongThreshold(amg_data));
HYPRE_BoomerAMGSetCoarsenType(coarse_solver,
hypre_ParAMGDataCoarsenType(amg_data));
HYPRE_BoomerAMGSetInterpType(coarse_solver,
hypre_ParAMGDataInterpType(amg_data));
HYPRE_BoomerAMGSetTruncFactor(coarse_solver,
hypre_ParAMGDataTruncFactor(amg_data));
HYPRE_BoomerAMGSetPMaxElmts(coarse_solver,
hypre_ParAMGDataPMaxElmts(amg_data));
if (hypre_ParAMGDataUserRelaxType(amg_data) > -1)
HYPRE_BoomerAMGSetRelaxType(coarse_solver,
hypre_ParAMGDataUserRelaxType(amg_data));
HYPRE_BoomerAMGSetRelaxOrder(coarse_solver,
hypre_ParAMGDataRelaxOrder(amg_data));
HYPRE_BoomerAMGSetRelaxWt(coarse_solver,
hypre_ParAMGDataUserRelaxWeight(amg_data));
if (hypre_ParAMGDataUserNumSweeps(amg_data) > -1)
HYPRE_BoomerAMGSetNumSweeps(coarse_solver,
hypre_ParAMGDataUserNumSweeps(amg_data));
HYPRE_BoomerAMGSetNumFunctions(coarse_solver,
hypre_ParAMGDataNumFunctions(amg_data));
HYPRE_BoomerAMGSetMaxIter(coarse_solver, 1);
HYPRE_BoomerAMGSetTol(coarse_solver, 0);
/* Create CSR Matrix, will be Diag part of new matrix */
A_tmp_i = hypre_CTAlloc(HYPRE_Int, num_rows+1);
A_tmp_i[0] = 0;
for (i=1; i < num_rows+1; i++)
A_tmp_i[i] = A_diag_i[i]-A_diag_i[i-1]+A_offd_i[i]-A_offd_i[i-1];
num_nonzeros = A_offd_i[num_rows]+A_diag_i[num_rows];
A_tmp_j = hypre_CTAlloc(HYPRE_Int, num_nonzeros);
A_tmp_data = hypre_CTAlloc(double, num_nonzeros);
cnt = 0;
for (i=0; i < num_rows; i++)
{
for (j=A_diag_i[i]; j < A_diag_i[i+1]; j++)
{
A_tmp_j[cnt] = A_diag_j[j]+first_row_index;
A_tmp_data[cnt++] = A_diag_data[j];
}
for (j=A_offd_i[i]; j < A_offd_i[i+1]; j++)
{
A_tmp_j[cnt] = col_map_offd[A_offd_j[j]];
A_tmp_data[cnt++] = A_offd_data[j];
}
}
displs = hypre_CTAlloc(HYPRE_Int, new_num_procs+1);
displs[0] = 0;
for (i=1; i < new_num_procs+1; i++)
displs[i] = displs[i-1]+info[i-1];
size = displs[new_num_procs];
A_seq_i = hypre_CTAlloc(HYPRE_Int, size+1);
A_seq_offd_i = hypre_CTAlloc(HYPRE_Int, size+1);
hypre_MPI_Allgatherv ( &A_tmp_i[1], num_rows, HYPRE_MPI_INT, &A_seq_i[1], info,
displs, HYPRE_MPI_INT, new_comm );
displs2 = hypre_CTAlloc(HYPRE_Int, new_num_procs+1);
A_seq_i[0] = 0;
displs2[0] = 0;
for (j=1; j < displs[1]; j++)
A_seq_i[j] = A_seq_i[j]+A_seq_i[j-1];
for (i=1; i < new_num_procs; i++)
{
for (j=displs[i]; j < displs[i+1]; j++)
{
A_seq_i[j] = A_seq_i[j]+A_seq_i[j-1];
}
}
A_seq_i[size] = A_seq_i[size]+A_seq_i[size-1];
displs2[new_num_procs] = A_seq_i[size];
for (i=1; i < new_num_procs+1; i++)
{
displs2[i] = A_seq_i[displs[i]];
info[i-1] = displs2[i] - displs2[i-1];
}
total_nnz = displs2[new_num_procs];
A_seq_j = hypre_CTAlloc(HYPRE_Int, total_nnz);
A_seq_data = hypre_CTAlloc(double, total_nnz);
hypre_MPI_Allgatherv ( A_tmp_j, num_nonzeros, HYPRE_MPI_INT,
A_seq_j, info, displs2,
HYPRE_MPI_INT, new_comm );
hypre_MPI_Allgatherv ( A_tmp_data, num_nonzeros, hypre_MPI_DOUBLE,
A_seq_data, info, displs2,
hypre_MPI_DOUBLE, new_comm );
hypre_TFree(displs);
hypre_TFree(displs2);
hypre_TFree(A_tmp_i);
hypre_TFree(A_tmp_j);
hypre_TFree(A_tmp_data);
row_starts = hypre_CTAlloc(HYPRE_Int,2);
row_starts[0] = 0;
row_starts[1] = size;
/* Create 1 proc communicator */
seq_comm = hypre_MPI_COMM_SELF;
A_seq = hypre_ParCSRMatrixCreate(seq_comm,size,size,
row_starts, row_starts,
0,total_nnz,0);
A_seq_diag = hypre_ParCSRMatrixDiag(A_seq);
A_seq_offd = hypre_ParCSRMatrixOffd(A_seq);
hypre_CSRMatrixData(A_seq_diag) = A_seq_data;
hypre_CSRMatrixI(A_seq_diag) = A_seq_i;
hypre_CSRMatrixJ(A_seq_diag) = A_seq_j;
hypre_CSRMatrixI(A_seq_offd) = A_seq_offd_i;
F_seq = hypre_ParVectorCreate(seq_comm, size, row_starts);
U_seq = hypre_ParVectorCreate(seq_comm, size, row_starts);
hypre_ParVectorOwnsPartitioning(F_seq) = 0;
hypre_ParVectorOwnsPartitioning(U_seq) = 0;
hypre_ParVectorInitialize(F_seq);
hypre_ParVectorInitialize(U_seq);
hypre_BoomerAMGSetup(coarse_solver,A_seq,F_seq,U_seq);
hypre_ParAMGDataCoarseSolver(amg_data) = coarse_solver;
hypre_ParAMGDataACoarse(amg_data) = A_seq;
hypre_ParAMGDataFCoarse(amg_data) = F_seq;
hypre_ParAMGDataUCoarse(amg_data) = U_seq;
hypre_ParAMGDataNewComm(amg_data) = new_comm;
}
hypre_TFree(info);
hypre_TFree(ranks);
}
return 0;
}
void init_multisystem(t_commrec *cr,int nsim,
int nfile,t_filenm fnm[],bool bParFn)
{
gmx_multisim_t *ms;
int nnodes,nnodpersim,sim,i,ftp;
char buf[256];
#ifdef GMX_MPI
MPI_Group mpi_group_world;
#endif
int *rank;
#ifndef GMX_MPI
if (nsim > 1) {
gmx_fatal(FARGS,"This binary is compiled without MPI support, can not do multiple simulations.");
}
#endif
nnodes = cr->nnodes;
if (nnodes % nsim != 0)
gmx_fatal(FARGS,"The number of nodes (%d) is not a multiple of the number of simulations (%d)",nnodes,nsim);
nnodpersim = nnodes/nsim;
sim = cr->nodeid/nnodpersim;
if (debug)
fprintf(debug,"We have %d simulations, %d nodes per simulation, local simulation is %d\n",nsim,nnodpersim,sim);
snew(ms,1);
cr->ms = ms;
ms->nsim = nsim;
ms->sim = sim;
#ifdef GMX_MPI
/* Create a communicator for the master nodes */
snew(rank,ms->nsim);
for(i=0; i<ms->nsim; i++)
rank[i] = i*nnodpersim;
MPI_Comm_group(MPI_COMM_WORLD,&mpi_group_world);
MPI_Group_incl(mpi_group_world,nsim,rank,&ms->mpi_group_masters);
sfree(rank);
MPI_Comm_create(MPI_COMM_WORLD,ms->mpi_group_masters,
&ms->mpi_comm_masters);
#endif
/* Reduce the intra-simulation communication */
cr->sim_nodeid = cr->nodeid % nnodpersim;
cr->nnodes = nnodpersim;
#ifdef GMX_MPI
MPI_Comm_split(MPI_COMM_WORLD,sim,cr->sim_nodeid,&cr->mpi_comm_mysim);
cr->mpi_comm_mygroup = cr->mpi_comm_mysim;
cr->nodeid = cr->sim_nodeid;
#endif
if (debug) {
fprintf(debug,"This is simulation %d",cr->ms->sim);
if (PAR(cr))
fprintf(debug,", local number of nodes %d, local nodeid %d",
cr->nnodes,cr->sim_nodeid);
fprintf(debug,"\n\n");
}
if (bParFn) {
/* Patch output and tpx file names (except log which has been done already)
*/
for(i=0; (i<nfile); i++) {
/* Because of possible multiple extensions per type we must look
* at the actual file name
*/
if (is_output(&fnm[i]) ||
fnm[i].ftp == efTPX || fnm[i].ftp == efCPT ||
strcmp(fnm[i].opt,"-rerun") == 0) {
ftp = fn2ftp(fnm[i].fns[0]);
par_fn(fnm[i].fns[0],ftp,cr,FALSE,buf,255);
sfree(fnm[i].fns[0]);
fnm[i].fns[0] = strdup(buf);
}
}
}
}
int run_main(int argc, char *argv[], int numprocs0, int myid0)
{
int MD_iter,i,j,po,ip;
char fileE[YOUSO10] = ".ene";
char fileDRC[YOUSO10] = ".md";
char fileMemory[YOUSO10];
char fileRestart[YOUSO10];
char operate[200];
double TStime,TEtime;
/* for idle CPUs */
int tag;
int complete;
MPI_Request request;
MPI_Status status;
/* for measuring elapsed time */
dtime(&TStime);
/* allocation of CompTime */
CompTime = (double**)malloc(sizeof(double*)*numprocs0);
for (i=0; i<numprocs0; i++){
CompTime[i] = (double*)malloc(sizeof(double)*30);
for (j=0; j<30; j++) CompTime[i][j] = 0.0;
}
if (myid0==Host_ID){
printf("\n*******************************************************\n");
printf("*******************************************************\n");
printf(" Welcome to OpenMX Ver. %s \n",Version_OpenMX);
printf(" Copyright (C), 2002-2009, T.Ozaki \n");
printf(" OpenMX comes with ABSOLUTELY NO WARRANTY. \n");
printf(" This is free software, and you are welcome to \n");
printf(" redistribute it under the constitution of the GNU-GPL.\n");
printf("*******************************************************\n");
printf("*******************************************************\n\n");
}
Init_List_YOUSO();
remake_headfile = 0;
ScaleSize = 1.2;
/****************************************************
Read the input file
****************************************************/
init_alloc_first();
CompTime[myid0][1] = readfile(argv);
MPI_Barrier(MPI_COMM_WORLD1);
/* initialize PrintMemory routine */
sprintf(fileMemory,"%s%s.memory%i",filepath,filename,myid0);
PrintMemory(fileMemory,0,"init");
PrintMemory_Fix();
/* initialize */
init();
fnjoint(filepath,filename,fileE);
fnjoint(filepath,filename,fileDRC);
/****************************************************
SCF-DFT calculations and MD and geometrical
optimization.
****************************************************/
MD_iter = 1;
do {
CompTime[myid0][2] += truncation(MD_iter,1);
if (ML_flag==1 && myid0==Host_ID) Get_VSZ(MD_iter);
if (Solver==4) {
TRAN_Calc_GridBound( mpi_comm_level1, atomnum, WhatSpecies, Spe_Atom_Cut1,
Ngrid1, Grid_Origin, Gxyz, tv, gtv, rgtv, Left_tv, Right_tv );
/* output: TRAN_region[], TRAN_grid_bound */
}
CompTime[myid0][3] += DFT(MD_iter,(MD_iter-1)%orbitalOpt_per_MDIter+1);
if (myid0==Host_ID) iterout(MD_iter,MD_TimeStep*MD_iter,fileE,fileDRC);
if (ML_flag==0) CompTime[myid0][4] += MD_pac(MD_iter,argv[1]);
MD_iter++;
} while(MD_Opt_OK==0 && MD_iter<=MD_IterNumber);
if ( TRAN_output_hks ) {
/* left is dummy */
TRAN_RestartFile(mpi_comm_level1, "write","left",filepath,TRAN_hksoutfilename);
}
/****************************************************
calculate Voronoi charge
****************************************************/
if (Voronoi_Charge_flag==1) Voronoi_Charge();
/****************************************************
making of a file *.frac for the fractional coordinates
****************************************************/
Make_FracCoord(argv[1]);
/****************************************************
generate Wannier functions added by Hongming Weng
****************************************************/
/* hmweng */
if(Wannier_Func_Calc){
if (myid0==Host_ID) printf("Calling Generate_Wannier...\n");fflush(0);
Generate_Wannier(argv[1]);
}
/****************************************************
Making of output files
****************************************************/
CompTime[myid0][20] = OutData(argv[1]);
/****************************************************
write connectivity, Hamiltonian, overlap, density
matrices, and etc. to a file, filename.scfout
****************************************************/
if (HS_fileout==1) SCF2File("write",argv[1]);
/* elapsed time */
dtime(&TEtime);
CompTime[myid0][0] = TEtime - TStime;
Output_CompTime();
for (i=0; i<numprocs0; i++){
free(CompTime[i]);
}
free(CompTime);
/* merge log files */
Merge_LogFile(argv[1]);
/* free arrays */
Free_Arrays(0);
/* print memory */
PrintMemory("total",0,"sum");
/****************************************************
reconstruct the original MPI group
****************************************************/
{
int *new_ranks;
MPI_Group new_group,old_group;
new_ranks = (int*)malloc(sizeof(int)*numprocs0);
for (i=0; i<numprocs0; i++) {
new_ranks[i]=i; /* a new group is made of original rank=0:Pnum[k]-1 */
}
MPI_Comm_group(MPI_COMM_WORLD1, &old_group);
/* define a new group */
MPI_Group_incl(old_group,numprocs0,new_ranks,&new_group);
MPI_Comm_create(MPI_COMM_WORLD1,new_group,&mpi_comm_level1);
MPI_Group_free(&new_group);
free(new_ranks); /* never forget cleaning! */
}
MPI_Barrier(MPI_COMM_WORLD1);
if (myid0==Host_ID){
printf("\nThe calculation was normally finished.\n");
}
return 0;
}
void init(int NGang=1)
{
# ifndef USE_MPI
std::cout << __FILE__ << ":" << __LINE__ << " MPI_Gang assumes -DUSE_MPI" << std::endl;
return;
# else
owner = true;
ngang = NGang;
//if(pool.comm==MPI_COMM_NULL) this->set_pool(MPI_Struct::world());
if(verbose_debug) std::cout << __FILE__ << ":" << __LINE__ << " NGang=" << ngang << std::endl;
// Get information about the pool of processes
if( !pool.in() ) return;
MPI_Comm_rank(pool.comm, &pool.iproc);
MPI_Comm_size(pool.comm, &pool.nproc);
MPI_Comm_group(pool.comm,&pool.group);
// Create a communicator for each Gang of workers
int NPerGang = pool.nproc/ngang;
if( NPerGang<1 )
{
NPerGang = 1;
ngang = pool.nproc;
}
if( (pool.nproc % NPerGang) != 0 )
{
if( pool.iproc==0 )
std::cout << __FILE__ << ":" << __LINE__ << "Can't evenly divide processes into gangs" << std::endl
<< "ngang=" << ngang << " npool=" << pool.nproc << std::endl;
}
igang = pool.iproc/NPerGang;
int gang_range[ngang][3];
for(int ig=0; ig<ngang; ig++)
{
gang_range[ig][0] = ig*NPerGang; // First process in gang
gang_range[ig][1] = (ig+1)*NPerGang-1; // Last process in gang
gang_range[ig][2] = 1; // Stride through original group
if(gang_range[ig][1]>=pool.nproc)
gang_range[ig][1] = pool.nproc-1;
}
if(verbose_debug && pool.iproc==0)
{
std::cout << "range =";
for(int i=0; i<(ngang*3); i++) std::cout << " " << gang_range[igang][i];
std::cout << std::endl;
}
if(pool.in())
{
MPI_Group_range_incl(pool.group,1,&(gang_range[igang]),&gang.group);
MPI_Comm_create(pool.comm,gang.group,&gang.comm);
if( gang.in() )
{
MPI_Comm_rank(gang.comm,&gang.iproc);
MPI_Comm_size(gang.comm,&gang.nproc);
}
}
else
{
std::cout << "iproc=" << pool.iproc << " not assigned to a gang" << std::endl;
return;
}
if(verbose_debug) std::cout << __FILE__ << ":" << __LINE__ << " iproc=" << pool.iproc << " igang=" << igang << "/" << ngang
<< " iproc_gang=" << gang.iproc << "/" << gang.nproc << std::endl;
// Create a communicator for lead-processes
std::vector<int> lead_rank(ngang);
for(int i=0; i<ngang; i++)
lead_rank[i] = i*NPerGang;
if( pool.in() )
{
MPI_Group_incl(pool.group,ngang,&(lead_rank[0]),&lead.group);
MPI_Comm_create(pool.comm,lead.group,&lead.comm);
if( lead.in() )
{
MPI_Comm_rank(lead.comm,&lead.iproc);
MPI_Comm_size(lead.comm,&lead.nproc);
}
}
if( gang.in() && gang.iproc==0 && !lead.in() ) // This is a paranoid check
std::cout << __FILE__ << ":" << __LINE__ << "(" << pool.iproc << ") gang.iproc=" << gang.iproc << std::endl;
if( lead.in() )
{
int ilead = -1;
MPI_Comm_rank(lead.comm,&ilead);
if( ilead!=igang )
{
std::cout << "ilead!=igang for iproc=" << pool.iproc << " ilead=" << ilead << " igang=" << igang << " iproc_gang=" << gang.iproc << std::endl;
}
}
# endif
}
int main( int argc, char *argv[] )
{
int numprocs, myid, server, workerid, ranks[1],
request, i, iter, done;
long rands[CHUNKSIZE], max, in, out, totalin, totalout;
double x, y, Pi, error, epsilon;
MPI_Comm world, workers;
MPI_Group world_group, worker_group;
MPI_Status status;
MPI_Init( &argc, &argv );
world = MPI_COMM_WORLD;
MPI_Comm_size( world, &numprocs );
MPI_Comm_rank( world, &myid );
server = numprocs-1; // Last process is a random server
/***
* Now Master should read epsilon from command line
* and distribute it to all processes.
*/
if (myid == 0) // Read epsilon from command line
{
sscanf( argv[1], "%lf", &epsilon );
};
// MPE_Start_log();
// MPE_Log_event(START_BCAST,0,"bcast epsilon");
MPI_Bcast( &epsilon, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD );
// MPE_Log_event(END_BCAST,0,"bcast epsilon");
/***
* Create new process group called world_group containing all
* processes and its communicator called world
* and a group called worker_group containing all processes
* except the last one (called here server)
* and its communicator called workers.
*/
MPI_Comm_group( world, &world_group );
ranks[0] = server;
MPI_Group_excl( world_group, 1, ranks, &worker_group );
MPI_Comm_create( world, worker_group, &workers );
MPI_Group_free( &worker_group );
/***
* Server part
*
* Server should loop until request code is 0, in each iteration:
* - receiving request code from any slave
* - generating a vector of CHUNKSIZE randoms <= INT_MAX
* - sending vector back to slave
*/
if (myid == server) { // I am the random generator server
do {
MPI_Recv( &request, 1, MPI_INT, MPI_ANY_SOURCE, REQUEST,
world, &status );
if (request) {
for (i = 0; i < CHUNKSIZE; ) {
rands[i] = random();
if ( rands[i] <= INT_MAX ) i++;
}
MPI_Send( rands, CHUNKSIZE, MPI_LONG,
status.MPI_SOURCE, REPLY, world );
}
}
while( request > 0 );
}
/***
* Workers (including Master) part
*
* Worker should send initial request to server.
* Later, in a loop worker should:
* - receive vector of randoms
* - compute x,y point inside unit square
* - check (and count result) if point is inside/outside
* unit circle
* - sum both counts over all workers
* - calculate pi and its error (from "exact" value)
* - test if error is within epsilon limit
* - test continuation condition (error and max. points limit)
* - print pi by master only
* - send a request to server (all if more or master only if finish)
* Before finishing workers should free their communicator.
*/
else { // I am a worker process
request = 1;
done = 0;
in = out = 0;
max = INT_MAX; // max int, for normalization
MPI_Send( &request, 1, MPI_INT, server, REQUEST, world );
MPI_Comm_rank( workers, &workerid );
iter = 0;
while (!done) {
iter++;
request = 1;
MPI_Recv( rands, CHUNKSIZE, MPI_LONG, server, REPLY,
world, &status );
for (i = 0; i < CHUNKSIZE - 1; ) {
x = (((double) rands[i++])/max) * 2 - 1;
y = (((double) rands[i++])/max) * 2 - 1;
if ( x*x + y*y < 1.0 ) {
in++;
}
else
out++;
}
MPI_Allreduce( &in, &totalin, 1, MPI_LONG, MPI_SUM, workers );
MPI_Allreduce( &out, &totalout, 1, MPI_LONG, MPI_SUM, workers );
Pi = ( 4.0 * totalin ) / ( totalin + totalout );
error = fabs( Pi - PI );
done = ( error < epsilon || (totalin + totalout) > THROW_MAX );
request = (done) ? 0 : 1;
if (myid == 0) {
printf( "\rpi = %23.20f", Pi );
MPI_Send( &request, 1, MPI_INT, server, REQUEST, world );
}
else {
if (request)
MPI_Send( &request, 1, MPI_INT, server, REQUEST, world );
}
}
MPI_Comm_free( &workers );
}
/***
* Master should print final point counts.
*/
if (myid == 0) {
printf( "\npoints: %ld\nin: %ld, out: %ld, <ret> to exit\n",
totalin+totalout, totalin, totalout );
getchar();
}
MPI_Finalize();
return 0;
}
int main( int argc, char *argv[] )
{
int iter;
int in, out, i, iters, max, ix, iy, ranks[1], done, temp;
double x, y, Pi, error, epsilon;
int numprocs, myid, server, totalin, totalout, workerid;
int rands[CHUNKSIZE], request;
MPI_Comm world, workers;
MPI_Group world_group, worker_group;
MPI_Status status;
MPI_Init(&argc,&argv);
world = MPI_COMM_WORLD;
MPI_Comm_size(world,&numprocs);
MPI_Comm_rank(world,&myid);
server = numprocs-1; /* last proc is server */
if (myid == 0)
sscanf( argv[1], "%lf", &epsilon );
MPI_Bcast( &epsilon, 1, MPI_DOUBLE, 0, MPI_COMM_WORLD );
MPI_Comm_group( world, &world_group );
ranks[0] = server;
MPI_Group_excl( world_group, 1, ranks, &worker_group );
MPI_Comm_create( world, worker_group, &workers );
MPI_Group_free(&worker_group);
if (myid == server) { /* I am the rand server */
do {
MPI_Recv(&request, 1, MPI_INT, MPI_ANY_SOURCE, REQUEST,
world, &status);
if (request) {
assert(request>0);
for (i = 0; i < CHUNKSIZE; ) {
rands[i] = random();
if (rands[i] <= INT_MAX) i++;
}
MPI_Send(rands, CHUNKSIZE, MPI_INT,
status.MPI_SOURCE, REPLY, world);
}
} while( request>0 );
}
else { /* I am a worker process */
request = 1;
done = in = out = 0;
max = INT_MAX; /* max int, for normalization */
MPI_Send( &request, 1, MPI_INT, server, REQUEST, world );
MPI_Comm_rank( workers, &workerid );
iter = 0;
while (!done) {
iter++;
request = 1;
MPI_Recv( rands, CHUNKSIZE, MPI_INT, server, REPLY,
world, &status );
for (i=0; i<CHUNKSIZE-1; ) {
x = (((double) rands[i++])/max) * 2 - 1;
y = (((double) rands[i++])/max) * 2 - 1;
if (x*x + y*y < 1.0)
in++;
else
out++;
}
MPI_Allreduce(&in, &totalin, 1, MPI_INT, MPI_SUM,
workers);
MPI_Allreduce(&out, &totalout, 1, MPI_INT, MPI_SUM,
workers);
Pi = (4.0*totalin)/(totalin + totalout);
error = fabs( Pi-3.141592653589793238462643);
done = (error < epsilon || (totalin+totalout) > 1000000);
request = (done) ? 0 : 1;
if (myid == 0) {
//printf( "\rpi = %23.20f", Pi );
MPI_Send( &request, 1, MPI_INT, server, REQUEST,
world );
}
else {
if (request) {
assert(request>0);
MPI_Send(&request, 1, MPI_INT, server, REQUEST,
world);
}
}
}
MPI_Comm_free(&workers);
}
if (myid == 0) {
//printf( "\npoints: %d\nin: %d, out: %d, <ret> to exit\n",
// totalin+totalout, totalin, totalout );
}
MPI_Finalize();
}
int
main (int argc, char **argv)
{
int nprocs = -1;
int rank = -1;
int i, j;
int *granks;
char processor_name[128];
int namelen = 128;
int buf[buf_size];
MPI_Status status;
MPI_Comm temp;
MPI_Comm intercomm = MPI_COMM_NULL;
MPI_Comm dcomms[DCOMM_CALL_COUNT];
MPI_Group world_group, dgroup;
int intersize, dnprocs[DCOMM_CALL_COUNT], drank[DCOMM_CALL_COUNT];
int dims[TWOD], periods[TWOD], remain_dims[TWOD];
int graph_index[] = { 2, 3, 4, 6 };
int graph_edges[] = { 1, 3, 0, 3, 0, 2 };
/* init */
MPI_Init (&argc, &argv);
MPI_Comm_size (MPI_COMM_WORLD, &nprocs);
MPI_Comm_rank (MPI_COMM_WORLD, &rank);
MPI_Get_processor_name (processor_name, &namelen);
printf ("(%d) is alive on %s\n", rank, processor_name);
fflush (stdout);
MPI_Barrier (MPI_COMM_WORLD);
/* probably want number to be higher... */
if (nprocs < 4) {
printf ("not enough tasks\n");
}
else {
if (DCOMM_CALL_COUNT > 0) {
#ifdef RUN_COMM_DUP
/* create all of the derived communicators... */
/* simplest is created by MPI_Comm_dup... */
MPI_Comm_dup (MPI_COMM_WORLD, &dcomms[0]);
#else
dcomms[0] = MPI_COMM_NULL;
#endif
}
if (DCOMM_CALL_COUNT > 1) {
#ifdef RUN_COMM_CREATE
/* use subset of MPI_COMM_WORLD group for MPI_Comm_create... */
MPI_Comm_group (MPI_COMM_WORLD, &world_group);
granks = (int *) malloc (sizeof(int) * (nprocs/2));
for (i = 0; i < nprocs/2; i++)
granks [i] = 2 * i;
MPI_Group_incl (world_group, nprocs/2, granks, &dgroup);
MPI_Comm_create (MPI_COMM_WORLD, dgroup, &dcomms[1]);
MPI_Group_free (&world_group);
MPI_Group_free (&dgroup);
free (granks);
#else
dcomms[1] = MPI_COMM_NULL;
#endif
}
if (DCOMM_CALL_COUNT > 2) {
#ifdef RUN_COMM_SPLIT
/* split into thirds with inverted ranks... */
MPI_Comm_split (MPI_COMM_WORLD, rank % 3, nprocs - rank, &dcomms[2]);
#else
dcomms[2] = MPI_COMM_NULL;
#endif
}
#ifdef RUN_INTERCOMM_CREATE
if ((DCOMM_CALL_COUNT < 2) || (dcomms[2] == MPI_COMM_NULL)) {
MPI_Comm_split (MPI_COMM_WORLD, rank % 3, nprocs - rank, &temp);
}
else {
temp = dcomms[2];
}
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);
}
if ((DCOMM_CALL_COUNT < 2) || (dcomms[2] == MPI_COMM_NULL)) {
MPI_Comm_free (&temp);
}
#endif
if (DCOMM_CALL_COUNT > 3) {
#ifdef RUN_CART_CREATE
/* create a 2 X nprocs/2 torus topology, allow reordering */
dims[0] = 2;
dims[1] = nprocs/2;
periods[0] = periods[1] = 1;
MPI_Cart_create (MPI_COMM_WORLD, TWOD, dims, periods, 1, &dcomms[3]);
#else
dcomms[3] = MPI_COMM_NULL;
#endif
}
if (DCOMM_CALL_COUNT > 4) {
#ifdef RUN_GRAPH_CREATE
/* create the graph on p.268 MPI: The Complete Reference... */
MPI_Graph_create (MPI_COMM_WORLD, GRAPH_SZ,
graph_index, graph_edges, 1, &dcomms[4]);
#else
dcomms[4] = MPI_COMM_NULL;
#endif
}
if (DCOMM_CALL_COUNT > 5) {
#ifdef RUN_CART_SUB
#ifndef RUN_CART_CREATE
/* need to make cartesian communicator temporarily... */
/* create a 2 X nprocs/2 torus topology, allow reordering */
dims[0] = 2;
dims[1] = nprocs/2;
periods[0] = periods[1] = 1;
MPI_Cart_create (MPI_COMM_WORLD, TWOD, dims, periods, 1, &dcomms[3]);
#endif
if (dcomms[3] != MPI_COMM_NULL) {
/* create 2 1 X nprocs/2 topologies... */
remain_dims[0] = 0;
remain_dims[1] = 1;
MPI_Cart_sub (dcomms[3], remain_dims, &dcomms[5]);
#ifndef RUN_CART_CREATE
/* free up temporarily created cartesian communicator... */
MPI_Comm_free (&dcomms[3]);
#endif
}
else {
dcomms[5] = MPI_COMM_NULL;
}
#else
dcomms[5] = MPI_COMM_NULL;
#endif
}
if (DCOMM_CALL_COUNT > 6) {
#ifdef RUN_INTERCOMM_MERGE
#ifndef RUN_INTERCOMM_CREATE
#ifndef RUN_COMM_SPLIT
/* need to make split communicator temporarily... */
/* split into thirds with inverted ranks... */
MPI_Comm_split (MPI_COMM_WORLD, rank % 3, nprocs - rank, &dcomms[2]);
#endif
#endif
/* create an intercommunicator and merge it... */
if (rank % 3) {
#ifndef RUN_INTERCOMM_CREATE
MPI_Intercomm_create (dcomms[2], 0, MPI_COMM_WORLD,
(((nprocs % 3) == 2) && ((rank % 3) == 2)) ?
nprocs - 1 : nprocs - (rank % 3) - (nprocs % 3),
INTERCOMM_CREATE_TAG, &intercomm);
#endif
MPI_Intercomm_merge (intercomm, ((rank % 3) == 1), &dcomms[6]);
#ifndef RUN_INTERCOMM_CREATE
/* we are done with intercomm... */
MPI_Comm_free (&intercomm);
#endif
}
else {
dcomms[6] = MPI_COMM_NULL;
}
#ifndef RUN_INTERCOMM_CREATE
#ifndef RUN_COMM_SPLIT
if (dcomms[2] != MPI_COMM_NULL)
/* free up temporarily created split communicator... */
MPI_Comm_free (&dcomms[2]);
#endif
#endif
#else
dcomms[6] = MPI_COMM_NULL;
#endif
}
/* get all of the sizes and ranks... */
for (i = 0; i < DCOMM_CALL_COUNT; i++) {
if (dcomms[i] != MPI_COMM_NULL) {
MPI_Comm_size (dcomms[i], &dnprocs[i]);
MPI_Comm_rank (dcomms[i], &drank[i]);
}
else {
dnprocs[i] = 0;
drank[i] = -1;
}
}
#ifdef RUN_INTERCOMM_CREATE
/* get the intercomm remote size... */
if (rank % 3) {
MPI_Comm_remote_size (intercomm, &intersize);
}
#endif
/* do some point to point on all of the dcomms... */
for (i = 0; i < DCOMM_CALL_COUNT; i++) {
if (dnprocs[i] > 1) {
if (drank[i] == 0) {
for (j = 1; j < dnprocs[i]; j++) {
MPI_Recv (buf, buf_size, MPI_INT, j, 0, dcomms[i], &status);
}
}
else {
memset (buf, 1, buf_size*sizeof(int));
MPI_Send (buf, buf_size, MPI_INT, 0, 0, dcomms[i]);
}
}
}
#ifdef RUN_INTERCOMM_CREATE
/* do some point to point on the intercomm... */
if ((rank % 3) == 1) {
for (j = 0; j < intersize; j++) {
MPI_Recv (buf, buf_size, MPI_INT, j, 0, intercomm, &status);
}
}
else if ((rank % 3) == 2) {
for (j = 0; j < intersize; j++) {
memset (buf, 1, buf_size*sizeof(int));
MPI_Send (buf, buf_size, MPI_INT, j, 0, intercomm);
}
}
#endif
/* do a bcast on all of the dcomms... */
for (i = 0; i < DCOMM_CALL_COUNT; i++) {
/* IBM's implementation gets error with comm over MPI_COMM_NULL... */
if (dnprocs[i] > 0)
MPI_Bcast (buf, buf_size, MPI_INT, 0, dcomms[i]);
}
/* use any source receives... */
for (i = 0; i < DCOMM_CALL_COUNT; i++) {
if (dnprocs[i] > 1) {
if (drank[i] == 0) {
for (j = 1; j < dnprocs[i]; j++) {
MPI_Recv (buf, buf_size, MPI_INT,
MPI_ANY_SOURCE, 0, dcomms[i], &status);
}
}
else {
memset (buf, 1, buf_size*sizeof(int));
MPI_Send (buf, buf_size, MPI_INT, 0, 0, dcomms[i]);
}
}
}
#ifdef RUN_INTERCOMM_CREATE
/* do any source receives on the intercomm... */
if ((rank % 3) == 1) {
for (j = 0; j < intersize; j++) {
MPI_Recv (buf, buf_size, MPI_INT,
MPI_ANY_SOURCE, 0, intercomm, &status);
}
}
else if ((rank % 3) == 2) {
for (j = 0; j < intersize; j++) {
memset (buf, 1, buf_size*sizeof(int));
MPI_Send (buf, buf_size, MPI_INT, j, 0, intercomm);
}
}
#endif
/* do a barrier on all of the dcomms... */
for (i = 0; i < DCOMM_CALL_COUNT; i++) {
/* IBM's implementation gets with communication over MPI_COMM_NULL... */
if (dnprocs[i] > 0)
MPI_Barrier (dcomms[i]);
}
/* free all of the derived communicators... */
for (i = 0; i < DCOMM_CALL_COUNT; i++) {
/* freeing MPI_COMM_NULL is explicitly defined as erroneous... */
if (dnprocs[i] > 0)
MPI_Comm_free (&dcomms[i]);
}
#ifdef RUN_INTERCOMM_CREATE
if (rank % 3)
/* we are done with intercomm... */
MPI_Comm_free (&intercomm);
#endif
}
MPI_Barrier (MPI_COMM_WORLD);
MPI_Finalize ();
printf ("(%d) Finished normally\n", rank);
}
MTEST_THREAD_RETURN_TYPE test_idup(void *arg)
{
int i;
int size, rank;
int ranges[1][3];
int rleader, isLeft;
int *excl = NULL;
int tid = *(int *) arg;
MPI_Group ingroup, high_group, even_group;
MPI_Comm local_comm, inter_comm;
MPI_Comm idupcomms[NUM_IDUPS];
MPI_Request reqs[NUM_IDUPS];
MPI_Comm outcomm;
MPI_Comm incomm = comms[tid];
MPI_Comm_size(incomm, &size);
MPI_Comm_rank(incomm, &rank);
MPI_Comm_group(incomm, &ingroup);
/* Idup incomm multiple times */
for (i = 0; i < NUM_IDUPS; i++) {
MPI_Comm_idup(incomm, &idupcomms[i], &reqs[i]);
}
/* Overlap pending idups with various comm generation functions */
/* Comm_dup */
MPI_Comm_dup(incomm, &outcomm);
errs[tid] += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
/* Comm_split */
MPI_Comm_split(incomm, rank % 2, size - rank, &outcomm);
errs[tid] += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
/* Comm_create, high half of incomm */
ranges[0][0] = size / 2;
ranges[0][1] = size - 1;
ranges[0][2] = 1;
MPI_Group_range_incl(ingroup, 1, ranges, &high_group);
MPI_Comm_create(incomm, high_group, &outcomm);
MPI_Group_free(&high_group);
errs[tid] += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
/* Comm_create_group, even ranks of incomm */
/* exclude the odd ranks */
excl = malloc((size / 2) * sizeof(int));
for (i = 0; i < size / 2; i++)
excl[i] = (2 * i) + 1;
MPI_Group_excl(ingroup, size / 2, excl, &even_group);
free(excl);
if (rank % 2 == 0) {
MPI_Comm_create_group(incomm, even_group, 0, &outcomm);
}
else {
outcomm = MPI_COMM_NULL;
}
MPI_Group_free(&even_group);
errs[tid] += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
/* Intercomm_create & Intercomm_merge */
MPI_Comm_split(incomm, (rank < size / 2), rank, &local_comm);
if (rank == 0) {
rleader = size / 2;
}
else if (rank == size / 2) {
rleader = 0;
}
else {
rleader = -1;
}
isLeft = rank < size / 2;
MPI_Intercomm_create(local_comm, 0, incomm, rleader, 99, &inter_comm);
MPI_Intercomm_merge(inter_comm, isLeft, &outcomm);
MPI_Comm_free(&local_comm);
errs[tid] += MTestTestComm(inter_comm);
MTestFreeComm(&inter_comm);
errs[tid] += MTestTestComm(outcomm);
MTestFreeComm(&outcomm);
MPI_Waitall(NUM_IDUPS, reqs, MPI_STATUSES_IGNORE);
for (i = 0; i < NUM_IDUPS; i++) {
errs[tid] += MTestTestComm(idupcomms[i]);
MPI_Comm_free(&idupcomms[i]);
}
MPI_Group_free(&ingroup);
return NULL;
}
//=============================================================================
int Amesos_Mumps::SymbolicFactorization()
{
// erase data if present.
if (IsSymbolicFactorizationOK_ && MDS.job != -777)
Destroy();
IsSymbolicFactorizationOK_ = false;
IsNumericFactorizationOK_ = false;
CreateTimer(Comm());
CheckParameters();
AMESOS_CHK_ERR(ConvertToTriplet(false));
#if defined(HAVE_MPI) && defined(HAVE_AMESOS_MPI_C2F)
if (MaxProcs_ != Comm().NumProc())
{
if(MUMPSComm_)
MPI_Comm_free(&MUMPSComm_);
std::vector<int> ProcsInGroup(MaxProcs_);
for (int i = 0 ; i < MaxProcs_ ; ++i)
ProcsInGroup[i] = i;
MPI_Group OrigGroup, MumpsGroup;
MPI_Comm_group(MPI_COMM_WORLD, &OrigGroup);
MPI_Group_incl(OrigGroup, MaxProcs_, &ProcsInGroup[0], &MumpsGroup);
MPI_Comm_create(MPI_COMM_WORLD, MumpsGroup, &MUMPSComm_);
#ifdef MUMPS_4_9
MDS.comm_fortran = (MUMPS_INT) MPI_Comm_c2f( MUMPSComm_);
#else
#ifndef HAVE_AMESOS_OLD_MUMPS
MDS.comm_fortran = (DMUMPS_INT) MPI_Comm_c2f( MUMPSComm_);
#else
MDS.comm_fortran = (F_INT) MPI_Comm_c2f( MUMPSComm_);
#endif
#endif
}
else
{
const Epetra_MpiComm* MpiComm = dynamic_cast<const Epetra_MpiComm*>(&Comm());
assert (MpiComm != 0);
#ifdef MUMPS_4_9
MDS.comm_fortran = (MUMPS_INT) MPI_Comm_c2f(MpiComm->GetMpiComm());
#else
#ifndef HAVE_AMESOS_OLD_MUMPS
MDS.comm_fortran = (DMUMPS_INT) MPI_Comm_c2f(MpiComm->GetMpiComm());
#else
MDS.comm_fortran = (F_INT) MPI_Comm_c2f(MpiComm->GetMpiComm());
#endif
#endif
}
#else
// This next three lines of code were required to make Amesos_Mumps work
// with Ifpack_SubdomainFilter. They is usefull in all cases
// when using MUMPS on a subdomain.
const Epetra_MpiComm* MpiComm = dynamic_cast<const Epetra_MpiComm*>(&Comm());
assert (MpiComm != 0);
MDS.comm_fortran = (MUMPS_INT) MPI_Comm_c2f(MpiComm->GetMpiComm());
// only thing I can do, use MPI_COMM_WORLD. This will work in serial as well
// Previously, the next line was uncommented, but we don't want MUMPS to work
// on the global MPI comm, but on the comm associated with the matrix
// MDS.comm_fortran = -987654;
#endif
MDS.job = -1 ; // Initialization
MDS.par = 1 ; // Host IS involved in computations
// MDS.sym = MatrixProperty_;
MDS.sym = 0; // MatrixProperty_ is unititalized. Furthermore MUMPS
// expects only half of the matrix to be provided for
// symmetric matrices. Hence setting MDS.sym to be non-zero
// indicating that the matrix is symmetric will only work
// if we change ConvertToTriplet to pass only half of the
// matrix. Bug #2331 and Bug #2332 - low priority
RedistrMatrix(true);
if (Comm().MyPID() < MaxProcs_)
{
dmumps_c(&(MDS)); // Initialize MUMPS
static_cast<void>( CheckError( ) );
}
MDS.n = Matrix().NumGlobalRows();
// fix pointers for nonzero pattern of A. Numerical values
// will be entered in PerformNumericalFactorization()
if (Comm().NumProc() != 1)
{
MDS.nz_loc = RedistrMatrix().NumMyNonzeros();
if (Comm().MyPID() < MaxProcs_)
{
MDS.irn_loc = &Row[0];
MDS.jcn_loc = &Col[0];
}
}
else
{
if (Comm().MyPID() == 0)
{
MDS.nz = Matrix().NumMyNonzeros();
MDS.irn = &Row[0];
MDS.jcn = &Col[0];
}
}
// scaling if provided by the user
if (RowSca_ != 0)
{
MDS.rowsca = RowSca_;
MDS.colsca = ColSca_;
}
// given ordering if provided by the user
if (PermIn_ != 0)
{
MDS.perm_in = PermIn_;
}
MDS.job = 1; // Request symbolic factorization
SetICNTLandCNTL();
// Perform symbolic factorization
ResetTimer();
if (Comm().MyPID() < MaxProcs_)
dmumps_c(&(MDS));
SymFactTime_ = AddTime("Total symbolic factorization time", SymFactTime_);
int IntWrong = CheckError()?1:0 ;
int AnyWrong;
Comm().SumAll( &IntWrong, &AnyWrong, 1 ) ;
bool Wrong = AnyWrong > 0 ;
if ( Wrong ) {
AMESOS_CHK_ERR( StructurallySingularMatrixError ) ;
}
IsSymbolicFactorizationOK_ = true ;
NumSymbolicFact_++;
return 0;
}
int main(int argc, char * argv[])
{
int numPointsPerDimension;
int verbose = 0;
double omega;
double epsilon;
double * * points;
struct timeval startTime;
struct timeval endTime;
double duration;
double breakdown = 0;
int numIterations;
double maxDiff, tmpMaxDiff;
int numProcesses;
int workingProcesses;
int myRank;
MPI_Status status;
MPI_Request requestUpSend, requestUpRecv;
MPI_Request requestDownSend, requestDownRecv;
int partitions;
int remainder;
int width;
int i, k;
int buffSize;
int startRow;
double * upPointsSend, * upPointsRecv;
double * downPointsSend, * downPointsRecv;
int upperProc, lowerProc;
struct timeval startInterval;
struct timeval endInterval;
if (argc < 2)
{
fprintf(stderr, "ERROR: Too few arguments!\n");
printUsage(argv[0]);
exit(1);
}
else if (argc > 3)
{
fprintf(stderr, "ERROR: Too many arguments!\n");
printUsage(argv[0]);
exit(1);
}
else
{
int argIdx = 1;
if (argc == 3)
{
if (strncmp(argv[argIdx], OPTION_VERBOSE, strlen(OPTION_VERBOSE)) != 0)
{
fprintf(stderr, "ERROR: Unexpected option '%s'!\n", argv[argIdx]);
printUsage(argv[0]);
exit(1);
}
verbose = 1;
++argIdx;
}
numPointsPerDimension = atoi(argv[argIdx]);
if (numPointsPerDimension < 2)
{
fprintf(stderr, "ERROR: The number of points, '%s', should be "
"a numeric value greater than or equal to 2!\n", argv[argIdx]);
printUsage(argv[0]);
exit(1);
}
}
MPI_Init(&argc, &argv);
/* get info about how may processes are running
* and what is your rank number */
MPI_Comm_size(MPI_COMM_WORLD, &numProcesses);
MPI_Comm_rank(MPI_COMM_WORLD, &myRank);
/* calculate nominal size of data per each process */
partitions = numPointsPerDimension / numProcesses;
/* calculate number of processes with the additional row of data */
remainder = numPointsPerDimension % numProcesses;
/* according to myRank, set the width of the table */
width = (myRank < remainder) ? partitions + 1 : partitions;
/* decide how many processes are required to do the calculation */
workingProcesses = (numProcesses > numPointsPerDimension) ? numPointsPerDimension : numProcesses;
/* terminate processes that won't be used */
/* start of copied part of code */
MPI_Comm MY_WORLD = MPI_COMM_WORLD;
if(workingProcesses < numProcesses)
{
MPI_Group world_group;
MPI_Comm_group(MPI_COMM_WORLD, &world_group);
// Remove all unnecessary ranks
MPI_Group new_group;
int ranges[1][3] = {{workingProcesses, (numProcesses - 1), 1}};
MPI_Group_range_excl(world_group, 1, ranges, &new_group);
// Create a new communicator
MPI_Comm_create(MPI_COMM_WORLD, new_group, &MY_WORLD);
if (MY_WORLD == MPI_COMM_NULL)
{
// Bye bye cruel world
MPI_Finalize();
exit(0);
}
}
/* end of copied part of code */
/* source: http://stackoverflow.com/questions/13774968/mpi-kill-unwanted-processes */
/* set the calculation parameters */
omega = getOmega(numPointsPerDimension);
epsilon = getEpsilon(numPointsPerDimension);
/* allocate points table for each process */
points = allocatePoints(numPointsPerDimension, width, numProcesses);
if (points == NULL)
{
freePoints(points, width, myRank);
fprintf(stderr, "ERROR: Malloc failed!\n");
exit(1);
}
/* size of the table to send per each iteration */
buffSize = numPointsPerDimension / 2 + numPointsPerDimension % 2 ;
/* initialize additional buffers for communication */
upPointsSend = initializeBuffer(buffSize);
upPointsRecv = initializeBuffer(buffSize);
downPointsSend = initializeBuffer(buffSize);
downPointsRecv = initializeBuffer(buffSize);
/* process #0 sends to others separate parts of the table
* others wait for incoming data */
if (myRank == 0)
{
startRow = numPointsPerDimension;
for(k = workingProcesses - 1; k >= 0 ; --k)
{
width = (k < remainder) ? partitions + 1 : partitions;
/* initialize points */
initializePoints(points, startRow - width, width, numPointsPerDimension);
/* send table to k-th process */
if(k != 0)
{
for(i = 0; i < width; ++i)
{
MPI_Send(points[i], numPointsPerDimension, MPI_DOUBLE, k, 123, MY_WORLD);
}
}
startRow -= width;
}
}
else
{
if(myRank < workingProcesses)
{
for(i = 0; i < width; ++i)
{
MPI_Recv(points[i], numPointsPerDimension, MPI_DOUBLE, 0, 123, MY_WORLD, &status);
}
}
}
/* remember with which processes you comunicate */
upperProc = myRank == 0 ? MPI_PROC_NULL : myRank - 1;
lowerProc = myRank == workingProcesses - 1 ? MPI_PROC_NULL : myRank + 1;
/* here each process has it's own data set for computations */
if(remainder > 0)
{
startRow = (myRank < remainder) ? myRank * (partitions + 1) : myRank * partitions + remainder;
}
else
{
startRow = myRank * partitions;
}
if(gettimeofday(&startTime, NULL))
{
freePoints(points, width, myRank);
fprintf(stderr, "ERROR: Gettimeofday failed!\n");
exit(1);
}
/* Start of computations. */
numIterations = 0;
do
{
int i, j, color;
maxDiff = 0.0;
for (color = 0; color < 2; ++color)
{
/* fill downPointsSend with the last row of points data */
setDataBuffer(downPointsSend, points, width - 1, 1 + ((startRow + width) % 2 == color ? 1 : 0), numPointsPerDimension);
if(gettimeofday(&startInterval, NULL))
{
freePoints(points, width, myRank);
fprintf(stderr, "ERROR: Gettimeofday failed!\n");
exit(1);
}
MPI_Isend(downPointsSend, buffSize, MPI_DOUBLE, lowerProc, color, MY_WORLD, &requestDownSend);
MPI_Irecv(downPointsRecv, buffSize, MPI_DOUBLE, lowerProc, color, MY_WORLD, &requestDownRecv);
if(gettimeofday(&endInterval, NULL))
{
freePoints(points, width, myRank);
fprintf(stderr, "ERROR: Gettimeofday failed!\n");
exit(1);
}
breakdown += ((double)endInterval.tv_sec + ((double)endInterval.tv_usec / 1000000.0)) -
((double)startInterval.tv_sec + ((double)startInterval.tv_usec / 1000000.0));
/* fill upPointsSend with the last row of points data */
setDataBuffer(upPointsSend, points, 0, 1 + ((startRow - 1) % 2 == color ? 1 : 0), numPointsPerDimension);
if(gettimeofday(&startInterval, NULL))
{
freePoints(points, width, myRank);
fprintf(stderr, "ERROR: Gettimeofday failed!\n");
exit(1);
}
MPI_Isend(upPointsSend, buffSize, MPI_DOUBLE, upperProc, color, MY_WORLD, &requestUpSend);
MPI_Irecv(upPointsRecv, buffSize, MPI_DOUBLE, upperProc, color, MY_WORLD, &requestUpRecv);
if(gettimeofday(&endInterval, NULL))
{
freePoints(points, width, myRank);
fprintf(stderr, "ERROR: Gettimeofday failed!\n");
exit(1);
}
breakdown += ((double)endInterval.tv_sec + ((double)endInterval.tv_usec / 1000000.0)) -
((double)startInterval.tv_sec + ((double)startInterval.tv_usec / 1000000.0));
/* computations of the first row requires data that has to be recieved from other process */
MPI_Wait(&requestUpRecv, &status);
for (i = 0; i < width; ++i)
{
/* before computing the last row of its data,
* process has to be sure that it has required
* row from process rank+1 */
if(i == width - 1)
{
MPI_Wait(&requestDownRecv, &status);
}
for (j = 1 + ((startRow+i) % 2 == color ? 1 : 0); j < numPointsPerDimension - 1; j += 2)
{
if( (myRank != 0 || i != 0 ) && (myRank != workingProcesses - 1 || i != width - 1) )
{
double tmp, diff;
double down, up;
int jIdx = (j - 1 - ((startRow + i) % 2 == color ? 1 : 0))/ 2;
/* decide if up or down value should be taken from additional buffers */
up = (i == 0) ? upPointsRecv[jIdx] : points[i-1][j];
down = (i == width - 1) ? downPointsRecv[jIdx] : points[i+1][j];
/* calculate final value */
tmp = (up + down + points[i][j - 1] + points[i][j + 1]) / 4.0;
diff = points[i][j];
points[i][j] = (1.0 - omega) * points[i][j] + omega * tmp;
diff = fabs(diff - points[i][j]);
if (diff > maxDiff)
{
maxDiff = diff;
}
}
}
}
MPI_Barrier(MY_WORLD);
}
if(gettimeofday(&startInterval, NULL))
{
freePoints(points, width, myRank);
fprintf(stderr, "ERROR: Gettimeofday failed!\n");
exit(1);
}
/* find new maxDiff among all processes */
MPI_Allreduce(&maxDiff, &tmpMaxDiff, 1, MPI_DOUBLE, MPI_MAX, MY_WORLD );
maxDiff = tmpMaxDiff;
if(gettimeofday(&endInterval, NULL))
{
freePoints(points, width, myRank);
fprintf(stderr, "ERROR: Gettimeofday failed!\n");
exit(1);
}
breakdown += ((double)endInterval.tv_sec + ((double)endInterval.tv_usec / 1000000.0)) -
((double)startInterval.tv_sec + ((double)startInterval.tv_usec / 1000000.0));
++numIterations;
}
while (maxDiff > epsilon);
/* End of computations. */
if(gettimeofday(&endTime, NULL))
{
freePoints(points, width, myRank);
fprintf(stderr, "ERROR: Gettimeofday failed!\n");
exit(1);
}
/* calculate how long did the computation lasted */
duration =
((double)endTime.tv_sec + ((double)endTime.tv_usec / 1000000.0)) -
((double)startTime.tv_sec + ((double)startTime.tv_usec / 1000000.0));
/* we choose the process whose execution lasted for the longest time */
double maxDuration;
MPI_Allreduce(&duration, &maxDuration, 1, MPI_DOUBLE, MPI_MAX, MY_WORLD);
if(myRank==0)
{
fprintf(stderr,
"Statistics: duration(s)=%.10f breakdown=%.10f #iters=%d diff=%.10f epsilon=%.10f\n",
maxDuration, breakdown, numIterations, maxDiff, epsilon);
}
if (verbose) {
MPI_Barrier(MY_WORLD);
/* process #0 is responsible for printing results of computation
* others send their data straight to it */
if(myRank != 0 && myRank < workingProcesses)
{
for(k = 0; k < width ; ++k)
{
MPI_Send(points[k], numPointsPerDimension, MPI_DOUBLE, 0, 123, MY_WORLD);
}
}
else if(myRank == 0)
{
printPoints(points, width, numPointsPerDimension);
for(i = 1; i < workingProcesses; ++i)
{
width = (i < remainder) ? partitions + 1 : partitions;
for (k = 0 ; k < width ; ++k)
{
MPI_Recv(points[k], numPointsPerDimension, MPI_DOUBLE, i, 123, MY_WORLD, &status);
}
printPoints(points, width, numPointsPerDimension);
}
}
}
/* free all the memory that was allocated */
freePoints(points, width, myRank);
free(downPointsSend);
free(upPointsSend);
free(downPointsRecv);
free(upPointsRecv);
MPI_Finalize();
return 0;
}
int main(int argc, char **argv) {
int rankLeft[4] = {0, 1, 2, 3}, rankRight[4] = {4, 5, 6, 7};
int i, result;
char outStr[600];
int nProcs, myRank;
MPI_Group grpWorld, grpNew;
MPI_Comm commNew;
MPI_Init(&argc, &argv);
MPI_Comm_size(MPI_COMM_WORLD, &nProcs);
MPI_Comm_rank(MPI_COMM_WORLD, &myRank);
MPI_Comm_group(MPI_COMM_WORLD, &grpWorld);
if (myRank < nProcs / 2) {
MPI_Group_incl(grpWorld, nProcs / 2, rankLeft, &grpNew);
} else {
MPI_Group_incl(grpWorld, nProcs / 2, rankRight, &grpNew);
}
MPI_Comm_create(MPI_COMM_WORLD, grpNew, &commNew);
int myRankCommNew, nProcsCommNew;
int myRankGrpNew, nProcsGrpNew;
MPI_Comm_rank(commNew, &myRankCommNew);
MPI_Comm_size(commNew, &nProcsCommNew);
MPI_Group_rank(grpNew, &myRankGrpNew);
MPI_Group_size(grpNew, &nProcsGrpNew);
fprintf(stdout, "WorldRank: %d in %d, NewCommRank: %d in %d, NewGrpRank: %d in %d\n",
myRank, nProcs, myRankCommNew, nProcsCommNew, myRankGrpNew, nProcsGrpNew);
MPI_Barrier(MPI_COMM_WORLD);
int sendBuf = myRank, recvBuf;
MPI_Allreduce(&sendBuf, &recvBuf, 1, MPI_INT, MPI_SUM, commNew);
fprintf(stdout, "WorldRank = %d, sendBuf = %d, recvBuf = %d\n", myRank, sendBuf, recvBuf);
fflush(stdout);
MPI_Barrier(MPI_COMM_WORLD);
int ranks1[8] = {0, 1, 2, 3, 4, 5, 6, 7}, ranks2[8];
MPI_Group_compare(grpWorld, grpNew, &result);
MPI_Group_translate_ranks(grpWorld, nProcs, ranks1, grpNew, ranks2);
if (myRank == 0) {
fprintf(stdout, "result = %d\n", result);
}
sprintf_s(outStr, "rank %d: ", myRank);
for (i = 0; i < nProcs; i++) {
sprintf_s(outStr, "%s%d = %d ", outStr, ranks1[i], ranks2[i]);
}
fprintf(stdout, "%s\n", outStr);
MPI_Comm_free(&commNew);
MPI_Group_free(&grpNew);
MPI_Group_free(&grpWorld);
MPI_Finalize();
return 0;
}
int Zoltan_PHG_Redistribute(
ZZ *zz,
PHGPartParams *hgp, /* Input: parameters; used only for user's
request of nProc_x and nProc_y */
HGraph *ohg, /* Input: Local part of distributed hypergraph */
int lo, int hi, /* Input: range of proc ranks (inclusive)
to be included in new communicator: ncomm */
PHGComm *ncomm, /* Output: Communicators of new distribution */
HGraph *nhg, /* Output: Newly redistributed hypergraph */
int **vmap, /* Output: allocated with the size nhg->nVtx and
vertex map from nhg to ohg's local vertex number*/
int **vdest /* Output: allocated with the size nhg->nVtx and
stores dest proc in ocomm */
)
{
char * yo = "Zoltan_PHG_Redistribute";
PHGComm *ocomm = ohg->comm;
int *v2Col, *n2Row, ierr=ZOLTAN_OK, i, *ranks;
int reqx=hgp->nProc_x_req, reqy=hgp->nProc_y_req;
double frac;
MPI_Group allgrp, newgrp;
MPI_Comm nmpicomm;
if (ocomm->nProc==1){
errexit("%s: ocomm->nProc==1", yo);
return ZOLTAN_FATAL;
}
/* create a new communicator for procs[lo..hi] */
MPI_Comm_group(ocomm->Communicator, &allgrp);
ranks = (int *) ZOLTAN_MALLOC(ocomm->nProc * sizeof(int));
if (!ranks) MEMORY_ERROR;
for (i=lo; i<=hi; ++i)
ranks[i-lo] = i;
MPI_Group_incl(allgrp, hi-lo+1, ranks, &newgrp);
MPI_Comm_create(ocomm->Communicator, newgrp, &nmpicomm);
MPI_Group_free(&newgrp);
MPI_Group_free(&allgrp);
ZOLTAN_FREE(&ranks);
if (reqx==1 || reqy==1)
;
else
reqx = reqy = -1;
/* fill ncomm */
ierr = Zoltan_PHG_Set_2D_Proc_Distrib(ocomm->zz, nmpicomm,
ocomm->myProc-lo, hi-lo+1,
reqx, reqy, ncomm);
v2Col = (int *) ZOLTAN_MALLOC(ohg->nVtx * sizeof(int));
n2Row = (int *) ZOLTAN_MALLOC(ohg->nEdge * sizeof(int));
if ( (ohg->nVtx && !v2Col) || (ohg->nEdge && !n2Row)) MEMORY_ERROR;
/* UVC: TODO very simple straight forward partitioning right now;
later we can implement a more "load balanced", or smarter
mechanisms */
/* KDDKDD 5/11/07: Round-off error in the computation of v2Col
* and n2Row can lead to different answers on different platforms.
* Vertices or edges get sent to different processors during the
* split, resulting in different matchings and, thus, different
* answers.
* Problem was observed on hg_cage10, zdrive.inp.phg.ipm.nproc_vertex1
* and zdrive.inp.phg.ipm.nproc_edge1;
* solaris machine seamus and linux machine patches give different
* results due to differences in n2Row and v2Col, respectively.
* Neither answer is wrong,
* but the linux results result in FAILED test in test_zoltan.
* KDDKDD 10/28/15: Round-off error when using floats can cause v2Col
* and n2Row to have invalid results, which exhibited in Comm_Do_Post.
* Changing to doubles solved the problem (for now, at least).
*/
frac = (double) ohg->nVtx / (double) ncomm->nProc_x;
for (i=0; i<ohg->nVtx; ++i)
v2Col[i] = (int) ((double) i / frac);
frac = (double) ohg->nEdge / (double) ncomm->nProc_y;
for (i=0; i<ohg->nEdge; ++i)
n2Row[i] = (int) ((double) i / frac);
ierr |= Zoltan_PHG_Redistribute_Hypergraph(zz, hgp, ohg, lo,
v2Col, n2Row, ncomm,
nhg, vmap, vdest);
End:
Zoltan_Multifree(__FILE__, __LINE__, 2,
&v2Col, &n2Row);
return ierr;
}
int main( int argc, char **argv ) {
int rank, size, i,j, r;
//int table[MAXN][MAXN];
int newtable[MAXN * MAXN];
int row[MAXN];
int ranks[MAXN];
int last;
int v;
int N = 5;
MPI_Datatype subarray;
int array_size[] ={N};
int array_subsize[] = {N};
int array_start[] = {0};
MPI_Comm COMM_LAST;
MPI_Group group_world, group_last;
MPI_Init( &argc, &argv );
MPI_Comm_rank( MPI_COMM_WORLD, &rank );
MPI_Comm_size( MPI_COMM_WORLD, &size );
MPI_Type_create_subarray(1, array_size, array_subsize, array_start, MPI_ORDER_C, MPI_INT, &subarray);
MPI_Type_commit(&subarray);
last = N % size;
/* If I'm the root (process 0), then fill out the big table */
if (rank == 0) {
int k = 0;
for ( i=0; i<N; i++)
for ( j=0; j<N; j++ )
newtable[i*N + j] = ++k;
} else {
for ( i=0; i<N; i++) {
for ( j=0; j<N; j++ )
newtable[i * N + j] = 0;
row[i] = 0;
}
}
printf("@[%d] Initialize..\n", rank);
MPI_Barrier(MPI_COMM_WORLD);
for(r = 0; r < size; r++) {
MPI_Barrier(MPI_COMM_WORLD);
if(rank == r) {
printf("@[%d] X-> \n", rank);
for(i=0; i<N; i++)
print_row("Xnewtable",newtable,i, N, rank);
}
MPI_Barrier(MPI_COMM_WORLD);
}
/* if(!rank)
for(i=0; i<N; i++)
print_row("newtable", newtable,i, N, rank);*/
for(i=0; i <last; i++) ranks[i] = i;
MPI_Comm_group(MPI_COMM_WORLD, &group_world);
MPI_Group_incl(group_world, last, ranks, &group_last);
MPI_Comm_create(MPI_COMM_WORLD, group_last, &COMM_LAST);
for(i = 0; i < N; i+= size ) {
if(!rank)printf("scatter <%d>\n", i);
if (i < (N - last)) {
MPI_Scatter(
&newtable[i * N + 0], 1, subarray,
&newtable[(i + rank) * N + 0], 1, subarray,
0,MPI_COMM_WORLD);
} else {
if (rank < last) {
MPI_Scatter(
&newtable[i * N + 0], 1, subarray,
&newtable[ (i + rank) * N + 0], 1, subarray,
0, COMM_LAST);
}
}
}
MPI_Barrier(MPI_COMM_WORLD);
for(r = 0; r < size; r++) {
MPI_Barrier(MPI_COMM_WORLD);
if(rank == r) {
printf("@[%d] -> \n", rank);
for(i=0; i<N; i++)
print_row("Xnewtable",newtable,i, N, rank);
}
MPI_Barrier(MPI_COMM_WORLD);
}
MPI_Barrier(MPI_COMM_WORLD);
printf("@[%d] ......\n", rank);
MPI_Barrier(MPI_COMM_WORLD);
// reset our little matrix
if (rank == 0) {
int k = 0;
for ( i=0; i<N; i++)
for ( j=0; j<N; j++ )
newtable[i * N + j] = 0;
for(r = 0; r < size; r++) {
printf("@[%d]\n", rank);
if(rank == r) {
for(i=0; i<N; i++)
print_row("newtable",newtable, i, N, rank);
}
}
}
MPI_Barrier(MPI_COMM_WORLD);
for(i = 0; i < N; i+= size ) {
if(!rank)printf("gather <%d>\n", i);
if (i < (N - last)) {
MPI_Gather(
&newtable[ ( i + rank ) * N + 0], 1, subarray,
&newtable[i * N + 0], 1, subarray,
0, MPI_COMM_WORLD);
} else {
if (rank < last) {
MPI_Gather(
&newtable[(i + rank) * N + 0], 1, subarray,
&newtable[i*N + 0], 1, subarray,
0,COMM_LAST);
}
}
}
if (rank == 0) {
for(r = 0; r < size; r++) {
printf("@[%d]\n", rank);
if(rank == r) {
for(i=0; i<N; i++)
print_row("newtable",newtable,i, N, rank);
}
}
}
MPI_Group_free(&group_last);
if (rank < last)
MPI_Comm_free(&COMM_LAST);
MPI_Finalize();
return 0;
}
void init_mesh(MeshS *pM)
{
int nblock,num_domains,nd,nl,level,maxlevel=0,nd_this_level;
int nDim,nDim_test,dim;
int *next_domainid;
char block[80];
int ncd,ir,irefine,l,m,n,roffset;
int i,Nx[3],izones;
div_t xdiv[3]; /* divisor with quot and rem members */
Real root_xmin[3], root_xmax[3]; /* min/max of x in each dir on root grid */
int Nproc_Comm_world=1,nproc=0,next_procID;
SideS D1,D2;
DomainS *pD, *pCD;
#ifdef MPI_PARALLEL
int ierr,child_found,groupn,Nranks,Nranks0,max_rank,irank,*ranks;
MPI_Group world_group;
/* Get total # of processes, in MPI_COMM_WORLD */
ierr = MPI_Comm_size(MPI_COMM_WORLD, &Nproc_Comm_world);
#endif
/* Start by initializing some quantaties in Mesh structure */
pM->time = 0.0;
pM->nstep = 0;
pM->outfilename = par_gets("job","problem_id");
/*--- Step 1: Figure out how many levels and domains there are. --------------*/
/* read levels of each domain block in input file and calculate max level */
num_domains = par_geti("job","num_domains");
#ifndef STATIC_MESH_REFINEMENT
if (num_domains > 1)
ath_error("[init_mesh]: num_domains=%d; for num_domains > 1 configure with --enable-smr\n",num_domains);
#endif
for (nblock=1; nblock<=num_domains; nblock++){
sprintf(block,"domain%d",nblock);
if (par_exist(block,"level") == 0)
ath_error("[init_mesh]: level does not exist in block %s\n",block);
level = par_geti(block,"level");
maxlevel = MAX(maxlevel,level);
}
/* set number of levels in Mesh, and allocate DomainsPerLevel array */
pM->NLevels = maxlevel + 1; /* level counting starts at 0 */
pM->DomainsPerLevel = (int*)calloc_1d_array(pM->NLevels,sizeof(int));
if (pM->DomainsPerLevel == NULL)
ath_error("[init_mesh]: malloc returned a NULL pointer\n");
/* Now figure out how many domains there are at each level */
for (nl=0; nl<=maxlevel; nl++){
nd_this_level=0;
for (nblock=1; nblock<=num_domains; nblock++){
sprintf(block,"domain%d",nblock);
if (par_geti(block,"level") == nl) nd_this_level++;
}
/* Error if there are any levels with no domains. Else set DomainsPerLevel */
if (nd_this_level == 0) {
ath_error("[init_mesh]: Level %d has zero domains\n",nl);
} else {
pM->DomainsPerLevel[nl] = nd_this_level;
}
}
/*--- Step 2: Set up root level. --------------------------------------------*/
/* Find the <domain> block in the input file corresponding to the root level,
* and set root level properties in Mesh structure */
if (pM->DomainsPerLevel[0] != 1)
ath_error("[init_mesh]: Level 0 has %d domains\n",pM->DomainsPerLevel[0]);
for (nblock=1; nblock<=num_domains; nblock++){
sprintf(block,"domain%d",nblock);
level = par_geti(block,"level");
if (level == 0){
root_xmin[0] = par_getd(block,"x1min");
root_xmax[0] = par_getd(block,"x1max");
root_xmin[1] = par_getd(block,"x2min");
root_xmax[1] = par_getd(block,"x2max");
root_xmin[2] = par_getd(block,"x3min");
root_xmax[2] = par_getd(block,"x3max");
Nx[0] = par_geti(block,"Nx1");
Nx[1] = par_geti(block,"Nx2");
Nx[2] = par_geti(block,"Nx3");
/* number of dimensions of root level, to test against all other inputs */
nDim=0;
for (i=0; i<3; i++) if (Nx[i]>1) nDim++;
if (nDim==0) ath_error("[init_mesh] None of Nx1,Nx2,Nx3 > 1\n");
/* some error tests of root grid */
for (i=0; i<3; i++) {
if (Nx[i] < 1) {
ath_error("[init_mesh]: Nx%d in %s must be >= 1\n",(i+1),block);
}
if(root_xmax[i] < root_xmin[i]) {
ath_error("[init_mesh]: x%dmax < x%dmin in %s\n",(i+1),block);
}
}
if (nDim==1 && Nx[0]==1) {
ath_error("[init_mesh]:1D requires Nx1>1: in %s Nx1=1,Nx2=%d,Nx3=%d\n",
block,Nx[1],Nx[2]);
}
if (nDim==2 && Nx[2]>1) {ath_error(
"[init_mesh]:2D requires Nx1,Nx2>1: in %s Nx1=%d,Nx2=%d,Nx3=%d\n",
block,Nx[0],Nx[1],Nx[2]);
}
/* Now that everything is OK, set root grid properties in Mesh structure */
for (i=0; i<3; i++) {
pM->Nx[i] = Nx[i];
pM->RootMinX[i] = root_xmin[i];
pM->RootMaxX[i] = root_xmax[i];
pM->dx[i] = (root_xmax[i] - root_xmin[i])/(Real)(Nx[i]);
}
/* Set BC flags on root domain */
pM->BCFlag_ix1 = par_geti_def(block,"bc_ix1",0);
pM->BCFlag_ix2 = par_geti_def(block,"bc_ix2",0);
pM->BCFlag_ix3 = par_geti_def(block,"bc_ix3",0);
pM->BCFlag_ox1 = par_geti_def(block,"bc_ox1",0);
pM->BCFlag_ox2 = par_geti_def(block,"bc_ox2",0);
pM->BCFlag_ox3 = par_geti_def(block,"bc_ox3",0);
}
}
/*--- Step 3: Allocate and initialize domain array. --------------------------*/
/* Allocate memory and set pointers for Domain array in Mesh. Since the
* number of domains nd depends on the level nl, this is a strange array
* because it is not [nl]x[nd]. Rather it is nl pointers to nd[nl] Domains.
* Compare to the calloc_2d_array() function in ath_array.c
*/
if((pM->Domain = (DomainS**)calloc((maxlevel+1),sizeof(DomainS*))) == NULL){
ath_error("[init_mesh] failed to allocate memory for %d Domain pointers\n",
(maxlevel+1));
}
if((pM->Domain[0]=(DomainS*)calloc(num_domains,sizeof(DomainS))) == NULL){
ath_error("[init_mesh] failed to allocate memory for Domains\n");
}
for(nl=1; nl<=maxlevel; nl++)
pM->Domain[nl] = (DomainS*)((unsigned char *)pM->Domain[nl-1] +
pM->DomainsPerLevel[nl-1]*sizeof(DomainS));
/* Loop over every <domain> block in the input file, and initialize each Domain
* in the mesh hierarchy (the Domain array), including the root level Domain */
next_domainid = (int*)calloc_1d_array(pM->NLevels,sizeof(int));
for(nl=0; nl<=maxlevel; nl++) next_domainid[nl] = 0;
for (nblock=1; nblock<=num_domains; nblock++){
sprintf(block,"domain%d",nblock);
/* choose nd coordinate in Domain array for this <domain> block according
* to the order it appears in input */
nl = par_geti(block,"level");
if (next_domainid[nl] > (pM->DomainsPerLevel[nl])-1)
ath_error("[init_mesh]: Exceeded available domain ids on level %d\n",nl);
nd = next_domainid[nl];
next_domainid[nl]++;
irefine = 1;
for (ir=1;ir<=nl;ir++) irefine *= 2; /* C pow fn only takes doubles !! */
/* Initialize level, number, input <domain> block number, and total number of
* cells in this Domain */
pM->Domain[nl][nd].Level = nl;
pM->Domain[nl][nd].DomNumber = nd;
pM->Domain[nl][nd].InputBlock = nblock;
pM->Domain[nl][nd].Nx[0] = par_geti(block,"Nx1");
pM->Domain[nl][nd].Nx[1] = par_geti(block,"Nx2");
pM->Domain[nl][nd].Nx[2] = par_geti(block,"Nx3");
/* error tests: dimensions of domain */
nDim_test=0;
for (i=0; i<3; i++) if (pM->Domain[nl][nd].Nx[i]>1) nDim_test++;
if (nDim_test != nDim) {
ath_error("[init_mesh]: in %s grid is %dD, but in root level it is %dD\n",
block,nDim_test,nDim);
}
for (i=0; i<3; i++) {
if (pM->Domain[nl][nd].Nx[i] < 1) {
ath_error("[init_mesh]: %s/Nx%d = %d must be >= 1\n",
block,(i+1),pM->Domain[nl][nd].Nx[i]);
}
}
if (nDim==1 && pM->Domain[nl][nd].Nx[0]==1) {ath_error(
"[init_mesh]: 1D requires Nx1>1 but in %s Nx1=1,Nx2=%d,Nx3=%d\n",
block,pM->Domain[nl][nd].Nx[1],pM->Domain[nl][nd].Nx[2]);
}
if (nDim==2 && pM->Domain[nl][nd].Nx[2]>1) {ath_error(
"[init_mesh]:2D requires Nx1,Nx2 > 1 but in %s Nx1=%d,Nx2=%d,Nx3=%d\n",
block,pM->Domain[nl][nd].Nx[0],pM->Domain[nl][nd].Nx[1],
pM->Domain[nl][nd].Nx[2]);
}
for (i=0; i<nDim; i++) {
xdiv[i] = div(pM->Domain[nl][nd].Nx[i], irefine);
if (xdiv[i].rem != 0){
ath_error("[init_mesh]: %s/Nx%d = %d must be divisible by %d\n",
block,(i+1),pM->Domain[nl][nd].Nx[i],irefine);
}
}
/* Set cell size based on level of domain, but only if Ncell > 1 */
for (i=0; i<3; i++) {
if (pM->Domain[nl][nd].Nx[i] > 1) {
pM->Domain[nl][nd].dx[i] = pM->dx[i]/(Real)(irefine);
} else {
pM->Domain[nl][nd].dx[i] = pM->dx[i];
}
}
/* Set displacement of Domain from origin. By definition, root level has 0
* displacement, so only read for levels other than root */
for (i=0; i<3; i++) pM->Domain[nl][nd].Disp[i] = 0;
if (nl != 0) {
if (par_exist(block,"iDisp") == 0)
ath_error("[init_mesh]: iDisp does not exist in block %s\n",block);
pM->Domain[nl][nd].Disp[0] = par_geti(block,"iDisp");
/* jDisp=0 if problem is only 1D */
if (pM->Nx[1] > 1) {
if (par_exist(block,"jDisp") == 0)
ath_error("[init_mesh]: jDisp does not exist in block %s\n",block);
pM->Domain[nl][nd].Disp[1] = par_geti(block,"jDisp");
}
/* kDisp=0 if problem is only 2D */
if (pM->Nx[2] > 1) {
if (par_exist(block,"kDisp") == 0)
ath_error("[init_mesh]: kDisp does not exist in block %s\n",block);
pM->Domain[nl][nd].Disp[2] = par_geti(block,"kDisp");
}
}
for (i=0; i<nDim; i++) {
xdiv[i] = div(pM->Domain[nl][nd].Disp[i], irefine);
if (xdiv[i].rem != 0){
ath_error("[init_mesh]: %s/Disp%d = %d must be divisible by %d\n",
block,(i+1),pM->Domain[nl][nd].Disp[i],irefine);
}
}
/* Use cell size and displacement from origin to compute min/max of x1/x2/x3 on
* this domain. Ensure that if Domain touches root grid boundary, the min/max
* of this Domain are set IDENTICAL to values in root grid */
for (i=0; i<3; i++){
if (pM->Domain[nl][nd].Disp[i] == 0) {
pM->Domain[nl][nd].MinX[i] = root_xmin[i];
} else {
pM->Domain[nl][nd].MinX[i] = root_xmin[i]
+ ((Real)(pM->Domain[nl][nd].Disp[i]))*pM->Domain[nl][nd].dx[i];
}
izones= (pM->Domain[nl][nd].Disp[i] + pM->Domain[nl][nd].Nx[i])/irefine;
if(izones == pM->Nx[i]){
pM->Domain[nl][nd].MaxX[i] = root_xmax[i];
} else {
pM->Domain[nl][nd].MaxX[i] = pM->Domain[nl][nd].MinX[i]
+ ((Real)(pM->Domain[nl][nd].Nx[i]))*pM->Domain[nl][nd].dx[i];
}
pM->Domain[nl][nd].RootMinX[i] = root_xmin[i];
pM->Domain[nl][nd].RootMaxX[i] = root_xmax[i];
}
} /*---------- end loop over domain blocks in input file ------------------*/
/*--- Step 4: Check that domains on the same level are non-overlapping. ------*/
/* Compare the integer coordinates of the sides of Domains at the same level.
* Print error if Domains overlap or touch. */
for (nl=maxlevel; nl>0; nl--){ /* start at highest level, and skip root */
for (nd=0; nd<(pM->DomainsPerLevel[nl])-1; nd++){
for (i=0; i<3; i++) {
D1.ijkl[i] = pM->Domain[nl][nd].Disp[i];
D1.ijkr[i] = pM->Domain[nl][nd].Disp[i] + pM->Domain[nl][nd].Nx[i];
}
for (ncd=nd+1; ncd<(pM->DomainsPerLevel[nl]); ncd++) {
for (i=0; i<3; i++) {
D2.ijkl[i] = pM->Domain[nl][ncd].Disp[i];
D2.ijkr[i] = pM->Domain[nl][ncd].Disp[i] + pM->Domain[nl][ncd].Nx[i];
}
if (D1.ijkl[0] <= D2.ijkr[0] && D1.ijkr[0] >= D2.ijkl[0] &&
D1.ijkl[1] <= D2.ijkr[1] && D1.ijkr[1] >= D2.ijkl[1] &&
D1.ijkl[2] <= D2.ijkr[2] && D1.ijkr[2] >= D2.ijkl[2]){
ath_error("Domains %d and %d at same level overlap or touch\n",
pM->Domain[nl][nd].InputBlock,pM->Domain[nl][ncd].InputBlock);
}
}
}}
/*--- Step 5: Check for illegal geometry of child/parent Domains -------------*/
for (nl=0; nl<maxlevel; nl++){
for (nd=0; nd<pM->DomainsPerLevel[nl]; nd++){
pD = (DomainS*)&(pM->Domain[nl][nd]); /* set ptr to this Domain */
for (i=0; i<3; i++) {
D1.ijkl[i] = pD->Disp[i];
D1.ijkr[i] = pD->Disp[i] + pD->Nx[i];
}
for (ncd=0; ncd<pM->DomainsPerLevel[nl+1]; ncd++){
pCD = (DomainS*)&(pM->Domain[nl+1][ncd]); /* set ptr to potential child*/
for (i=0; i<3; i++) {
D2.ijkl[i] = pCD->Disp[i]/2;
D2.ijkr[i] = 1;
if (pCD->Nx[i] > 1) D2.ijkr[i] = (pCD->Disp[i] + pCD->Nx[i])/2;
}
if (D1.ijkl[0] <= D2.ijkr[0] && D1.ijkr[0] >= D2.ijkl[0] &&
D1.ijkl[1] <= D2.ijkr[1] && D1.ijkr[1] >= D2.ijkl[1] &&
D1.ijkl[2] <= D2.ijkr[2] && D1.ijkr[2] >= D2.ijkl[2]){
/* check for child Domains that touch edge of parent (and are not at edges of
* root), extends past edge of parent, or are < nghost/2 from edge of parent */
for (dim=0; dim<nDim; dim++){
irefine = 1;
for (i=1;i<=nl;i++) irefine *= 2; /* parent refinement lev */
roffset = (pCD->Disp[dim] + pCD->Nx[dim])/(2*irefine) - pM->Nx[dim];
if (((D2.ijkl[dim] == D1.ijkl[dim]) && (pD->Disp[dim] != 0)) ||
((D2.ijkr[dim] == D1.ijkr[dim]) && (roffset != 0))) {
for (i=0; i<nDim; i++) {
D1.ijkl[i] /= irefine; /* report indices scaled to root */
D1.ijkr[i] /= irefine;
D2.ijkl[i] /= irefine;
D2.ijkr[i] /= irefine;
}
ath_error("[init_mesh] child Domain D%d[is,ie,js,je,ks,ke]=[%d %d %d %d %d %d] touches parent D%d[is,ie,js,je,ks,ke]=[%d %d %d %d %d %d]\n",
pCD->InputBlock,D2.ijkl[0],D2.ijkr[0],D2.ijkl[1],D2.ijkr[1],
D2.ijkl[2],D2.ijkr[2],pD->InputBlock,D1.ijkl[0],D1.ijkr[0],
D1.ijkl[1],D1.ijkr[1],D1.ijkl[2],D1.ijkr[2]);
}
if ((D2.ijkl[dim] < D1.ijkl[dim]) ||
(D2.ijkr[dim] > D1.ijkr[dim])) {
for (i=0; i<nDim; i++) {
D1.ijkl[i] /= irefine; /* report indices scaled to root */
D1.ijkr[i] /= irefine;
D2.ijkl[i] /= irefine;
D2.ijkr[i] /= irefine;
}
ath_error("[init_mesh] child Domain D%d[is,ie,js,je,ks,ke]=[%d %d %d %d %d %d] extends past parent D%d[is,ie,js,je,ks,ke]=[%d %d %d %d %d %d]\n",
pCD->InputBlock,D2.ijkl[0],D2.ijkr[0],D2.ijkl[1],D2.ijkr[1],
D2.ijkl[2],D2.ijkr[2],pD->InputBlock,D1.ijkl[0],D1.ijkr[0],
D1.ijkl[1],D1.ijkr[1],D1.ijkl[2],D1.ijkr[2]);
}
if (((2*(D2.ijkl[dim]-D1.ijkl[dim]) < nghost) &&
(2*(D2.ijkl[dim]-D1.ijkl[dim]) > 0 )) ||
((2*(D1.ijkr[dim]-D2.ijkr[dim]) < nghost) &&
(2*(D1.ijkr[dim]-D2.ijkr[dim]) > 0 ))) {
for (i=0; i<nDim; i++) {
D1.ijkl[i] /= irefine; /* report indices scaled to root */
D1.ijkr[i] /= irefine;
D2.ijkl[i] /= irefine;
D2.ijkr[i] /= irefine;
}
ath_error("[init_mesh] child Domain D%d[is,ie,js,je,ks,ke]=[%d %d %d %d %d %d] closer than nghost/2 to parent D%d[is,ie,js,je,ks,ke]=[%d %d %d %d %d %d]\n",
pCD->InputBlock,D2.ijkl[0],D2.ijkr[0],D2.ijkl[1],D2.ijkr[1],
D2.ijkl[2],D2.ijkr[2],pD->InputBlock,D1.ijkl[0],D1.ijkr[0],
D1.ijkl[1],D1.ijkr[1],D1.ijkl[2],D1.ijkr[2]);
}
}
}
}
}}
/*--- Step 6: Divide each Domain into Grids, and allocate to processor(s) ---*/
/* Get the number of Grids in each direction. These are given either in the
* <domain?> block in the input file, or by automatic decomposition given the
* number of processor desired for this domain. */
next_procID = 0; /* start assigning processors to Grids at ID=0 */
for (nl=0; nl<=maxlevel; nl++){
for (nd=0; nd<(pM->DomainsPerLevel[nl]); nd++){
pD = (DomainS*)&(pM->Domain[nl][nd]); /* set ptr to this Domain */
sprintf(block,"domain%d",pD->InputBlock);
#ifndef MPI_PARALLEL
for (i=0; i<3; i++) pD->NGrid[i] = 1;
#else
nproc = par_geti_def(block,"AutoWithNProc",0);
/* Read layout of Grids from input file */
if (nproc == 0){
pD->NGrid[0] = par_geti_def(block,"NGrid_x1",1);
pD->NGrid[1] = par_geti_def(block,"NGrid_x2",1);
pD->NGrid[2] = par_geti_def(block,"NGrid_x3",1);
if (pD->NGrid[0] == 0)
ath_error("[init_mesh] Cannot enter NGrid_x1=0 in %s\n",block);
if (pD->NGrid[1] == 0)
ath_error("[init_mesh] Cannot enter NGrid_x2=0 in %s\n",block);
if (pD->NGrid[2] == 0)
ath_error("[init_mesh] Cannot enter NGrid_x3=0 in %s\n",block);
}
/* Auto decompose Domain into Grids. To use this option, set "AutoWithNProc"
* to number of processors desired for this Domain */
else if (nproc > 0){
if(dom_decomp(pD->Nx[0],pD->Nx[1],pD->Nx[2],nproc,
&(pD->NGrid[0]),&(pD->NGrid[1]),&(pD->NGrid[2])))
ath_error("[init_mesh]: Error in automatic Domain decomposition\n");
/* Store the domain decomposition in the par database */
par_seti(block,"NGrid_x1","%d",pD->NGrid[0],"x1 decomp");
par_seti(block,"NGrid_x2","%d",pD->NGrid[1],"x2 decomp");
par_seti(block,"NGrid_x3","%d",pD->NGrid[2],"x3 decomp");
} else {
ath_error("[init_mesh] invalid AutoWithNProc=%d in %s\n",nproc,block);
}
#endif /* MPI_PARALLEL */
/* test for conflicts between number of grids and dimensionality */
for (i=0; i<3; i++){
if(pD->NGrid[i] > 1 && pD->Nx[i] <= 1)
ath_error("[init_mesh]: %s/NGrid_x%d = %d and Nx%d = %d\n",block,
(i+1),pD->NGrid[i],(i+1),pD->Nx[i]);
}
/* check there are more processors than Grids needed by this Domain. */
nproc = (pD->NGrid[0])*(pD->NGrid[1])*(pD->NGrid[2]);
if(nproc > Nproc_Comm_world) ath_error(
"[init_mesh]: %d Grids requested by block %s and only %d procs\n"
,nproc,block,Nproc_Comm_world);
/* Build 3D array to store data on Grids in this Domain */
if ((pD->GData = (GridsDataS***)calloc_3d_array(pD->NGrid[2],pD->NGrid[1],
pD->NGrid[0],sizeof(GridsDataS))) == NULL) ath_error(
"[init_mesh]: GData calloc returned a NULL pointer\n");
/* Divide the domain into blocks */
for (i=0; i<3; i++) {
xdiv[i] = div(pD->Nx[i], pD->NGrid[i]);
}
/* Distribute cells in Domain to Grids. Assign each Grid to a processor ID in
* the MPI_COMM_WORLD communicator. For single-processor jobs, there is only
* one ID=0, and the GData array will have only one element. */
for(n=0; n<(pD->NGrid[2]); n++){
for(m=0; m<(pD->NGrid[1]); m++){
for(l=0; l<(pD->NGrid[0]); l++){
for (i=0; i<3; i++) pD->GData[n][m][l].Nx[i] = xdiv[i].quot;
pD->GData[n][m][l].ID_Comm_world = next_procID++;
if (next_procID > ((Nproc_Comm_world)-1)) next_procID=0;
}}}
/* If the Domain is not evenly divisible put the extra cells on the first
* Grids in each direction, maintaining the load balance as much as possible */
for(n=0; n<(pD->NGrid[2]); n++){
for(m=0; m<(pD->NGrid[1]); m++){
for(l=0; l<xdiv[0].rem; l++){
pD->GData[n][m][l].Nx[0]++;
}
}
}
xdiv[0].rem=0;
for(n=0; n<(pD->NGrid[2]); n++){
for(m=0; m<xdiv[1].rem; m++) {
for(l=0; l<(pD->NGrid[0]); l++){
pD->GData[n][m][l].Nx[1]++;
}
}
}
xdiv[1].rem=0;
for(n=0; n<xdiv[2].rem; n++){
for(m=0; m<(pD->NGrid[1]); m++){
for(l=0; l<(pD->NGrid[0]); l++){
pD->GData[n][m][l].Nx[2]++;
}
}
}
xdiv[2].rem=0;
/* Initialize displacements from origin for each Grid */
for(n=0; n<(pD->NGrid[2]); n++){
for(m=0; m<(pD->NGrid[1]); m++){
pD->GData[n][m][0].Disp[0] = pD->Disp[0];
for(l=1; l<(pD->NGrid[0]); l++){
pD->GData[n][m][l].Disp[0] = pD->GData[n][m][l-1].Disp[0] +
pD->GData[n][m][l-1].Nx[0];
}
}
}
for(n=0; n<(pD->NGrid[2]); n++){
for(l=0; l<(pD->NGrid[0]); l++){
pD->GData[n][0][l].Disp[1] = pD->Disp[1];
for(m=1; m<(pD->NGrid[1]); m++){
pD->GData[n][m][l].Disp[1] = pD->GData[n][m-1][l].Disp[1] +
pD->GData[n][m-1][l].Nx[1];
}
}
}
for(m=0; m<(pD->NGrid[1]); m++){
for(l=0; l<(pD->NGrid[0]); l++){
pD->GData[0][m][l].Disp[2] = pD->Disp[2];
for(n=1; n<(pD->NGrid[2]); n++){
pD->GData[n][m][l].Disp[2] = pD->GData[n-1][m][l].Disp[2] +
pD->GData[n-1][m][l].Nx[2];
}
}
}
} /* end loop over ndomains */
} /* end loop over nlevels */
/* check that total number of Grids was partitioned evenly over total number of
* MPI processes available (equal to one for single processor jobs) */
if (next_procID != 0)
ath_error("[init_mesh]:total # of Grids != total # of MPI procs\n");
/*--- Step 7: Allocate a Grid for each Domain on this processor --------------*/
for (nl=0; nl<=maxlevel; nl++){
for (nd=0; nd<(pM->DomainsPerLevel[nl]); nd++){
pD = (DomainS*)&(pM->Domain[nl][nd]); /* set ptr to this Domain */
sprintf(block,"domain%d",pD->InputBlock);
pD->Grid = NULL;
/* Loop over GData array, and if there is a Grid assigned to this proc,
* allocate it */
for(n=0; n<(pD->NGrid[2]); n++){
for(m=0; m<(pD->NGrid[1]); m++){
for(l=0; l<(pD->NGrid[0]); l++){
if (pD->GData[n][m][l].ID_Comm_world == myID_Comm_world) {
if ((pD->Grid = (GridS*)malloc(sizeof(GridS))) == NULL)
ath_error("[init_mesh]: Failed to malloc a Grid for %s\n",block);
}
}}}
}
}
/*--- Step 8: Create an MPI Communicator for each Domain ---------------------*/
#ifdef MPI_PARALLEL
/* Allocate memory for ranks[] array */
max_rank = 0;
for (nl=0; nl<=maxlevel; nl++){
for (nd=0; nd<(pM->DomainsPerLevel[nl]); nd++){
pD = (DomainS*)&(pM->Domain[nl][nd]); /* set ptr to this Domain */
Nranks = (pD->NGrid[0])*(pD->NGrid[1])*(pD->NGrid[2]);
max_rank = MAX(max_rank, Nranks);
}}
ranks = (int*)calloc_1d_array(max_rank,sizeof(int));
/* Extract handle of group defined by MPI_COMM_WORLD communicator */
ierr = MPI_Comm_group(MPI_COMM_WORLD, &world_group);
for (nl=0; nl<=maxlevel; nl++){
for (nd=0; nd<(pM->DomainsPerLevel[nl]); nd++){
pD = (DomainS*)&(pM->Domain[nl][nd]); /* set ptr to this Domain */
/* Load integer array with ranks of processes in MPI_COMM_WORLD updating Grids
* on this Domain. The ranks of these processes in the new Comm_Domain
* communicator created below are equal to the indices of this array */
Nranks = (pD->NGrid[0])*(pD->NGrid[1])*(pD->NGrid[2]);
groupn = 0;
for(n=0; n<(pD->NGrid[2]); n++){
for(m=0; m<(pD->NGrid[1]); m++){
for(l=0; l<(pD->NGrid[0]); l++){
ranks[groupn] = pD->GData[n][m][l].ID_Comm_world;
pD->GData[n][m][l].ID_Comm_Domain = groupn;
groupn++;
}}}
/* Create a new group for this Domain; use it to create a new communicator */
ierr = MPI_Group_incl(world_group,Nranks,ranks,&(pD->Group_Domain));
ierr = MPI_Comm_create(MPI_COMM_WORLD,pD->Group_Domain,&(pD->Comm_Domain));
}}
free_1d_array(ranks);
#endif /* MPI_PARALLEL */
/*--- Step 9: Create MPI Communicators for Child and Parent Domains ----------*/
#if defined(MPI_PARALLEL) && defined(STATIC_MESH_REFINEMENT)
/* Initialize communicators to NULL, since not all Domains use them, and
* allocate memory for ranks[] array */
for (nl=0; nl<=maxlevel; nl++){
for (nd=0; nd<(pM->DomainsPerLevel[nl]); nd++){
pM->Domain[nl][nd].Comm_Parent = MPI_COMM_NULL;
pM->Domain[nl][nd].Comm_Children = MPI_COMM_NULL;
}
}
if (maxlevel > 0) {
ranks = (int*)calloc_1d_array(Nproc_Comm_world,sizeof(int));
}
/* For each Domain up to (maxlevel-1), initialize communicator with children */
for (nl=0; nl<maxlevel; nl++){
for (nd=0; nd<pM->DomainsPerLevel[nl]; nd++){
pD = (DomainS*)&(pM->Domain[nl][nd]); /* set ptr to this Domain */
child_found = 0;
/* Load integer array with ranks of processes in MPI_COMM_WORLD updating Grids
* on this Domain, in case a child Domain is found. Set IDs in Comm_Children
* communicator based on index in rank array, in case child found. If no
* child is found these ranks will never be used. */
Nranks = (pD->NGrid[0])*(pD->NGrid[1])*(pD->NGrid[2]);
groupn = 0;
for(n=0; n<(pD->NGrid[2]); n++){
for(m=0; m<(pD->NGrid[1]); m++){
for(l=0; l<(pD->NGrid[0]); l++){
ranks[groupn] = pD->GData[n][m][l].ID_Comm_world;
pD->GData[n][m][l].ID_Comm_Children = groupn;
groupn++;
}}}
/* edges of this Domain */
for (i=0; i<3; i++) {
D1.ijkl[i] = pD->Disp[i];
D1.ijkr[i] = pD->Disp[i] + pD->Nx[i];
}
/* Loop over all Domains at next level, looking for children of this Domain */
for (ncd=0; ncd<pM->DomainsPerLevel[nl+1]; ncd++){
pCD = (DomainS*)&(pM->Domain[nl+1][ncd]); /* set ptr to potential child*/
/* edges of potential child Domain */
for (i=0; i<3; i++) {
D2.ijkl[i] = pCD->Disp[i]/2;
D2.ijkr[i] = 1;
if (pCD->Nx[i] > 1) D2.ijkr[i] = (pCD->Disp[i] + pCD->Nx[i])/2;
}
if (D1.ijkl[0] < D2.ijkr[0] && D1.ijkr[0] > D2.ijkl[0] &&
D1.ijkl[1] < D2.ijkr[1] && D1.ijkr[1] > D2.ijkl[1] &&
D1.ijkl[2] < D2.ijkr[2] && D1.ijkr[2] > D2.ijkl[2]){
child_found = 1;
/* Child found. Add child processors to ranks array, but only if they are
* different from processes currently there (including parent and any previously
* found children). Set IDs associated with Comm_Parent communicator, since on
* the child Domain this is the same as the Comm_Children communicator on the
* parent Domain */
for(n=0; n<(pCD->NGrid[2]); n++){
for(m=0; m<(pCD->NGrid[1]); m++){
for(l=0; l<(pCD->NGrid[0]); l++){
irank = -1;
for (i=0; i<Nranks; i++) {
if(pCD->GData[n][m][l].ID_Comm_world == ranks[i]) irank = i;
}
if (irank == -1) {
ranks[groupn] = pCD->GData[n][m][l].ID_Comm_world;
pCD->GData[n][m][l].ID_Comm_Parent = groupn;
groupn++;
Nranks++;
} else {
pCD->GData[n][m][l].ID_Comm_Parent = ranks[irank];
}
}}}
}
}
/* After looping over all potential child Domains, create a new communicator if
* a child was found */
if (child_found == 1) {
ierr = MPI_Group_incl(world_group, Nranks, ranks, &(pD->Group_Children));
ierr = MPI_Comm_create(MPI_COMM_WORLD,pD->Group_Children,
&pD->Comm_Children);
/* Loop over children to set Comm_Parent communicators */
for (ncd=0; ncd<pM->DomainsPerLevel[nl+1]; ncd++){
pCD = (DomainS*)&(pM->Domain[nl+1][ncd]);
for (i=0; i<3; i++) {
D2.ijkl[i] = pCD->Disp[i]/2;
D2.ijkr[i] = 1;
if (pCD->Nx[i] > 1) D2.ijkr[i] = (pCD->Disp[i] + pCD->Nx[i])/2;
}
if (D1.ijkl[0] < D2.ijkr[0] && D1.ijkr[0] > D2.ijkl[0] &&
D1.ijkl[1] < D2.ijkr[1] && D1.ijkr[1] > D2.ijkl[1] &&
D1.ijkl[2] < D2.ijkr[2] && D1.ijkr[2] > D2.ijkl[2]){
pCD->Comm_Parent = pD->Comm_Children;
}
}
}
}}
#endif /* MPI_PARALLEL & STATIC_MESH_REFINEMENT */
free(next_domainid);
return;
}
int main(int argc,char* argv[])
{
int rank;
int size;
int new_rank; /* ranks are always contiguous, starting at 0 */
int sendbuf;
int recvbuf;
int count;
int ranks1[4]={0,1,2,3}; /* list of process ranks for 1st new group */
int ranks2[4]={4,5,6,7}; /* list of process ranks for 2nd new group */
MPI_Group orig_group; /* opaque group object from MPI_COMM_WORLD */
MPI_Group new_group; /* new group, to be created */
MPI_Comm new_comm; /* new communicator, to be created */
/* standard startup */
MPI_Init(&argc,&argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &size);
/* need to impose of certain size of MPI_COMM_WORLD
** as we've hardwired the list of process ranks in
** the new groups */
if(size != NPROCS) {
fprintf(stderr,"Error: Must have %d processes in MPI_COMM_WORLD\n", NPROCS);
MPI_Abort(MPI_COMM_WORLD,1);
}
/* going to broadcast my rank amongst the default communicator */
sendbuf = rank;
count = 1;
/* Extract the original group handle, as we can only make new
** groups in MPI, through reference to existing groups */
MPI_Comm_group(MPI_COMM_WORLD, &orig_group);
/* Divide processes into two distinct groups based upon rank.
** We're relying on integer division here, so let's be caseful! */
if (rank < NPROCS/2) {
MPI_Group_incl(orig_group, NPROCS/2, ranks1, &new_group);
}
else {
MPI_Group_incl(orig_group, NPROCS/2, ranks2, &new_group);
}
/* Create new communicator and then perform collective communications.
** Notice that all processes have called the group and communicator
** creation functions. */
MPI_Comm_create(MPI_COMM_WORLD, new_group, &new_comm);
/* Total the ranks--as associated with MPI_COMM_WORLD--within the newer,
** smaller communicators */
MPI_Allreduce(&sendbuf, &recvbuf, count, MPI_INT, MPI_SUM, new_comm);
/* get rank in new group */
MPI_Group_rank (new_group, &new_rank);
/* all processes print to screen */
printf("rank= %d newrank= %d recvbuf= %d\n",rank,new_rank,recvbuf);
MPI_Finalize();
return EXIT_SUCCESS;
}
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 np_l,np_li,lnsize;
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;
}
/* ------------------------------------ *\
Divide MPI nodes into logical nodes,
if DDI_LOGICAL_NODE_SIZE requests.
\* ------------------------------------ */
if(me == 0) {
if(getenv("DDI_LOGICAL_NODE_SIZE")) {
lnsize = atoi(getenv("DDI_LOGICAL_NODE_SIZE"));
fprintf(stdout,"DDI running over MPI found environment variable DDI_LOGICAL_NODE_SIZE, so\n");
fprintf(stdout,"physical nodes will be partitioned into logical nodes containing %i core(s).\n",lnsize);
} else {
lnsize = 0;
}
}
MPI_Bcast(&lnsize,1,MPI_INT,0,MPI_COMM_WORLD);
/* We only know how to handle either no d.s. or 1 d.s. per c.p. */
if(lnsize>0 &&
(np_local>lnsize && nd==0 || np_local>lnsize*2 && nd==nc)) {
for(i=0;i<np_local;i++) {
if(ranks[i]==me) {
np_l=lnsize; if(nd==nc) np_l*=2;
np_li=np_local; j=i/np_l; j*=np_l;
for(np_local=0; np_local<np_l && j<np_li; np_local++) {
/* Find other fellow node dwellers to be grouped.
Note that this always takes the closest in MPI rank. */
ranks[np_local]=ranks[j++];
}
break;
}
}
}
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"))
}
/*
* Return an intercomm; set isLeftGroup to 1 if the calling process is
* a member of the "left" group.
*/
int MTestGetIntercomm( MPI_Comm *comm, int *isLeftGroup, int min_size )
{
int size, rank, remsize, merr;
int done=0;
MPI_Comm mcomm = MPI_COMM_NULL;
MPI_Comm mcomm2 = MPI_COMM_NULL;
int rleader;
/* The while loop allows us to skip communicators that are too small.
MPI_COMM_NULL is always considered large enough. The size is
the sum of the sizes of the local and remote groups */
while (!done) {
*comm = MPI_COMM_NULL;
*isLeftGroup = 0;
interCommName = "MPI_COMM_NULL";
switch (interCommIdx) {
case 0:
/* Split comm world in half */
merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
if (merr) MTestPrintError( merr );
merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
if (merr) MTestPrintError( merr );
if (size > 1) {
merr = MPI_Comm_split( MPI_COMM_WORLD, (rank < size/2), rank,
&mcomm );
if (merr) MTestPrintError( merr );
if (rank == 0) {
rleader = size/2;
}
else if (rank == size/2) {
rleader = 0;
}
else {
/* Remote leader is signficant only for the processes
designated local leaders */
rleader = -1;
}
*isLeftGroup = rank < size/2;
merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD, rleader,
12345, comm );
if (merr) MTestPrintError( merr );
interCommName = "Intercomm by splitting MPI_COMM_WORLD";
}
else
*comm = MPI_COMM_NULL;
break;
case 1:
/* Split comm world in to 1 and the rest */
merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
if (merr) MTestPrintError( merr );
merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
if (merr) MTestPrintError( merr );
if (size > 1) {
merr = MPI_Comm_split( MPI_COMM_WORLD, rank == 0, rank,
&mcomm );
if (merr) MTestPrintError( merr );
if (rank == 0) {
rleader = 1;
}
else if (rank == 1) {
rleader = 0;
}
else {
/* Remote leader is signficant only for the processes
designated local leaders */
rleader = -1;
}
*isLeftGroup = rank == 0;
merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD,
rleader, 12346, comm );
if (merr) MTestPrintError( merr );
interCommName = "Intercomm by splitting MPI_COMM_WORLD into 1, rest";
}
else
*comm = MPI_COMM_NULL;
break;
case 2:
/* Split comm world in to 2 and the rest */
merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
if (merr) MTestPrintError( merr );
merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
if (merr) MTestPrintError( merr );
if (size > 3) {
merr = MPI_Comm_split( MPI_COMM_WORLD, rank < 2, rank,
&mcomm );
if (merr) MTestPrintError( merr );
if (rank == 0) {
rleader = 2;
}
else if (rank == 2) {
rleader = 0;
}
else {
/* Remote leader is signficant only for the processes
designated local leaders */
rleader = -1;
}
*isLeftGroup = rank < 2;
merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD,
rleader, 12347, comm );
if (merr) MTestPrintError( merr );
interCommName = "Intercomm by splitting MPI_COMM_WORLD into 2, rest";
}
else
*comm = MPI_COMM_NULL;
break;
case 3:
/* Split comm world in half, then dup */
merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
if (merr) MTestPrintError( merr );
merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
if (merr) MTestPrintError( merr );
if (size > 1) {
merr = MPI_Comm_split( MPI_COMM_WORLD, (rank < size/2), rank,
&mcomm );
if (merr) MTestPrintError( merr );
if (rank == 0) {
rleader = size/2;
}
else if (rank == size/2) {
rleader = 0;
}
else {
/* Remote leader is signficant only for the processes
designated local leaders */
rleader = -1;
}
*isLeftGroup = rank < size/2;
merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD, rleader,
12345, comm );
if (merr) MTestPrintError( merr );
/* avoid leaking after assignment below */
merr = MPI_Comm_free( &mcomm );
if (merr) MTestPrintError( merr );
/* now dup, some bugs only occur for dup's of intercomms */
mcomm = *comm;
merr = MPI_Comm_dup(mcomm, comm);
if (merr) MTestPrintError( merr );
interCommName = "Intercomm by splitting MPI_COMM_WORLD then dup'ing";
}
else
*comm = MPI_COMM_NULL;
break;
case 4:
/* Split comm world in half, form intercomm, then split that intercomm */
merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
if (merr) MTestPrintError( merr );
merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
if (merr) MTestPrintError( merr );
if (size > 1) {
merr = MPI_Comm_split( MPI_COMM_WORLD, (rank < size/2), rank,
&mcomm );
if (merr) MTestPrintError( merr );
if (rank == 0) {
rleader = size/2;
}
else if (rank == size/2) {
rleader = 0;
}
else {
/* Remote leader is signficant only for the processes
designated local leaders */
rleader = -1;
}
*isLeftGroup = rank < size/2;
merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD, rleader,
12345, comm );
if (merr) MTestPrintError( merr );
/* avoid leaking after assignment below */
merr = MPI_Comm_free( &mcomm );
if (merr) MTestPrintError( merr );
/* now split, some bugs only occur for splits of intercomms */
mcomm = *comm;
rank = MPI_Comm_rank(mcomm, &rank);
if (merr) MTestPrintError( merr );
/* this split is effectively a dup but tests the split code paths */
merr = MPI_Comm_split(mcomm, 0, rank, comm);
if (merr) MTestPrintError( merr );
interCommName = "Intercomm by splitting MPI_COMM_WORLD then then splitting again";
}
else
*comm = MPI_COMM_NULL;
break;
case 5:
/* split comm world in half discarding rank 0 on the "left"
* communicator, then form them into an intercommunicator */
merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
if (merr) MTestPrintError( merr );
merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
if (merr) MTestPrintError( merr );
if (size >= 4) {
int color = (rank < size/2 ? 0 : 1);
if (rank == 0)
color = MPI_UNDEFINED;
merr = MPI_Comm_split( MPI_COMM_WORLD, color, rank, &mcomm );
if (merr) MTestPrintError( merr );
if (rank == 1) {
rleader = size/2;
}
else if (rank == (size/2)) {
rleader = 1;
}
else {
/* Remote leader is signficant only for the processes
designated local leaders */
rleader = -1;
}
*isLeftGroup = rank < size/2;
if (rank != 0) { /* 0's mcomm is MPI_COMM_NULL */
merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD, rleader, 12345, comm );
if (merr) MTestPrintError( merr );
}
interCommName = "Intercomm by splitting MPI_COMM_WORLD (discarding rank 0 in the left group) then MPI_Intercomm_create'ing";
}
else {
*comm = MPI_COMM_NULL;
}
break;
case 6:
/* Split comm world in half then form them into an
* intercommunicator. Then discard rank 0 from each group of the
* intercomm via MPI_Comm_create. */
merr = MPI_Comm_rank( MPI_COMM_WORLD, &rank );
if (merr) MTestPrintError( merr );
merr = MPI_Comm_size( MPI_COMM_WORLD, &size );
if (merr) MTestPrintError( merr );
if (size >= 4) {
MPI_Group oldgroup, newgroup;
int ranks[1];
int color = (rank < size/2 ? 0 : 1);
merr = MPI_Comm_split( MPI_COMM_WORLD, color, rank, &mcomm );
if (merr) MTestPrintError( merr );
if (rank == 0) {
rleader = size/2;
}
else if (rank == (size/2)) {
rleader = 0;
}
else {
/* Remote leader is signficant only for the processes
designated local leaders */
rleader = -1;
}
*isLeftGroup = rank < size/2;
merr = MPI_Intercomm_create( mcomm, 0, MPI_COMM_WORLD, rleader, 12345, &mcomm2 );
if (merr) MTestPrintError( merr );
/* We have an intercomm between the two halves of comm world. Now create
* a new intercomm that removes rank 0 on each side. */
merr = MPI_Comm_group(mcomm2, &oldgroup);
if (merr) MTestPrintError( merr );
ranks[0] = 0;
merr = MPI_Group_excl(oldgroup, 1, ranks, &newgroup);
if (merr) MTestPrintError( merr );
merr = MPI_Comm_create(mcomm2, newgroup, comm);
if (merr) MTestPrintError( merr );
merr = MPI_Group_free(&oldgroup);
if (merr) MTestPrintError( merr );
merr = MPI_Group_free(&newgroup);
if (merr) MTestPrintError( merr );
interCommName = "Intercomm by splitting MPI_COMM_WORLD then discarding 0 ranks with MPI_Comm_create";
}
else {
*comm = MPI_COMM_NULL;
}
break;
default:
*comm = MPI_COMM_NULL;
interCommIdx = -1;
break;
}
if (*comm != MPI_COMM_NULL) {
merr = MPI_Comm_size( *comm, &size );
if (merr) MTestPrintError( merr );
merr = MPI_Comm_remote_size( *comm, &remsize );
if (merr) MTestPrintError( merr );
if (size + remsize >= min_size) done = 1;
}
else {
interCommName = "MPI_COMM_NULL";
done = 1;
}
/* we are only done if all processes are done */
MPI_Allreduce(MPI_IN_PLACE, &done, 1, MPI_INT, MPI_LAND, MPI_COMM_WORLD);
/* Advance the comm index whether we are done or not, otherwise we could
* spin forever trying to allocate a too-small communicator over and
* over again. */
interCommIdx++;
if (!done && *comm != MPI_COMM_NULL) {
/* avoid leaking communicators */
merr = MPI_Comm_free(comm);
if (merr) MTestPrintError(merr);
}
/* cleanup for common temp objects */
if (mcomm != MPI_COMM_NULL) {
merr = MPI_Comm_free(&mcomm);
if (merr) MTestPrintError( merr );
}
if (mcomm2 != MPI_COMM_NULL) {
merr = MPI_Comm_free(&mcomm2);
if (merr) MTestPrintError( merr );
}
}
return interCommIdx;
}
int PIOc_Init_Intracomm(const MPI_Comm comp_comm,
const int num_iotasks, const int stride,
const int base,const int rearr, int *iosysidp)
{
iosystem_desc_t *iosys;
int ierr = PIO_NOERR;
int ustride;
int lbase;
int mpierr;
iosys = (iosystem_desc_t *) malloc(sizeof(iosystem_desc_t));
/* Copy the computation communicator into union_comm. */
mpierr = MPI_Comm_dup(comp_comm, &iosys->union_comm);
CheckMPIReturn(mpierr, __FILE__, __LINE__);
if (mpierr)
ierr = PIO_EIO;
/* Copy the computation communicator into comp_comm. */
if (!ierr)
{
mpierr = MPI_Comm_dup(comp_comm, &iosys->comp_comm);
CheckMPIReturn(mpierr, __FILE__, __LINE__);
if (mpierr)
ierr = PIO_EIO;
}
if (!ierr)
{
iosys->my_comm = iosys->comp_comm;
iosys->io_comm = MPI_COMM_NULL;
iosys->intercomm = MPI_COMM_NULL;
iosys->error_handler = PIO_INTERNAL_ERROR;
iosys->async_interface= false;
iosys->compmaster = 0;
iosys->iomaster = 0;
iosys->ioproc = false;
iosys->default_rearranger = rearr;
iosys->num_iotasks = num_iotasks;
ustride = stride;
/* Find MPI rank and number of tasks in comp_comm communicator. */
CheckMPIReturn(MPI_Comm_rank(iosys->comp_comm, &(iosys->comp_rank)),__FILE__,__LINE__);
CheckMPIReturn(MPI_Comm_size(iosys->comp_comm, &(iosys->num_comptasks)),__FILE__,__LINE__);
if(iosys->comp_rank==0)
iosys->compmaster = MPI_ROOT;
/* Ensure that settings for number of computation tasks, number
* of IO tasks, and the stride are reasonable. */
if((iosys->num_comptasks == 1) && (num_iotasks*ustride > 1)) {
// This is a serial run with a bad configuration. Set up a single task.
fprintf(stderr, "PIO_TP PIOc_Init_Intracomm reset stride and tasks.\n");
iosys->num_iotasks = 1;
ustride = 1;
}
if((iosys->num_iotasks < 1) || ((iosys->num_iotasks*ustride) > iosys->num_comptasks)){
fprintf(stderr, "PIO_TP PIOc_Init_Intracomm error\n");
fprintf(stderr, "num_iotasks=%d, ustride=%d, num_comptasks=%d\n", num_iotasks, ustride, iosys->num_comptasks);
return PIO_EBADID;
}
/* Create an array that holds the ranks of the tasks to be used for IO. */
iosys->ioranks = (int *) calloc(sizeof(int), iosys->num_iotasks);
for(int i=0;i< iosys->num_iotasks; i++){
iosys->ioranks[i] = (base + i*ustride) % iosys->num_comptasks;
if(iosys->ioranks[i] == iosys->comp_rank)
iosys->ioproc = true;
}
iosys->ioroot = iosys->ioranks[0];
/* Create an MPI info object. */
CheckMPIReturn(MPI_Info_create(&(iosys->info)),__FILE__,__LINE__);
iosys->info = MPI_INFO_NULL;
if(iosys->comp_rank == iosys->ioranks[0])
iosys->iomaster = MPI_ROOT;
/* Create a group for the computation tasks. */
CheckMPIReturn(MPI_Comm_group(iosys->comp_comm, &(iosys->compgroup)),__FILE__,__LINE__);
/* Create a group for the IO tasks. */
CheckMPIReturn(MPI_Group_incl(iosys->compgroup, iosys->num_iotasks, iosys->ioranks,
&(iosys->iogroup)),__FILE__,__LINE__);
/* Create an MPI communicator for the IO tasks. */
CheckMPIReturn(MPI_Comm_create(iosys->comp_comm, iosys->iogroup, &(iosys->io_comm)),__FILE__,__LINE__);
/* For the tasks that are doing IO, get their rank. */
if(iosys->ioproc)
CheckMPIReturn(MPI_Comm_rank(iosys->io_comm, &(iosys->io_rank)),__FILE__,__LINE__);
else
iosys->io_rank = -1;
iosys->union_rank = iosys->comp_rank;
/* Add this iosys struct to the list in the PIO library. */
*iosysidp = pio_add_to_iosystem_list(iosys);
pio_get_env();
/* allocate buffer space for compute nodes */
compute_buffer_init(*iosys);
}
return ierr;
}
int main(int argc, char *argv[]) {
int numprocs, myrank, grank;
MPI_Init(&argc, &argv);
MPI_Comm_size(MPI_COMM_WORLD, &numprocs);
MPI_Comm_rank(MPI_COMM_WORLD, &myrank);
MPI_Group orig_group, new_group;
MPI_Comm new_comm;
/* Extract the original group handle */
MPI_Comm_group(MPI_COMM_WORLD, &orig_group);
double sendTime, recvTime, min, avg, max;
double time[3] = {0.0, 0.0, 0.0};
int msg_size;
MPI_Status mstat;
int i=0, pe, trial, hops;
char name[30];
char *send_buf = (char *)malloc(MAX_MSG_SIZE);
char *recv_buf = (char *)malloc(MAX_MSG_SIZE);
for(i = 0; i < MAX_MSG_SIZE; i++) {
recv_buf[i] = send_buf[i] = (char) (i & 0xff);
}
// allocate the routing map.
int *map = (int *) malloc(sizeof(int) * numprocs);
TopoManager *tmgr;
int dimNZ, numRG, x, y, z, t, bcastSend[3], bcastRecv[3];
if(myrank == 0) {
tmgr = new TopoManager();
#if CREATE_JOBS
numRG = tmgr->getDimNX() * (tmgr->getDimNY() - 2) * 2 * tmgr->getDimNT();
#else
numRG = tmgr->getDimNX() * tmgr->getDimNY() * 2 * tmgr->getDimNT();
#endif
dimNZ = tmgr->getDimNZ();
for (int i=1; i<numprocs; i++) {
bcastSend[0] = dimNZ;
bcastSend[1] = numRG;
tmgr->rankToCoordinates(i, x, y, z, t);
bcastSend[2] = z;
MPI_Send(bcastSend, 3, MPI_INT, i, 1, MPI_COMM_WORLD);
}
tmgr->rankToCoordinates(0, x, y, z, t);
} else {
MPI_Recv(bcastRecv, 3, MPI_INT, 0, 1, MPI_COMM_WORLD, &mstat);
dimNZ = bcastRecv[0];
numRG = bcastRecv[1];
z = bcastRecv[2];
}
MPI_Barrier(MPI_COMM_WORLD);
if (myrank == 0) {
printf("Torus Dimensions %d %d %d %d\n", tmgr->getDimNX(), tmgr->getDimNY(), dimNZ, tmgr->getDimNT());
}
#if CREATE_JOBS
for (hops=0; hops < 2; hops++) {
#else
for (hops=0; hops < dimNZ/2; hops++) {
#endif
int *mapRG = (int *) malloc(sizeof(int) * numRG);
if (myrank == 0) {
// Rank 0 makes up a routing map.
build_process_map(numprocs, map, hops, numRG, mapRG);
}
// Broadcast the routing map.
MPI_Bcast(map, numprocs, MPI_INT, 0, MPI_COMM_WORLD);
MPI_Bcast(mapRG, numRG, MPI_INT, 0, MPI_COMM_WORLD);
MPI_Group_incl(orig_group, numRG, mapRG, &new_group);
MPI_Comm_create(MPI_COMM_WORLD, new_group, &new_comm);
MPI_Group_rank(new_group, &grank);
#if CREATE_JOBS
sprintf(name, "xt4_job_%d_%d.dat", numprocs, hops);
#else
sprintf(name, "xt4_line_%d_%d.dat", numprocs, hops);
#endif
for (msg_size=MIN_MSG_SIZE; msg_size<=MAX_MSG_SIZE; msg_size=(msg_size<<1)) {
for (trial=0; trial<10; trial++) {
pe = map[myrank];
if(pe != -1) {
if(grank != MPI_UNDEFINED) MPI_Barrier(new_comm);
if(myrank < pe) {
// warmup
for(i=0; i<2; i++) {
MPI_Send(send_buf, msg_size, MPI_CHAR, pe, 1, MPI_COMM_WORLD);
MPI_Recv(recv_buf, msg_size, MPI_CHAR, pe, 1, MPI_COMM_WORLD, &mstat);
}
sendTime = MPI_Wtime();
for(i=0; i<NUM_MSGS; i++)
MPI_Send(send_buf, msg_size, MPI_CHAR, pe, 1, MPI_COMM_WORLD);
for(i=0; i<NUM_MSGS; i++)
MPI_Recv(recv_buf, msg_size, MPI_CHAR, pe, 1, MPI_COMM_WORLD, &mstat);
recvTime = (MPI_Wtime() - sendTime) / NUM_MSGS;
// cooldown
for(i=0; i<2; i++) {
MPI_Send(send_buf, msg_size, MPI_CHAR, pe, 1, MPI_COMM_WORLD);
MPI_Recv(recv_buf, msg_size, MPI_CHAR, pe, 1, MPI_COMM_WORLD, &mstat);
}
if(grank != MPI_UNDEFINED) MPI_Barrier(new_comm);
} else {
// warmup
for(i=0; i<2; i++) {
MPI_Recv(recv_buf, msg_size, MPI_CHAR, pe, 1, MPI_COMM_WORLD, &mstat);
MPI_Send(send_buf, msg_size, MPI_CHAR, pe, 1, MPI_COMM_WORLD);
}
sendTime = MPI_Wtime();
for(i=0; i<NUM_MSGS; i++)
MPI_Recv(recv_buf, msg_size, MPI_CHAR, pe, 1, MPI_COMM_WORLD, &mstat);
for(i=0; i<NUM_MSGS; i++)
MPI_Send(send_buf, msg_size, MPI_CHAR, pe, 1, MPI_COMM_WORLD);
recvTime = (MPI_Wtime() - sendTime) / NUM_MSGS;
// cooldown
for(i=0; i<2; i++) {
MPI_Recv(recv_buf, msg_size, MPI_CHAR, pe, 1, MPI_COMM_WORLD, &mstat);
MPI_Send(send_buf, msg_size, MPI_CHAR, pe, 1, MPI_COMM_WORLD);
}
if(grank != MPI_UNDEFINED) MPI_Barrier(new_comm);
}
if(grank != MPI_UNDEFINED) {
MPI_Allreduce(&recvTime, &min, 1, MPI_DOUBLE, MPI_MIN, new_comm);
MPI_Allreduce(&recvTime, &avg, 1, MPI_DOUBLE, MPI_SUM, new_comm);
MPI_Allreduce(&recvTime, &max, 1, MPI_DOUBLE, MPI_MAX, new_comm);
}
avg /= numRG;
} // end if map[pe] != -1
if(grank == 0) {
time[0] += min;
time[1] += avg;
time[2] += max;
}
} // end for loop of trials
if (grank == 0) {
FILE *outf = fopen(name, "a");
fprintf(outf, "%d %g %g %g\n", msg_size, time[0]/10, time[1]/10, time[2]/10);
fflush(NULL);
fclose(outf);
time[0] = time[1] = time[2] = 0.0;
}
} // end for loop of msgs
free(mapRG);
} // end for loop of hops
if(grank == 0)
printf("Program Complete\n");
MPI_Finalize();
return 0;
}
value caml_mpi_comm_create(value comm, value group)
{
MPI_Comm newcomm;
MPI_Comm_create(Comm_val(comm), Group_val(group), &newcomm);
return caml_mpi_alloc_comm(newcomm);
}
int util_mic_get_num_devices_() {
/* only smp master does call, then bcast */
#define SIZE_GROUP 256
MPI_Group wgroup_handle,group_handle;
MPI_Comm group_comm;
int err,i,ranks[SIZE_GROUP];
int my_smp_master=util_my_smp_master();
int size_group=util_cgetppn();
if(mic_get_num_initialized) {
return num_mic_devs;
}else{
if(util_my_smp_index() == 0) {
num_mic_devs=_Offload_number_of_devices();
#ifdef DEBUG
char *myhostname = (char *) malloc (MAXGETHOSTNAME);
if(num_mic_devs != DBG_NUM_DEVS){
gethostname(myhostname, sizeof(myhostname) );
printf(" me %d hostname %s num_mic_devs %d \n", GA_Nodeid(), myhostname, num_mic_devs);
if(num_mic_devs != DBG_NUM_DEVS){
num_mic_devs=2;
printf(" me %d reset hostname %s set num_mic_devs %d \n", GA_Nodeid(), myhostname, num_mic_devs);
// GA_Error("wrong number of MIC devs", (long) num_mic_devs);
}else{
printf(" me %d 2nd try hostname %s correct num_mic_devs %d \n", GA_Nodeid(), myhostname, num_mic_devs);
free(myhostname);
}
}
#endif
}
/*get world group handle to be used later */
err=MPI_Comm_group(MPI_COMM_WORLD, &wgroup_handle);
if (err != MPI_SUCCESS) {
fprintf(stdout,"util_getppn: MPI_Comm_group failed\n");
GA_Error("util_getppn error", 0L);
}
for (i=0; i< size_group; i++) ranks[i] = i + my_smp_master;
/* create new group of size size_group */
err=MPI_Group_incl(wgroup_handle, size_group, ranks, &group_handle);
if (err != MPI_SUCCESS) {
fprintf(stdout,"util_micdevs: MPI_Group_incl failed\n");
GA_Error("util_micdevs error", 0L);
fflush(stdout);
}
/* Create new new communicator for the newly created group */
err=MPI_Comm_create(MPI_COMM_WORLD, group_handle, &group_comm);
if (err != MPI_SUCCESS) {
fprintf(stdout,"util_micdevs: MPI_Comm_group failed\n");
GA_Error("util_micdevs error", 0L);
}
err= MPI_Bcast(&num_mic_devs, 1, MPI_INT, 0, group_comm);
if (err != MPI_SUCCESS) {
fprintf(stdout,"util_mics: MPI_Bcast failed\n");
fflush(stdout);
GA_Error("util_mic_get_num_devices error", 0L);
}
/*flush group and comm*/
err=MPI_Group_free(&group_handle);
if (err != MPI_SUCCESS) {
fprintf(stdout,"util_micdevs: MPI_Group_free failed\n");
GA_Error("util_micdevs error", 0L);
}
err=MPI_Comm_free(&group_comm);
if (err != MPI_SUCCESS) {
fprintf(stdout,"util_micdevs: MPI_Comm_free failed\n");
GA_Error("util_micdevs error", 0L);
}
mic_get_num_initialized = 1;
return num_mic_devs;
}
}
int main (int argc, char *argv[])
/*=======================================================================*/
/* Begin routine */
{/*begin routine */
/*=======================================================================*/
/* Local Variables */
int iii;
int np,myid;
int myid_forc;
int myid_bead_real,myid_bead_junk;
int np_beads = 2;
int np_forc = 2;
int i,j,k;
int ncomm,ngroup;
int *ranks;
MPI_Group world_group,incl_group;
MPI_Comm path_int_comm;
MPI_Comm path_int_comm_junk;
/*=======================================================================*/
/* Initialize MPI */
MPI_Init(&argc,&argv);
MPI_Comm_size(MPI_COMM_WORLD,&np);
MPI_Comm_rank(MPI_COMM_WORLD,&myid);
myid_forc = (myid % np_forc);
if(np_beads*np_forc != np){
printf("Incorrect number of procs %d vs %d\n",np,np_beads*np_forc);
MPI_Finalize();
exit();
}/*endfor*/
/*=======================================================================*/
/* Malloc */
ranks = (int *)malloc(np_beads*sizeof(int));
/*=======================================================================*/
/* Get rank of processor in new communicator */
MPI_Comm_group(MPI_COMM_WORLD,&world_group);
for(j=0;j < np_forc;j++){
/*-----------------------------------------------------------------------*/
/* i) set the ranks */
for(i=0;i<np_beads;i++){
ranks[i] = np_forc*i+j;
}/*endfor*/
/*-----------------------------------------------------------------------*/
/* ii) Debug the ranks */
#ifdef DEBUG
for(k=0;k<np;k++){
MPI_Barrier(MPI_COMM_WORLD);
if(myid==k){
printf("comm number %d myid %d\n",j,myid);
for(i=0;i<np_beads;i++){ printf("ranks %d ",ranks[i]);}
printf("\n");
}/*endif*/
}/*endfor*/
if(myid==0){scanf("%d",&iii);}
MPI_Barrier(MPI_COMM_WORLD);
#endif
/*-----------------------------------------------------------------------*/
/* iii) Create the new communicator */
MPI_Group_incl(world_group,np_beads,ranks,&incl_group);
if(myid_forc==j){
MPI_Comm_create(MPI_COMM_WORLD,incl_group,&path_int_comm);
MPI_Comm_rank(path_int_comm,&myid_bead_real);
MPI_Comm_size(path_int_comm,&ncomm);
#ifdef DEBUG
printf("myid's %d %d %d\n",myid,myid_bead_real,ncomm);
#endif
if(ncomm!=np_beads){
printf("\n");
}/*endif*/
}else{
MPI_Comm_create(MPI_COMM_WORLD,incl_group,&path_int_comm_junk);
}/*endif*/
MPI_Group_free(&incl_group);
#ifdef DEBUG
if(myid==0){printf("done : \n");scanf("%d",&iii);}
#endif
MPI_Barrier(MPI_COMM_WORLD);
}/*endfor*/
MPI_Group_free(&world_group);
/*==========================================================================*/
/* Exit */
MPI_Finalize();
exit(0);
/*------------------------------------------------------------------------*/
} /*end routine*/
int Zoltan_PHG_Initialize_Params(
ZZ *zz, /* the Zoltan data structure */
float *part_sizes,
PHGPartParams *hgp
)
{
int err = ZOLTAN_OK;
char *yo = "Zoltan_PHG_Initialize_Params";
int nProc;
int usePrimeComm;
MPI_Comm communicator;
char add_obj_weight[MAX_PARAM_STRING_LEN];
char edge_weight_op[MAX_PARAM_STRING_LEN];
char cut_objective[MAX_PARAM_STRING_LEN];
char *package = hgp->hgraph_pkg;
char *method = hgp->hgraph_method;
char buf[1024];
memset(hgp, 0, sizeof(*hgp)); /* in the future if we forget to initialize
another param at least it will be 0 */
Zoltan_Bind_Param(PHG_params, "HYPERGRAPH_PACKAGE", &hgp->hgraph_pkg);
Zoltan_Bind_Param(PHG_params, "PHG_MULTILEVEL", &hgp->useMultilevel);
Zoltan_Bind_Param(PHG_params, "PHG_FROM_GRAPH_METHOD", hgp->convert_str);
Zoltan_Bind_Param(PHG_params, "PHG_OUTPUT_LEVEL", &hgp->output_level);
Zoltan_Bind_Param(PHG_params, "FINAL_OUTPUT", &hgp->final_output);
Zoltan_Bind_Param(PHG_params, "CHECK_GRAPH", &hgp->check_graph);
Zoltan_Bind_Param(PHG_params, "CHECK_HYPERGRAPH", &hgp->check_graph);
Zoltan_Bind_Param(PHG_params, "PHG_NPROC_VERTEX", &hgp->nProc_x_req);
Zoltan_Bind_Param(PHG_params, "PHG_NPROC_EDGE", &hgp->nProc_y_req);
Zoltan_Bind_Param(PHG_params, "PHG_COARSENING_LIMIT", &hgp->redl);
Zoltan_Bind_Param(PHG_params, "PHG_COARSENING_NCANDIDATE", &hgp->nCand);
Zoltan_Bind_Param(PHG_params, "PHG_COARSENING_METHOD", hgp->redm_str);
Zoltan_Bind_Param(PHG_params, "PHG_COARSENING_METHOD_FAST", hgp->redm_fast);
Zoltan_Bind_Param(PHG_params, "PHG_VERTEX_VISIT_ORDER", &hgp->visit_order);
Zoltan_Bind_Param(PHG_params, "PHG_EDGE_SCALING", &hgp->edge_scaling);
Zoltan_Bind_Param(PHG_params, "PHG_VERTEX_SCALING", &hgp->vtx_scaling);
Zoltan_Bind_Param(PHG_params, "PHG_REFINEMENT_METHOD", hgp->refinement_str);
Zoltan_Bind_Param(PHG_params, "PHG_DIRECT_KWAY", &hgp->kway);
Zoltan_Bind_Param(PHG_params, "PHG_REFINEMENT_LOOP_LIMIT",
&hgp->fm_loop_limit);
Zoltan_Bind_Param(PHG_params, "PHG_REFINEMENT_MAX_NEG_MOVE",
&hgp->fm_max_neg_move);
Zoltan_Bind_Param(PHG_params, "PHG_REFINEMENT_QUALITY",
&hgp->refinement_quality);
Zoltan_Bind_Param(PHG_params, "PHG_COARSEPARTITION_METHOD",
hgp->coarsepartition_str);
Zoltan_Bind_Param(PHG_params, "PHG_USE_TIMERS",
(void*) &hgp->use_timers);
Zoltan_Bind_Param(PHG_params, "USE_TIMERS",
(void*) &hgp->use_timers);
Zoltan_Bind_Param(PHG_params, "PHG_EDGE_SIZE_THRESHOLD",
(void*) &hgp->EdgeSizeThreshold);
Zoltan_Bind_Param(PHG_params, "PHG_MATCH_EDGE_SIZE_THRESHOLD",
(void*) &hgp->MatchEdgeSizeThreshold);
Zoltan_Bind_Param(PHG_params, "PHG_BAL_TOL_ADJUSTMENT",
(void*) &hgp->bal_tol_adjustment);
Zoltan_Bind_Param(PHG_params, "PARKWAY_SERPART",
(void *) hgp->parkway_serpart);
Zoltan_Bind_Param(PHG_params, "PHG_CUT_OBJECTIVE",
(void *) &cut_objective);
Zoltan_Bind_Param(PHG_params, "ADD_OBJ_WEIGHT",
(void *) add_obj_weight);
Zoltan_Bind_Param(PHG_params, "PHG_EDGE_WEIGHT_OPERATION",
(void *) edge_weight_op);
Zoltan_Bind_Param(PHG_params, "PHG_RANDOMIZE_INPUT",
(void*) &hgp->RandomizeInitDist);
Zoltan_Bind_Param(PHG_params, "PHG_PROCESSOR_REDUCTION_LIMIT",
(void*) &hgp->ProRedL);
Zoltan_Bind_Param(PHG_params, "PHG_REPART_MULTIPLIER",
(void*) &hgp->RepartMultiplier);
Zoltan_Bind_Param(PHG_params, "PATOH_ALLOC_POOL0",
(void*) &hgp->patoh_alloc_pool0);
Zoltan_Bind_Param(PHG_params, "PATOH_ALLOC_POOL1",
(void*) &hgp->patoh_alloc_pool1);
/* Set default values */
strncpy(hgp->hgraph_pkg, "phg", MAX_PARAM_STRING_LEN);
strncpy(hgp->convert_str, "neighbors", MAX_PARAM_STRING_LEN);
strncpy(hgp->redm_str, "agg", MAX_PARAM_STRING_LEN);
hgp->match_array_type = 0;
strncpy(hgp->redm_fast, "l-ipm", MAX_PARAM_STRING_LEN);
strncpy(hgp->coarsepartition_str, "auto", MAX_PARAM_STRING_LEN);
strncpy(hgp->refinement_str, "fm2", MAX_PARAM_STRING_LEN);
strncpy(hgp->parkway_serpart, "patoh", MAX_PARAM_STRING_LEN);
strncpy(cut_objective, "connectivity", MAX_PARAM_STRING_LEN);
strncpy(add_obj_weight, "none", MAX_PARAM_STRING_LEN);
strncpy(edge_weight_op, "max", MAX_PARAM_STRING_LEN);
/* LB.Approach is initialized to "REPARTITION", and set in Set_Key_Params */
strncpy(hgp->hgraph_method, zz->LB.Approach, MAX_PARAM_STRING_LEN);
if (!strcasecmp(zz->LB.Approach,"REFINE"))
hgp->useMultilevel = 0;
else
hgp->useMultilevel = 1;
hgp->use_timers = 0;
hgp->LocalCoarsePartition = 0;
hgp->edge_scaling = 0;
hgp->vtx_scaling = 0;
hgp->vtx_scal_size = 0;
hgp->vtx_scal = NULL; /* Array for storing vertex degree scale vector.
Should perhaps go in hg structure, not the
param struct? */
hgp->connectivity_cut = 1;
hgp->visit_order = 0; /* Random */
hgp->check_graph = 0;
hgp->bal_tol = zz->LB.Imbalance_Tol[0]; /* Make vector for multiconstraint */
hgp->bal_tol_adjustment = 0.7;
hgp->nCand = 100;
hgp->redl = MAX(2*zz->LB.Num_Global_Parts, 100);
hgp->output_level = PHG_DEBUG_NONE;
hgp->final_output = 0;
hgp->nProc_x_req = -1;
hgp->nProc_y_req = -1;
hgp->kway = 0;
hgp->fm_loop_limit = 10;
hgp->fm_max_neg_move = 250;
hgp->refinement_quality = 1;
hgp->RandomizeInitDist = 0;
hgp->EdgeSizeThreshold = 0.25;
hgp->MatchEdgeSizeThreshold = 500;
hgp->hybrid_keep_factor = 0.;
hgp->ProRedL = 0.0; /* UVCUVC: CHECK default set to 0 until we run more experiments */
hgp->RepartMultiplier = 100.;
hgp->patoh_alloc_pool0 = 0;
hgp->patoh_alloc_pool1 = 0;
hgp->UseFixedVtx = 0;
hgp->UsePrefPart = 0;
/* Get application values of parameters. */
err = Zoltan_Assign_Param_Vals(zz->Params, PHG_params, zz->Debug_Level,
zz->Proc, zz->Debug_Proc);
nProc = zz->Num_Proc;
usePrimeComm = 0;
/* Parse add_obj_weight parameter */
if (!strcasecmp(add_obj_weight, "none")) {
hgp->add_obj_weight = PHG_ADD_NO_WEIGHT;
hgp->part_sizes = part_sizes;
}
else if (zz->Obj_Weight_Dim > 0) {
/* Do not add_obj_weight until multiconstraint PHG is implemented */
ZOLTAN_PRINT_WARN(zz->Proc, yo,
"Both application supplied *and* ADD_OBJ_WEIGHT "
"calculated vertex weights were provided.");
ZOLTAN_PRINT_WARN(zz->Proc, yo,
"Only the first application supplied weight per vertex will be used.");
hgp->add_obj_weight = PHG_ADD_NO_WEIGHT;
hgp->part_sizes = part_sizes;
}
else {
if (!strcasecmp(add_obj_weight, "vertices")){
hgp->add_obj_weight = PHG_ADD_UNIT_WEIGHT;
} else if (!strcasecmp(add_obj_weight, "unit")){
hgp->add_obj_weight = PHG_ADD_UNIT_WEIGHT;
} else if (!strcasecmp(add_obj_weight, "vertex degree")){
hgp->add_obj_weight = PHG_ADD_PINS_WEIGHT;
} else if (!strcasecmp(add_obj_weight, "nonzeros")){
hgp->add_obj_weight = PHG_ADD_PINS_WEIGHT;
} else if (!strcasecmp(add_obj_weight, "pins")){
hgp->add_obj_weight = PHG_ADD_PINS_WEIGHT;
} else{
ZOLTAN_PRINT_ERROR(zz->Proc, yo, "Invalid ADD_OBJ_WEIGHT parameter.\n");
err = ZOLTAN_WARN;
}
/* Set hgp->part_sizes to new array of part_sizes with added obj weight. */
if (part_sizes)
err = Zoltan_LB_Add_Part_Sizes_Weight(zz,
(zz->Obj_Weight_Dim ? zz->Obj_Weight_Dim : 1),
zz->Obj_Weight_Dim+1,
part_sizes, &(hgp->part_sizes));
}
if ((zz->Obj_Weight_Dim==0) && /* no application supplied weights */
(hgp->add_obj_weight==PHG_ADD_NO_WEIGHT)){ /* no calculated weight */
hgp->add_obj_weight = PHG_ADD_UNIT_WEIGHT; /* default object weight */
}
if (!strcasecmp(cut_objective, "default")
|| !strcasecmp(cut_objective, "connectivity"))
hgp->connectivity_cut = 1;
else if (!strcasecmp(cut_objective, "hyperedges"))
hgp->connectivity_cut = 0;
else {
ZOLTAN_PRINT_ERROR(zz->Proc, yo, "Invalid PHG_CUT_OBJECTIVE parameter.\n");
goto End;
}
if (!strcasecmp(edge_weight_op, "max")){
hgp->edge_weight_op = PHG_MAX_EDGE_WEIGHTS;
} else if (!strcasecmp(edge_weight_op, "add")){
hgp->edge_weight_op = PHG_ADD_EDGE_WEIGHTS;
} else if (!strcasecmp(edge_weight_op, "error")){
hgp->edge_weight_op = PHG_FLAG_ERROR_EDGE_WEIGHTS;
} else{
ZOLTAN_PRINT_ERROR(zz->Proc, yo,
"Invalid PHG_EDGE_WEIGHT_OPERATION parameter.\n");
err = ZOLTAN_WARN;
}
if ((strcasecmp(method, "PARTITION")) &&
(strcasecmp(method, "REPARTITION")) &&
(strcasecmp(method, "REFINE"))) {
sprintf(buf,"%s is not a valid hypergraph method\n",method);
ZOLTAN_PRINT_ERROR (zz->Proc, yo, buf);
err = ZOLTAN_FATAL;
goto End;
}
/* Adjust refinement parameters using hgp->refinement_quality */
if (hgp->refinement_quality < 0.5/hgp->fm_loop_limit)
/* No refinement */
strncpy(hgp->refinement_str, "no", MAX_PARAM_STRING_LEN);
else {
/* Scale FM parameters */
hgp->fm_loop_limit *= hgp->refinement_quality;
hgp->fm_max_neg_move *= hgp->refinement_quality;
}
if (!strcasecmp(package, "PHG")){
/* Test to determine whether we should change the number of processors
used for partitioning to make more efficient 2D decomposition */
if (hgp->nProc_x_req != 1 && hgp->nProc_y_req != 1) /* Want 2D decomp */
if (zz->Num_Proc > SMALL_PRIME && Zoltan_PHG_isPrime(zz->Num_Proc))
/* 2D data decomposition is requested but we have a prime
* number of processors. */
usePrimeComm = 1;
if ((!strcasecmp(method, "REPARTITION"))){
zz->LB.Remap_Flag = 0;
}
if ((!strcasecmp(method, "REPARTITION")) ||
(!strcasecmp(method, "REFINE"))) {
hgp->fm_loop_limit = 4; /* experimental evaluation showed that for
repartitioning/refinement small number of passes
is "good enough". These are all heuristics hence
it is possible to create a pathological cases;
but in general this seems to be sufficient */
}
if (!hgp->useMultilevel) {
/* don't do coarsening */
strncpy(hgp->redm_str, "no", MAX_PARAM_STRING_LEN);
/* we have modified all coarse partitioners to handle preferred part
if user wants to choose one she can choose; otherwise default
partitioner
(greedy growing) does work better than previous default partitioning
for phg_refine ("no"). */
hgp->UsePrefPart = 1;
}
if (!strcasecmp(method, "REFINE") && hgp->useMultilevel){
/* UVCUVC: as a heuristic we prefer local matching;
in our experiments for IPDPS'07 and WileyChapter multilevel_refine
didn't prove itself useful; it is too costly even with local matching
hence it will not be be released yet (i.e. not in v3). */
strncpy(hgp->redm_str, "l-ipm", MAX_PARAM_STRING_LEN);
hgp->UsePrefPart = 1;
}
}
else if (!strcasecmp(package, "PARKWAY")){
if (hgp->nProc_x_req>1) {
err = ZOLTAN_FATAL;
ZOLTAN_PRINT_ERROR(zz->Proc, yo, "ParKway requires nProc_x=1 or -1.");
goto End;
}
hgp->nProc_x_req = 1;
}
else if (!strcasecmp(package, "PATOH")){
if (zz->Num_Proc>1) {
err = ZOLTAN_FATAL;
ZOLTAN_PRINT_ERROR(zz->Proc, yo, "PaToH only works with Num_Proc=1.");
goto End;
}
}
if (!usePrimeComm)
MPI_Comm_dup(zz->Communicator, &communicator);
else {
MPI_Group newgrp, zzgrp;
nProc--;
MPI_Comm_group(zz->Communicator, &zzgrp);
MPI_Group_excl(zzgrp, 1, &nProc, &newgrp);
MPI_Comm_create(zz->Communicator, newgrp, &communicator);
MPI_Group_free(&newgrp);
MPI_Group_free(&zzgrp);
}
err = Zoltan_PHG_Set_2D_Proc_Distrib(zz, communicator, zz->Proc,
nProc, hgp->nProc_x_req,
hgp->nProc_y_req,
&hgp->globalcomm);
if (err != ZOLTAN_OK)
goto End;
/* Convert strings to function pointers. */
err = Zoltan_PHG_Set_Part_Options (zz, hgp);
End:
return err;
}
int main(int argc, char **argv) {
int rank, M, j,i, *d_graph;
int *local_matrix, *row_matrix, *col_matrix, *res_matrix, *rowIds, *colIds;
int P, N, q, p_row, p_col;
double start, finish;
MPI_Status status;
MPI_Init(&argc, &argv);
MPI_Comm_size(MPI_COMM_WORLD, &P);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
//INPUT HANDLED BY THE ROOT PROCESSOR
if (rank == ROOT){
scanf("%d", &N);
q = check_fox_conditions(P,N);
//Check's if the fox's conditions are met
if(q == 0){
MPI_Abort(MPI_COMM_WORLD, 0);
return 1; //error
}
d_graph = (int*)malloc((N*N) * sizeof(int));
for(i=0; i < N; i++){
for(j=0; j < N; j++){
scanf("%d", &d_graph[GET_MTRX_POS(i,j,N)]);
if (d_graph[GET_MTRX_POS(i,j,N)] == 0 && i != j) {
d_graph[GET_MTRX_POS(i,j,N)] = INF;
}
}
}
MPI_Bcast(&q, 1, MPI_INT, 0, MPI_COMM_WORLD);
MPI_Bcast(&N, 1, MPI_INT, 0, MPI_COMM_WORLD);
if(q > 1)
divide_matrix( d_graph, N, q);
}
else{
MPI_Bcast(&q, 1, MPI_INT, 0, MPI_COMM_WORLD);
MPI_Bcast(&N, 1, MPI_INT, 0, MPI_COMM_WORLD);
}
//---------------COMMON------------------
int lngth = N / q;
local_matrix = (int*)malloc((lngth*lngth) * sizeof(int));
row_matrix = (int*)malloc((lngth*lngth) * sizeof(int));
col_matrix = (int*)malloc((lngth*lngth) * sizeof(int));
res_matrix = (int*)malloc((lngth*lngth) * sizeof(int));
if(q>1)
chnkd_MPI_Recv(local_matrix, lngth*lngth, MPI_INT, 0);
else
local_matrix = d_graph;
p_row = ( rank / q );
p_col = ( rank % q );
//CREATE COMMUNICATORS
MPI_Group MPI_GROUP_WORLD;
MPI_Comm_group(MPI_COMM_WORLD, &MPI_GROUP_WORLD);
MPI_Group row_group, col_group;
MPI_Comm row_comm, col_comm, grid_comm;
int tmp_row, tmp_col, proc;
int row_process_ranks[q], col_process_ranks[q];
for(proc = 0; proc < q; proc++){
row_process_ranks[proc] = (p_row * q) + proc;
col_process_ranks[proc] = ((p_col + proc*q) %(q*q));
}
radixsort(col_process_ranks, q);
radixsort(row_process_ranks, q);
MPI_Group_incl(MPI_GROUP_WORLD, q, row_process_ranks, &row_group);
MPI_Group_incl(MPI_GROUP_WORLD, q, col_process_ranks, &col_group);
MPI_Comm_create(MPI_COMM_WORLD, row_group, &row_comm);
MPI_Comm_create(MPI_COMM_WORLD, col_group, &col_comm);
if ((rank / q) == (rank % q)) {
memcpy(row_matrix, local_matrix, (lngth*lngth) * sizeof(int));
}
int ln,d,flag;
int step, rotation_src, rotation_dest, src;
int count = 0;
memcpy(res_matrix, local_matrix, (lngth*lngth) * sizeof(int));
rotation_src = (p_row + 1) % q;
rotation_dest = ((p_row - 1) + q) % q;
ln = (lngth*q) << 1;
start = MPI_Wtime();
for (d = 2; d < ln; d = d << 1) {
memcpy(col_matrix, local_matrix, (lngth*lngth) * sizeof(int));
for ( step = 0; step < q; step++) {
src = (p_row + step) % q;
count++;
if (src == p_col) {
MPI_Bcast(local_matrix, lngth*lngth, MPI_INT, src, row_comm);
floyd_warshall( local_matrix, col_matrix, res_matrix, lngth);
} else {
MPI_Bcast(row_matrix, lngth*lngth, MPI_INT, src, row_comm);
floyd_warshall( row_matrix, col_matrix, res_matrix, lngth);
}
if( step < q-1)
MPI_Sendrecv_replace(col_matrix, lngth*lngth, MPI_INT, rotation_dest, STD_TAG,rotation_src, STD_TAG, col_comm, MPI_STATUS_IGNORE);
}
memcpy(local_matrix, res_matrix, (lngth*lngth) * sizeof(int));
}
int *sol;
sol = malloc(N*N*sizeof(int));
MPI_Gather(res_matrix, lngth*lngth, MPI_INT, sol, lngth*lngth, MPI_INT, 0, MPI_COMM_WORLD);
if (rank == 0) {
finish = MPI_Wtime();
printf("Tempo de execução %f\n",finish - start);
}
if (rank == 0) {
int row, col, pos_x, pos_y, pos, tmp_y, tmp_x;
for (i = 0; i < P; i++) {
pos_x = i / q;
pos_y = i % q;
pos = i * lngth*lngth;
for (row = 0; row < lngth; row++) {
for (col = 0; col < lngth; col++) {
tmp_x = GET_MTRX_POS(pos_x,row,lngth);
tmp_y = GET_MTRX_POS(pos_y,col,lngth);
if (sol[GET_MTRX_POS(row,col,lngth) + pos] == INF)
d_graph[GET_MTRX_POS(tmp_x,tmp_y,N)] = 0;
else
d_graph[GET_MTRX_POS(tmp_x,tmp_y,N)] = sol[GET_MTRX_POS(row,col,lngth) + pos];
}
}
}
prints_matrix(d_graph,N);
}
MPI_Finalize();
return 0;
}
int main(int argc, char **argv)
{
MPI_Comm c0, c1, ic;
MPI_Group g0, g1, gworld;
int a, b, c, d;
int rank, size, remote_leader, tag;
int ranks[2];
int errs = 0;
tag = 5;
c0 = c1 = ic = MPI_COMM_NULL;
g0 = g1 = gworld = MPI_GROUP_NULL;
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
MPI_Comm_size(MPI_COMM_WORLD, &size);
if (size < 33) {
printf("ERROR: this test requires at least 33 processes\n");
MPI_Abort(MPI_COMM_WORLD, 1);
exit(1);
}
/* group of c0
* NOTE: a>=32 is essential for exercising the loop bounds bug from tt#1574 */
a = 32;
b = 24;
/* group of c1 */
c = 25;
d = 26;
MPI_Comm_group(MPI_COMM_WORLD, &gworld);
ranks[0] = a;
ranks[1] = b;
MPI_Group_incl(gworld, 2, ranks, &g0);
MPI_Comm_create(MPI_COMM_WORLD, g0, &c0);
ranks[0] = c;
ranks[1] = d;
MPI_Group_incl(gworld, 2, ranks, &g1);
MPI_Comm_create(MPI_COMM_WORLD, g1, &c1);
if (rank == a || rank == b) {
remote_leader = c;
MPI_Intercomm_create(c0, 0, MPI_COMM_WORLD, remote_leader, tag, &ic);
}
else if (rank == c || rank == d) {
remote_leader = a;
MPI_Intercomm_create(c1, 0, MPI_COMM_WORLD, remote_leader, tag, &ic);
}
MPI_Group_free(&g0);
MPI_Group_free(&g1);
MPI_Group_free(&gworld);
if (c0 != MPI_COMM_NULL)
MPI_Comm_free(&c0);
if (c1 != MPI_COMM_NULL)
MPI_Comm_free(&c1);
if (ic != MPI_COMM_NULL)
MPI_Comm_free(&ic);
MPI_Reduce((rank == 0 ? MPI_IN_PLACE : &errs), &errs,
1, MPI_INT, MPI_SUM, 0, MPI_COMM_WORLD);
if (rank == 0) {
if (errs) {
printf("found %d errors\n", errs);
}
else {
printf(" No errors\n");
}
}
MPI_Finalize();
return 0;
}
int main(int argc, char *argv[])
{
int my_ID, myrow, mycol, /* my index and row and column index */
root=0, /* ID of root rank */
Num_procs, /* number of ranks */
nprow, npcol, /* row, column dimensions of rank grid */
order, /* matrix order */
mynrows, myfrow, /* my number of rows and index of first row*/
mylrow, /* and last row */
/*myncols,*/ myfcol,/* my number of cols and index of first row*/
mylcol, /* and last row */
*mm, /* arrays that hold m_i's and n_j's */
*nn,
/*nb,*/ /* block factor for SUMMA */
inner_block_flag, /* flag to select local DGEMM blocking */
error=0, /* error flag */
*ranks, /* work array for row and column ranks */
/*lda, ldb, ldc,*/ /* leading array dimensions of a, b, and c */
i, j, ii, jj, /* dummy variables */
iter, iterations;
long lda, ldb, ldc,
nb, myncols; /* make long to avoid integer overflow */
double *a, *b, *c, /* arrays that hold local a, b, c */
*work1, *work2, /* work arrays to pass to dpmmmult */
local_dgemm_time, /* timing parameters */
dgemm_time,
avgtime;
double
forder, nflops, /* float matrix order + total flops */
checksum, /* array checksum for verification test */
checksum_local=0.0,
ref_checksum; /* reference checkcum for verification */
MPI_Group world_group,
temp_group;
MPI_Comm comm_row, /* communicators for row and column ranks */
comm_col; /* of rank grid */
int shortcut; /* true if only doing initialization */
int procsize; /* number or ranks per process */
/* initialize */
MPI_Init(&argc,&argv);
MPI_Comm_rank( MPI_COMM_WORLD, &my_ID );
MPI_Comm_size( MPI_COMM_WORLD, &Num_procs );
/*********************************************************************
** process, test and broadcast input parameters
*********************************************************************/
if (my_ID == root) {
printf("Parallel Research Kernels version %s\n", PRKVERSION);
printf("FG_MPI Dense matrix-matrix multiplication: C = A x B\n");
if (argc != 5) {
printf("Usage: %s <# iterations> <matrix order> <outer block size> ",
*argv);
printf("<local block flag (non-zero=yes, zero=no)>\n");
error = 1;
goto ENDOFTESTS;
}
iterations = atoi(*++argv);
if(iterations < 1){
printf("ERROR: iterations must be positive: %d \n",iterations);
error = 1;
goto ENDOFTESTS;
}
order = atoi(*++argv);
if (order < 0) {
shortcut = 1;
order = -order;
} else shortcut = 0;
if (order < Num_procs) {
printf("ERROR: matrix order too small: %d\n", order);
error = 1;
goto ENDOFTESTS;
}
nb = atol(*++argv);
/* a non-positive tile size means no outer level tiling */
inner_block_flag = atoi(*++argv);
ENDOFTESTS:;
}
bail_out(error);
MPI_Bcast(&order, 1, MPI_INT, root, MPI_COMM_WORLD);
MPI_Bcast(&iterations, 1, MPI_INT, root, MPI_COMM_WORLD);
MPI_Bcast(&nb, 1, MPI_LONG, root, MPI_COMM_WORLD);
MPI_Bcast(&shortcut, 1, MPI_INT, root, MPI_COMM_WORLD);
MPI_Bcast(&inner_block_flag, 1, MPI_INT, root, MPI_COMM_WORLD);
/* compute rank grid to most closely match a square; to do so,
compute largest divisor of Num_procs, using hare-brained method.
The small term epsilon is used to guard against roundoff errors
in case Num_procs is a perfect square */
nprow = (int) (sqrt((double) Num_procs + epsilon));
while (Num_procs%nprow) nprow--;
npcol = Num_procs/nprow;
if (my_ID == root) {
MPIX_Get_collocated_size(&procsize);
printf("Number of ranks = %d\n", Num_procs);
printf("Number of ranks/process = %d\n", procsize);
printf("Ranks grid = %d rows x %d columns\n", nprow, npcol);
printf("Matrix order = %d\n", order);
printf("Outer block size = %d\n", nb);
printf("Number of iterations = %d\n", iterations);
if (inner_block_flag)
printf("Using local dgemm blocking\n");
else
printf("No local dgemm blocking\n");
if (shortcut)
printf("Only doing initialization\n");
}
/* set up row and column communicators */
ranks = (int *) malloc (3*Num_procs*sizeof(int));
if (!ranks) {
printf("ERROR: Proc %d could not allocate rank work arrays\n",
my_ID);
error = 1;
}
bail_out(error);
mm = ranks + Num_procs;
nn = mm + Num_procs;
/* 1. extract group of ranks that make up WORLD */
MPI_Comm_group( MPI_COMM_WORLD, &world_group );
/* 2. create list of all ranks in same row of rank grid */
ranks[0] = my_ID/npcol * npcol;
for (i=1; i<npcol; i++) ranks[i] = ranks[i-1] + 1;
/* create row group and communicator */
MPI_Group_incl( world_group, npcol, ranks, &temp_group );
MPI_Comm_create( MPI_COMM_WORLD, temp_group, &comm_row );
/* 3. create list of all ranks in same column of rank grid */
ranks[0] = my_ID%npcol;
for (i=1; i<nprow; i++) ranks[i] = ranks[i-1] + npcol;
/* create column group and communicator */
MPI_Group_incl( world_group, nprow, ranks, &temp_group );
MPI_Comm_create( MPI_COMM_WORLD, temp_group, &comm_col );
/* extract this node's row and column index */
MPI_Comm_rank( comm_row, &mycol );
MPI_Comm_rank( comm_col, &myrow );
/* mynrows = number of rows assigned to me; distribute excess
rows evenly if nprow does not divide matrix order evenly */
if (myrow < order%nprow) mynrows = (order/nprow)+1;
else mynrows = (order/nprow);
/* make sure lda is a multiple of the block size nb */
if (mynrows%nb==0 || mynrows<nb) lda = mynrows;
else lda = (mynrows/nb+1)*nb;
/* myncols = number of colums assigned to me; distribute excess
columns evenly if npcol does not divide order evenly */
if (mycol < order%npcol) myncols = (order/npcol)+1;
else myncols = (order/npcol);
/* get space for local blocks of A, B, C */
a = (double *) malloc( lda*myncols*sizeof(double) );
b = (double *) malloc( lda*myncols*sizeof(double) );
c = (double *) malloc( lda*myncols*sizeof(double) );
if ( a == NULL || b == NULL || c == NULL ) {
error = 1;
printf("ERROR: Proc %d could not allocate a, b, and/or c\n",my_ID);
}
bail_out(error);
/* get space for two work arrays for dgemm */
work1 = (double *) malloc( nb*lda*sizeof(double) );
work2 = (double *) malloc( nb*myncols*sizeof(double) );
if ( !work1 || !work2 ) {
printf("ERROR: Proc %d could not allocate work buffers\n", my_ID);
error = 1;
}
bail_out(error);
/* collect array that holds mynrows from all nodes in my row
of the rank grid (array of all m_i) */
MPI_Allgather( &mynrows, 1, MPI_INT, mm, 1, MPI_INT, comm_col );
/* myfrow = first row on my node */
for (myfrow=1,i=0; i<myrow; i++) myfrow += mm[i];
mylrow = myfrow+mynrows-1;
/* collect array that holds myncols from all nodes in my column
of the rank grid (array of all n_j) */
MPI_Allgather( &myncols, 1, MPI_INT, nn, 1, MPI_INT, comm_row );
/* myfcol = first col on my node */
for (myfcol=1,i=0; i<mycol; i++) myfcol += nn[i];
mylcol = myfcol+myncols-1;
/* initialize matrices A, B, and C */
ldc = ldb = lda;
for (jj=0, j=myfcol; j<=mylcol; j++,jj++ )
for (ii=0, i=myfrow; i<=mylrow; i++, ii++ ) {
A(ii,jj) = (double) (j-1);
B(ii,jj) = (double) (j-1);
C(ii,jj) = 0.0;
}
if (shortcut) {
MPI_Finalize();
exit(EXIT_SUCCESS);
}
for (iter=0; iter<=iterations; iter++) {
/* start timer after a warmup iteration */
if (iter == 1) {
MPI_Barrier(MPI_COMM_WORLD);
local_dgemm_time = wtime();
}
/* actual matrix-vector multiply */
dgemm(order, nb, inner_block_flag, a, lda, b, lda, c, lda,
mm, nn, comm_row, comm_col, work1, work2 );
} /* end of iterations */
local_dgemm_time = wtime() - local_dgemm_time;
MPI_Reduce(&local_dgemm_time, &dgemm_time, 1, MPI_DOUBLE, MPI_MAX, root,
MPI_COMM_WORLD);
/* verification test */
for (jj=0, j=myfcol; j<=mylcol; j++, jj++)
for (ii=0, i=myfrow; i<=mylrow; i++, ii++)
checksum_local += C(ii,jj);
MPI_Reduce(&checksum_local, &checksum, 1, MPI_DOUBLE, MPI_SUM,
root, MPI_COMM_WORLD);
forder = (double) order;
ref_checksum = (0.25*forder*forder*forder*(forder-1.0)*(forder-1.0));
ref_checksum *= (iterations+1);
if (my_ID == root) {
if (ABS((checksum - ref_checksum)/ref_checksum) > epsilon) {
printf("ERROR: Checksum = %lf, Reference checksum = %lf\n",
checksum, ref_checksum);
error = 1;
}
else {
printf("Solution validates\n");
#ifdef VERBOSE
printf("Reference checksum = %lf, checksum = %lf\n",
ref_checksum, checksum);
#endif
}
}
bail_out(error);
/* report elapsed time */
nflops = 2.0*forder*forder*forder;
if ( my_ID == root ) {
avgtime = dgemm_time/iterations;
printf("Rate (MFlops/s): %lf Avg time (s): %lf\n",
1.0E-06 * nflops/avgtime, avgtime);
}
MPI_Finalize();
}
void init_multisystem(t_commrec *cr, int nsim, char **multidirs,
int nfile, const t_filenm fnm[], gmx_bool bParFn)
{
gmx_multisim_t *ms;
int nnodes, nnodpersim, sim, i, ftp;
char buf[256];
#ifdef GMX_MPI
MPI_Group mpi_group_world;
int *rank;
#endif
#ifndef GMX_MPI
if (nsim > 1)
{
gmx_fatal(FARGS, "This binary is compiled without MPI support, can not do multiple simulations.");
}
#endif
nnodes = cr->nnodes;
if (nnodes % nsim != 0)
{
gmx_fatal(FARGS, "The number of ranks (%d) is not a multiple of the number of simulations (%d)", nnodes, nsim);
}
nnodpersim = nnodes/nsim;
sim = cr->nodeid/nnodpersim;
if (debug)
{
fprintf(debug, "We have %d simulations, %d ranks per simulation, local simulation is %d\n", nsim, nnodpersim, sim);
}
snew(ms, 1);
cr->ms = ms;
ms->nsim = nsim;
ms->sim = sim;
#ifdef GMX_MPI
/* Create a communicator for the master nodes */
snew(rank, ms->nsim);
for (i = 0; i < ms->nsim; i++)
{
rank[i] = i*nnodpersim;
}
MPI_Comm_group(MPI_COMM_WORLD, &mpi_group_world);
MPI_Group_incl(mpi_group_world, nsim, rank, &ms->mpi_group_masters);
sfree(rank);
MPI_Comm_create(MPI_COMM_WORLD, ms->mpi_group_masters,
&ms->mpi_comm_masters);
#if !defined(MPI_IN_PLACE_EXISTS)
/* initialize the MPI_IN_PLACE replacement buffers */
snew(ms->mpb, 1);
ms->mpb->ibuf = NULL;
ms->mpb->libuf = NULL;
ms->mpb->fbuf = NULL;
ms->mpb->dbuf = NULL;
ms->mpb->ibuf_alloc = 0;
ms->mpb->libuf_alloc = 0;
ms->mpb->fbuf_alloc = 0;
ms->mpb->dbuf_alloc = 0;
#endif
#endif
/* Reduce the intra-simulation communication */
cr->sim_nodeid = cr->nodeid % nnodpersim;
cr->nnodes = nnodpersim;
#ifdef GMX_MPI
MPI_Comm_split(MPI_COMM_WORLD, sim, cr->sim_nodeid, &cr->mpi_comm_mysim);
cr->mpi_comm_mygroup = cr->mpi_comm_mysim;
cr->nodeid = cr->sim_nodeid;
#endif
if (debug)
{
fprintf(debug, "This is simulation %d", cr->ms->sim);
if (PAR(cr))
{
fprintf(debug, ", local number of ranks %d, local rank ID %d",
cr->nnodes, cr->sim_nodeid);
}
fprintf(debug, "\n\n");
}
if (multidirs)
{
if (debug)
{
fprintf(debug, "Changing to directory %s\n", multidirs[cr->ms->sim]);
}
gmx_chdir(multidirs[cr->ms->sim]);
}
else if (bParFn)
{
/* Patch output and tpx, cpt and rerun input file names */
for (i = 0; (i < nfile); i++)
{
/* Because of possible multiple extensions per type we must look
* at the actual file name
*/
if (is_output(&fnm[i]) ||
fnm[i].ftp == efTPR || fnm[i].ftp == efCPT ||
strcmp(fnm[i].opt, "-rerun") == 0)
{
ftp = fn2ftp(fnm[i].fns[0]);
par_fn(fnm[i].fns[0], ftp, cr, TRUE, FALSE, buf, 255);
sfree(fnm[i].fns[0]);
fnm[i].fns[0] = gmx_strdup(buf);
}
}
}
}
/*
Create a child group for to the given group.
@param n IN #procs in this group (<= that in group_parent)
@param pid_list IN The list of proc ids (w.r.t. group_parent)
@param group_out OUT Handle to store the created group
@param group_parent IN Parent group
*/
void ARMCI_Group_create_child(int n, int *pid_list, ARMCI_Group *group_out,
ARMCI_Group *grp_parent) {
int i,grp_me;
ARMCI_iGroup *igroup = (ARMCI_iGroup *)group_out;
#ifdef ARMCI_GROUP
armci_grp_attr_t *grp_attr = &igroup->grp_attr;
int world_me, parent_grp_me;
#else
int rv;
ARMCI_iGroup *igroup_parent = (ARMCI_iGroup *)grp_parent;
MPI_Group *group_parent;
MPI_Comm *comm_parent;
#endif
#ifdef ARMCI_GROUP
ARMCI_Group_rank(grp_parent, &parent_grp_me);
for(i=0; i<n; i++) {
if(pid_list[i] == parent_grp_me) {
break;
}
}
if(i==n) {
/*this initialization is used in group free*/
grp_attr->nproc=0;
grp_attr->proc_list = NULL;
return; /*not in group to be created*/
}
#endif
for(i=0; i<n-1;i++) {
if(pid_list[i] > pid_list[i+1]){
armci_die("ARMCI_Group_create: Process ids are not sorted ",armci_me);
break;
}
}
#ifdef ARMCI_GROUP
grp_attr->grp_clus_info = NULL;
grp_attr->nproc = n;
grp_attr->proc_list = (int *)malloc(n*sizeof(int));
assert(grp_attr->proc_list!=NULL);
for(i=0; i<n; i++) {
grp_attr->proc_list[i] = ARMCI_Absolute_id(grp_parent,pid_list[i]);
}
/* MPI_Comm_rank(MPI_COMM_WORLD, &world_me); */
world_me = armci_msg_me();
grp_attr->grp_me = grp_me = MPI_UNDEFINED;
for(i=0; i<n; i++) {
if(igroup->grp_attr.proc_list[i] == world_me) {
grp_attr->grp_me = grp_me = i;
break;
}
}
if(grp_me != MPI_UNDEFINED) armci_cache_attr(group_out);
armci_msg_group_barrier(group_out);
#else
/* NOTE: default group is the parent group */
group_parent = &(igroup_parent->igroup);
comm_parent = &(igroup_parent->icomm);
rv=MPI_Group_incl(*group_parent, n, pid_list, &(igroup->igroup));
if(rv != MPI_SUCCESS) armci_die("MPI_Group_incl: Failed ",armci_me);
rv = MPI_Comm_create(*comm_parent, (MPI_Group)(igroup->igroup),
(MPI_Comm*)&(igroup->icomm));
if(rv != MPI_SUCCESS) armci_die("MPI_Comm_create: Failed ",armci_me);
/* processes belong to this group should cache attributes */
MPI_Group_rank((MPI_Group)(igroup->igroup), &grp_me);
igroup->grp_attr.grp_clus_info=NULL;
if(grp_me != MPI_UNDEFINED) armci_cache_attr(group_out);
#endif
}
void nrnmpi_subworld_size(int n) {
/* n is the size of a subworld, nrnmpi_numprocs (pc.nhost) */
if (nrnmpi_use != 1) { return; }
if (nrnmpi_comm != MPI_COMM_NULL) {asrt(MPI_Comm_free(&nrnmpi_comm)); }
if (nrn_bbs_comm != MPI_COMM_NULL) {asrt(MPI_Comm_free(&nrn_bbs_comm)); }
if (grp_bbs != MPI_GROUP_NULL) { asrt(MPI_Group_free(&grp_bbs)); }
if (grp_net != MPI_GROUP_NULL) { asrt(MPI_Group_free(&grp_net)); }
MPI_Group wg;
asrt(MPI_Comm_group(nrnmpi_world_comm, &wg));
int r = nrnmpi_myid_world;
/* special cases */
if (n == 1) {
asrt(MPI_Group_incl(wg, 1, &r, &grp_net));
asrt(MPI_Comm_dup(nrnmpi_world_comm, &nrn_bbs_comm));
asrt(MPI_Comm_create(nrnmpi_world_comm, grp_net, &nrnmpi_comm));
asrt(MPI_Comm_rank(nrnmpi_comm, &nrnmpi_myid));
asrt(MPI_Comm_size(nrnmpi_comm, &nrnmpi_numprocs));
asrt(MPI_Comm_rank(nrn_bbs_comm, &nrnmpi_myid_bbs));
asrt(MPI_Comm_size(nrn_bbs_comm, &nrnmpi_numprocs_bbs));
}else if (n == nrnmpi_numprocs_world) {
asrt(MPI_Group_incl(wg, 1, &r, &grp_bbs));
asrt(MPI_Comm_dup(nrnmpi_world_comm, &nrnmpi_comm));
asrt(MPI_Comm_create(nrnmpi_world_comm, grp_bbs, &nrn_bbs_comm));
asrt(MPI_Comm_rank(nrnmpi_comm, &nrnmpi_myid));
asrt(MPI_Comm_size(nrnmpi_comm, &nrnmpi_numprocs));
if (r == 0) {
asrt(MPI_Comm_rank(nrn_bbs_comm, &nrnmpi_myid_bbs));
asrt(MPI_Comm_size(nrn_bbs_comm, &nrnmpi_numprocs_bbs));
}else{
nrnmpi_myid_bbs = -1;
nrnmpi_numprocs_bbs = -1;
}
}else{
int nw = nrnmpi_numprocs_world;
int nb = nw/n; /* nrnmpi_numprocs_bbs */
int range[3];
/* net is contiguous */
range[0] = r/n;
range[0] *= n; /* first */
range[1] = range[0] + n - 1; /* last */
range[2] = 1; /* stride */
asrt(MPI_Group_range_incl(wg, 1, &range, &grp_net));
asrt(MPI_Comm_create(nrnmpi_world_comm, grp_net, &nrnmpi_comm));
asrt(MPI_Comm_rank(nrnmpi_comm, &nrnmpi_myid));
asrt(MPI_Comm_size(nrnmpi_comm, &nrnmpi_numprocs));
range[0] = 0; /* first */
range[1] = nw - n; /* last */
range[2] = n; /* stride */
asrt(MPI_Group_range_incl(wg, 1, &range, &grp_bbs));
asrt(MPI_Comm_create(nrnmpi_world_comm, grp_bbs, &nrn_bbs_comm));
if (r%n == 0) { /* only rank 0 of the subworlds */
asrt(MPI_Comm_rank(nrn_bbs_comm, &nrnmpi_myid_bbs));
asrt(MPI_Comm_size(nrn_bbs_comm, &nrnmpi_numprocs_bbs));
}else{
nrnmpi_myid_bbs = -1;
nrnmpi_numprocs_bbs = -1;
}
}
asrt(MPI_Group_free(&wg));
}