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