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