xref: /petsc/src/sys/objects/pinit.c (revision fe998a80077c9ee0917a39496df43fc256e1b478)
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     }
597     ierr = PetscOptionsHasName(NULL,"-saws_local",&flg2);CHKERRQ(ierr);
598     if (flg2) {
599       char jsdir[PETSC_MAX_PATH_LEN];
600       if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"-saws_local option requires -saws_root option");
601       ierr = PetscSNPrintf(jsdir,PETSC_MAX_PATH_LEN,"%s/js",root);CHKERRQ(ierr);
602       ierr = PetscTestDirectory(jsdir,'r',&flg);CHKERRQ(ierr);
603       if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_READ,"-saws_local option requires js directory in root directory");
604       PetscStackCallSAWs(SAWs_Push_Local_Header,());CHKERRQ(ierr);
605     }
606     ierr = PetscGetProgramName(programname,64);CHKERRQ(ierr);
607     ierr = PetscStrlen(help,&applinelen);CHKERRQ(ierr);
608     introlen   = 4096 + applinelen;
609     applinelen += 256;
610     ierr = PetscMalloc(applinelen,&appline);CHKERRQ(ierr);
611     ierr = PetscMalloc(introlen,&intro);CHKERRQ(ierr);
612 
613     if (rootlocal) {
614       ierr = PetscSNPrintf(appline,applinelen,"%s.c.html",programname);CHKERRQ(ierr);
615       ierr = PetscTestFile(appline,'r',&rootlocal);CHKERRQ(ierr);
616     }
617     ierr = PetscOptionsGetAll(&options);CHKERRQ(ierr);
618     if (rootlocal && help) {
619       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);
620     } else if (help) {
621       ierr = PetscSNPrintf(appline,applinelen,"<center>Running %s %s</center><br><center><pre>%s</pre></center><br>\n",programname,options,help);
622     } else {
623       ierr = PetscSNPrintf(appline,applinelen,"<center> Running %s %s</center><br>\n",programname,options);
624     }
625     ierr = PetscFree(options);CHKERRQ(ierr);
626     ierr = PetscGetVersion(version,sizeof(version));CHKERRQ(ierr);
627     ierr = PetscSNPrintf(intro,introlen,"<body>\n"
628                                     "<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"
629                                     "<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"
630                                     "%s",version,petscconfigureoptions,appline);
631     PetscStackCallSAWs(SAWs_Push_Body,("index.html",0,intro));
632     ierr = PetscFree(intro);CHKERRQ(ierr);
633     ierr = PetscFree(appline);CHKERRQ(ierr);
634     PetscStackCallSAWs(SAWs_Initialize,());
635     ierr = PetscCitationsRegister("@TechReport{ saws,\n"
636                                   "  Author = {Matt Otten and Jed Brown and Barry Smith},\n"
637                                   "  Title  = {Scientific Application Web Server (SAWs) Users Manual},\n"
638                                   "  Institution = {Argonne National Laboratory},\n"
639                                   "  Year   = 2013\n}\n",NULL);CHKERRQ(ierr);
640   }
641   PetscFunctionReturn(0);
642 }
643 #endif
644 
645 #undef __FUNCT__
646 #define __FUNCT__ "PetscInitialize"
647 /*@C
648    PetscInitialize - Initializes the PETSc database and MPI.
649    PetscInitialize() calls MPI_Init() if that has yet to be called,
650    so this routine should always be called near the beginning of
651    your program -- usually the very first line!
652 
653    Collective on MPI_COMM_WORLD or PETSC_COMM_WORLD if it has been set
654 
655    Input Parameters:
656 +  argc - count of number of command line arguments
657 .  args - the command line arguments
658 .  file - [optional] PETSc database file, also checks ~username/.petscrc and .petscrc use NULL to not check for
659           code specific file. Use -skip_petscrc in the code specific file to skip the .petscrc files
660 -  help - [optional] Help message to print, use NULL for no message
661 
662    If you wish PETSc code to run ONLY on a subcommunicator of MPI_COMM_WORLD, create that
663    communicator first and assign it to PETSC_COMM_WORLD BEFORE calling PetscInitialize(). Thus if you are running a
664    four process job and two processes will run PETSc and have PetscInitialize() and PetscFinalize() and two process will not,
665    then do this. If ALL processes in the job are using PetscInitialize() and PetscFinalize() then you don't need to do this, even
666    if different subcommunicators of the job are doing different things with PETSc.
667 
668    Options Database Keys:
669 +  -start_in_debugger [noxterm,dbx,xdb,gdb,...] - Starts program in debugger
670 .  -on_error_attach_debugger [noxterm,dbx,xdb,gdb,...] - Starts debugger when error detected
671 .  -on_error_emacs <machinename> causes emacsclient to jump to error file
672 .  -on_error_abort calls abort() when error detected (no traceback)
673 .  -on_error_mpiabort calls MPI_abort() when error detected
674 .  -error_output_stderr prints error messages to stderr instead of the default stdout
675 .  -error_output_none does not print the error messages (but handles errors in the same way as if this was not called)
676 .  -debugger_nodes [node1,node2,...] - Indicates nodes to start in debugger
677 .  -debugger_pause [sleeptime] (in seconds) - Pauses debugger
678 .  -stop_for_debugger - Print message on how to attach debugger manually to
679                         process and wait (-debugger_pause) seconds for attachment
680 .  -malloc - Indicates use of PETSc error-checking malloc (on by default for debug version of libraries)
681 .  -malloc no - Indicates not to use error-checking malloc
682 .  -malloc_debug - check for memory corruption at EVERY malloc or free
683 .  -malloc_dump - prints a list of all unfreed memory at the end of the run
684 .  -malloc_test - like -malloc_dump -malloc_debug, but only active for debugging builds
685 .  -fp_trap - Stops on floating point exceptions (Note that on the
686               IBM RS6000 this slows code by at least a factor of 10.)
687 .  -no_signal_handler - Indicates not to trap error signals
688 .  -shared_tmp - indicates /tmp directory is shared by all processors
689 .  -not_shared_tmp - each processor has own /tmp
690 .  -tmp - alternative name of /tmp directory
691 .  -get_total_flops - returns total flops done by all processors
692 -  -memory_info - Print memory usage at end of run
693 
694    Options Database Keys for Profiling:
695    See Users-Manual: ch_profiling for details.
696 +  -info <optional filename> - Prints verbose information to the screen
697 .  -info_exclude <null,vec,mat,pc,ksp,snes,ts> - Excludes some of the verbose messages
698 .  -log_sync - Log the synchronization in scatters, inner products and norms
699 .  -log_trace [filename] - Print traces of all PETSc calls to the screen (useful to determine where a program
700         hangs without running in the debugger).  See PetscLogTraceBegin().
701 .  -log_summary [filename] - Prints summary of flop and timing information to screen. If the filename is specified the
702         summary is written to the file.  See PetscLogView().
703 .  -log_all [filename] - Logs extensive profiling information  See PetscLogDump().
704 .  -log [filename] - Logs basic profiline information  See PetscLogDump().
705 -  -log_mpe [filename] - Creates a logfile viewable by the utility Jumpshot (in MPICH distribution)
706 
707     Only one of -log_trace, -log_summary, -log_all, -log, or -log_mpe may be used at a time
708 
709    Environmental Variables:
710 +   PETSC_TMP - alternative tmp directory
711 .   PETSC_SHARED_TMP - tmp is shared by all processes
712 .   PETSC_NOT_SHARED_TMP - each process has its own private tmp
713 .   PETSC_VIEWER_SOCKET_PORT - socket number to use for socket viewer
714 -   PETSC_VIEWER_SOCKET_MACHINE - machine to use for socket viewer to connect to
715 
716 
717    Level: beginner
718 
719    Notes:
720    If for some reason you must call MPI_Init() separately, call
721    it before PetscInitialize().
722 
723    Fortran Version:
724    In Fortran this routine has the format
725 $       call PetscInitialize(file,ierr)
726 
727 +   ierr - error return code
728 -  file - [optional] PETSc database file, also checks ~username/.petscrc and .petscrc use NULL_CHARACTER to not check for
729           code specific file. Use -skip_petscrc in the code specific file to skip the .petscrc files
730 
731    Important Fortran Note:
732    In Fortran, you MUST use NULL_CHARACTER to indicate a
733    null character string; you CANNOT just use NULL as
734    in the C version. See Users-Manual: ch_fortran for details.
735 
736    If your main program is C but you call Fortran code that also uses PETSc you need to call PetscInitializeFortran() soon after
737    calling PetscInitialize().
738 
739    Concepts: initializing PETSc
740 
741 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscInitializeNoArguments()
742 
743 @*/
744 PetscErrorCode  PetscInitialize(int *argc,char ***args,const char file[],const char help[])
745 {
746   PetscErrorCode ierr;
747   PetscMPIInt    flag, size;
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   /* on Windows - set printf to default to printing 2 digit exponents */
759 #if defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
760   _set_output_format(_TWO_DIGIT_EXPONENT);
761 #endif
762 
763   ierr = PetscOptionsCreate();CHKERRQ(ierr);
764 
765   /*
766      We initialize the program name here (before MPI_Init()) because MPICH has a bug in
767      it that it sets args[0] on all processors to be args[0] on the first processor.
768   */
769   if (argc && *argc) {
770     ierr = PetscSetProgramName(**args);CHKERRQ(ierr);
771   } else {
772     ierr = PetscSetProgramName("Unknown Name");CHKERRQ(ierr);
773   }
774 
775   ierr = MPI_Initialized(&flag);CHKERRQ(ierr);
776   if (!flag) {
777     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");
778 #if defined(PETSC_HAVE_MPI_INIT_THREAD)
779     {
780       PetscMPIInt provided;
781       ierr = MPI_Init_thread(argc,args,MPI_THREAD_FUNNELED,&provided);CHKERRQ(ierr);
782     }
783 #else
784     ierr = MPI_Init(argc,args);CHKERRQ(ierr);
785 #endif
786     PetscBeganMPI = PETSC_TRUE;
787   }
788   if (argc && args) {
789     PetscGlobalArgc = *argc;
790     PetscGlobalArgs = *args;
791   }
792   PetscFinalizeCalled = PETSC_FALSE;
793 
794   if (PETSC_COMM_WORLD == MPI_COMM_NULL) PETSC_COMM_WORLD = MPI_COMM_WORLD;
795   ierr = MPI_Comm_set_errhandler(PETSC_COMM_WORLD,MPI_ERRORS_RETURN);CHKERRQ(ierr);
796 
797   /* Done after init due to a bug in MPICH-GM? */
798   ierr = PetscErrorPrintfInitialize();CHKERRQ(ierr);
799 
800   ierr = MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank);CHKERRQ(ierr);
801   ierr = MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize);CHKERRQ(ierr);
802 
803   MPIU_BOOL = MPI_INT;
804   MPIU_ENUM = MPI_INT;
805 
806   /*
807      Initialized the global complex variable; this is because with
808      shared libraries the constructors for global variables
809      are not called; at least on IRIX.
810   */
811 #if defined(PETSC_HAVE_COMPLEX)
812   {
813 #if defined(PETSC_CLANGUAGE_CXX)
814     PetscComplex ic(0.0,1.0);
815     PETSC_i = ic;
816 #elif defined(PETSC_CLANGUAGE_C)
817     PETSC_i = _Complex_I;
818 #endif
819   }
820 
821 #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)
822   ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr);
823   ierr = MPI_Type_commit(&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr);
824   ierr = MPI_Type_contiguous(2,MPI_FLOAT,&MPIU_C_COMPLEX);CHKERRQ(ierr);
825   ierr = MPI_Type_commit(&MPIU_C_COMPLEX);CHKERRQ(ierr);
826 #endif
827 #endif /* PETSC_HAVE_COMPLEX */
828 
829   /*
830      Create the PETSc MPI reduction operator that sums of the first
831      half of the entries and maxes the second half.
832   */
833   ierr = MPI_Op_create(PetscMaxSum_Local,1,&PetscMaxSum_Op);CHKERRQ(ierr);
834 
835 #if defined(PETSC_USE_REAL___FLOAT128)
836   ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU___FLOAT128);CHKERRQ(ierr);
837   ierr = MPI_Type_commit(&MPIU___FLOAT128);CHKERRQ(ierr);
838 #if defined(PETSC_HAVE_COMPLEX)
839   ierr = MPI_Type_contiguous(4,MPI_DOUBLE,&MPIU___COMPLEX128);CHKERRQ(ierr);
840   ierr = MPI_Type_commit(&MPIU___COMPLEX128);CHKERRQ(ierr);
841 #endif
842   ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX);CHKERRQ(ierr);
843   ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN);CHKERRQ(ierr);
844 #endif
845 
846 #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128)
847   ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);CHKERRQ(ierr);
848 #endif
849 
850   ierr = MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR);CHKERRQ(ierr);
851   ierr = MPI_Type_commit(&MPIU_2SCALAR);CHKERRQ(ierr);
852   ierr = MPI_Op_create(PetscADMax_Local,1,&PetscADMax_Op);CHKERRQ(ierr);
853   ierr = MPI_Op_create(PetscADMin_Local,1,&PetscADMin_Op);CHKERRQ(ierr);
854 
855 #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT)
856   ierr = MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT);CHKERRQ(ierr);
857   ierr = MPI_Type_commit(&MPIU_2INT);CHKERRQ(ierr);
858 #endif
859 
860 
861   /*
862      Attributes to be set on PETSc communicators
863   */
864   ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelCounter,&Petsc_Counter_keyval,(void*)0);CHKERRQ(ierr);
865   ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Outer,&Petsc_InnerComm_keyval,(void*)0);CHKERRQ(ierr);
866   ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Inner,&Petsc_OuterComm_keyval,(void*)0);CHKERRQ(ierr);
867 
868   /*
869      Build the options database
870   */
871   ierr = PetscOptionsInsert(argc,args,file);CHKERRQ(ierr);
872 
873 
874   /*
875      Print main application help message
876   */
877   ierr = PetscOptionsHasName(NULL,"-help",&flg);CHKERRQ(ierr);
878   if (help && flg) {
879     ierr = PetscPrintf(PETSC_COMM_WORLD,help);CHKERRQ(ierr);
880   }
881   ierr = PetscOptionsCheckInitial_Private();CHKERRQ(ierr);
882 
883   ierr = PetscCitationsInitialize();CHKERRQ(ierr);
884 
885 #if defined(PETSC_HAVE_SAWS)
886   ierr = PetscInitializeSAWs(help);CHKERRQ(ierr);
887 #endif
888 
889   /* SHOULD PUT IN GUARDS: Make sure logging is initialized, even if we do not print it out */
890 #if defined(PETSC_USE_LOG)
891   ierr = PetscLogBegin_Private();CHKERRQ(ierr);
892 #endif
893 
894   /*
895      Load the dynamic libraries (on machines that support them), this registers all
896      the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes)
897   */
898   ierr = PetscInitialize_DynamicLibraries();CHKERRQ(ierr);
899 
900   ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
901   ierr = PetscInfo1(0,"PETSc successfully started: number of processors = %d\n",size);CHKERRQ(ierr);
902   ierr = PetscGetHostName(hostname,256);CHKERRQ(ierr);
903   ierr = PetscInfo1(0,"Running on machine: %s\n",hostname);CHKERRQ(ierr);
904 
905   /* Ensure that threadcomm-related keyval exists, so that PetscOptionsSetFromOptions can use PetscCommDuplicate. */
906   ierr = PetscThreadCommInitializePackage();CHKERRQ(ierr);
907 
908   ierr = PetscOptionsCheckInitial_Components();CHKERRQ(ierr);
909   /* Check the options database for options related to the options database itself */
910   ierr = PetscOptionsSetFromOptions();CHKERRQ(ierr);
911 
912 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
913   /*
914       Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI
915 
916       Currently not used because it is not supported by MPICH.
917   */
918 #if !defined(PETSC_WORDS_BIGENDIAN)
919   ierr = MPI_Register_datarep((char*)"petsc",PetscDataRep_read_conv_fn,PetscDataRep_write_conv_fn,PetscDataRep_extent_fn,NULL);CHKERRQ(ierr);
920 #endif
921 #endif
922 
923 #if defined(PETSC_HAVE_CUDA)
924   flg  = PETSC_TRUE;
925   ierr = PetscOptionsGetBool(NULL,"-cublas",&flg,NULL);CHKERRQ(ierr);
926   if (flg) {
927     PetscMPIInt p;
928     for (p = 0; p < PetscGlobalSize; ++p) {
929       if (p == PetscGlobalRank) cublasInit();
930       ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr);
931     }
932   }
933 #endif
934 
935   ierr = PetscOptionsHasName(NULL,"-python",&flg);CHKERRQ(ierr);
936   if (flg) {
937     PetscInitializeCalled = PETSC_TRUE;
938     ierr = PetscPythonInitialize(NULL,NULL);CHKERRQ(ierr);
939   }
940 
941   /*
942       Setup building of stack frames for all function calls
943   */
944   PetscThreadLocalRegister((PetscThreadKey*)&petscstack); /* Creates pthread_key */
945 #if defined(PETSC_USE_DEBUG)
946   ierr = PetscStackCreate();CHKERRQ(ierr);
947 #endif
948 
949 #if defined(PETSC_SERIALIZE_FUNCTIONS)
950   ierr = PetscFPTCreate(10000);CHKERRQ(ierr);
951 #endif
952 
953 
954   /*
955       Once we are completedly initialized then we can set this variables
956   */
957   PetscInitializeCalled = PETSC_TRUE;
958   PetscFunctionReturn(0);
959 }
960 
961 #if defined(PETSC_USE_LOG)
962 extern PetscObject *PetscObjects;
963 extern PetscInt    PetscObjectsCounts, PetscObjectsMaxCounts;
964 #endif
965 
966 #undef __FUNCT__
967 #define __FUNCT__ "PetscFinalize"
968 /*@C
969    PetscFinalize - Checks for options to be called at the conclusion
970    of the program. MPI_Finalize() is called only if the user had not
971    called MPI_Init() before calling PetscInitialize().
972 
973    Collective on PETSC_COMM_WORLD
974 
975    Options Database Keys:
976 +  -options_table - Calls PetscOptionsView()
977 .  -options_left - Prints unused options that remain in the database
978 .  -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
979 .  -mpidump - Calls PetscMPIDump()
980 .  -malloc_dump - Calls PetscMallocDump()
981 .  -malloc_info - Prints total memory usage
982 -  -malloc_log - Prints summary of memory usage
983 
984    Level: beginner
985 
986    Note:
987    See PetscInitialize() for more general runtime options.
988 
989 .seealso: PetscInitialize(), PetscOptionsView(), PetscMallocDump(), PetscMPIDump(), PetscEnd()
990 @*/
991 PetscErrorCode  PetscFinalize(void)
992 {
993   PetscErrorCode ierr;
994   PetscMPIInt    rank;
995   PetscInt       nopt;
996   PetscBool      flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,flg3 = PETSC_FALSE;
997   PetscBool      flg;
998 #if defined(PETSC_USE_LOG)
999   char           mname[PETSC_MAX_PATH_LEN];
1000 #endif
1001 
1002   PetscFunctionBegin;
1003   if (!PetscInitializeCalled) {
1004     printf("PetscInitialize() must be called before PetscFinalize()\n");
1005     PetscFunctionReturn(PETSC_ERR_ARG_WRONGSTATE);
1006   }
1007   ierr = PetscInfo(NULL,"PetscFinalize() called\n");CHKERRQ(ierr);
1008 
1009   ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
1010 
1011   ierr = PetscOptionsHasName(NULL,"-citations",&flg);CHKERRQ(ierr);
1012   if (flg) {
1013     char  *cits, filename[PETSC_MAX_PATH_LEN];
1014     FILE  *fd = PETSC_STDOUT;
1015 
1016     ierr = PetscOptionsGetString(NULL,"-citations",filename,PETSC_MAX_PATH_LEN,NULL);CHKERRQ(ierr);
1017     if (filename[0]) {
1018       ierr = PetscFOpen(PETSC_COMM_WORLD,filename,"w",&fd);CHKERRQ(ierr);
1019     }
1020     ierr = PetscSegBufferGet(PetscCitationsList,1,&cits);CHKERRQ(ierr);
1021     cits[0] = 0;
1022     ierr = PetscSegBufferExtractAlloc(PetscCitationsList,&cits);CHKERRQ(ierr);
1023     ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"If you publish results based on this computation please cite the following:\n");CHKERRQ(ierr);
1024     ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"===========================================================================\n");CHKERRQ(ierr);
1025     ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"%s",cits);CHKERRQ(ierr);
1026     ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"===========================================================================\n");CHKERRQ(ierr);
1027     ierr = PetscFClose(PETSC_COMM_WORLD,fd);CHKERRQ(ierr);
1028     ierr = PetscFree(cits);CHKERRQ(ierr);
1029   }
1030   ierr = PetscSegBufferDestroy(&PetscCitationsList);CHKERRQ(ierr);
1031 
1032 #if defined(PETSC_HAVE_SSL) && defined(PETSC_USE_SOCKET_VIEWER)
1033   /* TextBelt is run for testing purposes only, please do not use this feature often */
1034   {
1035     PetscInt nmax = 2;
1036     char     **buffs;
1037     ierr = PetscMalloc1(2,&buffs);CHKERRQ(ierr);
1038     ierr = PetscOptionsGetStringArray(NULL,"-textbelt",buffs,&nmax,&flg1);CHKERRQ(ierr);
1039     if (flg1) {
1040       if (!nmax) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_USER,"-textbelt requires either the phone number or number,\"message\"");
1041       if (nmax == 1) {
1042         ierr = PetscMalloc1(128,&buffs[1]);CHKERRQ(ierr);
1043         ierr = PetscGetProgramName(buffs[1],32);CHKERRQ(ierr);
1044         ierr = PetscStrcat(buffs[1]," has completed");CHKERRQ(ierr);
1045       }
1046       ierr = PetscTextBelt(PETSC_COMM_WORLD,buffs[0],buffs[1],NULL);CHKERRQ(ierr);
1047       ierr = PetscFree(buffs[0]);CHKERRQ(ierr);
1048       ierr = PetscFree(buffs[1]);CHKERRQ(ierr);
1049     }
1050     ierr = PetscFree(buffs);CHKERRQ(ierr);
1051   }
1052 #endif
1053   /*
1054     It should be safe to cancel the options monitors, since we don't expect to be setting options
1055     here (at least that are worth monitoring).  Monitors ought to be released so that they release
1056     whatever memory was allocated there before -malloc_dump reports unfreed memory.
1057   */
1058   ierr = PetscOptionsMonitorCancel();CHKERRQ(ierr);
1059 
1060 #if defined(PETSC_SERIALIZE_FUNCTIONS)
1061   ierr = PetscFPTDestroy();CHKERRQ(ierr);
1062 #endif
1063 
1064 
1065 #if defined(PETSC_HAVE_SAWS)
1066   flg = PETSC_FALSE;
1067   ierr = PetscOptionsGetBool(NULL,"-saw_options",&flg,NULL);CHKERRQ(ierr);
1068   if (flg) {
1069     ierr = PetscOptionsSAWsDestroy();CHKERRQ(ierr);
1070   }
1071 #endif
1072 
1073 #if defined(PETSC_HAVE_X)
1074   flg1 = PETSC_FALSE;
1075   ierr = PetscOptionsGetBool(NULL,"-x_virtual",&flg1,NULL);CHKERRQ(ierr);
1076   if (flg1) {
1077     /*  this is a crude hack, but better than nothing */
1078     ierr = PetscPOpen(PETSC_COMM_WORLD,NULL,"pkill -9 Xvfb","r",NULL);CHKERRQ(ierr);
1079   }
1080 #endif
1081 
1082   ierr = PetscOptionsGetBool(NULL,"-malloc_info",&flg2,NULL);CHKERRQ(ierr);
1083   if (!flg2) {
1084     flg2 = PETSC_FALSE;
1085     ierr = PetscOptionsGetBool(NULL,"-memory_info",&flg2,NULL);CHKERRQ(ierr);
1086   }
1087   if (flg2) {
1088     ierr = PetscMemoryShowUsage(PETSC_VIEWER_STDOUT_WORLD,"Summary of Memory Usage in PETSc\n");CHKERRQ(ierr);
1089   }
1090 
1091 #if defined(PETSC_USE_LOG)
1092   flg1 = PETSC_FALSE;
1093   ierr = PetscOptionsGetBool(NULL,"-get_total_flops",&flg1,NULL);CHKERRQ(ierr);
1094   if (flg1) {
1095     PetscLogDouble flops = 0;
1096     ierr = MPI_Reduce(&petsc_TotalFlops,&flops,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRQ(ierr);
1097     ierr = PetscPrintf(PETSC_COMM_WORLD,"Total flops over all processors %g\n",flops);CHKERRQ(ierr);
1098   }
1099 #endif
1100 
1101 
1102 #if defined(PETSC_USE_LOG)
1103 #if defined(PETSC_HAVE_MPE)
1104   mname[0] = 0;
1105 
1106   ierr = PetscOptionsGetString(NULL,"-log_mpe",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
1107   if (flg1) {
1108     if (mname[0]) {ierr = PetscLogMPEDump(mname);CHKERRQ(ierr);}
1109     else          {ierr = PetscLogMPEDump(0);CHKERRQ(ierr);}
1110   }
1111 #endif
1112   mname[0] = 0;
1113 
1114   ierr = PetscLogViewFromOptions();CHKERRQ(ierr);
1115   ierr = PetscOptionsGetString(NULL,"-log_summary",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
1116   if (flg1) {
1117     PetscViewer viewer;
1118     if (mname[0]) {
1119       ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);CHKERRQ(ierr);
1120       ierr = PetscLogView(viewer);CHKERRQ(ierr);
1121       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
1122     } else {
1123       viewer = PETSC_VIEWER_STDOUT_WORLD;
1124       ierr   = PetscLogView(viewer);CHKERRQ(ierr);
1125     }
1126   }
1127   mname[0] = 0;
1128 
1129   ierr = PetscOptionsGetString(NULL,"-log_all",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
1130   ierr = PetscOptionsGetString(NULL,"-log",mname,PETSC_MAX_PATH_LEN,&flg2);CHKERRQ(ierr);
1131   if (flg1 || flg2) {
1132     if (mname[0]) PetscLogDump(mname);
1133     else          PetscLogDump(0);
1134   }
1135 #endif
1136 
1137   /*
1138      Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_().
1139   */
1140   ierr = PetscObjectRegisterDestroyAll();CHKERRQ(ierr);
1141 
1142   ierr = PetscStackDestroy();CHKERRQ(ierr);
1143   PetscThreadLocalDestroy((PetscThreadKey)petscstack); /* Deletes pthread_key */
1144 
1145   flg1 = PETSC_FALSE;
1146   ierr = PetscOptionsGetBool(NULL,"-no_signal_handler",&flg1,NULL);CHKERRQ(ierr);
1147   if (!flg1) { ierr = PetscPopSignalHandler();CHKERRQ(ierr);}
1148   flg1 = PETSC_FALSE;
1149   ierr = PetscOptionsGetBool(NULL,"-mpidump",&flg1,NULL);CHKERRQ(ierr);
1150   if (flg1) {
1151     ierr = PetscMPIDump(stdout);CHKERRQ(ierr);
1152   }
1153   flg1 = PETSC_FALSE;
1154   flg2 = PETSC_FALSE;
1155   /* preemptive call to avoid listing this option in options table as unused */
1156   ierr = PetscOptionsHasName(NULL,"-malloc_dump",&flg1);CHKERRQ(ierr);
1157   ierr = PetscOptionsHasName(NULL,"-objects_dump",&flg1);CHKERRQ(ierr);
1158   ierr = PetscOptionsGetBool(NULL,"-options_view",&flg2,NULL);CHKERRQ(ierr);
1159 
1160   if (flg2) {
1161     PetscViewer viewer;
1162     ierr = PetscViewerCreate(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
1163     ierr = PetscViewerSetType(viewer,PETSCVIEWERASCII);CHKERRQ(ierr);
1164     ierr = PetscOptionsView(viewer);CHKERRQ(ierr);
1165     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
1166   }
1167 
1168   /* to prevent PETSc -options_left from warning */
1169   ierr = PetscOptionsHasName(NULL,"-nox",&flg1);CHKERRQ(ierr);
1170   ierr = PetscOptionsHasName(NULL,"-nox_warning",&flg1);CHKERRQ(ierr);
1171 
1172   flg3 = PETSC_FALSE; /* default value is required */
1173   ierr = PetscOptionsGetBool(NULL,"-options_left",&flg3,&flg1);CHKERRQ(ierr);
1174   ierr = PetscOptionsAllUsed(&nopt);CHKERRQ(ierr);
1175   if (flg3) {
1176     if (!flg2) { /* have not yet printed the options */
1177       PetscViewer viewer;
1178       ierr = PetscViewerCreate(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
1179       ierr = PetscViewerSetType(viewer,PETSCVIEWERASCII);CHKERRQ(ierr);
1180       ierr = PetscOptionsView(viewer);CHKERRQ(ierr);
1181       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
1182     }
1183     if (!nopt) {
1184       ierr = PetscPrintf(PETSC_COMM_WORLD,"There are no unused options.\n");CHKERRQ(ierr);
1185     } else if (nopt == 1) {
1186       ierr = PetscPrintf(PETSC_COMM_WORLD,"There is one unused database option. It is:\n");CHKERRQ(ierr);
1187     } else {
1188       ierr = PetscPrintf(PETSC_COMM_WORLD,"There are %D unused database options. They are:\n",nopt);CHKERRQ(ierr);
1189     }
1190   }
1191 #if defined(PETSC_USE_DEBUG)
1192   if (nopt && !flg3 && !flg1) {
1193     ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! There are options you set that were not used!\n");CHKERRQ(ierr);
1194     ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! could be spelling mistake, etc!\n");CHKERRQ(ierr);
1195     ierr = PetscOptionsLeft();CHKERRQ(ierr);
1196   } else if (nopt && flg3) {
1197 #else
1198   if (nopt && flg3) {
1199 #endif
1200     ierr = PetscOptionsLeft();CHKERRQ(ierr);
1201   }
1202 
1203 #if defined(PETSC_HAVE_SAWS)
1204   if (!PetscGlobalRank) {
1205     ierr = PetscStackSAWsViewOff();CHKERRQ(ierr);
1206     PetscStackCallSAWs(SAWs_Finalize,());
1207   }
1208 #endif
1209 
1210   {
1211     PetscThreadComm tcomm_world;
1212     ierr = PetscGetThreadCommWorld(&tcomm_world);CHKERRQ(ierr);
1213     /* Free global thread communicator */
1214     ierr = PetscThreadCommDestroy(&tcomm_world);CHKERRQ(ierr);
1215   }
1216 
1217 #if defined(PETSC_USE_LOG)
1218   /*
1219        List all objects the user may have forgot to free
1220   */
1221   ierr = PetscOptionsHasName(NULL,"-objects_dump",&flg1);CHKERRQ(ierr);
1222   if (flg1) {
1223     MPI_Comm local_comm;
1224     char     string[64];
1225 
1226     ierr = PetscOptionsGetString(NULL,"-objects_dump",string,64,NULL);CHKERRQ(ierr);
1227     ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr);
1228     ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr);
1229     ierr = PetscObjectsDump(stdout,(string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE);CHKERRQ(ierr);
1230     ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr);
1231     ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr);
1232   }
1233 #endif
1234 
1235 #if defined(PETSC_USE_LOG)
1236   PetscObjectsCounts    = 0;
1237   PetscObjectsMaxCounts = 0;
1238   ierr = PetscFree(PetscObjects);CHKERRQ(ierr);
1239 #endif
1240 
1241 #if defined(PETSC_USE_LOG)
1242   ierr = PetscLogDestroy();CHKERRQ(ierr);
1243 #endif
1244 
1245   /*
1246      Destroy any packages that registered a finalize
1247   */
1248   ierr = PetscRegisterFinalizeAll();CHKERRQ(ierr);
1249 
1250   /*
1251      Destroy all the function registration lists created
1252   */
1253   ierr = PetscFinalize_DynamicLibraries();CHKERRQ(ierr);
1254 
1255   /*
1256      Print PetscFunctionLists that have not been properly freed
1257 
1258   ierr = PetscFunctionListPrintAll();CHKERRQ(ierr);
1259   */
1260 
1261   if (petsc_history) {
1262     ierr = PetscCloseHistoryFile(&petsc_history);CHKERRQ(ierr);
1263     petsc_history = 0;
1264   }
1265 
1266   ierr = PetscInfoAllow(PETSC_FALSE,NULL);CHKERRQ(ierr);
1267 
1268   {
1269     char fname[PETSC_MAX_PATH_LEN];
1270     FILE *fd;
1271     int  err;
1272 
1273     fname[0] = 0;
1274 
1275     ierr = PetscOptionsGetString(NULL,"-malloc_dump",fname,250,&flg1);CHKERRQ(ierr);
1276     flg2 = PETSC_FALSE;
1277     ierr = PetscOptionsGetBool(NULL,"-malloc_test",&flg2,NULL);CHKERRQ(ierr);
1278 #if defined(PETSC_USE_DEBUG)
1279     if (PETSC_RUNNING_ON_VALGRIND) flg2 = PETSC_FALSE;
1280 #else
1281     flg2 = PETSC_FALSE;         /* Skip reporting for optimized builds regardless of -malloc_test */
1282 #endif
1283     if (flg1 && fname[0]) {
1284       char sname[PETSC_MAX_PATH_LEN];
1285 
1286       sprintf(sname,"%s_%d",fname,rank);
1287       fd   = fopen(sname,"w"); if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname);
1288       ierr = PetscMallocDump(fd);CHKERRQ(ierr);
1289       err  = fclose(fd);
1290       if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
1291     } else if (flg1 || flg2) {
1292       MPI_Comm local_comm;
1293 
1294       ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr);
1295       ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr);
1296       ierr = PetscMallocDump(stdout);CHKERRQ(ierr);
1297       ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr);
1298       ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr);
1299     }
1300   }
1301 
1302   {
1303     char fname[PETSC_MAX_PATH_LEN];
1304     FILE *fd = NULL;
1305 
1306     fname[0] = 0;
1307 
1308     ierr = PetscOptionsGetString(NULL,"-malloc_log",fname,250,&flg1);CHKERRQ(ierr);
1309     ierr = PetscOptionsHasName(NULL,"-malloc_log_threshold",&flg2);CHKERRQ(ierr);
1310     if (flg1 && fname[0]) {
1311       int err;
1312 
1313       if (!rank) {
1314         fd = fopen(fname,"w");
1315         if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",fname);
1316       }
1317       ierr = PetscMallocDumpLog(fd);CHKERRQ(ierr);
1318       if (fd) {
1319         err = fclose(fd);
1320         if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
1321       }
1322     } else if (flg1 || flg2) {
1323       ierr = PetscMallocDumpLog(stdout);CHKERRQ(ierr);
1324     }
1325   }
1326 
1327 #if defined(PETSC_HAVE_CUDA)
1328   flg  = PETSC_TRUE;
1329   ierr = PetscOptionsGetBool(NULL,"-cublas",&flg,NULL);CHKERRQ(ierr);
1330   if (flg) {
1331     PetscInt p;
1332     for (p = 0; p < PetscGlobalSize; ++p) {
1333       if (p == PetscGlobalRank) cublasShutdown();
1334       ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr);
1335     }
1336   }
1337 #endif
1338 
1339   /* Can be destroyed only after all the options are used */
1340   ierr = PetscOptionsDestroy();CHKERRQ(ierr);
1341 
1342   PetscGlobalArgc = 0;
1343   PetscGlobalArgs = 0;
1344 
1345 #if defined(PETSC_USE_REAL___FLOAT128)
1346   ierr = MPI_Type_free(&MPIU___FLOAT128);CHKERRQ(ierr);
1347 #if defined(PETSC_HAVE_COMPLEX)
1348   ierr = MPI_Type_free(&MPIU___COMPLEX128);CHKERRQ(ierr);
1349 #endif
1350   ierr = MPI_Op_free(&MPIU_MAX);CHKERRQ(ierr);
1351   ierr = MPI_Op_free(&MPIU_MIN);CHKERRQ(ierr);
1352 #endif
1353 
1354 #if defined(PETSC_HAVE_COMPLEX)
1355 #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)
1356   ierr = MPI_Type_free(&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr);
1357   ierr = MPI_Type_free(&MPIU_C_COMPLEX);CHKERRQ(ierr);
1358 #endif
1359 #endif
1360 
1361 #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128)
1362   ierr = MPI_Op_free(&MPIU_SUM);CHKERRQ(ierr);
1363 #endif
1364 
1365   ierr = MPI_Type_free(&MPIU_2SCALAR);CHKERRQ(ierr);
1366 #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT)
1367   ierr = MPI_Type_free(&MPIU_2INT);CHKERRQ(ierr);
1368 #endif
1369   ierr = MPI_Op_free(&PetscMaxSum_Op);CHKERRQ(ierr);
1370   ierr = MPI_Op_free(&PetscADMax_Op);CHKERRQ(ierr);
1371   ierr = MPI_Op_free(&PetscADMin_Op);CHKERRQ(ierr);
1372 
1373   /*
1374      Destroy any known inner MPI_Comm's and attributes pointing to them
1375      Note this will not destroy any new communicators the user has created.
1376 
1377      If all PETSc objects were not destroyed those left over objects will have hanging references to
1378      the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again
1379  */
1380   {
1381     PetscCommCounter *counter;
1382     PetscMPIInt      flg;
1383     MPI_Comm         icomm;
1384     union {MPI_Comm comm; void *ptr;} ucomm;
1385     ierr = MPI_Attr_get(PETSC_COMM_SELF,Petsc_InnerComm_keyval,&ucomm,&flg);CHKERRQ(ierr);
1386     if (flg) {
1387       icomm = ucomm.comm;
1388       ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr);
1389       if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1390 
1391       ierr = MPI_Attr_delete(PETSC_COMM_SELF,Petsc_InnerComm_keyval);CHKERRQ(ierr);
1392       ierr = MPI_Attr_delete(icomm,Petsc_Counter_keyval);CHKERRQ(ierr);
1393       ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr);
1394     }
1395     ierr = MPI_Attr_get(PETSC_COMM_WORLD,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_WORLD,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_WORLD,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   }
1406 
1407   ierr = MPI_Keyval_free(&Petsc_Counter_keyval);CHKERRQ(ierr);
1408   ierr = MPI_Keyval_free(&Petsc_InnerComm_keyval);CHKERRQ(ierr);
1409   ierr = MPI_Keyval_free(&Petsc_OuterComm_keyval);CHKERRQ(ierr);
1410 
1411   if (PetscBeganMPI) {
1412 #if defined(PETSC_HAVE_MPI_FINALIZED)
1413     PetscMPIInt flag;
1414     ierr = MPI_Finalized(&flag);CHKERRQ(ierr);
1415     if (flag) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()");
1416 #endif
1417     ierr = MPI_Finalize();CHKERRQ(ierr);
1418   }
1419 /*
1420 
1421      Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because
1422    the communicator has some outstanding requests on it. Specifically if the
1423    flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See
1424    src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate()
1425    is never freed as it should be. Thus one may obtain messages of the form
1426    [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the
1427    memory was not freed.
1428 
1429 */
1430   ierr = PetscMallocClear();CHKERRQ(ierr);
1431 
1432   PetscInitializeCalled = PETSC_FALSE;
1433   PetscFinalizeCalled   = PETSC_TRUE;
1434   PetscFunctionReturn(ierr);
1435 }
1436 
1437 #if defined(PETSC_MISSING_LAPACK_lsame_)
1438 PETSC_EXTERN int lsame_(char *a,char *b)
1439 {
1440   if (*a == *b) return 1;
1441   if (*a + 32 == *b) return 1;
1442   if (*a - 32 == *b) return 1;
1443   return 0;
1444 }
1445 #endif
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