Actual source code: zdmf.c
1: #include <petsc/private/fortranimpl.h>
2: #include <petscdm.h>
3: #include <petscviewer.h>
5: #if defined(PETSC_HAVE_FORTRAN_CAPS)
6: #define dmcreateinterpolation_ DMCREATEINTERPOLATION
7: #define dmview_ DMVIEW
8: #define dmsetoptionsprefix_ DMSETOPTIONSPREFIX
9: #define dmsettype_ DMSETTYPE
10: #define dmgettype_ DMGETTYPE
11: #define dmsetmattype_ DMSETMATTYPE
12: #define dmsetvectype_ DMSETVECTYPE
13: #define dmgetmattype_ DMGETMATTYPE
14: #define dmgetvectype_ DMGETVECTYPE
15: #define dmlabelview_ DMLABELVIEW
16: #define dmcreatelabel_ DMCREATELABEL
17: #define dmhaslabel_ DMHASLABEL
18: #define dmgetlabelvalue_ DMGETLABELVALUE
19: #define dmsetlabelvalue_ DMSETLABELVALUE
20: #define dmgetlabelsize_ DMGETLABELSIZE
21: #define dmgetlabelidis_ DMGETLABELIDIS
22: #define dmgetlabelname_ DMGETLABELNAME
23: #define dmgetlabel_ DMGETLABEL
24: #define dmgetstratumsize_ DMGETSTRATUMSIZE
25: #define dmgetstratumis_ DMGETSTRATUMIS
26: #define dmsetstratumis_ DMSETSTRATUMIS
27: #define dmremovelabel_ DMREMOVELABEL
28: #define dmviewfromoptions_ DMVIEWFROMOPTIONS
29: #define dmcreatesuperdm_ DMCREATESUPERDM
30: #define dmcreatesubdm_ DMCREATESUBDM
31: #define dmdestroy_ DMDESTROY
32: #define dmload_ DMLOAD
33: #define dmsetfield_ DMSETFIELD
34: #define dmaddfield_ DMADDFIELD
35: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
36: #define dmcreateinterpolation_ dmcreateinterpolation
37: #define dmview_ dmview
38: #define dmsetoptionsprefix_ dmsetoptionsprefix
39: #define dmsettype_ dmsettype
40: #define dmgettype_ dmgettype
41: #define dmsetmattype_ dmsetmattype
42: #define dmsetvectype_ dmsetvectype
43: #define dmgetmattype_ dmgetmattype
44: #define dmgetvectype_ dmgetvectype
45: #define dmlabelview_ dmlabelview
46: #define dmcreatelabel_ dmcreatelabel
47: #define dmhaslabel_ dmhaslabel
48: #define dmgetlabelvalue_ dmgetlabelvalue
49: #define dmsetlabelvalue_ dmsetlabelvalue
50: #define dmgetlabelsize_ dmlabelsize
51: #define dmgetlabelidis_ dmlabelidis
52: #define dmgetlabelname_ dmgetlabelname
53: #define dmgetlabel_ dmgetlabel
54: #define dmgetstratumsize_ dmgetstratumsize
55: #define dmgetstratumis_ dmgetstratumis
56: #define dmsetstratumis_ dmsetstratumis
57: #define dmremovelabel_ dmremovelabel
58: #define dmviewfromoptions_ dmviewfromoptions
59: #define dmcreatesuperdm_ dmreatesuperdm
60: #define dmcreatesubdm_ dmreatesubdm
61: #define dmdestroy_ dmdestroy
62: #define dmload_ dmload
63: #define dmsetfield_ dmsetfield
64: #define dmaddfield_ dmaddfield
65: #endif
67: PETSC_EXTERN void dmsetfield_(DM *dm, PetscInt *f, DMLabel label, PetscObject *disc, PetscErrorCode *ierr)
68: {
69: CHKFORTRANNULLOBJECT(label);
70: *ierr = DMSetField(*dm, *f, label, *disc);
71: }
73: PETSC_EXTERN void dmaddfield_(DM *dm, DMLabel label, PetscObject *disc, PetscErrorCode *ierr)
74: {
75: CHKFORTRANNULLOBJECT(label);
76: *ierr = DMAddField(*dm, label, *disc);
77: }
79: PETSC_EXTERN void dmload_(DM *dm, PetscViewer *vin, PetscErrorCode *ierr)
80: {
81: PetscViewer v;
82: PetscPatchDefaultViewers_Fortran(vin, v);
83: *ierr = DMLoad(*dm, v);
84: }
86: PETSC_EXTERN void dmgetmattype_(DM *mm, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
87: {
88: const char *tname;
90: *ierr = DMGetMatType(*mm, &tname);
91: if (*ierr) return;
92: if (name != PETSC_NULL_CHARACTER_Fortran) {
93: *ierr = PetscStrncpy(name, tname, len);
94: if (*ierr) return;
95: }
96: FIXRETURNCHAR(PETSC_TRUE, name, len);
97: }
99: PETSC_EXTERN void dmgetvectype_(DM *mm, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
100: {
101: const char *tname;
103: *ierr = DMGetVecType(*mm, &tname);
104: if (*ierr) return;
105: if (name != PETSC_NULL_CHARACTER_Fortran) {
106: *ierr = PetscStrncpy(name, tname, len);
107: if (*ierr) return;
108: }
109: FIXRETURNCHAR(PETSC_TRUE, name, len);
110: }
112: PETSC_EXTERN void dmview_(DM *da, PetscViewer *vin, PetscErrorCode *ierr)
113: {
114: PetscViewer v;
115: PetscPatchDefaultViewers_Fortran(vin, v);
116: *ierr = DMView(*da, v);
117: }
119: PETSC_EXTERN void dmsetoptionsprefix_(DM *dm, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
120: {
121: char *t;
123: FIXCHAR(prefix, len, t);
124: *ierr = DMSetOptionsPrefix(*dm, t);
125: if (*ierr) return;
126: FREECHAR(prefix, t);
127: }
129: PETSC_EXTERN void dmsettype_(DM *x, char *type_name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
130: {
131: char *t;
133: FIXCHAR(type_name, len, t);
134: *ierr = DMSetType(*x, t);
135: if (*ierr) return;
136: FREECHAR(type_name, t);
137: }
139: PETSC_EXTERN void dmgettype_(DM *mm, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
140: {
141: const char *tname;
143: *ierr = DMGetType(*mm, &tname);
144: if (*ierr) return;
145: if (name != PETSC_NULL_CHARACTER_Fortran) {
146: *ierr = PetscStrncpy(name, tname, len);
147: if (*ierr) return;
148: }
149: FIXRETURNCHAR(PETSC_TRUE, name, len);
150: }
152: PETSC_EXTERN void dmsetmattype_(DM *dm, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
153: {
154: char *t;
156: FIXCHAR(prefix, len, t);
157: *ierr = DMSetMatType(*dm, t);
158: if (*ierr) return;
159: FREECHAR(prefix, t);
160: }
162: PETSC_EXTERN void dmsetvectype_(DM *dm, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
163: {
164: char *t;
166: FIXCHAR(prefix, len, t);
167: *ierr = DMSetVecType(*dm, t);
168: if (*ierr) return;
169: FREECHAR(prefix, t);
170: }
172: PETSC_EXTERN void dmcreatelabel_(DM *dm, char *name, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN)
173: {
174: char *lname;
176: FIXCHAR(name, lenN, lname);
177: *ierr = DMCreateLabel(*dm, lname);
178: if (*ierr) return;
179: FREECHAR(name, lname);
180: }
182: PETSC_EXTERN void dmhaslabel_(DM *dm, char *name, PetscBool *hasLabel, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN)
183: {
184: char *lname;
186: FIXCHAR(name, lenN, lname);
187: *ierr = DMHasLabel(*dm, lname, hasLabel);
188: if (*ierr) return;
189: FREECHAR(name, lname);
190: }
192: PETSC_EXTERN void dmgetlabelvalue_(DM *dm, char *name, PetscInt *point, PetscInt *value, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN)
193: {
194: char *lname;
196: FIXCHAR(name, lenN, lname);
197: *ierr = DMGetLabelValue(*dm, lname, *point, value);
198: if (*ierr) return;
199: FREECHAR(name, lname);
200: }
202: PETSC_EXTERN void dmsetlabelvalue_(DM *dm, char *name, PetscInt *point, PetscInt *value, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN)
203: {
204: char *lname;
206: FIXCHAR(name, lenN, lname);
207: *ierr = DMSetLabelValue(*dm, lname, *point, *value);
208: if (*ierr) return;
209: FREECHAR(name, lname);
210: }
212: PETSC_EXTERN void dmgetlabelsize_(DM *dm, char *name, PetscInt *size, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN)
213: {
214: char *lname;
216: FIXCHAR(name, lenN, lname);
217: *ierr = DMGetLabelSize(*dm, lname, size);
218: if (*ierr) return;
219: FREECHAR(name, lname);
220: }
222: PETSC_EXTERN void dmgetlabelidis_(DM *dm, char *name, IS *ids, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN)
223: {
224: char *lname;
226: FIXCHAR(name, lenN, lname);
227: *ierr = DMGetLabelIdIS(*dm, lname, ids);
228: if (*ierr) return;
229: FREECHAR(name, lname);
230: }
232: PETSC_EXTERN void dmgetlabelname_(DM *dm, PetscInt *n, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
233: {
234: const char *tmp;
235: *ierr = DMGetLabelName(*dm, *n, &tmp);
236: *ierr = PetscStrncpy(name, tmp, len);
237: if (*ierr) return;
238: FIXRETURNCHAR(PETSC_TRUE, name, len);
239: }
241: PETSC_EXTERN void dmgetlabel_(DM *dm, char *name, DMLabel *label, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN)
242: {
243: char *lname;
245: FIXCHAR(name, lenN, lname);
246: *ierr = DMGetLabel(*dm, lname, label);
247: if (*ierr) return;
248: FREECHAR(name, lname);
249: }
251: PETSC_EXTERN void dmgetstratumsize_(DM *dm, char *name, PetscInt *value, PetscInt *size, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN)
252: {
253: char *lname;
255: FIXCHAR(name, lenN, lname);
256: *ierr = DMGetStratumSize(*dm, lname, *value, size);
257: if (*ierr) return;
258: FREECHAR(name, lname);
259: }
261: PETSC_EXTERN void dmgetstratumis_(DM *dm, char *name, PetscInt *value, IS *is, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN)
262: {
263: char *lname;
265: FIXCHAR(name, lenN, lname);
266: *ierr = DMGetStratumIS(*dm, lname, *value, is);
267: if (*ierr) return;
268: if (is && !*is) *is = (IS)0;
269: FREECHAR(name, lname);
270: }
272: PETSC_EXTERN void dmsetstratumis_(DM *dm, char *name, PetscInt *value, IS *is, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN)
273: {
274: char *lname;
276: FIXCHAR(name, lenN, lname);
277: *ierr = DMSetStratumIS(*dm, lname, *value, *is);
278: if (*ierr) return;
279: FREECHAR(name, lname);
280: }
282: PETSC_EXTERN void dmremovelabel_(DM *dm, char *name, DMLabel *label, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN)
283: {
284: char *lname;
286: FIXCHAR(name, lenN, lname);
287: *ierr = DMRemoveLabel(*dm, lname, label);
288: if (*ierr) return;
289: FREECHAR(name, lname);
290: }
292: PETSC_EXTERN void dmviewfromoptions_(DM *dm, PetscObject obj, char *type, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
293: {
294: char *t;
296: FIXCHAR(type, len, t);
297: CHKFORTRANNULLOBJECT(obj);
298: *ierr = DMViewFromOptions(*dm, obj, t);
299: if (*ierr) return;
300: FREECHAR(type, t);
301: }
303: PETSC_EXTERN void dmcreateinterpolation_(DM *dmc, DM *dmf, Mat *mat, Vec *vec, int *ierr)
304: {
305: CHKFORTRANNULLOBJECT(vec);
306: *ierr = DMCreateInterpolation(*dmc, *dmf, mat, vec);
307: }
309: PETSC_EXTERN void dmcreatesuperdm_(DM dms[], PetscInt *len, IS ***is, DM *superdm, int *ierr)
310: {
311: *ierr = DMCreateSuperDM(dms, *len, *is, superdm);
312: }
314: PETSC_EXTERN void dmcreatesubdm_(DM *dm, PetscInt *numFields, PetscInt fields[], IS *is, DM *subdm, int *ierr)
315: {
316: CHKFORTRANNULLOBJECT(is);
317: *ierr = DMCreateSubDM(*dm, *numFields, fields, is, subdm);
318: }
320: PETSC_EXTERN void dmdestroy_(DM *x, int *ierr)
321: {
322: PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(x);
323: *ierr = DMDestroy(x);
324: if (*ierr) return;
325: PETSC_FORTRAN_OBJECT_C_NULL_TO_F_DESTROYED(x);
326: }