xref: /petsc/src/sys/objects/init.c (revision fdc842d1a43d22858d8041cc45d2f5b4ad073a0b)
1 /*
2 
3    This file defines part of the initialization of PETSc
4 
5   This file uses regular malloc and free because it cannot known
6   what malloc is being used until it has already processed the input.
7 */
8 
9 #include <petscsys.h>        /*I  "petscsys.h"   I*/
10 #include <petsc/private/petscimpl.h>
11 #include <petscvalgrind.h>
12 #include <petscviewer.h>
13 #if defined(PETSC_USE_LOG)
14 PETSC_INTERN PetscErrorCode PetscLogInitialize(void);
15 #endif
16 
17 #if defined(PETSC_HAVE_SYS_SYSINFO_H)
18 #include <sys/sysinfo.h>
19 #endif
20 #if defined(PETSC_HAVE_UNISTD_H)
21 #include <unistd.h>
22 #endif
23 #if defined(PETSC_HAVE_CUDA)
24 #include <cuda_runtime.h>
25 extern PetscErrorCode PetscCUBLASInitializeHandle(void);
26 #endif
27 
28 #if defined(PETSC_HAVE_VIENNACL)
29 PETSC_EXTERN PetscErrorCode PetscViennaCLInit();
30 #endif
31 
32 /* ------------------------Nasty global variables -------------------------------*/
33 /*
34      Indicates if PETSc started up MPI, or it was
35    already started before PETSc was initialized.
36 */
37 PetscBool   PetscBeganMPI         = PETSC_FALSE;
38 PetscBool   PetscInitializeCalled = PETSC_FALSE;
39 PetscBool   PetscFinalizeCalled   = PETSC_FALSE;
40 PetscBool   PetscCUDAInitialized  = PETSC_FALSE;
41 
42 PetscMPIInt PetscGlobalRank       = -1;
43 PetscMPIInt PetscGlobalSize       = -1;
44 
45 #if defined(PETSC_HAVE_COMPLEX)
46 #if defined(PETSC_COMPLEX_INSTANTIATE)
47 template <> class std::complex<double>; /* instantiate complex template class */
48 #endif
49 #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)
50 MPI_Datatype MPIU_C_DOUBLE_COMPLEX;
51 MPI_Datatype MPIU_C_COMPLEX;
52 #endif
53 
54 /*MC
55    PETSC_i - the imaginary number i
56 
57    Synopsis:
58    #include <petscsys.h>
59    PetscComplex PETSC_i;
60 
61    Level: beginner
62 
63    Note:
64    Complex numbers are automatically available if PETSc located a working complex implementation
65 
66 .seealso: PetscRealPart(), PetscImaginaryPart(), PetscRealPartComplex(), PetscImaginaryPartComplex()
67 M*/
68 PetscComplex PETSC_i;
69 #endif
70 #if defined(PETSC_USE_REAL___FLOAT128)
71 MPI_Datatype MPIU___FLOAT128 = 0;
72 #if defined(PETSC_HAVE_COMPLEX)
73 MPI_Datatype MPIU___COMPLEX128 = 0;
74 #endif
75 #elif defined(PETSC_USE_REAL___FP16)
76 MPI_Datatype MPIU___FP16 = 0;
77 #endif
78 MPI_Datatype MPIU_2SCALAR = 0;
79 #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT)
80 MPI_Datatype MPIU_2INT = 0;
81 #endif
82 MPI_Datatype MPIU_BOOL;
83 MPI_Datatype MPIU_ENUM;
84 MPI_Datatype MPIU_FORTRANADDR;
85 MPI_Datatype MPIU_SIZE_T;
86 
87 /*
88        Function that is called to display all error messages
89 */
90 PetscErrorCode (*PetscErrorPrintf)(const char [],...)          = PetscErrorPrintfDefault;
91 PetscErrorCode (*PetscHelpPrintf)(MPI_Comm,const char [],...)  = PetscHelpPrintfDefault;
92 PetscErrorCode (*PetscVFPrintf)(FILE*,const char[],va_list)    = PetscVFPrintfDefault;
93 /*
94   This is needed to turn on/off GPU synchronization
95 */
96 PetscBool PetscViennaCLSynchronize = PETSC_FALSE;
97 PetscBool PetscCUDASynchronize = PETSC_FALSE;
98 
99 /* ------------------------------------------------------------------------------*/
100 /*
101    Optional file where all PETSc output from various prints is saved
102 */
103 PETSC_INTERN FILE *petsc_history;
104 FILE *petsc_history = NULL;
105 
106 PetscErrorCode  PetscOpenHistoryFile(const char filename[],FILE **fd)
107 {
108   PetscErrorCode ierr;
109   PetscMPIInt    rank,size;
110   char           pfile[PETSC_MAX_PATH_LEN],pname[PETSC_MAX_PATH_LEN],fname[PETSC_MAX_PATH_LEN],date[64];
111   char           version[256];
112 
113   PetscFunctionBegin;
114   ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
115   if (!rank) {
116     char        arch[10];
117     int         err;
118 
119     ierr = PetscGetArchType(arch,10);CHKERRQ(ierr);
120     ierr = PetscGetDate(date,64);CHKERRQ(ierr);
121     ierr = PetscGetVersion(version,256);CHKERRQ(ierr);
122     ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
123     if (filename) {
124       ierr = PetscFixFilename(filename,fname);CHKERRQ(ierr);
125     } else {
126       ierr = PetscGetHomeDirectory(pfile,240);CHKERRQ(ierr);
127       ierr = PetscStrcat(pfile,"/.petschistory");CHKERRQ(ierr);
128       ierr = PetscFixFilename(pfile,fname);CHKERRQ(ierr);
129     }
130 
131     *fd = fopen(fname,"a");
132     if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open file: %s",fname);
133 
134     ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"---------------------------------------------------------\n");CHKERRQ(ierr);
135     ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"%s %s\n",version,date);CHKERRQ(ierr);
136     ierr = PetscGetProgramName(pname,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
137     ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"%s on a %s, %d proc. with options:\n",pname,arch,size);CHKERRQ(ierr);
138     ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"---------------------------------------------------------\n");CHKERRQ(ierr);
139 
140     err = fflush(*fd);
141     if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
142   }
143   PetscFunctionReturn(0);
144 }
145 
146 PETSC_INTERN PetscErrorCode PetscCloseHistoryFile(FILE **fd)
147 {
148   PetscErrorCode ierr;
149   PetscMPIInt    rank;
150   char           date[64];
151   int            err;
152 
153   PetscFunctionBegin;
154   ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
155   if (!rank) {
156     ierr = PetscGetDate(date,64);CHKERRQ(ierr);
157     ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"---------------------------------------------------------\n");CHKERRQ(ierr);
158     ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"Finished at %s\n",date);CHKERRQ(ierr);
159     ierr = PetscFPrintf(PETSC_COMM_SELF,*fd,"---------------------------------------------------------\n");CHKERRQ(ierr);
160     err  = fflush(*fd);
161     if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
162     err = fclose(*fd);
163     if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
164   }
165   PetscFunctionReturn(0);
166 }
167 
168 /* ------------------------------------------------------------------------------*/
169 
170 /*
171    This is ugly and probably belongs somewhere else, but I want to
172   be able to put a true MPI abort error handler with command line args.
173 
174     This is so MPI errors in the debugger will leave all the stack
175   frames. The default MP_Abort() cleans up and exits thus providing no useful information
176   in the debugger hence we call abort() instead of MPI_Abort().
177 */
178 
179 void Petsc_MPI_AbortOnError(MPI_Comm *comm,PetscMPIInt *flag,...)
180 {
181   PetscFunctionBegin;
182   (*PetscErrorPrintf)("MPI error %d\n",*flag);
183   abort();
184 }
185 
186 void Petsc_MPI_DebuggerOnError(MPI_Comm *comm,PetscMPIInt *flag,...)
187 {
188   PetscErrorCode ierr;
189 
190   PetscFunctionBegin;
191   (*PetscErrorPrintf)("MPI error %d\n",*flag);
192   ierr = PetscAttachDebugger();
193   if (ierr) MPI_Abort(*comm,*flag); /* hopeless so get out */
194 }
195 
196 /*@C
197    PetscEnd - Calls PetscFinalize() and then ends the program. This is useful if one
198      wishes a clean exit somewhere deep in the program.
199 
200    Collective on PETSC_COMM_WORLD
201 
202    Options Database Keys are the same as for PetscFinalize()
203 
204    Level: advanced
205 
206    Note:
207    See PetscInitialize() for more general runtime options.
208 
209 .seealso: PetscInitialize(), PetscOptionsView(), PetscMallocDump(), PetscMPIDump(), PetscFinalize()
210 @*/
211 PetscErrorCode  PetscEnd(void)
212 {
213   PetscFunctionBegin;
214   PetscFinalize();
215   exit(0);
216   return 0;
217 }
218 
219 PetscBool PetscOptionsPublish = PETSC_FALSE;
220 PETSC_INTERN PetscErrorCode PetscSetUseTrMalloc_Private(void);
221 PETSC_INTERN PetscErrorCode PetscSetUseHBWMalloc_Private(void);
222 PETSC_INTERN PetscBool      petscsetmallocvisited;
223 static       char           emacsmachinename[256];
224 
225 PetscErrorCode (*PetscExternalVersionFunction)(MPI_Comm) = 0;
226 PetscErrorCode (*PetscExternalHelpFunction)(MPI_Comm)    = 0;
227 
228 /*@C
229    PetscSetHelpVersionFunctions - Sets functions that print help and version information
230    before the PETSc help and version information is printed. Must call BEFORE PetscInitialize().
231    This routine enables a "higher-level" package that uses PETSc to print its messages first.
232 
233    Input Parameter:
234 +  help - the help function (may be NULL)
235 -  version - the version function (may be NULL)
236 
237    Level: developer
238 
239 @*/
240 PetscErrorCode  PetscSetHelpVersionFunctions(PetscErrorCode (*help)(MPI_Comm),PetscErrorCode (*version)(MPI_Comm))
241 {
242   PetscFunctionBegin;
243   PetscExternalHelpFunction    = help;
244   PetscExternalVersionFunction = version;
245   PetscFunctionReturn(0);
246 }
247 
248 #if defined(PETSC_USE_LOG)
249 PETSC_INTERN PetscBool   PetscObjectsLog;
250 #endif
251 
252 PETSC_INTERN PetscErrorCode  PetscOptionsCheckInitial_Private(void)
253 {
254   char              string[64],mname[PETSC_MAX_PATH_LEN],*f;
255   MPI_Comm          comm = PETSC_COMM_WORLD;
256   PetscBool         flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,flg3 = PETSC_FALSE,flag;
257   PetscErrorCode    ierr;
258   PetscReal         si;
259   PetscInt          intensity;
260   int               i;
261   PetscMPIInt       rank;
262   char              version[256],helpoptions[256];
263 #if !defined(PETSC_HAVE_THREADSAFETY)
264   PetscReal         logthreshold;
265 #endif
266 #if defined(PETSC_USE_LOG)
267   PetscViewerFormat format;
268   PetscBool         flg4 = PETSC_FALSE;
269 #endif
270 #if defined(PETSC_HAVE_CUDA)
271   int               device;
272   PetscInt          deviceOpt = 0;
273   PetscBool         cuda_view_flag = PETSC_FALSE;
274 #endif
275   PetscFunctionBegin;
276   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
277 
278 #if !defined(PETSC_HAVE_THREADSAFETY)
279   /*
280       Setup the memory management; support for tracing malloc() usage
281   */
282   ierr = PetscOptionsHasName(NULL,NULL,"-malloc_log",&flg3);CHKERRQ(ierr);
283   logthreshold = 0.0;
284   ierr = PetscOptionsGetReal(NULL,NULL,"-malloc_log_threshold",&logthreshold,&flg1);CHKERRQ(ierr);
285   if (flg1) flg3 = PETSC_TRUE;
286 #if defined(PETSC_USE_DEBUG)
287   ierr = PetscOptionsGetBool(NULL,NULL,"-malloc",&flg1,&flg2);CHKERRQ(ierr);
288   if ((!flg2 || flg1) && !petscsetmallocvisited) {
289     if (flg2 || !(PETSC_RUNNING_ON_VALGRIND)) {
290       /* turn off default -malloc if valgrind is being used */
291       ierr = PetscSetUseTrMalloc_Private();CHKERRQ(ierr);
292     }
293   }
294 #else
295   ierr = PetscOptionsGetBool(NULL,NULL,"-malloc_dump",&flg1,NULL);CHKERRQ(ierr);
296   ierr = PetscOptionsGetBool(NULL,NULL,"-malloc",&flg2,NULL);CHKERRQ(ierr);
297   if (flg1 || flg2 || flg3) {ierr = PetscSetUseTrMalloc_Private();CHKERRQ(ierr);}
298 #endif
299   if (flg3) {
300     ierr = PetscMallocSetDumpLogThreshold((PetscLogDouble)logthreshold);CHKERRQ(ierr);
301   }
302   ierr = PetscOptionsGetBool(NULL,NULL,"-malloc_coalesce",&flg1,&flg2);CHKERRQ(ierr);
303   if (flg2) {ierr = PetscMallocSetCoalesce(flg1);CHKERRQ(ierr);}
304   flg1 = PETSC_FALSE;
305   ierr = PetscOptionsGetBool(NULL,NULL,"-malloc_debug",&flg1,NULL);CHKERRQ(ierr);
306   if (flg1) {
307     ierr = PetscSetUseTrMalloc_Private();CHKERRQ(ierr);
308     ierr = PetscMallocDebug(PETSC_TRUE);CHKERRQ(ierr);
309   }
310   flg1 = PETSC_FALSE;
311   ierr = PetscOptionsGetBool(NULL,NULL,"-malloc_test",&flg1,NULL);CHKERRQ(ierr);
312 #if defined(PETSC_USE_DEBUG)
313   if (flg1 && !PETSC_RUNNING_ON_VALGRIND) {
314     ierr = PetscSetUseTrMalloc_Private();CHKERRQ(ierr);
315     ierr = PetscMallocSetDumpLog();CHKERRQ(ierr);
316     ierr = PetscMallocDebug(PETSC_TRUE);CHKERRQ(ierr);
317   }
318 #endif
319   flg1 = PETSC_FALSE;
320   ierr = PetscOptionsGetBool(NULL,NULL,"-malloc_hbw",&flg1,NULL);CHKERRQ(ierr);
321   /* ignore this option if malloc is already set */
322   if (flg1 && !petscsetmallocvisited) {ierr = PetscSetUseHBWMalloc_Private();CHKERRQ(ierr);}
323 
324   flg1 = PETSC_FALSE;
325   ierr = PetscOptionsGetBool(NULL,NULL,"-malloc_info",&flg1,NULL);CHKERRQ(ierr);
326   if (!flg1) {
327     flg1 = PETSC_FALSE;
328     ierr = PetscOptionsGetBool(NULL,NULL,"-memory_view",&flg1,NULL);CHKERRQ(ierr);
329   }
330   if (flg1) {
331     ierr = PetscMemorySetGetMaximumUsage();CHKERRQ(ierr);
332   }
333 #endif
334 
335 #if defined(PETSC_USE_LOG)
336   ierr = PetscOptionsHasName(NULL,NULL,"-objects_dump",&PetscObjectsLog);CHKERRQ(ierr);
337 #endif
338 
339   /*
340       Set the display variable for graphics
341   */
342   ierr = PetscSetDisplay();CHKERRQ(ierr);
343 
344   /*
345       Print the PETSc version information
346   */
347   ierr = PetscOptionsHasName(NULL,NULL,"-v",&flg1);CHKERRQ(ierr);
348   ierr = PetscOptionsHasName(NULL,NULL,"-version",&flg2);CHKERRQ(ierr);
349   ierr = PetscOptionsHasHelp(NULL,&flg3);CHKERRQ(ierr);
350   if (flg1 || flg2 || flg3) {
351 
352     /*
353        Print "higher-level" package version message
354     */
355     if (PetscExternalVersionFunction) {
356       ierr = (*PetscExternalVersionFunction)(comm);CHKERRQ(ierr);
357     }
358 
359     ierr = PetscGetVersion(version,256);CHKERRQ(ierr);
360     ierr = (*PetscHelpPrintf)(comm,"--------------------------------------------------------------------------\n");CHKERRQ(ierr);
361     ierr = (*PetscHelpPrintf)(comm,"%s\n",version);CHKERRQ(ierr);
362     ierr = (*PetscHelpPrintf)(comm,"%s",PETSC_AUTHOR_INFO);CHKERRQ(ierr);
363     ierr = (*PetscHelpPrintf)(comm,"See docs/changes/index.html for recent updates.\n");CHKERRQ(ierr);
364     ierr = (*PetscHelpPrintf)(comm,"See docs/faq.html for problems.\n");CHKERRQ(ierr);
365     ierr = (*PetscHelpPrintf)(comm,"See docs/manualpages/index.html for help. \n");CHKERRQ(ierr);
366     ierr = (*PetscHelpPrintf)(comm,"Libraries linked from %s\n",PETSC_LIB_DIR);CHKERRQ(ierr);
367     ierr = (*PetscHelpPrintf)(comm,"--------------------------------------------------------------------------\n");CHKERRQ(ierr);
368   }
369 
370   /*
371        Print "higher-level" package help message
372   */
373   if (flg3) {
374     if (PetscExternalHelpFunction) {
375       ierr = (*PetscExternalHelpFunction)(comm);CHKERRQ(ierr);
376     }
377   }
378 
379   ierr = PetscOptionsGetString(NULL,NULL,"-help",helpoptions,sizeof(helpoptions),&flg1);CHKERRQ(ierr);
380   if (flg1) {
381     ierr = PetscStrcmp(helpoptions,"intro",&flg2);CHKERRQ(ierr);
382     if (flg2) {
383       ierr = PetscOptionsDestroyDefault();CHKERRQ(ierr);
384       ierr = PetscFreeMPIResources();CHKERRQ(ierr);
385       ierr = MPI_Finalize();CHKERRQ(ierr);
386       exit(0);
387     }
388   }
389 
390   /*
391       Setup the error handling
392   */
393   flg1 = PETSC_FALSE;
394   ierr = PetscOptionsGetBool(NULL,NULL,"-on_error_abort",&flg1,NULL);CHKERRQ(ierr);
395   if (flg1) {
396     ierr = MPI_Comm_set_errhandler(comm,MPI_ERRORS_ARE_FATAL);CHKERRQ(ierr);
397     ierr = PetscPushErrorHandler(PetscAbortErrorHandler,0);CHKERRQ(ierr);
398   }
399   flg1 = PETSC_FALSE;
400   ierr = PetscOptionsGetBool(NULL,NULL,"-on_error_mpiabort",&flg1,NULL);CHKERRQ(ierr);
401   if (flg1) { ierr = PetscPushErrorHandler(PetscMPIAbortErrorHandler,0);CHKERRQ(ierr);}
402   flg1 = PETSC_FALSE;
403   ierr = PetscOptionsGetBool(NULL,NULL,"-mpi_return_on_error",&flg1,NULL);CHKERRQ(ierr);
404   if (flg1) {
405     ierr = MPI_Comm_set_errhandler(comm,MPI_ERRORS_RETURN);CHKERRQ(ierr);
406   }
407   flg1 = PETSC_FALSE;
408   ierr = PetscOptionsGetBool(NULL,NULL,"-no_signal_handler",&flg1,NULL);CHKERRQ(ierr);
409   if (!flg1) {ierr = PetscPushSignalHandler(PetscSignalHandlerDefault,(void*)0);CHKERRQ(ierr);}
410   flg1 = PETSC_FALSE;
411   ierr = PetscOptionsGetBool(NULL,NULL,"-fp_trap",&flg1,NULL);CHKERRQ(ierr);
412   if (flg1) {ierr = PetscSetFPTrap(PETSC_FP_TRAP_ON);CHKERRQ(ierr);}
413   ierr = PetscOptionsGetInt(NULL,NULL,"-check_pointer_intensity",&intensity,&flag);CHKERRQ(ierr);
414   if (flag) {ierr = PetscCheckPointerSetIntensity(intensity);CHKERRQ(ierr);}
415 
416   /*
417       Setup debugger information
418   */
419   ierr = PetscSetDefaultDebugger();CHKERRQ(ierr);
420   ierr = PetscOptionsGetString(NULL,NULL,"-on_error_attach_debugger",string,64,&flg1);CHKERRQ(ierr);
421   if (flg1) {
422     MPI_Errhandler err_handler;
423 
424     ierr = PetscSetDebuggerFromString(string);CHKERRQ(ierr);
425     ierr = MPI_Comm_create_errhandler(Petsc_MPI_DebuggerOnError,&err_handler);CHKERRQ(ierr);
426     ierr = MPI_Comm_set_errhandler(comm,err_handler);CHKERRQ(ierr);
427     ierr = PetscPushErrorHandler(PetscAttachDebuggerErrorHandler,0);CHKERRQ(ierr);
428   }
429   ierr = PetscOptionsGetString(NULL,NULL,"-debug_terminal",string,64,&flg1);CHKERRQ(ierr);
430   if (flg1) { ierr = PetscSetDebugTerminal(string);CHKERRQ(ierr); }
431   ierr = PetscOptionsGetString(NULL,NULL,"-start_in_debugger",string,64,&flg1);CHKERRQ(ierr);
432   ierr = PetscOptionsGetString(NULL,NULL,"-stop_for_debugger",string,64,&flg2);CHKERRQ(ierr);
433   if (flg1 || flg2) {
434     PetscMPIInt    size;
435     PetscInt       lsize,*nodes;
436     MPI_Errhandler err_handler;
437     /*
438        we have to make sure that all processors have opened
439        connections to all other processors, otherwise once the
440        debugger has stated it is likely to receive a SIGUSR1
441        and kill the program.
442     */
443     ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
444     if (size > 2) {
445       PetscMPIInt dummy = 0;
446       MPI_Status  status;
447       for (i=0; i<size; i++) {
448         if (rank != i) {
449           ierr = MPI_Send(&dummy,1,MPI_INT,i,109,comm);CHKERRQ(ierr);
450         }
451       }
452       for (i=0; i<size; i++) {
453         if (rank != i) {
454           ierr = MPI_Recv(&dummy,1,MPI_INT,i,109,comm,&status);CHKERRQ(ierr);
455         }
456       }
457     }
458     /* check if this processor node should be in debugger */
459     ierr  = PetscMalloc1(size,&nodes);CHKERRQ(ierr);
460     lsize = size;
461     ierr  = PetscOptionsGetIntArray(NULL,NULL,"-debugger_nodes",nodes,&lsize,&flag);CHKERRQ(ierr);
462     if (flag) {
463       for (i=0; i<lsize; i++) {
464         if (nodes[i] == rank) { flag = PETSC_FALSE; break; }
465       }
466     }
467     if (!flag) {
468       ierr = PetscSetDebuggerFromString(string);CHKERRQ(ierr);
469       ierr = PetscPushErrorHandler(PetscAbortErrorHandler,0);CHKERRQ(ierr);
470       if (flg1) {
471         ierr = PetscAttachDebugger();CHKERRQ(ierr);
472       } else {
473         ierr = PetscStopForDebugger();CHKERRQ(ierr);
474       }
475       ierr = MPI_Comm_create_errhandler(Petsc_MPI_AbortOnError,&err_handler);CHKERRQ(ierr);
476       ierr = MPI_Comm_set_errhandler(comm,err_handler);CHKERRQ(ierr);
477     }
478     ierr = PetscFree(nodes);CHKERRQ(ierr);
479   }
480 
481   ierr = PetscOptionsGetString(NULL,NULL,"-on_error_emacs",emacsmachinename,128,&flg1);CHKERRQ(ierr);
482   if (flg1 && !rank) {ierr = PetscPushErrorHandler(PetscEmacsClientErrorHandler,emacsmachinename);CHKERRQ(ierr);}
483 
484   /*
485         Setup profiling and logging
486   */
487 #if defined(PETSC_USE_INFO)
488   {
489     char logname[PETSC_MAX_PATH_LEN]; logname[0] = 0;
490     ierr = PetscOptionsGetString(NULL,NULL,"-info",logname,250,&flg1);CHKERRQ(ierr);
491     if (flg1 && logname[0]) {
492       ierr = PetscInfoAllow(PETSC_TRUE,logname);CHKERRQ(ierr);
493     } else if (flg1) {
494       ierr = PetscInfoAllow(PETSC_TRUE,NULL);CHKERRQ(ierr);
495     }
496   }
497 #endif
498 #if defined(PETSC_USE_LOG)
499   mname[0] = 0;
500   ierr = PetscOptionsGetString(NULL,NULL,"-history",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
501   if (flg1) {
502     if (mname[0]) {
503       ierr = PetscOpenHistoryFile(mname,&petsc_history);CHKERRQ(ierr);
504     } else {
505       ierr = PetscOpenHistoryFile(NULL,&petsc_history);CHKERRQ(ierr);
506     }
507   }
508 
509   ierr = PetscOptionsGetBool(NULL,NULL,"-log_sync",&PetscLogSyncOn,NULL);CHKERRQ(ierr);
510 
511 #if defined(PETSC_HAVE_MPE)
512   flg1 = PETSC_FALSE;
513   ierr = PetscOptionsHasName(NULL,NULL,"-log_mpe",&flg1);CHKERRQ(ierr);
514   if (flg1) {ierr = PetscLogMPEBegin();CHKERRQ(ierr);}
515 #endif
516   flg1 = PETSC_FALSE;
517   flg3 = PETSC_FALSE;
518   ierr = PetscOptionsGetBool(NULL,NULL,"-log_all",&flg1,NULL);CHKERRQ(ierr);
519   ierr = PetscOptionsHasName(NULL,NULL,"-log_summary",&flg3);CHKERRQ(ierr);
520   if (flg1)                      { ierr = PetscLogAllBegin();CHKERRQ(ierr); }
521   else if (flg3)                 { ierr = PetscLogDefaultBegin();CHKERRQ(ierr);}
522 
523   ierr = PetscOptionsGetString(NULL,NULL,"-log_trace",mname,250,&flg1);CHKERRQ(ierr);
524   if (flg1) {
525     char name[PETSC_MAX_PATH_LEN],fname[PETSC_MAX_PATH_LEN];
526     FILE *file;
527     if (mname[0]) {
528       PetscSNPrintf(name,PETSC_MAX_PATH_LEN,"%s.%d",mname,rank);
529       ierr = PetscFixFilename(name,fname);CHKERRQ(ierr);
530       file = fopen(fname,"w");
531       if (!file) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to open trace file: %s",fname);
532     } else file = PETSC_STDOUT;
533     ierr = PetscLogTraceBegin(file);CHKERRQ(ierr);
534   }
535 
536   ierr = PetscOptionsGetViewer(comm,NULL,NULL,"-log_view",NULL,&format,&flg4);CHKERRQ(ierr);
537   if (flg4) {
538     if (format == PETSC_VIEWER_ASCII_XML) {
539       ierr = PetscLogNestedBegin();CHKERRQ(ierr);
540     } else {
541       ierr = PetscLogDefaultBegin();CHKERRQ(ierr);
542     }
543     PetscLogMemory = PETSC_FALSE;
544     ierr = PetscOptionsGetBool(NULL,NULL,"-log_view_memory",&PetscLogMemory,NULL);CHKERRQ(ierr);
545     if (PetscLogMemory) {
546       ierr = PetscSetUseTrMalloc_Private();CHKERRQ(ierr);
547     }
548   }
549   if (flg4 && format == PETSC_VIEWER_ASCII_XML) {
550     PetscReal threshold = PetscRealConstant(0.01);
551     ierr = PetscOptionsGetReal(NULL,NULL,"-log_threshold",&threshold,&flg1);CHKERRQ(ierr);
552     if (flg1) {ierr = PetscLogSetThreshold((PetscLogDouble)threshold,NULL);CHKERRQ(ierr);}
553   }
554 #endif
555 
556   ierr = PetscOptionsGetBool(NULL,NULL,"-saws_options",&PetscOptionsPublish,NULL);CHKERRQ(ierr);
557 
558 #if defined(PETSC_HAVE_CUDA)
559   /*
560      If collecting logging information, by default, wait for GPU to complete its operations
561      before returning to the CPU in order to get accurate timings of each event
562   */
563   ierr = PetscOptionsHasName(NULL,NULL,"-log_summary",&PetscCUDASynchronize);CHKERRQ(ierr);
564   if (!PetscCUDASynchronize) {
565     ierr = PetscOptionsHasName(NULL,NULL,"-log_view",&PetscCUDASynchronize);CHKERRQ(ierr);
566   }
567 
568   ierr = PetscOptionsBegin(comm,NULL,"CUDA options","Sys");CHKERRQ(ierr);
569   ierr = PetscOptionsInt("-cuda_set_device","Set all MPI ranks to use the specified CUDA device",NULL,deviceOpt,&deviceOpt,&flg1);CHKERRQ(ierr);
570   device = (int)deviceOpt;
571   ierr = PetscOptionsBool("-cuda_synchronize","Wait for the GPU to complete operations before returning to the CPU",NULL,PetscCUDASynchronize,&PetscCUDASynchronize,NULL);CHKERRQ(ierr);
572   ierr = PetscOptionsDeprecated("-cuda_show_devices","-cuda_view","3.12",NULL);CHKERRQ(ierr);
573   ierr = PetscOptionsName("-cuda_view","Display CUDA device information and assignments",NULL,&cuda_view_flag);CHKERRQ(ierr);
574   ierr = PetscOptionsEnd();CHKERRQ(ierr);
575   if (!PetscCUDAInitialized) {
576     PetscMPIInt size;
577     ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
578 
579     if (size>1) {
580       int         devCount;
581       PetscMPIInt rank;
582       cudaError_t err = cudaSuccess;
583 
584       /* check to see if we force multiple ranks to hit the same GPU */
585       if (flg1) {
586         err = cudaSetDevice(device);
587         if (err != cudaSuccess) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"error in cudaSetDevice %s",cudaGetErrorString(err));
588       } else {
589         /* we're not using the same GPU on multiple MPI threads. So try to allocated different   GPUs to different processes */
590 
591         /* First get the device count */
592         err   = cudaGetDeviceCount(&devCount);
593         if (err != cudaSuccess) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"error in cudaGetDeviceCount %s",cudaGetErrorString(err));
594 
595         /* next determine the rank and then set the device via a mod */
596         ierr   = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
597         device = rank % devCount;
598         err    = cudaSetDevice(device);
599         if (err != cudaSuccess) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"error in cudaSetDevice %s",cudaGetErrorString(err));
600       }
601 
602       /* set the device flags so that it can map host memory ... do NOT throw exception on err!=cudaSuccess
603        multiple devices may try to set the flags on the same device. So long as one of them succeeds, things
604        are ok. */
605       err = cudaSetDeviceFlags(cudaDeviceMapHost);
606       if (err != cudaSuccess) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"error in cudaSetDeviceFlags %s",cudaGetErrorString(err));
607     } else {
608       cudaError_t err = cudaSuccess;
609 
610       /* the code below works for serial GPU simulations */
611       if (flg1) {
612         err = cudaSetDevice(device);
613         if (err != cudaSuccess) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"error in cudaSetDevice %s",cudaGetErrorString(err));
614       }
615 
616       /* set the device flags so that it can map host memory ... here, we error check. */
617       err = cudaSetDeviceFlags(cudaDeviceMapHost);
618       if (err != cudaSuccess) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"error in cudaSetDeviceFlags %s",cudaGetErrorString(err));
619     }
620 
621     ierr = PetscCUBLASInitializeHandle();CHKERRQ(ierr);
622     PetscCUDAInitialized = PETSC_TRUE;
623   }
624   if (cuda_view_flag) {
625     struct cudaDeviceProp prop;
626     int                   devCount,device;
627     cudaError_t           err = cudaSuccess;
628 
629     err = cudaGetDeviceCount(&devCount);
630     if (err != cudaSuccess) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"error in cudaGetDeviceCount %s",cudaGetErrorString(err));
631     for (device = 0; device < devCount; ++device) {
632       err = cudaGetDeviceProperties(&prop,device);
633       if (err != cudaSuccess) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"error in cudaGetDeviceProperties %s",cudaGetErrorString(err));
634       ierr = PetscPrintf(comm, "CUDA device %d: %s\n", device, prop.name);CHKERRQ(ierr);
635     }
636     err = cudaGetDevice(&device);
637     if (err != cudaSuccess) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SYS,"error in cudaGetDevice %s",cudaGetErrorString(err));
638     ierr = PetscSynchronizedPrintf(PETSC_COMM_WORLD,"[%d] Using CUDA device %d.\n",rank,device);CHKERRQ(ierr);
639     ierr = PetscSynchronizedFlush(PETSC_COMM_WORLD,PETSC_STDOUT);CHKERRQ(ierr);
640   }
641 
642 #endif
643 
644 
645   /*
646        Print basic help message
647   */
648   ierr = PetscOptionsHasHelp(NULL,&flg1);CHKERRQ(ierr);
649   if (flg1) {
650     ierr = (*PetscHelpPrintf)(comm,"Options for all PETSc programs:\n");CHKERRQ(ierr);
651     ierr = (*PetscHelpPrintf)(comm," -help: prints help method for each option\n");CHKERRQ(ierr);
652     ierr = (*PetscHelpPrintf)(comm," -on_error_abort: cause an abort when an error is detected. Useful \n ");CHKERRQ(ierr);
653     ierr = (*PetscHelpPrintf)(comm,"       only when run in the debugger\n");CHKERRQ(ierr);
654     ierr = (*PetscHelpPrintf)(comm," -on_error_attach_debugger [gdb,dbx,xxgdb,ups,noxterm]\n");CHKERRQ(ierr);
655     ierr = (*PetscHelpPrintf)(comm,"       start the debugger in new xterm\n");CHKERRQ(ierr);
656     ierr = (*PetscHelpPrintf)(comm,"       unless noxterm is given\n");CHKERRQ(ierr);
657     ierr = (*PetscHelpPrintf)(comm," -start_in_debugger [gdb,dbx,xxgdb,ups,noxterm]\n");CHKERRQ(ierr);
658     ierr = (*PetscHelpPrintf)(comm,"       start all processes in the debugger\n");CHKERRQ(ierr);
659     ierr = (*PetscHelpPrintf)(comm," -on_error_emacs <machinename>\n");CHKERRQ(ierr);
660     ierr = (*PetscHelpPrintf)(comm,"    emacs jumps to error file\n");CHKERRQ(ierr);
661     ierr = (*PetscHelpPrintf)(comm," -debugger_nodes [n1,n2,..] Nodes to start in debugger\n");CHKERRQ(ierr);
662     ierr = (*PetscHelpPrintf)(comm," -debugger_pause [m] : delay (in seconds) to attach debugger\n");CHKERRQ(ierr);
663     ierr = (*PetscHelpPrintf)(comm," -stop_for_debugger : prints message on how to attach debugger manually\n");CHKERRQ(ierr);
664     ierr = (*PetscHelpPrintf)(comm,"                      waits the delay for you to attach\n");CHKERRQ(ierr);
665     ierr = (*PetscHelpPrintf)(comm," -display display: Location where X window graphics and debuggers are displayed\n");CHKERRQ(ierr);
666     ierr = (*PetscHelpPrintf)(comm," -no_signal_handler: do not trap error signals\n");CHKERRQ(ierr);
667     ierr = (*PetscHelpPrintf)(comm," -mpi_return_on_error: MPI returns error code, rather than abort on internal error\n");CHKERRQ(ierr);
668     ierr = (*PetscHelpPrintf)(comm," -fp_trap: stop on floating point exceptions\n");CHKERRQ(ierr);
669     ierr = (*PetscHelpPrintf)(comm,"           note on IBM RS6000 this slows run greatly\n");CHKERRQ(ierr);
670     ierr = (*PetscHelpPrintf)(comm," -malloc_dump <optional filename>: dump list of unfreed memory at conclusion\n");CHKERRQ(ierr);
671     ierr = (*PetscHelpPrintf)(comm," -malloc: use our error checking malloc\n");CHKERRQ(ierr);
672     ierr = (*PetscHelpPrintf)(comm," -malloc no: don't use error checking malloc\n");CHKERRQ(ierr);
673     ierr = (*PetscHelpPrintf)(comm," -malloc_info: prints total memory usage\n");CHKERRQ(ierr);
674     ierr = (*PetscHelpPrintf)(comm," -malloc_log: keeps log of all memory allocations\n");CHKERRQ(ierr);
675     ierr = (*PetscHelpPrintf)(comm," -malloc_debug: enables extended checking for memory corruption\n");CHKERRQ(ierr);
676     ierr = (*PetscHelpPrintf)(comm," -options_view: dump list of options inputted\n");CHKERRQ(ierr);
677     ierr = (*PetscHelpPrintf)(comm," -options_left: dump list of unused options\n");CHKERRQ(ierr);
678     ierr = (*PetscHelpPrintf)(comm," -options_left no: don't dump list of unused options\n");CHKERRQ(ierr);
679     ierr = (*PetscHelpPrintf)(comm," -tmp tmpdir: alternative /tmp directory\n");CHKERRQ(ierr);
680     ierr = (*PetscHelpPrintf)(comm," -shared_tmp: tmp directory is shared by all processors\n");CHKERRQ(ierr);
681     ierr = (*PetscHelpPrintf)(comm," -not_shared_tmp: each processor has separate tmp directory\n");CHKERRQ(ierr);
682     ierr = (*PetscHelpPrintf)(comm," -memory_view: print memory usage at end of run\n");CHKERRQ(ierr);
683 #if defined(PETSC_USE_LOG)
684     ierr = (*PetscHelpPrintf)(comm," -get_total_flops: total flops over all processors\n");CHKERRQ(ierr);
685     ierr = (*PetscHelpPrintf)(comm," -log_view [:filename:[format]]: logging objects and events\n");CHKERRQ(ierr);
686     ierr = (*PetscHelpPrintf)(comm," -log_trace [filename]: prints trace of all PETSc calls\n");CHKERRQ(ierr);
687 #if defined(PETSC_HAVE_MPE)
688     ierr = (*PetscHelpPrintf)(comm," -log_mpe: Also create logfile viewable through Jumpshot\n");CHKERRQ(ierr);
689 #endif
690     ierr = (*PetscHelpPrintf)(comm," -info <optional filename>: print informative messages about the calculations\n");CHKERRQ(ierr);
691 #endif
692     ierr = (*PetscHelpPrintf)(comm," -v: prints PETSc version number and release date\n");CHKERRQ(ierr);
693     ierr = (*PetscHelpPrintf)(comm," -options_file <file>: reads options from file\n");CHKERRQ(ierr);
694     ierr = (*PetscHelpPrintf)(comm," -petsc_sleep n: sleeps n seconds before running program\n");CHKERRQ(ierr);
695     ierr = (*PetscHelpPrintf)(comm,"-----------------------------------------------\n");CHKERRQ(ierr);
696   }
697 
698 #if defined(PETSC_HAVE_POPEN)
699   {
700   char machine[128];
701   ierr = PetscOptionsGetString(NULL,NULL,"-popen_machine",machine,128,&flg1);CHKERRQ(ierr);
702   if (flg1) {
703     ierr = PetscPOpenSetMachine(machine);CHKERRQ(ierr);
704   }
705   }
706 #endif
707 
708   ierr = PetscOptionsGetReal(NULL,NULL,"-petsc_sleep",&si,&flg1);CHKERRQ(ierr);
709   if (flg1) {
710     ierr = PetscSleep(si);CHKERRQ(ierr);
711   }
712 
713   ierr = PetscOptionsGetString(NULL,NULL,"-info_exclude",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
714   if (flg1) {
715     ierr = PetscStrstr(mname,"null",&f);CHKERRQ(ierr);
716     if (f) {
717       ierr = PetscInfoDeactivateClass(0);CHKERRQ(ierr);
718     }
719   }
720 
721 #if defined(PETSC_HAVE_VIENNACL)
722   ierr = PetscOptionsHasName(NULL,NULL,"-log_summary",&flg3);CHKERRQ(ierr);
723   if (!flg3) {
724     ierr = PetscOptionsHasName(NULL,NULL,"-log_view",&flg3);CHKERRQ(ierr);
725   }
726   ierr = PetscOptionsGetBool(NULL,NULL,"-viennacl_synchronize",&flg3,NULL);CHKERRQ(ierr);
727   PetscViennaCLSynchronize = flg3;
728   ierr = PetscViennaCLInit();CHKERRQ(ierr);
729 #endif
730 
731   /*
732      Creates the logging data structures; this is enabled even if logging is not turned on
733      This is the last thing we do before returning to the user code to prevent having the
734      logging numbers contaminated by any startup time associated with MPI and the GPUs
735   */
736 #if defined(PETSC_USE_LOG)
737   ierr = PetscLogInitialize();CHKERRQ(ierr);
738 #endif
739 
740   PetscFunctionReturn(0);
741 }
742