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