xref: /petsc/src/sys/objects/pinit.c (revision e04113cf637149666d9c83678a5abc4e1b351bcc)
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_Outer"
390 /*
391   This is invoked on the outer comm as a result of either PetscCommDestroy() (via MPI_Attr_delete) or when the user
392   calls MPI_Comm_free().
393 
394   This is the only entry point for breaking the links between inner and outer comms.
395 
396   This is called by MPI, not by users. This is called when MPI_Comm_free() is called on the communicator.
397 
398   Note: this is declared extern "C" because it is passed to MPI_Keyval_create()
399 
400 */
401 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Outer(MPI_Comm comm,PetscMPIInt keyval,void *attr_val,void *extra_state)
402 {
403   PetscErrorCode ierr;
404   PetscMPIInt    flg;
405   union {MPI_Comm comm; void *ptr;} icomm,ocomm;
406 
407   PetscFunctionBegin;
408   if (keyval != Petsc_InnerComm_keyval) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Unexpected keyval");
409   icomm.ptr = attr_val;
410 
411   ierr = MPI_Attr_get(icomm.comm,Petsc_OuterComm_keyval,&ocomm,&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   if (ocomm.comm != comm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm has reference to non-matching outer comm");
414   ierr = MPI_Attr_delete(icomm.comm,Petsc_OuterComm_keyval);CHKERRQ(ierr); /* Calls Petsc_DelComm_Inner */
415   ierr = PetscInfo1(0,"User MPI_Comm %ld is being freed after removing reference from inner PETSc comm to this outer comm\n",(long)comm);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr);
416   PetscFunctionReturn(MPI_SUCCESS);
417 }
418 
419 #undef __FUNCT__
420 #define __FUNCT__ "Petsc_DelComm_Inner"
421 /*
422  * This is invoked on the inner comm when Petsc_DelComm_Outer calls MPI_Attr_delete.  It should not be reached any other way.
423  */
424 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Inner(MPI_Comm comm,PetscMPIInt keyval,void *attr_val,void *extra_state)
425 {
426   PetscErrorCode ierr;
427 
428   PetscFunctionBegin;
429   ierr = PetscInfo1(0,"Removing reference to PETSc communicator embedded in a user MPI_Comm %ld\n",(long)comm);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr);
430   PetscFunctionReturn(MPI_SUCCESS);
431 }
432 
433 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
434 #if !defined(PETSC_WORDS_BIGENDIAN)
435 PETSC_EXTERN PetscMPIInt PetscDataRep_extent_fn(MPI_Datatype,MPI_Aint*,void*);
436 PETSC_EXTERN PetscMPIInt PetscDataRep_read_conv_fn(void*, MPI_Datatype,PetscMPIInt,void*,MPI_Offset,void*);
437 PETSC_EXTERN PetscMPIInt PetscDataRep_write_conv_fn(void*, MPI_Datatype,PetscMPIInt,void*,MPI_Offset,void*);
438 #endif
439 #endif
440 
441 int  PetscGlobalArgc   = 0;
442 char **PetscGlobalArgs = 0;
443 PetscSegBuffer PetscCitationsList;
444 
445 #undef __FUNCT__
446 #define __FUNCT__ "PetscCitationsInitialize"
447 PetscErrorCode PetscCitationsInitialize()
448 {
449   PetscErrorCode ierr;
450 
451   PetscFunctionBegin;
452   ierr = PetscSegBufferCreate(1,10000,&PetscCitationsList);CHKERRQ(ierr);
453   ierr = PetscCitationsRegister("@TechReport{petsc-user-ref,\n  Author = {Satish Balay and Jed Brown and and Kris Buschelman and Victor Eijkhout\n            and William D.  Gropp and Dinesh Kaushik and Matthew G. Knepley\n            and Lois Curfman McInnes and Barry F. Smith and Hong Zhang},\n  Title = {{PETS}c Users Manual},\n  Number = {ANL-95/11 - Revision 3.4},\n  Institution = {Argonne National Laboratory},\n  Year = {2013}\n}\n",NULL);CHKERRQ(ierr);
454   ierr = PetscCitationsRegister("@InProceedings{petsc-efficient,\n  Author = {Satish Balay and William D. Gropp and Lois Curfman McInnes and Barry F. Smith},\n  Title = {Efficient Management of Parallelism in Object Oriented Numerical Software Libraries},\n  Booktitle = {Modern Software Tools in Scientific Computing},\n  Editor = {E. Arge and A. M. Bruaset and H. P. Langtangen},\n  Pages = {163--202},\n  Publisher = {Birkh{\\\"{a}}user Press},\n  Year = {1997}\n}\n",NULL);CHKERRQ(ierr);
455   PetscFunctionReturn(0);
456 }
457 
458 #undef __FUNCT__
459 #define __FUNCT__ "PetscGetArgs"
460 /*@C
461    PetscGetArgs - Allows you to access the raw command line arguments anywhere
462      after PetscInitialize() is called but before PetscFinalize().
463 
464    Not Collective
465 
466    Output Parameters:
467 +  argc - count of number of command line arguments
468 -  args - the command line arguments
469 
470    Level: intermediate
471 
472    Notes:
473       This is usually used to pass the command line arguments into other libraries
474    that are called internally deep in PETSc or the application.
475 
476       The first argument contains the program name as is normal for C arguments.
477 
478    Concepts: command line arguments
479 
480 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArguments()
481 
482 @*/
483 PetscErrorCode  PetscGetArgs(int *argc,char ***args)
484 {
485   PetscFunctionBegin;
486   if (!PetscInitializeCalled && PetscFinalizeCalled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"You must call after PetscInitialize() but before PetscFinalize()");
487   *argc = PetscGlobalArgc;
488   *args = PetscGlobalArgs;
489   PetscFunctionReturn(0);
490 }
491 
492 #undef __FUNCT__
493 #define __FUNCT__ "PetscGetArguments"
494 /*@C
495    PetscGetArguments - Allows you to access the  command line arguments anywhere
496      after PetscInitialize() is called but before PetscFinalize().
497 
498    Not Collective
499 
500    Output Parameters:
501 .  args - the command line arguments
502 
503    Level: intermediate
504 
505    Notes:
506       This does NOT start with the program name and IS null terminated (final arg is void)
507 
508    Concepts: command line arguments
509 
510 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscFreeArguments()
511 
512 @*/
513 PetscErrorCode  PetscGetArguments(char ***args)
514 {
515   PetscInt       i,argc = PetscGlobalArgc;
516   PetscErrorCode ierr;
517 
518   PetscFunctionBegin;
519   if (!PetscInitializeCalled && PetscFinalizeCalled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"You must call after PetscInitialize() but before PetscFinalize()");
520   if (!argc) {*args = 0; PetscFunctionReturn(0);}
521   ierr = PetscMalloc(argc*sizeof(char*),args);CHKERRQ(ierr);
522   for (i=0; i<argc-1; i++) {
523     ierr = PetscStrallocpy(PetscGlobalArgs[i+1],&(*args)[i]);CHKERRQ(ierr);
524   }
525   (*args)[argc-1] = 0;
526   PetscFunctionReturn(0);
527 }
528 
529 #undef __FUNCT__
530 #define __FUNCT__ "PetscFreeArguments"
531 /*@C
532    PetscFreeArguments - Frees the memory obtained with PetscGetArguments()
533 
534    Not Collective
535 
536    Output Parameters:
537 .  args - the command line arguments
538 
539    Level: intermediate
540 
541    Concepts: command line arguments
542 
543 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscGetArguments()
544 
545 @*/
546 PetscErrorCode  PetscFreeArguments(char **args)
547 {
548   PetscInt       i = 0;
549   PetscErrorCode ierr;
550 
551   PetscFunctionBegin;
552   if (!args) PetscFunctionReturn(0);
553   while (args[i]) {
554     ierr = PetscFree(args[i]);CHKERRQ(ierr);
555     i++;
556   }
557   ierr = PetscFree(args);CHKERRQ(ierr);
558   PetscFunctionReturn(0);
559 }
560 
561 #undef __FUNCT__
562 #define __FUNCT__ "PetscInitialize"
563 /*@C
564    PetscInitialize - Initializes the PETSc database and MPI.
565    PetscInitialize() calls MPI_Init() if that has yet to be called,
566    so this routine should always be called near the beginning of
567    your program -- usually the very first line!
568 
569    Collective on MPI_COMM_WORLD or PETSC_COMM_WORLD if it has been set
570 
571    Input Parameters:
572 +  argc - count of number of command line arguments
573 .  args - the command line arguments
574 .  file - [optional] PETSc database file, also checks ~username/.petscrc and .petscrc use NULL to not check for
575           code specific file. Use -skip_petscrc in the code specific file to skip the .petscrc files
576 -  help - [optional] Help message to print, use NULL for no message
577 
578    If you wish PETSc code to run ONLY on a subcommunicator of MPI_COMM_WORLD, create that
579    communicator first and assign it to PETSC_COMM_WORLD BEFORE calling PetscInitialize(). Thus if you are running a
580    four process job and two processes will run PETSc and have PetscInitialize() and PetscFinalize() and two process will not,
581    then do this. If ALL processes in the job are using PetscInitialize() and PetscFinalize() then you don't need to do this, even
582    if different subcommunicators of the job are doing different things with PETSc.
583 
584    Options Database Keys:
585 +  -start_in_debugger [noxterm,dbx,xdb,gdb,...] - Starts program in debugger
586 .  -on_error_attach_debugger [noxterm,dbx,xdb,gdb,...] - Starts debugger when error detected
587 .  -on_error_emacs <machinename> causes emacsclient to jump to error file
588 .  -on_error_abort calls abort() when error detected (no traceback)
589 .  -on_error_mpiabort calls MPI_abort() when error detected
590 .  -error_output_stderr prints error messages to stderr instead of the default stdout
591 .  -error_output_none does not print the error messages (but handles errors in the same way as if this was not called)
592 .  -debugger_nodes [node1,node2,...] - Indicates nodes to start in debugger
593 .  -debugger_pause [sleeptime] (in seconds) - Pauses debugger
594 .  -stop_for_debugger - Print message on how to attach debugger manually to
595                         process and wait (-debugger_pause) seconds for attachment
596 .  -malloc - Indicates use of PETSc error-checking malloc (on by default for debug version of libraries)
597 .  -malloc no - Indicates not to use error-checking malloc
598 .  -malloc_debug - check for memory corruption at EVERY malloc or free
599 .  -malloc_test - like -malloc_dump -malloc_debug, but only active for debugging builds
600 .  -fp_trap - Stops on floating point exceptions (Note that on the
601               IBM RS6000 this slows code by at least a factor of 10.)
602 .  -no_signal_handler - Indicates not to trap error signals
603 .  -shared_tmp - indicates /tmp directory is shared by all processors
604 .  -not_shared_tmp - each processor has own /tmp
605 .  -tmp - alternative name of /tmp directory
606 .  -get_total_flops - returns total flops done by all processors
607 .  -memory_info - Print memory usage at end of run
608 -  -server <port> - start PETSc webserver (default port is 8080)
609 
610    Options Database Keys for Profiling:
611    See the <a href="../../docs/manual.pdf#nameddest=ch_profiling">profiling chapter of the users manual</a> for details.
612 +  -info <optional filename> - Prints verbose information to the screen
613 .  -info_exclude <null,vec,mat,pc,ksp,snes,ts> - Excludes some of the verbose messages
614 .  -log_sync - Log the synchronization in scatters, inner products and norms
615 .  -log_trace [filename] - Print traces of all PETSc calls to the screen (useful to determine where a program
616         hangs without running in the debugger).  See PetscLogTraceBegin().
617 .  -log_summary [filename] - Prints summary of flop and timing information to screen. If the filename is specified the
618         summary is written to the file.  See PetscLogView().
619 .  -log_summary_python [filename] - Prints data on of flop and timing usage to a file or screen. See PetscLogPrintSViewPython().
620 .  -log_all [filename] - Logs extensive profiling information  See PetscLogDump().
621 .  -log [filename] - Logs basic profiline information  See PetscLogDump().
622 -  -log_mpe [filename] - Creates a logfile viewable by the utility Jumpshot (in MPICH distribution)
623 
624     Only one of -log_trace, -log_summary, -log_all, -log, or -log_mpe may be used at a time
625 
626    Environmental Variables:
627 +   PETSC_TMP - alternative tmp directory
628 .   PETSC_SHARED_TMP - tmp is shared by all processes
629 .   PETSC_NOT_SHARED_TMP - each process has its own private tmp
630 .   PETSC_VIEWER_SOCKET_PORT - socket number to use for socket viewer
631 -   PETSC_VIEWER_SOCKET_MACHINE - machine to use for socket viewer to connect to
632 
633 
634    Level: beginner
635 
636    Notes:
637    If for some reason you must call MPI_Init() separately, call
638    it before PetscInitialize().
639 
640    Fortran Version:
641    In Fortran this routine has the format
642 $       call PetscInitialize(file,ierr)
643 
644 +   ierr - error return code
645 -  file - [optional] PETSc database file, also checks ~username/.petscrc and .petscrc use NULL_CHARACTER to not check for
646           code specific file. Use -skip_petscrc in the code specific file to skip the .petscrc files
647 
648    Important Fortran Note:
649    In Fortran, you MUST use NULL_CHARACTER to indicate a
650    null character string; you CANNOT just use NULL as
651    in the C version. See the <a href="../../docs/manual.pdf">users manual</a> for details.
652 
653    If your main program is C but you call Fortran code that also uses PETSc you need to call PetscInitializeFortran() soon after
654    calling PetscInitialize().
655 
656    Concepts: initializing PETSc
657 
658 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscInitializeNoArguments()
659 
660 @*/
661 PetscErrorCode  PetscInitialize(int *argc,char ***args,const char file[],const char help[])
662 {
663   PetscErrorCode ierr;
664   PetscMPIInt    flag, size;
665   PetscInt       nodesize;
666   PetscBool      flg;
667   char           hostname[256];
668 
669   PetscFunctionBegin;
670   if (PetscInitializeCalled) PetscFunctionReturn(0);
671 
672   /* these must be initialized in a routine, not as a constant declaration*/
673   PETSC_STDOUT = stdout;
674   PETSC_STDERR = stderr;
675 
676   ierr = PetscOptionsCreate();CHKERRQ(ierr);
677 
678   /*
679      We initialize the program name here (before MPI_Init()) because MPICH has a bug in
680      it that it sets args[0] on all processors to be args[0] on the first processor.
681   */
682   if (argc && *argc) {
683     ierr = PetscSetProgramName(**args);CHKERRQ(ierr);
684   } else {
685     ierr = PetscSetProgramName("Unknown Name");CHKERRQ(ierr);
686   }
687 
688   ierr = MPI_Initialized(&flag);CHKERRQ(ierr);
689   if (!flag) {
690     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");
691 #if defined(PETSC_HAVE_MPI_INIT_THREAD)
692     {
693       PetscMPIInt provided;
694       ierr = MPI_Init_thread(argc,args,MPI_THREAD_FUNNELED,&provided);CHKERRQ(ierr);
695     }
696 #else
697     ierr = MPI_Init(argc,args);CHKERRQ(ierr);
698 #endif
699     PetscBeganMPI = PETSC_TRUE;
700   }
701   if (argc && args) {
702     PetscGlobalArgc = *argc;
703     PetscGlobalArgs = *args;
704   }
705   PetscFinalizeCalled = PETSC_FALSE;
706 
707   if (PETSC_COMM_WORLD == MPI_COMM_NULL) PETSC_COMM_WORLD = MPI_COMM_WORLD;
708   ierr = MPI_Comm_set_errhandler(PETSC_COMM_WORLD,MPI_ERRORS_RETURN);CHKERRQ(ierr);
709 
710   /* Done after init due to a bug in MPICH-GM? */
711   ierr = PetscErrorPrintfInitialize();CHKERRQ(ierr);
712 
713   ierr = MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank);CHKERRQ(ierr);
714   ierr = MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize);CHKERRQ(ierr);
715 
716   MPIU_BOOL = MPI_INT;
717   MPIU_ENUM = MPI_INT;
718 
719   /*
720      Initialized the global complex variable; this is because with
721      shared libraries the constructors for global variables
722      are not called; at least on IRIX.
723   */
724 #if defined(PETSC_HAVE_COMPLEX)
725   {
726 #if defined(PETSC_CLANGUAGE_CXX)
727     PetscComplex ic(0.0,1.0);
728     PETSC_i = ic;
729 #elif defined(PETSC_CLANGUAGE_C)
730     PETSC_i = _Complex_I;
731 #endif
732   }
733 
734 #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)
735   ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr);
736   ierr = MPI_Type_commit(&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr);
737   ierr = MPI_Type_contiguous(2,MPI_FLOAT,&MPIU_C_COMPLEX);CHKERRQ(ierr);
738   ierr = MPI_Type_commit(&MPIU_C_COMPLEX);CHKERRQ(ierr);
739 #endif
740 #endif /* PETSC_HAVE_COMPLEX */
741 
742   /*
743      Create the PETSc MPI reduction operator that sums of the first
744      half of the entries and maxes the second half.
745   */
746   ierr = MPI_Op_create(PetscMaxSum_Local,1,&PetscMaxSum_Op);CHKERRQ(ierr);
747 
748 #if defined(PETSC_USE_REAL___FLOAT128)
749   ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU___FLOAT128);CHKERRQ(ierr);
750   ierr = MPI_Type_commit(&MPIU___FLOAT128);CHKERRQ(ierr);
751 #if defined(PETSC_HAVE_COMPLEX)
752   ierr = MPI_Type_contiguous(4,MPI_DOUBLE,&MPIU___COMPLEX128);CHKERRQ(ierr);
753   ierr = MPI_Type_commit(&MPIU___COMPLEX128);CHKERRQ(ierr);
754 #endif
755   ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX);CHKERRQ(ierr);
756   ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN);CHKERRQ(ierr);
757 #endif
758 
759 #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128)
760   ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);CHKERRQ(ierr);
761 #endif
762 
763   ierr = MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR);CHKERRQ(ierr);
764   ierr = MPI_Type_commit(&MPIU_2SCALAR);CHKERRQ(ierr);
765   ierr = MPI_Op_create(PetscADMax_Local,1,&PetscADMax_Op);CHKERRQ(ierr);
766   ierr = MPI_Op_create(PetscADMin_Local,1,&PetscADMin_Op);CHKERRQ(ierr);
767 
768 #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT)
769   ierr = MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT);CHKERRQ(ierr);
770   ierr = MPI_Type_commit(&MPIU_2INT);CHKERRQ(ierr);
771 #endif
772 
773 
774   /*
775      Attributes to be set on PETSc communicators
776   */
777   ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelCounter,&Petsc_Counter_keyval,(void*)0);CHKERRQ(ierr);
778   ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Outer,&Petsc_InnerComm_keyval,(void*)0);CHKERRQ(ierr);
779   ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Inner,&Petsc_OuterComm_keyval,(void*)0);CHKERRQ(ierr);
780 
781   /*
782      Build the options database
783   */
784   ierr = PetscOptionsInsert(argc,args,file);CHKERRQ(ierr);
785 
786 
787   /*
788      Print main application help message
789   */
790   ierr = PetscOptionsHasName(NULL,"-help",&flg);CHKERRQ(ierr);
791   if (help && flg) {
792     ierr = PetscPrintf(PETSC_COMM_WORLD,help);CHKERRQ(ierr);
793   }
794   ierr = PetscOptionsCheckInitial_Private();CHKERRQ(ierr);
795 
796 #if defined(PETSC_HAVE_SAWS)
797   ierr = SAWS_Initialize();CHKERRQ(ierr);
798 #endif
799 
800   /* SHOULD PUT IN GUARDS: Make sure logging is initialized, even if we do not print it out */
801 #if defined(PETSC_USE_LOG)
802   ierr = PetscLogBegin_Private();CHKERRQ(ierr);
803 #endif
804 
805   /*
806      Load the dynamic libraries (on machines that support them), this registers all
807      the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes)
808   */
809   ierr = PetscInitialize_DynamicLibraries();CHKERRQ(ierr);
810 
811   ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
812   ierr = PetscInfo1(0,"PETSc successfully started: number of processors = %d\n",size);CHKERRQ(ierr);
813   ierr = PetscGetHostName(hostname,256);CHKERRQ(ierr);
814   ierr = PetscInfo1(0,"Running on machine: %s\n",hostname);CHKERRQ(ierr);
815 
816   ierr = PetscOptionsCheckInitial_Components();CHKERRQ(ierr);
817   /* Check the options database for options related to the options database itself */
818   ierr = PetscOptionsSetFromOptions();CHKERRQ(ierr);
819 
820 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
821   /*
822       Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI
823 
824       Currently not used because it is not supported by MPICH.
825   */
826 #if !defined(PETSC_WORDS_BIGENDIAN)
827   ierr = MPI_Register_datarep((char*)"petsc",PetscDataRep_read_conv_fn,PetscDataRep_write_conv_fn,PetscDataRep_extent_fn,NULL);CHKERRQ(ierr);
828 #endif
829 #endif
830 
831   ierr = PetscOptionsGetInt(NULL,"-hmpi_spawn_size",&nodesize,&flg);CHKERRQ(ierr);
832   if (flg) {
833 #if defined(PETSC_HAVE_MPI_COMM_SPAWN)
834     ierr = PetscHMPISpawn((PetscMPIInt) nodesize);CHKERRQ(ierr); /* worker nodes never return from here; they go directly to PetscEnd() */
835 #else
836     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"PETSc built without MPI 2 (MPI_Comm_spawn) support, use -hmpi_merge_size instead");
837 #endif
838   } else {
839     ierr = PetscOptionsGetInt(NULL,"-hmpi_merge_size",&nodesize,&flg);CHKERRQ(ierr);
840     if (flg) {
841       ierr = PetscHMPIMerge((PetscMPIInt) nodesize,NULL,NULL);CHKERRQ(ierr);
842       if (PetscHMPIWorker) { /* if worker then never enter user code */
843         PetscInitializeCalled = PETSC_TRUE;
844         PetscEnd();
845       }
846     }
847   }
848 
849 #if defined(PETSC_HAVE_CUDA)
850   {
851     PetscMPIInt p;
852     for (p = 0; p < PetscGlobalSize; ++p) {
853       if (p == PetscGlobalRank) cublasInit();
854       ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr);
855     }
856   }
857 #endif
858 
859   ierr = PetscOptionsHasName(NULL,"-python",&flg);CHKERRQ(ierr);
860   if (flg) {
861     PetscInitializeCalled = PETSC_TRUE;
862     ierr = PetscPythonInitialize(NULL,NULL);CHKERRQ(ierr);
863   }
864 
865   ierr = PetscThreadCommInitializePackage();CHKERRQ(ierr);
866 
867   /*
868       Setup building of stack frames for all function calls
869   */
870 #if defined(PETSC_USE_DEBUG)
871   PetscThreadLocalRegister((PetscThreadKey*)&petscstack); /* Creates petscstack_key if needed */
872   ierr = PetscStackCreate();CHKERRQ(ierr);
873 #endif
874 
875 #if defined(PETSC_SERIALIZE_FUNCTIONS)
876   ierr = PetscFPTCreate(10000);CHKERRQ(ierr);
877 #endif
878 
879   ierr = PetscCitationsInitialize();CHKERRQ(ierr);
880 
881   /*
882       Once we are completedly initialized then we can set this variables
883   */
884   PetscInitializeCalled = PETSC_TRUE;
885   PetscFunctionReturn(0);
886 }
887 
888 extern PetscObject *PetscObjects;
889 extern PetscInt    PetscObjectsCounts, PetscObjectsMaxCounts;
890 
891 #undef __FUNCT__
892 #define __FUNCT__ "PetscFinalize"
893 /*@C
894    PetscFinalize - Checks for options to be called at the conclusion
895    of the program. MPI_Finalize() is called only if the user had not
896    called MPI_Init() before calling PetscInitialize().
897 
898    Collective on PETSC_COMM_WORLD
899 
900    Options Database Keys:
901 +  -options_table - Calls PetscOptionsView()
902 .  -options_left - Prints unused options that remain in the database
903 .  -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
904 .  -mpidump - Calls PetscMPIDump()
905 .  -malloc_dump - Calls PetscMallocDump()
906 .  -malloc_info - Prints total memory usage
907 -  -malloc_log - Prints summary of memory usage
908 
909    Level: beginner
910 
911    Note:
912    See PetscInitialize() for more general runtime options.
913 
914 .seealso: PetscInitialize(), PetscOptionsView(), PetscMallocDump(), PetscMPIDump(), PetscEnd()
915 @*/
916 PetscErrorCode  PetscFinalize(void)
917 {
918   PetscErrorCode ierr;
919   PetscMPIInt    rank;
920   PetscInt       nopt;
921   PetscBool      flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,flg3 = PETSC_FALSE;
922   PetscBool      flg;
923 #if defined(PETSC_USE_LOG)
924   char           mname[PETSC_MAX_PATH_LEN];
925 #endif
926 
927   PetscFunctionBegin;
928   if (!PetscInitializeCalled) {
929     printf("PetscInitialize() must be called before PetscFinalize()\n");
930     PetscFunctionReturn(PETSC_ERR_ARG_WRONGSTATE);
931   }
932   ierr = PetscInfo(NULL,"PetscFinalize() called\n");CHKERRQ(ierr);
933 
934   ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
935 
936   ierr = PetscOptionsHasName(NULL,"-citations",&flg);CHKERRQ(ierr);
937   if (flg) {
938     char  *cits, filename[PETSC_MAX_PATH_LEN];
939     FILE  *fd = PETSC_STDOUT;
940 
941     ierr = PetscOptionsGetString(NULL,"-citations",filename,PETSC_MAX_PATH_LEN,NULL);CHKERRQ(ierr);
942     if (filename[0]) {
943       ierr = PetscFOpen(PETSC_COMM_WORLD,filename,"w",&fd);CHKERRQ(ierr);
944     }
945     ierr = PetscSegBufferGet(PetscCitationsList,1,&cits);CHKERRQ(ierr);
946     cits[0] = 0;
947     ierr = PetscSegBufferExtractAlloc(PetscCitationsList,&cits);CHKERRQ(ierr);
948     ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"If you publish results based on this computation please cite the following:\n");CHKERRQ(ierr);
949     ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"===========================================================================\n");CHKERRQ(ierr);
950     ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"%s",cits);CHKERRQ(ierr);
951     ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"===========================================================================\n");CHKERRQ(ierr);
952     ierr = PetscFClose(PETSC_COMM_WORLD,fd);CHKERRQ(ierr);
953     ierr = PetscFree(cits);CHKERRQ(ierr);
954   }
955   ierr = PetscSegBufferDestroy(&PetscCitationsList);CHKERRQ(ierr);
956 
957 #if defined(PETSC_SERIALIZE_FUNCTIONS)
958   ierr = PetscFPTDestroy();CHKERRQ(ierr);
959 #endif
960 
961 
962 #if defined(PETSC_HAVE_SAWS)
963   flg = PETSC_FALSE;
964   ierr = PetscOptionsGetBool(NULL,"-options_gui",&flg,NULL);CHKERRQ(ierr);
965   if (flg) {
966     ierr = PetscOptionsSAWsDestroy();CHKERRQ(ierr);
967   }
968 #endif
969 
970 #if defined(PETSC_HAVE_SERVER)
971   flg1 = PETSC_FALSE;
972   ierr = PetscOptionsGetBool(NULL,"-server",&flg1,NULL);CHKERRQ(ierr);
973   if (flg1) {
974     /*  this is a crude hack, but better than nothing */
975     ierr = PetscPOpen(PETSC_COMM_WORLD,NULL,"pkill -9 petscwebserver","r",NULL);CHKERRQ(ierr);
976   }
977 #endif
978 
979 #if defined(PETSC_HAVE_X)
980   flg1 = PETSC_FALSE;
981   ierr = PetscOptionsGetBool(NULL,"-x_virtual",&flg1,NULL);CHKERRQ(ierr);
982   if (flg1) {
983     /*  this is a crude hack, but better than nothing */
984     ierr = PetscPOpen(PETSC_COMM_WORLD,NULL,"pkill -9 Xvfb","r",NULL);CHKERRQ(ierr);
985   }
986 #endif
987 
988   ierr = PetscHMPIFinalize();CHKERRQ(ierr);
989 
990   ierr = PetscOptionsGetBool(NULL,"-malloc_info",&flg2,NULL);CHKERRQ(ierr);
991   if (!flg2) {
992     flg2 = PETSC_FALSE;
993     ierr = PetscOptionsGetBool(NULL,"-memory_info",&flg2,NULL);CHKERRQ(ierr);
994   }
995   if (flg2) {
996     ierr = PetscMemoryShowUsage(PETSC_VIEWER_STDOUT_WORLD,"Summary of Memory Usage in PETSc\n");CHKERRQ(ierr);
997   }
998 
999 #if defined(PETSC_USE_LOG)
1000   flg1 = PETSC_FALSE;
1001   ierr = PetscOptionsGetBool(NULL,"-get_total_flops",&flg1,NULL);CHKERRQ(ierr);
1002   if (flg1) {
1003     PetscLogDouble flops = 0;
1004     ierr = MPI_Reduce(&petsc_TotalFlops,&flops,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRQ(ierr);
1005     ierr = PetscPrintf(PETSC_COMM_WORLD,"Total flops over all processors %g\n",flops);CHKERRQ(ierr);
1006   }
1007 #endif
1008 
1009 
1010 #if defined(PETSC_USE_LOG)
1011 #if defined(PETSC_HAVE_MPE)
1012   mname[0] = 0;
1013 
1014   ierr = PetscOptionsGetString(NULL,"-log_mpe",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
1015   if (flg1) {
1016     if (mname[0]) {ierr = PetscLogMPEDump(mname);CHKERRQ(ierr);}
1017     else          {ierr = PetscLogMPEDump(0);CHKERRQ(ierr);}
1018   }
1019 #endif
1020   mname[0] = 0;
1021 
1022   ierr = PetscOptionsGetString(NULL,"-log_summary",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
1023   if (flg1) {
1024     PetscViewer viewer;
1025     if (mname[0]) {
1026       ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);CHKERRQ(ierr);
1027       ierr = PetscLogView(viewer);CHKERRQ(ierr);
1028       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
1029     } else {
1030       viewer = PETSC_VIEWER_STDOUT_WORLD;
1031       ierr   = PetscLogView(viewer);CHKERRQ(ierr);
1032     }
1033   }
1034 
1035   mname[0] = 0;
1036 
1037   ierr = PetscOptionsGetString(NULL,"-log_summary_python",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
1038   if (flg1) {
1039     PetscViewer viewer;
1040     if (mname[0]) {
1041       ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);CHKERRQ(ierr);
1042       ierr = PetscLogViewPython(viewer);CHKERRQ(ierr);
1043       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
1044     } else {
1045       viewer = PETSC_VIEWER_STDOUT_WORLD;
1046       ierr   = PetscLogViewPython(viewer);CHKERRQ(ierr);
1047     }
1048   }
1049 
1050   ierr = PetscOptionsGetString(NULL,"-log_detailed",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
1051   if (flg1) {
1052     if (mname[0])  {ierr = PetscLogPrintDetailed(PETSC_COMM_WORLD,mname);CHKERRQ(ierr);}
1053     else           {ierr = PetscLogPrintDetailed(PETSC_COMM_WORLD,0);CHKERRQ(ierr);}
1054   }
1055 
1056   mname[0] = 0;
1057 
1058   ierr = PetscOptionsGetString(NULL,"-log_all",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
1059   ierr = PetscOptionsGetString(NULL,"-log",mname,PETSC_MAX_PATH_LEN,&flg2);CHKERRQ(ierr);
1060   if (flg1 || flg2) {
1061     if (mname[0]) PetscLogDump(mname);
1062     else          PetscLogDump(0);
1063   }
1064 #endif
1065 
1066   /*
1067      Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_().
1068   */
1069   ierr = PetscObjectRegisterDestroyAll();CHKERRQ(ierr);
1070 
1071   ierr = PetscStackDestroy();CHKERRQ(ierr);
1072 
1073   flg1 = PETSC_FALSE;
1074   ierr = PetscOptionsGetBool(NULL,"-no_signal_handler",&flg1,NULL);CHKERRQ(ierr);
1075   if (!flg1) { ierr = PetscPopSignalHandler();CHKERRQ(ierr);}
1076   flg1 = PETSC_FALSE;
1077   ierr = PetscOptionsGetBool(NULL,"-mpidump",&flg1,NULL);CHKERRQ(ierr);
1078   if (flg1) {
1079     ierr = PetscMPIDump(stdout);CHKERRQ(ierr);
1080   }
1081   flg1 = PETSC_FALSE;
1082   flg2 = PETSC_FALSE;
1083   /* preemptive call to avoid listing this option in options table as unused */
1084   ierr = PetscOptionsHasName(NULL,"-malloc_dump",&flg1);CHKERRQ(ierr);
1085   ierr = PetscOptionsHasName(NULL,"-objects_dump",&flg1);CHKERRQ(ierr);
1086   ierr = PetscOptionsGetBool(NULL,"-options_table",&flg2,NULL);CHKERRQ(ierr);
1087 
1088   if (flg2) {
1089     PetscViewer viewer;
1090     ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
1091     ierr = PetscOptionsView(viewer);CHKERRQ(ierr);
1092     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
1093   }
1094 
1095   /* to prevent PETSc -options_left from warning */
1096   ierr = PetscOptionsHasName(NULL,"-nox",&flg1);CHKERRQ(ierr);
1097   ierr = PetscOptionsHasName(NULL,"-nox_warning",&flg1);CHKERRQ(ierr);
1098 
1099   if (!PetscHMPIWorker) { /* worker processes skip this because they do not usually process options */
1100     flg3 = PETSC_FALSE; /* default value is required */
1101     ierr = PetscOptionsGetBool(NULL,"-options_left",&flg3,&flg1);CHKERRQ(ierr);
1102     ierr = PetscOptionsAllUsed(&nopt);CHKERRQ(ierr);
1103     if (flg3) {
1104       if (!flg2) { /* have not yet printed the options */
1105         PetscViewer viewer;
1106         ierr = PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
1107         ierr = PetscOptionsView(viewer);CHKERRQ(ierr);
1108         ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
1109       }
1110       if (!nopt) {
1111         ierr = PetscPrintf(PETSC_COMM_WORLD,"There are no unused options.\n");CHKERRQ(ierr);
1112       } else if (nopt == 1) {
1113         ierr = PetscPrintf(PETSC_COMM_WORLD,"There is one unused database option. It is:\n");CHKERRQ(ierr);
1114       } else {
1115         ierr = PetscPrintf(PETSC_COMM_WORLD,"There are %D unused database options. They are:\n",nopt);CHKERRQ(ierr);
1116       }
1117     }
1118 #if defined(PETSC_USE_DEBUG)
1119     if (nopt && !flg3 && !flg1) {
1120       ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! There are options you set that were not used!\n");CHKERRQ(ierr);
1121       ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! could be spelling mistake, etc!\n");CHKERRQ(ierr);
1122       ierr = PetscOptionsLeft();CHKERRQ(ierr);
1123     } else if (nopt && flg3) {
1124 #else
1125     if (nopt && flg3) {
1126 #endif
1127       ierr = PetscOptionsLeft();CHKERRQ(ierr);
1128     }
1129   }
1130 
1131 #if defined(PETSC_HAVE_SAWS)
1132     SAWS_Finalize();CHKERRQ(ierr);
1133 #endif
1134 
1135   {
1136     PetscThreadComm tcomm_world;
1137     ierr = PetscGetThreadCommWorld(&tcomm_world);CHKERRQ(ierr);
1138     /* Free global thread communicator */
1139     ierr = PetscThreadCommDestroy(&tcomm_world);CHKERRQ(ierr);
1140   }
1141 
1142   /*
1143        List all objects the user may have forgot to free
1144   */
1145   ierr = PetscOptionsHasName(NULL,"-objects_dump",&flg1);CHKERRQ(ierr);
1146   if (flg1) {
1147     MPI_Comm local_comm;
1148     char     string[64];
1149 
1150     ierr = PetscOptionsGetString(NULL,"-objects_dump",string,64,NULL);CHKERRQ(ierr);
1151     ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr);
1152     ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr);
1153     ierr = PetscObjectsDump(stdout,(string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE);CHKERRQ(ierr);
1154     ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr);
1155     ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr);
1156   }
1157   PetscObjectsCounts    = 0;
1158   PetscObjectsMaxCounts = 0;
1159 
1160   ierr = PetscFree(PetscObjects);CHKERRQ(ierr);
1161 
1162 #if defined(PETSC_USE_LOG)
1163   ierr = PetscLogDestroy();CHKERRQ(ierr);
1164 #endif
1165 
1166   /*
1167      Destroy any packages that registered a finalize
1168   */
1169   ierr = PetscRegisterFinalizeAll();CHKERRQ(ierr);
1170 
1171   /*
1172      Destroy all the function registration lists created
1173   */
1174   ierr = PetscFinalize_DynamicLibraries();CHKERRQ(ierr);
1175 
1176   /*
1177      Print PetscFunctionLists that have not been properly freed
1178 
1179   ierr = PetscFunctionListPrintAll();CHKERRQ(ierr);
1180   */
1181 
1182   if (petsc_history) {
1183     ierr = PetscCloseHistoryFile(&petsc_history);CHKERRQ(ierr);
1184     petsc_history = 0;
1185   }
1186 
1187   ierr = PetscInfoAllow(PETSC_FALSE,NULL);CHKERRQ(ierr);
1188 
1189   {
1190     char fname[PETSC_MAX_PATH_LEN];
1191     FILE *fd;
1192     int  err;
1193 
1194     fname[0] = 0;
1195 
1196     ierr = PetscOptionsGetString(NULL,"-malloc_dump",fname,250,&flg1);CHKERRQ(ierr);
1197     flg2 = PETSC_FALSE;
1198     ierr = PetscOptionsGetBool(NULL,"-malloc_test",&flg2,NULL);CHKERRQ(ierr);
1199 #if defined(PETSC_USE_DEBUG)
1200     if (PETSC_RUNNING_ON_VALGRIND) flg2 = PETSC_FALSE;
1201 #else
1202     flg2 = PETSC_FALSE;         /* Skip reporting for optimized builds regardless of -malloc_test */
1203 #endif
1204     if (flg1 && fname[0]) {
1205       char sname[PETSC_MAX_PATH_LEN];
1206 
1207       sprintf(sname,"%s_%d",fname,rank);
1208       fd   = fopen(sname,"w"); if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname);
1209       ierr = PetscMallocDump(fd);CHKERRQ(ierr);
1210       err  = fclose(fd);
1211       if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
1212     } else if (flg1 || flg2) {
1213       MPI_Comm local_comm;
1214 
1215       ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr);
1216       ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr);
1217       ierr = PetscMallocDump(stdout);CHKERRQ(ierr);
1218       ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr);
1219       ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr);
1220     }
1221   }
1222 
1223   {
1224     char fname[PETSC_MAX_PATH_LEN];
1225     FILE *fd = NULL;
1226 
1227     fname[0] = 0;
1228 
1229     ierr = PetscOptionsGetString(NULL,"-malloc_log",fname,250,&flg1);CHKERRQ(ierr);
1230     ierr = PetscOptionsHasName(NULL,"-malloc_log_threshold",&flg2);CHKERRQ(ierr);
1231     if (flg1 && fname[0]) {
1232       int err;
1233 
1234       if (!rank) {
1235         fd = fopen(fname,"w");
1236         if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",fname);
1237       }
1238       ierr = PetscMallocDumpLog(fd);CHKERRQ(ierr);
1239       if (fd) {
1240         err = fclose(fd);
1241         if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
1242       }
1243     } else if (flg1 || flg2) {
1244       ierr = PetscMallocDumpLog(stdout);CHKERRQ(ierr);
1245     }
1246   }
1247   /* Can be destroyed only after all the options are used */
1248   ierr = PetscOptionsDestroy();CHKERRQ(ierr);
1249 
1250   PetscGlobalArgc = 0;
1251   PetscGlobalArgs = 0;
1252 
1253 #if defined(PETSC_USE_REAL___FLOAT128)
1254   ierr = MPI_Type_free(&MPIU___FLOAT128);CHKERRQ(ierr);
1255 #if defined(PETSC_HAVE_COMPLEX)
1256   ierr = MPI_Type_free(&MPIU___COMPLEX128);CHKERRQ(ierr);
1257 #endif
1258   ierr = MPI_Op_free(&MPIU_MAX);CHKERRQ(ierr);
1259   ierr = MPI_Op_free(&MPIU_MIN);CHKERRQ(ierr);
1260 #endif
1261 
1262 #if defined(PETSC_HAVE_COMPLEX)
1263 #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)
1264   ierr = MPI_Type_free(&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr);
1265   ierr = MPI_Type_free(&MPIU_C_COMPLEX);CHKERRQ(ierr);
1266 #endif
1267 #endif
1268 
1269 #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128)
1270   ierr = MPI_Op_free(&MPIU_SUM);CHKERRQ(ierr);
1271 #endif
1272 
1273   ierr = MPI_Type_free(&MPIU_2SCALAR);CHKERRQ(ierr);
1274 #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT)
1275   ierr = MPI_Type_free(&MPIU_2INT);CHKERRQ(ierr);
1276 #endif
1277   ierr = MPI_Op_free(&PetscMaxSum_Op);CHKERRQ(ierr);
1278   ierr = MPI_Op_free(&PetscADMax_Op);CHKERRQ(ierr);
1279   ierr = MPI_Op_free(&PetscADMin_Op);CHKERRQ(ierr);
1280 
1281   /*
1282      Destroy any known inner MPI_Comm's and attributes pointing to them
1283      Note this will not destroy any new communicators the user has created.
1284 
1285      If all PETSc objects were not destroyed those left over objects will have hanging references to
1286      the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again
1287  */
1288   {
1289     PetscCommCounter *counter;
1290     PetscMPIInt      flg;
1291     MPI_Comm         icomm;
1292     union {MPI_Comm comm; void *ptr;} ucomm;
1293     ierr = MPI_Attr_get(PETSC_COMM_SELF,Petsc_InnerComm_keyval,&ucomm,&flg);CHKERRQ(ierr);
1294     if (flg) {
1295       icomm = ucomm.comm;
1296       ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr);
1297       if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1298 
1299       ierr = MPI_Attr_delete(PETSC_COMM_SELF,Petsc_InnerComm_keyval);CHKERRQ(ierr);
1300       ierr = MPI_Attr_delete(icomm,Petsc_Counter_keyval);CHKERRQ(ierr);
1301       ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr);
1302     }
1303     ierr = MPI_Attr_get(PETSC_COMM_WORLD,Petsc_InnerComm_keyval,&ucomm,&flg);CHKERRQ(ierr);
1304     if (flg) {
1305       icomm = ucomm.comm;
1306       ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr);
1307       if (!flg) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1308 
1309       ierr = MPI_Attr_delete(PETSC_COMM_WORLD,Petsc_InnerComm_keyval);CHKERRQ(ierr);
1310       ierr = MPI_Attr_delete(icomm,Petsc_Counter_keyval);CHKERRQ(ierr);
1311       ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr);
1312     }
1313   }
1314 
1315   ierr = MPI_Keyval_free(&Petsc_Counter_keyval);CHKERRQ(ierr);
1316   ierr = MPI_Keyval_free(&Petsc_InnerComm_keyval);CHKERRQ(ierr);
1317   ierr = MPI_Keyval_free(&Petsc_OuterComm_keyval);CHKERRQ(ierr);
1318 
1319 #if defined(PETSC_HAVE_CUDA)
1320   {
1321     PetscInt p;
1322     for (p = 0; p < PetscGlobalSize; ++p) {
1323       if (p == PetscGlobalRank) cublasShutdown();
1324       ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr);
1325     }
1326   }
1327 #endif
1328 
1329   if (PetscBeganMPI) {
1330 #if defined(PETSC_HAVE_MPI_FINALIZED)
1331     PetscMPIInt flag;
1332     ierr = MPI_Finalized(&flag);CHKERRQ(ierr);
1333     if (flag) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()");
1334 #endif
1335     ierr = MPI_Finalize();CHKERRQ(ierr);
1336   }
1337 /*
1338 
1339      Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because
1340    the communicator has some outstanding requests on it. Specifically if the
1341    flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See
1342    src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate()
1343    is never freed as it should be. Thus one may obtain messages of the form
1344    [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the
1345    memory was not freed.
1346 
1347 */
1348   ierr = PetscMallocClear();CHKERRQ(ierr);
1349 
1350   PetscInitializeCalled = PETSC_FALSE;
1351   PetscFinalizeCalled   = PETSC_TRUE;
1352   PetscFunctionReturn(ierr);
1353 }
1354 
1355 #if defined(PETSC_MISSING_LAPACK_lsame_)
1356 PETSC_EXTERN int lsame_(char *a,char *b)
1357 {
1358   if (*a == *b) return 1;
1359   if (*a + 32 == *b) return 1;
1360   if (*a - 32 == *b) return 1;
1361   return 0;
1362 }
1363 #endif
1364 
1365 #if defined(PETSC_MISSING_LAPACK_lsame)
1366 PETSC_EXTERN int lsame(char *a,char *b)
1367 {
1368   if (*a == *b) return 1;
1369   if (*a + 32 == *b) return 1;
1370   if (*a - 32 == *b) return 1;
1371   return 0;
1372 }
1373 #endif
1374