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"

 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

 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)

 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

 33: #if defined(PETSC_USE_64BIT_INDICES)
 34: #define PetscInt integer8
 35: #else
 36: #define PetscInt integer4
 37: #endif
 38: #define PetscInt64 integer8

 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

 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

 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

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

128: #define PetscReal2d type(tPetscReal2d)

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

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

165: #define PetscEnumCase(e) case(e%v)

167: #define PetscObjectSpecificCast(sp,ob) sp%v = ob%v

169: #endif