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 petscgetcommoncomm_ PETSCGETCOMMONCOMM 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 petscgetcommoncomm_ petscgetcommoncomm 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 PETSC_STDCALL mpi_init_(int*); 106 PETSC_EXTERN void PETSC_STDCALL petscgetcommoncomm_(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_FORTRAN_STDCALL) 119 PETSC_EXTERN int PETSC_STDCALL IARGC(); 120 PETSC_EXTERN void PETSC_STDCALL GETARG(int *,char *,int); 121 122 #elif defined(PETSC_HAVE_PXFGETARG_NEW) 123 PETSC_EXTERN int iargc_(); 124 PETSC_EXTERN void getarg_(int*,char*,int*,int*,int); 125 126 #else 127 PETSC_EXTERN int iargc_(); 128 PETSC_EXTERN void getarg_(int*,char*,int); 129 /* 130 The Cray T3D/T3E use the PXFGETARG() function 131 */ 132 #if defined(PETSC_HAVE_PXFGETARG) 133 PETSC_EXTERN void PXFGETARG(int*,_fcd,int*,int*); 134 #endif 135 #endif 136 137 #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16) 138 extern MPI_Op MPIU_SUM; 139 140 PETSC_EXTERN void MPIAPI PetscSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*); 141 142 #endif 143 #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16) 144 145 PETSC_EXTERN void MPIAPI PetscSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*); 146 PETSC_EXTERN void MPIAPI PetscMax_Local(void*,void*,PetscMPIInt*,MPI_Datatype*); 147 PETSC_EXTERN void MPIAPI PetscMin_Local(void*,void*,PetscMPIInt*,MPI_Datatype*); 148 #endif 149 150 PETSC_INTERN void MPIAPI MPIU_MaxSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*); 151 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelCounter(MPI_Comm,PetscMPIInt,void*,void*); 152 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Inner(MPI_Comm,PetscMPIInt,void*,void*); 153 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Outer(MPI_Comm,PetscMPIInt,void*,void*); 154 155 extern PetscErrorCode PetscOptionsCheckInitial_Private(void); 156 extern PetscErrorCode PetscOptionsCheckInitial_Components(void); 157 extern PetscErrorCode PetscInitialize_DynamicLibraries(void); 158 #if defined(PETSC_USE_LOG) 159 extern PetscErrorCode PetscLogInitialize(void); 160 #endif 161 extern PetscErrorCode PetscMallocAlign(size_t,int,const char[],const char[],void**); 162 extern PetscErrorCode PetscFreeAlign(void*,int,const char[],const char[]); 163 extern int PetscGlobalArgc; 164 extern char **PetscGlobalArgs; 165 166 /* 167 Reads in Fortran command line argments and sends them to 168 all processors. 169 */ 170 171 PetscErrorCode PETScParseFortranArgs_Private(int *argc,char ***argv) 172 { 173 #if defined(PETSC_USE_NARGS) 174 short i,flg; 175 #else 176 int i; 177 #endif 178 PetscErrorCode ierr; 179 int warg = 256; 180 PetscMPIInt rank; 181 char *p; 182 183 ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); 184 if (!rank) { 185 #if defined(PETSC_HAVE_IARG_COUNT_PROGNAME) 186 *argc = iargc_(); 187 #else 188 /* most compilers do not count the program name for argv[0] */ 189 *argc = 1 + iargc_(); 190 #endif 191 } 192 ierr = MPI_Bcast(argc,1,MPI_INT,0,PETSC_COMM_WORLD);CHKERRQ(ierr); 193 194 /* PetscTrMalloc() not yet set, so don't use PetscMalloc() */ 195 ierr = PetscMallocAlign((*argc+1)*(warg*sizeof(char)+sizeof(char*)),0,0,0,(void**)argv);CHKERRQ(ierr); 196 (*argv)[0] = (char*)(*argv + *argc + 1); 197 198 if (!rank) { 199 ierr = PetscMemzero((*argv)[0],(*argc)*warg*sizeof(char));CHKERRQ(ierr); 200 for (i=0; i<*argc; i++) { 201 (*argv)[i+1] = (*argv)[i] + warg; 202 #if defined (PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* same as 'else' case */ 203 getarg_(&i,(*argv)[i],warg); 204 #elif defined(PETSC_HAVE_PXFGETARG_NEW) 205 {char *tmp = (*argv)[i]; 206 int ilen; 207 getarg_(&i,tmp,&ilen,&ierr,warg);CHKERRQ(ierr); 208 tmp[ilen] = 0;} 209 #elif defined(PETSC_USE_NARGS) 210 GETARG(&i,(*argv)[i],warg,&flg); 211 #else 212 /* 213 Because the stupid #defines above define all kinds of things to getarg_ we cannot do this test 214 #elif defined(PETSC_HAVE_GETARG) 215 getarg_(&i,(*argv)[i],warg); 216 #else 217 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot get Fortran command line arguments"); 218 */ 219 getarg_(&i,(*argv)[i],warg); 220 #endif 221 /* zero out garbage at end of each argument */ 222 p = (*argv)[i] + warg-1; 223 while (p > (*argv)[i]) { 224 if (*p == ' ') *p = 0; 225 p--; 226 } 227 } 228 } 229 ierr = MPI_Bcast((*argv)[0],*argc*warg,MPI_CHAR,0,PETSC_COMM_WORLD);CHKERRQ(ierr); 230 if (rank) { 231 for (i=0; i<*argc; i++) (*argv)[i+1] = (*argv)[i] + warg; 232 } 233 return 0; 234 } 235 236 #if defined(PETSC_SERIALIZE_FUNCTIONS) 237 extern PetscFPT PetscFPTData; 238 #endif 239 240 #if defined(PETSC_HAVE_THREADSAFETY) 241 extern PetscSpinlock PetscViewerASCIISpinLockOpen; 242 extern PetscSpinlock PetscViewerASCIISpinLockStdout; 243 extern PetscSpinlock PetscViewerASCIISpinLockStderr; 244 extern PetscSpinlock PetscCommSpinLock; 245 #endif 246 247 #if defined(PETSC_HAVE_ADIOS) 248 #include <adios.h> 249 #include <adios_read.h> 250 #endif 251 /* -----------------------------------------------------------------------------------------------*/ 252 253 #if defined(PETSC_HAVE_SAWS) 254 #include <petscviewersaws.h> 255 extern PetscErrorCode PetscInitializeSAWs(const char[]); 256 #endif 257 258 PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelShared(MPI_Comm,PetscMPIInt,void *,void *); 259 260 /* 261 petscinitialize - Version called from Fortran. 262 263 Notes: 264 Since this is called from Fortran it does not return error codes 265 266 */ 267 static void petscinitialize_internal(char* filename, PetscInt len, PetscBool readarguments, PetscErrorCode *ierr) 268 { 269 int j,i; 270 #if defined (PETSC_USE_NARGS) 271 short flg; 272 #endif 273 int flag; 274 PetscMPIInt size; 275 char *t1,name[256],hostname[64]; 276 PetscMPIInt f_petsc_comm_world; 277 278 *ierr = PetscMemzero(name,sizeof(name)); if (*ierr) return; 279 if (PetscInitializeCalled) {*ierr = 0; return;} 280 281 /* this must be initialized in a routine, not as a constant declaration*/ 282 PETSC_STDOUT = stdout; 283 PETSC_STDERR = stderr; 284 285 /* on Windows - set printf to default to printing 2 digit exponents */ 286 #if defined(PETSC_HAVE__SET_OUTPUT_FORMAT) 287 _set_output_format(_TWO_DIGIT_EXPONENT); 288 #endif 289 290 *ierr = PetscOptionsCreateDefault(); 291 if (*ierr) return; 292 i = 0; 293 #if defined (PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* same as 'else' case */ 294 getarg_(&i,name,sizeof(name)); 295 #elif defined (PETSC_HAVE_PXFGETARG_NEW) 296 { int ilen,sierr; 297 getarg_(&i,name,&ilen,&sierr,256); 298 if (sierr) PetscStrncpy(name,"Unknown Name",256); 299 else name[ilen] = 0; 300 } 301 #elif defined(PETSC_USE_NARGS) 302 GETARG(&i,name,256,&flg); 303 #else 304 getarg_(&i,name,256); 305 #endif 306 /* Eliminate spaces at the end of the string */ 307 for (j=sizeof(name)-2; j>=0; j--) { 308 if (name[j] != ' ') { 309 name[j+1] = 0; 310 break; 311 } 312 } 313 if (j<0) PetscStrncpy(name,"Unknown Name",256); 314 *ierr = PetscSetProgramName(name); 315 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscSetProgramName()\n");return;} 316 317 /* check if PETSC_COMM_WORLD is initialized by the user in fortran */ 318 petscgetcommoncomm_(&f_petsc_comm_world); 319 MPI_Initialized(&flag); 320 if (!flag) { 321 PetscMPIInt mierr; 322 323 if (f_petsc_comm_world) {(*PetscErrorPrintf)("You cannot set PETSC_COMM_WORLD if you have not initialized MPI first\n");return;} 324 mpi_init_(&mierr); 325 if (mierr) { 326 *ierr = mierr; 327 (*PetscErrorPrintf)("PetscInitialize: Calling Fortran MPI_Init()\n"); 328 return; 329 } 330 PetscBeganMPI = PETSC_TRUE; 331 } 332 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 */ 333 else PETSC_COMM_WORLD = MPI_COMM_WORLD; 334 PetscInitializeCalled = PETSC_TRUE; 335 336 *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockOpen); 337 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;} 338 *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockStdout); 339 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;} 340 *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockStderr); 341 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;} 342 *ierr = PetscSpinlockCreate(&PetscCommSpinLock); 343 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;} 344 345 *ierr = PetscErrorPrintfInitialize(); 346 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscErrorPrintfInitialize()\n");return;} 347 *ierr = MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank); 348 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Setting PetscGlobalRank\n");return;} 349 *ierr = MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize); 350 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Setting PetscGlobalSize\n");return;} 351 352 MPIU_BOOL = MPI_INT; 353 MPIU_ENUM = MPI_INT; 354 355 #if defined(PETSC_HAVE_COMPLEX) 356 /* 357 Initialized the global variable; this is because with 358 shared libraries the constructors for global variables 359 are not called; at least on IRIX. 360 */ 361 { 362 #if defined(PETSC_CLANGUAGE_CXX) && !defined(PETSC_USE_REAL___FLOAT128) 363 PetscComplex ic(0.0,1.0); 364 PETSC_i = ic; 365 #else 366 PETSC_i = _Complex_I; 367 #endif 368 } 369 370 #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX) 371 *ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU_C_DOUBLE_COMPLEX); 372 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 373 *ierr = MPI_Type_commit(&MPIU_C_DOUBLE_COMPLEX); 374 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 375 *ierr = MPI_Type_contiguous(2,MPI_FLOAT,&MPIU_C_COMPLEX); 376 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 377 *ierr = MPI_Type_commit(&MPIU_C_COMPLEX); 378 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 379 *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM); 380 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 381 #endif 382 383 #endif 384 385 #if defined(PETSC_USE_REAL___FLOAT128) 386 *ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU___FLOAT128); 387 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 388 *ierr = MPI_Type_commit(&MPIU___FLOAT128); 389 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 390 #if defined(PETSC_HAVE_COMPLEX) 391 *ierr = MPI_Type_contiguous(4,MPI_DOUBLE,&MPIU___COMPLEX128); 392 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 393 *ierr = MPI_Type_commit(&MPIU___COMPLEX128); 394 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 395 #endif 396 *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM); 397 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 398 *ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX); 399 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 400 *ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN); 401 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 402 #elif defined(PETSC_USE_REAL___FP16) 403 *ierr = MPI_Type_contiguous(2,MPI_CHAR,&MPIU___FP16); 404 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 405 *ierr = MPI_Type_commit(&MPIU___FP16); 406 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 407 *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM); 408 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 409 *ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX); 410 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 411 *ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN); 412 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 413 #endif 414 415 /* 416 Create the PETSc MPI reduction operator that sums of the first 417 half of the entries and maxes the second half. 418 */ 419 *ierr = MPI_Op_create(MPIU_MaxSum_Local,1,&MPIU_MAXSUM_OP); 420 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 421 422 *ierr = MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR); 423 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 424 *ierr = MPI_Type_commit(&MPIU_2SCALAR); 425 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 426 #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT) 427 *ierr = MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT); 428 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 429 *ierr = MPI_Type_commit(&MPIU_2INT); 430 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 431 #endif 432 *ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_DelCounter,&Petsc_Counter_keyval,(void*)0); 433 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;} 434 *ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_DelComm_Outer,&Petsc_InnerComm_keyval,(void*)0); 435 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;} 436 *ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_DelComm_Inner,&Petsc_OuterComm_keyval,(void*)0); 437 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;} 438 *ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_DelShared,&Petsc_Shared_keyval,(void*)0); 439 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;} 440 441 /* 442 PetscInitializeFortran() is called twice. Here it initializes 443 PETSC_NULL_CHARACTER_Fortran. Below it initializes the PETSC_VIEWERs. 444 The PETSC_VIEWERs have not been created yet, so they must be initialized 445 below. 446 */ 447 PetscInitializeFortran(); 448 if(readarguments == PETSC_TRUE) { 449 PETScParseFortranArgs_Private(&PetscGlobalArgc,&PetscGlobalArgs); 450 FIXCHAR(filename,len,t1); 451 *ierr = PetscOptionsInsert(NULL,&PetscGlobalArgc,&PetscGlobalArgs,t1); 452 FREECHAR(filename,t1); 453 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating options database\n");return;} 454 } 455 *ierr = PetscOptionsCheckInitial_Private(); 456 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Checking initial options\n");return;} 457 /* call a second time to check options database */ 458 *ierr = PetscErrorPrintfInitialize(); 459 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscErrorPrintfInitialize()\n");return;} 460 *ierr = PetscCitationsInitialize(); 461 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscCitationsInitialize()\n");return;} 462 #if defined(PETSC_HAVE_SAWS) 463 *ierr = PetscInitializeSAWs(NULL); 464 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Initializing SAWs\n");return;} 465 #endif 466 #if defined(PETSC_USE_LOG) 467 *ierr = PetscLogInitialize(); 468 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: intializing logging\n");return;} 469 #endif 470 *ierr = PetscInitialize_DynamicLibraries(); 471 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Initializing dynamic libraries\n");return;} 472 473 *ierr = PetscInitializeFortran(); 474 if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Setting up common block\n");return;} 475 476 *ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size); 477 if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Getting MPI_Comm_size()\n");return;} 478 *ierr = PetscInfo1(0,"(Fortran):PETSc successfully started: procs %d\n",size); 479 if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Calling PetscInfo()\n");return;} 480 *ierr = PetscGetHostName(hostname,64); 481 if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Getting hostname\n");return;} 482 *ierr = PetscInfo1(0,"Running on machine: %s\n",hostname); 483 if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Calling PetscInfo()\n");return;} 484 *ierr = PetscOptionsCheckInitial_Components(); 485 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Checking initial options\n");return;} 486 487 #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY) 488 *ierr = PetscStackCreate(); 489 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscStackCreate()\n");return;} 490 #endif 491 492 #if defined(PETSC_SERIALIZE_FUNCTIONS) 493 *ierr = PetscFPTCreate(10000); 494 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscFPTCreate()\n");return;} 495 #endif 496 #if defined(PETSC_HAVE_ADIOS) 497 *ierr = adios_init_noxml(PETSC_COMM_WORLD); 498 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:adios_init_noxml()\n");return;} 499 *ierr = adios_declare_group(&Petsc_adios_group,"PETSc","",adios_stat_default); 500 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:adios_declare_group()\n");return;} 501 *ierr = adios_select_method(Petsc_adios_group,"MPI","",""); 502 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:adios_select_method()\n");return;} 503 *ierr = adios_read_init_method(ADIOS_READ_METHOD_BP,PETSC_COMM_WORLD,""); 504 if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:adios_read_init_method()\n");return;} 505 #endif 506 } 507 508 PETSC_EXTERN void PETSC_STDCALL petscinitialize_(char* filename PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 509 { 510 petscinitialize_internal(filename, len, PETSC_TRUE, ierr); 511 } 512 513 PETSC_EXTERN void PETSC_STDCALL petscinitializenoarguments_(PetscErrorCode *ierr) 514 { 515 petscinitialize_internal(NULL, (PetscInt) 0, PETSC_FALSE, ierr); 516 } 517 518 519 PETSC_EXTERN void PETSC_STDCALL petscfinalize_(PetscErrorCode *ierr) 520 { 521 #if defined(PETSC_HAVE_SUNMATHPRO) 522 extern void standard_arithmetic(); 523 standard_arithmetic(); 524 #endif 525 /* was malloced with PetscMallocAlign() so free the same way */ 526 *ierr = PetscFreeAlign(PetscGlobalArgs,0,0,0);if (*ierr) {(*PetscErrorPrintf)("PetscFinalize:Freeing args\n");return;} 527 528 *ierr = PetscFinalize(); 529 } 530 531 PETSC_EXTERN void PETSC_STDCALL petscend_(PetscErrorCode *ierr) 532 { 533 #if defined(PETSC_HAVE_SUNMATHPRO) 534 extern void standard_arithmetic(); 535 standard_arithmetic(); 536 #endif 537 538 *ierr = PetscEnd(); 539 } 540 541