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