void__give_pebil_name(mpi_init_)(int* ierr){
#else
void __wrapper_name(mpi_init_)(int* ierr){
pmpi_init_(ierr);
#endif // USES_PSINSTRACER
PMPI_Comm_rank(MPI_COMM_WORLD, &__taskid);
PMPI_Comm_size(MPI_COMM_WORLD, &__ntasks);
mpiValid = 1;
fprintf(stdout, "-[p%d]- remapping to taskid %d/%d on host %u in mpi_init_ wrapper\n", getpid(), __taskid, __ntasks, gethostid());
tool_mpi_init();
}
int NQJ_Init(int * _pnmpi_arg_0, char * * * _pnmpi_arg_1)
{
int res;
int start_level;
start_level=pnmpi_level;
if (IS_ACTIVATED(MPI_Init_MAJOR,MPI_Init_MINOR))
{
while ((pnmpi_level<pnmpi_max_level) && (modules.module[pnmpi_level]->stack_delimiter==0))
{
if (pnmpi_function_ptrs.pnmpi_int_MPI_Init[pnmpi_level]!=NULL)
{
DBGPRINT3("Calling a wrapper in MPI_Init at level %i FROM %px",pnmpi_level,&(Internal_XMPI_Init));
res=(pnmpi_function_ptrs.pnmpi_int_MPI_Init)[pnmpi_level](_pnmpi_arg_0, _pnmpi_arg_1);
DBGPRINT3("Done with wrapper in MPI_Init at level %i - reseting to %i",pnmpi_level,start_level);
pnmpi_level=start_level;
return res;
}
pnmpi_level++;
}
}
if (pnmpi_init_done)
{
DBGPRINT3("Duplicated: calling a original MPI in MPI_Init");
res=MPI_SUCCESS;
}
else
{
DBGPRINT3("Calling a original MPI in MPI_Init");
#ifdef COMPILE_FOR_FORTRAN
if (init_was_fortran)
pmpi_init_(&res);
else
#endif
res=PMPI_Init(_pnmpi_arg_0, _pnmpi_arg_1);
pnmpi_init_done=1;
}
DBGPRINT3("Done with original MPI in MPI_Init");
pnmpi_level=start_level;
return res;
}
/*-----------------------------------------------------------------------------
* Function mpi_init_
* Purpose: override MPI initialization in Fortran programs to capture MPI rank
*---------------------------------------------------------------------------*/
void mpi_init_(int *ierr)
{
pmpi_init_(ierr);
if (*ierr == MPI_SUCCESS) remember_rank();
}
static int PNMPI_Common_MPI_Init(int * _pnmpi_arg_0, char * * * _pnmpi_arg_1)
{
int returnVal;
pnmpi_PreInit(); /* this will never fail */
if (NOT_ACTIVATED(MPI_Init_MAJOR,MPI_Init_MINOR))
{
#ifdef COMPILE_FOR_FORTRAN
if (init_was_fortran)
pmpi_init_(&returnVal);
else
#endif
returnVal=PMPI_Init(_pnmpi_arg_0, _pnmpi_arg_1);
}
else
returnVal=Internal_XMPI_Init(_pnmpi_arg_0, _pnmpi_arg_1);
if (returnVal!=MPI_SUCCESS)
return returnVal;
DBGLATEINIT();
STATUSINIT();
DBGPRINT1("Leaving Init");
STATUSPRINT1("");
STATUSPRINT1("\t\t ---------------------------");
STATUSPRINT1("\t\t | P^N-MPI Interface |");
STATUSPRINT1("\t\t | Martin Schulz, 2005, LLNL |");
STATUSPRINT1("\t\t ---------------------------");
STATUSPRINT1("");
{
int i;
module_servlist_p serv;
module_globlist_p glob;
module_arg_t *args;
STATUSPRINT1("Number of modules: %i",modules.num);
STATUSPRINT1("Pcontrol Setting: %i",modules.pcontrol);
STATUSPRINT1("");
for (i=0; i<modules.num; i++)
{
if (modules.module[i]->registered)
{
STATUSPRINT1("Module %s: registered as %s (Pctrl %i)",
modules.module[i]->name,
modules.module[i]->username,
modules.module[i]->pcontrol);
}
else
{
if (modules.module[i]->stack_delimiter)
{ STATUSPRINT1("Stack %s: not registered",
modules.module[i]->name);
}
else
{ STATUSPRINT1("Module %s: not registered (Pctrl %i)",
modules.module[i]->name,
modules.module[i]->pcontrol);
}
}
for (args=modules.module[i]->args; args!=NULL; args=args->next)
{
STATUSPRINT1("\tArgument: %s = %s",
args->name,args->value);
}
for (serv=modules.module[i]->services; serv!=NULL; serv=serv->next)
{
STATUSPRINT1("\tService: %s (%s)",
serv->desc.name,serv->desc.sig);
}
for (glob=modules.module[i]->globals; glob!=NULL; glob=glob->next)
{
STATUSPRINT1("\tGlobal: %s (%c)",
glob->desc.name,glob->desc.sig);
}
}
STATUSPRINT1("");
}
return returnVal;
}
