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/fortranimpl.h>
8: #include <petscviewer.h>
10: #if defined(PETSC_HAVE_FORTRAN_CAPS)
11: #define petscsubcommview_ PETSCSUBCOMMVIEW
12: #define petscsubcommgetparent_ PETSCSUBCOMMGETPARENT
13: #define petscsubcommgetcontiguousparent_ PETSCSUBCOMMGETCONTIGUOUSPARENT
14: #define petscsubcommgetchild_ PETSCSUBCOMMGETCHILD
15: #define petscoptionsallused_ PETSCOPTIONSALLUSED
16: #define petscoptionsgetenumprivate_ PETSCOPTIONSGETENUMPRIVATE
17: #define petscoptionsgetbool_ PETSCOPTIONSGETBOOL
18: #define petscoptionsgetboolarray_ PETSCOPTIONSGETBOOLARRAY
19: #define petscoptionsgetintarray_ PETSCOPTIONSGETINTARRAY
20: #define petscoptionssetvalue_ PETSCOPTIONSSETVALUE
21: #define petscoptionsclearvalue_ PETSCOPTIONSCLEARVALUE
22: #define petscoptionshasname_ PETSCOPTIONSHASNAME
23: #define petscoptionsgetint_ PETSCOPTIONSGETINT
24: #define petscoptionsgetreal_ PETSCOPTIONSGETREAL
25: #define petscoptionsgetscalar_ PETSCOPTIONSGETSCALAR
26: #define petscoptionsgetscalararray_ PETSCOPTIONSGETSCALARARRAY
27: #define petscoptionsgetrealarray_ PETSCOPTIONSGETREALARRAY
28: #define petscoptionsgetstring_ PETSCOPTIONSGETSTRING
29: #define petscgetprogramname PETSCGETPROGRAMNAME
30: #define petscoptionsinsertfile_ PETSCOPTIONSINSERTFILE
31: #define petscoptionsclear_ PETSCOPTIONSCLEAR
32: #define petscoptionsinsertstring_ PETSCOPTIONSINSERTSTRING
33: #define petscoptionsview_ PETSCOPTIONSVIEW
34: #define petscoptionsleft_ PETSCOPTIONSLEFT
35: #define petscobjectviewfromoptions_ PETSCOBJECTVIEWFROMOPTIONS
36: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
37: #define petscsubcommview_ petscsubcommview
38: #define petscsubcommgetparent_ petscsubcommgetparent
39: #define petscsubcommgetcontiguousparent_ petscsubcommgetcontiguousparent
40: #define petscsubcommgetchild_ petscsubcommgetchild
41: #define petscoptionsallused_ petscoptionsallused
42: #define petscoptionsgetenumprivate_ petscoptionsgetenumprivate
43: #define petscoptionsgetbool_ petscoptionsgetbool
44: #define petscoptionsgetboolarray_ petscoptionsgetboolarray
45: #define petscoptionssetvalue_ petscoptionssetvalue
46: #define petscoptionsclearvalue_ petscoptionsclearvalue
47: #define petscoptionshasname_ petscoptionshasname
48: #define petscoptionsgetint_ petscoptionsgetint
49: #define petscoptionsgetreal_ petscoptionsgetreal
50: #define petscoptionsgetscalar_ petscoptionsgetscalar
51: #define petscoptionsgetscalararray_ petscoptionsgetscalararray
52: #define petscoptionsgetrealarray_ petscoptionsgetrealarray
53: #define petscoptionsgetstring_ petscoptionsgetstring
54: #define petscoptionsgetintarray_ petscoptionsgetintarray
55: #define petscgetprogramname_ petscgetprogramname
56: #define petscoptionsinsertfile_ petscoptionsinsertfile
57: #define petscoptionsclear_ petscoptionsclear
58: #define petscoptionsinsertstring_ petscoptionsinsertstring
59: #define petscoptionsview_ petscoptionsview
60: #define petscoptionsleft_ petscoptionsleft
61: #define petscobjectviewfromoptions_ petscobjectviewfromoptions
62: #endif
64: /* ---------------------------------------------------------------------*/
66: PETSC_EXTERN void petscoptionsinsertstring_(PetscOptions *options, char *file, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
67: {
68: char *c1;
70: FIXCHAR(file, len, c1);
71: *ierr = PetscOptionsInsertString(*options, c1);
72: if (*ierr) return;
73: FREECHAR(file, c1);
74: }
76: PETSC_EXTERN void petscoptionsinsertfile_(MPI_Fint *comm, PetscOptions *options, char *file, PetscBool *require, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
77: {
78: char *c1;
80: FIXCHAR(file, len, c1);
81: *ierr = PetscOptionsInsertFile(MPI_Comm_f2c(*comm), *options, c1, *require);
82: if (*ierr) return;
83: FREECHAR(file, c1);
84: }
86: PETSC_EXTERN void petscoptionssetvalue_(PetscOptions *options, char *name, char *value, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2)
87: {
88: char *c1, *c2;
90: FIXCHAR(name, len1, c1);
91: FIXCHAR(value, len2, c2);
92: *ierr = PetscOptionsSetValue(*options, c1, c2);
93: if (*ierr) return;
94: FREECHAR(name, c1);
95: FREECHAR(value, c2);
96: }
98: PETSC_EXTERN void petscoptionsclear_(PetscOptions *options, PetscErrorCode *ierr)
99: {
100: *ierr = PetscOptionsClear(*options);
101: }
103: PETSC_EXTERN void petscoptionsclearvalue_(PetscOptions *options, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
104: {
105: char *c1;
107: FIXCHAR(name, len, c1);
108: *ierr = PetscOptionsClearValue(*options, c1);
109: if (*ierr) return;
110: FREECHAR(name, c1);
111: }
113: PETSC_EXTERN void petscoptionshasname_(PetscOptions *options, char *pre, char *name, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2)
114: {
115: char *c1, *c2;
117: FIXCHAR(pre, len1, c1);
118: FIXCHAR(name, len2, c2);
119: *ierr = PetscOptionsHasName(*options, c1, c2, flg);
120: if (*ierr) return;
121: FREECHAR(pre, c1);
122: FREECHAR(name, c2);
123: }
125: PETSC_EXTERN void petscoptionsgetint_(PetscOptions *opt, char *pre, char *name, PetscInt *ivalue, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2)
126: {
127: char *c1, *c2;
128: PetscBool flag;
130: FIXCHAR(pre, len1, c1);
131: FIXCHAR(name, len2, c2);
132: *ierr = PetscOptionsGetInt(*opt, c1, c2, ivalue, &flag);
133: if (*ierr) return;
134: if (!FORTRANNULLBOOL(flg)) *flg = flag;
135: FREECHAR(pre, c1);
136: FREECHAR(name, c2);
137: }
139: PETSC_EXTERN void petscoptionsgetenumprivate_(PetscOptions *options, char *pre, char *name, const char *const *list, PetscEnum *ivalue, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2)
140: {
141: char *c1, *c2;
142: PetscBool flag;
144: FIXCHAR(pre, len1, c1);
145: FIXCHAR(name, len2, c2);
146: *ierr = PetscOptionsGetEnum(*options, c1, c2, list, ivalue, &flag);
147: if (*ierr) return;
148: if (!FORTRANNULLBOOL(flg)) *flg = flag;
149: FREECHAR(pre, c1);
150: FREECHAR(name, c2);
151: }
153: PETSC_EXTERN void petscoptionsgetbool_(PetscOptions *options, char *pre, char *name, PetscBool *ivalue, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2)
154: {
155: char *c1, *c2;
156: PetscBool flag;
158: FIXCHAR(pre, len1, c1);
159: FIXCHAR(name, len2, c2);
160: *ierr = PetscOptionsGetBool(*options, c1, c2, ivalue, &flag);
161: if (*ierr) return;
162: if (!FORTRANNULLBOOL(flg)) *flg = flag;
163: FREECHAR(pre, c1);
164: FREECHAR(name, c2);
165: }
167: PETSC_EXTERN void petscoptionsgetboolarray_(PetscOptions *options, char *pre, char *name, PetscBool *dvalue, PetscInt *nmax, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2)
168: {
169: char *c1, *c2;
170: PetscBool flag;
172: FIXCHAR(pre, len1, c1);
173: FIXCHAR(name, len2, c2);
174: *ierr = PetscOptionsGetBoolArray(*options, c1, c2, dvalue, nmax, &flag);
175: if (*ierr) return;
176: if (!FORTRANNULLBOOL(flg)) *flg = flag;
177: FREECHAR(pre, c1);
178: FREECHAR(name, c2);
179: }
181: PETSC_EXTERN void petscoptionsgetreal_(PetscOptions *options, char *pre, char *name, PetscReal *dvalue, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2)
182: {
183: char *c1, *c2;
184: PetscBool flag;
186: FIXCHAR(pre, len1, c1);
187: FIXCHAR(name, len2, c2);
188: *ierr = PetscOptionsGetReal(*options, c1, c2, dvalue, &flag);
189: if (*ierr) return;
190: if (!FORTRANNULLBOOL(flg)) *flg = flag;
191: FREECHAR(pre, c1);
192: FREECHAR(name, c2);
193: }
195: PETSC_EXTERN void petscoptionsgetscalar_(PetscOptions *options, char *pre, char *name, PetscScalar *dvalue, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2)
196: {
197: char *c1, *c2;
198: PetscBool flag;
200: FIXCHAR(pre, len1, c1);
201: FIXCHAR(name, len2, c2);
202: *ierr = PetscOptionsGetScalar(*options, c1, c2, dvalue, &flag);
203: if (*ierr) return;
204: if (!FORTRANNULLBOOL(flg)) *flg = flag;
205: FREECHAR(pre, c1);
206: FREECHAR(name, c2);
207: }
209: PETSC_EXTERN void petscoptionsgetscalararray_(PetscOptions *options, char *pre, char *name, PetscScalar *dvalue, PetscInt *nmax, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2)
210: {
211: char *c1, *c2;
212: PetscBool flag;
214: FIXCHAR(pre, len1, c1);
215: FIXCHAR(name, len2, c2);
216: *ierr = PetscOptionsGetScalarArray(*options, c1, c2, dvalue, nmax, &flag);
217: if (*ierr) return;
218: if (!FORTRANNULLBOOL(flg)) *flg = flag;
219: FREECHAR(pre, c1);
220: FREECHAR(name, c2);
221: }
223: PETSC_EXTERN void petscoptionsgetrealarray_(PetscOptions *options, char *pre, char *name, PetscReal *dvalue, PetscInt *nmax, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2)
224: {
225: char *c1, *c2;
226: PetscBool flag;
228: FIXCHAR(pre, len1, c1);
229: FIXCHAR(name, len2, c2);
230: *ierr = PetscOptionsGetRealArray(*options, c1, c2, dvalue, nmax, &flag);
231: if (*ierr) return;
232: if (!FORTRANNULLBOOL(flg)) *flg = flag;
233: FREECHAR(pre, c1);
234: FREECHAR(name, c2);
235: }
237: PETSC_EXTERN void petscoptionsgetintarray_(PetscOptions *options, char *pre, char *name, PetscInt *dvalue, PetscInt *nmax, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2)
238: {
239: char *c1, *c2;
240: PetscBool flag;
242: FIXCHAR(pre, len1, c1);
243: FIXCHAR(name, len2, c2);
244: *ierr = PetscOptionsGetIntArray(*options, c1, c2, dvalue, nmax, &flag);
245: if (*ierr) return;
246: if (!FORTRANNULLBOOL(flg)) *flg = flag;
247: FREECHAR(pre, c1);
248: FREECHAR(name, c2);
249: }
251: 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)
252: {
253: char *c1, *c2, *c3;
254: size_t len3;
255: PetscBool flag;
257: FIXCHAR(pre, len1, c1);
258: FIXCHAR(name, len2, c2);
259: c3 = string;
260: len3 = len - 1;
262: *ierr = PetscOptionsGetString(*options, c1, c2, c3, len3, &flag);
263: if (*ierr) return;
264: if (!FORTRANNULLBOOL(flg)) *flg = flag;
265: FREECHAR(pre, c1);
266: FREECHAR(name, c2);
267: FIXRETURNCHAR(flag, string, len);
268: }
270: PETSC_EXTERN void petscgetprogramname_(char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len_in)
271: {
272: char *tmp;
273: size_t len;
274: tmp = name;
275: len = len_in - 1;
276: *ierr = PetscGetProgramName(tmp, len);
277: FIXRETURNCHAR(PETSC_TRUE, name, len_in);
278: }
280: PETSC_EXTERN void petscoptionsview_(PetscOptions *options, PetscViewer *vin, PetscErrorCode *ierr)
281: {
282: PetscViewer v;
284: PetscPatchDefaultViewers_Fortran(vin, v);
285: *ierr = PetscOptionsView(*options, v);
286: }
288: PETSC_EXTERN void petscobjectviewfromoptions_(PetscObject *obj, PetscObject *bobj, char *option, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T loption)
289: {
290: char *o;
292: FIXCHAR(option, loption, o);
293: CHKFORTRANNULLOBJECT(obj);
294: *ierr = PetscObjectViewFromOptions(*obj, *bobj, o);
295: if (*ierr) return;
296: FREECHAR(option, o);
297: }
299: PETSC_EXTERN void petscsubcommgetparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr)
300: {
301: MPI_Comm tcomm;
302: *ierr = PetscSubcommGetParent(*scomm, &tcomm);
303: *pcomm = MPI_Comm_c2f(tcomm);
304: }
306: PETSC_EXTERN void petscsubcommgetcontiguousparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr)
307: {
308: MPI_Comm tcomm;
309: *ierr = PetscSubcommGetContiguousParent(*scomm, &tcomm);
310: *pcomm = MPI_Comm_c2f(tcomm);
311: }
313: PETSC_EXTERN void petscsubcommgetchild_(PetscSubcomm *scomm, MPI_Fint *ccomm, int *ierr)
314: {
315: MPI_Comm tcomm;
316: *ierr = PetscSubcommGetChild(*scomm, &tcomm);
317: *ccomm = MPI_Comm_c2f(tcomm);
318: }
320: PETSC_EXTERN void petscsubcommview_(PetscSubcomm *psubcomm, PetscViewer *viewer, int *ierr)
321: {
322: PetscViewer v;
323: PetscPatchDefaultViewers_Fortran(viewer, v);
324: *ierr = PetscSubcommView(*psubcomm, v);
325: }