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