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 petscoptionsbool3_               PETSCOPTIONSBOOL3
     15:   #define petscoptionsboolarray_           PETSCOPTIONSBOOLARRAY
     16:   #define petscoptionsenumprivate_         PETSCOPTIONSENUMPRIVATE
     17:   #define petscoptionsint_                 PETSCOPTIONSINT
     18:   #define petscoptionsintarray_            PETSCOPTIONSINTARRAY
     19:   #define petscoptionsreal_                PETSCOPTIONSREAL
     20:   #define petscoptionsrealarray_           PETSCOPTIONSREALARRAY
     21:   #define petscoptionsscalar_              PETSCOPTIONSSCALAR
     22:   #define petscoptionsscalararray_         PETSCOPTIONSSCALARARRAY
     23:   #define petscoptionsstring_              PETSCOPTIONSSTRING
     24:   #define petscsubcommgetparent_           PETSCSUBCOMMGETPARENT
     25:   #define petscsubcommgetcontiguousparent_ PETSCSUBCOMMGETCONTIGUOUSPARENT
     26:   #define petscsubcommgetchild_            PETSCSUBCOMMGETCHILD
     27:   #define petscoptionsallused_             PETSCOPTIONSALLUSED
     28:   #define petscoptionsgetenumprivate_      PETSCOPTIONSGETENUMPRIVATE
     29:   #define petscoptionsgetstring_           PETSCOPTIONSGETSTRING
     30: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
     31:   #define petscoptionsbegin_               petscoptionsbegin
     32:   #define petscoptionsend_                 petscoptionsend
     33:   #define petscoptionsbool_                petscoptionsbool
     34:   #define petscoptionsbool3_               petscoptionsbool3
     35:   #define petscoptionsboolarray_           petscoptionsboolarray
     36:   #define petscoptionsenumprivate_         petscoptionsenumprivate
     37:   #define petscoptionsint_                 petscoptionsint
     38:   #define petscoptionsintarray_            petscoptionsintarray
     39:   #define petscoptionsreal_                petscoptionsreal
     40:   #define petscoptionsrealarray_           petscoptionsrealarray
     41:   #define petscoptionsscalar_              petscoptionsscalar
     42:   #define petscoptionsscalararray_         petscoptionsscalararray
     43:   #define petscoptionsstring_              petscoptionsstring
     44:   #define petscsubcommgetparent_           petscsubcommgetparent
     45:   #define petscsubcommgetcontiguousparent_ petscsubcommgetcontiguousparent
     46:   #define petscsubcommgetchild_            petscsubcommgetchild
     47:   #define petscoptionsallused_             petscoptionsallused
     48:   #define petscoptionsgetenumprivate_      petscoptionsgetenumprivate
     49:   #define petscoptionsgetstring_           petscoptionsgetstring
     50: #endif

     52: static struct _n_PetscOptionItems PetscOptionsObjectBase;
     53: static PetscOptionItems           PetscOptionsObject = NULL;

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

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

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

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

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

    108: PETSC_EXTERN void petscoptionsbool3_(char *opt, char *text, char *man, PetscBool3 *currentvalue, PetscBool3 *value, PetscBool *set, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T lenopt, PETSC_FORTRAN_CHARLEN_T lentext, PETSC_FORTRAN_CHARLEN_T lenman)
    109: {
    110:   char *copt, *ctext, *cman;

    112:   FIXCHAR(opt, lenopt, copt);
    113:   FIXCHAR(text, lentext, ctext);
    114:   FIXCHAR(man, lenman, cman);
    115:   if (!PetscOptionsObject) {
    116:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
    117:     return;
    118:   }
    119:   PetscOptionsObject->count = 1;
    120:   *ierr                     = PetscOptionsBool3_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set);
    121:   if (*ierr) return;
    122:   FREECHAR(opt, copt);
    123:   FREECHAR(text, ctext);
    124:   FREECHAR(man, cman);
    125: }

    127: 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)
    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                     = PetscOptionsBoolArray_Private(PetscOptionsObject, copt, ctext, cman, dvalue, nmax, &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 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)
    149: {
    150:   char     *copt, *ctext, *cman;
    151:   PetscBool flag;

    153:   FIXCHAR(opt, lenopt, copt);
    154:   FIXCHAR(text, lentext, ctext);
    155:   FIXCHAR(man, lenman, cman);
    156:   if (!PetscOptionsObject) {
    157:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
    158:     return;
    159:   }
    160:   PetscOptionsObject->count = 1;
    161:   *ierr                     = PetscOptionsEnum_Private(PetscOptionsObject, copt, ctext, cman, list, *currentvalue, ivalue, &flag);
    162:   if (*ierr) return;
    163:   if (!FORTRANNULLBOOL(flg)) *flg = flag;
    164:   FREECHAR(opt, copt);
    165:   FREECHAR(text, ctext);
    166:   FREECHAR(man, cman);
    167: }

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

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

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

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

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

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

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

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

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

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

    264: 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)
    265: {
    266:   char *copt, *ctext, *cman;

    268:   FIXCHAR(opt, lenopt, copt);
    269:   FIXCHAR(text, lentext, ctext);
    270:   FIXCHAR(man, lenman, cman);
    271:   if (!PetscOptionsObject) {
    272:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
    273:     return;
    274:   }
    275:   PetscOptionsObject->count = 1;
    276:   *ierr                     = PetscOptionsScalarArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set);
    277:   if (*ierr) return;
    278:   FREECHAR(opt, copt);
    279:   FREECHAR(text, ctext);
    280:   FREECHAR(man, cman);
    281: }

    283: 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)
    284: {
    285:   char     *copt, *ctext, *cman, *ccurrent;
    286:   PetscBool flag;

    288:   FIXCHAR(opt, lenopt, copt);
    289:   FIXCHAR(text, lentext, ctext);
    290:   FIXCHAR(man, lenman, cman);
    291:   FIXCHAR(currentvalue, lencurrent, ccurrent);

    293:   if (!PetscOptionsObject) {
    294:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
    295:     return;
    296:   }
    297:   PetscOptionsObject->count = 1;

    299:   *ierr = PetscOptionsString_Private(PetscOptionsObject, copt, ctext, cman, ccurrent, value, lenvalue - 1, &flag);
    300:   if (*ierr) return;
    301:   if (!FORTRANNULLBOOL(flg)) *flg = flag;
    302:   FREECHAR(opt, copt);
    303:   FREECHAR(text, ctext);
    304:   FREECHAR(man, cman);
    305:   FREECHAR(currentvalue, ccurrent);
    306:   FIXRETURNCHAR(flag, value, lenvalue);
    307: }

    309: 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)
    310: {
    311:   char     *c1, *c2;
    312:   PetscBool flag;

    314:   FIXCHAR(pre, len1, c1);
    315:   FIXCHAR(name, len2, c2);
    316:   *ierr = PetscOptionsGetEnum(*opt, c1, c2, list, ivalue, &flag);
    317:   if (*ierr) return;
    318:   if (!FORTRANNULLBOOL(flg)) *flg = flag;
    319:   FREECHAR(pre, c1);
    320:   FREECHAR(name, c2);
    321: }

    323: 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)
    324: {
    325:   char     *c1, *c2, *c3;
    326:   size_t    len3;
    327:   PetscBool flag;

    329:   FIXCHAR(pre, len1, c1);
    330:   FIXCHAR(name, len2, c2);
    331:   c3   = string;
    332:   len3 = len - 1;

    334:   *ierr = PetscOptionsGetString(*options, c1, c2, c3, len3, &flag);
    335:   if (*ierr) return;
    336:   if (!FORTRANNULLBOOL(flg)) *flg = flag;
    337:   FREECHAR(pre, c1);
    338:   FREECHAR(name, c2);
    339:   FIXRETURNCHAR(flag, string, len);
    340: }
    341: PETSC_EXTERN void petscsubcommgetparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr)
    342: {
    343:   MPI_Comm tcomm;

    345:   *ierr  = PetscSubcommGetParent(*scomm, &tcomm);
    346:   *pcomm = MPI_Comm_c2f(tcomm);
    347: }

    349: PETSC_EXTERN void petscsubcommgetcontiguousparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr)
    350: {
    351:   MPI_Comm tcomm;

    353:   *ierr  = PetscSubcommGetContiguousParent(*scomm, &tcomm);
    354:   *pcomm = MPI_Comm_c2f(tcomm);
    355: }

    357: PETSC_EXTERN void petscsubcommgetchild_(PetscSubcomm *scomm, MPI_Fint *ccomm, int *ierr)
    358: {
    359:   MPI_Comm tcomm;

    361:   *ierr  = PetscSubcommGetChild(*scomm, &tcomm);
    362:   *ccomm = MPI_Comm_c2f(tcomm);
    363: }