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