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 petscoptionsgetint_ PETSCOPTIONSGETINT 32 #define petscoptionsgetreal_ PETSCOPTIONSGETREAL 33 #define petscoptionsgetscalar_ PETSCOPTIONSGETSCALAR 34 #define petscoptionsgetscalararray_ PETSCOPTIONSGETSCALARARRAY 35 #define petscoptionsgetrealarray_ PETSCOPTIONSGETREALARRAY 36 #define petscoptionsgetstring_ PETSCOPTIONSGETSTRING 37 #define petscgetprogramname PETSCGETPROGRAMNAME 38 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 39 #define petscoptionsbegin_ petscoptionsbegin 40 #define petscoptionsend_ petscoptionsend 41 #define petscoptionsbool_ petscoptionsbool 42 #define petscoptionsboolarray_ petscoptionsboolarray 43 #define petscoptionsenumprivate_ petscoptionsenumprivate 44 #define petscoptionsint_ petscoptionsint 45 #define petscoptionsintarray_ petscoptionsintarray 46 #define petscoptionsreal_ petscoptionsreal 47 #define petscoptionsrealarray_ petscoptionsrealarray 48 #define petscoptionsscalar_ petscoptionsscalar 49 #define petscoptionsscalararray_ petscoptionsscalararray 50 #define petscoptionsstring_ petscoptionsstring 51 #define petscsubcommgetparent_ petscsubcommgetparent 52 #define petscsubcommgetcontiguousparent_ petscsubcommgetcontiguousparent 53 #define petscsubcommgetchild_ petscsubcommgetchild 54 #define petscoptionsallused_ petscoptionsallused 55 #define petscoptionsgetenumprivate_ petscoptionsgetenumprivate 56 #define petscoptionsgetbool_ petscoptionsgetbool 57 #define petscoptionsgetboolarray_ petscoptionsgetboolarray 58 #define petscoptionsgetint_ petscoptionsgetint 59 #define petscoptionsgetreal_ petscoptionsgetreal 60 #define petscoptionsgetscalar_ petscoptionsgetscalar 61 #define petscoptionsgetscalararray_ petscoptionsgetscalararray 62 #define petscoptionsgetrealarray_ petscoptionsgetrealarray 63 #define petscoptionsgetstring_ petscoptionsgetstring 64 #define petscoptionsgetintarray_ petscoptionsgetintarray 65 #define petscgetprogramname_ petscgetprogramname 66 #endif 67 68 static PetscOptionItems PetscOptionsObjectBase, *PetscOptionsObject = NULL; 69 70 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) 71 { 72 MPI_Comm comm = MPI_Comm_f2c(*fcomm); 73 char *cprefix, *cmess, *csec; 74 75 FIXCHAR(prefix, lenprefix, cprefix); 76 FIXCHAR(mess, lenmess, cmess); 77 FIXCHAR(sec, lensec, csec); 78 if (PetscOptionsObject) { 79 *ierr = PETSC_ERR_ARG_WRONGSTATE; 80 return; 81 } 82 PetscOptionsObject = &PetscOptionsObjectBase; 83 *ierr = PetscMemzero(PetscOptionsObject, sizeof(*PetscOptionsObject)); 84 if (*ierr) return; 85 PetscOptionsObject->count = 1; 86 *ierr = PetscOptionsBegin_Private(PetscOptionsObject, comm, cprefix, cmess, csec); 87 if (*ierr) return; 88 FREECHAR(prefix, cprefix); 89 FREECHAR(mess, cmess); 90 FREECHAR(sec, csec); 91 } 92 93 PETSC_EXTERN void petscoptionsend_(PetscErrorCode *ierr) 94 { 95 if (!PetscOptionsObject) { 96 *ierr = PETSC_ERR_ARG_WRONGSTATE; 97 return; 98 } 99 PetscOptionsObject->count = 1; 100 *ierr = PetscOptionsEnd_Private(PetscOptionsObject); 101 PetscOptionsObject = NULL; 102 } 103 104 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) 105 { 106 char *copt, *ctext, *cman; 107 108 FIXCHAR(opt, lenopt, copt); 109 FIXCHAR(text, lentext, ctext); 110 FIXCHAR(man, lenman, cman); 111 if (!PetscOptionsObject) { 112 *ierr = PETSC_ERR_ARG_WRONGSTATE; 113 return; 114 } 115 PetscOptionsObject->count = 1; 116 *ierr = PetscOptionsBool_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set); 117 if (*ierr) return; 118 FREECHAR(opt, copt); 119 FREECHAR(text, ctext); 120 FREECHAR(man, cman); 121 } 122 123 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) 124 { 125 char *copt, *ctext, *cman; 126 PetscBool flag; 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 = PetscOptionsBoolArray_Private(PetscOptionsObject, copt, ctext, cman, dvalue, nmax, &flag); 137 if (*ierr) return; 138 if (!FORTRANNULLBOOL(flg)) *flg = flag; 139 FREECHAR(opt, copt); 140 FREECHAR(text, ctext); 141 FREECHAR(man, cman); 142 } 143 144 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) 145 { 146 char *copt, *ctext, *cman; 147 PetscBool flag; 148 149 FIXCHAR(opt, lenopt, copt); 150 FIXCHAR(text, lentext, ctext); 151 FIXCHAR(man, lenman, cman); 152 if (!PetscOptionsObject) { 153 *ierr = PETSC_ERR_ARG_WRONGSTATE; 154 return; 155 } 156 PetscOptionsObject->count = 1; 157 *ierr = PetscOptionsEnum_Private(PetscOptionsObject, copt, ctext, cman, list, *currentvalue, ivalue, &flag); 158 if (*ierr) return; 159 if (!FORTRANNULLBOOL(flg)) *flg = flag; 160 FREECHAR(opt, copt); 161 FREECHAR(text, ctext); 162 FREECHAR(man, cman); 163 } 164 165 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) 166 { 167 char *copt, *ctext, *cman; 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 = PetscOptionsInt_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set, PETSC_INT_MIN, PETSC_INT_MAX); 178 if (*ierr) return; 179 FREECHAR(opt, copt); 180 FREECHAR(text, ctext); 181 FREECHAR(man, cman); 182 } 183 184 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) 185 { 186 char *copt, *ctext, *cman; 187 188 FIXCHAR(opt, lenopt, copt); 189 FIXCHAR(text, lentext, ctext); 190 FIXCHAR(man, lenman, cman); 191 if (!PetscOptionsObject) { 192 *ierr = PETSC_ERR_ARG_WRONGSTATE; 193 return; 194 } 195 PetscOptionsObject->count = 1; 196 *ierr = PetscOptionsIntArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set); 197 if (*ierr) return; 198 FREECHAR(opt, copt); 199 FREECHAR(text, ctext); 200 FREECHAR(man, cman); 201 } 202 203 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) 204 { 205 char *copt, *ctext, *cman; 206 207 FIXCHAR(opt, lenopt, copt); 208 FIXCHAR(text, lentext, ctext); 209 FIXCHAR(man, lenman, cman); 210 if (!PetscOptionsObject) { 211 *ierr = PETSC_ERR_ARG_WRONGSTATE; 212 return; 213 } 214 PetscOptionsObject->count = 1; 215 *ierr = PetscOptionsReal_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set, PETSC_MIN_REAL, PETSC_MAX_REAL); 216 if (*ierr) return; 217 FREECHAR(opt, copt); 218 FREECHAR(text, ctext); 219 FREECHAR(man, cman); 220 } 221 222 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) 223 { 224 char *copt, *ctext, *cman; 225 226 FIXCHAR(opt, lenopt, copt); 227 FIXCHAR(text, lentext, ctext); 228 FIXCHAR(man, lenman, cman); 229 if (!PetscOptionsObject) { 230 *ierr = PETSC_ERR_ARG_WRONGSTATE; 231 return; 232 } 233 PetscOptionsObject->count = 1; 234 *ierr = PetscOptionsRealArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set); 235 if (*ierr) return; 236 FREECHAR(opt, copt); 237 FREECHAR(text, ctext); 238 FREECHAR(man, cman); 239 } 240 241 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) 242 { 243 char *copt, *ctext, *cman; 244 245 FIXCHAR(opt, lenopt, copt); 246 FIXCHAR(text, lentext, ctext); 247 FIXCHAR(man, lenman, cman); 248 if (!PetscOptionsObject) { 249 *ierr = PETSC_ERR_ARG_WRONGSTATE; 250 return; 251 } 252 PetscOptionsObject->count = 1; 253 *ierr = PetscOptionsScalar_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set); 254 if (*ierr) return; 255 FREECHAR(opt, copt); 256 FREECHAR(text, ctext); 257 FREECHAR(man, cman); 258 } 259 260 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) 261 { 262 char *copt, *ctext, *cman; 263 264 FIXCHAR(opt, lenopt, copt); 265 FIXCHAR(text, lentext, ctext); 266 FIXCHAR(man, lenman, cman); 267 if (!PetscOptionsObject) { 268 *ierr = PETSC_ERR_ARG_WRONGSTATE; 269 return; 270 } 271 PetscOptionsObject->count = 1; 272 *ierr = PetscOptionsScalarArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set); 273 if (*ierr) return; 274 FREECHAR(opt, copt); 275 FREECHAR(text, ctext); 276 FREECHAR(man, cman); 277 } 278 279 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) 280 { 281 char *copt, *ctext, *cman, *ccurrent; 282 PetscBool flag; 283 284 FIXCHAR(opt, lenopt, copt); 285 FIXCHAR(text, lentext, ctext); 286 FIXCHAR(man, lenman, cman); 287 FIXCHAR(currentvalue, lencurrent, ccurrent); 288 289 if (!PetscOptionsObject) { 290 *ierr = PETSC_ERR_ARG_WRONGSTATE; 291 return; 292 } 293 PetscOptionsObject->count = 1; 294 295 *ierr = PetscOptionsString_Private(PetscOptionsObject, copt, ctext, cman, ccurrent, value, lenvalue - 1, &flag); 296 if (*ierr) return; 297 if (!FORTRANNULLBOOL(flg)) *flg = flag; 298 FREECHAR(opt, copt); 299 FREECHAR(text, ctext); 300 FREECHAR(man, cman); 301 FREECHAR(currentvalue, ccurrent); 302 FIXRETURNCHAR(flag, value, lenvalue); 303 } 304 305 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) 306 { 307 char *c1, *c2; 308 PetscBool flag; 309 310 FIXCHAR(pre, len1, c1); 311 FIXCHAR(name, len2, c2); 312 *ierr = PetscOptionsGetInt(*opt, c1, c2, ivalue, &flag); 313 if (*ierr) return; 314 if (!FORTRANNULLBOOL(flg)) *flg = flag; 315 FREECHAR(pre, c1); 316 FREECHAR(name, c2); 317 } 318 319 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) 320 { 321 char *c1, *c2; 322 PetscBool flag; 323 324 FIXCHAR(pre, len1, c1); 325 FIXCHAR(name, len2, c2); 326 *ierr = PetscOptionsGetEnum(*options, c1, c2, list, ivalue, &flag); 327 if (*ierr) return; 328 if (!FORTRANNULLBOOL(flg)) *flg = flag; 329 FREECHAR(pre, c1); 330 FREECHAR(name, c2); 331 } 332 333 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) 334 { 335 char *c1, *c2; 336 PetscBool flag; 337 338 FIXCHAR(pre, len1, c1); 339 FIXCHAR(name, len2, c2); 340 *ierr = PetscOptionsGetBool(*options, c1, c2, ivalue, &flag); 341 if (*ierr) return; 342 if (!FORTRANNULLBOOL(flg)) *flg = flag; 343 FREECHAR(pre, c1); 344 FREECHAR(name, c2); 345 } 346 347 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) 348 { 349 char *c1, *c2; 350 PetscBool flag; 351 352 FIXCHAR(pre, len1, c1); 353 FIXCHAR(name, len2, c2); 354 *ierr = PetscOptionsGetBoolArray(*options, c1, c2, dvalue, nmax, &flag); 355 if (*ierr) return; 356 if (!FORTRANNULLBOOL(flg)) *flg = flag; 357 FREECHAR(pre, c1); 358 FREECHAR(name, c2); 359 } 360 361 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) 362 { 363 char *c1, *c2; 364 PetscBool flag; 365 366 FIXCHAR(pre, len1, c1); 367 FIXCHAR(name, len2, c2); 368 *ierr = PetscOptionsGetReal(*options, c1, c2, dvalue, &flag); 369 if (*ierr) return; 370 if (!FORTRANNULLBOOL(flg)) *flg = flag; 371 FREECHAR(pre, c1); 372 FREECHAR(name, c2); 373 } 374 375 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) 376 { 377 char *c1, *c2; 378 PetscBool flag; 379 380 FIXCHAR(pre, len1, c1); 381 FIXCHAR(name, len2, c2); 382 *ierr = PetscOptionsGetScalar(*options, c1, c2, dvalue, &flag); 383 if (*ierr) return; 384 if (!FORTRANNULLBOOL(flg)) *flg = flag; 385 FREECHAR(pre, c1); 386 FREECHAR(name, c2); 387 } 388 389 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) 390 { 391 char *c1, *c2; 392 PetscBool flag; 393 394 FIXCHAR(pre, len1, c1); 395 FIXCHAR(name, len2, c2); 396 *ierr = PetscOptionsGetScalarArray(*options, c1, c2, dvalue, nmax, &flag); 397 if (*ierr) return; 398 if (!FORTRANNULLBOOL(flg)) *flg = flag; 399 FREECHAR(pre, c1); 400 FREECHAR(name, c2); 401 } 402 403 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) 404 { 405 char *c1, *c2; 406 PetscBool flag; 407 408 FIXCHAR(pre, len1, c1); 409 FIXCHAR(name, len2, c2); 410 *ierr = PetscOptionsGetRealArray(*options, c1, c2, dvalue, nmax, &flag); 411 if (*ierr) return; 412 if (!FORTRANNULLBOOL(flg)) *flg = flag; 413 FREECHAR(pre, c1); 414 FREECHAR(name, c2); 415 } 416 417 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) 418 { 419 char *c1, *c2; 420 PetscBool flag; 421 422 FIXCHAR(pre, len1, c1); 423 FIXCHAR(name, len2, c2); 424 *ierr = PetscOptionsGetIntArray(*options, c1, c2, dvalue, nmax, &flag); 425 if (*ierr) return; 426 if (!FORTRANNULLBOOL(flg)) *flg = flag; 427 FREECHAR(pre, c1); 428 FREECHAR(name, c2); 429 } 430 431 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) 432 { 433 char *c1, *c2, *c3; 434 size_t len3; 435 PetscBool flag; 436 437 FIXCHAR(pre, len1, c1); 438 FIXCHAR(name, len2, c2); 439 c3 = string; 440 len3 = len - 1; 441 442 *ierr = PetscOptionsGetString(*options, c1, c2, c3, len3, &flag); 443 if (*ierr) return; 444 if (!FORTRANNULLBOOL(flg)) *flg = flag; 445 FREECHAR(pre, c1); 446 FREECHAR(name, c2); 447 FIXRETURNCHAR(flag, string, len); 448 } 449 450 PETSC_EXTERN void petscgetprogramname_(char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len_in) 451 { 452 char *tmp; 453 size_t len; 454 tmp = name; 455 len = len_in - 1; 456 *ierr = PetscGetProgramName(tmp, len); 457 FIXRETURNCHAR(PETSC_TRUE, name, len_in); 458 } 459 460 PETSC_EXTERN void petscsubcommgetparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr) 461 { 462 MPI_Comm tcomm; 463 *ierr = PetscSubcommGetParent(*scomm, &tcomm); 464 *pcomm = MPI_Comm_c2f(tcomm); 465 } 466 467 PETSC_EXTERN void petscsubcommgetcontiguousparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr) 468 { 469 MPI_Comm tcomm; 470 *ierr = PetscSubcommGetContiguousParent(*scomm, &tcomm); 471 *pcomm = MPI_Comm_c2f(tcomm); 472 } 473 474 PETSC_EXTERN void petscsubcommgetchild_(PetscSubcomm *scomm, MPI_Fint *ccomm, int *ierr) 475 { 476 MPI_Comm tcomm; 477 *ierr = PetscSubcommGetChild(*scomm, &tcomm); 478 *ccomm = MPI_Comm_c2f(tcomm); 479 } 480