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