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