xref: /petsc/src/sys/objects/pinit.c (revision 93b6d2d164bc74d7e5a80be2087e4e08a8225980)
1 
2 /*
3    This file defines the initialization of PETSc, including PetscInitialize()
4 */
5 #define PETSC_DESIRE_COMPLEX
6 #include <petsc-private/petscimpl.h>        /*I  "petscsys.h"   I*/
7 #include <petscviewer.h>
8 
9 #if defined(PETSC_HAVE_CUDA)
10 #include <cublas.h>
11 #endif
12 
13 #include <petscthreadcomm.h>
14 
15 #if defined(PETSC_USE_LOG)
16 extern PetscErrorCode PetscLogBegin_Private(void);
17 #endif
18 extern PetscBool PetscHMPIWorker;
19 
20 
21 #if defined(PETSC_SERIALIZE_FUNCTIONS)
22 PetscFPT PetscFPTData = 0;
23 #endif
24 
25 /* -----------------------------------------------------------------------------------------*/
26 
27 extern FILE *petsc_history;
28 
29 extern PetscErrorCode PetscInitialize_DynamicLibraries(void);
30 extern PetscErrorCode PetscFinalize_DynamicLibraries(void);
31 extern PetscErrorCode PetscFunctionListPrintAll(void);
32 extern PetscErrorCode PetscSequentialPhaseBegin_Private(MPI_Comm,int);
33 extern PetscErrorCode PetscSequentialPhaseEnd_Private(MPI_Comm,int);
34 extern PetscErrorCode PetscCloseHistoryFile(FILE**);
35 
36 /* user may set this BEFORE calling PetscInitialize() */
37 MPI_Comm PETSC_COMM_WORLD = MPI_COMM_NULL;
38 
39 PetscMPIInt Petsc_Counter_keyval   = MPI_KEYVAL_INVALID;
40 PetscMPIInt Petsc_InnerComm_keyval = MPI_KEYVAL_INVALID;
41 PetscMPIInt Petsc_OuterComm_keyval = MPI_KEYVAL_INVALID;
42 
43 /*
44      Declare and set all the string names of the PETSc enums
45 */
46 const char *const PetscBools[]     = {"FALSE","TRUE","PetscBool","PETSC_",0};
47 const char *const PetscCopyModes[] = {"COPY_VALUES","OWN_POINTER","USE_POINTER","PetscCopyMode","PETSC_",0};
48 const char *const PetscDataTypes[] = {"INT","DOUBLE","COMPLEX","LONG","SHORT","FLOAT",
49                                       "CHAR","LOGICAL","ENUM","BOOL","LONGDOUBLE","OBJECT","FUNCTION","PetscDataType","PETSC_",0};
50 
51 PetscBool PetscPreLoadingUsed = PETSC_FALSE;
52 PetscBool PetscPreLoadingOn   = PETSC_FALSE;
53 
54 /* pthread_key for PetscStack */
55 #if defined(PETSC_HAVE_PTHREADCLASSES) && !defined(PETSC_PTHREAD_LOCAL)
56 pthread_key_t petscstack;
57 #endif
58 
59 /*
60        Checks the options database for initializations related to the
61     PETSc components
62 */
63 #undef __FUNCT__
64 #define __FUNCT__ "PetscOptionsCheckInitial_Components"
65 PetscErrorCode  PetscOptionsCheckInitial_Components(void)
66 {
67   PetscBool      flg1;
68   PetscErrorCode ierr;
69 
70   PetscFunctionBegin;
71   ierr = PetscOptionsHasName(NULL,"-help",&flg1);CHKERRQ(ierr);
72   if (flg1) {
73 #if defined(PETSC_USE_LOG)
74     MPI_Comm comm = PETSC_COMM_WORLD;
75     ierr = (*PetscHelpPrintf)(comm,"------Additional PETSc component options--------\n");CHKERRQ(ierr);
76     ierr = (*PetscHelpPrintf)(comm," -log_summary_exclude: <vec,mat,pc.ksp,snes>\n");CHKERRQ(ierr);
77     ierr = (*PetscHelpPrintf)(comm," -info_exclude: <null,vec,mat,pc,ksp,snes,ts>\n");CHKERRQ(ierr);
78     ierr = (*PetscHelpPrintf)(comm,"-----------------------------------------------\n");CHKERRQ(ierr);
79 #endif
80   }
81   PetscFunctionReturn(0);
82 }
83 
84 #undef __FUNCT__
85 #define __FUNCT__ "PetscInitializeNoPointers"
86 /*
87       PetscInitializeNoPointers - Calls PetscInitialize() from C/C++ without the pointers to argc and args
88 
89    Collective
90 
91    Level: advanced
92 
93     Notes: this is called only by the PETSc MATLAB and Julia interface. Even though it might start MPI it sets the flag to
94      indicate that it did NOT start MPI so that the PetscFinalize() does not end MPI, thus allowing PetscInitialize() to
95      be called multiple times from MATLAB and Julia without the problem of trying to initialize MPI more than once.
96 
97      Turns off PETSc signal handling because that can interact with MATLAB's signal handling causing random crashes.
98 
99 .seealso: PetscInitialize(), PetscInitializeFortran(), PetscInitializeNoArguments()
100 */
101 PetscErrorCode  PetscInitializeNoPointers(int argc,char **args,const char *filename,const char *help)
102 {
103   PetscErrorCode ierr;
104   int            myargc   = argc;
105   char           **myargs = args;
106 
107   PetscFunctionBegin;
108   ierr = PetscInitialize(&myargc,&myargs,filename,help);CHKERRQ(ierr);
109   ierr = PetscPopSignalHandler();CHKERRQ(ierr);
110   PetscBeganMPI = PETSC_FALSE;
111   PetscFunctionReturn(ierr);
112 }
113 
114 #undef __FUNCT__
115 #define __FUNCT__ "PetscGetPETSC_COMM_SELF"
116 /*
117       Used by MATLAB and Julia interface to get communicator
118 */
119 PetscErrorCode  PetscGetPETSC_COMM_SELF(MPI_Comm *comm)
120 {
121   PetscFunctionBegin;
122   *comm = PETSC_COMM_SELF;
123   PetscFunctionReturn(0);
124 }
125 
126 #undef __FUNCT__
127 #define __FUNCT__ "PetscInitializeNoArguments"
128 /*@C
129       PetscInitializeNoArguments - Calls PetscInitialize() from C/C++ without
130         the command line arguments.
131 
132    Collective
133 
134    Level: advanced
135 
136 .seealso: PetscInitialize(), PetscInitializeFortran()
137 @*/
138 PetscErrorCode  PetscInitializeNoArguments(void)
139 {
140   PetscErrorCode ierr;
141   int            argc   = 0;
142   char           **args = 0;
143 
144   PetscFunctionBegin;
145   ierr = PetscInitialize(&argc,&args,NULL,NULL);
146   PetscFunctionReturn(ierr);
147 }
148 
149 #undef __FUNCT__
150 #define __FUNCT__ "PetscInitialized"
151 /*@
152       PetscInitialized - Determine whether PETSc is initialized.
153 
154    Level: beginner
155 
156 .seealso: PetscInitialize(), PetscInitializeNoArguments(), PetscInitializeFortran()
157 @*/
158 PetscErrorCode PetscInitialized(PetscBool  *isInitialized)
159 {
160   *isInitialized = PetscInitializeCalled;
161   return 0;
162 }
163 
164 #undef __FUNCT__
165 #define __FUNCT__ "PetscFinalized"
166 /*@
167       PetscFinalized - Determine whether PetscFinalize() has been called yet
168 
169    Level: developer
170 
171 .seealso: PetscInitialize(), PetscInitializeNoArguments(), PetscInitializeFortran()
172 @*/
173 PetscErrorCode  PetscFinalized(PetscBool  *isFinalized)
174 {
175   *isFinalized = PetscFinalizeCalled;
176   return 0;
177 }
178 
179 extern PetscErrorCode PetscOptionsCheckInitial_Private(void);
180 
181 /*
182        This function is the MPI reduction operation used to compute the sum of the
183    first half of the datatype and the max of the second half.
184 */
185 MPI_Op PetscMaxSum_Op = 0;
186 
187 #undef __FUNCT__
188 #define __FUNCT__ "PetscMaxSum_Local"
189 PETSC_EXTERN void MPIAPI PetscMaxSum_Local(void *in,void *out,int *cnt,MPI_Datatype *datatype)
190 {
191   PetscInt *xin = (PetscInt*)in,*xout = (PetscInt*)out,i,count = *cnt;
192 
193   PetscFunctionBegin;
194   if (*datatype != MPIU_2INT) {
195     (*PetscErrorPrintf)("Can only handle MPIU_2INT data types");
196     MPI_Abort(MPI_COMM_WORLD,1);
197   }
198 
199   for (i=0; i<count; i++) {
200     xout[2*i]    = PetscMax(xout[2*i],xin[2*i]);
201     xout[2*i+1] += xin[2*i+1];
202   }
203   PetscFunctionReturnVoid();
204 }
205 
206 /*
207     Returns the max of the first entry owned by this processor and the
208 sum of the second entry.
209 
210     The reason nprocs[2*i] contains lengths nprocs[2*i+1] contains flag of 1 if length is nonzero
211 is so that the PetscMaxSum_Op() can set TWO values, if we passed in only nprocs[i] with lengths
212 there would be no place to store the both needed results.
213 */
214 #undef __FUNCT__
215 #define __FUNCT__ "PetscMaxSum"
216 PetscErrorCode  PetscMaxSum(MPI_Comm comm,const PetscInt nprocs[],PetscInt *max,PetscInt *sum)
217 {
218   PetscMPIInt    size,rank;
219   struct {PetscInt max,sum;} *work;
220   PetscErrorCode ierr;
221 
222   PetscFunctionBegin;
223   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
224   ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
225   ierr = PetscMalloc(size*sizeof(*work),&work);CHKERRQ(ierr);
226   ierr = MPI_Allreduce((void*)nprocs,work,size,MPIU_2INT,PetscMaxSum_Op,comm);CHKERRQ(ierr);
227   *max = work[rank].max;
228   *sum = work[rank].sum;
229   ierr = PetscFree(work);CHKERRQ(ierr);
230   PetscFunctionReturn(0);
231 }
232 
233 /* ----------------------------------------------------------------------------*/
234 MPI_Op  PetscADMax_Op = 0;
235 
236 #undef __FUNCT__
237 #define __FUNCT__ "PetscADMax_Local"
238 PETSC_EXTERN void MPIAPI PetscADMax_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype)
239 {
240   PetscScalar *xin = (PetscScalar*)in,*xout = (PetscScalar*)out;
241   PetscInt    i,count = *cnt;
242 
243   PetscFunctionBegin;
244   if (*datatype != MPIU_2SCALAR) {
245     (*PetscErrorPrintf)("Can only handle MPIU_2SCALAR data (i.e. double or complex) types");
246     MPI_Abort(MPI_COMM_WORLD,1);
247   }
248 
249   for (i=0; i<count; i++) {
250     if (PetscRealPart(xout[2*i]) < PetscRealPart(xin[2*i])) {
251       xout[2*i]   = xin[2*i];
252       xout[2*i+1] = xin[2*i+1];
253     }
254   }
255   PetscFunctionReturnVoid();
256 }
257 
258 MPI_Op PetscADMin_Op = 0;
259 
260 #undef __FUNCT__
261 #define __FUNCT__ "PetscADMin_Local"
262 PETSC_EXTERN void MPIAPI PetscADMin_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype)
263 {
264   PetscScalar *xin = (PetscScalar*)in,*xout = (PetscScalar*)out;
265   PetscInt    i,count = *cnt;
266 
267   PetscFunctionBegin;
268   if (*datatype != MPIU_2SCALAR) {
269     (*PetscErrorPrintf)("Can only handle MPIU_2SCALAR data (i.e. double or complex) types");
270     MPI_Abort(MPI_COMM_WORLD,1);
271   }
272 
273   for (i=0; i<count; i++) {
274     if (PetscRealPart(xout[2*i]) > PetscRealPart(xin[2*i])) {
275       xout[2*i]   = xin[2*i];
276       xout[2*i+1] = xin[2*i+1];
277     }
278   }
279   PetscFunctionReturnVoid();
280 }
281 /* ---------------------------------------------------------------------------------------*/
282 
283 #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128)
284 MPI_Op MPIU_SUM = 0;
285 
286 #undef __FUNCT__
287 #define __FUNCT__ "PetscSum_Local"
288 PETSC_EXTERN void PetscSum_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype)
289 {
290   PetscInt i,count = *cnt;
291 
292   PetscFunctionBegin;
293   if (*datatype == MPIU_REAL) {
294     PetscReal *xin = (PetscReal*)in,*xout = (PetscReal*)out;
295     for (i=0; i<count; i++) xout[i] += xin[i];
296   }
297 #if defined(PETSC_HAVE_COMPLEX)
298   else if (*datatype == MPIU_COMPLEX) {
299     PetscComplex *xin = (PetscComplex*)in,*xout = (PetscComplex*)out;
300     for (i=0; i<count; i++) xout[i] += xin[i];
301   }
302 #endif
303   else {
304     (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types");
305     MPI_Abort(MPI_COMM_WORLD,1);
306   }
307   PetscFunctionReturnVoid();
308 }
309 #endif
310 
311 #if defined(PETSC_USE_REAL___FLOAT128)
312 MPI_Op MPIU_MAX = 0;
313 MPI_Op MPIU_MIN = 0;
314 
315 #undef __FUNCT__
316 #define __FUNCT__ "PetscMax_Local"
317 PETSC_EXTERN void PetscMax_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype)
318 {
319   PetscInt i,count = *cnt;
320 
321   PetscFunctionBegin;
322   if (*datatype == MPIU_REAL) {
323     PetscReal *xin = (PetscReal*)in,*xout = (PetscReal*)out;
324     for (i=0; i<count; i++) xout[i] = PetscMax(xout[i],xin[i]);
325   }
326 #if defined(PETSC_HAVE_COMPLEX)
327   else if (*datatype == MPIU_COMPLEX) {
328     PetscComplex *xin = (PetscComplex*)in,*xout = (PetscComplex*)out;
329     for (i=0; i<count; i++) {
330       xout[i] = PetscRealPartComplex(xout[i])<PetscRealPartComplex(xin[i]) ? xin[i] : xout[i];
331     }
332   }
333 #endif
334   else {
335     (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types");
336     MPI_Abort(MPI_COMM_WORLD,1);
337   }
338   PetscFunctionReturnVoid();
339 }
340 
341 #undef __FUNCT__
342 #define __FUNCT__ "PetscMin_Local"
343 PETSC_EXTERN void PetscMin_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype)
344 {
345   PetscInt    i,count = *cnt;
346 
347   PetscFunctionBegin;
348   if (*datatype == MPIU_REAL) {
349     PetscReal *xin = (PetscReal*)in,*xout = (PetscReal*)out;
350     for (i=0; i<count; i++) xout[i] = PetscMin(xout[i],xin[i]);
351   }
352 #if defined(PETSC_HAVE_COMPLEX)
353   else if (*datatype == MPIU_COMPLEX) {
354     PetscComplex *xin = (PetscComplex*)in,*xout = (PetscComplex*)out;
355     for (i=0; i<count; i++) {
356       xout[i] = PetscRealPartComplex(xout[i])>PetscRealPartComplex(xin[i]) ? xin[i] : xout[i];
357     }
358   }
359 #endif
360   else {
361     (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_SCALAR data (i.e. double or complex) types");
362     MPI_Abort(MPI_COMM_WORLD,1);
363   }
364   PetscFunctionReturnVoid();
365 }
366 #endif
367 
368 #undef __FUNCT__
369 #define __FUNCT__ "Petsc_DelCounter"
370 /*
371    Private routine to delete internal tag/name counter storage when a communicator is freed.
372 
373    This is called by MPI, not by users. This is called by MPI_Comm_free() when the communicator that has this  data as an attribute is freed.
374 
375    Note: this is declared extern "C" because it is passed to MPI_Keyval_create()
376 
377 */
378 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelCounter(MPI_Comm comm,PetscMPIInt keyval,void *count_val,void *extra_state)
379 {
380   PetscErrorCode ierr;
381 
382   PetscFunctionBegin;
383   ierr = PetscInfo1(0,"Deleting counter data in an MPI_Comm %ld\n",(long)comm);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr);
384   ierr = PetscFree(count_val);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr);
385   PetscFunctionReturn(MPI_SUCCESS);
386 }
387 
388 #undef __FUNCT__
389 #define __FUNCT__ "Petsc_DelComm"
390 /*
391   This does not actually free anything, it simply marks when a reference count to an internal or external MPI_Comm reaches zero and the
392   the external MPI_Comm drops its reference to the internal or external MPI_Comm
393 
394   This is called by MPI, not by users. This is called when MPI_Comm_free() is called on the communicator.
395 
396   Note: this is declared extern "C" because it is passed to MPI_Keyval_create()
397 
398 */
399 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm(MPI_Comm comm,PetscMPIInt keyval,void *attr_val,void *extra_state)
400 {
401   PetscErrorCode ierr;
402   PetscMPIInt    flg;
403   MPI_Comm       icomm;
404   void           *ptr;
405 
406   PetscFunctionBegin;
407   ierr = MPI_Attr_get(comm,Petsc_InnerComm_keyval,&ptr,&flg);CHKERRQ(ierr);
408   if (flg) {
409     /*  Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers  */
410     ierr = PetscMemcpy(&icomm,&ptr,sizeof(MPI_Comm));CHKERRQ(ierr);
411     ierr = MPI_Attr_get(icomm,Petsc_OuterComm_keyval,&ptr,&flg);CHKERRQ(ierr);
412     if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected reference to outer comm");
413     ierr = MPI_Attr_delete(icomm,Petsc_OuterComm_keyval);CHKERRQ(ierr);
414     ierr = PetscInfo1(0,"User MPI_Comm m %ld is being freed, removing reference from inner PETSc comm to this outer comm\n",(long)comm);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr);
415   } else {
416     ierr = PetscInfo1(0,"Removing reference to PETSc communicator imbedded in a user MPI_Comm m %ld\n",(long)comm);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr);
417   }
418   PetscFunctionReturn(MPI_SUCCESS);
419 }
420 
421 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
422 #if !defined(PETSC_WORDS_BIGENDIAN)
423 PETSC_EXTERN PetscMPIInt PetscDataRep_extent_fn(MPI_Datatype,MPI_Aint*,void*);
424 PETSC_EXTERN PetscMPIInt PetscDataRep_read_conv_fn(void*, MPI_Datatype,PetscMPIInt,void*,MPI_Offset,void*);
425 PETSC_EXTERN PetscMPIInt PetscDataRep_write_conv_fn(void*, MPI_Datatype,PetscMPIInt,void*,MPI_Offset,void*);
426 #endif
427 #endif
428 
429 int  PetscGlobalArgc   = 0;
430 char **PetscGlobalArgs = 0;
431 
432 #undef __FUNCT__
433 #define __FUNCT__ "PetscGetArgs"
434 /*@C
435    PetscGetArgs - Allows you to access the raw command line arguments anywhere
436      after PetscInitialize() is called but before PetscFinalize().
437 
438    Not Collective
439 
440    Output Parameters:
441 +  argc - count of number of command line arguments
442 -  args - the command line arguments
443 
444    Level: intermediate
445 
446    Notes:
447       This is usually used to pass the command line arguments into other libraries
448    that are called internally deep in PETSc or the application.
449 
450       The first argument contains the program name as is normal for C arguments.
451 
452    Concepts: command line arguments
453 
454 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArguments()
455 
456 @*/
457 PetscErrorCode  PetscGetArgs(int *argc,char ***args)
458 {
459   PetscFunctionBegin;
460   if (!PetscInitializeCalled && PetscFinalizeCalled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"You must call after PetscInitialize() but before PetscFinalize()");
461   *argc = PetscGlobalArgc;
462   *args = PetscGlobalArgs;
463   PetscFunctionReturn(0);
464 }
465 
466 #undef __FUNCT__
467 #define __FUNCT__ "PetscGetArguments"
468 /*@C
469    PetscGetArguments - Allows you to access the  command line arguments anywhere
470      after PetscInitialize() is called but before PetscFinalize().
471 
472    Not Collective
473 
474    Output Parameters:
475 .  args - the command line arguments
476 
477    Level: intermediate
478 
479    Notes:
480       This does NOT start with the program name and IS null terminated (final arg is void)
481 
482    Concepts: command line arguments
483 
484 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscFreeArguments()
485 
486 @*/
487 PetscErrorCode  PetscGetArguments(char ***args)
488 {
489   PetscInt       i,argc = PetscGlobalArgc;
490   PetscErrorCode ierr;
491 
492   PetscFunctionBegin;
493   if (!PetscInitializeCalled && PetscFinalizeCalled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"You must call after PetscInitialize() but before PetscFinalize()");
494   if (!argc) {*args = 0; PetscFunctionReturn(0);}
495   ierr = PetscMalloc(argc*sizeof(char*),args);CHKERRQ(ierr);
496   for (i=0; i<argc-1; i++) {
497     ierr = PetscStrallocpy(PetscGlobalArgs[i+1],&(*args)[i]);CHKERRQ(ierr);
498   }
499   (*args)[argc-1] = 0;
500   PetscFunctionReturn(0);
501 }
502 
503 #undef __FUNCT__
504 #define __FUNCT__ "PetscFreeArguments"
505 /*@C
506    PetscFreeArguments - Frees the memory obtained with PetscGetArguments()
507 
508    Not Collective
509 
510    Output Parameters:
511 .  args - the command line arguments
512 
513    Level: intermediate
514 
515    Concepts: command line arguments
516 
517 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscGetArguments()
518 
519 @*/
520 PetscErrorCode  PetscFreeArguments(char **args)
521 {
522   PetscInt       i = 0;
523   PetscErrorCode ierr;
524 
525   PetscFunctionBegin;
526   if (!args) PetscFunctionReturn(0);
527   while (args[i]) {
528     ierr = PetscFree(args[i]);CHKERRQ(ierr);
529     i++;
530   }
531   ierr = PetscFree(args);CHKERRQ(ierr);
532   PetscFunctionReturn(0);
533 }
534 
535 #undef __FUNCT__
536 #define __FUNCT__ "PetscInitialize"
537 /*@C
538    PetscInitialize - Initializes the PETSc database and MPI.
539    PetscInitialize() calls MPI_Init() if that has yet to be called,
540    so this routine should always be called near the beginning of
541    your program -- usually the very first line!
542 
543    Collective on MPI_COMM_WORLD or PETSC_COMM_WORLD if it has been set
544 
545    Input Parameters:
546 +  argc - count of number of command line arguments
547 .  args - the command line arguments
548 .  file - [optional] PETSc database file, also checks ~username/.petscrc and .petscrc use NULL to not check for
549           code specific file. Use -skip_petscrc in the code specific file to skip the .petscrc files
550 -  help - [optional] Help message to print, use NULL for no message
551 
552    If you wish PETSc code to run ONLY on a subcommunicator of MPI_COMM_WORLD, create that
553    communicator first and assign it to PETSC_COMM_WORLD BEFORE calling PetscInitialize(). Thus if you are running a
554    four process job and two processes will run PETSc and have PetscInitialize() and PetscFinalize() and two process will not,
555    then do this. If ALL processes in the job are using PetscInitialize() and PetscFinalize() then you don't need to do this, even
556    if different subcommunicators of the job are doing different things with PETSc.
557 
558    Options Database Keys:
559 +  -start_in_debugger [noxterm,dbx,xdb,gdb,...] - Starts program in debugger
560 .  -on_error_attach_debugger [noxterm,dbx,xdb,gdb,...] - Starts debugger when error detected
561 .  -on_error_emacs <machinename> causes emacsclient to jump to error file
562 .  -on_error_abort calls abort() when error detected (no traceback)
563 .  -on_error_mpiabort calls MPI_abort() when error detected
564 .  -error_output_stderr prints error messages to stderr instead of the default stdout
565 .  -error_output_none does not print the error messages (but handles errors in the same way as if this was not called)
566 .  -debugger_nodes [node1,node2,...] - Indicates nodes to start in debugger
567 .  -debugger_pause [sleeptime] (in seconds) - Pauses debugger
568 .  -stop_for_debugger - Print message on how to attach debugger manually to
569                         process and wait (-debugger_pause) seconds for attachment
570 .  -malloc - Indicates use of PETSc error-checking malloc (on by default for debug version of libraries)
571 .  -malloc no - Indicates not to use error-checking malloc
572 .  -malloc_debug - check for memory corruption at EVERY malloc or free
573 .  -malloc_test - like -malloc_dump -malloc_debug, but only active for debugging builds
574 .  -fp_trap - Stops on floating point exceptions (Note that on the
575               IBM RS6000 this slows code by at least a factor of 10.)
576 .  -no_signal_handler - Indicates not to trap error signals
577 .  -shared_tmp - indicates /tmp directory is shared by all processors
578 .  -not_shared_tmp - each processor has own /tmp
579 .  -tmp - alternative name of /tmp directory
580 .  -get_total_flops - returns total flops done by all processors
581 .  -memory_info - Print memory usage at end of run
582 -  -server <port> - start PETSc webserver (default port is 8080)
583 
584    Options Database Keys for Profiling:
585    See the <a href="../../docs/manual.pdf#nameddest=ch_profiling">profiling chapter of the users manual</a> for details.
586 +  -info <optional filename> - Prints verbose information to the screen
587 .  -info_exclude <null,vec,mat,pc,ksp,snes,ts> - Excludes some of the verbose messages
588 .  -log_sync - Log the synchronization in scatters, inner products and norms
589 .  -log_trace [filename] - Print traces of all PETSc calls to the screen (useful to determine where a program
590         hangs without running in the debugger).  See PetscLogTraceBegin().
591 .  -log_summary [filename] - Prints summary of flop and timing information to screen. If the filename is specified the
592         summary is written to the file.  See PetscLogView().
593 .  -log_summary_python [filename] - Prints data on of flop and timing usage to a file or screen. See PetscLogPrintSViewPython().
594 .  -log_all [filename] - Logs extensive profiling information  See PetscLogDump().
595 .  -log [filename] - Logs basic profiline information  See PetscLogDump().
596 -  -log_mpe [filename] - Creates a logfile viewable by the utility Jumpshot (in MPICH distribution)
597 
598     Only one of -log_trace, -log_summary, -log_all, -log, or -log_mpe may be used at a time
599 
600    Environmental Variables:
601 +   PETSC_TMP - alternative tmp directory
602 .   PETSC_SHARED_TMP - tmp is shared by all processes
603 .   PETSC_NOT_SHARED_TMP - each process has its own private tmp
604 .   PETSC_VIEWER_SOCKET_PORT - socket number to use for socket viewer
605 -   PETSC_VIEWER_SOCKET_MACHINE - machine to use for socket viewer to connect to
606 
607 
608    Level: beginner
609 
610    Notes:
611    If for some reason you must call MPI_Init() separately, call
612    it before PetscInitialize().
613 
614    Fortran Version:
615    In Fortran this routine has the format
616 $       call PetscInitialize(file,ierr)
617 
618 +   ierr - error return code
619 -  file - [optional] PETSc database file, also checks ~username/.petscrc and .petscrc use NULL_CHARACTER to not check for
620           code specific file. Use -skip_petscrc in the code specific file to skip the .petscrc files
621 
622    Important Fortran Note:
623    In Fortran, you MUST use NULL_CHARACTER to indicate a
624    null character string; you CANNOT just use NULL as
625    in the C version. See the <a href="../../docs/manual.pdf">users manual</a> for details.
626 
627    If your main program is C but you call Fortran code that also uses PETSc you need to call PetscInitializeFortran() soon after
628    calling PetscInitialize().
629 
630    Concepts: initializing PETSc
631 
632 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscInitializeNoArguments()
633 
634 @*/
635 PetscErrorCode  PetscInitialize(int *argc,char ***args,const char file[],const char help[])
636 {
637   PetscErrorCode ierr;
638   PetscMPIInt    flag, size;
639   PetscInt       nodesize;
640   PetscBool      flg;
641   char           hostname[256];
642 
643   PetscFunctionBegin;
644   if (PetscInitializeCalled) PetscFunctionReturn(0);
645 
646   /* these must be initialized in a routine, not as a constant declaration*/
647   PETSC_STDOUT = stdout;
648   PETSC_STDERR = stderr;
649 
650   ierr = PetscOptionsCreate();CHKERRQ(ierr);
651 
652   /*
653      We initialize the program name here (before MPI_Init()) because MPICH has a bug in
654      it that it sets args[0] on all processors to be args[0] on the first processor.
655   */
656   if (argc && *argc) {
657     ierr = PetscSetProgramName(**args);CHKERRQ(ierr);
658   } else {
659     ierr = PetscSetProgramName("Unknown Name");CHKERRQ(ierr);
660   }
661 
662   ierr = MPI_Initialized(&flag);CHKERRQ(ierr);
663   if (!flag) {
664     if (PETSC_COMM_WORLD != MPI_COMM_NULL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"You cannot set PETSC_COMM_WORLD if you have not initialized MPI first");
665 #if defined(PETSC_HAVE_MPI_INIT_THREAD)
666     {
667       PetscMPIInt provided;
668       ierr = MPI_Init_thread(argc,args,MPI_THREAD_FUNNELED,&provided);CHKERRQ(ierr);
669     }
670 #else
671     ierr = MPI_Init(argc,args);CHKERRQ(ierr);
672 #endif
673     PetscBeganMPI = PETSC_TRUE;
674   }
675   if (argc && args) {
676     PetscGlobalArgc = *argc;
677     PetscGlobalArgs = *args;
678   }
679   PetscFinalizeCalled = PETSC_FALSE;
680 
681   if (PETSC_COMM_WORLD == MPI_COMM_NULL) PETSC_COMM_WORLD = MPI_COMM_WORLD;
682   ierr = MPI_Comm_set_errhandler(PETSC_COMM_WORLD,MPI_ERRORS_RETURN);CHKERRQ(ierr);
683 
684   /* Done after init due to a bug in MPICH-GM? */
685   ierr = PetscErrorPrintfInitialize();CHKERRQ(ierr);
686 
687   ierr = MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank);CHKERRQ(ierr);
688   ierr = MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize);CHKERRQ(ierr);
689 
690   MPIU_BOOL = MPI_INT;
691   MPIU_ENUM = MPI_INT;
692 
693   /*
694      Initialized the global complex variable; this is because with
695      shared libraries the constructors for global variables
696      are not called; at least on IRIX.
697   */
698 #if defined(PETSC_HAVE_COMPLEX)
699   {
700 #if defined(PETSC_CLANGUAGE_CXX)
701     PetscComplex ic(0.0,1.0);
702     PETSC_i = ic;
703 #elif defined(PETSC_CLANGUAGE_C)
704     PETSC_i = _Complex_I;
705 #endif
706   }
707 
708 #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)
709   ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr);
710   ierr = MPI_Type_commit(&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr);
711   ierr = MPI_Type_contiguous(2,MPI_FLOAT,&MPIU_C_COMPLEX);CHKERRQ(ierr);
712   ierr = MPI_Type_commit(&MPIU_C_COMPLEX);CHKERRQ(ierr);
713 #endif
714 #endif /* PETSC_HAVE_COMPLEX */
715 
716   /*
717      Create the PETSc MPI reduction operator that sums of the first
718      half of the entries and maxes the second half.
719   */
720   ierr = MPI_Op_create(PetscMaxSum_Local,1,&PetscMaxSum_Op);CHKERRQ(ierr);
721 
722 #if defined(PETSC_USE_REAL___FLOAT128)
723   ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU___FLOAT128);CHKERRQ(ierr);
724   ierr = MPI_Type_commit(&MPIU___FLOAT128);CHKERRQ(ierr);
725 #if defined(PETSC_HAVE_COMPLEX)
726   ierr = MPI_Type_contiguous(4,MPI_DOUBLE,&MPIU___COMPLEX128);CHKERRQ(ierr);
727   ierr = MPI_Type_commit(&MPIU___COMPLEX128);CHKERRQ(ierr);
728 #endif
729   ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX);CHKERRQ(ierr);
730   ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN);CHKERRQ(ierr);
731 #endif
732 
733 #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128)
734   ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);CHKERRQ(ierr);
735 #endif
736 
737   ierr = MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR);CHKERRQ(ierr);
738   ierr = MPI_Type_commit(&MPIU_2SCALAR);CHKERRQ(ierr);
739   ierr = MPI_Op_create(PetscADMax_Local,1,&PetscADMax_Op);CHKERRQ(ierr);
740   ierr = MPI_Op_create(PetscADMin_Local,1,&PetscADMin_Op);CHKERRQ(ierr);
741 
742 #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT)
743   ierr = MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT);CHKERRQ(ierr);
744   ierr = MPI_Type_commit(&MPIU_2INT);CHKERRQ(ierr);
745 #endif
746 
747   /*
748      Attributes to be set on PETSc communicators
749   */
750   ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelCounter,&Petsc_Counter_keyval,(void*)0);CHKERRQ(ierr);
751   ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm,&Petsc_InnerComm_keyval,(void*)0);CHKERRQ(ierr);
752   ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm,&Petsc_OuterComm_keyval,(void*)0);CHKERRQ(ierr);
753 
754   /*
755      Build the options database
756   */
757   ierr = PetscOptionsInsert(argc,args,file);CHKERRQ(ierr);
758 
759 
760   /*
761      Print main application help message
762   */
763   ierr = PetscOptionsHasName(NULL,"-help",&flg);CHKERRQ(ierr);
764   if (help && flg) {
765     ierr = PetscPrintf(PETSC_COMM_WORLD,help);CHKERRQ(ierr);
766   }
767   ierr = PetscOptionsCheckInitial_Private();CHKERRQ(ierr);
768 
769   /* SHOULD PUT IN GUARDS: Make sure logging is initialized, even if we do not print it out */
770 #if defined(PETSC_USE_LOG)
771   ierr = PetscLogBegin_Private();CHKERRQ(ierr);
772 #endif
773 
774   /*
775      Load the dynamic libraries (on machines that support them), this registers all
776      the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes)
777   */
778   ierr = PetscInitialize_DynamicLibraries();CHKERRQ(ierr);
779 
780   ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
781   ierr = PetscInfo1(0,"PETSc successfully started: number of processors = %d\n",size);CHKERRQ(ierr);
782   ierr = PetscGetHostName(hostname,256);CHKERRQ(ierr);
783   ierr = PetscInfo1(0,"Running on machine: %s\n",hostname);CHKERRQ(ierr);
784 
785   ierr = PetscOptionsCheckInitial_Components();CHKERRQ(ierr);
786   /* Check the options database for options related to the options database itself */
787   ierr = PetscOptionsSetFromOptions();CHKERRQ(ierr);
788 
789 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
790   /*
791       Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI
792 
793       Currently not used because it is not supported by MPICH.
794   */
795 #if !defined(PETSC_WORDS_BIGENDIAN)
796   ierr = MPI_Register_datarep((char*)"petsc",PetscDataRep_read_conv_fn,PetscDataRep_write_conv_fn,PetscDataRep_extent_fn,NULL);CHKERRQ(ierr);
797 #endif
798 #endif
799 
800   ierr = PetscOptionsGetInt(NULL,"-hmpi_spawn_size",&nodesize,&flg);CHKERRQ(ierr);
801   if (flg) {
802 #if defined(PETSC_HAVE_MPI_COMM_SPAWN)
803     ierr = PetscHMPISpawn((PetscMPIInt) nodesize);CHKERRQ(ierr); /* worker nodes never return from here; they go directly to PetscEnd() */
804 #else
805     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"PETSc built without MPI 2 (MPI_Comm_spawn) support, use -hmpi_merge_size instead");
806 #endif
807   } else {
808     ierr = PetscOptionsGetInt(NULL,"-hmpi_merge_size",&nodesize,&flg);CHKERRQ(ierr);
809     if (flg) {
810       ierr = PetscHMPIMerge((PetscMPIInt) nodesize,NULL,NULL);CHKERRQ(ierr);
811       if (PetscHMPIWorker) { /* if worker then never enter user code */
812         PetscInitializeCalled = PETSC_TRUE;
813         PetscEnd();
814       }
815     }
816   }
817 
818 #if defined(PETSC_HAVE_CUDA)
819   {
820     PetscMPIInt p;
821     for (p = 0; p < PetscGlobalSize; ++p) {
822       if (p == PetscGlobalRank) cublasInit();
823       ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr);
824     }
825   }
826 #endif
827 
828   ierr = PetscOptionsHasName(NULL,"-python",&flg);CHKERRQ(ierr);
829   if (flg) {
830     PetscInitializeCalled = PETSC_TRUE;
831     ierr = PetscPythonInitialize(NULL,NULL);CHKERRQ(ierr);
832   }
833 
834   ierr = PetscThreadCommInitializePackage();CHKERRQ(ierr);
835 
836   /*
837       Setup building of stack frames for all function calls
838   */
839 #if defined(PETSC_USE_DEBUG)
840   PetscThreadLocalRegister((PetscThreadKey*)&petscstack); /* Creates petscstack_key if needed */
841   ierr = PetscStackCreate();CHKERRQ(ierr);
842 #endif
843 
844 #if defined(PETSC_SERIALIZE_FUNCTIONS)
845   ierr = PetscFPTCreate(10000);CHKERRQ(ierr);
846 #endif
847 
848   /*
849       Once we are completedly initialized then we can set this variables
850   */
851   PetscInitializeCalled = PETSC_TRUE;
852   PetscFunctionReturn(0);
853 }
854 
855 extern PetscObject *PetscObjects;
856 extern PetscInt    PetscObjectsCounts, PetscObjectsMaxCounts;
857 
858 #undef __FUNCT__
859 #define __FUNCT__ "PetscFinalize"
860 /*@C
861    PetscFinalize - Checks for options to be called at the conclusion
862    of the program. MPI_Finalize() is called only if the user had not
863    called MPI_Init() before calling PetscInitialize().
864 
865    Collective on PETSC_COMM_WORLD
866 
867    Options Database Keys:
868 +  -options_table - Calls PetscOptionsView()
869 .  -options_left - Prints unused options that remain in the database
870 .  -objects_dump [all] - Prints list of objects allocated by the user that have not been freed, the option all cause all outstanding objects to be listed
871 .  -mpidump - Calls PetscMPIDump()
872 .  -malloc_dump - Calls PetscMallocDump()
873 .  -malloc_info - Prints total memory usage
874 -  -malloc_log - Prints summary of memory usage
875 
876    Level: beginner
877 
878    Note:
879    See PetscInitialize() for more general runtime options.
880 
881 .seealso: PetscInitialize(), PetscOptionsView(), PetscMallocDump(), PetscMPIDump(), PetscEnd()
882 @*/
883 PetscErrorCode  PetscFinalize(void)
884 {
885   PetscErrorCode ierr;
886   PetscMPIInt    rank;
887   PetscInt       nopt;
888   PetscBool      flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,flg3 = PETSC_FALSE;
889 #if defined(PETSC_HAVE_AMS)
890   PetscBool      flg = PETSC_FALSE;
891 #endif
892 #if defined(PETSC_USE_LOG)
893   char           mname[PETSC_MAX_PATH_LEN];
894 #endif
895 
896   PetscFunctionBegin;
897   if (!PetscInitializeCalled) {
898     printf("PetscInitialize() must be called before PetscFinalize()\n");
899     PetscFunctionReturn(PETSC_ERR_ARG_WRONGSTATE);
900   }
901   ierr = PetscInfo(NULL,"PetscFinalize() called\n");CHKERRQ(ierr);
902 
903 #if defined(PETSC_SERIALIZE_FUNCTIONS)
904   ierr = PetscFPTDestroy();CHKERRQ(ierr);
905 #endif
906 
907 
908 #if defined(PETSC_HAVE_AMS)
909   ierr = PetscOptionsGetBool(NULL,"-options_gui",&flg,NULL);CHKERRQ(ierr);
910   if (flg) {
911     ierr = PetscOptionsAMSDestroy();CHKERRQ(ierr);
912   }
913 #endif
914 
915 #if defined(PETSC_HAVE_SERVER)
916   flg1 = PETSC_FALSE;
917   ierr = PetscOptionsGetBool(NULL,"-server",&flg1,NULL);CHKERRQ(ierr);
918   if (flg1) {
919     /*  this is a crude hack, but better than nothing */
920     ierr = PetscPOpen(PETSC_COMM_WORLD,NULL,"pkill -9 petscwebserver","r",NULL);CHKERRQ(ierr);
921   }
922 #endif
923 
924   ierr = PetscHMPIFinalize();CHKERRQ(ierr);
925 
926   ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
927   ierr = PetscOptionsGetBool(NULL,"-malloc_info",&flg2,NULL);CHKERRQ(ierr);
928   if (!flg2) {
929     flg2 = PETSC_FALSE;
930     ierr = PetscOptionsGetBool(NULL,"-memory_info",&flg2,NULL);CHKERRQ(ierr);
931   }
932   if (flg2) {
933     ierr = PetscMemoryShowUsage(PETSC_VIEWER_STDOUT_WORLD,"Summary of Memory Usage in PETSc\n");CHKERRQ(ierr);
934   }
935 
936 #if defined(PETSC_USE_LOG)
937   flg1 = PETSC_FALSE;
938   ierr = PetscOptionsGetBool(NULL,"-get_total_flops",&flg1,NULL);CHKERRQ(ierr);
939   if (flg1) {
940     PetscLogDouble flops = 0;
941     ierr = MPI_Reduce(&petsc_TotalFlops,&flops,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRQ(ierr);
942     ierr = PetscPrintf(PETSC_COMM_WORLD,"Total flops over all processors %g\n",flops);CHKERRQ(ierr);
943   }
944 #endif
945 
946 
947 #if defined(PETSC_USE_LOG)
948 #if defined(PETSC_HAVE_MPE)
949   mname[0] = 0;
950 
951   ierr = PetscOptionsGetString(NULL,"-log_mpe",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
952   if (flg1) {
953     if (mname[0]) {ierr = PetscLogMPEDump(mname);CHKERRQ(ierr);}
954     else          {ierr = PetscLogMPEDump(0);CHKERRQ(ierr);}
955   }
956 #endif
957   mname[0] = 0;
958 
959   ierr = PetscOptionsGetString(NULL,"-log_summary",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
960   if (flg1) {
961     PetscViewer viewer;
962     if (mname[0]) {
963       ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);CHKERRQ(ierr);
964       ierr = PetscLogView(viewer);CHKERRQ(ierr);
965       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
966     } else {
967       viewer = PETSC_VIEWER_STDOUT_WORLD;
968       ierr   = PetscLogView(viewer);CHKERRQ(ierr);
969     }
970   }
971 
972   mname[0] = 0;
973 
974   ierr = PetscOptionsGetString(NULL,"-log_summary_python",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
975   if (flg1) {
976     PetscViewer viewer;
977     if (mname[0]) {
978       ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);CHKERRQ(ierr);
979       ierr = PetscLogViewPython(viewer);CHKERRQ(ierr);
980       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
981     } else {
982       viewer = PETSC_VIEWER_STDOUT_WORLD;
983       ierr   = PetscLogViewPython(viewer);CHKERRQ(ierr);
984     }
985   }
986 
987   ierr = PetscOptionsGetString(NULL,"-log_detailed",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
988   if (flg1) {
989     if (mname[0])  {ierr = PetscLogPrintDetailed(PETSC_COMM_WORLD,mname);CHKERRQ(ierr);}
990     else           {ierr = PetscLogPrintDetailed(PETSC_COMM_WORLD,0);CHKERRQ(ierr);}
991   }
992 
993   mname[0] = 0;
994 
995   ierr = PetscOptionsGetString(NULL,"-log_all",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
996   ierr = PetscOptionsGetString(NULL,"-log",mname,PETSC_MAX_PATH_LEN,&flg2);CHKERRQ(ierr);
997   if (flg1 || flg2) {
998     if (mname[0]) PetscLogDump(mname);
999     else          PetscLogDump(0);
1000   }
1001 #endif
1002 
1003   /*
1004      Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_().
1005   */
1006   ierr = PetscObjectRegisterDestroyAll();CHKERRQ(ierr);
1007 
1008   ierr = PetscStackDestroy();CHKERRQ(ierr);
1009 
1010   flg1 = PETSC_FALSE;
1011   ierr = PetscOptionsGetBool(NULL,"-no_signal_handler",&flg1,NULL);CHKERRQ(ierr);
1012   if (!flg1) { ierr = PetscPopSignalHandler();CHKERRQ(ierr);}
1013   flg1 = PETSC_FALSE;
1014   ierr = PetscOptionsGetBool(NULL,"-mpidump",&flg1,NULL);CHKERRQ(ierr);
1015   if (flg1) {
1016     ierr = PetscMPIDump(stdout);CHKERRQ(ierr);
1017   }
1018   flg1 = PETSC_FALSE;
1019   flg2 = PETSC_FALSE;
1020   /* preemptive call to avoid listing this option in options table as unused */
1021   ierr = PetscOptionsHasName(NULL,"-malloc_dump",&flg1);CHKERRQ(ierr);
1022   ierr = PetscOptionsHasName(NULL,"-objects_dump",&flg1);CHKERRQ(ierr);
1023   ierr = PetscOptionsGetBool(NULL,"-options_table",&flg2,NULL);CHKERRQ(ierr);
1024 
1025   if (flg2) {
1026     PetscViewer viewer;
1027     ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
1028     ierr = PetscOptionsView(viewer);CHKERRQ(ierr);
1029     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
1030   }
1031 
1032   /* to prevent PETSc -options_left from warning */
1033   ierr = PetscOptionsHasName(NULL,"-nox",&flg1);CHKERRQ(ierr);
1034   ierr = PetscOptionsHasName(NULL,"-nox_warning",&flg1);CHKERRQ(ierr);
1035 
1036   if (!PetscHMPIWorker) { /* worker processes skip this because they do not usually process options */
1037     flg3 = PETSC_FALSE; /* default value is required */
1038     ierr = PetscOptionsGetBool(NULL,"-options_left",&flg3,&flg1);CHKERRQ(ierr);
1039     ierr = PetscOptionsAllUsed(&nopt);CHKERRQ(ierr);
1040     if (flg3) {
1041       if (!flg2) { /* have not yet printed the options */
1042         PetscViewer viewer;
1043         ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
1044         ierr = PetscOptionsView(viewer);CHKERRQ(ierr);
1045         ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
1046       }
1047       if (!nopt) {
1048         ierr = PetscPrintf(PETSC_COMM_WORLD,"There are no unused options.\n");CHKERRQ(ierr);
1049       } else if (nopt == 1) {
1050         ierr = PetscPrintf(PETSC_COMM_WORLD,"There is one unused database option. It is:\n");CHKERRQ(ierr);
1051       } else {
1052         ierr = PetscPrintf(PETSC_COMM_WORLD,"There are %D unused database options. They are:\n",nopt);CHKERRQ(ierr);
1053       }
1054     }
1055 #if defined(PETSC_USE_DEBUG)
1056     if (nopt && !flg3 && !flg1) {
1057       ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! There are options you set that were not used!\n");CHKERRQ(ierr);
1058       ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! could be spelling mistake, etc!\n");CHKERRQ(ierr);
1059       ierr = PetscOptionsLeft();CHKERRQ(ierr);
1060     } else if (nopt && flg3) {
1061 #else
1062     if (nopt && flg3) {
1063 #endif
1064       ierr = PetscOptionsLeft();CHKERRQ(ierr);
1065     }
1066   }
1067 
1068   {
1069     PetscThreadComm tcomm_world;
1070     ierr = PetscGetThreadCommWorld(&tcomm_world);CHKERRQ(ierr);
1071     /* Free global thread communicator */
1072     ierr = PetscThreadCommDestroy(&tcomm_world);CHKERRQ(ierr);
1073   }
1074 
1075   /*
1076        List all objects the user may have forgot to free
1077   */
1078   ierr = PetscOptionsHasName(NULL,"-objects_dump",&flg1);CHKERRQ(ierr);
1079   if (flg1) {
1080     MPI_Comm local_comm;
1081     char     string[64];
1082 
1083     ierr = PetscOptionsGetString(NULL,"-objects_dump",string,64,NULL);CHKERRQ(ierr);
1084     ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr);
1085     ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr);
1086     ierr = PetscObjectsDump(stdout,(string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE);CHKERRQ(ierr);
1087     ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr);
1088     ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr);
1089   }
1090   PetscObjectsCounts    = 0;
1091   PetscObjectsMaxCounts = 0;
1092 
1093   ierr = PetscFree(PetscObjects);CHKERRQ(ierr);
1094 
1095 #if defined(PETSC_USE_LOG)
1096   ierr = PetscLogDestroy();CHKERRQ(ierr);
1097 #endif
1098 
1099   /*
1100      Destroy any packages that registered a finalize
1101   */
1102   ierr = PetscRegisterFinalizeAll();CHKERRQ(ierr);
1103 
1104   /*
1105      Destroy all the function registration lists created
1106   */
1107   ierr = PetscFinalize_DynamicLibraries();CHKERRQ(ierr);
1108 
1109   /*
1110      Print PetscFunctionLists that have not been properly freed
1111 
1112   ierr = PetscFunctionListPrintAll();CHKERRQ(ierr);
1113   */
1114 
1115   if (petsc_history) {
1116     ierr = PetscCloseHistoryFile(&petsc_history);CHKERRQ(ierr);
1117     petsc_history = 0;
1118   }
1119 
1120   ierr = PetscInfoAllow(PETSC_FALSE,NULL);CHKERRQ(ierr);
1121 
1122   {
1123     char fname[PETSC_MAX_PATH_LEN];
1124     FILE *fd;
1125     int  err;
1126 
1127     fname[0] = 0;
1128 
1129     ierr = PetscOptionsGetString(NULL,"-malloc_dump",fname,250,&flg1);CHKERRQ(ierr);
1130     flg2 = PETSC_FALSE;
1131     ierr = PetscOptionsGetBool(NULL,"-malloc_test",&flg2,NULL);CHKERRQ(ierr);
1132 #if defined(PETSC_USE_DEBUG)
1133     if (PETSC_RUNNING_ON_VALGRIND) flg2 = PETSC_FALSE;
1134 #else
1135     flg2 = PETSC_FALSE;         /* Skip reporting for optimized builds regardless of -malloc_test */
1136 #endif
1137     if (flg1 && fname[0]) {
1138       char sname[PETSC_MAX_PATH_LEN];
1139 
1140       sprintf(sname,"%s_%d",fname,rank);
1141       fd   = fopen(sname,"w"); if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname);
1142       ierr = PetscMallocDump(fd);CHKERRQ(ierr);
1143       err  = fclose(fd);
1144       if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
1145     } else if (flg1 || flg2) {
1146       MPI_Comm local_comm;
1147 
1148       ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr);
1149       ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr);
1150       ierr = PetscMallocDump(stdout);CHKERRQ(ierr);
1151       ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr);
1152       ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr);
1153     }
1154   }
1155 
1156   {
1157     char fname[PETSC_MAX_PATH_LEN];
1158     FILE *fd = NULL;
1159 
1160     fname[0] = 0;
1161 
1162     ierr = PetscOptionsGetString(NULL,"-malloc_log",fname,250,&flg1);CHKERRQ(ierr);
1163     ierr = PetscOptionsHasName(NULL,"-malloc_log_threshold",&flg2);CHKERRQ(ierr);
1164     if (flg1 && fname[0]) {
1165       int err;
1166 
1167       if (!rank) {
1168         fd = fopen(fname,"w");
1169         if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",fname);
1170       }
1171       ierr = PetscMallocDumpLog(fd);CHKERRQ(ierr);
1172       if (fd) {
1173         err = fclose(fd);
1174         if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
1175       }
1176     } else if (flg1 || flg2) {
1177       ierr = PetscMallocDumpLog(stdout);CHKERRQ(ierr);
1178     }
1179   }
1180   /* Can be destroyed only after all the options are used */
1181   ierr = PetscOptionsDestroy();CHKERRQ(ierr);
1182 
1183   PetscGlobalArgc = 0;
1184   PetscGlobalArgs = 0;
1185 
1186 #if defined(PETSC_USE_REAL___FLOAT128)
1187   ierr = MPI_Type_free(&MPIU___FLOAT128);CHKERRQ(ierr);
1188 #if defined(PETSC_HAVE_COMPLEX)
1189   ierr = MPI_Type_free(&MPIU___COMPLEX128);CHKERRQ(ierr);
1190 #endif
1191   ierr = MPI_Op_free(&MPIU_MAX);CHKERRQ(ierr);
1192   ierr = MPI_Op_free(&MPIU_MIN);CHKERRQ(ierr);
1193 #endif
1194 
1195 #if defined(PETSC_HAVE_COMPLEX)
1196 #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)
1197   ierr = MPI_Type_free(&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr);
1198   ierr = MPI_Type_free(&MPIU_C_COMPLEX);CHKERRQ(ierr);
1199 #endif
1200 #endif
1201 
1202 #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128)
1203   ierr = MPI_Op_free(&MPIU_SUM);CHKERRQ(ierr);
1204 #endif
1205 
1206   ierr = MPI_Type_free(&MPIU_2SCALAR);CHKERRQ(ierr);
1207 #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT)
1208   ierr = MPI_Type_free(&MPIU_2INT);CHKERRQ(ierr);
1209 #endif
1210   ierr = MPI_Op_free(&PetscMaxSum_Op);CHKERRQ(ierr);
1211   ierr = MPI_Op_free(&PetscADMax_Op);CHKERRQ(ierr);
1212   ierr = MPI_Op_free(&PetscADMin_Op);CHKERRQ(ierr);
1213 
1214   /*
1215      Destroy any known inner MPI_Comm's and attributes pointing to them
1216      Note this will not destroy any new communicators the user has created.
1217 
1218      If all PETSc objects were not destroyed those left over objects will have hanging references to
1219      the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again
1220  */
1221   {
1222     PetscCommCounter *counter;
1223     PetscMPIInt      flg;
1224     MPI_Comm         icomm;
1225     void             *ptr;
1226     ierr = MPI_Attr_get(PETSC_COMM_SELF,Petsc_InnerComm_keyval,&ptr,&flg);CHKERRQ(ierr);
1227     if (flg) {
1228       /*  Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers  */
1229       ierr = PetscMemcpy(&icomm,&ptr,sizeof(MPI_Comm));CHKERRQ(ierr);
1230       ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr);
1231       if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1232 
1233       ierr = MPI_Attr_delete(PETSC_COMM_SELF,Petsc_InnerComm_keyval);CHKERRQ(ierr);
1234       ierr = MPI_Attr_delete(icomm,Petsc_Counter_keyval);CHKERRQ(ierr);
1235       ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr);
1236     }
1237     ierr = MPI_Attr_get(PETSC_COMM_WORLD,Petsc_InnerComm_keyval,&ptr,&flg);CHKERRQ(ierr);
1238     if (flg) {
1239       /*  Use PetscMemcpy() because casting from pointer to integer of different size is not allowed with some compilers  */
1240       ierr = PetscMemcpy(&icomm,&ptr,sizeof(MPI_Comm));CHKERRQ(ierr);
1241       ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr);
1242       if (!flg) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1243 
1244       ierr = MPI_Attr_delete(PETSC_COMM_WORLD,Petsc_InnerComm_keyval);CHKERRQ(ierr);
1245       ierr = MPI_Attr_delete(icomm,Petsc_Counter_keyval);CHKERRQ(ierr);
1246       ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr);
1247     }
1248   }
1249 
1250   ierr = MPI_Keyval_free(&Petsc_Counter_keyval);CHKERRQ(ierr);
1251   ierr = MPI_Keyval_free(&Petsc_InnerComm_keyval);CHKERRQ(ierr);
1252   ierr = MPI_Keyval_free(&Petsc_OuterComm_keyval);CHKERRQ(ierr);
1253 
1254 #if defined(PETSC_HAVE_CUDA)
1255   {
1256     PetscInt p;
1257     for (p = 0; p < PetscGlobalSize; ++p) {
1258       if (p == PetscGlobalRank) cublasShutdown();
1259       ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr);
1260     }
1261   }
1262 #endif
1263 
1264   if (PetscBeganMPI) {
1265 #if defined(PETSC_HAVE_MPI_FINALIZED)
1266     PetscMPIInt flag;
1267     ierr = MPI_Finalized(&flag);CHKERRQ(ierr);
1268     if (flag) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()");
1269 #endif
1270     ierr = MPI_Finalize();CHKERRQ(ierr);
1271   }
1272 /*
1273 
1274      Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because
1275    the communicator has some outstanding requests on it. Specifically if the
1276    flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See
1277    src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate()
1278    is never freed as it should be. Thus one may obtain messages of the form
1279    [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the
1280    memory was not freed.
1281 
1282 */
1283   ierr = PetscMallocClear();CHKERRQ(ierr);
1284 
1285   PetscInitializeCalled = PETSC_FALSE;
1286   PetscFinalizeCalled   = PETSC_TRUE;
1287   PetscFunctionReturn(ierr);
1288 }
1289 
1290 #if defined(PETSC_MISSING_LAPACK_lsame_)
1291 PETSC_EXTERN int lsame_(char *a,char *b)
1292 {
1293   if (*a == *b) return 1;
1294   if (*a + 32 == *b) return 1;
1295   if (*a - 32 == *b) return 1;
1296   return 0;
1297 }
1298 #endif
1299 
1300 #if defined(PETSC_MISSING_LAPACK_lsame)
1301 PETSC_EXTERN int lsame(char *a,char *b)
1302 {
1303   if (*a == *b) return 1;
1304   if (*a + 32 == *b) return 1;
1305   if (*a - 32 == *b) return 1;
1306   return 0;
1307 }
1308 #endif
1309