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