Actual source code: pinit.c
petsc-3.4.2 2013-07-02
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: /* pthread_key for PetscStack */
55: #if defined(PETSC_HAVE_PTHREADCLASSES) && !defined(PETSC_PTHREAD_LOCAL)
56: pthread_key_t petscstack;
57: #endif
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(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: }
86: /*
87: PetscInitializeNoPointers - Calls PetscInitialize() from C/C++ without the pointers to argc and args
89: Collective
91: Level: advanced
93: Notes: this is called only by the PETSc MATLAB and Julia interface. Even though it might start MPI it sets the flag to
94: indicate that it did NOT start MPI so that the PetscFinalize() does not end MPI, thus allowing PetscInitialize() to
95: be called multiple times from MATLAB and Julia without the problem of trying to initialize MPI more than once.
97: Turns off PETSc signal handling because that can interact with MATLAB's signal handling causing random crashes.
99: .seealso: PetscInitialize(), PetscInitializeFortran(), PetscInitializeNoArguments()
100: */
101: PetscErrorCode PetscInitializeNoPointers(int argc,char **args,const char *filename,const char *help)
102: {
104: int myargc = argc;
105: char **myargs = args;
108: PetscInitialize(&myargc,&myargs,filename,help);
109: PetscPopSignalHandler();
110: PetscBeganMPI = PETSC_FALSE;
111: PetscFunctionReturn(ierr);
112: }
116: /*
117: Used by MATLAB and Julia interface to get communicator
118: */
119: PetscErrorCode PetscGetPETSC_COMM_SELF(MPI_Comm *comm)
120: {
122: *comm = PETSC_COMM_SELF;
123: return(0);
124: }
128: /*@C
129: PetscInitializeNoArguments - Calls PetscInitialize() from C/C++ without
130: the command line arguments.
132: Collective
134: Level: advanced
136: .seealso: PetscInitialize(), PetscInitializeFortran()
137: @*/
138: PetscErrorCode PetscInitializeNoArguments(void)
139: {
141: int argc = 0;
142: char **args = 0;
145: PetscInitialize(&argc,&args,NULL,NULL);
146: PetscFunctionReturn(ierr);
147: }
151: /*@
152: PetscInitialized - Determine whether PETSc is initialized.
154: Level: beginner
156: .seealso: PetscInitialize(), PetscInitializeNoArguments(), PetscInitializeFortran()
157: @*/
158: PetscErrorCode PetscInitialized(PetscBool *isInitialized)
159: {
160: *isInitialized = PetscInitializeCalled;
161: return 0;
162: }
166: /*@
167: PetscFinalized - Determine whether PetscFinalize() has been called yet
169: Level: developer
171: .seealso: PetscInitialize(), PetscInitializeNoArguments(), PetscInitializeFortran()
172: @*/
173: PetscErrorCode PetscFinalized(PetscBool *isFinalized)
174: {
175: *isFinalized = PetscFinalizeCalled;
176: return 0;
177: }
179: extern PetscErrorCode PetscOptionsCheckInitial_Private(void);
181: /*
182: This function is the MPI reduction operation used to compute the sum of the
183: first half of the datatype and the max of the second half.
184: */
185: MPI_Op PetscMaxSum_Op = 0;
189: PETSC_EXTERN void MPIAPI PetscMaxSum_Local(void *in,void *out,int *cnt,MPI_Datatype *datatype)
190: {
191: PetscInt *xin = (PetscInt*)in,*xout = (PetscInt*)out,i,count = *cnt;
194: if (*datatype != MPIU_2INT) {
195: (*PetscErrorPrintf)("Can only handle MPIU_2INT data types");
196: MPI_Abort(MPI_COMM_WORLD,1);
197: }
199: for (i=0; i<count; i++) {
200: xout[2*i] = PetscMax(xout[2*i],xin[2*i]);
201: xout[2*i+1] += xin[2*i+1];
202: }
203: PetscFunctionReturnVoid();
204: }
206: /*
207: Returns the max of the first entry owned by this processor and the
208: sum of the second entry.
210: The reason nprocs[2*i] contains lengths nprocs[2*i+1] contains flag of 1 if length is nonzero
211: is so that the PetscMaxSum_Op() can set TWO values, if we passed in only nprocs[i] with lengths
212: there would be no place to store the both needed results.
213: */
216: PetscErrorCode PetscMaxSum(MPI_Comm comm,const PetscInt nprocs[],PetscInt *max,PetscInt *sum)
217: {
218: PetscMPIInt size,rank;
219: struct {PetscInt max,sum;} *work;
223: MPI_Comm_size(comm,&size);
224: MPI_Comm_rank(comm,&rank);
225: PetscMalloc(size*sizeof(*work),&work);
226: MPI_Allreduce((void*)nprocs,work,size,MPIU_2INT,PetscMaxSum_Op,comm);
227: *max = work[rank].max;
228: *sum = work[rank].sum;
229: PetscFree(work);
230: return(0);
231: }
233: /* ----------------------------------------------------------------------------*/
234: MPI_Op PetscADMax_Op = 0;
238: PETSC_EXTERN void MPIAPI PetscADMax_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype)
239: {
240: PetscScalar *xin = (PetscScalar*)in,*xout = (PetscScalar*)out;
241: PetscInt i,count = *cnt;
244: if (*datatype != MPIU_2SCALAR) {
245: (*PetscErrorPrintf)("Can only handle MPIU_2SCALAR data (i.e. double or complex) types");
246: MPI_Abort(MPI_COMM_WORLD,1);
247: }
249: for (i=0; i<count; i++) {
250: if (PetscRealPart(xout[2*i]) < PetscRealPart(xin[2*i])) {
251: xout[2*i] = xin[2*i];
252: xout[2*i+1] = xin[2*i+1];
253: }
254: }
255: PetscFunctionReturnVoid();
256: }
258: MPI_Op PetscADMin_Op = 0;
262: PETSC_EXTERN void MPIAPI PetscADMin_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype)
263: {
264: PetscScalar *xin = (PetscScalar*)in,*xout = (PetscScalar*)out;
265: PetscInt i,count = *cnt;
268: if (*datatype != MPIU_2SCALAR) {
269: (*PetscErrorPrintf)("Can only handle MPIU_2SCALAR data (i.e. double or complex) types");
270: MPI_Abort(MPI_COMM_WORLD,1);
271: }
273: for (i=0; i<count; i++) {
274: if (PetscRealPart(xout[2*i]) > PetscRealPart(xin[2*i])) {
275: xout[2*i] = xin[2*i];
276: xout[2*i+1] = xin[2*i+1];
277: }
278: }
279: PetscFunctionReturnVoid();
280: }
281: /* ---------------------------------------------------------------------------------------*/
283: #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128)
284: MPI_Op MPIU_SUM = 0;
288: PETSC_EXTERN void PetscSum_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype)
289: {
290: PetscInt i,count = *cnt;
293: if (*datatype == MPIU_REAL) {
294: PetscReal *xin = (PetscReal*)in,*xout = (PetscReal*)out;
295: for (i=0; i<count; i++) xout[i] += xin[i];
296: }
297: #if defined(PETSC_HAVE_COMPLEX)
298: else if (*datatype == MPIU_COMPLEX) {
299: PetscComplex *xin = (PetscComplex*)in,*xout = (PetscComplex*)out;
300: for (i=0; i<count; i++) xout[i] += xin[i];
301: }
302: #endif
303: else {
304: (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types");
305: MPI_Abort(MPI_COMM_WORLD,1);
306: }
307: PetscFunctionReturnVoid();
308: }
309: #endif
311: #if defined(PETSC_USE_REAL___FLOAT128)
312: MPI_Op MPIU_MAX = 0;
313: MPI_Op MPIU_MIN = 0;
317: PETSC_EXTERN void PetscMax_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype)
318: {
319: PetscInt i,count = *cnt;
322: if (*datatype == MPIU_REAL) {
323: PetscReal *xin = (PetscReal*)in,*xout = (PetscReal*)out;
324: for (i=0; i<count; i++) xout[i] = PetscMax(xout[i],xin[i]);
325: }
326: #if defined(PETSC_HAVE_COMPLEX)
327: else if (*datatype == MPIU_COMPLEX) {
328: PetscComplex *xin = (PetscComplex*)in,*xout = (PetscComplex*)out;
329: for (i=0; i<count; i++) {
330: xout[i] = PetscRealPartComplex(xout[i])<PetscRealPartComplex(xin[i]) ? xin[i] : xout[i];
331: }
332: }
333: #endif
334: else {
335: (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_COMPLEX data types");
336: MPI_Abort(MPI_COMM_WORLD,1);
337: }
338: PetscFunctionReturnVoid();
339: }
343: PETSC_EXTERN void PetscMin_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype)
344: {
345: PetscInt i,count = *cnt;
348: if (*datatype == MPIU_REAL) {
349: PetscReal *xin = (PetscReal*)in,*xout = (PetscReal*)out;
350: for (i=0; i<count; i++) xout[i] = PetscMin(xout[i],xin[i]);
351: }
352: #if defined(PETSC_HAVE_COMPLEX)
353: else if (*datatype == MPIU_COMPLEX) {
354: PetscComplex *xin = (PetscComplex*)in,*xout = (PetscComplex*)out;
355: for (i=0; i<count; i++) {
356: xout[i] = PetscRealPartComplex(xout[i])>PetscRealPartComplex(xin[i]) ? xin[i] : xout[i];
357: }
358: }
359: #endif
360: else {
361: (*PetscErrorPrintf)("Can only handle MPIU_REAL or MPIU_SCALAR data (i.e. double or complex) types");
362: MPI_Abort(MPI_COMM_WORLD,1);
363: }
364: PetscFunctionReturnVoid();
365: }
366: #endif
370: /*
371: Private routine to delete internal tag/name counter storage when a communicator is freed.
373: 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.
375: Note: this is declared extern "C" because it is passed to MPI_Keyval_create()
377: */
378: PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelCounter(MPI_Comm comm,PetscMPIInt keyval,void *count_val,void *extra_state)
379: {
383: PetscInfo1(0,"Deleting counter data in an MPI_Comm %ld\n",(long)comm);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr);
384: PetscFree(count_val);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr);
385: PetscFunctionReturn(MPI_SUCCESS);
386: }
390: /*
391: This is invoked on the outer comm as a result of either PetscCommDestroy() (via MPI_Attr_delete) or when the user
392: calls MPI_Comm_free().
394: This is the only entry point for breaking the links between inner and outer comms.
396: This is called by MPI, not by users. This is called when MPI_Comm_free() is called on the communicator.
398: Note: this is declared extern "C" because it is passed to MPI_Keyval_create()
400: */
401: PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Outer(MPI_Comm comm,PetscMPIInt keyval,void *attr_val,void *extra_state)
402: {
404: PetscMPIInt flg;
405: union {MPI_Comm comm; void *ptr;} icomm,ocomm;
408: if (keyval != Petsc_InnerComm_keyval) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Unexpected keyval");
409: icomm.ptr = attr_val;
411: MPI_Attr_get(icomm.comm,Petsc_OuterComm_keyval,&ocomm,&flg);
412: if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected reference to outer comm");
413: if (ocomm.comm != comm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm has reference to non-matching outer comm");
414: MPI_Attr_delete(icomm.comm,Petsc_OuterComm_keyval); /* Calls Petsc_DelComm_Inner */
415: 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);
416: PetscFunctionReturn(MPI_SUCCESS);
417: }
421: /*
422: * This is invoked on the inner comm when Petsc_DelComm_Outer calls MPI_Attr_delete. It should not be reached any other way.
423: */
424: PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Inner(MPI_Comm comm,PetscMPIInt keyval,void *attr_val,void *extra_state)
425: {
429: PetscInfo1(0,"Removing reference to PETSc communicator embedded in a user MPI_Comm %ld\n",(long)comm);if (ierr) PetscFunctionReturn((PetscMPIInt)ierr);
430: PetscFunctionReturn(MPI_SUCCESS);
431: }
433: #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
434: #if !defined(PETSC_WORDS_BIGENDIAN)
435: PETSC_EXTERN PetscMPIInt PetscDataRep_extent_fn(MPI_Datatype,MPI_Aint*,void*);
436: PETSC_EXTERN PetscMPIInt PetscDataRep_read_conv_fn(void*, MPI_Datatype,PetscMPIInt,void*,MPI_Offset,void*);
437: PETSC_EXTERN PetscMPIInt PetscDataRep_write_conv_fn(void*, MPI_Datatype,PetscMPIInt,void*,MPI_Offset,void*);
438: #endif
439: #endif
441: int PetscGlobalArgc = 0;
442: char **PetscGlobalArgs = 0;
446: /*@C
447: PetscGetArgs - Allows you to access the raw command line arguments anywhere
448: after PetscInitialize() is called but before PetscFinalize().
450: Not Collective
452: Output Parameters:
453: + argc - count of number of command line arguments
454: - args - the command line arguments
456: Level: intermediate
458: Notes:
459: This is usually used to pass the command line arguments into other libraries
460: that are called internally deep in PETSc or the application.
462: The first argument contains the program name as is normal for C arguments.
464: Concepts: command line arguments
466: .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArguments()
468: @*/
469: PetscErrorCode PetscGetArgs(int *argc,char ***args)
470: {
472: if (!PetscInitializeCalled && PetscFinalizeCalled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"You must call after PetscInitialize() but before PetscFinalize()");
473: *argc = PetscGlobalArgc;
474: *args = PetscGlobalArgs;
475: return(0);
476: }
480: /*@C
481: PetscGetArguments - Allows you to access the command line arguments anywhere
482: after PetscInitialize() is called but before PetscFinalize().
484: Not Collective
486: Output Parameters:
487: . args - the command line arguments
489: Level: intermediate
491: Notes:
492: This does NOT start with the program name and IS null terminated (final arg is void)
494: Concepts: command line arguments
496: .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscFreeArguments()
498: @*/
499: PetscErrorCode PetscGetArguments(char ***args)
500: {
501: PetscInt i,argc = PetscGlobalArgc;
505: if (!PetscInitializeCalled && PetscFinalizeCalled) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ORDER,"You must call after PetscInitialize() but before PetscFinalize()");
506: if (!argc) {*args = 0; return(0);}
507: PetscMalloc(argc*sizeof(char*),args);
508: for (i=0; i<argc-1; i++) {
509: PetscStrallocpy(PetscGlobalArgs[i+1],&(*args)[i]);
510: }
511: (*args)[argc-1] = 0;
512: return(0);
513: }
517: /*@C
518: PetscFreeArguments - Frees the memory obtained with PetscGetArguments()
520: Not Collective
522: Output Parameters:
523: . args - the command line arguments
525: Level: intermediate
527: Concepts: command line arguments
529: .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscGetArguments()
531: @*/
532: PetscErrorCode PetscFreeArguments(char **args)
533: {
534: PetscInt i = 0;
538: if (!args) return(0);
539: while (args[i]) {
540: PetscFree(args[i]);
541: i++;
542: }
543: PetscFree(args);
544: return(0);
545: }
549: /*@C
550: PetscInitialize - Initializes the PETSc database and MPI.
551: PetscInitialize() calls MPI_Init() if that has yet to be called,
552: so this routine should always be called near the beginning of
553: your program -- usually the very first line!
555: Collective on MPI_COMM_WORLD or PETSC_COMM_WORLD if it has been set
557: Input Parameters:
558: + argc - count of number of command line arguments
559: . args - the command line arguments
560: . file - [optional] PETSc database file, also checks ~username/.petscrc and .petscrc use NULL to not check for
561: code specific file. Use -skip_petscrc in the code specific file to skip the .petscrc files
562: - help - [optional] Help message to print, use NULL for no message
564: If you wish PETSc code to run ONLY on a subcommunicator of MPI_COMM_WORLD, create that
565: communicator first and assign it to PETSC_COMM_WORLD BEFORE calling PetscInitialize(). Thus if you are running a
566: four process job and two processes will run PETSc and have PetscInitialize() and PetscFinalize() and two process will not,
567: then do this. If ALL processes in the job are using PetscInitialize() and PetscFinalize() then you don't need to do this, even
568: if different subcommunicators of the job are doing different things with PETSc.
570: Options Database Keys:
571: + -start_in_debugger [noxterm,dbx,xdb,gdb,...] - Starts program in debugger
572: . -on_error_attach_debugger [noxterm,dbx,xdb,gdb,...] - Starts debugger when error detected
573: . -on_error_emacs <machinename> causes emacsclient to jump to error file
574: . -on_error_abort calls abort() when error detected (no traceback)
575: . -on_error_mpiabort calls MPI_abort() when error detected
576: . -error_output_stderr prints error messages to stderr instead of the default stdout
577: . -error_output_none does not print the error messages (but handles errors in the same way as if this was not called)
578: . -debugger_nodes [node1,node2,...] - Indicates nodes to start in debugger
579: . -debugger_pause [sleeptime] (in seconds) - Pauses debugger
580: . -stop_for_debugger - Print message on how to attach debugger manually to
581: process and wait (-debugger_pause) seconds for attachment
582: . -malloc - Indicates use of PETSc error-checking malloc (on by default for debug version of libraries)
583: . -malloc no - Indicates not to use error-checking malloc
584: . -malloc_debug - check for memory corruption at EVERY malloc or free
585: . -malloc_test - like -malloc_dump -malloc_debug, but only active for debugging builds
586: . -fp_trap - Stops on floating point exceptions (Note that on the
587: IBM RS6000 this slows code by at least a factor of 10.)
588: . -no_signal_handler - Indicates not to trap error signals
589: . -shared_tmp - indicates /tmp directory is shared by all processors
590: . -not_shared_tmp - each processor has own /tmp
591: . -tmp - alternative name of /tmp directory
592: . -get_total_flops - returns total flops done by all processors
593: . -memory_info - Print memory usage at end of run
594: - -server <port> - start PETSc webserver (default port is 8080)
596: Options Database Keys for Profiling:
597: See the <a href="../../docs/manual.pdf#nameddest=Chapter 10 Profiling">profiling chapter of the users manual</a> for details.
598: + -info <optional filename> - Prints verbose information to the screen
599: . -info_exclude <null,vec,mat,pc,ksp,snes,ts> - Excludes some of the verbose messages
600: . -log_sync - Log the synchronization in scatters, inner products and norms
601: . -log_trace [filename] - Print traces of all PETSc calls to the screen (useful to determine where a program
602: hangs without running in the debugger). See PetscLogTraceBegin().
603: . -log_summary [filename] - Prints summary of flop and timing information to screen. If the filename is specified the
604: summary is written to the file. See PetscLogView().
605: . -log_summary_python [filename] - Prints data on of flop and timing usage to a file or screen. See PetscLogPrintSViewPython().
606: . -log_all [filename] - Logs extensive profiling information See PetscLogDump().
607: . -log [filename] - Logs basic profiline information See PetscLogDump().
608: - -log_mpe [filename] - Creates a logfile viewable by the utility Jumpshot (in MPICH distribution)
610: Only one of -log_trace, -log_summary, -log_all, -log, or -log_mpe may be used at a time
612: Environmental Variables:
613: + PETSC_TMP - alternative tmp directory
614: . PETSC_SHARED_TMP - tmp is shared by all processes
615: . PETSC_NOT_SHARED_TMP - each process has its own private tmp
616: . PETSC_VIEWER_SOCKET_PORT - socket number to use for socket viewer
617: - PETSC_VIEWER_SOCKET_MACHINE - machine to use for socket viewer to connect to
620: Level: beginner
622: Notes:
623: If for some reason you must call MPI_Init() separately, call
624: it before PetscInitialize().
626: Fortran Version:
627: In Fortran this routine has the format
628: $ call PetscInitialize(file,ierr)
630: + ierr - error return code
631: - file - [optional] PETSc database file, also checks ~username/.petscrc and .petscrc use NULL_CHARACTER to not check for
632: code specific file. Use -skip_petscrc in the code specific file to skip the .petscrc files
634: Important Fortran Note:
635: In Fortran, you MUST use NULL_CHARACTER to indicate a
636: null character string; you CANNOT just use NULL as
637: in the C version. See the <a href="../../docs/manual.pdf">users manual</a> for details.
639: If your main program is C but you call Fortran code that also uses PETSc you need to call PetscInitializeFortran() soon after
640: calling PetscInitialize().
642: Concepts: initializing PETSc
644: .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscInitializeNoArguments()
646: @*/
647: PetscErrorCode PetscInitialize(int *argc,char ***args,const char file[],const char help[])
648: {
650: PetscMPIInt flag, size;
651: PetscInt nodesize;
652: PetscBool flg;
653: char hostname[256];
656: if (PetscInitializeCalled) return(0);
658: /* these must be initialized in a routine, not as a constant declaration*/
659: PETSC_STDOUT = stdout;
660: PETSC_STDERR = stderr;
662: PetscOptionsCreate();
664: /*
665: We initialize the program name here (before MPI_Init()) because MPICH has a bug in
666: it that it sets args[0] on all processors to be args[0] on the first processor.
667: */
668: if (argc && *argc) {
669: PetscSetProgramName(**args);
670: } else {
671: PetscSetProgramName("Unknown Name");
672: }
674: MPI_Initialized(&flag);
675: if (!flag) {
676: 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");
677: #if defined(PETSC_HAVE_MPI_INIT_THREAD)
678: {
679: PetscMPIInt provided;
680: MPI_Init_thread(argc,args,MPI_THREAD_FUNNELED,&provided);
681: }
682: #else
683: MPI_Init(argc,args);
684: #endif
685: PetscBeganMPI = PETSC_TRUE;
686: }
687: if (argc && args) {
688: PetscGlobalArgc = *argc;
689: PetscGlobalArgs = *args;
690: }
691: PetscFinalizeCalled = PETSC_FALSE;
693: if (PETSC_COMM_WORLD == MPI_COMM_NULL) PETSC_COMM_WORLD = MPI_COMM_WORLD;
694: MPI_Comm_set_errhandler(PETSC_COMM_WORLD,MPI_ERRORS_RETURN);
696: /* Done after init due to a bug in MPICH-GM? */
697: PetscErrorPrintfInitialize();
699: MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank);
700: MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize);
702: MPIU_BOOL = MPI_INT;
703: MPIU_ENUM = MPI_INT;
705: /*
706: Initialized the global complex variable; this is because with
707: shared libraries the constructors for global variables
708: are not called; at least on IRIX.
709: */
710: #if defined(PETSC_HAVE_COMPLEX)
711: {
712: #if defined(PETSC_CLANGUAGE_CXX)
713: PetscComplex ic(0.0,1.0);
714: PETSC_i = ic;
715: #elif defined(PETSC_CLANGUAGE_C)
716: PETSC_i = _Complex_I;
717: #endif
718: }
720: #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)
721: MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU_C_DOUBLE_COMPLEX);
722: MPI_Type_commit(&MPIU_C_DOUBLE_COMPLEX);
723: MPI_Type_contiguous(2,MPI_FLOAT,&MPIU_C_COMPLEX);
724: MPI_Type_commit(&MPIU_C_COMPLEX);
725: #endif
726: #endif /* PETSC_HAVE_COMPLEX */
728: /*
729: Create the PETSc MPI reduction operator that sums of the first
730: half of the entries and maxes the second half.
731: */
732: MPI_Op_create(PetscMaxSum_Local,1,&PetscMaxSum_Op);
734: #if defined(PETSC_USE_REAL___FLOAT128)
735: MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU___FLOAT128);
736: MPI_Type_commit(&MPIU___FLOAT128);
737: #if defined(PETSC_HAVE_COMPLEX)
738: MPI_Type_contiguous(4,MPI_DOUBLE,&MPIU___COMPLEX128);
739: MPI_Type_commit(&MPIU___COMPLEX128);
740: #endif
741: MPI_Op_create(PetscMax_Local,1,&MPIU_MAX);
742: MPI_Op_create(PetscMin_Local,1,&MPIU_MIN);
743: #endif
745: #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128)
746: MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);
747: #endif
749: MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR);
750: MPI_Type_commit(&MPIU_2SCALAR);
751: MPI_Op_create(PetscADMax_Local,1,&PetscADMax_Op);
752: MPI_Op_create(PetscADMin_Local,1,&PetscADMin_Op);
754: #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT)
755: MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT);
756: MPI_Type_commit(&MPIU_2INT);
757: #endif
759: /*
760: Attributes to be set on PETSc communicators
761: */
762: MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelCounter,&Petsc_Counter_keyval,(void*)0);
763: MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Outer,&Petsc_InnerComm_keyval,(void*)0);
764: MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Inner,&Petsc_OuterComm_keyval,(void*)0);
766: /*
767: Build the options database
768: */
769: PetscOptionsInsert(argc,args,file);
772: /*
773: Print main application help message
774: */
775: PetscOptionsHasName(NULL,"-help",&flg);
776: if (help && flg) {
777: PetscPrintf(PETSC_COMM_WORLD,help);
778: }
779: PetscOptionsCheckInitial_Private();
781: /* SHOULD PUT IN GUARDS: Make sure logging is initialized, even if we do not print it out */
782: #if defined(PETSC_USE_LOG)
783: PetscLogBegin_Private();
784: #endif
786: /*
787: Load the dynamic libraries (on machines that support them), this registers all
788: the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes)
789: */
790: PetscInitialize_DynamicLibraries();
792: MPI_Comm_size(PETSC_COMM_WORLD,&size);
793: PetscInfo1(0,"PETSc successfully started: number of processors = %d\n",size);
794: PetscGetHostName(hostname,256);
795: PetscInfo1(0,"Running on machine: %s\n",hostname);
797: PetscOptionsCheckInitial_Components();
798: /* Check the options database for options related to the options database itself */
799: PetscOptionsSetFromOptions();
801: #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
802: /*
803: Tell MPI about our own data representation converter, this would/should be used if extern32 is not supported by the MPI
805: Currently not used because it is not supported by MPICH.
806: */
807: #if !defined(PETSC_WORDS_BIGENDIAN)
808: MPI_Register_datarep((char*)"petsc",PetscDataRep_read_conv_fn,PetscDataRep_write_conv_fn,PetscDataRep_extent_fn,NULL);
809: #endif
810: #endif
812: PetscOptionsGetInt(NULL,"-hmpi_spawn_size",&nodesize,&flg);
813: if (flg) {
814: #if defined(PETSC_HAVE_MPI_COMM_SPAWN)
815: PetscHMPISpawn((PetscMPIInt) nodesize); /* worker nodes never return from here; they go directly to PetscEnd() */
816: #else
817: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"PETSc built without MPI 2 (MPI_Comm_spawn) support, use -hmpi_merge_size instead");
818: #endif
819: } else {
820: PetscOptionsGetInt(NULL,"-hmpi_merge_size",&nodesize,&flg);
821: if (flg) {
822: PetscHMPIMerge((PetscMPIInt) nodesize,NULL,NULL);
823: if (PetscHMPIWorker) { /* if worker then never enter user code */
824: PetscInitializeCalled = PETSC_TRUE;
825: PetscEnd();
826: }
827: }
828: }
830: #if defined(PETSC_HAVE_CUDA)
831: {
832: PetscMPIInt p;
833: for (p = 0; p < PetscGlobalSize; ++p) {
834: if (p == PetscGlobalRank) cublasInit();
835: MPI_Barrier(PETSC_COMM_WORLD);
836: }
837: }
838: #endif
840: PetscOptionsHasName(NULL,"-python",&flg);
841: if (flg) {
842: PetscInitializeCalled = PETSC_TRUE;
843: PetscPythonInitialize(NULL,NULL);
844: }
846: PetscThreadCommInitializePackage();
848: /*
849: Setup building of stack frames for all function calls
850: */
851: #if defined(PETSC_USE_DEBUG)
852: PetscThreadLocalRegister((PetscThreadKey*)&petscstack); /* Creates petscstack_key if needed */
853: PetscStackCreate();
854: #endif
856: #if defined(PETSC_SERIALIZE_FUNCTIONS)
857: PetscFPTCreate(10000);
858: #endif
860: /*
861: Once we are completedly initialized then we can set this variables
862: */
863: PetscInitializeCalled = PETSC_TRUE;
864: return(0);
865: }
867: extern PetscObject *PetscObjects;
868: extern PetscInt PetscObjectsCounts, PetscObjectsMaxCounts;
872: /*@C
873: PetscFinalize - Checks for options to be called at the conclusion
874: of the program. MPI_Finalize() is called only if the user had not
875: called MPI_Init() before calling PetscInitialize().
877: Collective on PETSC_COMM_WORLD
879: Options Database Keys:
880: + -options_table - Calls PetscOptionsView()
881: . -options_left - Prints unused options that remain in the database
882: . -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
883: . -mpidump - Calls PetscMPIDump()
884: . -malloc_dump - Calls PetscMallocDump()
885: . -malloc_info - Prints total memory usage
886: - -malloc_log - Prints summary of memory usage
888: Level: beginner
890: Note:
891: See PetscInitialize() for more general runtime options.
893: .seealso: PetscInitialize(), PetscOptionsView(), PetscMallocDump(), PetscMPIDump(), PetscEnd()
894: @*/
895: PetscErrorCode PetscFinalize(void)
896: {
898: PetscMPIInt rank;
899: PetscInt nopt;
900: PetscBool flg1 = PETSC_FALSE,flg2 = PETSC_FALSE,flg3 = PETSC_FALSE;
901: #if defined(PETSC_HAVE_AMS)
902: PetscBool flg = PETSC_FALSE;
903: #endif
904: #if defined(PETSC_USE_LOG)
905: char mname[PETSC_MAX_PATH_LEN];
906: #endif
909: if (!PetscInitializeCalled) {
910: printf("PetscInitialize() must be called before PetscFinalize()\n");
911: PetscFunctionReturn(PETSC_ERR_ARG_WRONGSTATE);
912: }
913: PetscInfo(NULL,"PetscFinalize() called\n");
915: #if defined(PETSC_SERIALIZE_FUNCTIONS)
916: PetscFPTDestroy();
917: #endif
920: #if defined(PETSC_HAVE_AMS)
921: PetscOptionsGetBool(NULL,"-options_gui",&flg,NULL);
922: if (flg) {
923: PetscOptionsAMSDestroy();
924: }
925: #endif
927: #if defined(PETSC_HAVE_SERVER)
928: flg1 = PETSC_FALSE;
929: PetscOptionsGetBool(NULL,"-server",&flg1,NULL);
930: if (flg1) {
931: /* this is a crude hack, but better than nothing */
932: PetscPOpen(PETSC_COMM_WORLD,NULL,"pkill -9 petscwebserver","r",NULL);
933: }
934: #endif
936: PetscHMPIFinalize();
938: MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
939: PetscOptionsGetBool(NULL,"-malloc_info",&flg2,NULL);
940: if (!flg2) {
941: flg2 = PETSC_FALSE;
942: PetscOptionsGetBool(NULL,"-memory_info",&flg2,NULL);
943: }
944: if (flg2) {
945: PetscMemoryShowUsage(PETSC_VIEWER_STDOUT_WORLD,"Summary of Memory Usage in PETSc\n");
946: }
948: #if defined(PETSC_USE_LOG)
949: flg1 = PETSC_FALSE;
950: PetscOptionsGetBool(NULL,"-get_total_flops",&flg1,NULL);
951: if (flg1) {
952: PetscLogDouble flops = 0;
953: MPI_Reduce(&petsc_TotalFlops,&flops,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);
954: PetscPrintf(PETSC_COMM_WORLD,"Total flops over all processors %g\n",flops);
955: }
956: #endif
959: #if defined(PETSC_USE_LOG)
960: #if defined(PETSC_HAVE_MPE)
961: mname[0] = 0;
963: PetscOptionsGetString(NULL,"-log_mpe",mname,PETSC_MAX_PATH_LEN,&flg1);
964: if (flg1) {
965: if (mname[0]) {PetscLogMPEDump(mname);}
966: else {PetscLogMPEDump(0);}
967: }
968: #endif
969: mname[0] = 0;
971: PetscOptionsGetString(NULL,"-log_summary",mname,PETSC_MAX_PATH_LEN,&flg1);
972: if (flg1) {
973: PetscViewer viewer;
974: if (mname[0]) {
975: PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);
976: PetscLogView(viewer);
977: PetscViewerDestroy(&viewer);
978: } else {
979: viewer = PETSC_VIEWER_STDOUT_WORLD;
980: PetscLogView(viewer);
981: }
982: }
984: mname[0] = 0;
986: PetscOptionsGetString(NULL,"-log_summary_python",mname,PETSC_MAX_PATH_LEN,&flg1);
987: if (flg1) {
988: PetscViewer viewer;
989: if (mname[0]) {
990: PetscViewerASCIIOpen(PETSC_COMM_WORLD,mname,&viewer);
991: PetscLogViewPython(viewer);
992: PetscViewerDestroy(&viewer);
993: } else {
994: viewer = PETSC_VIEWER_STDOUT_WORLD;
995: PetscLogViewPython(viewer);
996: }
997: }
999: PetscOptionsGetString(NULL,"-log_detailed",mname,PETSC_MAX_PATH_LEN,&flg1);
1000: if (flg1) {
1001: if (mname[0]) {PetscLogPrintDetailed(PETSC_COMM_WORLD,mname);}
1002: else {PetscLogPrintDetailed(PETSC_COMM_WORLD,0);}
1003: }
1005: mname[0] = 0;
1007: PetscOptionsGetString(NULL,"-log_all",mname,PETSC_MAX_PATH_LEN,&flg1);
1008: PetscOptionsGetString(NULL,"-log",mname,PETSC_MAX_PATH_LEN,&flg2);
1009: if (flg1 || flg2) {
1010: if (mname[0]) PetscLogDump(mname);
1011: else PetscLogDump(0);
1012: }
1013: #endif
1015: /*
1016: Free all objects registered with PetscObjectRegisterDestroy() such as PETSC_VIEWER_XXX_().
1017: */
1018: PetscObjectRegisterDestroyAll();
1020: PetscStackDestroy();
1022: flg1 = PETSC_FALSE;
1023: PetscOptionsGetBool(NULL,"-no_signal_handler",&flg1,NULL);
1024: if (!flg1) { PetscPopSignalHandler();}
1025: flg1 = PETSC_FALSE;
1026: PetscOptionsGetBool(NULL,"-mpidump",&flg1,NULL);
1027: if (flg1) {
1028: PetscMPIDump(stdout);
1029: }
1030: flg1 = PETSC_FALSE;
1031: flg2 = PETSC_FALSE;
1032: /* preemptive call to avoid listing this option in options table as unused */
1033: PetscOptionsHasName(NULL,"-malloc_dump",&flg1);
1034: PetscOptionsHasName(NULL,"-objects_dump",&flg1);
1035: PetscOptionsGetBool(NULL,"-options_table",&flg2,NULL);
1037: if (flg2) {
1038: PetscViewer viewer;
1039: PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);
1040: PetscOptionsView(viewer);
1041: PetscViewerDestroy(&viewer);
1042: }
1044: /* to prevent PETSc -options_left from warning */
1045: PetscOptionsHasName(NULL,"-nox",&flg1);
1046: PetscOptionsHasName(NULL,"-nox_warning",&flg1);
1048: if (!PetscHMPIWorker) { /* worker processes skip this because they do not usually process options */
1049: flg3 = PETSC_FALSE; /* default value is required */
1050: PetscOptionsGetBool(NULL,"-options_left",&flg3,&flg1);
1051: PetscOptionsAllUsed(&nopt);
1052: if (flg3) {
1053: if (!flg2) { /* have not yet printed the options */
1054: PetscViewer viewer;
1055: PetscViewerASCIIGetStdout(PETSC_COMM_WORLD,&viewer);
1056: PetscOptionsView(viewer);
1057: PetscViewerDestroy(&viewer);
1058: }
1059: if (!nopt) {
1060: PetscPrintf(PETSC_COMM_WORLD,"There are no unused options.\n");
1061: } else if (nopt == 1) {
1062: PetscPrintf(PETSC_COMM_WORLD,"There is one unused database option. It is:\n");
1063: } else {
1064: PetscPrintf(PETSC_COMM_WORLD,"There are %D unused database options. They are:\n",nopt);
1065: }
1066: }
1067: #if defined(PETSC_USE_DEBUG)
1068: if (nopt && !flg3 && !flg1) {
1069: PetscPrintf(PETSC_COMM_WORLD,"WARNING! There are options you set that were not used!\n");
1070: PetscPrintf(PETSC_COMM_WORLD,"WARNING! could be spelling mistake, etc!\n");
1071: PetscOptionsLeft();
1072: } else if (nopt && flg3) {
1073: #else
1074: if (nopt && flg3) {
1075: #endif
1076: PetscOptionsLeft();
1077: }
1078: }
1080: {
1081: PetscThreadComm tcomm_world;
1082: PetscGetThreadCommWorld(&tcomm_world);
1083: /* Free global thread communicator */
1084: PetscThreadCommDestroy(&tcomm_world);
1085: }
1087: /*
1088: List all objects the user may have forgot to free
1089: */
1090: PetscOptionsHasName(NULL,"-objects_dump",&flg1);
1091: if (flg1) {
1092: MPI_Comm local_comm;
1093: char string[64];
1095: PetscOptionsGetString(NULL,"-objects_dump",string,64,NULL);
1096: MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);
1097: PetscSequentialPhaseBegin_Private(local_comm,1);
1098: PetscObjectsDump(stdout,(string[0] == 'a') ? PETSC_TRUE : PETSC_FALSE);
1099: PetscSequentialPhaseEnd_Private(local_comm,1);
1100: MPI_Comm_free(&local_comm);
1101: }
1102: PetscObjectsCounts = 0;
1103: PetscObjectsMaxCounts = 0;
1105: PetscFree(PetscObjects);
1107: #if defined(PETSC_USE_LOG)
1108: PetscLogDestroy();
1109: #endif
1111: /*
1112: Destroy any packages that registered a finalize
1113: */
1114: PetscRegisterFinalizeAll();
1116: /*
1117: Destroy all the function registration lists created
1118: */
1119: PetscFinalize_DynamicLibraries();
1121: /*
1122: Print PetscFunctionLists that have not been properly freed
1124: PetscFunctionListPrintAll();
1125: */
1127: if (petsc_history) {
1128: PetscCloseHistoryFile(&petsc_history);
1129: petsc_history = 0;
1130: }
1132: PetscInfoAllow(PETSC_FALSE,NULL);
1134: {
1135: char fname[PETSC_MAX_PATH_LEN];
1136: FILE *fd;
1137: int err;
1139: fname[0] = 0;
1141: PetscOptionsGetString(NULL,"-malloc_dump",fname,250,&flg1);
1142: flg2 = PETSC_FALSE;
1143: PetscOptionsGetBool(NULL,"-malloc_test",&flg2,NULL);
1144: #if defined(PETSC_USE_DEBUG)
1145: if (PETSC_RUNNING_ON_VALGRIND) flg2 = PETSC_FALSE;
1146: #else
1147: flg2 = PETSC_FALSE; /* Skip reporting for optimized builds regardless of -malloc_test */
1148: #endif
1149: if (flg1 && fname[0]) {
1150: char sname[PETSC_MAX_PATH_LEN];
1152: sprintf(sname,"%s_%d",fname,rank);
1153: fd = fopen(sname,"w"); if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname);
1154: PetscMallocDump(fd);
1155: err = fclose(fd);
1156: if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
1157: } else if (flg1 || flg2) {
1158: MPI_Comm local_comm;
1160: MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);
1161: PetscSequentialPhaseBegin_Private(local_comm,1);
1162: PetscMallocDump(stdout);
1163: PetscSequentialPhaseEnd_Private(local_comm,1);
1164: MPI_Comm_free(&local_comm);
1165: }
1166: }
1168: {
1169: char fname[PETSC_MAX_PATH_LEN];
1170: FILE *fd = NULL;
1172: fname[0] = 0;
1174: PetscOptionsGetString(NULL,"-malloc_log",fname,250,&flg1);
1175: PetscOptionsHasName(NULL,"-malloc_log_threshold",&flg2);
1176: if (flg1 && fname[0]) {
1177: int err;
1179: if (!rank) {
1180: fd = fopen(fname,"w");
1181: if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",fname);
1182: }
1183: PetscMallocDumpLog(fd);
1184: if (fd) {
1185: err = fclose(fd);
1186: if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fclose() failed on file");
1187: }
1188: } else if (flg1 || flg2) {
1189: PetscMallocDumpLog(stdout);
1190: }
1191: }
1192: /* Can be destroyed only after all the options are used */
1193: PetscOptionsDestroy();
1195: PetscGlobalArgc = 0;
1196: PetscGlobalArgs = 0;
1198: #if defined(PETSC_USE_REAL___FLOAT128)
1199: MPI_Type_free(&MPIU___FLOAT128);
1200: #if defined(PETSC_HAVE_COMPLEX)
1201: MPI_Type_free(&MPIU___COMPLEX128);
1202: #endif
1203: MPI_Op_free(&MPIU_MAX);
1204: MPI_Op_free(&MPIU_MIN);
1205: #endif
1207: #if defined(PETSC_HAVE_COMPLEX)
1208: #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)
1209: MPI_Type_free(&MPIU_C_DOUBLE_COMPLEX);
1210: MPI_Type_free(&MPIU_C_COMPLEX);
1211: #endif
1212: #endif
1214: #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128)
1215: MPI_Op_free(&MPIU_SUM);
1216: #endif
1218: MPI_Type_free(&MPIU_2SCALAR);
1219: #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT)
1220: MPI_Type_free(&MPIU_2INT);
1221: #endif
1222: MPI_Op_free(&PetscMaxSum_Op);
1223: MPI_Op_free(&PetscADMax_Op);
1224: MPI_Op_free(&PetscADMin_Op);
1226: /*
1227: Destroy any known inner MPI_Comm's and attributes pointing to them
1228: Note this will not destroy any new communicators the user has created.
1230: If all PETSc objects were not destroyed those left over objects will have hanging references to
1231: the MPI_Comms that were freed; but that is ok because those PETSc objects will never be used again
1232: */
1233: {
1234: PetscCommCounter *counter;
1235: PetscMPIInt flg;
1236: MPI_Comm icomm;
1237: union {MPI_Comm comm; void *ptr;} ucomm;
1238: MPI_Attr_get(PETSC_COMM_SELF,Petsc_InnerComm_keyval,&ucomm,&flg);
1239: if (flg) {
1240: icomm = ucomm.comm;
1241: MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);
1242: if (!flg) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1244: MPI_Attr_delete(PETSC_COMM_SELF,Petsc_InnerComm_keyval);
1245: MPI_Attr_delete(icomm,Petsc_Counter_keyval);
1246: MPI_Comm_free(&icomm);
1247: }
1248: MPI_Attr_get(PETSC_COMM_WORLD,Petsc_InnerComm_keyval,&ucomm,&flg);
1249: if (flg) {
1250: icomm = ucomm.comm;
1251: MPI_Attr_get(icomm,Petsc_Counter_keyval,&counter,&flg);
1252: if (!flg) SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_ARG_CORRUPT,"Inner MPI_Comm does not have expected tag/name counter, problem with corrupted memory");
1254: MPI_Attr_delete(PETSC_COMM_WORLD,Petsc_InnerComm_keyval);
1255: MPI_Attr_delete(icomm,Petsc_Counter_keyval);
1256: MPI_Comm_free(&icomm);
1257: }
1258: }
1260: MPI_Keyval_free(&Petsc_Counter_keyval);
1261: MPI_Keyval_free(&Petsc_InnerComm_keyval);
1262: MPI_Keyval_free(&Petsc_OuterComm_keyval);
1264: #if defined(PETSC_HAVE_CUDA)
1265: {
1266: PetscInt p;
1267: for (p = 0; p < PetscGlobalSize; ++p) {
1268: if (p == PetscGlobalRank) cublasShutdown();
1269: MPI_Barrier(PETSC_COMM_WORLD);
1270: }
1271: }
1272: #endif
1274: if (PetscBeganMPI) {
1275: #if defined(PETSC_HAVE_MPI_FINALIZED)
1276: PetscMPIInt flag;
1277: MPI_Finalized(&flag);
1278: if (flag) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"MPI_Finalize() has already been called, even though MPI_Init() was called by PetscInitialize()");
1279: #endif
1280: MPI_Finalize();
1281: }
1282: /*
1284: Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because
1285: the communicator has some outstanding requests on it. Specifically if the
1286: flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See
1287: src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate()
1288: is never freed as it should be. Thus one may obtain messages of the form
1289: [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the
1290: memory was not freed.
1292: */
1293: PetscMallocClear();
1295: PetscInitializeCalled = PETSC_FALSE;
1296: PetscFinalizeCalled = PETSC_TRUE;
1297: PetscFunctionReturn(ierr);
1298: }
1300: #if defined(PETSC_MISSING_LAPACK_lsame_)
1301: PETSC_EXTERN int lsame_(char *a,char *b)
1302: {
1303: if (*a == *b) return 1;
1304: if (*a + 32 == *b) return 1;
1305: if (*a - 32 == *b) return 1;
1306: return 0;
1307: }
1308: #endif
1310: #if defined(PETSC_MISSING_LAPACK_lsame)
1311: PETSC_EXTERN int lsame(char *a,char *b)
1312: {
1313: if (*a == *b) return 1;
1314: if (*a + 32 == *b) return 1;
1315: if (*a - 32 == *b) return 1;
1316: return 0;
1317: }
1318: #endif