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