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 petscoptionsbegin_ PETSCOPTIONSBEGIN 12 #define petscoptionsend_ PETSCOPTIONSEND 13 #define petscoptionsbool_ PETSCOPTIONSBOOL 14 #define petscoptionsboolarray_ PETSCOPTIONSBOOLARRAY 15 #define petscoptionsenumprivate_ PETSCOPTIONSENUMPRIVATE 16 #define petscoptionsint_ PETSCOPTIONSINT 17 #define petscoptionsintarray_ PETSCOPTIONSINTARRAY 18 #define petscoptionsreal_ PETSCOPTIONSREAL 19 #define petscoptionsrealarray_ PETSCOPTIONSREALARRAY 20 #define petscoptionsscalar_ PETSCOPTIONSSCALAR 21 #define petscoptionsscalararray_ PETSCOPTIONSSCALARARRAY 22 #define petscoptionsstring PETSCOPTIONSSTRING 23 #define petscsubcommview_ PETSCSUBCOMMVIEW 24 #define petscsubcommgetparent_ PETSCSUBCOMMGETPARENT 25 #define petscsubcommgetcontiguousparent_ PETSCSUBCOMMGETCONTIGUOUSPARENT 26 #define petscsubcommgetchild_ PETSCSUBCOMMGETCHILD 27 #define petscoptionsallused_ PETSCOPTIONSALLUSED 28 #define petscoptionsgetenumprivate_ PETSCOPTIONSGETENUMPRIVATE 29 #define petscoptionsgetbool_ PETSCOPTIONSGETBOOL 30 #define petscoptionsgetboolarray_ PETSCOPTIONSGETBOOLARRAY 31 #define petscoptionsgetintarray_ PETSCOPTIONSGETINTARRAY 32 #define petscoptionssetvalue_ PETSCOPTIONSSETVALUE 33 #define petscoptionsclearvalue_ PETSCOPTIONSCLEARVALUE 34 #define petscoptionshasname_ PETSCOPTIONSHASNAME 35 #define petscoptionsgetint_ PETSCOPTIONSGETINT 36 #define petscoptionsgetreal_ PETSCOPTIONSGETREAL 37 #define petscoptionsgetscalar_ PETSCOPTIONSGETSCALAR 38 #define petscoptionsgetscalararray_ PETSCOPTIONSGETSCALARARRAY 39 #define petscoptionsgetrealarray_ PETSCOPTIONSGETREALARRAY 40 #define petscoptionsgetstring_ PETSCOPTIONSGETSTRING 41 #define petscgetprogramname PETSCGETPROGRAMNAME 42 #define petscoptionsinsertfile_ PETSCOPTIONSINSERTFILE 43 #define petscoptionsclear_ PETSCOPTIONSCLEAR 44 #define petscoptionsinsertstring_ PETSCOPTIONSINSERTSTRING 45 #define petscoptionsview_ PETSCOPTIONSVIEW 46 #define petscoptionsleft_ PETSCOPTIONSLEFT 47 #define petscobjectviewfromoptions_ PETSCOBJECTVIEWFROMOPTIONS 48 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 49 #define petscoptionsbegin_ petscoptionsbegin 50 #define petscoptionsend_ petscoptionsend 51 #define petscoptionsbool_ petscoptionsbool 52 #define petscoptionsboolarray_ petscoptionsboolarray 53 #define petscoptionsenumprivate_ petscoptionsenumprivate_ 54 #define petscoptionsint_ petscoptionsint 55 #define petscoptionsintarray_ petscoptionsintarray 56 #define petscoptionsreal_ petscoptionsreal 57 #define petscoptionsrealarray_ petscoptionsrealarray 58 #define petscoptionsscalar_ petscoptionsscalar 59 #define petscoptionsscalararray_ petscoptionsscalararray 60 #define petscoptionsstring_ petscoptionsstring 61 #define petscsubcommview_ petscsubcommview 62 #define petscsubcommgetparent_ petscsubcommgetparent 63 #define petscsubcommgetcontiguousparent_ petscsubcommgetcontiguousparent 64 #define petscsubcommgetchild_ petscsubcommgetchild 65 #define petscoptionsallused_ petscoptionsallused 66 #define petscoptionsgetenumprivate_ petscoptionsgetenumprivate 67 #define petscoptionsgetbool_ petscoptionsgetbool 68 #define petscoptionsgetboolarray_ petscoptionsgetboolarray 69 #define petscoptionssetvalue_ petscoptionssetvalue 70 #define petscoptionsclearvalue_ petscoptionsclearvalue 71 #define petscoptionshasname_ petscoptionshasname 72 #define petscoptionsgetint_ petscoptionsgetint 73 #define petscoptionsgetreal_ petscoptionsgetreal 74 #define petscoptionsgetscalar_ petscoptionsgetscalar 75 #define petscoptionsgetscalararray_ petscoptionsgetscalararray 76 #define petscoptionsgetrealarray_ petscoptionsgetrealarray 77 #define petscoptionsgetstring_ petscoptionsgetstring 78 #define petscoptionsgetintarray_ petscoptionsgetintarray 79 #define petscgetprogramname_ petscgetprogramname 80 #define petscoptionsinsertfile_ petscoptionsinsertfile 81 #define petscoptionsclear_ petscoptionsclear 82 #define petscoptionsinsertstring_ petscoptionsinsertstring 83 #define petscoptionsview_ petscoptionsview 84 #define petscoptionsleft_ petscoptionsleft 85 #define petscobjectviewfromoptions_ petscobjectviewfromoptions 86 #endif 87 88 static PetscOptionItems PetscOptionsObjectBase, *PetscOptionsObject = NULL; 89 90 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) 91 { 92 MPI_Comm comm = MPI_Comm_f2c(*fcomm); 93 char *cprefix, *cmess, *csec; 94 95 FIXCHAR(prefix, lenprefix, cprefix); 96 FIXCHAR(mess, lenmess, cmess); 97 FIXCHAR(sec, lensec, csec); 98 if (PetscOptionsObject) { 99 *ierr = PETSC_ERR_ARG_WRONGSTATE; 100 return; 101 } 102 PetscOptionsObject = &PetscOptionsObjectBase; 103 *ierr = PetscMemzero(PetscOptionsObject, sizeof(*PetscOptionsObject)); 104 if (*ierr) return; 105 PetscOptionsObject->count = 1; 106 *ierr = PetscOptionsBegin_Private(PetscOptionsObject, comm, cprefix, cmess, csec); 107 if (*ierr) return; 108 FREECHAR(prefix, cprefix); 109 FREECHAR(mess, cmess); 110 FREECHAR(sec, csec); 111 } 112 113 PETSC_EXTERN void petscoptionsend_(PetscErrorCode *ierr) 114 { 115 if (!PetscOptionsObject) { 116 *ierr = PETSC_ERR_ARG_WRONGSTATE; 117 return; 118 } 119 PetscOptionsObject->count = 1; 120 *ierr = PetscOptionsEnd_Private(PetscOptionsObject); 121 PetscOptionsObject = NULL; 122 } 123 124 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) 125 { 126 char *copt, *ctext, *cman; 127 128 FIXCHAR(opt, lenopt, copt); 129 FIXCHAR(text, lentext, ctext); 130 FIXCHAR(man, lenman, cman); 131 if (!PetscOptionsObject) { 132 *ierr = PETSC_ERR_ARG_WRONGSTATE; 133 return; 134 } 135 PetscOptionsObject->count = 1; 136 *ierr = PetscOptionsBool_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set); 137 if (*ierr) return; 138 FREECHAR(opt, copt); 139 FREECHAR(text, ctext); 140 FREECHAR(man, cman); 141 } 142 143 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) 144 { 145 char *copt, *ctext, *cman; 146 PetscBool flag; 147 148 FIXCHAR(opt, lenopt, copt); 149 FIXCHAR(text, lentext, ctext); 150 FIXCHAR(man, lenman, cman); 151 if (!PetscOptionsObject) { 152 *ierr = PETSC_ERR_ARG_WRONGSTATE; 153 return; 154 } 155 PetscOptionsObject->count = 1; 156 *ierr = PetscOptionsBoolArray_Private(PetscOptionsObject, copt, ctext, cman, dvalue, nmax, &flag); 157 if (*ierr) return; 158 if (!FORTRANNULLBOOL(flg)) *flg = flag; 159 FREECHAR(opt, copt); 160 FREECHAR(text, ctext); 161 FREECHAR(man, cman); 162 } 163 164 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) 165 { 166 char *copt, *ctext, *cman; 167 PetscBool flag; 168 169 FIXCHAR(opt, lenopt, copt); 170 FIXCHAR(text, lentext, ctext); 171 FIXCHAR(man, lenman, cman); 172 if (!PetscOptionsObject) { 173 *ierr = PETSC_ERR_ARG_WRONGSTATE; 174 return; 175 } 176 PetscOptionsObject->count = 1; 177 *ierr = PetscOptionsEnum_Private(PetscOptionsObject, copt, ctext, cman, list, *currentvalue, ivalue, &flag); 178 if (*ierr) return; 179 if (!FORTRANNULLBOOL(flg)) *flg = flag; 180 FREECHAR(opt, copt); 181 FREECHAR(text, ctext); 182 FREECHAR(man, cman); 183 } 184 185 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) 186 { 187 char *copt, *ctext, *cman; 188 189 FIXCHAR(opt, lenopt, copt); 190 FIXCHAR(text, lentext, ctext); 191 FIXCHAR(man, lenman, cman); 192 if (!PetscOptionsObject) { 193 *ierr = PETSC_ERR_ARG_WRONGSTATE; 194 return; 195 } 196 PetscOptionsObject->count = 1; 197 *ierr = PetscOptionsInt_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set, PETSC_MIN_INT, PETSC_MAX_INT); 198 if (*ierr) return; 199 FREECHAR(opt, copt); 200 FREECHAR(text, ctext); 201 FREECHAR(man, cman); 202 } 203 204 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) 205 { 206 char *copt, *ctext, *cman; 207 208 FIXCHAR(opt, lenopt, copt); 209 FIXCHAR(text, lentext, ctext); 210 FIXCHAR(man, lenman, cman); 211 if (!PetscOptionsObject) { 212 *ierr = PETSC_ERR_ARG_WRONGSTATE; 213 return; 214 } 215 PetscOptionsObject->count = 1; 216 *ierr = PetscOptionsIntArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set); 217 if (*ierr) return; 218 FREECHAR(opt, copt); 219 FREECHAR(text, ctext); 220 FREECHAR(man, cman); 221 } 222 223 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) 224 { 225 char *copt, *ctext, *cman; 226 227 FIXCHAR(opt, lenopt, copt); 228 FIXCHAR(text, lentext, ctext); 229 FIXCHAR(man, lenman, cman); 230 if (!PetscOptionsObject) { 231 *ierr = PETSC_ERR_ARG_WRONGSTATE; 232 return; 233 } 234 PetscOptionsObject->count = 1; 235 *ierr = PetscOptionsReal_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set); 236 if (*ierr) return; 237 FREECHAR(opt, copt); 238 FREECHAR(text, ctext); 239 FREECHAR(man, cman); 240 } 241 242 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) 243 { 244 char *copt, *ctext, *cman; 245 246 FIXCHAR(opt, lenopt, copt); 247 FIXCHAR(text, lentext, ctext); 248 FIXCHAR(man, lenman, cman); 249 if (!PetscOptionsObject) { 250 *ierr = PETSC_ERR_ARG_WRONGSTATE; 251 return; 252 } 253 PetscOptionsObject->count = 1; 254 *ierr = PetscOptionsRealArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set); 255 if (*ierr) return; 256 FREECHAR(opt, copt); 257 FREECHAR(text, ctext); 258 FREECHAR(man, cman); 259 } 260 261 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) 262 { 263 char *copt, *ctext, *cman; 264 265 FIXCHAR(opt, lenopt, copt); 266 FIXCHAR(text, lentext, ctext); 267 FIXCHAR(man, lenman, cman); 268 if (!PetscOptionsObject) { 269 *ierr = PETSC_ERR_ARG_WRONGSTATE; 270 return; 271 } 272 PetscOptionsObject->count = 1; 273 *ierr = PetscOptionsScalar_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set); 274 if (*ierr) return; 275 FREECHAR(opt, copt); 276 FREECHAR(text, ctext); 277 FREECHAR(man, cman); 278 } 279 280 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) 281 { 282 char *copt, *ctext, *cman; 283 284 FIXCHAR(opt, lenopt, copt); 285 FIXCHAR(text, lentext, ctext); 286 FIXCHAR(man, lenman, cman); 287 if (!PetscOptionsObject) { 288 *ierr = PETSC_ERR_ARG_WRONGSTATE; 289 return; 290 } 291 PetscOptionsObject->count = 1; 292 *ierr = PetscOptionsScalarArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set); 293 if (*ierr) return; 294 FREECHAR(opt, copt); 295 FREECHAR(text, ctext); 296 FREECHAR(man, cman); 297 } 298 299 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) 300 { 301 char *copt, *ctext, *cman, *ccurrent; 302 PetscBool flag; 303 304 FIXCHAR(opt, lenopt, copt); 305 FIXCHAR(text, lentext, ctext); 306 FIXCHAR(man, lenman, cman); 307 FIXCHAR(currentvalue, lencurrent, ccurrent); 308 309 if (!PetscOptionsObject) { 310 *ierr = PETSC_ERR_ARG_WRONGSTATE; 311 return; 312 } 313 PetscOptionsObject->count = 1; 314 315 *ierr = PetscOptionsString_Private(PetscOptionsObject, copt, ctext, cman, ccurrent, value, lenvalue - 1, &flag); 316 if (*ierr) return; 317 if (!FORTRANNULLBOOL(flg)) *flg = flag; 318 FREECHAR(opt, copt); 319 FREECHAR(text, ctext); 320 FREECHAR(man, cman); 321 FREECHAR(currentvalue, ccurrent); 322 FIXRETURNCHAR(flag, value, lenvalue); 323 } 324 325 PETSC_EXTERN void petscoptionsinsertstring_(PetscOptions *options, char *file, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 326 { 327 char *c1; 328 329 FIXCHAR(file, len, c1); 330 *ierr = PetscOptionsInsertString(*options, c1); 331 if (*ierr) return; 332 FREECHAR(file, c1); 333 } 334 335 PETSC_EXTERN void petscoptionsinsertfile_(MPI_Fint *comm, PetscOptions *options, char *file, PetscBool *require, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 336 { 337 char *c1; 338 339 FIXCHAR(file, len, c1); 340 *ierr = PetscOptionsInsertFile(MPI_Comm_f2c(*comm), *options, c1, *require); 341 if (*ierr) return; 342 FREECHAR(file, c1); 343 } 344 345 PETSC_EXTERN void petscoptionssetvalue_(PetscOptions *options, char *name, char *value, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2) 346 { 347 char *c1, *c2; 348 349 FIXCHAR(name, len1, c1); 350 FIXCHAR(value, len2, c2); 351 *ierr = PetscOptionsSetValue(*options, c1, c2); 352 if (*ierr) return; 353 FREECHAR(name, c1); 354 FREECHAR(value, c2); 355 } 356 357 PETSC_EXTERN void petscoptionsclear_(PetscOptions *options, PetscErrorCode *ierr) 358 { 359 *ierr = PetscOptionsClear(*options); 360 } 361 362 PETSC_EXTERN void petscoptionsclearvalue_(PetscOptions *options, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 363 { 364 char *c1; 365 366 FIXCHAR(name, len, c1); 367 *ierr = PetscOptionsClearValue(*options, c1); 368 if (*ierr) return; 369 FREECHAR(name, c1); 370 } 371 372 PETSC_EXTERN void petscoptionshasname_(PetscOptions *options, char *pre, char *name, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2) 373 { 374 char *c1, *c2; 375 376 FIXCHAR(pre, len1, c1); 377 FIXCHAR(name, len2, c2); 378 *ierr = PetscOptionsHasName(*options, c1, c2, flg); 379 if (*ierr) return; 380 FREECHAR(pre, c1); 381 FREECHAR(name, c2); 382 } 383 384 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) 385 { 386 char *c1, *c2; 387 PetscBool flag; 388 389 FIXCHAR(pre, len1, c1); 390 FIXCHAR(name, len2, c2); 391 *ierr = PetscOptionsGetInt(*opt, c1, c2, ivalue, &flag); 392 if (*ierr) return; 393 if (!FORTRANNULLBOOL(flg)) *flg = flag; 394 FREECHAR(pre, c1); 395 FREECHAR(name, c2); 396 } 397 398 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) 399 { 400 char *c1, *c2; 401 PetscBool flag; 402 403 FIXCHAR(pre, len1, c1); 404 FIXCHAR(name, len2, c2); 405 *ierr = PetscOptionsGetEnum(*options, c1, c2, list, ivalue, &flag); 406 if (*ierr) return; 407 if (!FORTRANNULLBOOL(flg)) *flg = flag; 408 FREECHAR(pre, c1); 409 FREECHAR(name, c2); 410 } 411 412 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) 413 { 414 char *c1, *c2; 415 PetscBool flag; 416 417 FIXCHAR(pre, len1, c1); 418 FIXCHAR(name, len2, c2); 419 *ierr = PetscOptionsGetBool(*options, c1, c2, ivalue, &flag); 420 if (*ierr) return; 421 if (!FORTRANNULLBOOL(flg)) *flg = flag; 422 FREECHAR(pre, c1); 423 FREECHAR(name, c2); 424 } 425 426 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) 427 { 428 char *c1, *c2; 429 PetscBool flag; 430 431 FIXCHAR(pre, len1, c1); 432 FIXCHAR(name, len2, c2); 433 *ierr = PetscOptionsGetBoolArray(*options, c1, c2, dvalue, nmax, &flag); 434 if (*ierr) return; 435 if (!FORTRANNULLBOOL(flg)) *flg = flag; 436 FREECHAR(pre, c1); 437 FREECHAR(name, c2); 438 } 439 440 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) 441 { 442 char *c1, *c2; 443 PetscBool flag; 444 445 FIXCHAR(pre, len1, c1); 446 FIXCHAR(name, len2, c2); 447 *ierr = PetscOptionsGetReal(*options, c1, c2, dvalue, &flag); 448 if (*ierr) return; 449 if (!FORTRANNULLBOOL(flg)) *flg = flag; 450 FREECHAR(pre, c1); 451 FREECHAR(name, c2); 452 } 453 454 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) 455 { 456 char *c1, *c2; 457 PetscBool flag; 458 459 FIXCHAR(pre, len1, c1); 460 FIXCHAR(name, len2, c2); 461 *ierr = PetscOptionsGetScalar(*options, c1, c2, dvalue, &flag); 462 if (*ierr) return; 463 if (!FORTRANNULLBOOL(flg)) *flg = flag; 464 FREECHAR(pre, c1); 465 FREECHAR(name, c2); 466 } 467 468 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) 469 { 470 char *c1, *c2; 471 PetscBool flag; 472 473 FIXCHAR(pre, len1, c1); 474 FIXCHAR(name, len2, c2); 475 *ierr = PetscOptionsGetScalarArray(*options, c1, c2, dvalue, nmax, &flag); 476 if (*ierr) return; 477 if (!FORTRANNULLBOOL(flg)) *flg = flag; 478 FREECHAR(pre, c1); 479 FREECHAR(name, c2); 480 } 481 482 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) 483 { 484 char *c1, *c2; 485 PetscBool flag; 486 487 FIXCHAR(pre, len1, c1); 488 FIXCHAR(name, len2, c2); 489 *ierr = PetscOptionsGetRealArray(*options, c1, c2, dvalue, nmax, &flag); 490 if (*ierr) return; 491 if (!FORTRANNULLBOOL(flg)) *flg = flag; 492 FREECHAR(pre, c1); 493 FREECHAR(name, c2); 494 } 495 496 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) 497 { 498 char *c1, *c2; 499 PetscBool flag; 500 501 FIXCHAR(pre, len1, c1); 502 FIXCHAR(name, len2, c2); 503 *ierr = PetscOptionsGetIntArray(*options, c1, c2, dvalue, nmax, &flag); 504 if (*ierr) return; 505 if (!FORTRANNULLBOOL(flg)) *flg = flag; 506 FREECHAR(pre, c1); 507 FREECHAR(name, c2); 508 } 509 510 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) 511 { 512 char *c1, *c2, *c3; 513 size_t len3; 514 PetscBool flag; 515 516 FIXCHAR(pre, len1, c1); 517 FIXCHAR(name, len2, c2); 518 c3 = string; 519 len3 = len - 1; 520 521 *ierr = PetscOptionsGetString(*options, c1, c2, c3, len3, &flag); 522 if (*ierr) return; 523 if (!FORTRANNULLBOOL(flg)) *flg = flag; 524 FREECHAR(pre, c1); 525 FREECHAR(name, c2); 526 FIXRETURNCHAR(flag, string, len); 527 } 528 529 PETSC_EXTERN void petscgetprogramname_(char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len_in) 530 { 531 char *tmp; 532 size_t len; 533 tmp = name; 534 len = len_in - 1; 535 *ierr = PetscGetProgramName(tmp, len); 536 FIXRETURNCHAR(PETSC_TRUE, name, len_in); 537 } 538 539 PETSC_EXTERN void petscoptionsview_(PetscOptions *options, PetscViewer *vin, PetscErrorCode *ierr) 540 { 541 PetscViewer v; 542 543 PetscPatchDefaultViewers_Fortran(vin, v); 544 *ierr = PetscOptionsView(*options, v); 545 } 546 547 PETSC_EXTERN void petscobjectviewfromoptions_(PetscObject *obj, PetscObject *bobj, char *option, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T loption) 548 { 549 char *o; 550 551 FIXCHAR(option, loption, o); 552 CHKFORTRANNULLOBJECT(obj); 553 *ierr = PetscObjectViewFromOptions(*obj, *bobj, o); 554 if (*ierr) return; 555 FREECHAR(option, o); 556 } 557 558 PETSC_EXTERN void petscsubcommgetparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr) 559 { 560 MPI_Comm tcomm; 561 *ierr = PetscSubcommGetParent(*scomm, &tcomm); 562 *pcomm = MPI_Comm_c2f(tcomm); 563 } 564 565 PETSC_EXTERN void petscsubcommgetcontiguousparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr) 566 { 567 MPI_Comm tcomm; 568 *ierr = PetscSubcommGetContiguousParent(*scomm, &tcomm); 569 *pcomm = MPI_Comm_c2f(tcomm); 570 } 571 572 PETSC_EXTERN void petscsubcommgetchild_(PetscSubcomm *scomm, MPI_Fint *ccomm, int *ierr) 573 { 574 MPI_Comm tcomm; 575 *ierr = PetscSubcommGetChild(*scomm, &tcomm); 576 *ccomm = MPI_Comm_c2f(tcomm); 577 } 578 579 PETSC_EXTERN void petscsubcommview_(PetscSubcomm *psubcomm, PetscViewer *viewer, int *ierr) 580 { 581 PetscViewer v; 582 PetscPatchDefaultViewers_Fortran(viewer, v); 583 *ierr = PetscSubcommView(*psubcomm, v); 584 } 585