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