xref: /petsc/src/sys/objects/pinit.c (revision 71752422d7f2c0ab3fabd056c61ac155247843a2)
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 MPIU_MAXSUM_OP = 0;
189 
190 #undef __FUNCT__
191 #define __FUNCT__ "MPIU_MaxSum_Local"
192 PETSC_INTERN void MPIAPI MPIU_MaxSum_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 MPIU_MAXSUM_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,MPIU_MAXSUM_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,MPIU_MAXSUM_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) || defined(PETSC_USE_REAL___FP16)
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) || defined(PETSC_USE_REAL___FP16)
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(MPIU_MaxSum_Local,1,&MPIU_MAXSUM_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 #elif defined(PETSC_USE_REAL___FP16)
847   ierr = MPI_Type_contiguous(2,MPI_CHAR,&MPIU___FP16);CHKERRQ(ierr);
848   ierr = MPI_Type_commit(&MPIU___FP16);CHKERRQ(ierr);
849   ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX);CHKERRQ(ierr);
850   ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN);CHKERRQ(ierr);
851 #endif
852 
853 #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
854   ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);CHKERRQ(ierr);
855 #endif
856 
857   ierr = MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR);CHKERRQ(ierr);
858   ierr = MPI_Type_commit(&MPIU_2SCALAR);CHKERRQ(ierr);
859 
860 #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT)
861   ierr = MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT);CHKERRQ(ierr);
862   ierr = MPI_Type_commit(&MPIU_2INT);CHKERRQ(ierr);
863 #endif
864 
865 
866   /*
867      Attributes to be set on PETSc communicators
868   */
869   ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelCounter,&Petsc_Counter_keyval,(void*)0);CHKERRQ(ierr);
870   ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Outer,&Petsc_InnerComm_keyval,(void*)0);CHKERRQ(ierr);
871   ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Inner,&Petsc_OuterComm_keyval,(void*)0);CHKERRQ(ierr);
872 
873   /*
874      Build the options database
875   */
876   ierr = PetscOptionsInsert(NULL,argc,args,file);CHKERRQ(ierr);
877 
878 
879   /*
880      Print main application help message
881   */
882   ierr = PetscOptionsHasName(NULL,NULL,"-help",&flg);CHKERRQ(ierr);
883   if (help && flg) {
884     ierr = PetscPrintf(PETSC_COMM_WORLD,help);CHKERRQ(ierr);
885   }
886   ierr = PetscOptionsCheckInitial_Private();CHKERRQ(ierr);
887 
888   ierr = PetscCitationsInitialize();CHKERRQ(ierr);
889 
890 #if defined(PETSC_HAVE_SAWS)
891   ierr = PetscInitializeSAWs(help);CHKERRQ(ierr);
892 #endif
893 
894   /* Creates the logging data structures; this is enabled even if logging is not turned on */
895 #if defined(PETSC_USE_LOG)
896   ierr = PetscLogInitialize();CHKERRQ(ierr);
897 #endif
898 
899   /*
900      Load the dynamic libraries (on machines that support them), this registers all
901      the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes)
902   */
903   ierr = PetscInitialize_DynamicLibraries();CHKERRQ(ierr);
904 
905   ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
906   ierr = PetscInfo1(0,"PETSc successfully started: number of processors = %d\n",size);CHKERRQ(ierr);
907   ierr = PetscGetHostName(hostname,256);CHKERRQ(ierr);
908   ierr = PetscInfo1(0,"Running on machine: %s\n",hostname);CHKERRQ(ierr);
909 
910   ierr = PetscOptionsCheckInitial_Components();CHKERRQ(ierr);
911   /* Check the options database for options related to the options database itself */
912   ierr = PetscOptionsSetFromOptions(NULL);CHKERRQ(ierr);
913 
914 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
915   /*
916       Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI
917 
918       Currently not used because it is not supported by MPICH.
919   */
920 #if !defined(PETSC_WORDS_BIGENDIAN)
921   ierr = MPI_Register_datarep((char*)"petsc",PetscDataRep_read_conv_fn,PetscDataRep_write_conv_fn,PetscDataRep_extent_fn,NULL);CHKERRQ(ierr);
922 #endif
923 #endif
924 
925 #if defined(PETSC_HAVE_CUDA)
926   flg  = PETSC_TRUE;
927   ierr = PetscOptionsGetBool(NULL,NULL,"-cublas",&flg,NULL);CHKERRQ(ierr);
928   if (flg) {
929     PetscMPIInt p;
930     for (p = 0; p < PetscGlobalSize; ++p) {
931       if (p == PetscGlobalRank) {
932         cberr = cublasCreate(&cublasv2handle);CHKERRCUBLAS(cberr);
933       }
934       ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr);
935     }
936   }
937 #endif
938 
939   ierr = PetscOptionsHasName(NULL,NULL,"-python",&flg);CHKERRQ(ierr);
940   if (flg) {
941     PetscInitializeCalled = PETSC_TRUE;
942     ierr = PetscPythonInitialize(NULL,NULL);CHKERRQ(ierr);
943   }
944 
945   /*
946       Setup building of stack frames for all function calls
947   */
948 #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY)
949   ierr = PetscStackCreate();CHKERRQ(ierr);
950 #endif
951 
952 #if defined(PETSC_SERIALIZE_FUNCTIONS)
953   ierr = PetscFPTCreate(10000);CHKERRQ(ierr);
954 #endif
955 
956 
957   /*
958       Once we are completedly initialized then we can set this variables
959   */
960   PetscInitializeCalled = PETSC_TRUE;
961   PetscFunctionReturn(0);
962 }
963 
964 #if defined(PETSC_USE_LOG)
965 extern PetscObject *PetscObjects;
966 extern PetscInt    PetscObjectsCounts, PetscObjectsMaxCounts;
967 extern PetscBool   PetscObjectsLog;
968 #endif
969 
970 #undef __FUNCT__
971 #define __FUNCT__ "PetscFinalize"
972 /*@C
973    PetscFinalize - Checks for options to be called at the conclusion
974    of the program. MPI_Finalize() is called only if the user had not
975    called MPI_Init() before calling PetscInitialize().
976 
977    Collective on PETSC_COMM_WORLD
978 
979    Options Database Keys:
980 +  -options_table - Calls PetscOptionsView()
981 .  -options_left - Prints unused options that remain in the database
982 .  -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
983 .  -mpidump - Calls PetscMPIDump()
984 .  -malloc_dump - Calls PetscMallocDump()
985 .  -malloc_info - Prints total memory usage
986 -  -malloc_log - Prints summary of memory usage
987 
988    Level: beginner
989 
990    Note:
991    See PetscInitialize() for more general runtime options.
992 
993 .seealso: PetscInitialize(), PetscOptionsView(), PetscMallocDump(), PetscMPIDump(), PetscEnd()
994 @*/
995 PetscErrorCode  PetscFinalize(void)
996 {
997   PetscErrorCode ierr;
998   PetscMPIInt    rank;
999   PetscInt       nopt;
1000   PetscBool      flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,flg3 = PETSC_FALSE;
1001   PetscBool      flg;
1002 #if defined(PETSC_USE_LOG)
1003   char           mname[PETSC_MAX_PATH_LEN];
1004 #endif
1005 #if defined(PETSC_HAVE_CUDA)
1006   cublasStatus_t cberr;
1007 #endif
1008 
1009   PetscFunctionBegin;
1010   if (!PetscInitializeCalled) {
1011     printf("PetscInitialize() must be called before PetscFinalize()\n");
1012     PetscFunctionReturn(PETSC_ERR_ARG_WRONGSTATE);
1013   }
1014   ierr = PetscInfo(NULL,"PetscFinalize() called\n");CHKERRQ(ierr);
1015 
1016   ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
1017 
1018   ierr = PetscOptionsHasName(NULL,NULL,"-citations",&flg);CHKERRQ(ierr);
1019   if (flg) {
1020     char  *cits, filename[PETSC_MAX_PATH_LEN];
1021     FILE  *fd = PETSC_STDOUT;
1022 
1023     ierr = PetscOptionsGetString(NULL,NULL,"-citations",filename,PETSC_MAX_PATH_LEN,NULL);CHKERRQ(ierr);
1024     if (filename[0]) {
1025       ierr = PetscFOpen(PETSC_COMM_WORLD,filename,"w",&fd);CHKERRQ(ierr);
1026     }
1027     ierr = PetscSegBufferGet(PetscCitationsList,1,&cits);CHKERRQ(ierr);
1028     cits[0] = 0;
1029     ierr = PetscSegBufferExtractAlloc(PetscCitationsList,&cits);CHKERRQ(ierr);
1030     ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"If you publish results based on this computation please cite the following:\n");CHKERRQ(ierr);
1031     ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"===========================================================================\n");CHKERRQ(ierr);
1032     ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"%s",cits);CHKERRQ(ierr);
1033     ierr = PetscFPrintf(PETSC_COMM_WORLD,fd,"===========================================================================\n");CHKERRQ(ierr);
1034     ierr = PetscFClose(PETSC_COMM_WORLD,fd);CHKERRQ(ierr);
1035     ierr = PetscFree(cits);CHKERRQ(ierr);
1036   }
1037   ierr = PetscSegBufferDestroy(&PetscCitationsList);CHKERRQ(ierr);
1038 
1039 #if defined(PETSC_HAVE_SSL) && defined(PETSC_USE_SOCKET_VIEWER)
1040   /* TextBelt is run for testing purposes only, please do not use this feature often */
1041   {
1042     PetscInt nmax = 2;
1043     char     **buffs;
1044     ierr = PetscMalloc1(2,&buffs);CHKERRQ(ierr);
1045     ierr = PetscOptionsGetStringArray(NULL,NULL,"-textbelt",buffs,&nmax,&flg1);CHKERRQ(ierr);
1046     if (flg1) {
1047       if (!nmax) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_USER,"-textbelt requires either the phone number or number,\"message\"");
1048       if (nmax == 1) {
1049         ierr = PetscMalloc1(128,&buffs[1]);CHKERRQ(ierr);
1050         ierr = PetscGetProgramName(buffs[1],32);CHKERRQ(ierr);
1051         ierr = PetscStrcat(buffs[1]," has completed");CHKERRQ(ierr);
1052       }
1053       ierr = PetscTextBelt(PETSC_COMM_WORLD,buffs[0],buffs[1],NULL);CHKERRQ(ierr);
1054       ierr = PetscFree(buffs[0]);CHKERRQ(ierr);
1055       ierr = PetscFree(buffs[1]);CHKERRQ(ierr);
1056     }
1057     ierr = PetscFree(buffs);CHKERRQ(ierr);
1058   }
1059   {
1060     PetscInt nmax = 2;
1061     char     **buffs;
1062     ierr = PetscMalloc1(2,&buffs);CHKERRQ(ierr);
1063     ierr = PetscOptionsGetStringArray(NULL,NULL,"-tellmycell",buffs,&nmax,&flg1);CHKERRQ(ierr);
1064     if (flg1) {
1065       if (!nmax) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_USER,"-tellmycell requires either the phone number or number,\"message\"");
1066       if (nmax == 1) {
1067         ierr = PetscMalloc1(128,&buffs[1]);CHKERRQ(ierr);
1068         ierr = PetscGetProgramName(buffs[1],32);CHKERRQ(ierr);
1069         ierr = PetscStrcat(buffs[1]," has completed");CHKERRQ(ierr);
1070       }
1071       ierr = PetscTellMyCell(PETSC_COMM_WORLD,buffs[0],buffs[1],NULL);CHKERRQ(ierr);
1072       ierr = PetscFree(buffs[0]);CHKERRQ(ierr);
1073       ierr = PetscFree(buffs[1]);CHKERRQ(ierr);
1074     }
1075     ierr = PetscFree(buffs);CHKERRQ(ierr);
1076   }
1077 #endif
1078   /*
1079     It should be safe to cancel the options monitors, since we don't expect to be setting options
1080     here (at least that are worth monitoring).  Monitors ought to be released so that they release
1081     whatever memory was allocated there before -malloc_dump reports unfreed memory.
1082   */
1083   ierr = PetscOptionsMonitorCancel();CHKERRQ(ierr);
1084 
1085 #if defined(PETSC_SERIALIZE_FUNCTIONS)
1086   ierr = PetscFPTDestroy();CHKERRQ(ierr);
1087 #endif
1088 
1089 
1090 #if defined(PETSC_HAVE_SAWS)
1091   flg = PETSC_FALSE;
1092   ierr = PetscOptionsGetBool(NULL,NULL,"-saw_options",&flg,NULL);CHKERRQ(ierr);
1093   if (flg) {
1094     ierr = PetscOptionsSAWsDestroy();CHKERRQ(ierr);
1095   }
1096 #endif
1097 
1098 #if defined(PETSC_HAVE_X)
1099   flg1 = PETSC_FALSE;
1100   ierr = PetscOptionsGetBool(NULL,NULL,"-x_virtual",&flg1,NULL);CHKERRQ(ierr);
1101   if (flg1) {
1102     /*  this is a crude hack, but better than nothing */
1103     ierr = PetscPOpen(PETSC_COMM_WORLD,NULL,"pkill -9 Xvfb","r",NULL);CHKERRQ(ierr);
1104   }
1105 #endif
1106 
1107 #if !defined(PETSC_HAVE_THREADSAFETY)
1108   ierr = PetscOptionsGetBool(NULL,NULL,"-malloc_info",&flg2,NULL);CHKERRQ(ierr);
1109   if (!flg2) {
1110     flg2 = PETSC_FALSE;
1111     ierr = PetscOptionsGetBool(NULL,NULL,"-memory_view",&flg2,NULL);CHKERRQ(ierr);
1112   }
1113   if (flg2) {
1114     ierr = PetscMemoryView(PETSC_VIEWER_STDOUT_WORLD,"Summary of Memory Usage in PETSc\n");CHKERRQ(ierr);
1115   }
1116 #endif
1117 
1118 #if defined(PETSC_USE_LOG)
1119   flg1 = PETSC_FALSE;
1120   ierr = PetscOptionsGetBool(NULL,NULL,"-get_total_flops",&flg1,NULL);CHKERRQ(ierr);
1121   if (flg1) {
1122     PetscLogDouble flops = 0;
1123     ierr = MPI_Reduce(&petsc_TotalFlops,&flops,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRQ(ierr);
1124     ierr = PetscPrintf(PETSC_COMM_WORLD,"Total flops over all processors %g\n",flops);CHKERRQ(ierr);
1125   }
1126 #endif
1127 
1128 
1129 #if defined(PETSC_USE_LOG)
1130 #if defined(PETSC_HAVE_MPE)
1131   mname[0] = 0;
1132 
1133   ierr = PetscOptionsGetString(NULL,NULL,"-log_mpe",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
1134   if (flg1) {
1135     if (mname[0]) {ierr = PetscLogMPEDump(mname);CHKERRQ(ierr);}
1136     else          {ierr = PetscLogMPEDump(0);CHKERRQ(ierr);}
1137   }
1138 #endif
1139   mname[0] = 0;
1140 
1141   ierr = PetscLogViewFromOptions();CHKERRQ(ierr);
1142   ierr = PetscOptionsGetString(NULL,NULL,"-log_summary",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
1143   if (flg1) {
1144     PetscViewer viewer;
1145     ierr = (*PetscHelpPrintf)(PETSC_COMM_WORLD,"\n\n WARNING:   -log_summary is being deprecated; switch to -log_view\n\n\n");CHKERRQ(ierr);
1146     if (mname[0]) {
1147       ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);CHKERRQ(ierr);
1148       ierr = PetscLogView(viewer);CHKERRQ(ierr);
1149       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
1150     } else {
1151       viewer = PETSC_VIEWER_STDOUT_WORLD;
1152       ierr   = PetscViewerPushFormat(viewer,PETSC_VIEWER_DEFAULT);CHKERRQ(ierr);
1153       ierr   = PetscLogView(viewer);CHKERRQ(ierr);
1154       ierr   = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
1155     }
1156   }
1157   mname[0] = 0;
1158 
1159   ierr = PetscOptionsGetString(NULL,NULL,"-log_all",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
1160   ierr = PetscOptionsGetString(NULL,NULL,"-log",mname,PETSC_MAX_PATH_LEN,&flg2);CHKERRQ(ierr);
1161   if (flg1 || flg2) {
1162     if (mname[0]) PetscLogDump(mname);
1163     else          PetscLogDump(0);
1164   }
1165 #endif
1166 
1167   /*
1168      Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_().
1169   */
1170   ierr = PetscObjectRegisterDestroyAll();CHKERRQ(ierr);
1171 
1172   ierr = PetscStackDestroy();CHKERRQ(ierr);
1173 
1174   flg1 = PETSC_FALSE;
1175   ierr = PetscOptionsGetBool(NULL,NULL,"-no_signal_handler",&flg1,NULL);CHKERRQ(ierr);
1176   if (!flg1) { ierr = PetscPopSignalHandler();CHKERRQ(ierr);}
1177   flg1 = PETSC_FALSE;
1178   ierr = PetscOptionsGetBool(NULL,NULL,"-mpidump",&flg1,NULL);CHKERRQ(ierr);
1179   if (flg1) {
1180     ierr = PetscMPIDump(stdout);CHKERRQ(ierr);
1181   }
1182   flg1 = PETSC_FALSE;
1183   flg2 = PETSC_FALSE;
1184   /* preemptive call to avoid listing this option in options table as unused */
1185   ierr = PetscOptionsHasName(NULL,NULL,"-malloc_dump",&flg1);CHKERRQ(ierr);
1186   ierr = PetscOptionsHasName(NULL,NULL,"-objects_dump",&flg1);CHKERRQ(ierr);
1187   ierr = PetscOptionsGetBool(NULL,NULL,"-options_view",&flg2,NULL);CHKERRQ(ierr);
1188 
1189   if (flg2) {
1190     PetscViewer viewer;
1191     ierr = PetscViewerCreate(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
1192     ierr = PetscViewerSetType(viewer,PETSCVIEWERASCII);CHKERRQ(ierr);
1193     ierr = PetscOptionsView(NULL,viewer);CHKERRQ(ierr);
1194     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
1195   }
1196 
1197   /* to prevent PETSc -options_left from warning */
1198   ierr = PetscOptionsHasName(NULL,NULL,"-nox",&flg1);CHKERRQ(ierr);
1199   ierr = PetscOptionsHasName(NULL,NULL,"-nox_warning",&flg1);CHKERRQ(ierr);
1200 
1201   flg3 = PETSC_FALSE; /* default value is required */
1202   ierr = PetscOptionsGetBool(NULL,NULL,"-options_left",&flg3,&flg1);CHKERRQ(ierr);
1203   ierr = PetscOptionsAllUsed(NULL,&nopt);CHKERRQ(ierr);
1204   if (flg3) {
1205     if (!flg2) { /* have not yet printed the options */
1206       PetscViewer viewer;
1207       ierr = PetscViewerCreate(PETSC_COMM_WORLD,&viewer);CHKERRQ(ierr);
1208       ierr = PetscViewerSetType(viewer,PETSCVIEWERASCII);CHKERRQ(ierr);
1209       ierr = PetscOptionsView(NULL,viewer);CHKERRQ(ierr);
1210       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
1211     }
1212     if (!nopt) {
1213       ierr = PetscPrintf(PETSC_COMM_WORLD,"There are no unused options.\n");CHKERRQ(ierr);
1214     } else if (nopt == 1) {
1215       ierr = PetscPrintf(PETSC_COMM_WORLD,"There is one unused database option. It is:\n");CHKERRQ(ierr);
1216     } else {
1217       ierr = PetscPrintf(PETSC_COMM_WORLD,"There are %D unused database options. They are:\n",nopt);CHKERRQ(ierr);
1218     }
1219   }
1220 #if defined(PETSC_USE_DEBUG)
1221   if (nopt && !flg3 && !flg1) {
1222     ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! There are options you set that were not used!\n");CHKERRQ(ierr);
1223     ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! could be spelling mistake, etc!\n");CHKERRQ(ierr);
1224     ierr = PetscOptionsLeft(NULL);CHKERRQ(ierr);
1225   } else if (nopt && flg3) {
1226 #else
1227   if (nopt && flg3) {
1228 #endif
1229     ierr = PetscOptionsLeft(NULL);CHKERRQ(ierr);
1230   }
1231 
1232 #if defined(PETSC_HAVE_SAWS)
1233   if (!PetscGlobalRank) {
1234     ierr = PetscStackSAWsViewOff();CHKERRQ(ierr);
1235     PetscStackCallSAWs(SAWs_Finalize,());
1236   }
1237 #endif
1238 
1239 #if defined(PETSC_USE_LOG)
1240   /*
1241        List all objects the user may have forgot to free
1242   */
1243   if (PetscObjectsLog) {
1244     ierr = PetscOptionsHasName(NULL,NULL,"-objects_dump",&flg1);CHKERRQ(ierr);
1245     if (flg1) {
1246       MPI_Comm local_comm;
1247       char     string[64];
1248 
1249       ierr = PetscOptionsGetString(NULL,NULL,"-objects_dump",string,64,NULL);CHKERRQ(ierr);
1250       ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr);
1251       ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr);
1252       ierr = PetscObjectsDump(stdout,(string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE);CHKERRQ(ierr);
1253       ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr);
1254       ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr);
1255     }
1256   }
1257 #endif
1258 
1259 #if defined(PETSC_USE_LOG)
1260   PetscObjectsCounts    = 0;
1261   PetscObjectsMaxCounts = 0;
1262   ierr = PetscFree(PetscObjects);CHKERRQ(ierr);
1263 #endif
1264 
1265   /*
1266      Destroy any packages that registered a finalize
1267   */
1268   ierr = PetscRegisterFinalizeAll();CHKERRQ(ierr);
1269 
1270 #if defined(PETSC_USE_LOG)
1271   ierr = PetscLogDestroy();CHKERRQ(ierr);
1272 #endif
1273 
1274   /*
1275      Print PetscFunctionLists that have not been properly freed
1276 
1277   ierr = PetscFunctionListPrintAll();CHKERRQ(ierr);
1278   */
1279 
1280   if (petsc_history) {
1281     ierr = PetscCloseHistoryFile(&petsc_history);CHKERRQ(ierr);
1282     petsc_history = 0;
1283   }
1284   ierr = PetscOptionsHelpPrintedDestroy(&PetscOptionsHelpPrintedSingleton);CHKERRQ(ierr);
1285 
1286   ierr = PetscInfoAllow(PETSC_FALSE,NULL);CHKERRQ(ierr);
1287 
1288 #if !defined(PETSC_HAVE_THREADSAFETY)
1289   {
1290     char fname[PETSC_MAX_PATH_LEN];
1291     FILE *fd;
1292     int  err;
1293 
1294     fname[0] = 0;
1295 
1296     ierr = PetscOptionsGetString(NULL,NULL,"-malloc_dump",fname,250,&flg1);CHKERRQ(ierr);
1297     flg2 = PETSC_FALSE;
1298     ierr = PetscOptionsGetBool(NULL,NULL,"-malloc_test",&flg2,NULL);CHKERRQ(ierr);
1299 #if defined(PETSC_USE_DEBUG)
1300     if (PETSC_RUNNING_ON_VALGRIND) flg2 = PETSC_FALSE;
1301 #else
1302     flg2 = PETSC_FALSE;         /* Skip reporting for optimized builds regardless of -malloc_test */
1303 #endif
1304     if (flg1 && fname[0]) {
1305       char sname[PETSC_MAX_PATH_LEN];
1306 
1307       sprintf(sname,"%s_%d",fname,rank);
1308       fd   = fopen(sname,"w"); if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname);
1309       ierr = PetscMallocDump(fd);CHKERRQ(ierr);
1310       err  = fclose(fd);
1311       if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
1312     } else if (flg1 || flg2) {
1313       MPI_Comm local_comm;
1314 
1315       ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr);
1316       ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr);
1317       ierr = PetscMallocDump(stdout);CHKERRQ(ierr);
1318       ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr);
1319       ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr);
1320     }
1321   }
1322 
1323   {
1324     char fname[PETSC_MAX_PATH_LEN];
1325     FILE *fd = NULL;
1326 
1327     fname[0] = 0;
1328 
1329     ierr = PetscOptionsGetString(NULL,NULL,"-malloc_log",fname,250,&flg1);CHKERRQ(ierr);
1330     ierr = PetscOptionsHasName(NULL,NULL,"-malloc_log_threshold",&flg2);CHKERRQ(ierr);
1331     if (flg1 && fname[0]) {
1332       int err;
1333 
1334       if (!rank) {
1335         fd = fopen(fname,"w");
1336         if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",fname);
1337       }
1338       ierr = PetscMallocDumpLog(fd);CHKERRQ(ierr);
1339       if (fd) {
1340         err = fclose(fd);
1341         if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
1342       }
1343     } else if (flg1 || flg2) {
1344       ierr = PetscMallocDumpLog(stdout);CHKERRQ(ierr);
1345     }
1346   }
1347 #endif
1348 
1349   /*
1350      Close any open dynamic libraries
1351   */
1352   ierr = PetscFinalize_DynamicLibraries();CHKERRQ(ierr);
1353 
1354 #if defined(PETSC_HAVE_CUDA)
1355   flg  = PETSC_TRUE;
1356   ierr = PetscOptionsGetBool(NULL,NULL,"-cublas",&flg,NULL);CHKERRQ(ierr);
1357   if (flg) {
1358     PetscInt p;
1359     for (p = 0; p < PetscGlobalSize; ++p) {
1360       if (p == PetscGlobalRank) {
1361         if (cublasv2handle) {
1362           cberr = cublasDestroy(cublasv2handle);CHKERRCUBLAS(cberr);
1363         }
1364       }
1365       ierr = MPI_Barrier(PETSC_COMM_WORLD);CHKERRQ(ierr);
1366     }
1367   }
1368 #endif
1369 
1370   /* Can be destroyed only after all the options are used */
1371   ierr = PetscOptionsDestroyDefault();CHKERRQ(ierr);
1372 
1373   PetscGlobalArgc = 0;
1374   PetscGlobalArgs = 0;
1375 
1376 #if defined(PETSC_USE_REAL___FLOAT128)
1377   ierr = MPI_Type_free(&MPIU___FLOAT128);CHKERRQ(ierr);
1378 #if defined(PETSC_HAVE_COMPLEX)
1379   ierr = MPI_Type_free(&MPIU___COMPLEX128);CHKERRQ(ierr);
1380 #endif
1381   ierr = MPI_Op_free(&MPIU_MAX);CHKERRQ(ierr);
1382   ierr = MPI_Op_free(&MPIU_MIN);CHKERRQ(ierr);
1383 #elif defined(PETSC_USE_REAL___FP16)
1384   ierr = MPI_Type_free(&MPIU___FP16);CHKERRQ(ierr);
1385   ierr = MPI_Op_free(&MPIU_MAX);CHKERRQ(ierr);
1386   ierr = MPI_Op_free(&MPIU_MIN);CHKERRQ(ierr);
1387 #endif
1388 
1389 #if defined(PETSC_HAVE_COMPLEX)
1390 #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)
1391   ierr = MPI_Type_free(&MPIU_C_DOUBLE_COMPLEX);CHKERRQ(ierr);
1392   ierr = MPI_Type_free(&MPIU_C_COMPLEX);CHKERRQ(ierr);
1393 #endif
1394 #endif
1395 
1396 #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
1397   ierr = MPI_Op_free(&MPIU_SUM);CHKERRQ(ierr);
1398 #endif
1399 
1400   ierr = MPI_Type_free(&MPIU_2SCALAR);CHKERRQ(ierr);
1401 #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT)
1402   ierr = MPI_Type_free(&MPIU_2INT);CHKERRQ(ierr);
1403 #endif
1404   ierr = MPI_Op_free(&MPIU_MAXSUM_OP);CHKERRQ(ierr);
1405 
1406   /*
1407      Destroy any known inner MPI_Comm's and attributes pointing to them
1408      Note this will not destroy any new communicators the user has created.
1409 
1410      If all PETSc objects were not destroyed those left over objects will have hanging references to
1411      the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again
1412  */
1413   {
1414     PetscCommCounter *counter;
1415     PetscMPIInt      flg;
1416     MPI_Comm         icomm;
1417     union {MPI_Comm comm; void *ptr;} ucomm;
1418     ierr = MPI_Attr_get(PETSC_COMM_SELF,Petsc_InnerComm_keyval,&ucomm,&flg);CHKERRQ(ierr);
1419     if (flg) {
1420       icomm = ucomm.comm;
1421       ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr);
1422       if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1423 
1424       ierr = MPI_Attr_delete(PETSC_COMM_SELF,Petsc_InnerComm_keyval);CHKERRQ(ierr);
1425       ierr = MPI_Attr_delete(icomm,Petsc_Counter_keyval);CHKERRQ(ierr);
1426       ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr);
1427     }
1428     ierr = MPI_Attr_get(PETSC_COMM_WORLD,Petsc_InnerComm_keyval,&ucomm,&flg);CHKERRQ(ierr);
1429     if (flg) {
1430       icomm = ucomm.comm;
1431       ierr = MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);CHKERRQ(ierr);
1432       if (!flg) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1433 
1434       ierr = MPI_Attr_delete(PETSC_COMM_WORLD,Petsc_InnerComm_keyval);CHKERRQ(ierr);
1435       ierr = MPI_Attr_delete(icomm,Petsc_Counter_keyval);CHKERRQ(ierr);
1436       ierr = MPI_Comm_free(&icomm);CHKERRQ(ierr);
1437     }
1438   }
1439 
1440   ierr = MPI_Keyval_free(&Petsc_Counter_keyval);CHKERRQ(ierr);
1441   ierr = MPI_Keyval_free(&Petsc_InnerComm_keyval);CHKERRQ(ierr);
1442   ierr = MPI_Keyval_free(&Petsc_OuterComm_keyval);CHKERRQ(ierr);
1443 
1444   ierr = PetscSpinlockDestroy(&PetscViewerASCIISpinLockOpen);CHKERRQ(ierr);
1445   ierr = PetscSpinlockDestroy(&PetscViewerASCIISpinLockStdout);CHKERRQ(ierr);
1446   ierr = PetscSpinlockDestroy(&PetscViewerASCIISpinLockStderr);CHKERRQ(ierr);
1447   ierr = PetscSpinlockDestroy(&PetscCommSpinLock);CHKERRQ(ierr);
1448 
1449   if (PetscBeganMPI) {
1450 #if defined(PETSC_HAVE_MPI_FINALIZED)
1451     PetscMPIInt flag;
1452     ierr = MPI_Finalized(&flag);CHKERRQ(ierr);
1453     if (flag) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()");
1454 #endif
1455     ierr = MPI_Finalize();CHKERRQ(ierr);
1456   }
1457 /*
1458 
1459      Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because
1460    the communicator has some outstanding requests on it. Specifically if the
1461    flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See
1462    src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate()
1463    is never freed as it should be. Thus one may obtain messages of the form
1464    [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the
1465    memory was not freed.
1466 
1467 */
1468   ierr = PetscMallocClear();CHKERRQ(ierr);
1469 
1470   PetscInitializeCalled = PETSC_FALSE;
1471   PetscFinalizeCalled   = PETSC_TRUE;
1472   PetscFunctionReturn(0);
1473 }
1474 
1475 #if defined(PETSC_MISSING_LAPACK_lsame_)
1476 PETSC_EXTERN int lsame_(char *a,char *b)
1477 {
1478   if (*a == *b) return 1;
1479   if (*a + 32 == *b) return 1;
1480   if (*a - 32 == *b) return 1;
1481   return 0;
1482 }
1483 #endif
1484 
1485 #if defined(PETSC_MISSING_LAPACK_lsame)
1486 PETSC_EXTERN int lsame(char *a,char *b)
1487 {
1488   if (*a == *b) return 1;
1489   if (*a + 32 == *b) return 1;
1490   if (*a - 32 == *b) return 1;
1491   return 0;
1492 }
1493 #endif
1494