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