1ba9a049bSBarry Smith /* 2ba9a049bSBarry Smith This file contains Fortran stubs for PetscInitialize and Finalize. 3ba9a049bSBarry Smith */ 4ba9a049bSBarry Smith 5ba9a049bSBarry Smith /* 6ba9a049bSBarry Smith This is to prevent the Cray T3D version of MPI (University of Edinburgh) 7ba9a049bSBarry Smith from stupidly redefining MPI_INIT(). They put this in to detect errors 8ba9a049bSBarry Smith in C code,but here I do want to be calling the Fortran version from a 9ba9a049bSBarry Smith C subroutine. 10ba9a049bSBarry Smith */ 11ba9a049bSBarry Smith #define T3DMPI_FORTRAN 12ba9a049bSBarry Smith #define T3EMPI_FORTRAN 13ba9a049bSBarry Smith 14af0996ceSBarry Smith #include <petsc/private/fortranimpl.h> 15ba9a049bSBarry Smith 1676c028afSSatish Balay #if defined(PETSC_HAVE_CUDA) 1782f73ecaSAlejandro Lamas Daviña #include <cublas_v2.h> 18d730656cSKarl Rupp 19d730656cSKarl Rupp extern cublasHandle_t cublasv2handle; 20ba9a049bSBarry Smith #endif 21ba9a049bSBarry Smith 22519f805aSKarl Rupp #if defined(PETSC_HAVE_FORTRAN_CAPS) 23ba9a049bSBarry Smith #define petscinitialize_ PETSCINITIALIZE 24fb2dfec1SJacht Volker #define petscinitializenoarguments_ PETSCINITIALIZENOARGUMENTS 25ba9a049bSBarry Smith #define petscfinalize_ PETSCFINALIZE 26ba9a049bSBarry Smith #define petscend_ PETSCEND 27ba9a049bSBarry Smith #define iargc_ IARGC 28ba9a049bSBarry Smith #define getarg_ GETARG 29ba9a049bSBarry Smith #define mpi_init_ MPI_INIT 30ba9a049bSBarry Smith #define petscgetcommoncomm_ PETSCGETCOMMONCOMM 31541b5888SSatish Balay #define petsccommandargumentcount_ PETSCCOMMANDARGUMENTCOUNT 32541b5888SSatish Balay #define petscgetcommandargument_ PETSCGETCOMMANDARGUMENT 33ba9a049bSBarry Smith #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 34ba9a049bSBarry Smith #define petscinitialize_ petscinitialize 351bdb895aSBarry Smith #define petscinitializenoarguments_ petscinitializenoarguments 36ba9a049bSBarry Smith #define petscfinalize_ petscfinalize 37ba9a049bSBarry Smith #define petscend_ petscend 38ba9a049bSBarry Smith #define mpi_init_ mpi_init 39ba9a049bSBarry Smith #define iargc_ iargc 40ba9a049bSBarry Smith #define getarg_ getarg 41ba9a049bSBarry Smith #define petscgetcommoncomm_ petscgetcommoncomm 42541b5888SSatish Balay #define petsccommandargumentcount_ petsccommandargumentcount 43541b5888SSatish Balay #define petscgetcommandargument_ petscgetcommandargument 44ba9a049bSBarry Smith #endif 45ba9a049bSBarry Smith 46ba9a049bSBarry Smith #if defined(PETSC_HAVE_NAGF90) 47ba9a049bSBarry Smith #undef iargc_ 48ba9a049bSBarry Smith #undef getarg_ 49ba9a049bSBarry Smith #define iargc_ f90_unix_MP_iargc 50ba9a049bSBarry Smith #define getarg_ f90_unix_MP_getarg 51ba9a049bSBarry Smith #endif 52ba9a049bSBarry Smith #if defined(PETSC_USE_NARGS) /* Digital Fortran */ 53ba9a049bSBarry Smith #undef iargc_ 54ba9a049bSBarry Smith #undef getarg_ 55ba9a049bSBarry Smith #define iargc_ NARGS 56ba9a049bSBarry Smith #define getarg_ GETARG 57ba9a049bSBarry Smith #elif defined(PETSC_HAVE_PXFGETARG_NEW) /* cray x1 */ 58ba9a049bSBarry Smith #undef iargc_ 59ba9a049bSBarry Smith #undef getarg_ 60ba9a049bSBarry Smith #define iargc_ ipxfargc_ 61ba9a049bSBarry Smith #define getarg_ pxfgetarg_ 62ba9a049bSBarry Smith #endif 63ba9a049bSBarry Smith #if defined(PETSC_HAVE_FORTRAN_IARGC_UNDERSCORE) /* HPUX + no underscore */ 64ba9a049bSBarry Smith #undef iargc_ 65ba9a049bSBarry Smith #undef getarg_ 66ba9a049bSBarry Smith #define iargc_ iargc_ 67ba9a049bSBarry Smith #define getarg_ getarg_ 68ba9a049bSBarry Smith #endif 69541b5888SSatish Balay 70541b5888SSatish Balay #if defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* Fortran 2003 */ 71541b5888SSatish Balay #undef iargc_ 72541b5888SSatish Balay #undef getarg_ 73541b5888SSatish Balay #define iargc_ petsccommandargumentcount_ 74541b5888SSatish Balay #define getarg_ petscgetcommandargument_ 75541b5888SSatish Balay #elif defined(PETSC_HAVE_GFORTRAN_IARGC) /* gfortran from gcc4 */ 76ba9a049bSBarry Smith #undef iargc_ 77ba9a049bSBarry Smith #undef getarg_ 78ba9a049bSBarry Smith #define iargc_ _gfortran_iargc 79ba9a049bSBarry Smith #define getarg_ _gfortran_getarg_i4 80ba9a049bSBarry Smith #elif defined(PETSC_HAVE_BGL_IARGC) /* bgl g77 has different external & internal name mangling */ 81ba9a049bSBarry Smith #undef iargc_ 82ba9a049bSBarry Smith #undef getarg_ 83ba9a049bSBarry Smith #define iargc iargc_ 84ba9a049bSBarry Smith #define getarg getarg_ 85ba9a049bSBarry Smith #endif 86ba9a049bSBarry Smith 87ba9a049bSBarry Smith /* 88ba9a049bSBarry Smith The extra _ is because the f2c compiler puts an 89ba9a049bSBarry Smith extra _ at the end if the original routine name 90ba9a049bSBarry Smith contained any _. 91ba9a049bSBarry Smith */ 92ba9a049bSBarry Smith #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE) 93ba9a049bSBarry Smith #define mpi_init_ mpi_init__ 94ba9a049bSBarry Smith #endif 95ba9a049bSBarry Smith 96a7b85bbcSSatish Balay #if defined(PETSC_HAVE_MPIUNI) 97a7b85bbcSSatish Balay #if defined(mpi_init_) 98a7b85bbcSSatish Balay #undef mpi_init_ 99a7b85bbcSSatish Balay #if defined(PETSC_HAVE_FORTRAN_CAPS) 100a7b85bbcSSatish Balay #define mpi_init_ PETSC_MPI_INIT 101a7b85bbcSSatish Balay #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 102a7b85bbcSSatish Balay #define mpi_init_ petsc_mpi_init 103a7b85bbcSSatish Balay #elif defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE) 104a7b85bbcSSatish Balay #define mpi_init_ petsc_mpi_init__ 105a7b85bbcSSatish Balay #endif 106a7b85bbcSSatish Balay #else /* mpi_init_ */ 107a7b85bbcSSatish Balay #define mpi_init_ petsc_mpi_init_ 108a7b85bbcSSatish Balay #endif /* mpi_init_ */ 109a7b85bbcSSatish Balay #endif /* PETSC_HAVE_MPIUNI */ 110a7b85bbcSSatish Balay 1118cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL mpi_init_(int*); 1128cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL petscgetcommoncomm_(PetscMPIInt*); 113ba9a049bSBarry Smith 114ba9a049bSBarry Smith /* 115ba9a049bSBarry Smith Different Fortran compilers handle command lines in different ways 116ba9a049bSBarry Smith */ 117541b5888SSatish Balay #if defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* Fortran 2003 - same as 'else' case */ 118*a30ec4eaSSatish Balay PETSC_EXTERN int iargc_(void); 119541b5888SSatish Balay PETSC_EXTERN void getarg_(int*,char*,int); 120541b5888SSatish Balay #elif defined(PETSC_USE_NARGS) 1218cc058d9SJed Brown PETSC_EXTERN short __stdcall NARGS(); 1228cc058d9SJed Brown PETSC_EXTERN void __stdcall GETARG(short*,char*,int,short *); 123ba9a049bSBarry Smith 124ba9a049bSBarry Smith #elif defined(PETSC_HAVE_FORTRAN_STDCALL) 1258cc058d9SJed Brown PETSC_EXTERN int PETSC_STDCALL IARGC(); 1268cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL GETARG(int *,char *,int); 127ba9a049bSBarry Smith 128ba9a049bSBarry Smith #elif defined(PETSC_HAVE_PXFGETARG_NEW) 1298cc058d9SJed Brown PETSC_EXTERN int iargc_(); 1308cc058d9SJed Brown PETSC_EXTERN void getarg_(int*,char*,int*,int*,int); 131ba9a049bSBarry Smith 132ba9a049bSBarry Smith #else 1338cc058d9SJed Brown PETSC_EXTERN int iargc_(); 1348cc058d9SJed Brown PETSC_EXTERN void getarg_(int*,char*,int); 135ba9a049bSBarry Smith /* 136ba9a049bSBarry Smith The Cray T3D/T3E use the PXFGETARG() function 137ba9a049bSBarry Smith */ 138ba9a049bSBarry Smith #if defined(PETSC_HAVE_PXFGETARG) 1398cc058d9SJed Brown PETSC_EXTERN void PXFGETARG(int*,_fcd,int*,int*); 140ba9a049bSBarry Smith #endif 141ba9a049bSBarry Smith #endif 142ba9a049bSBarry Smith 143570b7f6dSBarry Smith #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16) 144ba9a049bSBarry Smith extern MPI_Op MPIU_SUM; 14599e0435eSBarry Smith 1468cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*); 14799e0435eSBarry Smith 148ba9a049bSBarry Smith #endif 149570b7f6dSBarry Smith #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16) 15099e0435eSBarry Smith 1518cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*); 1528cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscMax_Local(void*,void*,PetscMPIInt*,MPI_Datatype*); 1538cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscMin_Local(void*,void*,PetscMPIInt*,MPI_Datatype*); 154ba9a049bSBarry Smith #endif 155ba9a049bSBarry Smith 156367daffbSBarry Smith PETSC_INTERN void MPIAPI MPIU_MaxSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*); 1578cc058d9SJed Brown PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelCounter(MPI_Comm,PetscMPIInt,void*,void*); 158da3039f7SJed Brown PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Inner(MPI_Comm,PetscMPIInt,void*,void*); 159da3039f7SJed Brown PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Outer(MPI_Comm,PetscMPIInt,void*,void*); 160ba9a049bSBarry Smith 161ba9a049bSBarry Smith extern PetscErrorCode PetscOptionsCheckInitial_Private(void); 162ba9a049bSBarry Smith extern PetscErrorCode PetscOptionsCheckInitial_Components(void); 163ba9a049bSBarry Smith extern PetscErrorCode PetscInitialize_DynamicLibraries(void); 164ba9a049bSBarry Smith #if defined(PETSC_USE_LOG) 165896238b9SBarry Smith extern PetscErrorCode PetscLogInitialize(void); 166ba9a049bSBarry Smith #endif 167efca3c55SSatish Balay extern PetscErrorCode PetscMallocAlign(size_t,int,const char[],const char[],void**); 168efca3c55SSatish Balay extern PetscErrorCode PetscFreeAlign(void*,int,const char[],const char[]); 169ba9a049bSBarry Smith extern int PetscGlobalArgc; 170ba9a049bSBarry Smith extern char **PetscGlobalArgs; 171ba9a049bSBarry Smith 172ba9a049bSBarry Smith /* 173ba9a049bSBarry Smith Reads in Fortran command line argments and sends them to 174d5be86a5SBarry Smith all processors. 175ba9a049bSBarry Smith */ 176ba9a049bSBarry Smith 177ba9a049bSBarry Smith PetscErrorCode PETScParseFortranArgs_Private(int *argc,char ***argv) 178ba9a049bSBarry Smith { 179ba9a049bSBarry Smith #if defined(PETSC_USE_NARGS) 180ba9a049bSBarry Smith short i,flg; 181ba9a049bSBarry Smith #else 182ba9a049bSBarry Smith int i; 183ba9a049bSBarry Smith #endif 184ba9a049bSBarry Smith PetscErrorCode ierr; 185ba9a049bSBarry Smith int warg = 256; 186ba9a049bSBarry Smith PetscMPIInt rank; 187ba9a049bSBarry Smith char *p; 188ba9a049bSBarry Smith 189ba9a049bSBarry Smith ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); 190ba9a049bSBarry Smith if (!rank) { 191ba9a049bSBarry Smith #if defined(PETSC_HAVE_IARG_COUNT_PROGNAME) 192ba9a049bSBarry Smith *argc = iargc_(); 193ba9a049bSBarry Smith #else 194ba9a049bSBarry Smith /* most compilers do not count the program name for argv[0] */ 195ba9a049bSBarry Smith *argc = 1 + iargc_(); 196ba9a049bSBarry Smith #endif 197ba9a049bSBarry Smith } 198ba9a049bSBarry Smith ierr = MPI_Bcast(argc,1,MPI_INT,0,PETSC_COMM_WORLD);CHKERRQ(ierr); 199ba9a049bSBarry Smith 200ba9a049bSBarry Smith /* PetscTrMalloc() not yet set, so don't use PetscMalloc() */ 201efca3c55SSatish Balay ierr = PetscMallocAlign((*argc+1)*(warg*sizeof(char)+sizeof(char*)),0,0,0,(void**)argv);CHKERRQ(ierr); 202ba9a049bSBarry Smith (*argv)[0] = (char*)(*argv + *argc + 1); 203ba9a049bSBarry Smith 204ba9a049bSBarry Smith if (!rank) { 205ba9a049bSBarry Smith ierr = PetscMemzero((*argv)[0],(*argc)*warg*sizeof(char));CHKERRQ(ierr); 206ba9a049bSBarry Smith for (i=0; i<*argc; i++) { 207ba9a049bSBarry Smith (*argv)[i+1] = (*argv)[i] + warg; 208541b5888SSatish Balay #if defined (PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* same as 'else' case */ 209541b5888SSatish Balay getarg_(&i,(*argv)[i],warg); 210541b5888SSatish Balay #elif defined(PETSC_HAVE_PXFGETARG_NEW) 211ba9a049bSBarry Smith {char *tmp = (*argv)[i]; 212ba9a049bSBarry Smith int ilen; 213ba9a049bSBarry Smith getarg_(&i,tmp,&ilen,&ierr,warg);CHKERRQ(ierr); 214a297a907SKarl Rupp tmp[ilen] = 0;} 215ba9a049bSBarry Smith #elif defined(PETSC_USE_NARGS) 216ba9a049bSBarry Smith GETARG(&i,(*argv)[i],warg,&flg); 217ba9a049bSBarry Smith #else 218ba9a049bSBarry Smith /* 219ba9a049bSBarry Smith Because the stupid #defines above define all kinds of things to getarg_ we cannot do this test 220ba9a049bSBarry Smith #elif defined(PETSC_HAVE_GETARG) 221ba9a049bSBarry Smith getarg_(&i,(*argv)[i],warg); 222ba9a049bSBarry Smith #else 223ba9a049bSBarry Smith SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot get Fortran command line arguments"); 224ba9a049bSBarry Smith */ 225ba9a049bSBarry Smith getarg_(&i,(*argv)[i],warg); 226ba9a049bSBarry Smith #endif 227ba9a049bSBarry Smith /* zero out garbage at end of each argument */ 228ba9a049bSBarry Smith p = (*argv)[i] + warg-1; 229ba9a049bSBarry Smith while (p > (*argv)[i]) { 230ba9a049bSBarry Smith if (*p == ' ') *p = 0; 231ba9a049bSBarry Smith p--; 232ba9a049bSBarry Smith } 233ba9a049bSBarry Smith } 234ba9a049bSBarry Smith } 235ba9a049bSBarry Smith ierr = MPI_Bcast((*argv)[0],*argc*warg,MPI_CHAR,0,PETSC_COMM_WORLD);CHKERRQ(ierr); 236ba9a049bSBarry Smith if (rank) { 237a297a907SKarl Rupp for (i=0; i<*argc; i++) (*argv)[i+1] = (*argv)[i] + warg; 238ba9a049bSBarry Smith } 239ba9a049bSBarry Smith return 0; 240ba9a049bSBarry Smith } 241ba9a049bSBarry Smith 242b2bbaf76SBarry Smith #if defined(PETSC_SERIALIZE_FUNCTIONS) 243b2bbaf76SBarry Smith extern PetscFPT PetscFPTData; 244b2bbaf76SBarry Smith #endif 245b2bbaf76SBarry Smith 246ef19f930SBarry Smith #if defined(PETSC_HAVE_THREADSAFETY) 247b22622e2STadeu Manoel extern PetscSpinlock PetscViewerASCIISpinLockOpen; 248b22622e2STadeu Manoel extern PetscSpinlock PetscViewerASCIISpinLockStdout; 249b22622e2STadeu Manoel extern PetscSpinlock PetscViewerASCIISpinLockStderr; 250b22622e2STadeu Manoel extern PetscSpinlock PetscCommSpinLock; 251ef19f930SBarry Smith #endif 252ef19f930SBarry Smith 253ba9a049bSBarry Smith /* -----------------------------------------------------------------------------------------------*/ 254ba9a049bSBarry Smith 25511525c0dSBarry Smith #if defined(PETSC_HAVE_SAWS) 25611525c0dSBarry Smith #include <petscviewersaws.h> 25711525c0dSBarry Smith extern PetscErrorCode PetscInitializeSAWs(const char[]); 25811525c0dSBarry Smith #endif 259ba9a049bSBarry Smith 260ba9a049bSBarry Smith /* 261ba9a049bSBarry Smith petscinitialize - Version called from Fortran. 262ba9a049bSBarry Smith 263ba9a049bSBarry Smith Notes: 264ba9a049bSBarry Smith Since this is called from Fortran it does not return error codes 265ba9a049bSBarry Smith 266ba9a049bSBarry Smith */ 267390e1bf2SBarry Smith static void petscinitialize_internal(char* filename, PetscInt len, PetscBool readarguments, PetscErrorCode *ierr) 268ba9a049bSBarry Smith { 2694b60c348SBarry Smith int j,i; 270ba9a049bSBarry Smith #if defined (PETSC_USE_NARGS) 2714b60c348SBarry Smith short flg; 272ba9a049bSBarry Smith #endif 273da748e8fSMatthew G. Knepley #if defined(PETSC_HAVE_CUDA) 274da748e8fSMatthew G. Knepley PetscBool flg2; 27582f73ecaSAlejandro Lamas Daviña cublasStatus_t cberr; 276da748e8fSMatthew G. Knepley #endif 277ba9a049bSBarry Smith int flag; 278ba9a049bSBarry Smith PetscMPIInt size; 279ba9a049bSBarry Smith char *t1,name[256],hostname[64]; 280ba9a049bSBarry Smith PetscMPIInt f_petsc_comm_world; 281ba9a049bSBarry Smith 2824b60c348SBarry Smith *ierr = PetscMemzero(name,sizeof(name)); if (*ierr) return; 283ba9a049bSBarry Smith if (PetscInitializeCalled) {*ierr = 0; return;} 284ba9a049bSBarry Smith 285ba9a049bSBarry Smith /* this must be initialized in a routine, not as a constant declaration*/ 286ba9a049bSBarry Smith PETSC_STDOUT = stdout; 287ba9a049bSBarry Smith PETSC_STDERR = stderr; 288ba9a049bSBarry Smith 2890c30907bSSatish Balay /* on Windows - set printf to default to printing 2 digit exponents */ 2900c30907bSSatish Balay #if defined(PETSC_HAVE__SET_OUTPUT_FORMAT) 2910c30907bSSatish Balay _set_output_format(_TWO_DIGIT_EXPONENT); 2920c30907bSSatish Balay #endif 2930c30907bSSatish Balay 2944416b707SBarry Smith *ierr = PetscOptionsCreateDefault(); 295ba9a049bSBarry Smith if (*ierr) return; 296ba9a049bSBarry Smith i = 0; 297541b5888SSatish Balay #if defined (PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* same as 'else' case */ 2984b60c348SBarry Smith getarg_(&i,name,sizeof(name)); 299541b5888SSatish Balay #elif defined (PETSC_HAVE_PXFGETARG_NEW) 300ba9a049bSBarry Smith { int ilen,sierr; 301ba9a049bSBarry Smith getarg_(&i,name,&ilen,&sierr,256); 302a297a907SKarl Rupp if (sierr) PetscStrncpy(name,"Unknown Name",256); 303a297a907SKarl Rupp else name[ilen] = 0; 304ba9a049bSBarry Smith } 305ba9a049bSBarry Smith #elif defined(PETSC_USE_NARGS) 306ba9a049bSBarry Smith GETARG(&i,name,256,&flg); 307ba9a049bSBarry Smith #else 308ba9a049bSBarry Smith getarg_(&i,name,256); 3094b60c348SBarry Smith #endif 310ba9a049bSBarry Smith /* Eliminate spaces at the end of the string */ 3119350f85dSSatish Balay for (j=sizeof(name)-2; j>=0; j--) { 312ba9a049bSBarry Smith if (name[j] != ' ') { 313ba9a049bSBarry Smith name[j+1] = 0; 314ba9a049bSBarry Smith break; 315ba9a049bSBarry Smith } 316ba9a049bSBarry Smith } 317a297a907SKarl Rupp if (j<0) PetscStrncpy(name,"Unknown Name",256); 318ba9a049bSBarry Smith *ierr = PetscSetProgramName(name); 319ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscSetProgramName()\n");return;} 320ba9a049bSBarry Smith 321ba9a049bSBarry Smith /* check if PETSC_COMM_WORLD is initialized by the user in fortran */ 322ba9a049bSBarry Smith petscgetcommoncomm_(&f_petsc_comm_world); 323ba9a049bSBarry Smith MPI_Initialized(&flag); 324ba9a049bSBarry Smith if (!flag) { 325ba9a049bSBarry Smith PetscMPIInt mierr; 326ba9a049bSBarry Smith 327ba9a049bSBarry Smith if (f_petsc_comm_world) {(*PetscErrorPrintf)("You cannot set PETSC_COMM_WORLD if you have not initialized MPI first\n");return;} 328ba9a049bSBarry Smith mpi_init_(&mierr); 329ba9a049bSBarry Smith if (mierr) { 330ba9a049bSBarry Smith *ierr = mierr; 331ba9a049bSBarry Smith (*PetscErrorPrintf)("PetscInitialize: Calling Fortran MPI_Init()\n"); 332ba9a049bSBarry Smith return; 333ba9a049bSBarry Smith } 334ba9a049bSBarry Smith PetscBeganMPI = PETSC_TRUE; 335ba9a049bSBarry Smith } 336a297a907SKarl Rupp 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 */ 337a297a907SKarl Rupp else PETSC_COMM_WORLD = MPI_COMM_WORLD; 338ba9a049bSBarry Smith PetscInitializeCalled = PETSC_TRUE; 339ba9a049bSBarry Smith 3405ad9ad5bSBarry Smith *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockOpen); 3415ad9ad5bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;} 3425ad9ad5bSBarry Smith *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockStdout); 3435ad9ad5bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;} 3445ad9ad5bSBarry Smith *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockStderr); 345ef19f930SBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;} 346ef19f930SBarry Smith *ierr = PetscSpinlockCreate(&PetscCommSpinLock); 347ef19f930SBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;} 348ef19f930SBarry Smith 349ba9a049bSBarry Smith *ierr = PetscErrorPrintfInitialize(); 350ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscErrorPrintfInitialize()\n");return;} 351ba9a049bSBarry Smith *ierr = MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank); 352ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Setting PetscGlobalRank\n");return;} 353ba9a049bSBarry Smith *ierr = MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize); 354ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Setting PetscGlobalSize\n");return;} 3558ad47952SJed Brown 3568ad47952SJed Brown MPIU_BOOL = MPI_INT; 3578ad47952SJed Brown MPIU_ENUM = MPI_INT; 3588ad47952SJed Brown 359e383bbd0SJed Brown #if defined(PETSC_HAVE_COMPLEX) 360ba9a049bSBarry Smith /* 361ba9a049bSBarry Smith Initialized the global variable; this is because with 362ba9a049bSBarry Smith shared libraries the constructors for global variables 363ba9a049bSBarry Smith are not called; at least on IRIX. 364ba9a049bSBarry Smith */ 365ba9a049bSBarry Smith { 366ba9a049bSBarry Smith #if defined(PETSC_CLANGUAGE_CXX) 367e383bbd0SJed Brown PetscComplex ic(0.0,1.0); 368ba9a049bSBarry Smith PETSC_i = ic; 369ba9a049bSBarry Smith #else 370e383bbd0SJed Brown PETSC_i = _Complex_I; 371ba9a049bSBarry Smith #endif 372ba9a049bSBarry Smith } 373ba9a049bSBarry Smith 374ba9a049bSBarry Smith #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX) 375e383bbd0SJed Brown *ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU_C_DOUBLE_COMPLEX); 376ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 377ba9a049bSBarry Smith *ierr = MPI_Type_commit(&MPIU_C_DOUBLE_COMPLEX); 378ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 379ba9a049bSBarry Smith *ierr = MPI_Type_contiguous(2,MPI_FLOAT,&MPIU_C_COMPLEX); 380ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 381ba9a049bSBarry Smith *ierr = MPI_Type_commit(&MPIU_C_COMPLEX); 382ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 383ba9a049bSBarry Smith *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM); 384ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 385ba9a049bSBarry Smith #endif 386ba9a049bSBarry Smith 387ba9a049bSBarry Smith #endif 388ba9a049bSBarry Smith 389ba9a049bSBarry Smith #if defined(PETSC_USE_REAL___FLOAT128) 390ba9a049bSBarry Smith *ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU___FLOAT128); 391ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 392ba9a049bSBarry Smith *ierr = MPI_Type_commit(&MPIU___FLOAT128); 393ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 394e383bbd0SJed Brown #if defined(PETSC_HAVE_COMPLEX) 395e383bbd0SJed Brown *ierr = MPI_Type_contiguous(4,MPI_DOUBLE,&MPIU___COMPLEX128); 396ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 397ba9a049bSBarry Smith *ierr = MPI_Type_commit(&MPIU___COMPLEX128); 398ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 399ba9a049bSBarry Smith #endif 400ba9a049bSBarry Smith *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM); 401ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 402ba9a049bSBarry Smith *ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX); 403ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 404ba9a049bSBarry Smith *ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN); 405ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 406570b7f6dSBarry Smith #elif defined(PETSC_USE_REAL___FP16) 407570b7f6dSBarry Smith *ierr = MPI_Type_contiguous(2,MPI_CHAR,&MPIU___FP16); 408570b7f6dSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 409570b7f6dSBarry Smith *ierr = MPI_Type_commit(&MPIU___FP16); 410570b7f6dSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 411570b7f6dSBarry Smith *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM); 412570b7f6dSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 413570b7f6dSBarry Smith *ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX); 414570b7f6dSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 415570b7f6dSBarry Smith *ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN); 416570b7f6dSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 417570b7f6dSBarry Smith #endif 418ba9a049bSBarry Smith 419ba9a049bSBarry Smith /* 420ba9a049bSBarry Smith Create the PETSc MPI reduction operator that sums of the first 421ba9a049bSBarry Smith half of the entries and maxes the second half. 422ba9a049bSBarry Smith */ 423367daffbSBarry Smith *ierr = MPI_Op_create(MPIU_MaxSum_Local,1,&MPIU_MAXSUM_OP); 424ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;} 425ba9a049bSBarry Smith 426ba9a049bSBarry Smith *ierr = MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR); 427ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 428ba9a049bSBarry Smith *ierr = MPI_Type_commit(&MPIU_2SCALAR); 429ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 43044041f26SJed Brown #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT) 431ba9a049bSBarry Smith *ierr = MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT); 432ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 433ba9a049bSBarry Smith *ierr = MPI_Type_commit(&MPIU_2INT); 434ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;} 43544041f26SJed Brown #endif 436ba9a049bSBarry Smith *ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelCounter,&Petsc_Counter_keyval,(void*)0); 437ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;} 438da3039f7SJed Brown *ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Outer,&Petsc_InnerComm_keyval,(void*)0); 439ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;} 440da3039f7SJed Brown *ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Inner,&Petsc_OuterComm_keyval,(void*)0); 441ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;} 442ba9a049bSBarry Smith 443ba9a049bSBarry Smith /* 444ba9a049bSBarry Smith PetscInitializeFortran() is called twice. Here it initializes 445ba9a049bSBarry Smith PETSC_NULL_CHARACTER_Fortran. Below it initializes the PETSC_VIEWERs. 446ba9a049bSBarry Smith The PETSC_VIEWERs have not been created yet, so they must be initialized 447ba9a049bSBarry Smith below. 448ba9a049bSBarry Smith */ 449ba9a049bSBarry Smith PetscInitializeFortran(); 450fb2dfec1SJacht Volker if(readarguments == PETSC_TRUE) { 451ba9a049bSBarry Smith PETScParseFortranArgs_Private(&PetscGlobalArgc,&PetscGlobalArgs); 452ba9a049bSBarry Smith FIXCHAR(filename,len,t1); 453c5929fdfSBarry Smith *ierr = PetscOptionsInsert(NULL,&PetscGlobalArgc,&PetscGlobalArgs,t1); 454ba9a049bSBarry Smith FREECHAR(filename,t1); 455ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating options database\n");return;} 456fb2dfec1SJacht Volker } 457ba9a049bSBarry Smith *ierr = PetscOptionsCheckInitial_Private(); 458ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Checking initial options\n");return;} 45911525c0dSBarry Smith *ierr = PetscCitationsInitialize(); 46011525c0dSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscCitationsInitialize()\n");return;} 46111525c0dSBarry Smith #if defined(PETSC_HAVE_SAWS) 46211525c0dSBarry Smith *ierr = PetscInitializeSAWs(NULL); 46311525c0dSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Initializing SAWs\n");return;} 46411525c0dSBarry Smith #endif 465ba9a049bSBarry Smith #if defined(PETSC_USE_LOG) 466896238b9SBarry Smith *ierr = PetscLogInitialize(); 467ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: intializing logging\n");return;} 468ba9a049bSBarry Smith #endif 469ba9a049bSBarry Smith *ierr = PetscInitialize_DynamicLibraries(); 470ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Initializing dynamic libraries\n");return;} 471ba9a049bSBarry Smith 472ba9a049bSBarry Smith *ierr = PetscInitializeFortran(); 473ba9a049bSBarry Smith if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Setting up common block\n");return;} 474ba9a049bSBarry Smith 475ba9a049bSBarry Smith *ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size); 476ba9a049bSBarry Smith if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Getting MPI_Comm_size()\n");return;} 477ba9a049bSBarry Smith *ierr = PetscInfo1(0,"(Fortran):PETSc successfully started: procs %d\n",size); 478ba9a049bSBarry Smith if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Calling PetscInfo()\n");return;} 479ba9a049bSBarry Smith *ierr = PetscGetHostName(hostname,64); 480ba9a049bSBarry Smith if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Getting hostname\n");return;} 481ba9a049bSBarry Smith *ierr = PetscInfo1(0,"Running on machine: %s\n",hostname); 482ba9a049bSBarry Smith if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Calling PetscInfo()\n");return;} 483ba9a049bSBarry Smith *ierr = PetscOptionsCheckInitial_Components(); 484ba9a049bSBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Checking initial options\n");return;} 485ba9a049bSBarry Smith 486ef19f930SBarry Smith #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY) 4879248b815SShri Abhyankar *ierr = PetscStackCreate(); 4883f209d92SBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscStackCreate()\n");return;} 4899248b815SShri Abhyankar #endif 4909248b815SShri Abhyankar 491b2bbaf76SBarry Smith #if defined(PETSC_SERIALIZE_FUNCTIONS) 492b2bbaf76SBarry Smith *ierr = PetscFPTCreate(10000); 493b2bbaf76SBarry Smith if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscFPTCreate()\n");return;} 494b2bbaf76SBarry Smith #endif 495b2bbaf76SBarry Smith 496ba9a049bSBarry Smith #if defined(PETSC_HAVE_CUDA) 497da748e8fSMatthew G. Knepley flg2 = PETSC_TRUE; 498c5929fdfSBarry Smith *ierr = PetscOptionsGetBool(NULL,NULL,"-cublas",&flg2,NULL); 49982f73ecaSAlejandro Lamas Daviña if (flg2) { 50082f73ecaSAlejandro Lamas Daviña cberr = cublasCreate(&cublasv2handle); 50182f73ecaSAlejandro Lamas Daviña if (((int)cberr) != (int)CUBLAS_STATUS_SUCCESS) {(*PetscErrorPrintf)("PetscInitialize:CUBLAS error %d\n",cberr);return;} 50282f73ecaSAlejandro Lamas Daviña } 503ba9a049bSBarry Smith #endif 504ba9a049bSBarry Smith } 505ba9a049bSBarry Smith 506390e1bf2SBarry Smith PETSC_EXTERN void PETSC_STDCALL petscinitialize_(char* filename PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 507fb2dfec1SJacht Volker { 508fb2dfec1SJacht Volker petscinitialize_internal(filename, len, PETSC_TRUE, ierr); 509fb2dfec1SJacht Volker } 510fb2dfec1SJacht Volker 511fb2dfec1SJacht Volker PETSC_EXTERN void PETSC_STDCALL petscinitializenoarguments_(PetscErrorCode *ierr) 512fb2dfec1SJacht Volker { 513fb2dfec1SJacht Volker petscinitialize_internal(NULL, (PetscInt) 0, PETSC_FALSE, ierr); 514fb2dfec1SJacht Volker } 515fb2dfec1SJacht Volker 516fb2dfec1SJacht Volker 5178cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL petscfinalize_(PetscErrorCode *ierr) 518ba9a049bSBarry Smith { 519ba9a049bSBarry Smith #if defined(PETSC_HAVE_SUNMATHPRO) 520ba9a049bSBarry Smith extern void standard_arithmetic(); 521ba9a049bSBarry Smith standard_arithmetic(); 522ba9a049bSBarry Smith #endif 523ba9a049bSBarry Smith /* was malloced with PetscMallocAlign() so free the same way */ 524efca3c55SSatish Balay *ierr = PetscFreeAlign(PetscGlobalArgs,0,0,0);if (*ierr) {(*PetscErrorPrintf)("PetscFinalize:Freeing args\n");return;} 525ba9a049bSBarry Smith 526ba9a049bSBarry Smith *ierr = PetscFinalize(); 527ba9a049bSBarry Smith } 528ba9a049bSBarry Smith 529a45aced0SAlex Fikl PETSC_EXTERN void PETSC_STDCALL petscend_(PetscErrorCode *ierr) 530ba9a049bSBarry Smith { 531ba9a049bSBarry Smith #if defined(PETSC_HAVE_SUNMATHPRO) 532ba9a049bSBarry Smith extern void standard_arithmetic(); 533ba9a049bSBarry Smith standard_arithmetic(); 534ba9a049bSBarry Smith #endif 535ba9a049bSBarry Smith 536ba9a049bSBarry Smith *ierr = PetscEnd(); 537ba9a049bSBarry Smith } 538ba9a049bSBarry Smith 539