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: }