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