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