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: #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)

 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

 28: #if defined(PETSC_USE_64BIT_INDICES)
 29: #define PetscInt integer8
 30: #else
 31: #define PetscInt integer4
 32: #endif
 33: #define PetscInt64 integer8

 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

 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

 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

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

116: #define PetscReal2d type(tPetscReal2d)

118: #define PetscObjectIsNull(obj) (obj%v == 0 .or. obj%v == -2 .or. obj%v == -3)
119: #define PetscObjectNullify(obj) obj%v PETSC_FORTRAN_TYPE_INITIALIZE
120: !
121: !     Macros for error checking
122: !
123: #define SETERRQ(c, ierr, s)  call PetscError(c, ierr, 0, s); return
124: #define SETERRA(c, ierr, s)  call PetscError(c, ierr, 0, s); call MPIU_Abort(c, ierr)
125: #if defined(PETSC_HAVE_FORTRAN_FREE_LINE_LENGTH_NONE)
126: #define CHKERRQ(ierr) if (ierr .ne. 0) then;call PetscErrorF(ierr,__LINE__,__FILE__);return;endif
127: #define CHKERRA(ierr) if (ierr .ne. 0) then;call PetscErrorF(ierr,__LINE__,__FILE__);call MPIU_Abort(PETSC_COMM_SELF,ierr);endif
128: #define CHKERRMPI(ierr) if (ierr .ne. 0) then;call PetscErrorMPI(ierr,__LINE__,__FILE__);return;endif
129: #define CHKERRMPIA(ierr) if (ierr .ne. 0) then;call PetscErrorMPI(ierr,__LINE__,__FILE__);call MPIU_Abort(PETSC_COMM_SELF,ierr);endif
130: #else
131: #define CHKERRQ(ierr) if (ierr .ne. 0) then;call PetscErrorF(ierr);return;endif
132: #define CHKERRA(ierr) if (ierr .ne. 0) then;call PetscErrorF(ierr);call MPIU_Abort(PETSC_COMM_SELF,ierr);endif
133: #define CHKERRMPI(ierr) if (ierr .ne. 0) then;call PetscErrorMPI(ierr);return;endif
134: #define CHKERRMPIA(ierr) if (ierr .ne. 0) then;call PetscErrorMPI(ierr);call MPIU_Abort(PETSC_COMM_SELF,ierr);endif
135: #endif
136: #define CHKMEMQ call chkmemfortran(__LINE__,__FILE__,ierr)
137: #define PetscCall(func) call func; CHKERRQ(ierr)
138: #define PetscCallMPI(func) call func; CHKERRMPI(ierr)
139: #define PetscCallA(func) call func; CHKERRA(ierr)
140: #define PetscCallMPIA(func) call func; CHKERRMPIA(ierr)
141: #define PetscCheckA(err, c, ierr, s) if (.not.(err)) then; SETERRA(c, ierr, s); endif
142: #define PetscCheck(err, c, ierr, s) if (.not.(err)) then; SETERRQ(c, ierr, s); endif

144: #if !defined(PetscFlush)
145: #if defined(PETSC_HAVE_FORTRAN_FLUSH)
146: #define PetscFlush(a)    flush(a)
147: #elif defined(PETSC_HAVE_FORTRAN_FLUSH_)
148: #define PetscFlush(a)    flush_(a)
149: #else
150: #define PetscFlush(a)
151: #endif
152: #endif

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

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

158: #endif