Actual source code: zbagf90.c

  1: #include <petsc/private/f90impl.h>
  2: #include <petsc/private/fortranimpl.h>
  3: #include <petscbag.h>
  4: #include <petsc/private/bagimpl.h>
  5: #include <petscviewer.h>

  7: #if defined(PETSC_HAVE_FORTRAN_CAPS)
  8:   #define petscbaggetdata_           PETSCBAGGETDATA
  9:   #define petscbagregisterint_       PETSCBAGREGISTERINT
 10:   #define petscbagregisterint64_     PETSCBAGREGISTERINT64
 11:   #define petscbagregisterintarray_  PETSCBAGREGISTERINTARRAY
 12:   #define petscbagregisterscalar_    PETSCBAGREGISTERSCALAR
 13:   #define petscbagregisterstring_    PETSCBAGREGISTERSTRING
 14:   #define petscbagregisterreal_      PETSCBAGREGISTERREAL
 15:   #define petscbagregisterrealarray_ PETSCBAGREGISTERREALARRAY
 16:   #define petscbagregisterbool_      PETSCBAGREGISTERBOOL
 17:   #define petscbagregisterboolarray_ PETSCBAGREGISTERBOOLARRAY
 18:   #define petscbagcreate_            PETSCBAGCREATE
 19: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 20:   #define petscbaggetdata_           petscbaggetdata
 21:   #define petscbagregisterint_       petscbagregisterint
 22:   #define petscbagregisterint64_     petscbagregisterint64
 23:   #define petscbagregisterintarray_  petscbagregisterintarray
 24:   #define petscbagregisterscalar_    petscbagregisterscalar
 25:   #define petscbagregisterstring_    petscbagregisterstring
 26:   #define petscbagregisterreal_      petscbagregisterreal
 27:   #define petscbagregisterrealarray_ petscbagregisterrealarray
 28:   #define petscbagregisterbool_      petscbagregisterbool
 29:   #define petscbagregisterboolarray_ petscbagregisterboolarray
 30:   #define petscbagcreate_            petscbagcreate
 31: #endif

 33: PETSC_EXTERN void petscbagcreate_(MPI_Fint *comm, size_t *bagsize, PetscBag *bag, PetscErrorCode *ierr)
 34: {
 35:   *ierr = PetscBagCreate(MPI_Comm_f2c(*(comm)), *bagsize, bag);
 36: }

 38: PETSC_EXTERN void petscbagregisterint_(PetscBag *bag, void *ptr, PetscInt *def, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
 39: {
 40:   char *t1, *t2;
 41:   FIXCHAR(s1, l1, t1);
 42:   FIXCHAR(s2, l2, t2);
 43:   *ierr = PetscBagRegisterInt(*bag, ptr, *def, t1, t2);
 44:   if (*ierr) return;
 45:   FREECHAR(s1, t1);
 46:   FREECHAR(s2, t2);
 47: }

 49: PETSC_EXTERN void petscbagregisterint64_(PetscBag *bag, void *ptr, PetscInt64 *def, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
 50: {
 51:   char *t1, *t2;
 52:   FIXCHAR(s1, l1, t1);
 53:   FIXCHAR(s2, l2, t2);
 54:   *ierr = PetscBagRegisterInt64(*bag, ptr, *def, t1, t2);
 55:   if (*ierr) return;
 56:   FREECHAR(s1, t1);
 57:   FREECHAR(s2, t2);
 58: }

 60: PETSC_EXTERN void petscbagregisterintarray_(PetscBag *bag, void *ptr, PetscInt *msize, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
 61: {
 62:   char *t1, *t2;
 63:   FIXCHAR(s1, l1, t1);
 64:   FIXCHAR(s2, l2, t2);
 65:   *ierr = PetscBagRegisterIntArray(*bag, ptr, *msize, t1, t2);
 66:   if (*ierr) return;
 67:   FREECHAR(s1, t1);
 68:   FREECHAR(s2, t2);
 69: }

 71: PETSC_EXTERN void petscbagregisterscalar_(PetscBag *bag, void *ptr, PetscScalar *def, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
 72: {
 73:   char *t1, *t2;
 74:   FIXCHAR(s1, l1, t1);
 75:   FIXCHAR(s2, l2, t2);
 76:   *ierr = PetscBagRegisterScalar(*bag, ptr, *def, t1, t2);
 77:   if (*ierr) return;
 78:   FREECHAR(s1, t1);
 79:   FREECHAR(s2, t2);
 80: }

 82: PETSC_EXTERN void petscbagregisterreal_(PetscBag *bag, void *ptr, PetscReal *def, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
 83: {
 84:   char *t1, *t2;
 85:   FIXCHAR(s1, l1, t1);
 86:   FIXCHAR(s2, l2, t2);
 87:   *ierr = PetscBagRegisterReal(*bag, ptr, *def, t1, t2);
 88:   if (*ierr) return;
 89:   FREECHAR(s1, t1);
 90:   FREECHAR(s2, t2);
 91: }

 93: PETSC_EXTERN void petscbagregisterrealarray_(PetscBag *bag, void *ptr, PetscInt *msize, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
 94: {
 95:   char *t1, *t2;
 96:   FIXCHAR(s1, l1, t1);
 97:   FIXCHAR(s2, l2, t2);
 98:   *ierr = PetscBagRegisterRealArray(*bag, ptr, *msize, t1, t2);
 99:   if (*ierr) return;
100:   FREECHAR(s1, t1);
101:   FREECHAR(s2, t2);
102: }

104: PETSC_EXTERN void petscbagregisterbool_(PetscBag *bag, void *ptr, PetscBool *def, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
105: {
106:   char     *t1, *t2;
107:   PetscBool flg = PETSC_FALSE;

109:   /* some Fortran compilers use -1 as boolean */
110:   if (*def) flg = PETSC_TRUE;
111:   FIXCHAR(s1, l1, t1);
112:   FIXCHAR(s2, l2, t2);
113:   *ierr = PetscBagRegisterBool(*bag, ptr, flg, t1, t2);
114:   if (*ierr) return;
115:   FREECHAR(s1, t1);
116:   FREECHAR(s2, t2);
117: }

119: PETSC_EXTERN void petscbagregisterboolarray_(PetscBag *bag, void *ptr, PetscInt *msize, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
120: {
121:   char *t1, *t2;

123:   /* some Fortran compilers use -1 as boolean */
124:   FIXCHAR(s1, l1, t1);
125:   FIXCHAR(s2, l2, t2);
126:   *ierr = PetscBagRegisterBoolArray(*bag, ptr, *msize, t1, t2);
127:   if (*ierr) return;
128:   FREECHAR(s1, t1);
129:   FREECHAR(s2, t2);
130: }

132: PETSC_EXTERN void petscbagregisterstring_(PetscBag *bag, char *p, char *cs1, char *s1, char *s2, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T pl, PETSC_FORTRAN_CHARLEN_T cl1, PETSC_FORTRAN_CHARLEN_T l1, PETSC_FORTRAN_CHARLEN_T l2)
133: {
134:   char *t1, *t2, *ct1;
135:   FIXCHAR(s1, l1, t1);
136:   FIXCHAR(cs1, cl1, ct1);
137:   FIXCHAR(s2, l2, t2);
138:   *ierr = PetscBagRegisterString(*bag, (void *)p, (PetscInt)pl, ct1, t1, t2);
139:   if (*ierr) return;
140:   FREECHAR(cs1, ct1);
141:   FREECHAR(s1, t1);
142:   FREECHAR(s2, t2);
143: }

145: PETSC_EXTERN void petscbaggetdata_(PetscBag *bag, void **data, PetscErrorCode *ierr)
146: {
147:   *ierr = PetscBagGetData(*bag, data);
148: }