1 /* 2 This file contains Fortran stubs for PetscInitialize and Finalize. 3 */ 4 5 /* 6 This is to prevent the Cray T3D version of MPI (University of Edinburgh) 7 from stupidly redefining MPI_INIT(). They put this in to detect errors 8 in C code,but here I do want to be calling the Fortran version from a 9 C subroutine. 10 */ 11 #define T3DMPI_FORTRAN 12 #define T3EMPI_FORTRAN 13 14 #include <petsc/private/fortranimpl.h> 15 16 #if defined(PETSC_HAVE_FORTRAN_CAPS) 17 #define petscinitialize_ PETSCINITIALIZE 18 #define petscinitializenoarguments_ PETSCINITIALIZENOARGUMENTS 19 #define petscfinalize_ PETSCFINALIZE 20 #define petscend_ PETSCEND 21 #define iargc_ IARGC 22 #define getarg_ GETARG 23 #define mpi_init_ MPI_INIT 24 #define petscgetcomm_ PETSCGETCOMM 25 #define petsccommandargumentcount_ PETSCCOMMANDARGUMENTCOUNT 26 #define petscgetcommandargument_ PETSCGETCOMMANDARGUMENT 27 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 28 #define petscinitialize_ petscinitialize 29 #define petscinitializenoarguments_ petscinitializenoarguments 30 #define petscfinalize_ petscfinalize 31 #define petscend_ petscend 32 #define mpi_init_ mpi_init 33 #define iargc_ iargc 34 #define getarg_ getarg 35 #define petscgetcomm_ petscgetcomm 36 #define petsccommandargumentcount_ petsccommandargumentcount 37 #define petscgetcommandargument_ petscgetcommandargument 38 #endif 39 40 #if defined(PETSC_HAVE_NAGF90) 41 #undef iargc_ 42 #undef getarg_ 43 #define iargc_ f90_unix_MP_iargc 44 #define getarg_ f90_unix_MP_getarg 45 #endif 46 #if defined(PETSC_USE_NARGS) /* Digital Fortran */ 47 #undef iargc_ 48 #undef getarg_ 49 #define iargc_ NARGS 50 #define getarg_ GETARG 51 #elif defined(PETSC_HAVE_PXFGETARG_NEW) /* cray x1 */ 52 #undef iargc_ 53 #undef getarg_ 54 #define iargc_ ipxfargc_ 55 #define getarg_ pxfgetarg_ 56 #endif 57 #if defined(PETSC_HAVE_FORTRAN_IARGC_UNDERSCORE) /* HPUX + no underscore */ 58 #undef iargc_ 59 #undef getarg_ 60 #define iargc_ iargc_ 61 #define getarg_ getarg_ 62 #endif 63 64 #if defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* Fortran 2003 */ 65 #undef iargc_ 66 #undef getarg_ 67 #define iargc_ petsccommandargumentcount_ 68 #define getarg_ petscgetcommandargument_ 69 #elif defined(PETSC_HAVE__GFORTRAN_IARGC) /* gfortran from gcc4 */ 70 #undef iargc_ 71 #undef getarg_ 72 #define iargc_ _gfortran_iargc 73 #define getarg_ _gfortran_getarg_i4 74 #elif defined(PETSC_HAVE_BGL_IARGC) /* bgl g77 has different external & internal name mangling */ 75 #undef iargc_ 76 #undef getarg_ 77 #define iargc iargc_ 78 #define getarg getarg_ 79 #endif 80 81 /* 82 The extra _ is because the f2c compiler puts an 83 extra _ at the end if the original routine name 84 contained any _. 85 */ 86 #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE) 87 #define mpi_init_ mpi_init__ 88 #endif 89 90 #if defined(PETSC_HAVE_MPIUNI) 91 #if defined(mpi_init_) 92 #undef mpi_init_ 93 #if defined(PETSC_HAVE_FORTRAN_CAPS) 94 #define mpi_init_ PETSC_MPI_INIT 95 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 96 #define mpi_init_ petsc_mpi_init 97 #elif defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE) 98 #define mpi_init_ petsc_mpi_init__ 99 #endif 100 #else /* mpi_init_ */ 101 #define mpi_init_ petsc_mpi_init_ 102 #endif /* mpi_init_ */ 103 #endif /* PETSC_HAVE_MPIUNI */ 104 105 PETSC_EXTERN void mpi_init_(int*); 106 PETSC_EXTERN void petscgetcomm_(PetscMPIInt*); 107 108 /* 109 Different Fortran compilers handle command lines in different ways 110 */ 111 #if defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* Fortran 2003 - same as 'else' case */ 112 PETSC_EXTERN int iargc_(void); 113 PETSC_EXTERN void getarg_(int*,char*,int); 114 #elif defined(PETSC_USE_NARGS) 115 PETSC_EXTERN short __stdcall NARGS(); 116 PETSC_EXTERN void __stdcall GETARG(short*,char*,int,short *); 117 118 #elif defined(PETSC_HAVE_PXFGETARG_NEW) 119 PETSC_EXTERN int iargc_(); 120 PETSC_EXTERN void getarg_(int*,char*,int*,int*,int); 121 122 #else 123 PETSC_EXTERN int iargc_(); 124 PETSC_EXTERN void getarg_(int*,char*,int); 125 /* 126 The Cray T3D/T3E use the PXFGETARG() function 127 */ 128 #if defined(PETSC_HAVE_PXFGETARG) 129 PETSC_EXTERN void PXFGETARG(int*,_fcd,int*,int*); 130 #endif 131 #endif 132 133 #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16) 134 PETSC_EXTERN void MPIAPI PetscSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*); 135 PETSC_EXTERN void MPIAPI PetscMax_Local(void*,void*,PetscMPIInt*,MPI_Datatype*); 136 PETSC_EXTERN void MPIAPI PetscMin_Local(void*,void*,PetscMPIInt*,MPI_Datatype*); 137 #endif 138 139 PETSC_INTERN void MPIAPI MPIU_MaxSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*); 140 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_Counter_Attr_Delete_Fn(MPI_Comm,PetscMPIInt,void*,void*); 141 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_InnerComm_Attr_Delete_Fn(MPI_Comm,PetscMPIInt,void*,void*); 142 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_OuterComm_Attr_Delete_Fn(MPI_Comm,PetscMPIInt,void*,void*); 143 144 PETSC_INTERN PetscErrorCode PetscOptionsCheckInitial_Private(void); 145 PETSC_INTERN PetscErrorCode PetscInitialize_DynamicLibraries(void); 146 #if defined(PETSC_USE_LOG) 147 PETSC_INTERN PetscErrorCode PetscLogInitialize(void); 148 #endif 149 PETSC_EXTERN PetscErrorCode PetscMallocAlign(size_t,PetscBool,int,const char[],const char[],void**); 150 PETSC_EXTERN PetscErrorCode PetscFreeAlign(void*,int,const char[],const char[]); 151 PETSC_INTERN int PetscGlobalArgc; 152 PETSC_INTERN char **PetscGlobalArgs; 153 154 /* 155 Reads in Fortran command line argments and sends them to 156 all processors. 157 */ 158 159 PetscErrorCode PETScParseFortranArgs_Private(int *argc,char ***argv) 160 { 161 #if defined(PETSC_USE_NARGS) 162 short i,flg; 163 #else 164 int i; 165 #endif 166 PetscErrorCode ierr; 167 int warg = 256; 168 PetscMPIInt rank; 169 char *p; 170 171 ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRMPI(ierr); 172 if (!rank) { 173 #if defined(PETSC_HAVE_IARG_COUNT_PROGNAME) 174 *argc = iargc_(); 175 #else 176 /* most compilers do not count the program name for argv[0] */ 177 *argc = 1 + iargc_(); 178 #endif 179 } 180 ierr = MPI_Bcast(argc,1,MPI_INT,0,PETSC_COMM_WORLD);CHKERRMPI(ierr); 181 182 /* PetscTrMalloc() not yet set, so don't use PetscMalloc() */ 183 ierr = PetscMallocAlign((*argc+1)*(warg*sizeof(char)+sizeof(char*)),PETSC_FALSE,0,0,0,(void**)argv);CHKERRQ(ierr); 184 (*argv)[0] = (char*)(*argv + *argc + 1); 185 186 if (!rank) { 187 ierr = PetscMemzero((*argv)[0],(*argc)*warg*sizeof(char));CHKERRQ(ierr); 188 for (i=0; i<*argc; i++) { 189 (*argv)[i+1] = (*argv)[i] + warg; 190 #if defined (PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* same as 'else' case */ 191 getarg_(&i,(*argv)[i],warg); 192 #elif defined(PETSC_HAVE_PXFGETARG_NEW) 193 {char *tmp = (*argv)[i]; 194 int ilen; 195 getarg_(&i,tmp,&ilen,&ierr,warg);CHKERRQ(ierr); 196 tmp[ilen] = 0;} 197 #elif defined(PETSC_USE_NARGS) 198 GETARG(&i,(*argv)[i],warg,&flg); 199 #else 200 /* 201 Because the stupid #defines above define all kinds of things to getarg_ we cannot do this test 202 #elif defined(PETSC_HAVE_GETARG) 203 getarg_(&i,(*argv)[i],warg); 204 #else 205 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot get Fortran command line arguments"); 206 */ 207 getarg_(&i,(*argv)[i],warg); 208 #endif 209 /* zero out garbage at end of each argument */ 210 p = (*argv)[i] + warg-1; 211 while (p > (*argv)[i]) { 212 if (*p == ' ') *p = 0; 213 p--; 214 } 215 } 216 } 217 ierr = MPI_Bcast((*argv)[0],*argc*warg,MPI_CHAR,0,PETSC_COMM_WORLD);CHKERRMPI(ierr); 218 if (rank) { 219 for (i=0; i<*argc; i++) (*argv)[i+1] = (*argv)[i] + warg; 220 } 221 return 0; 222 } 223 224 #if defined(PETSC_SERIALIZE_FUNCTIONS) 225 PETSC_INTERN PetscFPT PetscFPTData; 226 #endif 227 228 #if defined(PETSC_HAVE_ADIOS) 229 #include <adios.h> 230 #include <adios_read.h> 231 #endif 232 /* -----------------------------------------------------------------------------------------------*/ 233 234 #if defined(PETSC_HAVE_SAWS) 235 #include <petscviewersaws.h> 236 PETSC_INTERN PetscErrorCode PetscInitializeSAWs(const char[]); 237 #endif 238 239 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_ShmComm_Attr_Delete_Fn(MPI_Comm,PetscMPIInt,void *,void *); 240 PETSC_INTERN PetscErrorCode PetscPreMPIInit_Private(); 241 242 /* 243 petscinitialize - Version called from Fortran. 244 245 Notes: 246 Since this is called from Fortran it does not return error codes 247 248 */ 249 static void petscinitialize_internal(char* filename, PetscInt len, PetscBool readarguments, PetscErrorCode *ierr) 250 { 251 int j,i; 252 #if defined (PETSC_USE_NARGS) 253 short flg; 254 #endif 255 int flag; 256 PetscMPIInt size; 257 char *t1,name[256],hostname[64]; 258 PetscMPIInt f_petsc_comm_world; 259 260 *ierr = PetscMemzero(name,sizeof(name)); if (*ierr) return; 261 if (PetscInitializeCalled) {*ierr = 0; return;} 262 263 /* this must be initialized in a routine, not as a constant declaration*/ 264 PETSC_STDOUT = stdout; 265 PETSC_STDERR = stderr; 266 267 /* on Windows - set printf to default to printing 2 digit exponents */ 268 #if defined(PETSC_HAVE__SET_OUTPUT_FORMAT) 269 _set_output_format(_TWO_DIGIT_EXPONENT); 270 #endif 271 272 *ierr = PetscOptionsCreateDefault(); 273 if (*ierr) return; 274 i = 0; 275 #if defined (PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* same as 'else' case */ 276 getarg_(&i,name,sizeof(name)); 277 #elif defined (PETSC_HAVE_PXFGETARG_NEW) 278 { int ilen,sierr; 279 getarg_(&i,name,&ilen,&sierr,256); 280 if (sierr) PetscStrncpy(name,"Unknown Name",256); 281 else name[ilen] = 0; 282 } 283 #elif defined(PETSC_USE_NARGS) 284 GETARG(&i,name,256,&flg); 285 #else 286 getarg_(&i,name,256); 287 #endif 288 /* Eliminate spaces at the end of the string */ 289 for (j=sizeof(name)-2; j>=0; j--) { 290 if (name[j] != ' ') { 291 name[j+1] = 0; 292 break; 293 } 294 } 295 if (j<0) PetscStrncpy(name,"Unknown Name",256); 296 *ierr = PetscSetProgramName(name); 297 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscSetProgramName()\n");return;} 298 299 /* check if PETSC_COMM_WORLD is initialized by the user in fortran */ 300 petscgetcomm_(&f_petsc_comm_world); 301 MPI_Initialized(&flag); 302 if (!flag) { 303 PetscMPIInt mierr; 304 305 if (f_petsc_comm_world) {(*PetscErrorPrintf)("You cannot set PETSC_COMM_WORLD if you have not initialized MPI first\n");return;} 306 307 *ierr = PetscPreMPIInit_Private(); if (*ierr) return; 308 mpi_init_(&mierr); 309 if (mierr) { 310 *ierr = mierr; 311 (*PetscErrorPrintf)("PetscInitialize: Calling Fortran MPI_Init()\n"); 312 return; 313 } 314 PetscBeganMPI = PETSC_TRUE; 315 } 316 if (f_petsc_comm_world) PETSC_COMM_WORLD = MPI_Comm_f2c(*(MPI_Fint*)&f_petsc_comm_world); /* User called MPI_INITIALIZE() and changed PETSC_COMM_WORLD */ 317 else PETSC_COMM_WORLD = MPI_COMM_WORLD; 318 *ierr = MPI_Comm_set_errhandler(PETSC_COMM_WORLD,MPI_ERRORS_RETURN); 319 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Setting MPI error handler\n");return;} 320 PetscInitializeCalled = PETSC_TRUE; 321 322 *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockOpen); 323 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;} 324 *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockStdout); 325 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;} 326 *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockStderr); 327 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;} 328 *ierr = PetscSpinlockCreate(&PetscCommSpinLock); 329 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;} 330 331 *ierr = PetscErrorPrintfInitialize(); 332 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscErrorPrintfInitialize()\n");return;} 333 *ierr = MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank); 334 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Setting PetscGlobalRank\n");return;} 335 *ierr = MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize); 336 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Setting PetscGlobalSize\n");return;} 337 338 MPIU_BOOL = MPI_INT; 339 MPIU_ENUM = MPI_INT; 340 MPIU_FORTRANADDR = (sizeof(void*) == sizeof(int)) ? MPI_INT : MPIU_INT64; 341 if (sizeof(size_t) == sizeof(unsigned)) MPIU_SIZE_T = MPI_UNSIGNED; 342 else if (sizeof(size_t) == sizeof(unsigned long)) MPIU_SIZE_T = MPI_UNSIGNED_LONG; 343 #if defined(PETSC_SIZEOF_LONG_LONG) 344 else if (sizeof(size_t) == sizeof(unsigned long long)) MPIU_SIZE_T = MPI_UNSIGNED_LONG_LONG; 345 #endif 346 else {(*PetscErrorPrintf)("PetscInitialize: Could not find MPI type for size_t\n"); return;} 347 348 #if defined(PETSC_HAVE_COMPLEX) 349 /* 350 Initialized the global variable; this is because with 351 shared libraries the constructors for global variables 352 are not called; at least on IRIX. 353 */ 354 { 355 #if defined(PETSC_CLANGUAGE_CXX) 356 PetscComplex ic(0.0,1.0); 357 PETSC_i = ic; 358 #else 359 PETSC_i = _Complex_I; 360 #endif 361 } 362 #endif 363 364 #if defined(PETSC_USE_REAL___FLOAT128) 365 *ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU___FLOAT128); 366 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 367 *ierr = MPI_Type_commit(&MPIU___FLOAT128); 368 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 369 #if defined(PETSC_HAVE_COMPLEX) 370 *ierr = MPI_Type_contiguous(4,MPI_DOUBLE,&MPIU___COMPLEX128); 371 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 372 *ierr = MPI_Type_commit(&MPIU___COMPLEX128); 373 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 374 #endif 375 *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM); 376 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 377 *ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX); 378 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 379 *ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN); 380 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 381 #elif defined(PETSC_USE_REAL___FP16) 382 *ierr = MPI_Type_contiguous(2,MPI_CHAR,&MPIU___FP16); 383 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 384 *ierr = MPI_Type_commit(&MPIU___FP16); 385 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 386 *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM); 387 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 388 *ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX); 389 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 390 *ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN); 391 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 392 #endif 393 394 /* 395 Create the PETSc MPI reduction operator that sums of the first 396 half of the entries and maxes the second half. 397 */ 398 *ierr = MPI_Op_create(MPIU_MaxSum_Local,1,&MPIU_MAXSUM_OP); 399 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 400 401 *ierr = MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR); 402 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 403 *ierr = MPI_Type_commit(&MPIU_2SCALAR); 404 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 405 #if defined(PETSC_USE_64BIT_INDICES) 406 *ierr = MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT); 407 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 408 *ierr = MPI_Type_commit(&MPIU_2INT); 409 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 410 #endif 411 *ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_Counter_Attr_Delete_Fn,&Petsc_Counter_keyval,(void*)0); 412 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;} 413 *ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_InnerComm_Attr_Delete_Fn,&Petsc_InnerComm_keyval,(void*)0); 414 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;} 415 *ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_OuterComm_Attr_Delete_Fn,&Petsc_OuterComm_keyval,(void*)0); 416 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;} 417 *ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_ShmComm_Attr_Delete_Fn,&Petsc_ShmComm_keyval,(void*)0); 418 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;} 419 420 /* 421 PetscInitializeFortran() is called twice. Here it initializes 422 PETSC_NULL_CHARACTER_Fortran. Below it initializes the PETSC_VIEWERs. 423 The PETSC_VIEWERs have not been created yet, so they must be initialized 424 below. 425 */ 426 PetscInitializeFortran(); 427 if (readarguments == PETSC_TRUE) { 428 PETScParseFortranArgs_Private(&PetscGlobalArgc,&PetscGlobalArgs); 429 FIXCHAR(filename,len,t1); 430 *ierr = PetscOptionsInsert(NULL,&PetscGlobalArgc,&PetscGlobalArgs,t1); 431 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating options database\n");return;} 432 FREECHAR(filename,t1); 433 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Freeing string in creating options database\n");return;} 434 } 435 *ierr = PetscOptionsCheckInitial_Private(); 436 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Checking initial options\n");return;} 437 /* call a second time to check options database */ 438 *ierr = PetscErrorPrintfInitialize(); 439 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscErrorPrintfInitialize()\n");return;} 440 *ierr = PetscCitationsInitialize(); 441 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscCitationsInitialize()\n");return;} 442 #if defined(PETSC_HAVE_SAWS) 443 *ierr = PetscInitializeSAWs(NULL); 444 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Initializing SAWs\n");return;} 445 #endif 446 #if defined(PETSC_USE_LOG) 447 *ierr = PetscLogInitialize(); 448 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: initializing logging\n");return;} 449 #endif 450 *ierr = PetscInitialize_DynamicLibraries(); 451 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Initializing dynamic libraries\n");return;} 452 453 *ierr = PetscInitializeFortran(); 454 if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Setting up common block\n");return;} 455 456 *ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size); 457 if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Getting MPI_Comm_size()\n");return;} 458 *ierr = PetscInfo1(0,"(Fortran):PETSc successfully started: procs %d\n",size); 459 if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Calling PetscInfo()\n");return;} 460 *ierr = PetscGetHostName(hostname,64); 461 if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Getting hostname\n");return;} 462 *ierr = PetscInfo1(0,"Running on machine: %s\n",hostname); 463 if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Calling PetscInfo()\n");return;} 464 465 #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY) 466 *ierr = PetscStackCreate(); 467 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscStackCreate()\n");return;} 468 #endif 469 470 #if defined(PETSC_SERIALIZE_FUNCTIONS) 471 *ierr = PetscFPTCreate(10000); 472 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscFPTCreate()\n");return;} 473 #endif 474 #if defined(PETSC_HAVE_ADIOS) 475 *ierr = adios_init_noxml(PETSC_COMM_WORLD); 476 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:adios_init_noxml()\n");return;} 477 *ierr = adios_declare_group(&Petsc_adios_group,"PETSc","",adios_stat_default); 478 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:adios_declare_group()\n");return;} 479 *ierr = adios_select_method(Petsc_adios_group,"MPI","",""); 480 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:adios_select_method()\n");return;} 481 *ierr = adios_read_init_method(ADIOS_READ_METHOD_BP,PETSC_COMM_WORLD,""); 482 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:adios_read_init_method()\n");return;} 483 #endif 484 } 485 486 PETSC_EXTERN void petscinitialize_(char* filename,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 487 { 488 petscinitialize_internal(filename, len, PETSC_TRUE, ierr); 489 } 490 491 PETSC_EXTERN void petscinitializenoarguments_(PetscErrorCode *ierr) 492 { 493 petscinitialize_internal(NULL, (PetscInt) 0, PETSC_FALSE, ierr); 494 } 495 496 497 PETSC_EXTERN void petscfinalize_(PetscErrorCode *ierr) 498 { 499 #if defined(PETSC_HAVE_SUNMATHPRO) 500 extern void standard_arithmetic(); 501 standard_arithmetic(); 502 #endif 503 /* was malloced with PetscMallocAlign() so free the same way */ 504 *ierr = PetscFreeAlign(PetscGlobalArgs,0,0,0);if (*ierr) {(*PetscErrorPrintf)("PetscFinalize:Freeing args\n");return;} 505 506 *ierr = PetscFinalize(); 507 } 508 509 PETSC_EXTERN void petscend_(PetscErrorCode *ierr) 510 { 511 #if defined(PETSC_HAVE_SUNMATHPRO) 512 extern void standard_arithmetic(); 513 standard_arithmetic(); 514 #endif 515 516 *ierr = PetscEnd(); 517 } 518 519