Date: 2025-03-29T05:58:45+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/ftnimpl.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 petscoptionsgetstring_           PETSCOPTIONSGETSTRING
     29: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     30:   #define petscoptionsbegin_               petscoptionsbegin
     31:   #define petscoptionsend_                 petscoptionsend
     32:   #define petscoptionsbool_                petscoptionsbool
     33:   #define petscoptionsboolarray_           petscoptionsboolarray
     34:   #define petscoptionsenumprivate_         petscoptionsenumprivate
     35:   #define petscoptionsint_                 petscoptionsint
     36:   #define petscoptionsintarray_            petscoptionsintarray
     37:   #define petscoptionsreal_                petscoptionsreal
     38:   #define petscoptionsrealarray_           petscoptionsrealarray
     39:   #define petscoptionsscalar_              petscoptionsscalar
     40:   #define petscoptionsscalararray_         petscoptionsscalararray
     41:   #define petscoptionsstring_              petscoptionsstring
     42:   #define petscsubcommgetparent_           petscsubcommgetparent
     43:   #define petscsubcommgetcontiguousparent_ petscsubcommgetcontiguousparent
     44:   #define petscsubcommgetchild_            petscsubcommgetchild
     45:   #define petscoptionsallused_             petscoptionsallused
     46:   #define petscoptionsgetenumprivate_      petscoptionsgetenumprivate
     47:   #define petscoptionsgetstring_           petscoptionsgetstring
     48: #endif

     50: static struct _n_PetscOptionItems PetscOptionsObjectBase;
     51: static PetscOptionItems           PetscOptionsObject = NULL;

     53: 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)
     54: {
     55:   MPI_Comm comm = MPI_Comm_f2c(*fcomm);
     56:   char    *cprefix, *cmess, *csec;

     58:   FIXCHAR(prefix, lenprefix, cprefix);
     59:   FIXCHAR(mess, lenmess, cmess);
     60:   FIXCHAR(sec, lensec, csec);
     61:   if (PetscOptionsObject) {
     62:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
     63:     return;
     64:   }
     65:   PetscOptionsObject = &PetscOptionsObjectBase;
     66:   *ierr              = PetscMemzero(PetscOptionsObject, sizeof(*PetscOptionsObject));
     67:   if (*ierr) return;
     68:   PetscOptionsObject->count = 1;
     69:   *ierr                     = PetscOptionsBegin_Private(PetscOptionsObject, comm, cprefix, cmess, csec);
     70:   if (*ierr) return;
     71:   FREECHAR(prefix, cprefix);
     72:   FREECHAR(mess, cmess);
     73:   FREECHAR(sec, csec);
     74: }

     76: PETSC_EXTERN void petscoptionsend_(PetscErrorCode *ierr)
     77: {
     78:   if (!PetscOptionsObject) {
     79:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
     80:     return;
     81:   }
     82:   PetscOptionsObject->count = 1;
     83:   *ierr                     = PetscOptionsEnd_Private(PetscOptionsObject);
     84:   PetscOptionsObject        = NULL;
     85: }

     87: 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)
     88: {
     89:   char *copt, *ctext, *cman;

     91:   FIXCHAR(opt, lenopt, copt);
     92:   FIXCHAR(text, lentext, ctext);
     93:   FIXCHAR(man, lenman, cman);
     94:   if (!PetscOptionsObject) {
     95:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
     96:     return;
     97:   }
     98:   PetscOptionsObject->count = 1;
     99:   *ierr                     = PetscOptionsBool_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set);
    100:   if (*ierr) return;
    101:   FREECHAR(opt, copt);
    102:   FREECHAR(text, ctext);
    103:   FREECHAR(man, cman);
    104: }

    106: 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)
    107: {
    108:   char     *copt, *ctext, *cman;
    109:   PetscBool flag;

    111:   FIXCHAR(opt, lenopt, copt);
    112:   FIXCHAR(text, lentext, ctext);
    113:   FIXCHAR(man, lenman, cman);
    114:   if (!PetscOptionsObject) {
    115:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
    116:     return;
    117:   }
    118:   PetscOptionsObject->count = 1;
    119:   *ierr                     = PetscOptionsBoolArray_Private(PetscOptionsObject, copt, ctext, cman, dvalue, nmax, &flag);
    120:   if (*ierr) return;
    121:   if (!FORTRANNULLBOOL(flg)) *flg = flag;
    122:   FREECHAR(opt, copt);
    123:   FREECHAR(text, ctext);
    124:   FREECHAR(man, cman);
    125: }

    127: 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)
    128: {
    129:   char     *copt, *ctext, *cman;
    130:   PetscBool flag;

    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                     = PetscOptionsEnum_Private(PetscOptionsObject, copt, ctext, cman, list, *currentvalue, ivalue, &flag);
    141:   if (*ierr) return;
    142:   if (!FORTRANNULLBOOL(flg)) *flg = flag;
    143:   FREECHAR(opt, copt);
    144:   FREECHAR(text, ctext);
    145:   FREECHAR(man, cman);
    146: }

    148: 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)
    149: {
    150:   char *copt, *ctext, *cman;

    152:   FIXCHAR(opt, lenopt, copt);
    153:   FIXCHAR(text, lentext, ctext);
    154:   FIXCHAR(man, lenman, cman);
    155:   if (!PetscOptionsObject) {
    156:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
    157:     return;
    158:   }
    159:   PetscOptionsObject->count = 1;
    160:   *ierr                     = PetscOptionsInt_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set, PETSC_INT_MIN, PETSC_INT_MAX);
    161:   if (*ierr) return;
    162:   FREECHAR(opt, copt);
    163:   FREECHAR(text, ctext);
    164:   FREECHAR(man, cman);
    165: }

    167: 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)
    168: {
    169:   char *copt, *ctext, *cman;

    171:   FIXCHAR(opt, lenopt, copt);
    172:   FIXCHAR(text, lentext, ctext);
    173:   FIXCHAR(man, lenman, cman);
    174:   if (!PetscOptionsObject) {
    175:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
    176:     return;
    177:   }
    178:   PetscOptionsObject->count = 1;
    179:   *ierr                     = PetscOptionsIntArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set);
    180:   if (*ierr) return;
    181:   FREECHAR(opt, copt);
    182:   FREECHAR(text, ctext);
    183:   FREECHAR(man, cman);
    184: }

    186: 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)
    187: {
    188:   char *copt, *ctext, *cman;

    190:   FIXCHAR(opt, lenopt, copt);
    191:   FIXCHAR(text, lentext, ctext);
    192:   FIXCHAR(man, lenman, cman);
    193:   if (!PetscOptionsObject) {
    194:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
    195:     return;
    196:   }
    197:   PetscOptionsObject->count = 1;
    198:   *ierr                     = PetscOptionsReal_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set, PETSC_MIN_REAL, PETSC_MAX_REAL);
    199:   if (*ierr) return;
    200:   FREECHAR(opt, copt);
    201:   FREECHAR(text, ctext);
    202:   FREECHAR(man, cman);
    203: }

    205: 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)
    206: {
    207:   char *copt, *ctext, *cman;

    209:   FIXCHAR(opt, lenopt, copt);
    210:   FIXCHAR(text, lentext, ctext);
    211:   FIXCHAR(man, lenman, cman);
    212:   if (!PetscOptionsObject) {
    213:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
    214:     return;
    215:   }
    216:   PetscOptionsObject->count = 1;
    217:   *ierr                     = PetscOptionsRealArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set);
    218:   if (*ierr) return;
    219:   FREECHAR(opt, copt);
    220:   FREECHAR(text, ctext);
    221:   FREECHAR(man, cman);
    222: }

    224: 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)
    225: {
    226:   char *copt, *ctext, *cman;

    228:   FIXCHAR(opt, lenopt, copt);
    229:   FIXCHAR(text, lentext, ctext);
    230:   FIXCHAR(man, lenman, cman);
    231:   if (!PetscOptionsObject) {
    232:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
    233:     return;
    234:   }
    235:   PetscOptionsObject->count = 1;
    236:   *ierr                     = PetscOptionsScalar_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set);
    237:   if (*ierr) return;
    238:   FREECHAR(opt, copt);
    239:   FREECHAR(text, ctext);
    240:   FREECHAR(man, cman);
    241: }

    243: 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)
    244: {
    245:   char *copt, *ctext, *cman;

    247:   FIXCHAR(opt, lenopt, copt);
    248:   FIXCHAR(text, lentext, ctext);
    249:   FIXCHAR(man, lenman, cman);
    250:   if (!PetscOptionsObject) {
    251:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
    252:     return;
    253:   }
    254:   PetscOptionsObject->count = 1;
    255:   *ierr                     = PetscOptionsScalarArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set);
    256:   if (*ierr) return;
    257:   FREECHAR(opt, copt);
    258:   FREECHAR(text, ctext);
    259:   FREECHAR(man, cman);
    260: }

    262: 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)
    263: {
    264:   char     *copt, *ctext, *cman, *ccurrent;
    265:   PetscBool flag;

    267:   FIXCHAR(opt, lenopt, copt);
    268:   FIXCHAR(text, lentext, ctext);
    269:   FIXCHAR(man, lenman, cman);
    270:   FIXCHAR(currentvalue, lencurrent, ccurrent);

    272:   if (!PetscOptionsObject) {
    273:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
    274:     return;
    275:   }
    276:   PetscOptionsObject->count = 1;

    278:   *ierr = PetscOptionsString_Private(PetscOptionsObject, copt, ctext, cman, ccurrent, value, lenvalue - 1, &flag);
    279:   if (*ierr) return;
    280:   if (!FORTRANNULLBOOL(flg)) *flg = flag;
    281:   FREECHAR(opt, copt);
    282:   FREECHAR(text, ctext);
    283:   FREECHAR(man, cman);
    284:   FREECHAR(currentvalue, ccurrent);
    285:   FIXRETURNCHAR(flag, value, lenvalue);
    286: }

    288: 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)
    289: {
    290:   char     *c1, *c2;
    291:   PetscBool flag;

    293:   FIXCHAR(pre, len1, c1);
    294:   FIXCHAR(name, len2, c2);
    295:   *ierr = PetscOptionsGetEnum(*opt, c1, c2, list, ivalue, &flag);
    296:   if (*ierr) return;
    297:   if (!FORTRANNULLBOOL(flg)) *flg = flag;
    298:   FREECHAR(pre, c1);
    299:   FREECHAR(name, c2);
    300: }

    302: 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)
    303: {
    304:   char     *c1, *c2, *c3;
    305:   size_t    len3;
    306:   PetscBool flag;

    308:   FIXCHAR(pre, len1, c1);
    309:   FIXCHAR(name, len2, c2);
    310:   c3   = string;
    311:   len3 = len - 1;

    313:   *ierr = PetscOptionsGetString(*options, c1, c2, c3, len3, &flag);
    314:   if (*ierr) return;
    315:   if (!FORTRANNULLBOOL(flg)) *flg = flag;
    316:   FREECHAR(pre, c1);
    317:   FREECHAR(name, c2);
    318:   FIXRETURNCHAR(flag, string, len);
    319: }
    320: PETSC_EXTERN void petscsubcommgetparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr)
    321: {
    322:   MPI_Comm tcomm;

    324:   *ierr  = PetscSubcommGetParent(*scomm, &tcomm);
    325:   *pcomm = MPI_Comm_c2f(tcomm);
    326: }

    328: PETSC_EXTERN void petscsubcommgetcontiguousparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr)
    329: {
    330:   MPI_Comm tcomm;

    332:   *ierr  = PetscSubcommGetContiguousParent(*scomm, &tcomm);
    333:   *pcomm = MPI_Comm_c2f(tcomm);
    334: }

    336: PETSC_EXTERN void petscsubcommgetchild_(PetscSubcomm *scomm, MPI_Fint *ccomm, int *ierr)
    337: {
    338:   MPI_Comm tcomm;

    340:   *ierr  = PetscSubcommGetChild(*scomm, &tcomm);
    341:   *ccomm = MPI_Comm_c2f(tcomm);
    342: }