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