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/ftnimpl.h> 8 #include <petscviewer.h> 9 10 #if defined(PETSC_HAVE_FORTRAN_CAPS) 11 #define petscoptionsbegin_ PETSCOPTIONSBEGIN 12 #define petscoptionsend_ PETSCOPTIONSEND 13 #define petscoptionsbool_ PETSCOPTIONSBOOL 14 #define petscoptionsbool3_ PETSCOPTIONSBOOL3 15 #define petscoptionsboolarray_ PETSCOPTIONSBOOLARRAY 16 #define petscoptionsenumprivate_ PETSCOPTIONSENUMPRIVATE 17 #define petscoptionsint_ PETSCOPTIONSINT 18 #define petscoptionsintarray_ PETSCOPTIONSINTARRAY 19 #define petscoptionsreal_ PETSCOPTIONSREAL 20 #define petscoptionsrealarray_ PETSCOPTIONSREALARRAY 21 #define petscoptionsscalar_ PETSCOPTIONSSCALAR 22 #define petscoptionsscalararray_ PETSCOPTIONSSCALARARRAY 23 #define petscoptionsstring_ PETSCOPTIONSSTRING 24 #define petscsubcommgetparent_ PETSCSUBCOMMGETPARENT 25 #define petscsubcommgetcontiguousparent_ PETSCSUBCOMMGETCONTIGUOUSPARENT 26 #define petscsubcommgetchild_ PETSCSUBCOMMGETCHILD 27 #define petscoptionsallused_ PETSCOPTIONSALLUSED 28 #define petscoptionsgetenumprivate_ PETSCOPTIONSGETENUMPRIVATE 29 #define petscoptionsgetstring_ PETSCOPTIONSGETSTRING 30 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 31 #define petscoptionsbegin_ petscoptionsbegin 32 #define petscoptionsend_ petscoptionsend 33 #define petscoptionsbool_ petscoptionsbool 34 #define petscoptionsbool3_ petscoptionsbool3 35 #define petscoptionsboolarray_ petscoptionsboolarray 36 #define petscoptionsenumprivate_ petscoptionsenumprivate 37 #define petscoptionsint_ petscoptionsint 38 #define petscoptionsintarray_ petscoptionsintarray 39 #define petscoptionsreal_ petscoptionsreal 40 #define petscoptionsrealarray_ petscoptionsrealarray 41 #define petscoptionsscalar_ petscoptionsscalar 42 #define petscoptionsscalararray_ petscoptionsscalararray 43 #define petscoptionsstring_ petscoptionsstring 44 #define petscsubcommgetparent_ petscsubcommgetparent 45 #define petscsubcommgetcontiguousparent_ petscsubcommgetcontiguousparent 46 #define petscsubcommgetchild_ petscsubcommgetchild 47 #define petscoptionsallused_ petscoptionsallused 48 #define petscoptionsgetenumprivate_ petscoptionsgetenumprivate 49 #define petscoptionsgetstring_ petscoptionsgetstring 50 #endif 51 52 static struct _n_PetscOptionItems PetscOptionsObjectBase; 53 static PetscOptionItems PetscOptionsObject = NULL; 54 55 PETSC_EXTERN void petscoptionsbegin_(MPI_Fint *fcomm, char *prefix, char *mess, char *sec, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenprefix, PETSC_FORTRAN_CHARLEN_T lenmess, PETSC_FORTRAN_CHARLEN_T lensec) 56 { 57 MPI_Comm comm = MPI_Comm_f2c(*fcomm); 58 char *cprefix, *cmess, *csec; 59 60 FIXCHAR(prefix, lenprefix, cprefix); 61 FIXCHAR(mess, lenmess, cmess); 62 FIXCHAR(sec, lensec, csec); 63 if (PetscOptionsObject) { 64 *ierr = PETSC_ERR_ARG_WRONGSTATE; 65 return; 66 } 67 PetscOptionsObject = &PetscOptionsObjectBase; 68 *ierr = PetscMemzero(PetscOptionsObject, sizeof(*PetscOptionsObject)); 69 if (*ierr) return; 70 PetscOptionsObject->count = 1; 71 *ierr = PetscOptionsBegin_Private(PetscOptionsObject, comm, cprefix, cmess, csec); 72 if (*ierr) return; 73 FREECHAR(prefix, cprefix); 74 FREECHAR(mess, cmess); 75 FREECHAR(sec, csec); 76 } 77 78 PETSC_EXTERN void petscoptionsend_(PetscErrorCode *ierr) 79 { 80 if (!PetscOptionsObject) { 81 *ierr = PETSC_ERR_ARG_WRONGSTATE; 82 return; 83 } 84 PetscOptionsObject->count = 1; 85 *ierr = PetscOptionsEnd_Private(PetscOptionsObject); 86 PetscOptionsObject = NULL; 87 } 88 89 PETSC_EXTERN void petscoptionsbool_(char *opt, char *text, char *man, PetscBool *currentvalue, PetscBool *value, PetscBool *set, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 90 { 91 char *copt, *ctext, *cman; 92 93 FIXCHAR(opt, lenopt, copt); 94 FIXCHAR(text, lentext, ctext); 95 FIXCHAR(man, lenman, cman); 96 if (!PetscOptionsObject) { 97 *ierr = PETSC_ERR_ARG_WRONGSTATE; 98 return; 99 } 100 PetscOptionsObject->count = 1; 101 *ierr = PetscOptionsBool_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set); 102 if (*ierr) return; 103 FREECHAR(opt, copt); 104 FREECHAR(text, ctext); 105 FREECHAR(man, cman); 106 } 107 108 PETSC_EXTERN void petscoptionsbool3_(char *opt, char *text, char *man, PetscBool3 *currentvalue, PetscBool3 *value, PetscBool *set, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 109 { 110 char *copt, *ctext, *cman; 111 112 FIXCHAR(opt, lenopt, copt); 113 FIXCHAR(text, lentext, ctext); 114 FIXCHAR(man, lenman, cman); 115 if (!PetscOptionsObject) { 116 *ierr = PETSC_ERR_ARG_WRONGSTATE; 117 return; 118 } 119 PetscOptionsObject->count = 1; 120 *ierr = PetscOptionsBool3_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set); 121 if (*ierr) return; 122 FREECHAR(opt, copt); 123 FREECHAR(text, ctext); 124 FREECHAR(man, cman); 125 } 126 127 PETSC_EXTERN void petscoptionsboolarray_(char *opt, char *text, char *man, PetscBool *dvalue, PetscInt *nmax, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 128 { 129 char *copt, *ctext, *cman; 130 PetscBool flag; 131 132 FIXCHAR(opt, lenopt, copt); 133 FIXCHAR(text, lentext, ctext); 134 FIXCHAR(man, lenman, cman); 135 if (!PetscOptionsObject) { 136 *ierr = PETSC_ERR_ARG_WRONGSTATE; 137 return; 138 } 139 PetscOptionsObject->count = 1; 140 *ierr = PetscOptionsBoolArray_Private(PetscOptionsObject, copt, ctext, cman, dvalue, nmax, &flag); 141 if (*ierr) return; 142 if (!FORTRANNULLBOOL(flg)) *flg = flag; 143 FREECHAR(opt, copt); 144 FREECHAR(text, ctext); 145 FREECHAR(man, cman); 146 } 147 148 PETSC_EXTERN void petscoptionsenumprivate_(char *opt, char *text, char *man, const char *const *list, PetscEnum *currentvalue, PetscEnum *ivalue, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 149 { 150 char *copt, *ctext, *cman; 151 PetscBool flag; 152 153 FIXCHAR(opt, lenopt, copt); 154 FIXCHAR(text, lentext, ctext); 155 FIXCHAR(man, lenman, cman); 156 if (!PetscOptionsObject) { 157 *ierr = PETSC_ERR_ARG_WRONGSTATE; 158 return; 159 } 160 PetscOptionsObject->count = 1; 161 *ierr = PetscOptionsEnum_Private(PetscOptionsObject, copt, ctext, cman, list, *currentvalue, ivalue, &flag); 162 if (*ierr) return; 163 if (!FORTRANNULLBOOL(flg)) *flg = flag; 164 FREECHAR(opt, copt); 165 FREECHAR(text, ctext); 166 FREECHAR(man, cman); 167 } 168 169 PETSC_EXTERN void petscoptionsint_(char *opt, char *text, char *man, PetscInt *currentvalue, PetscInt *value, PetscBool *set, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 170 { 171 char *copt, *ctext, *cman; 172 173 FIXCHAR(opt, lenopt, copt); 174 FIXCHAR(text, lentext, ctext); 175 FIXCHAR(man, lenman, cman); 176 if (!PetscOptionsObject) { 177 *ierr = PETSC_ERR_ARG_WRONGSTATE; 178 return; 179 } 180 PetscOptionsObject->count = 1; 181 *ierr = PetscOptionsInt_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set, PETSC_INT_MIN, PETSC_INT_MAX); 182 if (*ierr) return; 183 FREECHAR(opt, copt); 184 FREECHAR(text, ctext); 185 FREECHAR(man, cman); 186 } 187 188 PETSC_EXTERN void petscoptionsintarray_(char *opt, char *text, char *man, PetscInt *currentvalue, PetscInt *n, PetscBool *set, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 189 { 190 char *copt, *ctext, *cman; 191 192 FIXCHAR(opt, lenopt, copt); 193 FIXCHAR(text, lentext, ctext); 194 FIXCHAR(man, lenman, cman); 195 if (!PetscOptionsObject) { 196 *ierr = PETSC_ERR_ARG_WRONGSTATE; 197 return; 198 } 199 PetscOptionsObject->count = 1; 200 *ierr = PetscOptionsIntArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set); 201 if (*ierr) return; 202 FREECHAR(opt, copt); 203 FREECHAR(text, ctext); 204 FREECHAR(man, cman); 205 } 206 207 PETSC_EXTERN void petscoptionsreal_(char *opt, char *text, char *man, PetscReal *currentvalue, PetscReal *value, PetscBool *set, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 208 { 209 char *copt, *ctext, *cman; 210 211 FIXCHAR(opt, lenopt, copt); 212 FIXCHAR(text, lentext, ctext); 213 FIXCHAR(man, lenman, cman); 214 if (!PetscOptionsObject) { 215 *ierr = PETSC_ERR_ARG_WRONGSTATE; 216 return; 217 } 218 PetscOptionsObject->count = 1; 219 *ierr = PetscOptionsReal_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set, PETSC_MIN_REAL, PETSC_MAX_REAL); 220 if (*ierr) return; 221 FREECHAR(opt, copt); 222 FREECHAR(text, ctext); 223 FREECHAR(man, cman); 224 } 225 226 PETSC_EXTERN void petscoptionsrealarray_(char *opt, char *text, char *man, PetscReal *currentvalue, PetscInt *n, PetscBool *set, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 227 { 228 char *copt, *ctext, *cman; 229 230 FIXCHAR(opt, lenopt, copt); 231 FIXCHAR(text, lentext, ctext); 232 FIXCHAR(man, lenman, cman); 233 if (!PetscOptionsObject) { 234 *ierr = PETSC_ERR_ARG_WRONGSTATE; 235 return; 236 } 237 PetscOptionsObject->count = 1; 238 *ierr = PetscOptionsRealArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set); 239 if (*ierr) return; 240 FREECHAR(opt, copt); 241 FREECHAR(text, ctext); 242 FREECHAR(man, cman); 243 } 244 245 PETSC_EXTERN void petscoptionsscalar_(char *opt, char *text, char *man, PetscScalar *currentvalue, PetscScalar *value, PetscBool *set, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 246 { 247 char *copt, *ctext, *cman; 248 249 FIXCHAR(opt, lenopt, copt); 250 FIXCHAR(text, lentext, ctext); 251 FIXCHAR(man, lenman, cman); 252 if (!PetscOptionsObject) { 253 *ierr = PETSC_ERR_ARG_WRONGSTATE; 254 return; 255 } 256 PetscOptionsObject->count = 1; 257 *ierr = PetscOptionsScalar_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set); 258 if (*ierr) return; 259 FREECHAR(opt, copt); 260 FREECHAR(text, ctext); 261 FREECHAR(man, cman); 262 } 263 264 PETSC_EXTERN void petscoptionsscalararray_(char *opt, char *text, char *man, PetscScalar *currentvalue, PetscInt *n, PetscBool *set, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman) 265 { 266 char *copt, *ctext, *cman; 267 268 FIXCHAR(opt, lenopt, copt); 269 FIXCHAR(text, lentext, ctext); 270 FIXCHAR(man, lenman, cman); 271 if (!PetscOptionsObject) { 272 *ierr = PETSC_ERR_ARG_WRONGSTATE; 273 return; 274 } 275 PetscOptionsObject->count = 1; 276 *ierr = PetscOptionsScalarArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set); 277 if (*ierr) return; 278 FREECHAR(opt, copt); 279 FREECHAR(text, ctext); 280 FREECHAR(man, cman); 281 } 282 283 PETSC_EXTERN void petscoptionsstring_(char *opt, char *text, char *man, char *currentvalue, char *value, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman, PETSC_FORTRAN_CHARLEN_T lencurrent, PETSC_FORTRAN_CHARLEN_T lenvalue) 284 { 285 char *copt, *ctext, *cman, *ccurrent; 286 PetscBool flag; 287 288 FIXCHAR(opt, lenopt, copt); 289 FIXCHAR(text, lentext, ctext); 290 FIXCHAR(man, lenman, cman); 291 FIXCHAR(currentvalue, lencurrent, ccurrent); 292 293 if (!PetscOptionsObject) { 294 *ierr = PETSC_ERR_ARG_WRONGSTATE; 295 return; 296 } 297 PetscOptionsObject->count = 1; 298 299 *ierr = PetscOptionsString_Private(PetscOptionsObject, copt, ctext, cman, ccurrent, value, lenvalue - 1, &flag); 300 if (*ierr) return; 301 if (!FORTRANNULLBOOL(flg)) *flg = flag; 302 FREECHAR(opt, copt); 303 FREECHAR(text, ctext); 304 FREECHAR(man, cman); 305 FREECHAR(currentvalue, ccurrent); 306 FIXRETURNCHAR(flag, value, lenvalue); 307 } 308 309 PETSC_EXTERN void petscoptionsgetenumprivate_(PetscOptions *opt, char *pre, char *name, const char *const *list, PetscEnum *ivalue, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2) 310 { 311 char *c1, *c2; 312 PetscBool flag; 313 314 FIXCHAR(pre, len1, c1); 315 FIXCHAR(name, len2, c2); 316 *ierr = PetscOptionsGetEnum(*opt, c1, c2, list, ivalue, &flag); 317 if (*ierr) return; 318 if (!FORTRANNULLBOOL(flg)) *flg = flag; 319 FREECHAR(pre, c1); 320 FREECHAR(name, c2); 321 } 322 323 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) 324 { 325 char *c1, *c2, *c3; 326 size_t len3; 327 PetscBool flag; 328 329 FIXCHAR(pre, len1, c1); 330 FIXCHAR(name, len2, c2); 331 c3 = string; 332 len3 = len - 1; 333 334 *ierr = PetscOptionsGetString(*options, c1, c2, c3, len3, &flag); 335 if (*ierr) return; 336 if (!FORTRANNULLBOOL(flg)) *flg = flag; 337 FREECHAR(pre, c1); 338 FREECHAR(name, c2); 339 FIXRETURNCHAR(flag, string, len); 340 } 341 PETSC_EXTERN void petscsubcommgetparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr) 342 { 343 MPI_Comm tcomm; 344 345 *ierr = PetscSubcommGetParent(*scomm, &tcomm); 346 *pcomm = MPI_Comm_c2f(tcomm); 347 } 348 349 PETSC_EXTERN void petscsubcommgetcontiguousparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr) 350 { 351 MPI_Comm tcomm; 352 353 *ierr = PetscSubcommGetContiguousParent(*scomm, &tcomm); 354 *pcomm = MPI_Comm_c2f(tcomm); 355 } 356 357 PETSC_EXTERN void petscsubcommgetchild_(PetscSubcomm *scomm, MPI_Fint *ccomm, int *ierr) 358 { 359 MPI_Comm tcomm; 360 361 *ierr = PetscSubcommGetChild(*scomm, &tcomm); 362 *ccomm = MPI_Comm_c2f(tcomm); 363 } 364