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