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