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