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