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