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