Actual source code: mpinit.c


 3:  #include petscsys.h

  5: static MPI_Comm saved_PETSC_COMM_WORLD = 0;
  6: MPI_Comm PETSC_COMM_LOCAL_WORLD        = 0;           /* comm for a single node (local set of processes) */
  7: PetscTruth PetscOpenMPWorker           = PETSC_FALSE;  /* this is a regular process, nonworker process */
  8: void* PetscOpenMPCtx                   = 0;


 12: #if defined(PETSC_HAVE_MPI_COMM_SPAWN)
 15: /*@C
 16:    PetscOpenMPSpawn - Initialize additional processes to be used as "worker" processes. This is not generally 
 17:      called by users. One should use -openmp_spawn_size <n> to indicate that you wish to have n-1 new MPI 
 18:      processes spawned for each current process.

 20:    Not Collective (could make collective on MPI_COMM_WORLD, generate one huge comm and then split it up)

 22:    Input Parameter:
 23: .  nodesize - size of each compute node that will share processors

 25:    Options Database:
 26: .   -openmp_spawn_size nodesize

 28:    Notes: This is only supported on systems with an MPI 2 implementation that includes the MPI_Comm_Spawn() routine.

 30: $    Comparison of two approaches for OpenMP usage (MPI started with N processes)
 31: $
 32: $    -openmp_spawn_size <n> requires MPI 2, results in n*N total processes with N directly used by application code
 33: $                                           and n-1 worker processes (used by PETSc) for each application node.
 34: $                           You MUST launch MPI so that only ONE MPI process is created for each hardware node.
 35: $
 36: $    -openmp_merge_size <n> results in N total processes, N/n used by the application code and the rest worker processes
 37: $                            (used by PETSc)
 38: $                           You MUST launch MPI so that n MPI processes are created for each hardware node.
 39: $
 40: $    petscmpiexec -n 2 ./ex1 -openmp_spawn_size 3 gives 2 application nodes (and 4 PETSc worker nodes)
 41: $    petscmpiexec -n 6 ./ex1 -openmp_merge_size 3 gives the SAME 2 application nodes and 4 PETSc worker nodes
 42: $       This is what would use if each of the computers hardware nodes had 3 CPUs.
 43: $
 44: $      These are intended to be used in conjunction with USER OpenMP code. The user will have 1 process per
 45: $   computer (hardware) node (where the computer node has p cpus), the user's code will use threads to fully
 46: $   utilize all the CPUs on the node. The PETSc code will have p processes to fully use the compute node for 
 47: $   PETSc calculations. The user THREADS and PETSc PROCESSES will NEVER run at the same time so the p CPUs 
 48: $   are always working on p task, never more than p.
 49: $
 50: $    See PCOPENMP for a PETSc preconditioner that can use this functionality
 51: $

 53:    For both PetscOpenMPSpawn() and PetscOpenMPMerge() PETSC_COMM_WORLD consists of one process per "node", PETSC_COMM_LOCAL_WORLD
 54:    consists of all the processes in a "node."

 56:    In both cases the user's code is running ONLY on PETSC_COMM_WORLD (that was newly generated by running this command).

 58:    Level: developer

 60:    Concepts: OpenMP
 61:    
 62: .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscOpenMPFinalize(), PetscInitialize(), PetscOpenMPMerge(), PetscOpenMPRun()

 64: @*/
 65: PetscErrorCode  PetscOpenMPSpawn(PetscMPIInt nodesize)
 66: {
 68:   PetscMPIInt    size;
 69:   MPI_Comm       parent,children;
 70: 
 72:   MPI_Comm_get_parent(&parent);
 73:   if (parent == MPI_COMM_NULL) {  /* the original processes started by user */
 74:     char programname[PETSC_MAX_PATH_LEN];
 75:     char **argv;

 77:     PetscGetProgramName(programname,PETSC_MAX_PATH_LEN);
 78:     PetscGetArguments(&argv);
 79:     MPI_Comm_spawn(programname,argv,nodesize-1,MPI_INFO_NULL,0,PETSC_COMM_SELF,&children,MPI_ERRCODES_IGNORE);
 80:     PetscFreeArguments(argv);
 81:     MPI_Intercomm_merge(children,0,&PETSC_COMM_LOCAL_WORLD);

 83:     MPI_Comm_size(PETSC_COMM_WORLD,&size);
 84:     PetscInfo2(0,"PETSc OpenMP successfully spawned: number of nodes = %d node size = %d\n",size,nodesize);
 85:     saved_PETSC_COMM_WORLD = PETSC_COMM_WORLD;
 86:   } else { /* worker nodes that get spawned */
 87:     MPI_Intercomm_merge(parent,1,&PETSC_COMM_LOCAL_WORLD);
 88:     PetscOpenMPHandle(PETSC_COMM_LOCAL_WORLD);
 89:     PetscOpenMPWorker = PETSC_TRUE; /* so that PetscOpenMPIFinalize() will not attempt a broadcast from this process */
 90:     PetscEnd();  /* cannot continue into user code */
 91:   }
 92:   return(0);
 93: }
 94: #endif

 98: /*@C
 99:    PetscOpenMPMerge - Initializes the PETSc and MPI to work with OpenMP. This is not usually called
100:       by the user. One should use -openmp_merge_size <n> to indicate the node size of merged communicator
101:       to be.

103:    Collective on MPI_COMM_WORLD or PETSC_COMM_WORLD if it has been set

105:    Input Parameter:
106: +  nodesize - size of each compute node that will share processors
107: .  func - optional function to call on the master nodes
108: -  ctx - context passed to function on master nodes

110:    Options Database:
111: .   -openmp_merge_size <n>

113:    Level: developer

115: $    Comparison of two approaches for OpenMP usage (MPI started with N processes)
116: $
117: $    -openmp_spawn_size <n> requires MPI 2, results in n*N total processes with N directly used by application code
118: $                                           and n-1 worker processes (used by PETSc) for each application node.
119: $                           You MUST launch MPI so that only ONE MPI process is created for each hardware node.
120: $
121: $    -openmp_merge_size <n> results in N total processes, N/n used by the application code and the rest worker processes
122: $                            (used by PETSc)
123: $                           You MUST launch MPI so that n MPI processes are created for each hardware node.
124: $
125: $    petscmpiexec -n 2 ./ex1 -openmp_spawn_size 3 gives 2 application nodes (and 4 PETSc worker nodes)
126: $    petscmpiexec -n 6 ./ex1 -openmp_merge_size 3 gives the SAME 2 application nodes and 4 PETSc worker nodes
127: $       This is what would use if each of the computers hardware nodes had 3 CPUs.
128: $
129: $      These are intended to be used in conjunction with USER OpenMP code. The user will have 1 process per
130: $   computer (hardware) node (where the computer node has p cpus), the user's code will use threads to fully
131: $   utilize all the CPUs on the node. The PETSc code will have p processes to fully use the compute node for 
132: $   PETSc calculations. The user THREADS and PETSc PROCESSES will NEVER run at the same time so the p CPUs 
133: $   are always working on p task, never more than p.
134: $
135: $    See PCOPENMP for a PETSc preconditioner that can use this functionality
136: $

138:    For both PetscOpenMPSpawn() and PetscOpenMPMerge() PETSC_COMM_WORLD consists of one process per "node", PETSC_COMM_LOCAL_WORLD
139:    consists of all the processes in a "node."

141:    In both cases the user's code is running ONLY on PETSC_COMM_WORLD (that was newly generated by running this command).

143:    Concepts: OpenMP
144:    
145: .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscOpenMPFinalize(), PetscInitialize(), PetscOpenMPSpawn(), PetscOpenMPRun()

147: @*/
148: PetscErrorCode  PetscOpenMPMerge(PetscMPIInt nodesize,PetscErrorCode (*func)(void*),void *ctx)
149: {
151:   PetscMPIInt    size,rank,*ranks,i;
152:   MPI_Group      group,newgroup;

155:   saved_PETSC_COMM_WORLD = PETSC_COMM_WORLD;

157:   MPI_Comm_size(saved_PETSC_COMM_WORLD,&size);
158:   if (size % nodesize) SETERRQ2(PETSC_ERR_ARG_SIZ,"Total number of process nodes %d is not divisible by number of processes per node %d",size,nodesize);
159:   MPI_Comm_rank(saved_PETSC_COMM_WORLD,&rank);


162:   /* create two communicators 
163:       *) one that contains the first process from each node: 0,nodesize,2*nodesize,...
164:       *) one that contains all processes in a node:  (0,1,2...,nodesize-1), (nodesize,nodesize+1,...2*nodesize-), ...
165:   */
166:   MPI_Comm_group(saved_PETSC_COMM_WORLD,&group);
167:   PetscMalloc((size/nodesize)*sizeof(PetscMPIInt),&ranks);
168:   for (i=0; i<(size/nodesize); i++) ranks[i] = i*nodesize;
169:   MPI_Group_incl(group,size/nodesize,ranks,&newgroup);
170:   PetscFree(ranks);
171:   MPI_Comm_create(saved_PETSC_COMM_WORLD,newgroup,&PETSC_COMM_WORLD);
172:   if (rank % nodesize) PETSC_COMM_WORLD = 0; /* mark invalid processes for easy debugging */
173:   MPI_Group_free(&group);
174:   MPI_Group_free(&newgroup);

176:   MPI_Comm_split(saved_PETSC_COMM_WORLD,rank/nodesize,rank % nodesize,&PETSC_COMM_LOCAL_WORLD);

178:   PetscInfo2(0,"PETSc OpenMP successfully started: number of nodes = %d node size = %d\n",size/nodesize,nodesize);
179:   PetscInfo1(0,"PETSc OpenMP process %sactive\n",(rank % nodesize) ? "in" : "");

181:   PetscOpenMPCtx = ctx;
182:   /* 
183:      All process not involved in user application code wait here
184:   */
185:   if (!PETSC_COMM_WORLD) {
186:     PetscOpenMPHandle(PETSC_COMM_LOCAL_WORLD);
187:     PETSC_COMM_WORLD  = saved_PETSC_COMM_WORLD;
188:     PetscOpenMPWorker = PETSC_TRUE; /* so that PetscOpenMPIFinalize() will not attempt a broadcast from this process */
189:     PetscInfo(0,"PETSc OpenMP inactive process becoming active");
190:   } else {
191:     if (func) {
192:       (*func)(ctx);
193:     }
194:   }
195:   return(0);
196: }

200: /*@C
201:    PetscOpenMPFinalize - Finalizes the PETSc and MPI to work with OpenMP. Called by PetscFinalize() cannot
202:        be called by user.

204:    Collective on the entire system

206:    Level: developer
207:            
208: .seealso: PetscFinalize(), PetscGetArgs(), PetscOpenMPMerge(), PCOpenMPRun()

210: @*/
211: PetscErrorCode  PetscOpenMPFinalize(void)
212: {
213:   PetscErrorCode 0;
214:   PetscInt       command = 3;

217:   if (!PetscOpenMPWorker && PETSC_COMM_LOCAL_WORLD) {
218:     MPI_Bcast(&command,1,MPIU_INT,0,PETSC_COMM_LOCAL_WORLD); /* broadcast to my worker group to end program */
219:     PETSC_COMM_WORLD = saved_PETSC_COMM_WORLD;
220:     PetscInfo(0,"PETSc OpenMP active process ending PetscOpenMPMerge()");
221:   }
222:   PetscFunctionReturn(ierr);
223: }

225: static PetscInt numberobjects = 0;
226: static void     *objects[100];

230: /*@C
231:    PetscOpenMPHandle - Receives commands from the master node and processes them

233:    Collective on MPI_Comm

235:    Input Parameter:
236: .   comm - Must be PETSC_COMM_LOCAL_WORLD

238:    Level: developer

240:    Notes: this is usually handled automatically, likely you do not need to use this directly

242:    Developer Notes: Since comm must be PETSC_COMM_LOCAL_WORLD, why have this argument?
243:            
244: .seealso: PetscOpenMPMerge(), PCOpenMPRun(), PCOpenMPNew()

246: @*/
247: PetscErrorCode  PetscOpenMPHandle(MPI_Comm comm)
248: {
250:   PetscInt       command;
251:   PetscTruth     exitwhileloop = PETSC_FALSE;

254:   while (!exitwhileloop) {
255:     MPI_Bcast(&command,1,MPIU_INT,0,comm);
256:     switch (command) {
257:     case 0: { /* allocate some memory on this worker process */
258:       size_t   n;
259:       void     *ptr;
260:       MPI_Bcast(&n,1,MPIU_SIZE_T,0,comm);
261:       /* cannot use PetscNew() cause it requires struct argument */
262:       PetscMalloc(n,&ptr);
263:       PetscMemzero(ptr,n);
264:       objects[numberobjects++] = ptr;
265:       break;
266:     }
267:     case 1: {  /* free some memory on this worker process */
268:       PetscInt i;
269:       MPI_Bcast(&i,1,MPIU_INT,0,comm);
270:       PetscFree(objects[i]);
271:       objects[i] = 0;
272:       break;
273:     }
274:     case 2: {  /* run a function on this worker process */
275:       PetscInt       i;
276:       PetscErrorCode (*f)(MPI_Comm,void*);
277:       MPI_Bcast(&i,1,MPIU_INT,0,comm);
278:       MPI_Bcast(&f,1,MPIU_SIZE_T,0,comm);
279:       (*f)(comm,objects[i]);
280:       break;
281:     }
282:     case 4: {  /* run a function on this worker process with provided context */
283:       PetscInt       i;
284:       PetscErrorCode (*f)(MPI_Comm,void*,void*);
285:       MPI_Bcast(&i,1,MPIU_INT,0,comm);
286:       MPI_Bcast(&f,1,MPIU_SIZE_T,0,comm);
287:       (*f)(comm,PetscOpenMPCtx,objects[i]);
288:       break;
289:     }
290:     case 3: {
291:       exitwhileloop = PETSC_TRUE;
292:       break;
293:     }
294:     default:
295:       SETERRQ1(PETSC_ERR_PLIB,"Unknown OpenMP command %D",command);
296:     }
297:   }
298:   return(0);
299: }

303: /*@C
304:    PetscOpenMPMalloc - Creates a "c struct" on all nodes of an OpenMP communicator

306:    Collective on MPI_Comm

308:    Input Parameters:
309: +   comm - Must be PETSC_COMM_LOCAL_WORLD
310: -   n  - amount of memory requested

312:    Level: developer

314:    Developer Notes: Since comm must be PETSC_COMM_LOCAL_WORLD, why have this argument?

316: .seealso: PetscOpenMPMerge(), PCOpenMPRun(), PCOpenMPFree()

318: @*/
319: PetscErrorCode  PetscOpenMPMalloc(MPI_Comm comm,size_t n,void **ptr)
320: {
322:   PetscInt       command = 0;

325:   if (PetscOpenMPWorker) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not using OpenMP feature of PETSc");

327:   MPI_Bcast(&command,1,MPIU_INT,0,comm);
328:   MPI_Bcast(&n,1,MPIU_SIZE_T,0,comm);
329:   /* cannot use PetscNew() cause it requires struct argument */
330:   PetscMalloc(n,ptr);
331:   PetscMemzero(*ptr,n);
332:   objects[numberobjects++] = *ptr;
333:   return(0);
334: }

338: /*@C
339:    PetscOpenMPFree - Frees a "c struct" on all nodes of an OpenMP communicator

341:    Collective on MPI_Comm

343:    Input Parameters:
344: +   comm - Must be PETSC_COMM_LOCAL_WORLD
345: -   ptr - pointer to data to be freed, must have been obtained with PetscOpenMPMalloc()

347:    Level: developer
348:            
349:   Developer Notes: Since comm must be PETSC_COMM_LOCAL_WORLD, why have this argument?

351: .seealso: PetscOpenMPMerge(), PetscOpenMPMalloc()

353: @*/
354: PetscErrorCode  PetscOpenMPFree(MPI_Comm comm,void *ptr)
355: {
357:   PetscInt       command = 1,i;

360:   if (PetscOpenMPWorker) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not using OpenMP feature of PETSc");

362:   MPI_Bcast(&command,1,MPIU_INT,0,comm);
363:   for (i=0; i<numberobjects; i++) {
364:     if (objects[i] == ptr) {
365:       MPI_Bcast(&i,1,MPIU_INT,0,comm);
366:       PetscFree(ptr);
367:       objects[i] = 0;
368:       return(0);
369:     }
370:   }
371:   SETERRQ(PETSC_ERR_ARG_WRONG,"Pointer does not appear to have been created with PetscOpenMPMalloc()");
372:   PetscFunctionReturn(ierr);
373: }

377: /*@C
378:    PetscOpenMPRun - runs a function on all the processes of a node

380:    Collective on MPI_Comm

382:    Input Parameters:
383: +   comm - communicator to run function on, must be PETSC_COMM_LOCAL_WORLD
384: .   f - function to run
385: -   ptr - pointer to data to pass to function; must be obtained with PetscOpenMPMalloc()

387:    Level: developer
388:            
389:    Developer Notes: Since comm must be PETSC_COMM_LOCAL_WORLD, why have this argument?

391: .seealso: PetscOpenMPMerge(), PetscOpenMPMalloc(), PetscOpenMPFree(), PetscOpenMPRunCtx()

393: @*/
394: PetscErrorCode  PetscOpenMPRun(MPI_Comm comm,PetscErrorCode (*f)(MPI_Comm,void *),void *ptr)
395: {
397:   PetscInt       command = 2,i;

400:   if (PetscOpenMPWorker) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not using OpenMP feature of PETSc");

402:   MPI_Bcast(&command,1,MPIU_INT,0,comm);
403:   for (i=0; i<numberobjects; i++) {
404:     if (objects[i] == ptr) {
405:       MPI_Bcast(&i,1,MPIU_INT,0,comm);
406:       MPI_Bcast(&f,1,MPIU_SIZE_T,0,comm);
407:       (*f)(comm,ptr);
408:       return(0);
409:     }
410:   }
411:   SETERRQ(PETSC_ERR_ARG_WRONG,"Pointer does not appear to have been created with PetscOpenMPMalloc()");
412:   PetscFunctionReturn(ierr);
413: }

417: /*@C
418:    PetscOpenMPRunCtx - runs a function on all the processes of a node

420:    Collective on MPI_Comm

422:    Input Parameters:
423: +   comm - communicator to run function on, must be PETSC_COMM_LOCAL_WORLD
424: .   f - function to run
425: -   ptr - pointer to data to pass to function; must be obtained with PetscOpenMPMalloc()

427:    Notes: This is like PetscOpenMPRun() except it also passes the context passed in PetscOpenMPMerge()
428:    Level: developer
429:            
430:    Developer Notes: Since comm must be PETSC_COMM_LOCAL_WORLD, why have this argument?

432: .seealso: PetscOpenMPMerge(), PetscOpenMPMalloc(), PetscOpenMPFree(), PetscOpenMPRun()

434: @*/
435: PetscErrorCode  PetscOpenMPRunCtx(MPI_Comm comm,PetscErrorCode (*f)(MPI_Comm,void*,void *),void *ptr)
436: {
438:   PetscInt       command = 4,i;

441:   if (PetscOpenMPWorker) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not using OpenMP feature of PETSc");

443:   MPI_Bcast(&command,1,MPIU_INT,0,comm);
444:   for (i=0; i<numberobjects; i++) {
445:     if (objects[i] == ptr) {
446:       MPI_Bcast(&i,1,MPIU_INT,0,comm);
447:       MPI_Bcast(&f,1,MPIU_SIZE_T,0,comm);
448:       (*f)(comm,PetscOpenMPCtx,ptr);
449:       return(0);
450:     }
451:   }
452:   SETERRQ(PETSC_ERR_ARG_WRONG,"Pointer does not appear to have been created with PetscOpenMPMalloc()");
453:   PetscFunctionReturn(ierr);
454: }