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