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 PetscFortranAddr integer8
 22: #else
 23: #define PetscFortranAddr integer4
 24: #endif

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

 33: #if defined(PETSC_USE_64BIT_BLAS_INDICES)
 34: #define PetscBLASInt integer8
 35: #else
 36: #define PetscBLASInt integer4
 37: #endif
 38: #define PetscCuBLASInt integer4
 39: #define PetscHipBLASInt integer4

 41: !
 42: #define PetscSizeT integer(kind=C_SIZE_T)
 43: !
 44: #if defined(PETSC_USE_MPI_F08)
 45: #define MPIU_Comm type(MPI_Comm)
 46: #define MPIU_Group type(MPI_Group)
 47: #define MPIU_Datatype type(MPI_Datatype)
 48: #define MPIU_Op type(MPI_Op)
 49: #define MPIU_Request type(MPI_Request)
 50: #define MPIU_Status type(MPI_Status)
 51: #else
 52: #define MPIU_Comm integer4
 53: #define MPIU_Group integer4
 54: #define MPIU_Datatype integer4
 55: #define MPIU_Op integer4
 56: #define MPIU_Status integer4
 57: #define MPIU_Request integer4
 58: #endif
 59: !
 60: #define PetscEnum integer4
 61: #define PetscVoid PetscFortranAddr
 62: !
 63: #define PetscFortranFloat real(kind=C_FLOAT)
 64: #define PetscFortranDouble real(kind=C_DOUBLE)
 65: #define PetscFortranLongDouble real(kind=C_FLOAT128)
 66: #if defined(PETSC_USE_REAL_SINGLE)
 67: #define PetscComplex complex(kind=C_FLOAT_COMPLEX)
 68: #elif defined(PETSC_USE_REAL_DOUBLE)
 69: #define PetscComplex complex(kind=C_DOUBLE_COMPLEX)
 70: #elif defined(PETSC_USE_REAL___FLOAT128)
 71: #define PetscComplex complex(kind=C_FLOAT128_COMPLEX)
 72: #endif

 74: #if defined(PETSC_USE_COMPLEX)
 75: #define PETSC_SCALAR PETSC_COMPLEX
 76: #else
 77: #if defined(PETSC_USE_REAL_SINGLE)
 78: #define PETSC_SCALAR PETSC_FLOAT
 79: #elif defined(PETSC_USE_REAL___FLOAT128)
 80: #define PETSC_SCALAR PETSC___FLOAT128
 81: #else
 82: #define PETSC_SCALAR PETSC_DOUBLE
 83: #endif
 84: #endif
 85: #if defined(PETSC_USE_REAL_SINGLE)
 86: #define  PETSC_REAL  PETSC_FLOAT
 87: #define PetscIntToReal(a) real(a,C_FLOAT)
 88: #elif defined(PETSC_USE_REAL___FLOAT128)
 89: #define PETSC_REAL PETSC___FLOAT128
 90: #define PetscIntToReal(a) real(a,C_FLOAT128)
 91: #else
 92: #define  PETSC_REAL  PETSC_DOUBLE
 93: #define PetscIntToReal(a) real(a,C_DOUBLE)
 94: #endif
 95: !
 96: !     Macro for templating between real and complex
 97: !
 98: #if defined(PETSC_USE_COMPLEX)
 99: #define PetscScalar PetscComplex
100: !
101: ! F90 uses real(), conjg() when KIND parameter is used.
102: !
103: #define PetscRealPart(a) real(a)
104: #define PetscConj(a) conjg(a)
105: #define PetscImaginaryPart(a) aimag(a)
106: #else
107: #if defined(PETSC_USE_REAL_SINGLE)
108: #define PetscScalar PetscFortranFloat
109: #elif defined(PETSC_USE_REAL___FLOAT128)
110: #define PetscScalar PetscFortranLongDouble
111: #elif defined(PETSC_USE_REAL_DOUBLE)
112: #define PetscScalar PetscFortranDouble
113: #endif
114: #define PetscRealPart(a) a
115: #define PetscConj(a) a
116: #define PetscImaginaryPart(a) 0.0
117: #endif

119: #if defined(PETSC_USE_REAL_SINGLE)
120: #define PetscReal PetscFortranFloat
121: #elif defined(PETSC_USE_REAL___FLOAT128)
122: #define PetscReal PetscFortranLongDouble
123: #elif defined(PETSC_USE_REAL_DOUBLE)
124: #define PetscReal PetscFortranDouble
125: #endif

127: #define PetscReal2d type(tPetscReal2d)

129: #define PETSC_FORTRAN_TYPE_INITIALIZE -2
130: #define PetscObjectIsNull(obj) (obj%v == 0 .or. obj%v ==  PETSC_FORTRAN_TYPE_INITIALIZE .or. obj%v == -3)
131: #define PetscObjectNullify(obj) obj%v = PETSC_FORTRAN_TYPE_INITIALIZE
132: !
133: !     Macros for error checking
134: !
135: #define SETERRQ(c, ierr, s)  call PetscError(c, ierr, PETSC_ERROR_INITIAL, s); return
136: #define SETERRA(c, ierr, s)  call PetscError(c, ierr, PETSC_ERROR_INITIAL, s); call MPIU_Abort(c, ierr)
137: #if defined(PETSC_HAVE_FORTRAN_FREE_LINE_LENGTH_NONE)
138: #define CHKERRQ(ierr) if (ierr .ne. 0) then;call PetscErrorF(ierr,__LINE__,__FILE__);return;endif
139: #define CHKERRA(ierr) if (ierr .ne. 0) then;call PetscErrorF(ierr,__LINE__,__FILE__);call MPIU_Abort(PETSC_COMM_SELF,ierr);endif
140: #define CHKERRMPI(ierr) if (ierr .ne. 0) then;call PetscErrorMPI(ierr,__LINE__,__FILE__);return;endif
141: #define CHKERRMPIA(ierr) if (ierr .ne. 0) then;call PetscErrorMPI(ierr,__LINE__,__FILE__);call MPIU_Abort(PETSC_COMM_SELF,ierr);endif
142: #else
143: #define CHKERRQ(ierr) if (ierr .ne. 0) then;call PetscErrorF(ierr);return;endif
144: #define CHKERRA(ierr) if (ierr .ne. 0) then;call PetscErrorF(ierr);call MPIU_Abort(PETSC_COMM_SELF,ierr);endif
145: #define CHKERRMPI(ierr) if (ierr .ne. 0) then;call PetscErrorMPI(ierr);return;endif
146: #define CHKERRMPIA(ierr) if (ierr .ne. 0) then;call PetscErrorMPI(ierr);call MPIU_Abort(PETSC_COMM_SELF,ierr);endif
147: #endif
148: #define CHKMEMQ call chkmemfortran(__LINE__,__FILE__,ierr)
149: #define PetscCall(func) call func; CHKERRQ(ierr)
150: #define PetscCallMPI(func) call func; CHKERRMPI(ierr)
151: #define PetscCallA(func) call func; CHKERRA(ierr)
152: #define PetscCallMPIA(func) call func; CHKERRMPIA(ierr)
153: #define PetscCheckA(err, c, ierr, s) if (.not.(err)) then; SETERRA(c, ierr, s); endif
154: #define PetscCheck(err, c, ierr, s) if (.not.(err)) then; SETERRQ(c, ierr, s); endif

156: #if !defined(PetscFlush)
157: #if defined(PETSC_HAVE_FORTRAN_FLUSH)
158: #define PetscFlush(a)    flush(a)
159: #elif defined(PETSC_HAVE_FORTRAN_FLUSH_)
160: #define PetscFlush(a)    flush_(a)
161: #else
162: #define PetscFlush(a)
163: #endif
164: #endif

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

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

170: #endif