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