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