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