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 petscbagdestroy_           PETSCBAGDESTROY
  9:   #define petscbagview_              PETSCBAGVIEW
 10:   #define petscbagload_              PETSCBAGLOAD
 11:   #define petscbaggetdata_           PETSCBAGGETDATA
 12:   #define petscbagregisterint_       PETSCBAGREGISTERINT
 13:   #define petscbagregisterint64_     PETSCBAGREGISTERINT64
 14:   #define petscbagregisterintarray_  PETSCBAGREGISTERINTARRAY
 15:   #define petscbagregisterscalar_    PETSCBAGREGISTERSCALAR
 16:   #define petscbagregisterstring_    PETSCBAGREGISTERSTRING
 17:   #define petscbagregisterreal_      PETSCBAGREGISTERREAL
 18:   #define petscbagregisterrealarray_ PETSCBAGREGISTERREALARRAY
 19:   #define petscbagregisterbool_      PETSCBAGREGISTERBOOL
 20:   #define petscbagregisterboolarray_ PETSCBAGREGISTERBOOLARRAY
 21:   #define petscbagsetname_           PETSCBAGSETNAME
 22:   #define petscbagsetoptionsprefix_  PETSCBAGSETOPTIONSPREFIX
 23:   #define petscbagcreate_            PETSCBAGCREATE
 24: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 25:   #define petscbagdestroy_           petscbagdestroy
 26:   #define petscbagview_              petscbagview
 27:   #define petscbagload_              petscbagload
 28:   #define petscbaggetdata_           petscbaggetdata
 29:   #define petscbagregisterint_       petscbagregisterint
 30:   #define petscbagregisterint64_     petscbagregisterint64
 31:   #define petscbagregisterintarray_  petscbagregisterintarray
 32:   #define petscbagregisterscalar_    petscbagregisterscalar
 33:   #define petscbagregisterstring_    petscbagregisterstring
 34:   #define petscbagregisterreal_      petscbagregisterreal
 35:   #define petscbagregisterrealarray_ petscbagregisterrealarray
 36:   #define petscbagregisterbool_      petscbagregisterbool
 37:   #define petscbagregisterboolarray_ petscbagregisterboolarray
 38:   #define petscbagsetname_           petscbagsetname
 39:   #define petscbagsetoptionsprefix_  petscbagsetoptionsprefix
 40:   #define petscbagcreate_            petscbagcreate
 41: #endif

 43: PETSC_EXTERN void petscbagcreate_(MPI_Fint *comm, size_t *bagsize, PetscBag *bag, PetscErrorCode *ierr)
 44: {
 45:   *ierr = PetscBagCreate(MPI_Comm_f2c(*(comm)), *bagsize, bag);
 46: }

 48: PETSC_EXTERN void petscbagdestroy_(PetscBag *bag, PetscErrorCode *ierr)
 49: {
 50:   *ierr = PetscBagDestroy(bag);
 51: }

 53: PETSC_EXTERN void petscbagview_(PetscBag *bag, PetscViewer *viewer, PetscErrorCode *ierr)
 54: {
 55:   PetscViewer v;
 56:   PetscPatchDefaultViewers_Fortran(viewer, v);
 57:   *ierr = PetscBagView(*bag, v);
 58: }

 60: PETSC_EXTERN void petscbagload_(PetscViewer *viewer, PetscBag *bag, PetscErrorCode *ierr)
 61: {
 62:   PetscViewer v;
 63:   PetscPatchDefaultViewers_Fortran(viewer, v);
 64:   *ierr = PetscBagLoad(v, *bag);
 65: }

 67: 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)
 68: {
 69:   char *t1, *t2;
 70:   FIXCHAR(s1, l1, t1);
 71:   FIXCHAR(s2, l2, t2);
 72:   *ierr = PetscBagRegisterInt(*bag, ptr, *def, t1, t2);
 73:   if (*ierr) return;
 74:   FREECHAR(s1, t1);
 75:   FREECHAR(s2, t2);
 76: }

 78: 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)
 79: {
 80:   char *t1, *t2;
 81:   FIXCHAR(s1, l1, t1);
 82:   FIXCHAR(s2, l2, t2);
 83:   *ierr = PetscBagRegisterInt64(*bag, ptr, *def, t1, t2);
 84:   if (*ierr) return;
 85:   FREECHAR(s1, t1);
 86:   FREECHAR(s2, t2);
 87: }

 89: 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)
 90: {
 91:   char *t1, *t2;
 92:   FIXCHAR(s1, l1, t1);
 93:   FIXCHAR(s2, l2, t2);
 94:   *ierr = PetscBagRegisterIntArray(*bag, ptr, *msize, t1, t2);
 95:   if (*ierr) return;
 96:   FREECHAR(s1, t1);
 97:   FREECHAR(s2, t2);
 98: }

100: 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)
101: {
102:   char *t1, *t2;
103:   FIXCHAR(s1, l1, t1);
104:   FIXCHAR(s2, l2, t2);
105:   *ierr = PetscBagRegisterScalar(*bag, ptr, *def, t1, t2);
106:   if (*ierr) return;
107:   FREECHAR(s1, t1);
108:   FREECHAR(s2, t2);
109: }

111: 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)
112: {
113:   char *t1, *t2;
114:   FIXCHAR(s1, l1, t1);
115:   FIXCHAR(s2, l2, t2);
116:   *ierr = PetscBagRegisterReal(*bag, ptr, *def, t1, t2);
117:   if (*ierr) return;
118:   FREECHAR(s1, t1);
119:   FREECHAR(s2, t2);
120: }

122: 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)
123: {
124:   char *t1, *t2;
125:   FIXCHAR(s1, l1, t1);
126:   FIXCHAR(s2, l2, t2);
127:   *ierr = PetscBagRegisterRealArray(*bag, ptr, *msize, t1, t2);
128:   if (*ierr) return;
129:   FREECHAR(s1, t1);
130:   FREECHAR(s2, t2);
131: }

133: 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)
134: {
135:   char     *t1, *t2;
136:   PetscBool flg = PETSC_FALSE;

138:   /* some Fortran compilers use -1 as boolean */
139:   if (*def) flg = PETSC_TRUE;
140:   FIXCHAR(s1, l1, t1);
141:   FIXCHAR(s2, l2, t2);
142:   *ierr = PetscBagRegisterBool(*bag, ptr, flg, t1, t2);
143:   if (*ierr) return;
144:   FREECHAR(s1, t1);
145:   FREECHAR(s2, t2);
146: }

148: 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)
149: {
150:   char *t1, *t2;

152:   /* some Fortran compilers use -1 as boolean */
153:   FIXCHAR(s1, l1, t1);
154:   FIXCHAR(s2, l2, t2);
155:   *ierr = PetscBagRegisterBoolArray(*bag, ptr, *msize, t1, t2);
156:   if (*ierr) return;
157:   FREECHAR(s1, t1);
158:   FREECHAR(s2, t2);
159: }

161: 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)
162: {
163:   char *t1, *t2, *ct1;
164:   FIXCHAR(s1, l1, t1);
165:   FIXCHAR(cs1, cl1, ct1);
166:   FIXCHAR(s2, l2, t2);
167:   *ierr = PetscBagRegisterString(*bag, p, pl, ct1, t1, t2);
168:   if (*ierr) return;
169:   FREECHAR(cs1, ct1);
170:   FREECHAR(s1, t1);
171:   FREECHAR(s2, t2);
172: }

174: PETSC_EXTERN void petscbaggetdata_(PetscBag *bag, void **data, PetscErrorCode *ierr)
175: {
176:   *ierr = PetscBagGetData(*bag, data);
177: }

179: PETSC_EXTERN void petscbagsetname_(PetscBag *bag, char *ns, char *hs, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T nl, PETSC_FORTRAN_CHARLEN_T hl)
180: {
181:   char *nt, *ht;
182:   FIXCHAR(ns, nl, nt);
183:   FIXCHAR(hs, hl, ht);
184:   *ierr = PetscBagSetName(*bag, nt, ht);
185:   if (*ierr) return;
186:   FREECHAR(ns, nt);
187:   FREECHAR(hs, ht);
188: }

190: PETSC_EXTERN void petscbagsetoptionsprefix_(PetscBag *bag, char *pre, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
191: {
192:   char *t;
193:   FIXCHAR(pre, len, t);
194:   *ierr = PetscBagSetOptionsPrefix(*bag, t);
195:   if (*ierr) return;
196:   FREECHAR(pre, t);
197: }