1 #include <petsc/private/fortranimpl.h> 2 #include <petscdm.h> 3 #include <petscviewer.h> 4 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 66 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 } 72 73 PETSC_EXTERN void dmaddfield_(DM *dm, DMLabel label, PetscObject *disc, PetscErrorCode *ierr) 74 { 75 CHKFORTRANNULLOBJECT(label); 76 *ierr = DMAddField(*dm, label, *disc); 77 } 78 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 } 85 86 PETSC_EXTERN void dmgetmattype_(DM *mm, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 87 { 88 const char *tname; 89 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 } 98 99 PETSC_EXTERN void dmgetvectype_(DM *mm, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 100 { 101 const char *tname; 102 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 } 111 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 } 118 119 PETSC_EXTERN void dmsetoptionsprefix_(DM *dm, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 120 { 121 char *t; 122 123 FIXCHAR(prefix, len, t); 124 *ierr = DMSetOptionsPrefix(*dm, t); 125 if (*ierr) return; 126 FREECHAR(prefix, t); 127 } 128 129 PETSC_EXTERN void dmsettype_(DM *x, char *type_name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 130 { 131 char *t; 132 133 FIXCHAR(type_name, len, t); 134 *ierr = DMSetType(*x, t); 135 if (*ierr) return; 136 FREECHAR(type_name, t); 137 } 138 139 PETSC_EXTERN void dmgettype_(DM *mm, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 140 { 141 const char *tname; 142 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 } 151 152 PETSC_EXTERN void dmsetmattype_(DM *dm, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 153 { 154 char *t; 155 156 FIXCHAR(prefix, len, t); 157 *ierr = DMSetMatType(*dm, t); 158 if (*ierr) return; 159 FREECHAR(prefix, t); 160 } 161 162 PETSC_EXTERN void dmsetvectype_(DM *dm, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 163 { 164 char *t; 165 166 FIXCHAR(prefix, len, t); 167 *ierr = DMSetVecType(*dm, t); 168 if (*ierr) return; 169 FREECHAR(prefix, t); 170 } 171 172 PETSC_EXTERN void dmcreatelabel_(DM *dm, char *name, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN) 173 { 174 char *lname; 175 176 FIXCHAR(name, lenN, lname); 177 *ierr = DMCreateLabel(*dm, lname); 178 if (*ierr) return; 179 FREECHAR(name, lname); 180 } 181 182 PETSC_EXTERN void dmhaslabel_(DM *dm, char *name, PetscBool *hasLabel, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN) 183 { 184 char *lname; 185 186 FIXCHAR(name, lenN, lname); 187 *ierr = DMHasLabel(*dm, lname, hasLabel); 188 if (*ierr) return; 189 FREECHAR(name, lname); 190 } 191 192 PETSC_EXTERN void dmgetlabelvalue_(DM *dm, char *name, PetscInt *point, PetscInt *value, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN) 193 { 194 char *lname; 195 196 FIXCHAR(name, lenN, lname); 197 *ierr = DMGetLabelValue(*dm, lname, *point, value); 198 if (*ierr) return; 199 FREECHAR(name, lname); 200 } 201 202 PETSC_EXTERN void dmsetlabelvalue_(DM *dm, char *name, PetscInt *point, PetscInt *value, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN) 203 { 204 char *lname; 205 206 FIXCHAR(name, lenN, lname); 207 *ierr = DMSetLabelValue(*dm, lname, *point, *value); 208 if (*ierr) return; 209 FREECHAR(name, lname); 210 } 211 212 PETSC_EXTERN void dmgetlabelsize_(DM *dm, char *name, PetscInt *size, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN) 213 { 214 char *lname; 215 216 FIXCHAR(name, lenN, lname); 217 *ierr = DMGetLabelSize(*dm, lname, size); 218 if (*ierr) return; 219 FREECHAR(name, lname); 220 } 221 222 PETSC_EXTERN void dmgetlabelidis_(DM *dm, char *name, IS *ids, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN) 223 { 224 char *lname; 225 226 FIXCHAR(name, lenN, lname); 227 *ierr = DMGetLabelIdIS(*dm, lname, ids); 228 if (*ierr) return; 229 FREECHAR(name, lname); 230 } 231 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 } 240 241 PETSC_EXTERN void dmgetlabel_(DM *dm, char *name, DMLabel *label, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN) 242 { 243 char *lname; 244 245 FIXCHAR(name, lenN, lname); 246 *ierr = DMGetLabel(*dm, lname, label); 247 if (*ierr) return; 248 FREECHAR(name, lname); 249 } 250 251 PETSC_EXTERN void dmgetstratumsize_(DM *dm, char *name, PetscInt *value, PetscInt *size, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN) 252 { 253 char *lname; 254 255 FIXCHAR(name, lenN, lname); 256 *ierr = DMGetStratumSize(*dm, lname, *value, size); 257 if (*ierr) return; 258 FREECHAR(name, lname); 259 } 260 261 PETSC_EXTERN void dmgetstratumis_(DM *dm, char *name, PetscInt *value, IS *is, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN) 262 { 263 char *lname; 264 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 } 271 272 PETSC_EXTERN void dmsetstratumis_(DM *dm, char *name, PetscInt *value, IS *is, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN) 273 { 274 char *lname; 275 276 FIXCHAR(name, lenN, lname); 277 *ierr = DMSetStratumIS(*dm, lname, *value, *is); 278 if (*ierr) return; 279 FREECHAR(name, lname); 280 } 281 282 PETSC_EXTERN void dmremovelabel_(DM *dm, char *name, DMLabel *label, int *ierr, PETSC_FORTRAN_CHARLEN_T lenN) 283 { 284 char *lname; 285 286 FIXCHAR(name, lenN, lname); 287 *ierr = DMRemoveLabel(*dm, lname, label); 288 if (*ierr) return; 289 FREECHAR(name, lname); 290 } 291 292 PETSC_EXTERN void dmviewfromoptions_(DM *dm, PetscObject obj, char *type, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 293 { 294 char *t; 295 296 FIXCHAR(type, len, t); 297 CHKFORTRANNULLOBJECT(obj); 298 *ierr = DMViewFromOptions(*dm, obj, t); 299 if (*ierr) return; 300 FREECHAR(type, t); 301 } 302 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 } 308 309 PETSC_EXTERN void dmcreatesuperdm_(DM dms[], PetscInt *len, IS ***is, DM *superdm, int *ierr) 310 { 311 *ierr = DMCreateSuperDM(dms, *len, *is, superdm); 312 } 313 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 } 319 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 } 327