1 ! 2 ! Manually maintained part of the base include file for Fortran use of PETSc. 3 ! Note: This file should contain only define statements 4 ! 5 #if !defined (PETSCSYSBASEDEF_H) 6 #define PETSCSYSBASEDEF_H 7 #include "petscconf.h" 8 #if defined (PETSC_HAVE_MPIUNI) 9 #include "petsc/mpiuni/mpiunifdef.h" 10 #endif 11 #include "petscversion.h" 12 13 ! 14 #define integer8 integer(kind=C_INT64_T) 15 #define integer4 integer(kind=C_INT32_T) 16 #define integer2 integer(kind=C_INT16_T) 17 #define integer1 integer(kind=C_INT8_T) 18 #define PetscBool logical(kind=C_BOOL) 19 20 #if (PETSC_SIZEOF_VOID_P == 8) 21 #define PetscOffset integer8 22 #define PetscFortranAddr integer8 23 #else 24 #define PetscOffset integer4 25 #define PetscFortranAddr integer4 26 #endif 27 28 #if defined(PETSC_USE_64BIT_INDICES) 29 #define PetscInt integer8 30 #else 31 #define PetscInt integer4 32 #endif 33 #define PetscInt64 integer8 34 35 #if defined(PETSC_USE_64BIT_BLAS_INDICES) 36 #define PetscBLASInt integer8 37 #else 38 #define PetscBLASInt integer4 39 #endif 40 #define PetscCuBLASInt integer4 41 #define PetscHipBLASInt integer4 42 43 ! 44 #define PetscSizeT integer(kind=C_SIZE_T) 45 ! 46 #define MPI_Comm integer4 47 #define MPI_Group integer4 48 ! 49 #define PetscEnum integer4 50 #define PetscVoid PetscFortranAddr 51 ! 52 #define PetscFortranFloat real(kind=C_FLOAT) 53 #define PetscFortranDouble real(kind=C_DOUBLE) 54 #define PetscFortranLongDouble real(kind=C_FLOAT128) 55 #if defined(PETSC_USE_REAL_SINGLE) 56 #define PetscComplex complex(kind=C_FLOAT_COMPLEX) 57 #elif defined(PETSC_USE_REAL_DOUBLE) 58 #define PetscComplex complex(kind=C_DOUBLE_COMPLEX) 59 #elif defined(PETSC_USE_REAL___FLOAT128) 60 #define PetscComplex complex(kind=C_FLOAT128_COMPLEX) 61 #endif 62 63 #if defined(PETSC_USE_COMPLEX) 64 #define PETSC_SCALAR PETSC_COMPLEX 65 #else 66 #if defined(PETSC_USE_REAL_SINGLE) 67 #define PETSC_SCALAR PETSC_FLOAT 68 #elif defined(PETSC_USE_REAL___FLOAT128) 69 #define PETSC_SCALAR PETSC___FLOAT128 70 #else 71 #define PETSC_SCALAR PETSC_DOUBLE 72 #endif 73 #endif 74 #if defined(PETSC_USE_REAL_SINGLE) 75 #define PETSC_REAL PETSC_FLOAT 76 #define PetscIntToReal(a) real(a) 77 #elif defined(PETSC_USE_REAL___FLOAT128) 78 #define PETSC_REAL PETSC___FLOAT128 79 #define PetscIntToReal(a) dble(a) 80 #else 81 #define PETSC_REAL PETSC_DOUBLE 82 #define PetscIntToReal(a) dble(a) 83 #endif 84 ! 85 ! Macro for templating between real and complex 86 ! 87 #if defined(PETSC_USE_COMPLEX) 88 #define PetscScalar PetscComplex 89 ! 90 ! F90 uses real(), conjg() when KIND parameter is used. 91 ! 92 #define PetscRealPart(a) real(a) 93 #define PetscConj(a) conjg(a) 94 #define PetscImaginaryPart(a) aimag(a) 95 #else 96 #if defined (PETSC_USE_REAL_SINGLE) 97 #define PetscScalar PetscFortranFloat 98 #elif defined(PETSC_USE_REAL___FLOAT128) 99 #define PetscScalar PetscFortranLongDouble 100 #elif defined(PETSC_USE_REAL_DOUBLE) 101 #define PetscScalar PetscFortranDouble 102 #endif 103 #define PetscRealPart(a) a 104 #define PetscConj(a) a 105 #define PetscImaginaryPart(a) 0.0 106 #endif 107 108 #if defined (PETSC_USE_REAL_SINGLE) 109 #define PetscReal PetscFortranFloat 110 #elif defined(PETSC_USE_REAL___FLOAT128) 111 #define PetscReal PetscFortranLongDouble 112 #elif defined(PETSC_USE_REAL_DOUBLE) 113 #define PetscReal PetscFortranDouble 114 #endif 115 116 #define PetscReal2d type(tPetscReal2d) 117 118 #define PETSC_FORTRAN_TYPE_INITIALIZE -2 119 #define PetscObjectIsNull(obj) (obj%v == 0 .or. obj%v == PETSC_FORTRAN_TYPE_INITIALIZE .or. obj%v == -3) 120 #define PetscObjectNullify(obj) obj%v = PETSC_FORTRAN_TYPE_INITIALIZE 121 ! 122 ! Macros for error checking 123 ! 124 #define SETERRQ(c, ierr, s) call PetscError(c, ierr, PETSC_ERROR_INITIAL, s); return 125 #define SETERRA(c, ierr, s) call PetscError(c, ierr, PETSC_ERROR_INITIAL, s); call MPIU_Abort(c, ierr) 126 #if defined(PETSC_HAVE_FORTRAN_FREE_LINE_LENGTH_NONE) 127 #define CHKERRQ(ierr) if (ierr .ne. 0) then;call PetscErrorF(ierr,__LINE__,__FILE__);return;endif 128 #define CHKERRA(ierr) if (ierr .ne. 0) then;call PetscErrorF(ierr,__LINE__,__FILE__);call MPIU_Abort(PETSC_COMM_SELF,ierr);endif 129 #define CHKERRMPI(ierr) if (ierr .ne. 0) then;call PetscErrorMPI(ierr,__LINE__,__FILE__);return;endif 130 #define CHKERRMPIA(ierr) if (ierr .ne. 0) then;call PetscErrorMPI(ierr,__LINE__,__FILE__);call MPIU_Abort(PETSC_COMM_SELF,ierr);endif 131 #else 132 #define CHKERRQ(ierr) if (ierr .ne. 0) then;call PetscErrorF(ierr);return;endif 133 #define CHKERRA(ierr) if (ierr .ne. 0) then;call PetscErrorF(ierr);call MPIU_Abort(PETSC_COMM_SELF,ierr);endif 134 #define CHKERRMPI(ierr) if (ierr .ne. 0) then;call PetscErrorMPI(ierr);return;endif 135 #define CHKERRMPIA(ierr) if (ierr .ne. 0) then;call PetscErrorMPI(ierr);call MPIU_Abort(PETSC_COMM_SELF,ierr);endif 136 #endif 137 #define CHKMEMQ call chkmemfortran(__LINE__,__FILE__,ierr) 138 #define PetscCall(func) call func; CHKERRQ(ierr) 139 #define PetscCallMPI(func) call func; CHKERRMPI(ierr) 140 #define PetscCallA(func) call func; CHKERRA(ierr) 141 #define PetscCallMPIA(func) call func; CHKERRMPIA(ierr) 142 #define PetscCheckA(err, c, ierr, s) if (.not.(err)) then; SETERRA(c, ierr, s); endif 143 #define PetscCheck(err, c, ierr, s) if (.not.(err)) then; SETERRQ(c, ierr, s); endif 144 145 #if !defined(PetscFlush) 146 #if defined(PETSC_HAVE_FORTRAN_FLUSH) 147 #define PetscFlush(a) flush(a) 148 #elif defined(PETSC_HAVE_FORTRAN_FLUSH_) 149 #define PetscFlush(a) flush_(a) 150 #else 151 #define PetscFlush(a) 152 #endif 153 #endif 154 155 #define PetscEnumCase(e) case(e%v) 156 157 #define PetscObjectSpecificCast(sp,ob) sp%v = ob%v 158 159 #endif 160