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