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