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