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 ! The real*8,complex*16 notatiton is used so that the 15 ! PETSc double/complex variables are not affected by 16 ! compiler options like -r4,-r8, that are sometimes invoked 17 ! by the user. NAG compiler does not like integer*4,real*8 18 19 #define integer8 integer(kind=selected_int_kind(10)) 20 #define integer4 integer(kind=selected_int_kind(5)) 21 #define integer2 integer(kind=selected_int_kind(3)) 22 #define integer1 integer(kind=selected_int_kind(1)) 23 #define PetscBool logical(kind=4) 24 25 #if (PETSC_SIZEOF_VOID_P == 8) 26 #define PetscOffset integer8 27 #define PetscFortranAddr integer8 28 #else 29 #define PetscOffset integer4 30 #define PetscFortranAddr integer4 31 #endif 32 33 #if defined(PETSC_USE_64BIT_INDICES) 34 #define PetscInt integer8 35 #else 36 #define PetscInt integer4 37 #endif 38 #define PetscInt64 integer8 39 40 #if defined(PETSC_USE_64BIT_BLAS_INDICES) 41 #define PetscBLASInt integer8 42 #else 43 #define PetscBLASInt integer4 44 #endif 45 #define PetscCuBLASInt integer4 46 #define PetscHipBLASInt integer4 47 48 ! 49 ! Fortran does not support unsigned, though ISO_C_BINDING 50 ! supports INTEGER(KIND=C_SIZE_T). We don't use that here 51 ! only to avoid importing the module. 52 #if (PETSC_SIZEOF_SIZE_T == 8) 53 #define PetscSizeT integer8 54 #else 55 #define PetscSizeT integer4 56 #endif 57 ! 58 #define MPI_Comm integer4 59 #define MPI_Group integer4 60 ! 61 #define PetscEnum integer4 62 #define PetscVoid PetscFortranAddr 63 ! 64 #define PetscFortranFloat real(kind=selected_real_kind(5)) 65 #define PetscFortranDouble real(kind=selected_real_kind(10)) 66 #define PetscFortranLongDouble real(kind=selected_real_kind(19)) 67 #if defined(PETSC_USE_REAL_SINGLE) 68 #define PetscComplex complex(kind=selected_real_kind(5)) 69 #elif defined(PETSC_USE_REAL_DOUBLE) 70 #define PetscComplex complex(kind=selected_real_kind(10)) 71 #elif defined(PETSC_USE_REAL___FLOAT128) 72 #define PetscComplex complex(kind=selected_real_kind(20)) 73 #endif 74 75 #if defined(PETSC_USE_COMPLEX) 76 #define PETSC_SCALAR PETSC_COMPLEX 77 #else 78 #if defined(PETSC_USE_REAL_SINGLE) 79 #define PETSC_SCALAR PETSC_FLOAT 80 #elif defined(PETSC_USE_REAL___FLOAT128) 81 #define PETSC_SCALAR PETSC___FLOAT128 82 #else 83 #define PETSC_SCALAR PETSC_DOUBLE 84 #endif 85 #endif 86 #if defined(PETSC_USE_REAL_SINGLE) 87 #define PETSC_REAL PETSC_FLOAT 88 #define PetscIntToReal(a) real(a) 89 #elif defined(PETSC_USE_REAL___FLOAT128) 90 #define PETSC_REAL PETSC___FLOAT128 91 #define PetscIntToReal(a) dble(a) 92 #else 93 #define PETSC_REAL PETSC_DOUBLE 94 #define PetscIntToReal(a) dble(a) 95 #endif 96 ! 97 ! Macro for templating between real and complex 98 ! 99 #if defined(PETSC_USE_COMPLEX) 100 #define PetscScalar PetscComplex 101 ! 102 ! F90 uses real(), conjg() when KIND parameter is used. 103 ! 104 #define PetscRealPart(a) real(a) 105 #define PetscConj(a) conjg(a) 106 #define PetscImaginaryPart(a) aimag(a) 107 #else 108 #if defined (PETSC_USE_REAL_SINGLE) 109 #define PetscScalar PetscFortranFloat 110 #elif defined(PETSC_USE_REAL___FLOAT128) 111 #define PetscScalar PetscFortranLongDouble 112 #elif defined(PETSC_USE_REAL_DOUBLE) 113 #define PetscScalar PetscFortranDouble 114 #endif 115 #define PetscRealPart(a) a 116 #define PetscConj(a) a 117 #define PetscImaginaryPart(a) 0.0 118 #endif 119 120 #if defined (PETSC_USE_REAL_SINGLE) 121 #define PetscReal PetscFortranFloat 122 #elif defined(PETSC_USE_REAL___FLOAT128) 123 #define PetscReal PetscFortranLongDouble 124 #elif defined(PETSC_USE_REAL_DOUBLE) 125 #define PetscReal PetscFortranDouble 126 #endif 127 128 #define PetscReal2d type(tPetscReal2d) 129 130 #define PetscObjectIsNull(obj) (obj%v == 0 .or. obj%v == -2 .or. obj%v == -3) 131 ! 132 ! Macros for error checking 133 ! 134 #define SETERRQ(c, ierr, s) call PetscError(c, ierr, 0, s); return 135 #define SETERRA(c, ierr, s) call PetscError(c, ierr, 0, s); call MPIU_Abort(c, ierr) 136 #if defined(PETSC_HAVE_FORTRAN_FREE_LINE_LENGTH_NONE) 137 #define CHKERRQ(ierr) if (ierr .ne. 0) then;call PetscErrorF(ierr,__LINE__,__FILE__);return;endif 138 #define CHKERRA(ierr) if (ierr .ne. 0) then;call PetscErrorF(ierr,__LINE__,__FILE__);call MPIU_Abort(PETSC_COMM_SELF,ierr);endif 139 #define CHKERRMPI(ierr) if (ierr .ne. 0) then;call PetscErrorMPI(ierr,__LINE__,__FILE__);return;endif 140 #define CHKERRMPIA(ierr) if (ierr .ne. 0) then;call PetscErrorMPI(ierr,__LINE__,__FILE__);call MPIU_Abort(PETSC_COMM_SELF,ierr);endif 141 #else 142 #define CHKERRQ(ierr) if (ierr .ne. 0) then;call PetscErrorF(ierr);return;endif 143 #define CHKERRA(ierr) if (ierr .ne. 0) then;call PetscErrorF(ierr);call MPIU_Abort(PETSC_COMM_SELF,ierr);endif 144 #define CHKERRMPI(ierr) if (ierr .ne. 0) then;call PetscErrorMPI(ierr);return;endif 145 #define CHKERRMPIA(ierr) if (ierr .ne. 0) then;call PetscErrorMPI(ierr);call MPIU_Abort(PETSC_COMM_SELF,ierr);endif 146 #endif 147 #define CHKMEMQ call chkmemfortran(__LINE__,__FILE__,ierr) 148 #define PetscCall(func) call func; CHKERRQ(ierr) 149 #define PetscCallMPI(func) call func; CHKERRMPI(ierr) 150 #define PetscCallA(func) call func; CHKERRA(ierr) 151 #define PetscCallMPIA(func) call func; CHKERRMPIA(ierr) 152 #define PetscCheckA(err, c, ierr, s) if (.not.(err)) then; SETERRA(c, ierr, s); endif 153 #define PetscCheck(err, c, ierr, s) if (.not.(err)) then; SETERRQ(c, ierr, s); endif 154 155 #if !defined(PetscFlush) 156 #if defined(PETSC_HAVE_FORTRAN_FLUSH) 157 #define PetscFlush(a) flush(a) 158 #elif defined(PETSC_HAVE_FORTRAN_FLUSH_) 159 #define PetscFlush(a) flush_(a) 160 #else 161 #define PetscFlush(a) 162 #endif 163 #endif 164 165 #define PetscEnumCase(e) case(e%v) 166 167 #define PetscObjectSpecificCast(sp,ob) sp%v = ob%v 168 169 #endif 170