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