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; }