1 /* 2 This file contains Fortran stubs for Options routines. 3 These are not generated automatically since they require passing strings 4 between Fortran and C. 5 */ 6 7 #include <petsc/private/fortranimpl.h> 8 9 #if defined(PETSC_HAVE_FORTRAN_CAPS) 10 #define petscobjectcompose_ PETSCOBJECTCOMPOSE 11 #define petscobjectquery_ PETSCOBJECTQUERY 12 #define petscobjectreference_ PETSCOBJECTREFERENCE 13 #define petscobjectdereference_ PETSCOBJECTDEREFERENCE 14 #define petscobjectgetreference_ PETSCOBJECTGETREFERENCE 15 #define petsccudainitialize_ PETSCCUDAINITIALIZE 16 #define petschipinitialize_ PETSCHIPINITIALIZE 17 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 18 #define petscobjectcompose_ petscobjectcompose 19 #define petscobjectquery_ petscobjectquery 20 #define petscobjectreference_ petscobjectreference 21 #define petscobjectdereference_ petscobjectdereference 22 #define petscobjectgetreference_ petscobjectgetreference 23 #define petsccudainitialize_ petsccudainitialize 24 #define petschipinitialize_ petschipinitialize 25 #endif 26 27 /* ---------------------------------------------------------------------*/ 28 29 #if defined(PETSC_HAVE_CUDA) 30 PETSC_EXTERN void petsccudainitialize_(MPI_Fint *comm, PetscInt *dev,PetscErrorCode *ierr) 31 { 32 *ierr = PetscCUDAInitialize(MPI_Comm_f2c(*(comm)),*dev); 33 } 34 #endif 35 36 #if defined(PETSC_HAVE_HIP) 37 PETSC_EXTERN void petschipinitialize_(MPI_Fint *comm, PetscInt *dev,PetscErrorCode *ierr) 38 { 39 *ierr = PetscHIPInitialize(MPI_Comm_f2c(*(comm)),*dev); 40 } 41 #endif 42 43 PETSC_EXTERN void petscobjectcompose_(PetscObject *obj, char *name, PetscObject *ptr, PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 44 { 45 char *n1; 46 47 FIXCHAR(name,len,n1); 48 *ierr = PetscObjectCompose(*obj, n1, *ptr);if (*ierr) return; 49 FREECHAR(name,n1); 50 } 51 52 PETSC_EXTERN void petscobjectquery_(PetscObject *obj, char *name, PetscObject *ptr, PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 53 { 54 char *n1; 55 56 FIXCHAR(name,len,n1); 57 *ierr = PetscObjectQuery(*obj, n1, ptr);if (*ierr) return; 58 FREECHAR(name,n1); 59 } 60 61 PETSC_EXTERN void petscobjectreference_(PetscObject *obj,PetscErrorCode *ierr) 62 { 63 *ierr = PetscObjectReference(*obj); 64 } 65 66 PETSC_EXTERN void petscobjectdereference_(PetscObject *obj,PetscErrorCode *ierr) 67 { 68 *ierr = PetscObjectDereference(*obj); 69 } 70 71 PETSC_EXTERN void petscobjectgetreference_(PetscObject *obj,PetscInt *ref,PetscErrorCode *ierr) 72 { 73 *ierr = PetscObjectGetReference(*obj,ref); 74 } 75