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