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