xref: /petsc/src/sys/objects/pinit.c (revision 5f80ce2ab25dff0f4601e710601cbbcecf323266)
1 #define PETSC_DESIRE_FEATURE_TEST_MACROS
2 /*
3    This file defines the initialization of PETSc, including PetscInitialize()
4 */
5 #include <petsc/private/petscimpl.h>        /*I  "petscsys.h"   I*/
6 #include <petscviewer.h>
7 
8 #if !defined(PETSC_HAVE_WINDOWS_COMPILERS)
9 #include <petsc/private/valgrind/valgrind.h>
10 #endif
11 
12 #if defined(PETSC_HAVE_FORTRAN)
13 #include <petsc/private/fortranimpl.h>
14 #endif
15 
16 #if defined(PETSC_USE_GCOV)
17 EXTERN_C_BEGIN
18 void  __gcov_flush(void);
19 EXTERN_C_END
20 #endif
21 
22 #if defined(PETSC_SERIALIZE_FUNCTIONS)
23 PETSC_INTERN PetscFPT PetscFPTData;
24 PetscFPT PetscFPTData = 0;
25 #endif
26 
27 #if PetscDefined(HAVE_SAWS)
28 #include <petscviewersaws.h>
29 #endif
30 
31 /* -----------------------------------------------------------------------------------------*/
32 
33 PETSC_INTERN FILE *petsc_history;
34 
35 PETSC_INTERN PetscErrorCode PetscInitialize_DynamicLibraries(void);
36 PETSC_INTERN PetscErrorCode PetscFinalize_DynamicLibraries(void);
37 PETSC_INTERN PetscErrorCode PetscFunctionListPrintAll(void);
38 PETSC_INTERN PetscErrorCode PetscSequentialPhaseBegin_Private(MPI_Comm,int);
39 PETSC_INTERN PetscErrorCode PetscSequentialPhaseEnd_Private(MPI_Comm,int);
40 PETSC_INTERN PetscErrorCode PetscCloseHistoryFile(FILE**);
41 
42 /* user may set these BEFORE calling PetscInitialize() */
43 MPI_Comm PETSC_COMM_WORLD = MPI_COMM_NULL;
44 #if PetscDefined(HAVE_MPI_INIT_THREAD)
45 PetscMPIInt PETSC_MPI_THREAD_REQUIRED = MPI_THREAD_FUNNELED;
46 #else
47 PetscMPIInt PETSC_MPI_THREAD_REQUIRED = 0;
48 #endif
49 
50 PetscMPIInt Petsc_Counter_keyval   = MPI_KEYVAL_INVALID;
51 PetscMPIInt Petsc_InnerComm_keyval = MPI_KEYVAL_INVALID;
52 PetscMPIInt Petsc_OuterComm_keyval = MPI_KEYVAL_INVALID;
53 PetscMPIInt Petsc_ShmComm_keyval   = MPI_KEYVAL_INVALID;
54 
55 /*
56      Declare and set all the string names of the PETSc enums
57 */
58 const char *const PetscBools[]     = {"FALSE","TRUE","PetscBool","PETSC_",NULL};
59 const char *const PetscCopyModes[] = {"COPY_VALUES","OWN_POINTER","USE_POINTER","PetscCopyMode","PETSC_",NULL};
60 
61 PetscBool PetscPreLoadingUsed = PETSC_FALSE;
62 PetscBool PetscPreLoadingOn   = PETSC_FALSE;
63 
64 PetscInt PetscHotRegionDepth;
65 
66 PetscBool PETSC_RUNNING_ON_VALGRIND = PETSC_FALSE;
67 
68 #if defined(PETSC_HAVE_THREADSAFETY)
69 PetscSpinlock PetscViewerASCIISpinLockOpen;
70 PetscSpinlock PetscViewerASCIISpinLockStdout;
71 PetscSpinlock PetscViewerASCIISpinLockStderr;
72 PetscSpinlock PetscCommSpinLock;
73 #endif
74 
75 /*
76       PetscInitializeNoPointers - Calls PetscInitialize() from C/C++ without the pointers to argc and args
77 
78    Collective
79 
80    Level: advanced
81 
82     Notes:
83     this is called only by the PETSc Julia interface. Even though it might start MPI it sets the flag to
84      indicate that it did NOT start MPI so that the PetscFinalize() does not end MPI, thus allowing PetscInitialize() to
85      be called multiple times from Julia without the problem of trying to initialize MPI more than once.
86 
87      Developer Note: Turns off PETSc signal handling to allow Julia to manage signals
88 
89 .seealso: PetscInitialize(), PetscInitializeFortran(), PetscInitializeNoArguments()
90 */
91 PetscErrorCode  PetscInitializeNoPointers(int argc,char **args,const char *filename,const char *help)
92 {
93   PetscErrorCode ierr;
94   int            myargc   = argc;
95   char           **myargs = args;
96 
97   PetscFunctionBegin;
98   ierr = PetscInitialize(&myargc,&myargs,filename,help);if (ierr) PetscFunctionReturn(ierr);
99   CHKERRQ(PetscPopSignalHandler());
100   PetscBeganMPI = PETSC_FALSE;
101   PetscFunctionReturn(0);
102 }
103 
104 /*
105       Used by Julia interface to get communicator
106 */
107 PetscErrorCode  PetscGetPETSC_COMM_SELF(MPI_Comm *comm)
108 {
109   PetscFunctionBegin;
110   if (PetscInitializeCalled) PetscValidPointer(comm,1);
111   *comm = PETSC_COMM_SELF;
112   PetscFunctionReturn(0);
113 }
114 
115 /*@C
116       PetscInitializeNoArguments - Calls PetscInitialize() from C/C++ without
117         the command line arguments.
118 
119    Collective
120 
121    Level: advanced
122 
123 .seealso: PetscInitialize(), PetscInitializeFortran()
124 @*/
125 PetscErrorCode  PetscInitializeNoArguments(void)
126 {
127   PetscErrorCode ierr;
128   int            argc   = 0;
129   char           **args = NULL;
130 
131   PetscFunctionBegin;
132   ierr = PetscInitialize(&argc,&args,NULL,NULL);
133   PetscFunctionReturn(ierr);
134 }
135 
136 /*@
137       PetscInitialized - Determine whether PETSc is initialized.
138 
139    Level: beginner
140 
141 .seealso: PetscInitialize(), PetscInitializeNoArguments(), PetscInitializeFortran()
142 @*/
143 PetscErrorCode PetscInitialized(PetscBool *isInitialized)
144 {
145   PetscFunctionBegin;
146   if (PetscInitializeCalled) PetscValidBoolPointer(isInitialized,1);
147   *isInitialized = PetscInitializeCalled;
148   PetscFunctionReturn(0);
149 }
150 
151 /*@
152       PetscFinalized - Determine whether PetscFinalize() has been called yet
153 
154    Level: developer
155 
156 .seealso: PetscInitialize(), PetscInitializeNoArguments(), PetscInitializeFortran()
157 @*/
158 PetscErrorCode  PetscFinalized(PetscBool  *isFinalized)
159 {
160   PetscFunctionBegin;
161   if (!PetscFinalizeCalled) PetscValidBoolPointer(isFinalized,1);
162   *isFinalized = PetscFinalizeCalled;
163   PetscFunctionReturn(0);
164 }
165 
166 PETSC_INTERN PetscErrorCode PetscOptionsCheckInitial_Private(const char []);
167 
168 /*
169        This function is the MPI reduction operation used to compute the sum of the
170    first half of the datatype and the max of the second half.
171 */
172 MPI_Op MPIU_MAXSUM_OP = 0;
173 
174 PETSC_INTERN void MPIAPI MPIU_MaxSum_Local(void *in,void *out,int *cnt,MPI_Datatype *datatype)
175 {
176   PetscInt *xin = (PetscInt*)in,*xout = (PetscInt*)out,i,count = *cnt;
177 
178   PetscFunctionBegin;
179   if (*datatype != MPIU_2INT) {
180     (*PetscErrorPrintf)("Can only handle MPIU_2INT data types");
181     PETSCABORT(MPI_COMM_SELF,PETSC_ERR_ARG_WRONG);
182   }
183 
184   for (i=0; i<count; i++) {
185     xout[2*i]    = PetscMax(xout[2*i],xin[2*i]);
186     xout[2*i+1] += xin[2*i+1];
187   }
188   PetscFunctionReturnVoid();
189 }
190 
191 /*
192     Returns the max of the first entry owned by this processor and the
193 sum of the second entry.
194 
195     The reason sizes[2*i] contains lengths sizes[2*i+1] contains flag of 1 if length is nonzero
196 is so that the MPIU_MAXSUM_OP() can set TWO values, if we passed in only sizes[i] with lengths
197 there would be no place to store the both needed results.
198 */
199 PetscErrorCode  PetscMaxSum(MPI_Comm comm,const PetscInt sizes[],PetscInt *max,PetscInt *sum)
200 {
201   PetscFunctionBegin;
202 #if defined(PETSC_HAVE_MPI_REDUCE_SCATTER_BLOCK)
203   {
204     struct {PetscInt max,sum;} work;
205     CHKERRMPI(MPI_Reduce_scatter_block((void*)sizes,&work,1,MPIU_2INT,MPIU_MAXSUM_OP,comm));
206     *max = work.max;
207     *sum = work.sum;
208   }
209 #else
210   {
211     PetscMPIInt    size,rank;
212     struct {PetscInt max,sum;} *work;
213     CHKERRMPI(MPI_Comm_size(comm,&size));
214     CHKERRMPI(MPI_Comm_rank(comm,&rank));
215     CHKERRQ(PetscMalloc1(size,&work));
216     CHKERRMPI(MPIU_Allreduce((void*)sizes,work,size,MPIU_2INT,MPIU_MAXSUM_OP,comm));
217     *max = work[rank].max;
218     *sum = work[rank].sum;
219     CHKERRQ(PetscFree(work));
220   }
221 #endif
222   PetscFunctionReturn(0);
223 }
224 
225 /* ----------------------------------------------------------------------------*/
226 
227 #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
228 MPI_Op MPIU_SUM = 0;
229 
230 PETSC_EXTERN void MPIAPI PetscSum_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype)
231 {
232   PetscInt i,count = *cnt;
233 
234   PetscFunctionBegin;
235   if (*datatype == MPIU_REAL) {
236     PetscReal *xin = (PetscReal*)in,*xout = (PetscReal*)out;
237     for (i=0; i<count; i++) xout[i] += xin[i];
238   }
239 #if defined(PETSC_HAVE_COMPLEX)
240   else if (*datatype == MPIU_COMPLEX) {
241     PetscComplex *xin = (PetscComplex*)in,*xout = (PetscComplex*)out;
242     for (i=0; i<count; i++) xout[i] += xin[i];
243   }
244 #endif
245   else {
246     (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types");
247     PETSCABORT(MPI_COMM_SELF,PETSC_ERR_ARG_WRONG);
248   }
249   PetscFunctionReturnVoid();
250 }
251 #endif
252 
253 #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
254 MPI_Op MPIU_MAX = 0;
255 MPI_Op MPIU_MIN = 0;
256 
257 PETSC_EXTERN void MPIAPI PetscMax_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype)
258 {
259   PetscInt i,count = *cnt;
260 
261   PetscFunctionBegin;
262   if (*datatype == MPIU_REAL) {
263     PetscReal *xin = (PetscReal*)in,*xout = (PetscReal*)out;
264     for (i=0; i<count; i++) xout[i] = PetscMax(xout[i],xin[i]);
265   }
266 #if defined(PETSC_HAVE_COMPLEX)
267   else if (*datatype == MPIU_COMPLEX) {
268     PetscComplex *xin = (PetscComplex*)in,*xout = (PetscComplex*)out;
269     for (i=0; i<count; i++) {
270       xout[i] = PetscRealPartComplex(xout[i])<PetscRealPartComplex(xin[i]) ? xin[i] : xout[i];
271     }
272   }
273 #endif
274   else {
275     (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types");
276     PETSCABORT(MPI_COMM_SELF,PETSC_ERR_ARG_WRONG);
277   }
278   PetscFunctionReturnVoid();
279 }
280 
281 PETSC_EXTERN void MPIAPI PetscMin_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype)
282 {
283   PetscInt    i,count = *cnt;
284 
285   PetscFunctionBegin;
286   if (*datatype == MPIU_REAL) {
287     PetscReal *xin = (PetscReal*)in,*xout = (PetscReal*)out;
288     for (i=0; i<count; i++) xout[i] = PetscMin(xout[i],xin[i]);
289   }
290 #if defined(PETSC_HAVE_COMPLEX)
291   else if (*datatype == MPIU_COMPLEX) {
292     PetscComplex *xin = (PetscComplex*)in,*xout = (PetscComplex*)out;
293     for (i=0; i<count; i++) {
294       xout[i] = PetscRealPartComplex(xout[i])>PetscRealPartComplex(xin[i]) ? xin[i] : xout[i];
295     }
296   }
297 #endif
298   else {
299     (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_SCALAR data (i.e. double or complex) types");
300     PETSCABORT(MPI_COMM_SELF,PETSC_ERR_ARG_WRONG);
301   }
302   PetscFunctionReturnVoid();
303 }
304 #endif
305 
306 /*
307    Private routine to delete internal tag/name counter storage when a communicator is freed.
308 
309    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.
310 
311    Note: this is declared extern "C" because it is passed to MPI_Comm_create_keyval()
312 
313 */
314 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_Counter_Attr_Delete_Fn(MPI_Comm comm,PetscMPIInt keyval,void *count_val,void *extra_state)
315 {
316   PetscCommCounter      *counter=(PetscCommCounter*)count_val;
317   struct PetscCommStash *comms = counter->comms, *pcomm;
318 
319   PetscFunctionBegin;
320   CHKERRMPI(PetscInfo(NULL,"Deleting counter data in an MPI_Comm %ld\n",(long)comm));
321   CHKERRMPI(PetscFree(counter->iflags));
322   while (comms) {
323     CHKERRMPI(MPI_Comm_free(&comms->comm));
324     pcomm = comms;
325     comms = comms->next;
326     CHKERRQ(PetscFree(pcomm));
327   }
328   CHKERRMPI(PetscFree(counter));
329   PetscFunctionReturn(MPI_SUCCESS);
330 }
331 
332 /*
333   This is invoked on the outer comm as a result of either PetscCommDestroy() (via MPI_Comm_delete_attr) or when the user
334   calls MPI_Comm_free().
335 
336   This is the only entry point for breaking the links between inner and outer comms.
337 
338   This is called by MPI, not by users. This is called when MPI_Comm_free() is called on the communicator.
339 
340   Note: this is declared extern "C" because it is passed to MPI_Comm_create_keyval()
341 
342 */
343 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_InnerComm_Attr_Delete_Fn(MPI_Comm comm,PetscMPIInt keyval,void *attr_val,void *extra_state)
344 {
345   union {MPI_Comm comm; void *ptr;} icomm;
346 
347   PetscFunctionBegin;
348   if (keyval != Petsc_InnerComm_keyval) SETERRMPI(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Unexpected keyval");
349   icomm.ptr = attr_val;
350   if (PetscDefined(USE_DEBUG)) {
351     /* Error out if the inner/outer comms are not correctly linked through their Outer/InnterComm attributes */
352     PetscMPIInt flg;
353     union {MPI_Comm comm; void *ptr;} ocomm;
354     CHKERRMPI(MPI_Comm_get_attr(icomm.comm,Petsc_OuterComm_keyval,&ocomm,&flg));
355     if (!flg) SETERRMPI(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner comm does not have OuterComm attribute");
356     if (ocomm.comm != comm) SETERRMPI(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner comm's OuterComm attribute does not point to outer PETSc comm");
357   }
358   CHKERRMPI(MPI_Comm_delete_attr(icomm.comm,Petsc_OuterComm_keyval));
359   CHKERRMPI(PetscInfo(NULL,"User MPI_Comm %ld is being unlinked from inner PETSc comm %ld\n",(long)comm,(long)icomm.comm));
360   PetscFunctionReturn(MPI_SUCCESS);
361 }
362 
363 /*
364  * This is invoked on the inner comm when Petsc_InnerComm_Attr_Delete_Fn calls MPI_Comm_delete_attr().  It should not be reached any other way.
365  */
366 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_OuterComm_Attr_Delete_Fn(MPI_Comm comm,PetscMPIInt keyval,void *attr_val,void *extra_state)
367 {
368   PetscFunctionBegin;
369   CHKERRMPI(PetscInfo(NULL,"Removing reference to PETSc communicator embedded in a user MPI_Comm %ld\n",(long)comm));
370   PetscFunctionReturn(MPI_SUCCESS);
371 }
372 
373 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_ShmComm_Attr_Delete_Fn(MPI_Comm,PetscMPIInt,void *,void *);
374 
375 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
376 PETSC_EXTERN PetscMPIInt PetscDataRep_extent_fn(MPI_Datatype,MPI_Aint*,void*);
377 PETSC_EXTERN PetscMPIInt PetscDataRep_read_conv_fn(void*, MPI_Datatype,PetscMPIInt,void*,MPI_Offset,void*);
378 PETSC_EXTERN PetscMPIInt PetscDataRep_write_conv_fn(void*, MPI_Datatype,PetscMPIInt,void*,MPI_Offset,void*);
379 #endif
380 
381 PetscMPIInt PETSC_MPI_ERROR_CLASS=MPI_ERR_LASTCODE,PETSC_MPI_ERROR_CODE;
382 
383 PETSC_INTERN int  PetscGlobalArgc;
384 PETSC_INTERN char **PetscGlobalArgs;
385 int  PetscGlobalArgc   = 0;
386 char **PetscGlobalArgs = NULL;
387 PetscSegBuffer PetscCitationsList;
388 
389 PetscErrorCode PetscCitationsInitialize(void)
390 {
391   PetscFunctionBegin;
392   CHKERRQ(PetscSegBufferCreate(1,10000,&PetscCitationsList));
393   CHKERRQ(PetscCitationsRegister("@TechReport{petsc-user-ref,\n  Author = {Satish Balay and Shrirang Abhyankar and Mark F. Adams and Jed Brown \n            and Peter Brune and Kris Buschelman and Lisandro Dalcin and\n            Victor Eijkhout and William D. Gropp and Dmitry Karpeyev and\n            Dinesh Kaushik and Matthew G. Knepley and Dave A. May and Lois Curfman McInnes\n            and Richard Tran Mills and Todd Munson and Karl Rupp and Patrick Sanan\n            and Barry F. Smith and Stefano Zampini and Hong Zhang and Hong Zhang},\n  Title = {{PETS}c Users Manual},\n  Number = {ANL-95/11 - Revision 3.11},\n  Institution = {Argonne National Laboratory},\n  Year = {2019}\n}\n",NULL));
394   CHKERRQ(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));
395   PetscFunctionReturn(0);
396 }
397 
398 static char programname[PETSC_MAX_PATH_LEN] = ""; /* HP includes entire path in name */
399 
400 PetscErrorCode  PetscSetProgramName(const char name[])
401 {
402   PetscFunctionBegin;
403   CHKERRQ(PetscStrncpy(programname,name,sizeof(programname)));
404   PetscFunctionReturn(0);
405 }
406 
407 /*@C
408     PetscGetProgramName - Gets the name of the running program.
409 
410     Not Collective
411 
412     Input Parameter:
413 .   len - length of the string name
414 
415     Output Parameter:
416 .   name - the name of the running program
417 
418    Level: advanced
419 
420     Notes:
421     The name of the program is copied into the user-provided character
422     array of length len.  On some machines the program name includes
423     its entire path, so one should generally set len >= PETSC_MAX_PATH_LEN.
424 @*/
425 PetscErrorCode  PetscGetProgramName(char name[],size_t len)
426 {
427   PetscFunctionBegin;
428   CHKERRQ(PetscStrncpy(name,programname,len));
429   PetscFunctionReturn(0);
430 }
431 
432 /*@C
433    PetscGetArgs - Allows you to access the raw command line arguments anywhere
434      after PetscInitialize() is called but before PetscFinalize().
435 
436    Not Collective
437 
438    Output Parameters:
439 +  argc - count of number of command line arguments
440 -  args - the command line arguments
441 
442    Level: intermediate
443 
444    Notes:
445       This is usually used to pass the command line arguments into other libraries
446    that are called internally deep in PETSc or the application.
447 
448       The first argument contains the program name as is normal for C arguments.
449 
450 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArguments()
451 
452 @*/
453 PetscErrorCode  PetscGetArgs(int *argc,char ***args)
454 {
455   PetscFunctionBegin;
456   PetscCheckFalse(!PetscInitializeCalled && PetscFinalizeCalled,PETSC_COMM_SELF,PETSC_ERR_ORDER,"You must call after PetscInitialize() but before PetscFinalize()");
457   *argc = PetscGlobalArgc;
458   *args = PetscGlobalArgs;
459   PetscFunctionReturn(0);
460 }
461 
462 /*@C
463    PetscGetArguments - Allows you to access the  command line arguments anywhere
464      after PetscInitialize() is called but before PetscFinalize().
465 
466    Not Collective
467 
468    Output Parameters:
469 .  args - the command line arguments
470 
471    Level: intermediate
472 
473    Notes:
474       This does NOT start with the program name and IS null terminated (final arg is void)
475 
476 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscFreeArguments()
477 
478 @*/
479 PetscErrorCode  PetscGetArguments(char ***args)
480 {
481   PetscInt       i,argc = PetscGlobalArgc;
482 
483   PetscFunctionBegin;
484   PetscCheckFalse(!PetscInitializeCalled && PetscFinalizeCalled,PETSC_COMM_SELF,PETSC_ERR_ORDER,"You must call after PetscInitialize() but before PetscFinalize()");
485   if (!argc) {*args = NULL; PetscFunctionReturn(0);}
486   CHKERRQ(PetscMalloc1(argc,args));
487   for (i=0; i<argc-1; i++) {
488     CHKERRQ(PetscStrallocpy(PetscGlobalArgs[i+1],&(*args)[i]));
489   }
490   (*args)[argc-1] = NULL;
491   PetscFunctionReturn(0);
492 }
493 
494 /*@C
495    PetscFreeArguments - Frees the memory obtained with PetscGetArguments()
496 
497    Not Collective
498 
499    Output Parameters:
500 .  args - the command line arguments
501 
502    Level: intermediate
503 
504 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscGetArguments()
505 
506 @*/
507 PetscErrorCode  PetscFreeArguments(char **args)
508 {
509   PetscInt       i = 0;
510 
511   PetscFunctionBegin;
512   if (!args) PetscFunctionReturn(0);
513   while (args[i]) {
514     CHKERRQ(PetscFree(args[i]));
515     i++;
516   }
517   CHKERRQ(PetscFree(args));
518   PetscFunctionReturn(0);
519 }
520 
521 #if PetscDefined(HAVE_SAWS)
522 #include <petscconfiginfo.h>
523 
524 PETSC_INTERN PetscErrorCode PetscInitializeSAWs(const char help[])
525 {
526   PetscFunctionBegin;
527   if (!PetscGlobalRank) {
528     char           cert[PETSC_MAX_PATH_LEN],root[PETSC_MAX_PATH_LEN],*intro,programname[64],*appline,*options,version[64];
529     int            port;
530     PetscBool      flg,rootlocal = PETSC_FALSE,flg2,selectport = PETSC_FALSE;
531     size_t         applinelen,introlen;
532     PetscErrorCode ierr;
533     char           sawsurl[256];
534 
535     CHKERRQ(PetscOptionsHasName(NULL,NULL,"-saws_log",&flg));
536     if (flg) {
537       char  sawslog[PETSC_MAX_PATH_LEN];
538 
539       CHKERRQ(PetscOptionsGetString(NULL,NULL,"-saws_log",sawslog,sizeof(sawslog),NULL));
540       if (sawslog[0]) {
541         PetscStackCallSAWs(SAWs_Set_Use_Logfile,(sawslog));
542       } else {
543         PetscStackCallSAWs(SAWs_Set_Use_Logfile,(NULL));
544       }
545     }
546     CHKERRQ(PetscOptionsGetString(NULL,NULL,"-saws_https",cert,sizeof(cert),&flg));
547     if (flg) {
548       PetscStackCallSAWs(SAWs_Set_Use_HTTPS,(cert));
549     }
550     CHKERRQ(PetscOptionsGetBool(NULL,NULL,"-saws_port_auto_select",&selectport,NULL));
551     if (selectport) {
552         PetscStackCallSAWs(SAWs_Get_Available_Port,(&port));
553         PetscStackCallSAWs(SAWs_Set_Port,(port));
554     } else {
555       CHKERRQ(PetscOptionsGetInt(NULL,NULL,"-saws_port",&port,&flg));
556       if (flg) {
557         PetscStackCallSAWs(SAWs_Set_Port,(port));
558       }
559     }
560     CHKERRQ(PetscOptionsGetString(NULL,NULL,"-saws_root",root,sizeof(root),&flg));
561     if (flg) {
562       PetscStackCallSAWs(SAWs_Set_Document_Root,(root));
563       CHKERRQ(PetscStrcmp(root,".",&rootlocal));
564     } else {
565       CHKERRQ(PetscOptionsHasName(NULL,NULL,"-saws_options",&flg));
566       if (flg) {
567         CHKERRQ(PetscStrreplace(PETSC_COMM_WORLD,"${PETSC_DIR}/share/petsc/saws",root,sizeof(root)));
568         PetscStackCallSAWs(SAWs_Set_Document_Root,(root));
569       }
570     }
571     CHKERRQ(PetscOptionsHasName(NULL,NULL,"-saws_local",&flg2));
572     if (flg2) {
573       char jsdir[PETSC_MAX_PATH_LEN];
574       PetscCheckFalse(!flg,PETSC_COMM_SELF,PETSC_ERR_SUP,"-saws_local option requires -saws_root option");
575       CHKERRQ(PetscSNPrintf(jsdir,sizeof(jsdir),"%s/js",root));
576       CHKERRQ(PetscTestDirectory(jsdir,'r',&flg));
577       PetscCheckFalse(!flg,PETSC_COMM_SELF,PETSC_ERR_FILE_READ,"-saws_local option requires js directory in root directory");
578       PetscStackCallSAWs(SAWs_Push_Local_Header,());
579     }
580     CHKERRQ(PetscGetProgramName(programname,sizeof(programname)));
581     CHKERRQ(PetscStrlen(help,&applinelen));
582     introlen   = 4096 + applinelen;
583     applinelen += 1024;
584     CHKERRQ(PetscMalloc(applinelen,&appline));
585     CHKERRQ(PetscMalloc(introlen,&intro));
586 
587     if (rootlocal) {
588       CHKERRQ(PetscSNPrintf(appline,applinelen,"%s.c.html",programname));
589       CHKERRQ(PetscTestFile(appline,'r',&rootlocal));
590     }
591     CHKERRQ(PetscOptionsGetAll(NULL,&options));
592     if (rootlocal && help) {
593       CHKERRQ(PetscSNPrintf(appline,applinelen,"<center> Running <a href=\"%s.c.html\">%s</a> %s</center><br><center><pre>%s</pre></center><br>\n",programname,programname,options,help));
594     } else if (help) {
595       CHKERRQ(PetscSNPrintf(appline,applinelen,"<center>Running %s %s</center><br><center><pre>%s</pre></center><br>",programname,options,help));
596     } else {
597       CHKERRQ(PetscSNPrintf(appline,applinelen,"<center> Running %s %s</center><br>\n",programname,options));
598     }
599     CHKERRQ(PetscFree(options));
600     CHKERRQ(PetscGetVersion(version,sizeof(version)));
601     CHKERRQ(PetscSNPrintf(intro,introlen,"<body>\n"
602                           "<center><h2> <a href=\"https://petsc.org/\">PETSc</a> Application Web server powered by <a href=\"https://bitbucket.org/saws/saws\">SAWs</a> </h2></center>\n"
603                           "<center>This is the default PETSc application dashboard, from it you can access any published PETSc objects or logging data</center><br><center>%s configured with %s</center><br>\n"
604                           "%s",version,petscconfigureoptions,appline));
605     PetscStackCallSAWs(SAWs_Push_Body,("index.html",0,intro));
606     CHKERRQ(PetscFree(intro));
607     CHKERRQ(PetscFree(appline));
608     if (selectport) {
609       PetscBool silent;
610 
611       ierr = SAWs_Initialize();
612       /* another process may have grabbed the port so keep trying */
613       while (ierr) {
614         PetscStackCallSAWs(SAWs_Get_Available_Port,(&port));
615         PetscStackCallSAWs(SAWs_Set_Port,(port));
616         ierr = SAWs_Initialize();
617       }
618 
619       CHKERRQ(PetscOptionsGetBool(NULL,NULL,"-saws_port_auto_select_silent",&silent,NULL));
620       if (!silent) {
621         PetscStackCallSAWs(SAWs_Get_FullURL,(sizeof(sawsurl),sawsurl));
622         CHKERRQ(PetscPrintf(PETSC_COMM_WORLD,"Point your browser to %s for SAWs\n",sawsurl));
623       }
624     } else {
625       PetscStackCallSAWs(SAWs_Initialize,());
626     }
627     CHKERRQ(PetscCitationsRegister("@TechReport{ saws,\n"
628                                    "  Author = {Matt Otten and Jed Brown and Barry Smith},\n"
629                                    "  Title  = {Scientific Application Web Server (SAWs) Users Manual},\n"
630                                    "  Institution = {Argonne National Laboratory},\n"
631                                    "  Year   = 2013\n}\n",NULL));
632   }
633   PetscFunctionReturn(0);
634 }
635 #endif
636 
637 /* Things must be done before MPI_Init() when MPI is not yet initialized, and can be shared between C init and Fortran init */
638 PETSC_INTERN PetscErrorCode PetscPreMPIInit_Private(void)
639 {
640   PetscFunctionBegin;
641 #if defined(PETSC_HAVE_HWLOC_SOLARIS_BUG)
642     /* see MPI.py for details on this bug */
643     (void) setenv("HWLOC_COMPONENTS","-x86",1);
644 #endif
645   PetscFunctionReturn(0);
646 }
647 
648 #if PetscDefined(HAVE_ADIOS)
649 #include <adios.h>
650 #include <adios_read.h>
651 int64_t Petsc_adios_group;
652 #endif
653 #if PetscDefined(HAVE_OPENMP)
654 #include <omp.h>
655 PetscInt PetscNumOMPThreads;
656 #endif
657 
658 #if PetscDefined(HAVE_DEVICE)
659 #include <petsc/private/deviceimpl.h>
660 #  if PetscDefined(HAVE_CUDA)
661 // REMOVE ME
662 cudaStream_t PetscDefaultCudaStream = NULL;
663 #  endif
664 #  if PetscDefined(HAVE_HIP)
665 // REMOVE ME
666 hipStream_t PetscDefaultHipStream = NULL;
667 #  endif
668 #endif
669 
670 #if PetscDefined(HAVE_DLFCN_H)
671 #include <dlfcn.h>
672 #endif
673 #if PetscDefined(USE_LOG)
674 PETSC_INTERN PetscErrorCode PetscLogInitialize(void);
675 #endif
676 #if PetscDefined(HAVE_VIENNACL)
677 PETSC_EXTERN PetscErrorCode PetscViennaCLInit();
678 PetscBool PetscViennaCLSynchronize = PETSC_FALSE;
679 #endif
680 
681 /*
682   PetscInitialize_Common  - shared code between C and Fortran initialization
683 
684   prog:     program name
685   file:     optional PETSc database file name. Might be in Fortran string format when 'ftn' is true
686   help:     program help message
687   ftn:      is it called from Fortran initilization (petscinitializef_)?
688   readarguments,len: used when fortran is true
689 */
690 PETSC_INTERN PetscErrorCode PetscInitialize_Common(const char* prog,const char* file,const char *help,PetscBool ftn,PetscBool readarguments,PetscInt len)
691 {
692   PetscMPIInt size;
693   PetscBool   flg = PETSC_TRUE;
694   char        hostname[256];
695 
696   PetscFunctionBegin;
697   if (PetscInitializeCalled) PetscFunctionReturn(0);
698   /*
699       The checking over compatible runtime libraries is complicated by the MPI ABI initiative
700       https://wiki.mpich.org/mpich/index.php/ABI_Compatibility_Initiative which started with
701         MPICH v3.1 (Released February 2014)
702         IBM MPI v2.1 (December 2014)
703         Intel MPI Library v5.0 (2014)
704         Cray MPT v7.0.0 (June 2014)
705       As of July 31, 2017 the ABI number still appears to be 12, that is all of the versions
706       listed above and since that time are compatible.
707 
708       Unfortunately the MPI ABI initiative has not defined a way to determine the ABI number
709       at compile time or runtime. Thus we will need to systematically track the allowed versions
710       and how they are represented in the mpi.h and MPI_Get_library_version() output in order
711       to perform the checking.
712 
713       Currently we only check for pre MPI ABI versions (and packages that do not follow the MPI ABI).
714 
715       Questions:
716 
717         Should the checks for ABI incompatibility be only on the major version number below?
718         Presumably the output to stderr will be removed before a release.
719   */
720 
721 #if defined(PETSC_HAVE_MPI_GET_LIBRARY_VERSION)
722   {
723     char           mpilibraryversion[MPI_MAX_LIBRARY_VERSION_STRING];
724     PetscMPIInt    mpilibraryversionlength;
725     PetscErrorCode ierr = MPI_Get_library_version(mpilibraryversion,&mpilibraryversionlength);
726     if (ierr) PetscFunctionReturn(ierr);
727     /* check for MPICH versions before MPI ABI initiative */
728 #if defined(MPICH_VERSION)
729 #if MPICH_NUMVERSION < 30100000
730     {
731       char      *ver,*lf;
732       PetscBool flg = PETSC_FALSE;
733       ierr = PetscStrstr(mpilibraryversion,"MPICH Version:",&ver);
734       if (ierr) PetscFunctionReturn(ierr);
735       else if (ver) {
736         ierr = PetscStrchr(ver,'\n',&lf);
737         if (ierr) PetscFunctionReturn(ierr);
738         else if (lf) {
739           *lf = 0;
740           ierr = PetscStrendswith(ver,MPICH_VERSION,&flg);if (ierr) PetscFunctionReturn(ierr);
741         }
742       }
743       if (!flg) {
744         PetscInfo(NULL,"PETSc warning --- MPICH library version \n%s does not match what PETSc was compiled with %s.\n",mpilibraryversion,MPICH_VESION);
745         flg = PETSC_TRUE;
746       }
747     }
748 #endif
749     /* check for OpenMPI version, it is not part of the MPI ABI initiative (is it part of another initiative that needs to be handled?) */
750 #elif defined(OMPI_MAJOR_VERSION)
751     {
752       char *ver,bs[MPI_MAX_LIBRARY_VERSION_STRING],*bsf;
753       PetscBool flg = PETSC_FALSE;
754 #define PSTRSZ 2
755       char ompistr1[PSTRSZ][MPI_MAX_LIBRARY_VERSION_STRING] = {"Open MPI","FUJITSU MPI"};
756       char ompistr2[PSTRSZ][MPI_MAX_LIBRARY_VERSION_STRING] = {"v","Library "};
757       int i;
758       for (i=0; i<PSTRSZ; i++) {
759         ierr = PetscStrstr(mpilibraryversion,ompistr1[i],&ver);
760         if (ierr) PetscFunctionReturn(ierr);
761         else if (ver) {
762           PetscSNPrintf(bs,MPI_MAX_LIBRARY_VERSION_STRING,"%s%d.%d",ompistr2[i],OMPI_MAJOR_VERSION,OMPI_MINOR_VERSION);
763           ierr = PetscStrstr(ver,bs,&bsf);
764           if (ierr) PetscFunctionReturn(ierr);
765           else if (bsf) flg = PETSC_TRUE;
766           break;
767         }
768       }
769       if (!flg) {
770         PetscInfo(NULL,"PETSc warning --- Open MPI library version \n%s does not match what PETSc was compiled with %d.%d.\n",mpilibraryversion,OMPI_MAJOR_VERSION,OMPI_MINOR_VERSION);
771         flg = PETSC_TRUE;
772       }
773     }
774 #endif
775   }
776 #endif
777 
778 #if defined(PETSC_HAVE_DLSYM)
779   /* These symbols are currently in the OpenMPI and MPICH libraries; they may not always be, in that case the test will simply not detect the problem */
780   if (PetscUnlikely(dlsym(RTLD_DEFAULT,"ompi_mpi_init") && dlsym(RTLD_DEFAULT,"MPID_Abort"))) {
781     fprintf(stderr,"PETSc Error --- Application was linked against both OpenMPI and MPICH based MPI libraries and will not run correctly\n");
782     CHKERRQ(PetscStackView(stderr));
783     PetscFunctionReturn(PETSC_ERR_MPI_LIB_INCOMP);
784   }
785 #endif
786 
787   /* these must be initialized in a routine, not as a constant declaration*/
788   PETSC_STDOUT = stdout;
789   PETSC_STDERR = stderr;
790 
791   /*CHKERRQ can be used from now */
792   PetscErrorHandlingInitialized = PETSC_TRUE;
793 
794   /* on Windows - set printf to default to printing 2 digit exponents */
795 #if defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
796   _set_output_format(_TWO_DIGIT_EXPONENT);
797 #endif
798 
799   CHKERRQ(PetscOptionsCreateDefault());
800 
801   PetscFinalizeCalled = PETSC_FALSE;
802 
803   CHKERRQ(PetscSetProgramName(prog));
804   CHKERRQ(PetscSpinlockCreate(&PetscViewerASCIISpinLockOpen));
805   CHKERRQ(PetscSpinlockCreate(&PetscViewerASCIISpinLockStdout));
806   CHKERRQ(PetscSpinlockCreate(&PetscViewerASCIISpinLockStderr));
807   CHKERRQ(PetscSpinlockCreate(&PetscCommSpinLock));
808 
809   if (PETSC_COMM_WORLD == MPI_COMM_NULL) PETSC_COMM_WORLD = MPI_COMM_WORLD;
810   CHKERRMPI(MPI_Comm_set_errhandler(PETSC_COMM_WORLD,MPI_ERRORS_RETURN));
811 
812   if (PETSC_MPI_ERROR_CLASS == MPI_ERR_LASTCODE) {
813     CHKERRMPI(MPI_Add_error_class(&PETSC_MPI_ERROR_CLASS));
814     CHKERRMPI(MPI_Add_error_code(PETSC_MPI_ERROR_CLASS,&PETSC_MPI_ERROR_CODE));
815   }
816 
817   /* Done after init due to a bug in MPICH-GM? */
818   CHKERRQ(PetscErrorPrintfInitialize());
819 
820   CHKERRMPI(MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank));
821   CHKERRMPI(MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize));
822 
823   MPIU_BOOL = MPI_INT;
824   MPIU_ENUM = MPI_INT;
825   MPIU_FORTRANADDR = (sizeof(void*) == sizeof(int)) ? MPI_INT : MPIU_INT64;
826   if (sizeof(size_t) == sizeof(unsigned)) MPIU_SIZE_T = MPI_UNSIGNED;
827   else if (sizeof(size_t) == sizeof(unsigned long)) MPIU_SIZE_T = MPI_UNSIGNED_LONG;
828 #if defined(PETSC_SIZEOF_LONG_LONG)
829   else if (sizeof(size_t) == sizeof(unsigned long long)) MPIU_SIZE_T = MPI_UNSIGNED_LONG_LONG;
830 #endif
831   else {
832     (*PetscErrorPrintf)("PetscInitialize_Common: Could not find MPI type for size_t\n");
833     PetscFunctionReturn(PETSC_ERR_SUP_SYS);
834   }
835 
836   /*
837      Initialized the global complex variable; this is because with
838      shared libraries the constructors for global variables
839      are not called; at least on IRIX.
840   */
841 #if defined(PETSC_HAVE_COMPLEX)
842   {
843 #if defined(PETSC_CLANGUAGE_CXX) && !defined(PETSC_USE_REAL___FLOAT128)
844     PetscComplex ic(0.0,1.0);
845     PETSC_i = ic;
846 #else
847     PETSC_i = _Complex_I;
848 #endif
849   }
850 #endif /* PETSC_HAVE_COMPLEX */
851 
852   /*
853      Create the PETSc MPI reduction operator that sums of the first
854      half of the entries and maxes the second half.
855   */
856   CHKERRMPI(MPI_Op_create(MPIU_MaxSum_Local,1,&MPIU_MAXSUM_OP));
857 
858 #if defined(PETSC_USE_REAL___FLOAT128)
859   CHKERRMPI(MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU___FLOAT128));
860   CHKERRMPI(MPI_Type_commit(&MPIU___FLOAT128));
861 #if defined(PETSC_HAVE_COMPLEX)
862   CHKERRMPI(MPI_Type_contiguous(4,MPI_DOUBLE,&MPIU___COMPLEX128));
863   CHKERRMPI(MPI_Type_commit(&MPIU___COMPLEX128));
864 #endif
865   CHKERRMPI(MPI_Op_create(PetscMax_Local,1,&MPIU_MAX));
866   CHKERRMPI(MPI_Op_create(PetscMin_Local,1,&MPIU_MIN));
867 #elif defined(PETSC_USE_REAL___FP16)
868   CHKERRMPI(MPI_Type_contiguous(2,MPI_CHAR,&MPIU___FP16));
869   CHKERRMPI(MPI_Type_commit(&MPIU___FP16));
870   CHKERRMPI(MPI_Op_create(PetscMax_Local,1,&MPIU_MAX));
871   CHKERRMPI(MPI_Op_create(PetscMin_Local,1,&MPIU_MIN));
872 #endif
873 
874 #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
875   CHKERRMPI(MPI_Op_create(PetscSum_Local,1,&MPIU_SUM));
876 #endif
877 
878   CHKERRMPI(MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR));
879   CHKERRMPI(MPI_Type_commit(&MPIU_2SCALAR));
880 
881   /* create datatypes used by MPIU_MAXLOC, MPIU_MINLOC and PetscSplitReduction_Op */
882 #if !defined(PETSC_HAVE_MPIUNI)
883   {
884     struct PetscRealInt { PetscReal v; PetscInt i; };
885     PetscMPIInt  blockSizes[2] = {1,1};
886     MPI_Aint     blockOffsets[2] = {offsetof(struct PetscRealInt,v),offsetof(struct PetscRealInt,i)};
887     MPI_Datatype blockTypes[2] = {MPIU_REAL,MPIU_INT}, tmpStruct;
888 
889     CHKERRMPI(MPI_Type_create_struct(2,blockSizes,blockOffsets,blockTypes,&tmpStruct));
890     CHKERRMPI(MPI_Type_create_resized(tmpStruct,0,sizeof(struct PetscRealInt),&MPIU_REAL_INT));
891     CHKERRMPI(MPI_Type_free(&tmpStruct));
892     CHKERRMPI(MPI_Type_commit(&MPIU_REAL_INT));
893   }
894   {
895     struct PetscScalarInt { PetscScalar v; PetscInt i; };
896     PetscMPIInt  blockSizes[2] = {1,1};
897     MPI_Aint     blockOffsets[2] = {offsetof(struct PetscScalarInt,v),offsetof(struct PetscScalarInt,i)};
898     MPI_Datatype blockTypes[2] = {MPIU_SCALAR,MPIU_INT}, tmpStruct;
899 
900     CHKERRMPI(MPI_Type_create_struct(2,blockSizes,blockOffsets,blockTypes,&tmpStruct));
901     CHKERRMPI(MPI_Type_create_resized(tmpStruct,0,sizeof(struct PetscScalarInt),&MPIU_SCALAR_INT));
902     CHKERRMPI(MPI_Type_free(&tmpStruct));
903     CHKERRMPI(MPI_Type_commit(&MPIU_SCALAR_INT));
904   }
905 #endif
906 
907 #if defined(PETSC_USE_64BIT_INDICES)
908   CHKERRMPI(MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT));
909   CHKERRMPI(MPI_Type_commit(&MPIU_2INT));
910 #endif
911   CHKERRMPI(MPI_Type_contiguous(4,MPI_INT,&MPI_4INT));
912   CHKERRMPI(MPI_Type_commit(&MPI_4INT));
913   CHKERRMPI(MPI_Type_contiguous(4,MPIU_INT,&MPIU_4INT));
914   CHKERRMPI(MPI_Type_commit(&MPIU_4INT));
915 
916   /*
917      Attributes to be set on PETSc communicators
918   */
919   CHKERRMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_Counter_Attr_Delete_Fn,&Petsc_Counter_keyval,(void*)0));
920   CHKERRMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_InnerComm_Attr_Delete_Fn,&Petsc_InnerComm_keyval,(void*)0));
921   CHKERRMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_OuterComm_Attr_Delete_Fn,&Petsc_OuterComm_keyval,(void*)0));
922   CHKERRMPI(MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_ShmComm_Attr_Delete_Fn,&Petsc_ShmComm_keyval,(void*)0));
923 
924 #if defined(PETSC_HAVE_FORTRAN)
925   if (ftn) CHKERRQ(PetscInitFortran_Private(readarguments,file,len));
926   else
927 #endif
928   CHKERRQ(PetscOptionsInsert(NULL,&PetscGlobalArgc,&PetscGlobalArgs,file));
929 
930   /* call a second time so it can look in the options database */
931   CHKERRQ(PetscErrorPrintfInitialize());
932 
933   /*
934      Check system options and print help
935   */
936   CHKERRQ(PetscOptionsCheckInitial_Private(help));
937 
938   /*
939    Initialize PetscDevice and PetscDeviceContext
940 
941    Note to any future devs thinking of moving this, proper initialization requires:
942    1. MPI initialized
943    2. Options DB initialized
944    3. Petsc error handling initialized, specifically signal handlers. This expects to set up its own SIGSEV handler via
945       the push/pop interface.
946   */
947 #if (PetscDefined(HAVE_CUDA) || PetscDefined(HAVE_HIP) || PetscDefined(HAVE_SYCL))
948   CHKERRQ(PetscDeviceInitializeFromOptions_Internal(PETSC_COMM_WORLD));
949 #endif
950 
951 #if PetscDefined(HAVE_VIENNACL)
952   flg = PETSC_FALSE;
953   CHKERRQ(PetscOptionsHasName(NULL,NULL,"-log_summary",&flg));
954   if (!flg) CHKERRQ(PetscOptionsHasName(NULL,NULL,"-log_view",&flg));
955   if (!flg) CHKERRQ(PetscOptionsGetBool(NULL,NULL,"-viennacl_synchronize",&flg,NULL));
956   PetscViennaCLSynchronize = flg;
957   CHKERRQ(PetscViennaCLInit());
958 #endif
959 
960   /*
961      Creates the logging data structures; this is enabled even if logging is not turned on
962      This is the last thing we do before returning to the user code to prevent having the
963      logging numbers contaminated by any startup time associated with MPI
964   */
965 #if defined(PETSC_USE_LOG)
966   CHKERRQ(PetscLogInitialize());
967 #endif
968 
969   CHKERRQ(PetscCitationsInitialize());
970 
971 #if defined(PETSC_HAVE_SAWS)
972   CHKERRQ(PetscInitializeSAWs(ftn ? NULL : help));
973   flg = PETSC_FALSE;
974   CHKERRQ(PetscOptionsHasName(NULL,NULL,"-stack_view",&flg));
975   if (flg) CHKERRQ(PetscStackViewSAWs());
976 #endif
977 
978   /*
979      Load the dynamic libraries (on machines that support them), this registers all
980      the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes)
981   */
982   CHKERRQ(PetscInitialize_DynamicLibraries());
983 
984   CHKERRMPI(MPI_Comm_size(PETSC_COMM_WORLD,&size));
985   CHKERRQ(PetscInfo(NULL,"PETSc successfully started: number of processors = %d\n",size));
986   CHKERRQ(PetscGetHostName(hostname,256));
987   CHKERRQ(PetscInfo(NULL,"Running on machine: %s\n",hostname));
988 #if defined(PETSC_HAVE_OPENMP)
989   {
990     PetscBool       omp_view_flag;
991     char           *threads = getenv("OMP_NUM_THREADS");
992     PetscErrorCode  ierr;
993 
994     if (threads) {
995       CHKERRQ(PetscInfo(NULL,"Number of OpenMP threads %s (as given by OMP_NUM_THREADS)\n",threads));
996       (void) sscanf(threads, "%" PetscInt_FMT,&PetscNumOMPThreads);
997     } else {
998       PetscNumOMPThreads = (PetscInt) omp_get_max_threads();
999       CHKERRQ(PetscInfo(NULL,"Number of OpenMP threads %" PetscInt_FMT " (as given by omp_get_max_threads())\n",PetscNumOMPThreads));
1000     }
1001     ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"OpenMP options","Sys");CHKERRQ(ierr);
1002     CHKERRQ(PetscOptionsInt("-omp_num_threads","Number of OpenMP threads to use (can also use environmental variable OMP_NUM_THREADS","None",PetscNumOMPThreads,&PetscNumOMPThreads,&flg));
1003     CHKERRQ(PetscOptionsName("-omp_view","Display OpenMP number of threads",NULL,&omp_view_flag));
1004     ierr = PetscOptionsEnd();CHKERRQ(ierr);
1005     if (flg) {
1006       CHKERRQ(PetscInfo(NULL,"Number of OpenMP theads %" PetscInt_FMT " (given by -omp_num_threads)\n",PetscNumOMPThreads));
1007       omp_set_num_threads((int)PetscNumOMPThreads);
1008     }
1009     if (omp_view_flag) {
1010       CHKERRQ(PetscPrintf(PETSC_COMM_WORLD,"OpenMP: number of threads %" PetscInt_FMT "\n",PetscNumOMPThreads));
1011     }
1012   }
1013 #endif
1014 
1015 #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
1016   /*
1017       Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI
1018 
1019       Currently not used because it is not supported by MPICH.
1020   */
1021   if (!PetscBinaryBigEndian()) CHKERRMPI(MPI_Register_datarep((char*)"petsc",PetscDataRep_read_conv_fn,PetscDataRep_write_conv_fn,PetscDataRep_extent_fn,NULL));
1022 #endif
1023 
1024 #if defined(PETSC_SERIALIZE_FUNCTIONS)
1025   CHKERRQ(PetscFPTCreate(10000));
1026 #endif
1027 
1028 #if defined(PETSC_HAVE_HWLOC)
1029   {
1030     PetscViewer viewer;
1031     CHKERRQ(PetscOptionsGetViewer(PETSC_COMM_WORLD,NULL,NULL,"-process_view",&viewer,NULL,&flg));
1032     if (flg) {
1033       CHKERRQ(PetscProcessPlacementView(viewer));
1034       CHKERRQ(PetscViewerDestroy(&viewer));
1035     }
1036   }
1037 #endif
1038 
1039   flg  = PETSC_TRUE;
1040   CHKERRQ(PetscOptionsGetBool(NULL,NULL,"-viewfromoptions",&flg,NULL));
1041   if (!flg) CHKERRQ(PetscOptionsPushGetViewerOff(PETSC_TRUE));
1042 
1043 #if defined(PETSC_HAVE_ADIOS)
1044   CHKERRQ(adios_init_noxml(PETSC_COMM_WORLD));
1045   CHKERRQ(adios_declare_group(&Petsc_adios_group,"PETSc","",adios_stat_default));
1046   CHKERRQ(adios_select_method(Petsc_adios_group,"MPI","",""));
1047   CHKERRQ(adios_read_init_method(ADIOS_READ_METHOD_BP,PETSC_COMM_WORLD,""));
1048 #endif
1049 
1050 #if defined(__VALGRIND_H)
1051   PETSC_RUNNING_ON_VALGRIND = RUNNING_ON_VALGRIND? PETSC_TRUE: PETSC_FALSE;
1052 #if defined(PETSC_USING_DARWIN) && defined(PETSC_BLASLAPACK_SDOT_RETURNS_DOUBLE)
1053   if (PETSC_RUNNING_ON_VALGRIND) CHKERRQ(PetscPrintf(PETSC_COMM_WORLD,"WARNING: Running valgrind with the MacOS native BLAS and LAPACK can fail. If it fails suggest configuring with --download-fblaslapack or --download-f2cblaslapack"));
1054 #endif
1055 #endif
1056   /*
1057       Set flag that we are completely initialized
1058   */
1059   PetscInitializeCalled = PETSC_TRUE;
1060 
1061   CHKERRQ(PetscOptionsHasName(NULL,NULL,"-python",&flg));
1062   if (flg) CHKERRQ(PetscPythonInitialize(NULL,NULL));
1063   PetscFunctionReturn(0);
1064 }
1065 
1066 /*@C
1067    PetscInitialize - Initializes the PETSc database and MPI.
1068    PetscInitialize() calls MPI_Init() if that has yet to be called,
1069    so this routine should always be called near the beginning of
1070    your program -- usually the very first line!
1071 
1072    Collective on MPI_COMM_WORLD or PETSC_COMM_WORLD if it has been set
1073 
1074    Input Parameters:
1075 +  argc - count of number of command line arguments
1076 .  args - the command line arguments
1077 .  file - [optional] PETSc database file, append ":yaml" to filename to specify YAML options format.
1078           Use NULL or empty string to not check for code specific file.
1079           Also checks ~/.petscrc, .petscrc and petscrc.
1080           Use -skip_petscrc in the code specific file (or command line) to skip ~/.petscrc, .petscrc and petscrc files.
1081 -  help - [optional] Help message to print, use NULL for no message
1082 
1083    If you wish PETSc code to run ONLY on a subcommunicator of MPI_COMM_WORLD, create that
1084    communicator first and assign it to PETSC_COMM_WORLD BEFORE calling PetscInitialize(). Thus if you are running a
1085    four process job and two processes will run PETSc and have PetscInitialize() and PetscFinalize() and two process will not,
1086    then do this. If ALL processes in the job are using PetscInitialize() and PetscFinalize() then you don't need to do this, even
1087    if different subcommunicators of the job are doing different things with PETSc.
1088 
1089    Options Database Keys:
1090 +  -help [intro] - prints help method for each option; if intro is given the program stops after printing the introductory help message
1091 .  -start_in_debugger [noxterm,dbx,xdb,gdb,...] - Starts program in debugger
1092 .  -on_error_attach_debugger [noxterm,dbx,xdb,gdb,...] - Starts debugger when error detected
1093 .  -on_error_emacs <machinename> - causes emacsclient to jump to error file
1094 .  -on_error_abort - calls abort() when error detected (no traceback)
1095 .  -on_error_mpiabort - calls MPI_abort() when error detected
1096 .  -error_output_stderr - prints error messages to stderr instead of the default stdout
1097 .  -error_output_none - does not print the error messages (but handles errors in the same way as if this was not called)
1098 .  -debugger_ranks [rank1,rank2,...] - Indicates ranks to start in debugger
1099 .  -debugger_pause [sleeptime] (in seconds) - Pauses debugger
1100 .  -stop_for_debugger - Print message on how to attach debugger manually to
1101                         process and wait (-debugger_pause) seconds for attachment
1102 .  -malloc - Indicates use of PETSc error-checking malloc (on by default for debug version of libraries) (deprecated, use -malloc_debug)
1103 .  -malloc no - Indicates not to use error-checking malloc (deprecated, use -malloc_debug no)
1104 .  -malloc_debug - check for memory corruption at EVERY malloc or free, see PetscMallocSetDebug()
1105 .  -malloc_dump - prints a list of all unfreed memory at the end of the run
1106 .  -malloc_test - like -malloc_dump -malloc_debug, but only active for debugging builds, ignored in optimized build. May want to set in PETSC_OPTIONS environmental variable
1107 .  -malloc_view - show a list of all allocated memory during PetscFinalize()
1108 .  -malloc_view_threshold <t> - only list memory allocations of size greater than t with -malloc_view
1109 .  -malloc_requested_size - malloc logging will record the requested size rather than size after alignment
1110 .  -fp_trap - Stops on floating point exceptions
1111 .  -no_signal_handler - Indicates not to trap error signals
1112 .  -shared_tmp - indicates /tmp directory is shared by all processors
1113 .  -not_shared_tmp - each processor has own /tmp
1114 .  -tmp - alternative name of /tmp directory
1115 .  -get_total_flops - returns total flops done by all processors
1116 -  -memory_view - Print memory usage at end of run
1117 
1118    Options Database Keys for Option Database:
1119 +  -skip_petscrc - skip the default option files ~/.petscrc, .petscrc, petscrc
1120 .  -options_monitor - monitor all set options to standard output for the whole program run
1121 -  -options_monitor_cancel - cancel options monitoring hard-wired using PetscOptionsMonitorSet()
1122 
1123    Options -options_monitor_{all,cancel} are
1124    position-independent and apply to all options set since the PETSc start.
1125    They can be used also in option files.
1126 
1127    See PetscOptionsMonitorSet() to do monitoring programmatically.
1128 
1129    Options Database Keys for Profiling:
1130    See Users-Manual: ch_profiling for details.
1131 +  -info [filename][:[~]<list,of,classnames>[:[~]self]] - Prints verbose information. See PetscInfo().
1132 .  -log_sync - Enable barrier synchronization for all events. This option is useful to debug imbalance within each event,
1133         however it slows things down and gives a distorted view of the overall runtime.
1134 .  -log_trace [filename] - Print traces of all PETSc calls to the screen (useful to determine where a program
1135         hangs without running in the debugger).  See PetscLogTraceBegin().
1136 .  -log_view [:filename:format] - Prints summary of flop and timing information to screen or file, see PetscLogView().
1137 .  -log_view_memory - Includes in the summary from -log_view the memory used in each method, see PetscLogView().
1138 .  -log_summary [filename] - (Deprecated, use -log_view) Prints summary of flop and timing information to screen. If the filename is specified the
1139         summary is written to the file.  See PetscLogView().
1140 .  -log_exclude: <vec,mat,pc,ksp,snes> - excludes subset of object classes from logging
1141 .  -log_all [filename] - Logs extensive profiling information  See PetscLogDump().
1142 .  -log [filename] - Logs basic profiline information  See PetscLogDump().
1143 .  -log_mpe [filename] - Creates a logfile viewable by the utility Jumpshot (in MPICH distribution)
1144 .  -viewfromoptions on,off - Enable or disable XXXSetFromOptions() calls, for applications with many small solves turn this off
1145 -  -check_pointer_intensity 0,1,2 - if pointers are checked for validity (debug version only), using 0 will result in faster code
1146 
1147     Only one of -log_trace, -log_view, -log_view, -log_all, -log, or -log_mpe may be used at a time
1148 
1149    Options Database Keys for SAWs:
1150 +  -saws_port <portnumber> - port number to publish SAWs data, default is 8080
1151 .  -saws_port_auto_select - have SAWs select a new unique port number where it publishes the data, the URL is printed to the screen
1152                             this is useful when you are running many jobs that utilize SAWs at the same time
1153 .  -saws_log <filename> - save a log of all SAWs communication
1154 .  -saws_https <certificate file> - have SAWs use HTTPS instead of HTTP
1155 -  -saws_root <directory> - allow SAWs to have access to the given directory to search for requested resources and files
1156 
1157    Environmental Variables:
1158 +   PETSC_TMP - alternative tmp directory
1159 .   PETSC_SHARED_TMP - tmp is shared by all processes
1160 .   PETSC_NOT_SHARED_TMP - each process has its own private tmp
1161 .   PETSC_OPTIONS - a string containing additional options for petsc in the form of command line "-key value" pairs
1162 .   PETSC_OPTIONS_YAML - (requires configuring PETSc to use libyaml) a string containing additional options for petsc in the form of a YAML document
1163 .   PETSC_VIEWER_SOCKET_PORT - socket number to use for socket viewer
1164 -   PETSC_VIEWER_SOCKET_MACHINE - machine to use for socket viewer to connect to
1165 
1166    Level: beginner
1167 
1168    Notes:
1169    If for some reason you must call MPI_Init() separately, call
1170    it before PetscInitialize().
1171 
1172    Fortran Version:
1173    In Fortran this routine has the format
1174 $       call PetscInitialize(file,ierr)
1175 
1176 +  ierr - error return code
1177 -  file - [optional] PETSc database file, also checks ~/.petscrc, .petscrc and petscrc.
1178           Use PETSC_NULL_CHARACTER to not check for code specific file.
1179           Use -skip_petscrc in the code specific file (or command line) to skip ~/.petscrc, .petscrc and petscrc files.
1180 
1181    Important Fortran Note:
1182    In Fortran, you MUST use PETSC_NULL_CHARACTER to indicate a
1183    null character string; you CANNOT just use NULL as
1184    in the C version. See Users-Manual: ch_fortran for details.
1185 
1186    If your main program is C but you call Fortran code that also uses PETSc you need to call PetscInitializeFortran() soon after
1187    calling PetscInitialize().
1188 
1189 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscInitializeNoArguments()
1190 
1191 @*/
1192 PetscErrorCode  PetscInitialize(int *argc,char ***args,const char file[],const char help[])
1193 {
1194   PetscMPIInt    flag;
1195   const char     *prog = "Unknown Name";
1196 
1197   PetscFunctionBegin;
1198   if (PetscInitializeCalled) PetscFunctionReturn(0);
1199   CHKERRMPI(MPI_Initialized(&flag));
1200   if (!flag) {
1201     PetscCheckFalse(PETSC_COMM_WORLD != MPI_COMM_NULL,PETSC_COMM_SELF,PETSC_ERR_SUP,"You cannot set PETSC_COMM_WORLD if you have not initialized MPI first");
1202     CHKERRQ(PetscPreMPIInit_Private());
1203 #if defined(PETSC_HAVE_MPI_INIT_THREAD)
1204     {
1205       PetscMPIInt provided;
1206       CHKERRMPI(MPI_Init_thread(argc,args,PETSC_MPI_THREAD_REQUIRED,&provided));
1207     }
1208 #else
1209     CHKERRMPI(MPI_Init(argc,args));
1210 #endif
1211     PetscBeganMPI = PETSC_TRUE;
1212   }
1213 
1214   if (argc && *argc) prog = **args;
1215   if (argc && args) {
1216     PetscGlobalArgc = *argc;
1217     PetscGlobalArgs = *args;
1218   }
1219   CHKERRQ(PetscInitialize_Common(prog,file,help,PETSC_FALSE/*C*/,PETSC_FALSE,0));
1220   PetscFunctionReturn(0);
1221 }
1222 
1223 #if PetscDefined(USE_LOG)
1224 PETSC_INTERN PetscObject *PetscObjects;
1225 PETSC_INTERN PetscInt    PetscObjectsCounts;
1226 PETSC_INTERN PetscInt    PetscObjectsMaxCounts;
1227 PETSC_INTERN PetscBool   PetscObjectsLog;
1228 #endif
1229 
1230 /*
1231     Frees all the MPI types and operations that PETSc may have created
1232 */
1233 PetscErrorCode  PetscFreeMPIResources(void)
1234 {
1235   PetscFunctionBegin;
1236 #if defined(PETSC_USE_REAL___FLOAT128)
1237   CHKERRMPI(MPI_Type_free(&MPIU___FLOAT128));
1238 #if defined(PETSC_HAVE_COMPLEX)
1239   CHKERRMPI(MPI_Type_free(&MPIU___COMPLEX128));
1240 #endif
1241   CHKERRMPI(MPI_Op_free(&MPIU_MAX));
1242   CHKERRMPI(MPI_Op_free(&MPIU_MIN));
1243 #elif defined(PETSC_USE_REAL___FP16)
1244   CHKERRMPI(MPI_Type_free(&MPIU___FP16));
1245   CHKERRMPI(MPI_Op_free(&MPIU_MAX));
1246   CHKERRMPI(MPI_Op_free(&MPIU_MIN));
1247 #endif
1248 
1249 #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
1250   CHKERRMPI(MPI_Op_free(&MPIU_SUM));
1251 #endif
1252 
1253   CHKERRMPI(MPI_Type_free(&MPIU_2SCALAR));
1254   CHKERRMPI(MPI_Type_free(&MPIU_REAL_INT));
1255   CHKERRMPI(MPI_Type_free(&MPIU_SCALAR_INT));
1256 #if defined(PETSC_USE_64BIT_INDICES)
1257   CHKERRMPI(MPI_Type_free(&MPIU_2INT));
1258 #endif
1259   CHKERRMPI(MPI_Type_free(&MPI_4INT));
1260   CHKERRMPI(MPI_Type_free(&MPIU_4INT));
1261   CHKERRMPI(MPI_Op_free(&MPIU_MAXSUM_OP));
1262   PetscFunctionReturn(0);
1263 }
1264 
1265 #if PetscDefined(USE_LOG)
1266 PETSC_INTERN PetscErrorCode PetscLogFinalize(void);
1267 #endif
1268 
1269 /*@C
1270    PetscFinalize - Checks for options to be called at the conclusion
1271    of the program. MPI_Finalize() is called only if the user had not
1272    called MPI_Init() before calling PetscInitialize().
1273 
1274    Collective on PETSC_COMM_WORLD
1275 
1276    Options Database Keys:
1277 +  -options_view - Calls PetscOptionsView()
1278 .  -options_left - Prints unused options that remain in the database
1279 .  -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
1280 .  -mpidump - Calls PetscMPIDump()
1281 .  -malloc_dump <optional filename> - Calls PetscMallocDump(), displays all memory allocated that has not been freed
1282 .  -malloc_info - Prints total memory usage
1283 -  -malloc_view <optional filename> - Prints list of all memory allocated and where
1284 
1285    Level: beginner
1286 
1287    Note:
1288    See PetscInitialize() for more general runtime options.
1289 
1290 .seealso: PetscInitialize(), PetscOptionsView(), PetscMallocDump(), PetscMPIDump(), PetscEnd()
1291 @*/
1292 PetscErrorCode  PetscFinalize(void)
1293 {
1294   PetscMPIInt    rank;
1295   PetscInt       nopt;
1296   PetscBool      flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,flg3 = PETSC_FALSE;
1297   PetscBool      flg;
1298 #if defined(PETSC_USE_LOG)
1299   char           mname[PETSC_MAX_PATH_LEN];
1300 #endif
1301 
1302   PetscFunctionBegin;
1303   if (PetscUnlikely(!PetscInitializeCalled)) {
1304     fprintf(PETSC_STDOUT,"PetscInitialize() must be called before PetscFinalize()\n");
1305     CHKERRQ(PetscStackView(PETSC_STDOUT));
1306     PetscStackClearTop;
1307     return PETSC_ERR_ARG_WRONGSTATE;
1308   }
1309   CHKERRQ(PetscInfo(NULL,"PetscFinalize() called\n"));
1310 
1311   CHKERRMPI(MPI_Comm_rank(PETSC_COMM_WORLD,&rank));
1312 #if defined(PETSC_HAVE_ADIOS)
1313   CHKERRQ(adios_read_finalize_method(ADIOS_READ_METHOD_BP_AGGREGATE));
1314   CHKERRQ(adios_finalize(rank));
1315 #endif
1316   CHKERRQ(PetscOptionsHasName(NULL,NULL,"-citations",&flg));
1317   if (flg) {
1318     char  *cits, filename[PETSC_MAX_PATH_LEN];
1319     FILE  *fd = PETSC_STDOUT;
1320 
1321     CHKERRQ(PetscOptionsGetString(NULL,NULL,"-citations",filename,sizeof(filename),NULL));
1322     if (filename[0]) {
1323       CHKERRQ(PetscFOpen(PETSC_COMM_WORLD,filename,"w",&fd));
1324     }
1325     CHKERRQ(PetscSegBufferGet(PetscCitationsList,1,&cits));
1326     cits[0] = 0;
1327     CHKERRQ(PetscSegBufferExtractAlloc(PetscCitationsList,&cits));
1328     CHKERRQ(PetscFPrintf(PETSC_COMM_WORLD,fd,"If you publish results based on this computation please cite the following:\n"));
1329     CHKERRQ(PetscFPrintf(PETSC_COMM_WORLD,fd,"===========================================================================\n"));
1330     CHKERRQ(PetscFPrintf(PETSC_COMM_WORLD,fd,"%s",cits));
1331     CHKERRQ(PetscFPrintf(PETSC_COMM_WORLD,fd,"===========================================================================\n"));
1332     CHKERRQ(PetscFClose(PETSC_COMM_WORLD,fd));
1333     CHKERRQ(PetscFree(cits));
1334   }
1335   CHKERRQ(PetscSegBufferDestroy(&PetscCitationsList));
1336 
1337 #if defined(PETSC_HAVE_SSL) && defined(PETSC_USE_SOCKET_VIEWER)
1338   /* TextBelt is run for testing purposes only, please do not use this feature often */
1339   {
1340     PetscInt nmax = 2;
1341     char     **buffs;
1342     CHKERRQ(PetscMalloc1(2,&buffs));
1343     CHKERRQ(PetscOptionsGetStringArray(NULL,NULL,"-textbelt",buffs,&nmax,&flg1));
1344     if (flg1) {
1345       PetscCheckFalse(!nmax,PETSC_COMM_WORLD,PETSC_ERR_USER,"-textbelt requires either the phone number or number,\"message\"");
1346       if (nmax == 1) {
1347         CHKERRQ(PetscMalloc1(128,&buffs[1]));
1348         CHKERRQ(PetscGetProgramName(buffs[1],32));
1349         CHKERRQ(PetscStrcat(buffs[1]," has completed"));
1350       }
1351       CHKERRQ(PetscTextBelt(PETSC_COMM_WORLD,buffs[0],buffs[1],NULL));
1352       CHKERRQ(PetscFree(buffs[0]));
1353       CHKERRQ(PetscFree(buffs[1]));
1354     }
1355     CHKERRQ(PetscFree(buffs));
1356   }
1357   {
1358     PetscInt nmax = 2;
1359     char     **buffs;
1360     CHKERRQ(PetscMalloc1(2,&buffs));
1361     CHKERRQ(PetscOptionsGetStringArray(NULL,NULL,"-tellmycell",buffs,&nmax,&flg1));
1362     if (flg1) {
1363       PetscCheckFalse(!nmax,PETSC_COMM_WORLD,PETSC_ERR_USER,"-tellmycell requires either the phone number or number,\"message\"");
1364       if (nmax == 1) {
1365         CHKERRQ(PetscMalloc1(128,&buffs[1]));
1366         CHKERRQ(PetscGetProgramName(buffs[1],32));
1367         CHKERRQ(PetscStrcat(buffs[1]," has completed"));
1368       }
1369       CHKERRQ(PetscTellMyCell(PETSC_COMM_WORLD,buffs[0],buffs[1],NULL));
1370       CHKERRQ(PetscFree(buffs[0]));
1371       CHKERRQ(PetscFree(buffs[1]));
1372     }
1373     CHKERRQ(PetscFree(buffs));
1374   }
1375 #endif
1376 
1377 #if defined(PETSC_SERIALIZE_FUNCTIONS)
1378   CHKERRQ(PetscFPTDestroy());
1379 #endif
1380 
1381 #if defined(PETSC_HAVE_SAWS)
1382   flg = PETSC_FALSE;
1383   CHKERRQ(PetscOptionsGetBool(NULL,NULL,"-saw_options",&flg,NULL));
1384   if (flg) {
1385     CHKERRQ(PetscOptionsSAWsDestroy());
1386   }
1387 #endif
1388 
1389 #if defined(PETSC_HAVE_X)
1390   flg1 = PETSC_FALSE;
1391   CHKERRQ(PetscOptionsGetBool(NULL,NULL,"-x_virtual",&flg1,NULL));
1392   if (flg1) {
1393     /*  this is a crude hack, but better than nothing */
1394     CHKERRQ(PetscPOpen(PETSC_COMM_WORLD,NULL,"pkill -9 Xvfb","r",NULL));
1395   }
1396 #endif
1397 
1398 #if !defined(PETSC_HAVE_THREADSAFETY)
1399   CHKERRQ(PetscOptionsGetBool(NULL,NULL,"-malloc_info",&flg2,NULL));
1400   if (!flg2) {
1401     flg2 = PETSC_FALSE;
1402     CHKERRQ(PetscOptionsGetBool(NULL,NULL,"-memory_view",&flg2,NULL));
1403   }
1404   if (flg2) {
1405     CHKERRQ(PetscMemoryView(PETSC_VIEWER_STDOUT_WORLD,"Summary of Memory Usage in PETSc\n"));
1406   }
1407 #endif
1408 
1409 #if defined(PETSC_USE_LOG)
1410   flg1 = PETSC_FALSE;
1411   CHKERRQ(PetscOptionsGetBool(NULL,NULL,"-get_total_flops",&flg1,NULL));
1412   if (flg1) {
1413     PetscLogDouble flops = 0;
1414     CHKERRMPI(MPI_Reduce(&petsc_TotalFlops,&flops,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD));
1415     CHKERRQ(PetscPrintf(PETSC_COMM_WORLD,"Total flops over all processors %g\n",flops));
1416   }
1417 #endif
1418 
1419 #if defined(PETSC_USE_LOG)
1420 #if defined(PETSC_HAVE_MPE)
1421   mname[0] = 0;
1422   CHKERRQ(PetscOptionsGetString(NULL,NULL,"-log_mpe",mname,sizeof(mname),&flg1));
1423   if (flg1) {
1424     if (mname[0]) CHKERRQ(PetscLogMPEDump(mname));
1425     else          CHKERRQ(PetscLogMPEDump(0));
1426   }
1427 #endif
1428 #endif
1429 
1430   /*
1431      Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_().
1432   */
1433   CHKERRQ(PetscObjectRegisterDestroyAll());
1434 
1435 #if defined(PETSC_USE_LOG)
1436   CHKERRQ(PetscOptionsPushGetViewerOff(PETSC_FALSE));
1437   CHKERRQ(PetscLogViewFromOptions());
1438   CHKERRQ(PetscOptionsPopGetViewerOff());
1439 
1440   mname[0] = 0;
1441   CHKERRQ(PetscOptionsGetString(NULL,NULL,"-log_summary",mname,sizeof(mname),&flg1));
1442   if (flg1) {
1443     PetscViewer viewer;
1444     CHKERRQ((*PetscHelpPrintf)(PETSC_COMM_WORLD,"\n\n WARNING:   -log_summary is being deprecated; switch to -log_view\n\n\n"));
1445     if (mname[0]) {
1446       CHKERRQ(PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer));
1447       CHKERRQ(PetscLogView(viewer));
1448       CHKERRQ(PetscViewerDestroy(&viewer));
1449     } else {
1450       viewer = PETSC_VIEWER_STDOUT_WORLD;
1451       CHKERRQ(PetscViewerPushFormat(viewer,PETSC_VIEWER_DEFAULT));
1452       CHKERRQ(PetscLogView(viewer));
1453       CHKERRQ(PetscViewerPopFormat(viewer));
1454     }
1455   }
1456 
1457   /*
1458      Free any objects created by the last block of code.
1459   */
1460   CHKERRQ(PetscObjectRegisterDestroyAll());
1461 
1462   mname[0] = 0;
1463   CHKERRQ(PetscOptionsGetString(NULL,NULL,"-log_all",mname,sizeof(mname),&flg1));
1464   CHKERRQ(PetscOptionsGetString(NULL,NULL,"-log",mname,sizeof(mname),&flg2));
1465   if (flg1 || flg2) CHKERRQ(PetscLogDump(mname));
1466 #endif
1467 
1468   flg1 = PETSC_FALSE;
1469   CHKERRQ(PetscOptionsGetBool(NULL,NULL,"-no_signal_handler",&flg1,NULL));
1470   if (!flg1) CHKERRQ(PetscPopSignalHandler());
1471   flg1 = PETSC_FALSE;
1472   CHKERRQ(PetscOptionsGetBool(NULL,NULL,"-mpidump",&flg1,NULL));
1473   if (flg1) {
1474     CHKERRQ(PetscMPIDump(stdout));
1475   }
1476   flg1 = PETSC_FALSE;
1477   flg2 = PETSC_FALSE;
1478   /* preemptive call to avoid listing this option in options table as unused */
1479   CHKERRQ(PetscOptionsHasName(NULL,NULL,"-malloc_dump",&flg1));
1480   CHKERRQ(PetscOptionsHasName(NULL,NULL,"-objects_dump",&flg1));
1481   CHKERRQ(PetscOptionsGetBool(NULL,NULL,"-options_view",&flg2,NULL));
1482 
1483   if (flg2) {
1484     PetscViewer viewer;
1485     CHKERRQ(PetscViewerCreate(PETSC_COMM_WORLD,&viewer));
1486     CHKERRQ(PetscViewerSetType(viewer,PETSCVIEWERASCII));
1487     CHKERRQ(PetscOptionsView(NULL,viewer));
1488     CHKERRQ(PetscViewerDestroy(&viewer));
1489   }
1490 
1491   /* to prevent PETSc -options_left from warning */
1492   CHKERRQ(PetscOptionsHasName(NULL,NULL,"-nox",&flg1));
1493   CHKERRQ(PetscOptionsHasName(NULL,NULL,"-nox_warning",&flg1));
1494 
1495   flg3 = PETSC_FALSE; /* default value is required */
1496   CHKERRQ(PetscOptionsGetBool(NULL,NULL,"-options_left",&flg3,&flg1));
1497   if (PetscUnlikelyDebug(!flg1)) flg3 = PETSC_TRUE;
1498   if (flg3) {
1499     if (!flg2 && flg1) { /* have not yet printed the options */
1500       PetscViewer viewer;
1501       CHKERRQ(PetscViewerCreate(PETSC_COMM_WORLD,&viewer));
1502       CHKERRQ(PetscViewerSetType(viewer,PETSCVIEWERASCII));
1503       CHKERRQ(PetscOptionsView(NULL,viewer));
1504       CHKERRQ(PetscViewerDestroy(&viewer));
1505     }
1506     CHKERRQ(PetscOptionsAllUsed(NULL,&nopt));
1507     if (nopt) {
1508       CHKERRQ(PetscPrintf(PETSC_COMM_WORLD,"WARNING! There are options you set that were not used!\n"));
1509       CHKERRQ(PetscPrintf(PETSC_COMM_WORLD,"WARNING! could be spelling mistake, etc!\n"));
1510       if (nopt == 1) {
1511         CHKERRQ(PetscPrintf(PETSC_COMM_WORLD,"There is one unused database option. It is:\n"));
1512       } else {
1513         CHKERRQ(PetscPrintf(PETSC_COMM_WORLD,"There are %" PetscInt_FMT " unused database options. They are:\n",nopt));
1514       }
1515     } else if (flg3 && flg1) {
1516       CHKERRQ(PetscPrintf(PETSC_COMM_WORLD,"There are no unused options.\n"));
1517     }
1518     CHKERRQ(PetscOptionsLeft(NULL));
1519   }
1520 
1521 #if defined(PETSC_HAVE_SAWS)
1522   if (!PetscGlobalRank) {
1523     CHKERRQ(PetscStackSAWsViewOff());
1524     PetscStackCallSAWs(SAWs_Finalize,());
1525   }
1526 #endif
1527 
1528 #if defined(PETSC_USE_LOG)
1529   /*
1530        List all objects the user may have forgot to free
1531   */
1532   if (PetscObjectsLog) {
1533     CHKERRQ(PetscOptionsHasName(NULL,NULL,"-objects_dump",&flg1));
1534     if (flg1) {
1535       MPI_Comm local_comm;
1536       char     string[64];
1537 
1538       CHKERRQ(PetscOptionsGetString(NULL,NULL,"-objects_dump",string,sizeof(string),NULL));
1539       CHKERRMPI(MPI_Comm_dup(MPI_COMM_WORLD,&local_comm));
1540       CHKERRQ(PetscSequentialPhaseBegin_Private(local_comm,1));
1541       CHKERRQ(PetscObjectsDump(stdout,(string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE));
1542       CHKERRQ(PetscSequentialPhaseEnd_Private(local_comm,1));
1543       CHKERRMPI(MPI_Comm_free(&local_comm));
1544     }
1545   }
1546 #endif
1547 
1548 #if defined(PETSC_USE_LOG)
1549   PetscObjectsCounts    = 0;
1550   PetscObjectsMaxCounts = 0;
1551   CHKERRQ(PetscFree(PetscObjects));
1552 #endif
1553 
1554   /*
1555      Destroy any packages that registered a finalize
1556   */
1557   CHKERRQ(PetscRegisterFinalizeAll());
1558 
1559 #if defined(PETSC_USE_LOG)
1560   CHKERRQ(PetscLogFinalize());
1561 #endif
1562 
1563   /*
1564      Print PetscFunctionLists that have not been properly freed
1565 
1566   CHKERRQ(PetscFunctionListPrintAll());
1567   */
1568 
1569   if (petsc_history) {
1570     CHKERRQ(PetscCloseHistoryFile(&petsc_history));
1571     petsc_history = NULL;
1572   }
1573   CHKERRQ(PetscOptionsHelpPrintedDestroy(&PetscOptionsHelpPrintedSingleton));
1574   CHKERRQ(PetscInfoDestroy());
1575 
1576 #if !defined(PETSC_HAVE_THREADSAFETY)
1577   if (!(PETSC_RUNNING_ON_VALGRIND)) {
1578     char fname[PETSC_MAX_PATH_LEN];
1579     char sname[PETSC_MAX_PATH_LEN];
1580     FILE *fd;
1581     int  err;
1582 
1583     flg2 = PETSC_FALSE;
1584     flg3 = PETSC_FALSE;
1585     if (PetscDefined(USE_DEBUG)) CHKERRQ(PetscOptionsGetBool(NULL,NULL,"-malloc_test",&flg2,NULL));
1586     CHKERRQ(PetscOptionsGetBool(NULL,NULL,"-malloc_debug",&flg3,NULL));
1587     fname[0] = 0;
1588     CHKERRQ(PetscOptionsGetString(NULL,NULL,"-malloc_dump",fname,sizeof(fname),&flg1));
1589     if (flg1 && fname[0]) {
1590 
1591       PetscSNPrintf(sname,sizeof(sname),"%s_%d",fname,rank);
1592       fd   = fopen(sname,"w"); PetscCheckFalse(!fd,PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname);
1593       CHKERRQ(PetscMallocDump(fd));
1594       err  = fclose(fd);
1595       PetscCheckFalse(err,PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
1596     } else if (flg1 || flg2 || flg3) {
1597       MPI_Comm local_comm;
1598 
1599       CHKERRMPI(MPI_Comm_dup(MPI_COMM_WORLD,&local_comm));
1600       CHKERRQ(PetscSequentialPhaseBegin_Private(local_comm,1));
1601       CHKERRQ(PetscMallocDump(stdout));
1602       CHKERRQ(PetscSequentialPhaseEnd_Private(local_comm,1));
1603       CHKERRMPI(MPI_Comm_free(&local_comm));
1604     }
1605     fname[0] = 0;
1606     CHKERRQ(PetscOptionsGetString(NULL,NULL,"-malloc_view",fname,sizeof(fname),&flg1));
1607     if (flg1 && fname[0]) {
1608 
1609       PetscSNPrintf(sname,sizeof(sname),"%s_%d",fname,rank);
1610       fd   = fopen(sname,"w"); PetscCheckFalse(!fd,PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname);
1611       CHKERRQ(PetscMallocView(fd));
1612       err  = fclose(fd);
1613       PetscCheckFalse(err,PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
1614     } else if (flg1) {
1615       MPI_Comm local_comm;
1616 
1617       CHKERRMPI(MPI_Comm_dup(MPI_COMM_WORLD,&local_comm));
1618       CHKERRQ(PetscSequentialPhaseBegin_Private(local_comm,1));
1619       CHKERRQ(PetscMallocView(stdout));
1620       CHKERRQ(PetscSequentialPhaseEnd_Private(local_comm,1));
1621       CHKERRMPI(MPI_Comm_free(&local_comm));
1622     }
1623   }
1624 #endif
1625 
1626   /*
1627      Close any open dynamic libraries
1628   */
1629   CHKERRQ(PetscFinalize_DynamicLibraries());
1630 
1631   /* Can be destroyed only after all the options are used */
1632   CHKERRQ(PetscOptionsDestroyDefault());
1633 
1634   PetscGlobalArgc = 0;
1635   PetscGlobalArgs = NULL;
1636 
1637 #if defined(PETSC_HAVE_KOKKOS)
1638   if (PetscBeganKokkos) {
1639     CHKERRQ(PetscKokkosFinalize_Private());
1640     PetscBeganKokkos = PETSC_FALSE;
1641     PetscKokkosInitialized = PETSC_FALSE;
1642   }
1643 #endif
1644 
1645 #if defined(PETSC_HAVE_NVSHMEM)
1646   if (PetscBeganNvshmem) {
1647     CHKERRQ(PetscNvshmemFinalize());
1648     PetscBeganNvshmem = PETSC_FALSE;
1649   }
1650 #endif
1651 
1652   CHKERRQ(PetscFreeMPIResources());
1653 
1654   /*
1655      Destroy any known inner MPI_Comm's and attributes pointing to them
1656      Note this will not destroy any new communicators the user has created.
1657 
1658      If all PETSc objects were not destroyed those left over objects will have hanging references to
1659      the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again
1660  */
1661   {
1662     PetscCommCounter *counter;
1663     PetscMPIInt      flg;
1664     MPI_Comm         icomm;
1665     union {MPI_Comm comm; void *ptr;} ucomm;
1666     CHKERRMPI(MPI_Comm_get_attr(PETSC_COMM_SELF,Petsc_InnerComm_keyval,&ucomm,&flg));
1667     if (flg) {
1668       icomm = ucomm.comm;
1669       CHKERRMPI(MPI_Comm_get_attr(icomm,Petsc_Counter_keyval,&counter,&flg));
1670       PetscCheckFalse(!flg,PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1671 
1672       CHKERRMPI(MPI_Comm_delete_attr(PETSC_COMM_SELF,Petsc_InnerComm_keyval));
1673       CHKERRMPI(MPI_Comm_delete_attr(icomm,Petsc_Counter_keyval));
1674       CHKERRMPI(MPI_Comm_free(&icomm));
1675     }
1676     CHKERRMPI(MPI_Comm_get_attr(PETSC_COMM_WORLD,Petsc_InnerComm_keyval,&ucomm,&flg));
1677     if (flg) {
1678       icomm = ucomm.comm;
1679       CHKERRMPI(MPI_Comm_get_attr(icomm,Petsc_Counter_keyval,&counter,&flg));
1680       PetscCheckFalse(!flg,PETSC_COMM_WORLD,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1681 
1682       CHKERRMPI(MPI_Comm_delete_attr(PETSC_COMM_WORLD,Petsc_InnerComm_keyval));
1683       CHKERRMPI(MPI_Comm_delete_attr(icomm,Petsc_Counter_keyval));
1684       CHKERRMPI(MPI_Comm_free(&icomm));
1685     }
1686   }
1687 
1688   CHKERRMPI(MPI_Comm_free_keyval(&Petsc_Counter_keyval));
1689   CHKERRMPI(MPI_Comm_free_keyval(&Petsc_InnerComm_keyval));
1690   CHKERRMPI(MPI_Comm_free_keyval(&Petsc_OuterComm_keyval));
1691   CHKERRMPI(MPI_Comm_free_keyval(&Petsc_ShmComm_keyval));
1692 
1693   CHKERRQ(PetscSpinlockDestroy(&PetscViewerASCIISpinLockOpen));
1694   CHKERRQ(PetscSpinlockDestroy(&PetscViewerASCIISpinLockStdout));
1695   CHKERRQ(PetscSpinlockDestroy(&PetscViewerASCIISpinLockStderr));
1696   CHKERRQ(PetscSpinlockDestroy(&PetscCommSpinLock));
1697 
1698   if (PetscBeganMPI) {
1699     PetscMPIInt flag;
1700     CHKERRMPI(MPI_Finalized(&flag));
1701     PetscCheckFalse(flag,PETSC_COMM_SELF,PETSC_ERR_LIB,"MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()");
1702     CHKERRMPI(MPI_Finalize());
1703   }
1704 /*
1705 
1706      Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because
1707    the communicator has some outstanding requests on it. Specifically if the
1708    flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See
1709    src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate()
1710    is never freed as it should be. Thus one may obtain messages of the form
1711    [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the
1712    memory was not freed.
1713 
1714 */
1715   CHKERRQ(PetscMallocClear());
1716   CHKERRQ(PetscStackReset());
1717 
1718   PetscErrorHandlingInitialized = PETSC_FALSE;
1719   PetscInitializeCalled = PETSC_FALSE;
1720   PetscFinalizeCalled   = PETSC_TRUE;
1721 #if defined(PETSC_USE_GCOV)
1722   /*
1723      flush gcov, otherwise during CI the flushing continues into the next pipeline resulting in git not being able to delete directories since the
1724      gcov files are still being added to the directories as git tries to remove the directories.
1725    */
1726   __gcov_flush();
1727 #endif
1728   /* To match PetscFunctionBegin() at the beginning of this function */
1729   PetscStackClearTop;
1730   return 0;
1731 }
1732 
1733 #if defined(PETSC_MISSING_LAPACK_lsame_)
1734 PETSC_EXTERN int lsame_(char *a,char *b)
1735 {
1736   if (*a == *b) return 1;
1737   if (*a + 32 == *b) return 1;
1738   if (*a - 32 == *b) return 1;
1739   return 0;
1740 }
1741 #endif
1742 
1743 #if defined(PETSC_MISSING_LAPACK_lsame)
1744 PETSC_EXTERN int lsame(char *a,char *b)
1745 {
1746   if (*a == *b) return 1;
1747   if (*a + 32 == *b) return 1;
1748   if (*a - 32 == *b) return 1;
1749   return 0;
1750 }
1751 #endif
1752