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 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 30 #define dmcreateinterpolation_ dmcreateinterpolation 31 #define dmview_ dmview 32 #define dmsetoptionsprefix_ dmsetoptionsprefix 33 #define dmsettype_ dmsettype 34 #define dmgettype_ dmgettype 35 #define dmsetmattype_ dmsetmattype 36 #define dmsetvectype_ dmsetvectype 37 #define dmgetmattype_ dmgetmattype 38 #define dmgetvectype_ dmgetvectype 39 #define dmlabelview_ dmlabelview 40 #define dmcreatelabel_ dmcreatelabel 41 #define dmhaslabel_ dmhaslabel 42 #define dmgetlabelvalue_ dmgetlabelvalue 43 #define dmsetlabelvalue_ dmsetlabelvalue 44 #define dmgetlabelsize_ dmlabelsize 45 #define dmgetlabelidis_ dmlabelidis 46 #define dmgetlabelname_ dmgetlabelname 47 #define dmgetlabel_ dmgetlabel 48 #define dmgetstratumsize_ dmgetstratumsize 49 #define dmgetstratumis_ dmgetstratumis 50 #define dmsetstratumis_ dmsetstratumis 51 #define dmremovelabel_ dmremovelabel 52 #define dmviewfromoptions_ dmviewfromoptions 53 #endif 54 55 PETSC_EXTERN void dmgetmattype_(DM *mm,char* name,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 56 { 57 const char *tname; 58 59 *ierr = DMGetMatType(*mm,&tname);if (*ierr) return; 60 if (name != PETSC_NULL_CHARACTER_Fortran) { 61 *ierr = PetscStrncpy(name,tname,len);if (*ierr) return; 62 } 63 FIXRETURNCHAR(PETSC_TRUE,name,len); 64 } 65 66 PETSC_EXTERN void dmgetvectype_(DM *mm,char* name,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 67 { 68 const char *tname; 69 70 *ierr = DMGetVecType(*mm,&tname);if (*ierr) return; 71 if (name != PETSC_NULL_CHARACTER_Fortran) { 72 *ierr = PetscStrncpy(name,tname,len);if (*ierr) return; 73 } 74 FIXRETURNCHAR(PETSC_TRUE,name,len); 75 } 76 77 PETSC_EXTERN void dmview_(DM *da,PetscViewer *vin,PetscErrorCode *ierr) 78 { 79 PetscViewer v; 80 PetscPatchDefaultViewers_Fortran(vin,v); 81 *ierr = DMView(*da,v); 82 } 83 84 PETSC_EXTERN void dmsetoptionsprefix_(DM *dm,char* prefix, PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 85 { 86 char *t; 87 88 FIXCHAR(prefix,len,t); 89 *ierr = DMSetOptionsPrefix(*dm,t);if (*ierr) return; 90 FREECHAR(prefix,t); 91 } 92 93 PETSC_EXTERN void dmsettype_(DM *x,char* type_name,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 94 { 95 char *t; 96 97 FIXCHAR(type_name,len,t); 98 *ierr = DMSetType(*x,t);if (*ierr) return; 99 FREECHAR(type_name,t); 100 } 101 102 PETSC_EXTERN void dmgettype_(DM *mm,char* name,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 103 { 104 const char *tname; 105 106 *ierr = DMGetType(*mm,&tname);if (*ierr) return; 107 if (name != PETSC_NULL_CHARACTER_Fortran) { 108 *ierr = PetscStrncpy(name,tname,len);if (*ierr) return; 109 } 110 FIXRETURNCHAR(PETSC_TRUE,name,len); 111 112 } 113 114 PETSC_EXTERN void dmsetmattype_(DM *dm,char* prefix, PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 115 { 116 char *t; 117 118 FIXCHAR(prefix,len,t); 119 *ierr = DMSetMatType(*dm,t);if (*ierr) return; 120 FREECHAR(prefix,t); 121 } 122 123 124 PETSC_EXTERN void dmsetvectype_(DM *dm,char* prefix, PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 125 { 126 char *t; 127 128 FIXCHAR(prefix,len,t); 129 *ierr = DMSetVecType(*dm,t);if (*ierr) return; 130 FREECHAR(prefix,t); 131 } 132 133 PETSC_EXTERN void dmcreatelabel_(DM *dm, char* name, int *ierr,PETSC_FORTRAN_CHARLEN_T lenN) 134 { 135 char *lname; 136 137 FIXCHAR(name, lenN, lname); 138 *ierr = DMCreateLabel(*dm, lname);if (*ierr) return; 139 FREECHAR(name, lname); 140 } 141 142 PETSC_EXTERN void dmhaslabel_(DM *dm, char* name, PetscBool *hasLabel, int *ierr,PETSC_FORTRAN_CHARLEN_T lenN) 143 { 144 char *lname; 145 146 FIXCHAR(name, lenN, lname); 147 *ierr = DMHasLabel(*dm, lname, hasLabel);if (*ierr) return; 148 FREECHAR(name, lname); 149 } 150 151 PETSC_EXTERN void dmgetlabelvalue_(DM *dm, char* name, PetscInt *point, PetscInt *value, int *ierr,PETSC_FORTRAN_CHARLEN_T lenN) 152 { 153 char *lname; 154 155 FIXCHAR(name, lenN, lname); 156 *ierr = DMGetLabelValue(*dm, lname, *point, value);if (*ierr) return; 157 FREECHAR(name, lname); 158 } 159 160 PETSC_EXTERN void dmsetlabelvalue_(DM *dm, char* name, PetscInt *point, PetscInt *value, int *ierr,PETSC_FORTRAN_CHARLEN_T lenN) 161 { 162 char *lname; 163 164 FIXCHAR(name, lenN, lname); 165 *ierr = DMSetLabelValue(*dm, lname, *point, *value);if (*ierr) return; 166 FREECHAR(name, lname); 167 } 168 169 PETSC_EXTERN void dmgetlabelsize_(DM *dm, char* name, PetscInt *size, int *ierr,PETSC_FORTRAN_CHARLEN_T lenN) 170 { 171 char *lname; 172 173 FIXCHAR(name, lenN, lname); 174 *ierr = DMGetLabelSize(*dm, lname, size);if (*ierr) return; 175 FREECHAR(name, lname); 176 } 177 178 PETSC_EXTERN void dmgetlabelidis_(DM *dm, char* name, IS *ids, int *ierr,PETSC_FORTRAN_CHARLEN_T lenN) 179 { 180 char *lname; 181 182 FIXCHAR(name, lenN, lname); 183 *ierr = DMGetLabelIdIS(*dm, lname, ids);if (*ierr) return; 184 FREECHAR(name, lname); 185 } 186 187 PETSC_EXTERN void dmgetlabelname_(DM *dm,PetscInt *n,char* name,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 188 { 189 const char *tmp; 190 *ierr = DMGetLabelName(*dm,*n,&tmp); 191 *ierr = PetscStrncpy(name,tmp,len);if (*ierr) return; 192 FIXRETURNCHAR(PETSC_TRUE,name,len); 193 } 194 195 PETSC_EXTERN void dmgetlabel_(DM *dm, char* name, DMLabel *label, int *ierr,PETSC_FORTRAN_CHARLEN_T lenN) 196 { 197 char *lname; 198 199 FIXCHAR(name, lenN, lname); 200 *ierr = DMGetLabel(*dm, lname, label);if (*ierr) return; 201 FREECHAR(name, lname); 202 } 203 204 PETSC_EXTERN void dmgetstratumsize_(DM *dm, char* name, PetscInt *value, PetscInt *size, int *ierr,PETSC_FORTRAN_CHARLEN_T lenN) 205 { 206 char *lname; 207 208 FIXCHAR(name, lenN, lname); 209 *ierr = DMGetStratumSize(*dm, lname, *value, size);if (*ierr) return; 210 FREECHAR(name, lname); 211 } 212 213 PETSC_EXTERN void dmgetstratumis_(DM *dm, char* name, PetscInt *value, IS *is, int *ierr,PETSC_FORTRAN_CHARLEN_T lenN) 214 { 215 char *lname; 216 217 FIXCHAR(name, lenN, lname); 218 *ierr = DMGetStratumIS(*dm, lname, *value, is);if (*ierr) return; 219 if (is && !*is) *is = (IS)0; 220 FREECHAR(name, lname); 221 } 222 223 PETSC_EXTERN void dmsetstratumis_(DM *dm, char* name, PetscInt *value, IS *is, int *ierr,PETSC_FORTRAN_CHARLEN_T lenN) 224 { 225 char *lname; 226 227 FIXCHAR(name, lenN, lname); 228 *ierr = DMSetStratumIS(*dm, lname, *value, *is);if (*ierr) return; 229 FREECHAR(name, lname); 230 } 231 232 PETSC_EXTERN void dmremovelabel_(DM *dm, char* name, DMLabel *label, int *ierr,PETSC_FORTRAN_CHARLEN_T lenN) 233 { 234 char *lname; 235 236 FIXCHAR(name, lenN, lname); 237 *ierr = DMRemoveLabel(*dm, lname, label);if (*ierr) return; 238 FREECHAR(name, lname); 239 } 240 241 PETSC_EXTERN void dmviewfromoptions_(DM *dm,PetscObject obj,char* type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 242 { 243 char *t; 244 245 FIXCHAR(type,len,t); 246 CHKFORTRANNULLOBJECT(obj); 247 *ierr = DMViewFromOptions(*dm,obj,t);if (*ierr) return; 248 FREECHAR(type,t); 249 } 250 251 PETSC_EXTERN void dmcreateinterpolation_(DM *dmc,DM *dmf,Mat *mat,Vec *vec, int *ierr) 252 { 253 CHKFORTRANNULLOBJECT(vec); 254 *ierr = DMCreateInterpolation(*dmc,*dmf,mat,vec); 255 } 256