1 /* 2 This file contains Fortran stubs for Options routines. 3 These are not generated automatically since they require passing strings 4 between Fortran and C. 5 */ 6 7 #include <petsc/private/fortranimpl.h> 8 #include <petscviewer.h> 9 10 #if defined(PETSC_HAVE_FORTRAN_CAPS) 11 #define petscsubcommview_ PETSCSUBCOMMVIEW 12 #define petscsubcommgetparent_ PETSCSUBCOMMGETPARENT 13 #define petscsubcommgetcontiguousparent_ PETSCSUBCOMMGETCONTIGUOUSPARENT 14 #define petscsubcommgetchild_ PETSCSUBCOMMGETCHILD 15 #define petscoptionsallused_ PETSCOPTIONSALLUSED 16 #define petscoptionsgetenumprivate_ PETSCOPTIONSGETENUMPRIVATE 17 #define petscoptionsgetbool_ PETSCOPTIONSGETBOOL 18 #define petscoptionsgetboolarray_ PETSCOPTIONSGETBOOLARRAY 19 #define petscoptionsgetintarray_ PETSCOPTIONSGETINTARRAY 20 #define petscoptionssetvalue_ PETSCOPTIONSSETVALUE 21 #define petscoptionsclearvalue_ PETSCOPTIONSCLEARVALUE 22 #define petscoptionshasname_ PETSCOPTIONSHASNAME 23 #define petscoptionsgetint_ PETSCOPTIONSGETINT 24 #define petscoptionsgetreal_ PETSCOPTIONSGETREAL 25 #define petscoptionsgetscalar_ PETSCOPTIONSGETSCALAR 26 #define petscoptionsgetscalararray_ PETSCOPTIONSGETSCALARARRAY 27 #define petscoptionsgetrealarray_ PETSCOPTIONSGETREALARRAY 28 #define petscoptionsgetstring_ PETSCOPTIONSGETSTRING 29 #define petscgetprogramname PETSCGETPROGRAMNAME 30 #define petscoptionsinsertfile_ PETSCOPTIONSINSERTFILE 31 #define petscoptionsclear_ PETSCOPTIONSCLEAR 32 #define petscoptionsinsertstring_ PETSCOPTIONSINSERTSTRING 33 #define petscoptionsview_ PETSCOPTIONSVIEW 34 #define petscoptionsleft_ PETSCOPTIONSLEFT 35 #define petscobjectviewfromoptions_ PETSCOBJECTVIEWFROMOPTIONS 36 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 37 #define petscsubcommview_ petscsubcommview 38 #define petscsubcommgetparent_ petscsubcommgetparent 39 #define petscsubcommgetcontiguousparent_ petscsubcommgetcontiguousparent 40 #define petscsubcommgetchild_ petscsubcommgetchild 41 #define petscoptionsallused_ petscoptionsallused 42 #define petscoptionsgetenumprivate_ petscoptionsgetenumprivate 43 #define petscoptionsgetbool_ petscoptionsgetbool 44 #define petscoptionsgetboolarray_ petscoptionsgetboolarray 45 #define petscoptionssetvalue_ petscoptionssetvalue 46 #define petscoptionsclearvalue_ petscoptionsclearvalue 47 #define petscoptionshasname_ petscoptionshasname 48 #define petscoptionsgetint_ petscoptionsgetint 49 #define petscoptionsgetreal_ petscoptionsgetreal 50 #define petscoptionsgetscalar_ petscoptionsgetscalar 51 #define petscoptionsgetscalararray_ petscoptionsgetscalararray 52 #define petscoptionsgetrealarray_ petscoptionsgetrealarray 53 #define petscoptionsgetstring_ petscoptionsgetstring 54 #define petscoptionsgetintarray_ petscoptionsgetintarray 55 #define petscgetprogramname_ petscgetprogramname 56 #define petscoptionsinsertfile_ petscoptionsinsertfile 57 #define petscoptionsclear_ petscoptionsclear 58 #define petscoptionsinsertstring_ petscoptionsinsertstring 59 #define petscoptionsview_ petscoptionsview 60 #define petscoptionsleft_ petscoptionsleft 61 #define petscobjectviewfromoptions_ petscobjectviewfromoptions 62 #endif 63 64 /* ---------------------------------------------------------------------*/ 65 66 PETSC_EXTERN void petscoptionsinsertstring_(PetscOptions *options, char *file, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 67 { 68 char *c1; 69 70 FIXCHAR(file, len, c1); 71 *ierr = PetscOptionsInsertString(*options, c1); 72 if (*ierr) return; 73 FREECHAR(file, c1); 74 } 75 76 PETSC_EXTERN void petscoptionsinsertfile_(MPI_Fint *comm, PetscOptions *options, char *file, PetscBool *require, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 77 { 78 char *c1; 79 80 FIXCHAR(file, len, c1); 81 *ierr = PetscOptionsInsertFile(MPI_Comm_f2c(*comm), *options, c1, *require); 82 if (*ierr) return; 83 FREECHAR(file, c1); 84 } 85 86 PETSC_EXTERN void petscoptionssetvalue_(PetscOptions *options, char *name, char *value, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2) 87 { 88 char *c1, *c2; 89 90 FIXCHAR(name, len1, c1); 91 FIXCHAR(value, len2, c2); 92 *ierr = PetscOptionsSetValue(*options, c1, c2); 93 if (*ierr) return; 94 FREECHAR(name, c1); 95 FREECHAR(value, c2); 96 } 97 98 PETSC_EXTERN void petscoptionsclear_(PetscOptions *options, PetscErrorCode *ierr) 99 { 100 *ierr = PetscOptionsClear(*options); 101 } 102 103 PETSC_EXTERN void petscoptionsclearvalue_(PetscOptions *options, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 104 { 105 char *c1; 106 107 FIXCHAR(name, len, c1); 108 *ierr = PetscOptionsClearValue(*options, c1); 109 if (*ierr) return; 110 FREECHAR(name, c1); 111 } 112 113 PETSC_EXTERN void petscoptionshasname_(PetscOptions *options, char *pre, char *name, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2) 114 { 115 char *c1, *c2; 116 117 FIXCHAR(pre, len1, c1); 118 FIXCHAR(name, len2, c2); 119 *ierr = PetscOptionsHasName(*options, c1, c2, flg); 120 if (*ierr) return; 121 FREECHAR(pre, c1); 122 FREECHAR(name, c2); 123 } 124 125 PETSC_EXTERN void petscoptionsgetint_(PetscOptions *opt, char *pre, char *name, PetscInt *ivalue, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2) 126 { 127 char *c1, *c2; 128 PetscBool flag; 129 130 FIXCHAR(pre, len1, c1); 131 FIXCHAR(name, len2, c2); 132 *ierr = PetscOptionsGetInt(*opt, c1, c2, ivalue, &flag); 133 if (*ierr) return; 134 if (!FORTRANNULLBOOL(flg)) *flg = flag; 135 FREECHAR(pre, c1); 136 FREECHAR(name, c2); 137 } 138 139 PETSC_EXTERN void petscoptionsgetenumprivate_(PetscOptions *options, char *pre, char *name, const char *const *list, PetscEnum *ivalue, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2) 140 { 141 char *c1, *c2; 142 PetscBool flag; 143 144 FIXCHAR(pre, len1, c1); 145 FIXCHAR(name, len2, c2); 146 *ierr = PetscOptionsGetEnum(*options, c1, c2, list, ivalue, &flag); 147 if (*ierr) return; 148 if (!FORTRANNULLBOOL(flg)) *flg = flag; 149 FREECHAR(pre, c1); 150 FREECHAR(name, c2); 151 } 152 153 PETSC_EXTERN void petscoptionsgetbool_(PetscOptions *options, char *pre, char *name, PetscBool *ivalue, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2) 154 { 155 char *c1, *c2; 156 PetscBool flag; 157 158 FIXCHAR(pre, len1, c1); 159 FIXCHAR(name, len2, c2); 160 *ierr = PetscOptionsGetBool(*options, c1, c2, ivalue, &flag); 161 if (*ierr) return; 162 if (!FORTRANNULLBOOL(flg)) *flg = flag; 163 FREECHAR(pre, c1); 164 FREECHAR(name, c2); 165 } 166 167 PETSC_EXTERN void petscoptionsgetboolarray_(PetscOptions *options, char *pre, char *name, PetscBool *dvalue, PetscInt *nmax, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2) 168 { 169 char *c1, *c2; 170 PetscBool flag; 171 172 FIXCHAR(pre, len1, c1); 173 FIXCHAR(name, len2, c2); 174 *ierr = PetscOptionsGetBoolArray(*options, c1, c2, dvalue, nmax, &flag); 175 if (*ierr) return; 176 if (!FORTRANNULLBOOL(flg)) *flg = flag; 177 FREECHAR(pre, c1); 178 FREECHAR(name, c2); 179 } 180 181 PETSC_EXTERN void petscoptionsgetreal_(PetscOptions *options, char *pre, char *name, PetscReal *dvalue, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2) 182 { 183 char *c1, *c2; 184 PetscBool flag; 185 186 FIXCHAR(pre, len1, c1); 187 FIXCHAR(name, len2, c2); 188 *ierr = PetscOptionsGetReal(*options, c1, c2, dvalue, &flag); 189 if (*ierr) return; 190 if (!FORTRANNULLBOOL(flg)) *flg = flag; 191 FREECHAR(pre, c1); 192 FREECHAR(name, c2); 193 } 194 195 PETSC_EXTERN void petscoptionsgetscalar_(PetscOptions *options, char *pre, char *name, PetscScalar *dvalue, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2) 196 { 197 char *c1, *c2; 198 PetscBool flag; 199 200 FIXCHAR(pre, len1, c1); 201 FIXCHAR(name, len2, c2); 202 *ierr = PetscOptionsGetScalar(*options, c1, c2, dvalue, &flag); 203 if (*ierr) return; 204 if (!FORTRANNULLBOOL(flg)) *flg = flag; 205 FREECHAR(pre, c1); 206 FREECHAR(name, c2); 207 } 208 209 PETSC_EXTERN void petscoptionsgetscalararray_(PetscOptions *options, char *pre, char *name, PetscScalar *dvalue, PetscInt *nmax, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2) 210 { 211 char *c1, *c2; 212 PetscBool flag; 213 214 FIXCHAR(pre, len1, c1); 215 FIXCHAR(name, len2, c2); 216 *ierr = PetscOptionsGetScalarArray(*options, c1, c2, dvalue, nmax, &flag); 217 if (*ierr) return; 218 if (!FORTRANNULLBOOL(flg)) *flg = flag; 219 FREECHAR(pre, c1); 220 FREECHAR(name, c2); 221 } 222 223 PETSC_EXTERN void petscoptionsgetrealarray_(PetscOptions *options, char *pre, char *name, PetscReal *dvalue, PetscInt *nmax, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2) 224 { 225 char *c1, *c2; 226 PetscBool flag; 227 228 FIXCHAR(pre, len1, c1); 229 FIXCHAR(name, len2, c2); 230 *ierr = PetscOptionsGetRealArray(*options, c1, c2, dvalue, nmax, &flag); 231 if (*ierr) return; 232 if (!FORTRANNULLBOOL(flg)) *flg = flag; 233 FREECHAR(pre, c1); 234 FREECHAR(name, c2); 235 } 236 237 PETSC_EXTERN void petscoptionsgetintarray_(PetscOptions *options, char *pre, char *name, PetscInt *dvalue, PetscInt *nmax, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2) 238 { 239 char *c1, *c2; 240 PetscBool flag; 241 242 FIXCHAR(pre, len1, c1); 243 FIXCHAR(name, len2, c2); 244 *ierr = PetscOptionsGetIntArray(*options, c1, c2, dvalue, nmax, &flag); 245 if (*ierr) return; 246 if (!FORTRANNULLBOOL(flg)) *flg = flag; 247 FREECHAR(pre, c1); 248 FREECHAR(name, c2); 249 } 250 251 PETSC_EXTERN void petscoptionsgetstring_(PetscOptions *options, char *pre, char *name, char *string, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2, PETSC_FORTRAN_CHARLEN_T len) 252 { 253 char *c1, *c2, *c3; 254 size_t len3; 255 PetscBool flag; 256 257 FIXCHAR(pre, len1, c1); 258 FIXCHAR(name, len2, c2); 259 c3 = string; 260 len3 = len - 1; 261 262 *ierr = PetscOptionsGetString(*options, c1, c2, c3, len3, &flag); 263 if (*ierr) return; 264 if (!FORTRANNULLBOOL(flg)) *flg = flag; 265 FREECHAR(pre, c1); 266 FREECHAR(name, c2); 267 FIXRETURNCHAR(flag, string, len); 268 } 269 270 PETSC_EXTERN void petscgetprogramname_(char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len_in) 271 { 272 char *tmp; 273 size_t len; 274 tmp = name; 275 len = len_in - 1; 276 *ierr = PetscGetProgramName(tmp, len); 277 FIXRETURNCHAR(PETSC_TRUE, name, len_in); 278 } 279 280 PETSC_EXTERN void petscoptionsview_(PetscOptions *options, PetscViewer *vin, PetscErrorCode *ierr) 281 { 282 PetscViewer v; 283 284 PetscPatchDefaultViewers_Fortran(vin, v); 285 *ierr = PetscOptionsView(*options, v); 286 } 287 288 PETSC_EXTERN void petscobjectviewfromoptions_(PetscObject *obj, PetscObject *bobj, char *option, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T loption) 289 { 290 char *o; 291 292 FIXCHAR(option, loption, o); 293 CHKFORTRANNULLOBJECT(obj); 294 *ierr = PetscObjectViewFromOptions(*obj, *bobj, o); 295 if (*ierr) return; 296 FREECHAR(option, o); 297 } 298 299 PETSC_EXTERN void petscsubcommgetparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr) 300 { 301 MPI_Comm tcomm; 302 *ierr = PetscSubcommGetParent(*scomm, &tcomm); 303 *pcomm = MPI_Comm_c2f(tcomm); 304 } 305 306 PETSC_EXTERN void petscsubcommgetcontiguousparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr) 307 { 308 MPI_Comm tcomm; 309 *ierr = PetscSubcommGetContiguousParent(*scomm, &tcomm); 310 *pcomm = MPI_Comm_c2f(tcomm); 311 } 312 313 PETSC_EXTERN void petscsubcommgetchild_(PetscSubcomm *scomm, MPI_Fint *ccomm, int *ierr) 314 { 315 MPI_Comm tcomm; 316 *ierr = PetscSubcommGetChild(*scomm, &tcomm); 317 *ccomm = MPI_Comm_c2f(tcomm); 318 } 319 320 PETSC_EXTERN void petscsubcommview_(PetscSubcomm *psubcomm, PetscViewer *viewer, int *ierr) 321 { 322 PetscViewer v; 323 PetscPatchDefaultViewers_Fortran(viewer, v); 324 *ierr = PetscSubcommView(*psubcomm, v); 325 } 326