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