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