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