xref: /petsc/src/sys/objects/pinit.c (revision aa5bb8c05f5e82794e9434b48d44e54c07b222a5)
1 #define PETSC_DLL
2 /*
3    This file defines the initialization of PETSc, including PetscInitialize()
4 */
5 
6 #include "petsc.h"        /*I  "petsc.h"   I*/
7 #include "petscsys.h"
8 
9 #if defined(PETSC_USE_LOG)
10 EXTERN PetscErrorCode PetscLogBegin_Private(void);
11 #endif
12 
13 /* -----------------------------------------------------------------------------------------*/
14 
15 extern FILE *petsc_history;
16 
17 EXTERN PetscErrorCode PetscInitialize_DynamicLibraries(void);
18 EXTERN PetscErrorCode PetscFinalize_DynamicLibraries(void);
19 EXTERN PetscErrorCode PetscFListDestroyAll(void);
20 EXTERN PetscErrorCode PetscSequentialPhaseBegin_Private(MPI_Comm,int);
21 EXTERN PetscErrorCode PetscSequentialPhaseEnd_Private(MPI_Comm,int);
22 EXTERN PetscErrorCode PetscLogCloseHistoryFile(FILE **);
23 EXTERN PetscErrorCode PetscOptionsHelpDestroyList(void);
24 
25 /* this is used by the _, __, and ___ macros (see include/petscerror.h) */
26 PetscErrorCode __gierr = 0;
27 
28 /* user may set this BEFORE calling PetscInitialize() */
29 MPI_Comm PETSC_COMM_WORLD = 0;
30 
31 /*
32      Declare and set all the string names of the PETSc enums
33 */
34 const char *PetscTruths[]    = {"FALSE","TRUE","PetscTruth","PETSC_",0};
35 const char *PetscDataTypes[] = {"INT", "DOUBLE", "COMPLEX",
36                                 "LONG","SHORT",  "FLOAT",
37                                 "CHAR","LOGICAL","ENUM","TRUTH","LONGDOUBLE","PetscDataType","PETSC_",0};
38 
39 PetscCookie PETSC_LARGEST_COOKIE = PETSC_SMALLEST_COOKIE;
40 PetscCookie PETSC_OBJECT_COOKIE = 0;
41 
42 PetscTruth PetscPreLoadingUsed = PETSC_FALSE;
43 PetscTruth PetscPreLoadingOn   = PETSC_FALSE;
44 
45 PetscErrorCode PETSC_DLLEXPORT PetscCookieRegister(PetscCookie *cookie)
46 {
47   *cookie = ++PETSC_LARGEST_COOKIE;
48   return 0;
49 }
50 
51 /*
52        Checks the options database for initializations related to the
53     PETSc components
54 */
55 #undef __FUNCT__
56 #define __FUNCT__ "PetscOptionsCheckInitial_Components"
57 PetscErrorCode PETSC_DLLEXPORT PetscOptionsCheckInitial_Components(void)
58 {
59   PetscTruth flg1;
60   PetscErrorCode ierr;
61 
62   PetscFunctionBegin;
63   ierr = PetscOptionsHasName(PETSC_NULL,"-help",&flg1);CHKERRQ(ierr);
64   if (flg1) {
65 #if defined (PETSC_USE_LOG)
66     MPI_Comm   comm = PETSC_COMM_WORLD;
67     ierr = (*PetscHelpPrintf)(comm,"------Additional PETSc component options--------\n");CHKERRQ(ierr);
68     ierr = (*PetscHelpPrintf)(comm," -log_summary_exclude: <vec,mat,pc.ksp,snes>\n");CHKERRQ(ierr);
69     ierr = (*PetscHelpPrintf)(comm," -info_exclude: <null,vec,mat,pc,ksp,snes,ts>\n");CHKERRQ(ierr);
70     ierr = (*PetscHelpPrintf)(comm,"-----------------------------------------------\n");CHKERRQ(ierr);
71 #endif
72   }
73   PetscFunctionReturn(0);
74 }
75 
76 #undef __FUNCT__
77 #define __FUNCT__ "PetscInitializeNoArguments"
78 /*@C
79       PetscInitializeNoArguments - Calls PetscInitialize() from C/C++ without
80         the command line arguments.
81 
82    Collective
83 
84    Level: advanced
85 
86 .seealso: PetscInitialize(), PetscInitializeFortran()
87 @*/
88 PetscErrorCode PETSC_DLLEXPORT PetscInitializeNoArguments(void)
89 {
90   PetscErrorCode ierr;
91   int            argc = 0;
92   char           **args = 0;
93 
94   PetscFunctionBegin;
95   ierr = PetscInitialize(&argc,&args,PETSC_NULL,PETSC_NULL);
96   PetscFunctionReturn(ierr);
97 }
98 
99 #undef __FUNCT__
100 #define __FUNCT__ "PetscInitialized"
101 /*@
102       PetscInitialized - Determine whether PETSc is initialized.
103 
104    Level: beginner
105 
106 .seealso: PetscInitialize(), PetscInitializeNoArguments(), PetscInitializeFortran()
107 @*/
108 PetscErrorCode PETSC_DLLEXPORT PetscInitialized(PetscTruth *isInitialized)
109 {
110   PetscFunctionBegin;
111   PetscValidPointer(isInitialized, 1);
112   *isInitialized = PetscInitializeCalled;
113   PetscFunctionReturn(0);
114 }
115 
116 #undef __FUNCT__
117 #define __FUNCT__ "PetscFinalized"
118 /*@
119       PetscFinalized - Determine whether PetscFinalize() has been called yet
120 
121    Level: developer
122 
123 .seealso: PetscInitialize(), PetscInitializeNoArguments(), PetscInitializeFortran()
124 @*/
125 PetscErrorCode PETSC_DLLEXPORT PetscFinalized(PetscTruth *isFinalized)
126 {
127   PetscFunctionBegin;
128   PetscValidPointer(isFinalized, 1);
129   *isFinalized = PetscFinalizeCalled;
130   PetscFunctionReturn(0);
131 }
132 
133 EXTERN PetscErrorCode        PetscOptionsCheckInitial_Private(void);
134 extern PetscTruth PetscBeganMPI;
135 
136 /*
137        This function is the MPI reduction operation used to compute the sum of the
138    first half of the datatype and the max of the second half.
139 */
140 MPI_Op PetscMaxSum_Op = 0;
141 
142 EXTERN_C_BEGIN
143 #undef __FUNCT__
144 #define __FUNCT__ "PetscMaxSum_Local"
145 void PETSC_DLLEXPORT PetscMaxSum_Local(void *in,void *out,int *cnt,MPI_Datatype *datatype)
146 {
147   PetscInt *xin = (PetscInt*)in,*xout = (PetscInt*)out,i,count = *cnt;
148 
149   PetscFunctionBegin;
150   if (*datatype != MPIU_2INT) {
151     (*PetscErrorPrintf)("Can only handle MPIU_2INT data types");
152     MPI_Abort(MPI_COMM_WORLD,1);
153   }
154 
155   for (i=0; i<count; i++) {
156     xout[2*i]    = PetscMax(xout[2*i],xin[2*i]);
157     xout[2*i+1] += xin[2*i+1];
158   }
159   PetscStackPop;
160   return;
161 }
162 EXTERN_C_END
163 
164 /*
165     Returns the max of the first entry owned by this processor and the
166 sum of the second entry.
167 */
168 #undef __FUNCT__
169 #define __FUNCT__ "PetscMaxSum"
170 PetscErrorCode PETSC_DLLEXPORT PetscMaxSum(MPI_Comm comm,const PetscInt nprocs[],PetscInt *max,PetscInt *sum)
171 {
172   PetscMPIInt    size,rank;
173   PetscInt       *work;
174   PetscErrorCode ierr;
175 
176   PetscFunctionBegin;
177   ierr   = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
178   ierr   = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
179   ierr   = PetscMalloc(2*size*sizeof(PetscInt),&work);CHKERRQ(ierr);
180   ierr   = MPI_Allreduce((void*)nprocs,work,size,MPIU_2INT,PetscMaxSum_Op,comm);CHKERRQ(ierr);
181   *max   = work[2*rank];
182   *sum   = work[2*rank+1];
183   ierr   = PetscFree(work);CHKERRQ(ierr);
184   PetscFunctionReturn(0);
185 }
186 
187 /* ----------------------------------------------------------------------------*/
188 MPI_Op PETSC_DLLEXPORT PetscADMax_Op = 0;
189 
190 EXTERN_C_BEGIN
191 #undef __FUNCT__
192 #define __FUNCT__ "PetscADMax_Local"
193 void PETSC_DLLEXPORT PetscADMax_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype)
194 {
195   PetscScalar *xin = (PetscScalar *)in,*xout = (PetscScalar*)out;
196   PetscInt    i,count = *cnt;
197 
198   PetscFunctionBegin;
199   if (*datatype != MPIU_2SCALAR) {
200     (*PetscErrorPrintf)("Can only handle MPIU_2SCALAR data (i.e. double or complex) types");
201     MPI_Abort(MPI_COMM_WORLD,1);
202   }
203 
204   for (i=0; i<count; i++) {
205     if (PetscRealPart(xout[2*i]) < PetscRealPart(xin[2*i])) {
206       xout[2*i]   = xin[2*i];
207       xout[2*i+1] = xin[2*i+1];
208     }
209   }
210 
211   PetscStackPop;
212   return;
213 }
214 EXTERN_C_END
215 
216 MPI_Op PETSC_DLLEXPORT PetscADMin_Op = 0;
217 
218 EXTERN_C_BEGIN
219 #undef __FUNCT__
220 #define __FUNCT__ "PetscADMin_Local"
221 void PETSC_DLLEXPORT PetscADMin_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype)
222 {
223   PetscScalar *xin = (PetscScalar *)in,*xout = (PetscScalar*)out;
224   PetscInt    i,count = *cnt;
225 
226   PetscFunctionBegin;
227   if (*datatype != MPIU_2SCALAR) {
228     (*PetscErrorPrintf)("Can only handle MPIU_2SCALAR data (i.e. double or complex) types");
229     MPI_Abort(MPI_COMM_WORLD,1);
230   }
231 
232   for (i=0; i<count; i++) {
233     if (PetscRealPart(xout[2*i]) > PetscRealPart(xin[2*i])) {
234       xout[2*i]   = xin[2*i];
235       xout[2*i+1] = xin[2*i+1];
236     }
237   }
238 
239   PetscStackPop;
240   return;
241 }
242 EXTERN_C_END
243 /* ---------------------------------------------------------------------------------------*/
244 
245 #if defined(PETSC_USE_COMPLEX)
246 MPI_Op PetscSum_Op = 0;
247 
248 EXTERN_C_BEGIN
249 #undef __FUNCT__
250 #define __FUNCT__ "PetscSum_Local"
251 void PETSC_DLLEXPORT PetscSum_Local(void *in,void *out,PetscMPIInt *cnt,MPI_Datatype *datatype)
252 {
253   PetscScalar *xin = (PetscScalar *)in,*xout = (PetscScalar*)out;
254   PetscInt         i,count = *cnt;
255 
256   PetscFunctionBegin;
257   if (*datatype != MPIU_SCALAR) {
258     (*PetscErrorPrintf)("Can only handle MPIU_SCALAR data (i.e. double or complex) types");
259     MPI_Abort(MPI_COMM_WORLD,1);
260   }
261 
262   for (i=0; i<count; i++) {
263     xout[i] += xin[i];
264   }
265 
266   PetscStackPop;
267   return;
268 }
269 EXTERN_C_END
270 #endif
271 
272 static int  PetscGlobalArgc   = 0;
273 static char **PetscGlobalArgs = 0;
274 
275 #undef __FUNCT__
276 #define __FUNCT__ "PetscGetArgs"
277 /*@C
278    PetscGetArgs - Allows you to access the raw command line arguments anywhere
279      after PetscInitialize() is called but before PetscFinalize().
280 
281    Not Collective
282 
283    Output Parameters:
284 +  argc - count of number of command line arguments
285 -  args - the command line arguments
286 
287    Level: intermediate
288 
289    Notes:
290       This is usually used to pass the command line arguments into other libraries
291    that are called internally deep in PETSc or the application.
292 
293    Concepts: command line arguments
294 
295 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArguments()
296 
297 @*/
298 PetscErrorCode PETSC_DLLEXPORT PetscGetArgs(int *argc,char ***args)
299 {
300   PetscFunctionBegin;
301   if (!PetscGlobalArgs) {
302     SETERRQ(PETSC_ERR_ORDER,"You must call after PetscInitialize() but before PetscFinalize()");
303   }
304   *argc = PetscGlobalArgc;
305   *args = PetscGlobalArgs;
306   PetscFunctionReturn(0);
307 }
308 
309 #undef __FUNCT__
310 #define __FUNCT__ "PetscGetArguments"
311 /*@C
312    PetscGetArguments - Allows you to access the  command line arguments anywhere
313      after PetscInitialize() is called but before PetscFinalize().
314 
315    Not Collective
316 
317    Output Parameters:
318 .  args - the command line arguments
319 
320    Level: intermediate
321 
322    Notes:
323       This does NOT start with the program name and IS null terminated (final arg is void)
324 
325    Concepts: command line arguments
326 
327 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscFreeArguments()
328 
329 @*/
330 PetscErrorCode PETSC_DLLEXPORT PetscGetArguments(char ***args)
331 {
332   PetscInt       i,argc = PetscGlobalArgc;
333   PetscErrorCode ierr;
334 
335   PetscFunctionBegin;
336   if (!PetscGlobalArgs) {
337     SETERRQ(PETSC_ERR_ORDER,"You must call after PetscInitialize() but before PetscFinalize()");
338   }
339   ierr = PetscMalloc(argc*sizeof(char*),args);CHKERRQ(ierr);
340   for (i=0; i<argc-1; i++) {
341     ierr = PetscStrallocpy(PetscGlobalArgs[i+1],&(*args)[i]);CHKERRQ(ierr);
342   }
343   (*args)[argc-1] = 0;
344   PetscFunctionReturn(0);
345 }
346 
347 #undef __FUNCT__
348 #define __FUNCT__ "PetscFreeArguments"
349 /*@C
350    PetscFreeArguments - Frees the memory obtained with PetscGetArguments()
351 
352    Not Collective
353 
354    Output Parameters:
355 .  args - the command line arguments
356 
357    Level: intermediate
358 
359    Concepts: command line arguments
360 
361 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs(), PetscGetArguments()
362 
363 @*/
364 PetscErrorCode PETSC_DLLEXPORT PetscFreeArguments(char **args)
365 {
366   PetscInt       i = 0;
367   PetscErrorCode ierr;
368 
369   PetscFunctionBegin;
370   while (args[i]) {
371     ierr = PetscFree(args[i]);CHKERRQ(ierr);
372     i++;
373   }
374   ierr = PetscFree(args);CHKERRQ(ierr);
375   PetscFunctionReturn(0);
376 }
377 
378 #undef __FUNCT__
379 #define __FUNCT__ "PetscInitialize"
380 /*@C
381    PetscInitialize - Initializes the PETSc database and MPI.
382    PetscInitialize() calls MPI_Init() if that has yet to be called,
383    so this routine should always be called near the beginning of
384    your program -- usually the very first line!
385 
386    Collective on MPI_COMM_WORLD or PETSC_COMM_WORLD if it has been set
387 
388    Input Parameters:
389 +  argc - count of number of command line arguments
390 .  args - the command line arguments
391 .  file - [optional] PETSc database file, also checks ~username/.petscrc and .petscrc use PETSC_NULL to not check for
392           code specific file. Use -skip_petscrc in the code specific file to skip the .petscrc files
393 -  help - [optional] Help message to print, use PETSC_NULL for no message
394 
395    If you wish PETSc to run on a subcommunicator of MPI_COMM_WORLD, create that
396    communicator first and assign it to PETSC_COMM_WORLD BEFORE calling PetscInitialize()
397 
398    Options Database Keys:
399 +  -start_in_debugger [noxterm,dbx,xdb,gdb,...] - Starts program in debugger
400 .  -on_error_attach_debugger [noxterm,dbx,xdb,gdb,...] - Starts debugger when error detected
401 .  -on_error_emacs <machinename> causes emacsclient to jump to error file
402 .  -on_error_abort calls abort() when error detected (no traceback)
403 .  -on_error_mpiabort calls MPI_abort() when error detected
404 .  -error_output_stderr prints error messages to stderr instead of the default stdout
405 .  -error_output_none does not print the error messages (but handles errors in the same way as if this was not called)
406 .  -debugger_nodes [node1,node2,...] - Indicates nodes to start in debugger
407 .  -debugger_pause [sleeptime] (in seconds) - Pauses debugger
408 .  -stop_for_debugger - Print message on how to attach debugger manually to
409                         process and wait (-debugger_pause) seconds for attachment
410 .  -malloc - Indicates use of PETSc error-checking malloc (on by default for debug version of libraries)
411 .  -malloc no - Indicates not to use error-checking malloc
412 .  -malloc_debug - check for memory corruption at EVERY malloc or free
413 .  -fp_trap - Stops on floating point exceptions (Note that on the
414               IBM RS6000 this slows code by at least a factor of 10.)
415 .  -no_signal_handler - Indicates not to trap error signals
416 .  -shared_tmp - indicates /tmp directory is shared by all processors
417 .  -not_shared_tmp - each processor has own /tmp
418 .  -tmp - alternative name of /tmp directory
419 .  -get_total_flops - returns total flops done by all processors
420 -  -memory_info - Print memory usage at end of run
421 
422    Options Database Keys for Profiling:
423    See the Profiling chapter of the users manual for details.
424 +  -log_trace [filename] - Print traces of all PETSc calls
425         to the screen (useful to determine where a program
426         hangs without running in the debugger).  See PetscLogTraceBegin().
427 .  -info <optional filename> - Prints verbose information to the screen
428 -  -info_exclude <null,vec,mat,pc,ksp,snes,ts> - Excludes some of the verbose messages
429 
430    Environmental Variables:
431 +   PETSC_TMP - alternative tmp directory
432 .   PETSC_SHARED_TMP - tmp is shared by all processes
433 .   PETSC_NOT_SHARED_TMP - each process has its own private tmp
434 .   PETSC_VIEWER_SOCKET_PORT - socket number to use for socket viewer
435 -   PETSC_VIEWER_SOCKET_MACHINE - machine to use for socket viewer to connect to
436 
437 
438    Level: beginner
439 
440    Notes:
441    If for some reason you must call MPI_Init() separately, call
442    it before PetscInitialize().
443 
444    Fortran Version:
445    In Fortran this routine has the format
446 $       call PetscInitialize(file,ierr)
447 
448 +   ierr - error return code
449 -  file - [optional] PETSc database file, also checks ~username/.petscrc and .petscrc use PETSC_CHARACTER_NULL to not check for
450           code specific file. Use -skip_petscrc in the code specific file to skip the .petscrc files
451 
452    Important Fortran Note:
453    In Fortran, you MUST use PETSC_NULL_CHARACTER to indicate a
454    null character string; you CANNOT just use PETSC_NULL as
455    in the C version.  See the users manual for details.
456 
457 
458    Concepts: initializing PETSc
459 
460 .seealso: PetscFinalize(), PetscInitializeFortran(), PetscGetArgs()
461 
462 @*/
463 PetscErrorCode PETSC_DLLEXPORT PetscInitialize(int *argc,char ***args,const char file[],const char help[])
464 {
465   PetscErrorCode ierr;
466   PetscMPIInt    flag, size;
467   PetscInt       nodesize;
468   PetscTruth     flg;
469   char           hostname[256];
470 
471   PetscFunctionBegin;
472   if (PetscInitializeCalled) PetscFunctionReturn(0);
473 
474   /* these must be initialized in a routine, not as a constant declaration*/
475   PETSC_STDOUT = stdout;
476   PETSC_STDERR = stderr;
477 
478   ierr = PetscOptionsCreate();CHKERRQ(ierr);
479 
480   /*
481      We initialize the program name here (before MPI_Init()) because MPICH has a bug in
482      it that it sets args[0] on all processors to be args[0] on the first processor.
483   */
484   if (argc && *argc) {
485     ierr = PetscSetProgramName(**args);CHKERRQ(ierr);
486   } else {
487     ierr = PetscSetProgramName("Unknown Name");CHKERRQ(ierr);
488   }
489 
490 
491   ierr = MPI_Initialized(&flag);CHKERRQ(ierr);
492   if (!flag) {
493     if (PETSC_COMM_WORLD) SETERRQ(PETSC_ERR_SUP,"You cannot set PETSC_COMM_WORLD if you have not initialized MPI first");
494     ierr          = MPI_Init(argc,args);CHKERRQ(ierr);
495     PetscBeganMPI = PETSC_TRUE;
496   }
497   if (argc && args) {
498     PetscGlobalArgc = *argc;
499     PetscGlobalArgs = *args;
500   }
501   PetscInitializeCalled = PETSC_TRUE;
502   PetscFinalizeCalled   = PETSC_FALSE;
503 
504   if (!PETSC_COMM_WORLD) {
505     PETSC_COMM_WORLD = MPI_COMM_WORLD;
506   }
507 
508   /* Done after init due to a bug in MPICH-GM? */
509   ierr = PetscErrorPrintfInitialize();CHKERRQ(ierr);
510 
511   ierr = MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank);CHKERRQ(ierr);
512   ierr = MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize);CHKERRQ(ierr);
513 
514 #if defined(PETSC_USE_COMPLEX)
515   /*
516      Initialized the global complex variable; this is because with
517      shared libraries the constructors for global variables
518      are not called; at least on IRIX.
519   */
520   {
521 #if defined(PETSC_CLANGUAGE_CXX)
522     PetscScalar ic(0.0,1.0);
523     PETSC_i = ic;
524 #else
525     PetscScalar ic;
526     ic = 1.I;
527     PETSC_i = ic;
528 #endif
529   }
530 
531   ierr = MPI_Type_contiguous(2,MPIU_REAL,&MPIU_COMPLEX);CHKERRQ(ierr);
532   ierr = MPI_Type_commit(&MPIU_COMPLEX);CHKERRQ(ierr);
533   ierr = MPI_Op_create(PetscSum_Local,1,&PetscSum_Op);CHKERRQ(ierr);
534 #endif
535 
536   /*
537      Create the PETSc MPI reduction operator that sums of the first
538      half of the entries and maxes the second half.
539   */
540   ierr = MPI_Op_create(PetscMaxSum_Local,1,&PetscMaxSum_Op);CHKERRQ(ierr);
541 
542   ierr = MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR);CHKERRQ(ierr);
543   ierr = MPI_Type_commit(&MPIU_2SCALAR);CHKERRQ(ierr);
544   ierr = MPI_Op_create(PetscADMax_Local,1,&PetscADMax_Op);CHKERRQ(ierr);
545   ierr = MPI_Op_create(PetscADMin_Local,1,&PetscADMin_Op);CHKERRQ(ierr);
546 
547   ierr = MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT);CHKERRQ(ierr);
548   ierr = MPI_Type_commit(&MPIU_2INT);CHKERRQ(ierr);
549 
550   /*
551      Build the options database
552   */
553   ierr = PetscOptionsInsert(argc,args,file);CHKERRQ(ierr);
554 
555   /*
556      Print main application help message
557   */
558   ierr = PetscOptionsHasName(PETSC_NULL,"-help",&flg);CHKERRQ(ierr);
559   if (help && flg) {
560     ierr = PetscPrintf(PETSC_COMM_WORLD,help);CHKERRQ(ierr);
561   }
562   ierr = PetscOptionsCheckInitial_Private();CHKERRQ(ierr);
563 
564   /* SHOULD PUT IN GUARDS: Make sure logging is initialized, even if we do not print it out */
565 #if defined(PETSC_USE_LOG)
566   ierr = PetscLogBegin_Private();CHKERRQ(ierr);
567 #endif
568 
569   /*
570      Load the dynamic libraries (on machines that support them), this registers all
571      the solvers etc. (On non-dynamic machines this initializes the PetscDraw and PetscViewer classes)
572   */
573   ierr = PetscInitialize_DynamicLibraries();CHKERRQ(ierr);
574 
575   ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
576   ierr = PetscInfo1(0,"PETSc successfully started: number of processors = %d\n",size);CHKERRQ(ierr);
577   ierr = PetscGetHostName(hostname,256);CHKERRQ(ierr);
578   ierr = PetscInfo1(0,"Running on machine: %s\n",hostname);CHKERRQ(ierr);
579 
580   ierr = PetscOptionsCheckInitial_Components();CHKERRQ(ierr);
581   /* Check the options database for options related to the options database itself */
582   ierr = PetscOptionsSetFromOptions(); CHKERRQ(ierr);
583 
584   ierr = PetscOptionsGetInt(PETSC_NULL,"-openmp_spawn_size",&nodesize,&flg);CHKERRQ(ierr);
585   if (flg) {
586 #if defined(PETSC_HAVE_MPI_COMM_SPAWN)
587     ierr = PetscOpenMPSpawn((PetscMPIInt) nodesize);CHKERRQ(ierr);
588 #else
589     SETERRQ(PETSC_ERR_SUP,"PETSc built without MPI 2 (MPI_Comm_spawn) support, use -openmp_merge_size instead");
590 #endif
591   } else {
592     ierr = PetscOptionsGetInt(PETSC_NULL,"-openmp_merge_size",&nodesize,&flg);CHKERRQ(ierr);
593     if (flg) {
594       ierr = PetscOpenMPMerge((PetscMPIInt) nodesize);CHKERRQ(ierr);
595     }
596   }
597 
598   PetscFunctionReturn(ierr);
599 }
600 
601 
602 #undef __FUNCT__
603 #define __FUNCT__ "PetscFinalize"
604 /*@C
605    PetscFinalize - Checks for options to be called at the conclusion
606    of the program. MPI_Finalize() is called only if the user had not
607    called MPI_Init() before calling PetscInitialize().
608 
609    Collective on PETSC_COMM_WORLD
610 
611    Options Database Keys:
612 +  -options_table - Calls PetscOptionsPrint()
613 .  -options_left - Prints unused options that remain in the database
614 .  -options_left no - Does not print unused options that remain in the database
615 .  -mpidump - Calls PetscMPIDump()
616 .  -malloc_dump - Calls PetscMallocDump()
617 .  -malloc_info - Prints total memory usage
618 -  -malloc_log - Prints summary of memory usage
619 
620    Options Database Keys for Profiling:
621    See the Profiling chapter of the users manual for details.
622 +  -log_summary [filename] - Prints summary of flop and timing
623         information to screen. If the filename is specified the
624         summary is written to the file. (for code compiled with
625         PETSC_USE_LOG).  See PetscLogPrintSummary().
626 .  -log_all [filename] - Logs extensive profiling information
627         (for code compiled with PETSC_USE_LOG). See PetscLogDump().
628 .  -log [filename] - Logs basic profiline information (for
629         code compiled with PETSC_USE_LOG).  See PetscLogDump().
630 .  -log_sync - Log the synchronization in scatters, inner products
631         and norms
632 -  -log_mpe [filename] - Creates a logfile viewable by the
633       utility Upshot/Nupshot (in MPICH distribution)
634 
635    Level: beginner
636 
637    Note:
638    See PetscInitialize() for more general runtime options.
639 
640 .seealso: PetscInitialize(), PetscOptionsPrint(), PetscMallocDump(), PetscMPIDump(), PetscEnd()
641 @*/
642 PetscErrorCode PETSC_DLLEXPORT PetscFinalize(void)
643 {
644   PetscErrorCode ierr;
645   PetscMPIInt    rank;
646   int            nopt;
647   PetscTruth     flg1,flg2,flg3;
648 
649   PetscFunctionBegin;
650 
651   if (!PetscInitializeCalled) {
652     (*PetscErrorPrintf)("PetscInitialize() must be called before PetscFinalize()\n");
653     PetscFunctionReturn(0);
654   }
655   ierr = PetscOpenMPFinalize();CHKERRQ(ierr);
656 
657   ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
658   ierr = PetscOptionsHasName(PETSC_NULL,"-malloc_info",&flg2);CHKERRQ(ierr);
659   if (!flg2) {
660     ierr = PetscOptionsHasName(PETSC_NULL,"-memory_info",&flg2);CHKERRQ(ierr);
661   }
662   if (flg2) {
663     ierr = PetscMemoryShowUsage(PETSC_VIEWER_STDOUT_WORLD,"Summary of Memory Usage in PETSc\n");CHKERRQ(ierr);
664   }
665 
666   /* Destroy auxiliary packages */
667 #if defined(PETSC_HAVE_MATHEMATICA)
668   ierr = PetscViewerMathematicaFinalizePackage();CHKERRQ(ierr);
669 #endif
670 #if defined(PETSC_USE_DYNAMIC_LIBRARIES)
671 #if defined(PETSC_HAVE_SIEVE)
672   {
673     PetscErrorCode (*func)(void);
674     char lib[PETSC_MAX_PATH_LEN];
675 
676     ierr = PetscStrcpy(lib,"${PETSC_LIB_DIR}");CHKERRQ(ierr);
677     ierr = PetscStrcat(lib,"/libpetscdm");CHKERRQ(ierr);
678     ierr = PetscDLLibrarySym(PETSC_COMM_WORLD,&DLLibrariesLoaded,lib,"DMFinalizePackage",(void **) &func);CHKERRQ(ierr);
679     if (func) {
680       ierr = (*func)();CHKERRQ(ierr);
681     }
682   }
683 #endif
684 #endif
685 
686   /*
687      Destroy all the function registration lists created
688   */
689   ierr = PetscFinalize_DynamicLibraries();CHKERRQ(ierr);
690 
691 #if defined(PETSC_USE_LOG)
692   ierr = PetscOptionsHasName(PETSC_NULL,"-get_total_flops",&flg1);CHKERRQ(ierr);
693   if (flg1) {
694     PetscLogDouble flops = 0;
695     ierr = MPI_Reduce(&_TotalFlops,&flops,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRQ(ierr);
696     ierr = PetscPrintf(PETSC_COMM_WORLD,"Total flops over all processors %g\n",flops);CHKERRQ(ierr);
697   }
698 #endif
699 
700   /*
701      Free all objects registered with PetscObjectRegisterDestroy() such ast
702     PETSC_VIEWER_XXX_().
703   */
704   ierr = PetscObjectRegisterDestroyAll();CHKERRQ(ierr);
705   ierr = PetscOptionsHelpDestroyList();CHKERRQ(ierr);
706 
707 #if defined(PETSC_USE_DEBUG)
708   if (PetscStackActive) {
709     ierr = PetscStackDestroy();CHKERRQ(ierr);
710   }
711 #endif
712 
713 #if defined(PETSC_USE_LOG)
714   {
715     char mname[PETSC_MAX_PATH_LEN];
716 #if defined(PETSC_HAVE_MPE)
717     mname[0] = 0;
718     ierr = PetscOptionsGetString(PETSC_NULL,"-log_mpe",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
719     if (flg1){
720       if (mname[0]) {ierr = PetscLogMPEDump(mname);CHKERRQ(ierr);}
721       else          {ierr = PetscLogMPEDump(0);CHKERRQ(ierr);}
722     }
723 #endif
724     mname[0] = 0;
725     ierr = PetscOptionsGetString(PETSC_NULL,"-log_summary",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
726     if (flg1) {
727       if (mname[0])  {ierr = PetscLogPrintSummary(PETSC_COMM_WORLD,mname);CHKERRQ(ierr);}
728       else           {ierr = PetscLogPrintSummary(PETSC_COMM_WORLD,0);CHKERRQ(ierr);}
729     }
730 
731     ierr = PetscOptionsGetString(PETSC_NULL,"-log_detailed",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
732     if (flg1) {
733       if (mname[0])  {ierr = PetscLogPrintDetailed(PETSC_COMM_WORLD,mname);CHKERRQ(ierr);}
734       else           {ierr = PetscLogPrintDetailed(PETSC_COMM_WORLD,0);CHKERRQ(ierr);}
735     }
736 
737     mname[0] = 0;
738     ierr = PetscOptionsGetString(PETSC_NULL,"-log_all",mname,PETSC_MAX_PATH_LEN,&flg1);CHKERRQ(ierr);
739     ierr = PetscOptionsGetString(PETSC_NULL,"-log",mname,PETSC_MAX_PATH_LEN,&flg2);CHKERRQ(ierr);
740     if (flg1 || flg2){
741       if (mname[0]) PetscLogDump(mname);
742       else          PetscLogDump(0);
743     }
744     ierr = PetscLogDestroy();CHKERRQ(ierr);
745   }
746 #endif
747   ierr = PetscOptionsHasName(PETSC_NULL,"-no_signal_handler",&flg1);CHKERRQ(ierr);
748   if (!flg1) { ierr = PetscPopSignalHandler();CHKERRQ(ierr);}
749   ierr = PetscOptionsHasName(PETSC_NULL,"-mpidump",&flg1);CHKERRQ(ierr);
750   if (flg1) {
751     ierr = PetscMPIDump(stdout);CHKERRQ(ierr);
752   }
753   ierr = PetscOptionsHasName(PETSC_NULL,"-malloc_dump",&flg1);CHKERRQ(ierr);
754   ierr = PetscOptionsHasName(PETSC_NULL,"-options_table",&flg2);CHKERRQ(ierr);
755   if (flg2) {
756     if (!rank) {ierr = PetscOptionsPrint(stdout);CHKERRQ(ierr);}
757   }
758 
759   /* to prevent PETSc -options_left from warning */
760   ierr = PetscOptionsHasName(PETSC_NULL,"-nox",&flg1);CHKERRQ(ierr)
761   ierr = PetscOptionsHasName(PETSC_NULL,"-nox_warning",&flg1);CHKERRQ(ierr)
762 
763   flg3 = PETSC_FALSE; /* default value is required */
764   ierr = PetscOptionsGetTruth(PETSC_NULL,"-options_left",&flg3,&flg1);CHKERRQ(ierr);
765   ierr = PetscOptionsAllUsed(&nopt);CHKERRQ(ierr);
766   if (flg3) {
767     if (!flg2) { /* have not yet printed the options */
768       ierr = PetscOptionsPrint(stdout);CHKERRQ(ierr);
769     }
770     if (!nopt) {
771       ierr = PetscPrintf(PETSC_COMM_WORLD,"There are no unused options.\n");CHKERRQ(ierr);
772     } else if (nopt == 1) {
773       ierr = PetscPrintf(PETSC_COMM_WORLD,"There is one unused database option. It is:\n");CHKERRQ(ierr);
774     } else {
775       ierr = PetscPrintf(PETSC_COMM_WORLD,"There are %d unused database options. They are:\n",nopt);CHKERRQ(ierr);
776     }
777   }
778 #if defined(PETSC_USE_DEBUG)
779   if (nopt && !flg3 && !flg1) {
780     ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! There are options you set that were not used!\n");CHKERRQ(ierr);
781     ierr = PetscPrintf(PETSC_COMM_WORLD,"WARNING! could be spelling mistake, etc!\n");CHKERRQ(ierr);
782     ierr = PetscOptionsLeft();CHKERRQ(ierr);
783   } else if (nopt && flg3) {
784 #else
785   if (nopt && flg3) {
786 #endif
787     ierr = PetscOptionsLeft();CHKERRQ(ierr);
788   }
789 
790   ierr = PetscOptionsHasName(PETSC_NULL,"-log_history",&flg1);CHKERRQ(ierr);
791   if (flg1) {
792     ierr = PetscLogCloseHistoryFile(&petsc_history);CHKERRQ(ierr);
793     petsc_history = 0;
794   }
795 
796   ierr = PetscInfoAllow(PETSC_FALSE,PETSC_NULL);CHKERRQ(ierr);
797 
798   /*
799        Free all the registered create functions, such as KSPList, VecList, SNESList, etc
800   */
801   ierr = PetscFListDestroyAll();CHKERRQ(ierr);
802 
803   ierr = PetscOptionsHasName(PETSC_NULL,"-malloc_dump",&flg1);CHKERRQ(ierr);
804   ierr = PetscOptionsHasName(PETSC_NULL,"-malloc_log",&flg3);CHKERRQ(ierr);
805   if (flg1) {
806     char fname[PETSC_MAX_PATH_LEN];
807     FILE *fd;
808 
809     fname[0] = 0;
810     ierr = PetscOptionsGetString(PETSC_NULL,"-malloc_dump",fname,250,&flg1);CHKERRQ(ierr);
811     if (flg1 && fname[0]) {
812       char sname[PETSC_MAX_PATH_LEN];
813 
814       sprintf(sname,"%s_%d",fname,rank);
815       fd   = fopen(sname,"w"); if (!fd) SETERRQ1(PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname);
816       ierr = PetscMallocDump(fd);CHKERRQ(ierr);
817       fclose(fd);
818     } else {
819       MPI_Comm local_comm;
820 
821       ierr = MPI_Comm_dup(MPI_COMM_WORLD,&local_comm);CHKERRQ(ierr);
822       ierr = PetscSequentialPhaseBegin_Private(local_comm,1);CHKERRQ(ierr);
823         ierr = PetscMallocDump(stdout);CHKERRQ(ierr);
824       ierr = PetscSequentialPhaseEnd_Private(local_comm,1);CHKERRQ(ierr);
825       ierr = MPI_Comm_free(&local_comm);CHKERRQ(ierr);
826     }
827   }
828   if (flg3) {
829     char fname[PETSC_MAX_PATH_LEN];
830     FILE *fd;
831 
832     fname[0] = 0;
833     ierr = PetscOptionsGetString(PETSC_NULL,"-malloc_log",fname,250,&flg1);CHKERRQ(ierr);
834     if (flg1 && fname[0]) {
835       char sname[PETSC_MAX_PATH_LEN];
836 
837       sprintf(sname,"%s_%d",fname,rank);
838       fd   = fopen(sname,"w"); if (!fd) SETERRQ1(PETSC_ERR_FILE_OPEN,"Cannot open log file: %s",sname);
839       ierr = PetscMallocDumpLog(fd);CHKERRQ(ierr);
840       fclose(fd);
841     } else {
842       ierr = PetscMallocDumpLog(stdout);CHKERRQ(ierr);
843     }
844   }
845   /* Can be destroyed only after all the options are used */
846   ierr = PetscOptionsDestroy();CHKERRQ(ierr);
847 
848   PetscGlobalArgc = 0;
849   PetscGlobalArgs = 0;
850 
851 #if defined(PETSC_USE_COMPLEX)
852   ierr = MPI_Op_free(&PetscSum_Op);CHKERRQ(ierr);
853   ierr = MPI_Type_free(&MPIU_COMPLEX);CHKERRQ(ierr);
854 #endif
855   ierr = MPI_Type_free(&MPIU_2SCALAR);CHKERRQ(ierr);
856   ierr = MPI_Type_free(&MPIU_2INT);CHKERRQ(ierr);
857   ierr = MPI_Op_free(&PetscMaxSum_Op);CHKERRQ(ierr);
858   ierr = MPI_Op_free(&PetscADMax_Op);CHKERRQ(ierr);
859   ierr = MPI_Op_free(&PetscADMin_Op);CHKERRQ(ierr);
860 
861   ierr = PetscInfo(0,"PETSc successfully ended!\n");CHKERRQ(ierr);
862   if (PetscBeganMPI) {
863     ierr = MPI_Finalize();CHKERRQ(ierr);
864   }
865 
866 /*
867 
868      Note: In certain cases PETSC_COMM_WORLD is never MPI_Comm_free()ed because
869    the communicator has some outstanding requests on it. Specifically if the
870    flag PETSC_HAVE_BROKEN_REQUEST_FREE is set (for IBM MPI implementation). See
871    src/vec/utils/vpscat.c. Due to this the memory allocated in PetscCommDuplicate()
872    is never freed as it should be. Thus one may obtain messages of the form
873    [ 1] 8 bytes PetscCommDuplicate() line 645 in src/sys/mpiu.c indicating the
874    memory was not freed.
875 
876 */
877   ierr = PetscClearMalloc();CHKERRQ(ierr);
878   PetscInitializeCalled = PETSC_FALSE;
879   PetscFinalizeCalled   = PETSC_TRUE;
880   PetscFunctionReturn(ierr);
881 }
882 
883 /*
884      These may be used in code that ADIC is to be used on
885 */
886 
887 #undef __FUNCT__
888 #define __FUNCT__ "PetscGlobalMax"
889 /*@C
890       PetscGlobalMax - Computes the maximum value over several processors
891 
892      Collective on MPI_Comm
893 
894    Input Parameters:
895 +   local - the local value
896 -   comm - the processors that find the maximum
897 
898    Output Parameter:
899 .   result - the maximum value
900 
901    Level: intermediate
902 
903    Notes:
904      These functions are to be used inside user functions that are to be processed with
905    ADIC. PETSc will automatically provide differentiated versions of these functions
906 
907 .seealso: PetscGlobalMin(), PetscGlobalSum()
908 @*/
909 PetscErrorCode PETSC_DLLEXPORT PetscGlobalMax(PetscReal* local,PetscReal* result,MPI_Comm comm)
910 {
911   return MPI_Allreduce(local,result,1,MPIU_REAL,MPI_MAX,comm);
912 }
913 
914 #undef __FUNCT__
915 #define __FUNCT__ "PetscGlobalMin"
916 /*@C
917       PetscGlobalMin - Computes the minimum value over several processors
918 
919      Collective on MPI_Comm
920 
921    Input Parameters:
922 +   local - the local value
923 -   comm - the processors that find the minimum
924 
925    Output Parameter:
926 .   result - the minimum value
927 
928    Level: intermediate
929 
930    Notes:
931      These functions are to be used inside user functions that are to be processed with
932    ADIC. PETSc will automatically provide differentiated versions of these functions
933 
934 .seealso: PetscGlobalMax(), PetscGlobalSum()
935 @*/
936 PetscErrorCode PETSC_DLLEXPORT PetscGlobalMin(PetscReal* local,PetscReal* result,MPI_Comm comm)
937 {
938   return MPI_Allreduce(local,result,1,MPIU_REAL,MPI_MIN,comm);
939 }
940 
941 #undef __FUNCT__
942 #define __FUNCT__ "PetscGlobalSum"
943 /*@C
944       PetscGlobalSum - Computes the sum over sever processors
945 
946      Collective on MPI_Comm
947 
948    Input Parameters:
949 +   local - the local value
950 -   comm - the processors that find the sum
951 
952    Output Parameter:
953 .   result - the sum
954 
955    Level: intermediate
956 
957    Notes:
958      These functions are to be used inside user functions that are to be processed with
959    ADIC. PETSc will automatically provide differentiated versions of these functions
960 
961 .seealso: PetscGlobalMin(), PetscGlobalMax()
962 @*/
963 PetscErrorCode PETSC_DLLEXPORT PetscGlobalSum(PetscScalar* local,PetscScalar* result,MPI_Comm comm)
964 {
965   return MPI_Allreduce(local,result,1,MPIU_SCALAR,PetscSum_Op,comm);
966 }
967 
968 
969