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