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