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