Date: 2025-03-28T21:11:12+00:00

Actual source code: zoptionsf.c

      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: */

      7: #include <petsc/private/fortranimpl.h>
      8: #include <petscviewer.h>

     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

     68: static PetscOptionItems PetscOptionsObjectBase, *PetscOptionsObject = NULL;

     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;

     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: }

     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: }

    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;

    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: }

    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;

    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: }

    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;

    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: }

    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;

    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: }

    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;

    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: }

    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;

    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: }

    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;

    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: }

    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;

    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: }

    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;

    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: }

    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;

    284:   FIXCHAR(opt, lenopt, copt);
    285:   FIXCHAR(text, lentext, ctext);
    286:   FIXCHAR(man, lenman, cman);
    287:   FIXCHAR(currentvalue, lencurrent, ccurrent);

    289:   if (!PetscOptionsObject) {
    290:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
    291:     return;
    292:   }
    293:   PetscOptionsObject->count = 1;

    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: }

    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;

    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: }

    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;

    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: }

    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;

    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: }

    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;

    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: }

    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;

    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: }

    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;

    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: }

    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;

    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: }

    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;

    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: }

    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;

    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: }

    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;

    437:   FIXCHAR(pre, len1, c1);
    438:   FIXCHAR(name, len2, c2);
    439:   c3   = string;
    440:   len3 = len - 1;

    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: }

    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: }

    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: }

    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: }

    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: }