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 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 petscsubcommview_ PETSCSUBCOMMVIEW
24: #define petscsubcommgetparent_ PETSCSUBCOMMGETPARENT
25: #define petscsubcommgetcontiguousparent_ PETSCSUBCOMMGETCONTIGUOUSPARENT
26: #define petscsubcommgetchild_ PETSCSUBCOMMGETCHILD
27: #define petscoptionsallused_ PETSCOPTIONSALLUSED
28: #define petscoptionsgetenumprivate_ PETSCOPTIONSGETENUMPRIVATE
29: #define petscoptionsgetbool_ PETSCOPTIONSGETBOOL
30: #define petscoptionsgetboolarray_ PETSCOPTIONSGETBOOLARRAY
31: #define petscoptionsgetintarray_ PETSCOPTIONSGETINTARRAY
32: #define petscoptionssetvalue_ PETSCOPTIONSSETVALUE
33: #define petscoptionsclearvalue_ PETSCOPTIONSCLEARVALUE
34: #define petscoptionshasname_ PETSCOPTIONSHASNAME
35: #define petscoptionsgetint_ PETSCOPTIONSGETINT
36: #define petscoptionsgetreal_ PETSCOPTIONSGETREAL
37: #define petscoptionsgetscalar_ PETSCOPTIONSGETSCALAR
38: #define petscoptionsgetscalararray_ PETSCOPTIONSGETSCALARARRAY
39: #define petscoptionsgetrealarray_ PETSCOPTIONSGETREALARRAY
40: #define petscoptionsgetstring_ PETSCOPTIONSGETSTRING
41: #define petscgetprogramname PETSCGETPROGRAMNAME
42: #define petscoptionsinsertfile_ PETSCOPTIONSINSERTFILE
43: #define petscoptionsclear_ PETSCOPTIONSCLEAR
44: #define petscoptionsinsertstring_ PETSCOPTIONSINSERTSTRING
45: #define petscoptionsview_ PETSCOPTIONSVIEW
46: #define petscoptionsleft_ PETSCOPTIONSLEFT
47: #define petscobjectviewfromoptions_ PETSCOBJECTVIEWFROMOPTIONS
48: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
49: #define petscoptionsbegin_ petscoptionsbegin
50: #define petscoptionsend_ petscoptionsend
51: #define petscoptionsbool_ petscoptionsbool
52: #define petscoptionsboolarray_ petscoptionsboolarray
53: #define petscoptionsenumprivate_ petscoptionsenumprivate_
54: #define petscoptionsint_ petscoptionsint
55: #define petscoptionsintarray_ petscoptionsintarray
56: #define petscoptionsreal_ petscoptionsreal
57: #define petscoptionsrealarray_ petscoptionsrealarray
58: #define petscoptionsscalar_ petscoptionsscalar
59: #define petscoptionsscalararray_ petscoptionsscalararray
60: #define petscoptionsstring_ petscoptionsstring
61: #define petscsubcommview_ petscsubcommview
62: #define petscsubcommgetparent_ petscsubcommgetparent
63: #define petscsubcommgetcontiguousparent_ petscsubcommgetcontiguousparent
64: #define petscsubcommgetchild_ petscsubcommgetchild
65: #define petscoptionsallused_ petscoptionsallused
66: #define petscoptionsgetenumprivate_ petscoptionsgetenumprivate
67: #define petscoptionsgetbool_ petscoptionsgetbool
68: #define petscoptionsgetboolarray_ petscoptionsgetboolarray
69: #define petscoptionssetvalue_ petscoptionssetvalue
70: #define petscoptionsclearvalue_ petscoptionsclearvalue
71: #define petscoptionshasname_ petscoptionshasname
72: #define petscoptionsgetint_ petscoptionsgetint
73: #define petscoptionsgetreal_ petscoptionsgetreal
74: #define petscoptionsgetscalar_ petscoptionsgetscalar
75: #define petscoptionsgetscalararray_ petscoptionsgetscalararray
76: #define petscoptionsgetrealarray_ petscoptionsgetrealarray
77: #define petscoptionsgetstring_ petscoptionsgetstring
78: #define petscoptionsgetintarray_ petscoptionsgetintarray
79: #define petscgetprogramname_ petscgetprogramname
80: #define petscoptionsinsertfile_ petscoptionsinsertfile
81: #define petscoptionsclear_ petscoptionsclear
82: #define petscoptionsinsertstring_ petscoptionsinsertstring
83: #define petscoptionsview_ petscoptionsview
84: #define petscoptionsleft_ petscoptionsleft
85: #define petscobjectviewfromoptions_ petscobjectviewfromoptions
86: #endif
88: static PetscOptionItems PetscOptionsObjectBase, *PetscOptionsObject = NULL;
90: 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)
91: {
92: MPI_Comm comm = MPI_Comm_f2c(*fcomm);
93: char *cprefix, *cmess, *csec;
95: FIXCHAR(prefix, lenprefix, cprefix);
96: FIXCHAR(mess, lenmess, cmess);
97: FIXCHAR(sec, lensec, csec);
98: if (PetscOptionsObject) {
99: *ierr = PETSC_ERR_ARG_WRONGSTATE;
100: return;
101: }
102: PetscOptionsObject = &PetscOptionsObjectBase;
103: *ierr = PetscMemzero(PetscOptionsObject, sizeof(*PetscOptionsObject));
104: if (*ierr) return;
105: PetscOptionsObject->count = 1;
106: *ierr = PetscOptionsBegin_Private(PetscOptionsObject, comm, cprefix, cmess, csec);
107: if (*ierr) return;
108: FREECHAR(prefix, cprefix);
109: FREECHAR(mess, cmess);
110: FREECHAR(sec, csec);
111: }
113: PETSC_EXTERN void petscoptionsend_(PetscErrorCode *ierr)
114: {
115: if (!PetscOptionsObject) {
116: *ierr = PETSC_ERR_ARG_WRONGSTATE;
117: return;
118: }
119: PetscOptionsObject->count = 1;
120: *ierr = PetscOptionsEnd_Private(PetscOptionsObject);
121: PetscOptionsObject = NULL;
122: }
124: 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)
125: {
126: char *copt, *ctext, *cman;
128: FIXCHAR(opt, lenopt, copt);
129: FIXCHAR(text, lentext, ctext);
130: FIXCHAR(man, lenman, cman);
131: if (!PetscOptionsObject) {
132: *ierr = PETSC_ERR_ARG_WRONGSTATE;
133: return;
134: }
135: PetscOptionsObject->count = 1;
136: *ierr = PetscOptionsBool_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set);
137: if (*ierr) return;
138: FREECHAR(opt, copt);
139: FREECHAR(text, ctext);
140: FREECHAR(man, cman);
141: }
143: 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)
144: {
145: char *copt, *ctext, *cman;
146: PetscBool flag;
148: FIXCHAR(opt, lenopt, copt);
149: FIXCHAR(text, lentext, ctext);
150: FIXCHAR(man, lenman, cman);
151: if (!PetscOptionsObject) {
152: *ierr = PETSC_ERR_ARG_WRONGSTATE;
153: return;
154: }
155: PetscOptionsObject->count = 1;
156: *ierr = PetscOptionsBoolArray_Private(PetscOptionsObject, copt, ctext, cman, dvalue, nmax, &flag);
157: if (*ierr) return;
158: if (!FORTRANNULLBOOL(flg)) *flg = flag;
159: FREECHAR(opt, copt);
160: FREECHAR(text, ctext);
161: FREECHAR(man, cman);
162: }
164: 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)
165: {
166: char *copt, *ctext, *cman;
167: PetscBool flag;
169: FIXCHAR(opt, lenopt, copt);
170: FIXCHAR(text, lentext, ctext);
171: FIXCHAR(man, lenman, cman);
172: if (!PetscOptionsObject) {
173: *ierr = PETSC_ERR_ARG_WRONGSTATE;
174: return;
175: }
176: PetscOptionsObject->count = 1;
177: *ierr = PetscOptionsEnum_Private(PetscOptionsObject, copt, ctext, cman, list, *currentvalue, ivalue, &flag);
178: if (*ierr) return;
179: if (!FORTRANNULLBOOL(flg)) *flg = flag;
180: FREECHAR(opt, copt);
181: FREECHAR(text, ctext);
182: FREECHAR(man, cman);
183: }
185: 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)
186: {
187: char *copt, *ctext, *cman;
189: FIXCHAR(opt, lenopt, copt);
190: FIXCHAR(text, lentext, ctext);
191: FIXCHAR(man, lenman, cman);
192: if (!PetscOptionsObject) {
193: *ierr = PETSC_ERR_ARG_WRONGSTATE;
194: return;
195: }
196: PetscOptionsObject->count = 1;
197: *ierr = PetscOptionsInt_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set, PETSC_MIN_INT, PETSC_MAX_INT);
198: if (*ierr) return;
199: FREECHAR(opt, copt);
200: FREECHAR(text, ctext);
201: FREECHAR(man, cman);
202: }
204: 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)
205: {
206: char *copt, *ctext, *cman;
208: FIXCHAR(opt, lenopt, copt);
209: FIXCHAR(text, lentext, ctext);
210: FIXCHAR(man, lenman, cman);
211: if (!PetscOptionsObject) {
212: *ierr = PETSC_ERR_ARG_WRONGSTATE;
213: return;
214: }
215: PetscOptionsObject->count = 1;
216: *ierr = PetscOptionsIntArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set);
217: if (*ierr) return;
218: FREECHAR(opt, copt);
219: FREECHAR(text, ctext);
220: FREECHAR(man, cman);
221: }
223: 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)
224: {
225: char *copt, *ctext, *cman;
227: FIXCHAR(opt, lenopt, copt);
228: FIXCHAR(text, lentext, ctext);
229: FIXCHAR(man, lenman, cman);
230: if (!PetscOptionsObject) {
231: *ierr = PETSC_ERR_ARG_WRONGSTATE;
232: return;
233: }
234: PetscOptionsObject->count = 1;
235: *ierr = PetscOptionsReal_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set);
236: if (*ierr) return;
237: FREECHAR(opt, copt);
238: FREECHAR(text, ctext);
239: FREECHAR(man, cman);
240: }
242: 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)
243: {
244: char *copt, *ctext, *cman;
246: FIXCHAR(opt, lenopt, copt);
247: FIXCHAR(text, lentext, ctext);
248: FIXCHAR(man, lenman, cman);
249: if (!PetscOptionsObject) {
250: *ierr = PETSC_ERR_ARG_WRONGSTATE;
251: return;
252: }
253: PetscOptionsObject->count = 1;
254: *ierr = PetscOptionsRealArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set);
255: if (*ierr) return;
256: FREECHAR(opt, copt);
257: FREECHAR(text, ctext);
258: FREECHAR(man, cman);
259: }
261: 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)
262: {
263: char *copt, *ctext, *cman;
265: FIXCHAR(opt, lenopt, copt);
266: FIXCHAR(text, lentext, ctext);
267: FIXCHAR(man, lenman, cman);
268: if (!PetscOptionsObject) {
269: *ierr = PETSC_ERR_ARG_WRONGSTATE;
270: return;
271: }
272: PetscOptionsObject->count = 1;
273: *ierr = PetscOptionsScalar_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set);
274: if (*ierr) return;
275: FREECHAR(opt, copt);
276: FREECHAR(text, ctext);
277: FREECHAR(man, cman);
278: }
280: 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)
281: {
282: char *copt, *ctext, *cman;
284: FIXCHAR(opt, lenopt, copt);
285: FIXCHAR(text, lentext, ctext);
286: FIXCHAR(man, lenman, cman);
287: if (!PetscOptionsObject) {
288: *ierr = PETSC_ERR_ARG_WRONGSTATE;
289: return;
290: }
291: PetscOptionsObject->count = 1;
292: *ierr = PetscOptionsScalarArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set);
293: if (*ierr) return;
294: FREECHAR(opt, copt);
295: FREECHAR(text, ctext);
296: FREECHAR(man, cman);
297: }
299: 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)
300: {
301: char *copt, *ctext, *cman, *ccurrent;
302: PetscBool flag;
304: FIXCHAR(opt, lenopt, copt);
305: FIXCHAR(text, lentext, ctext);
306: FIXCHAR(man, lenman, cman);
307: FIXCHAR(currentvalue, lencurrent, ccurrent);
309: if (!PetscOptionsObject) {
310: *ierr = PETSC_ERR_ARG_WRONGSTATE;
311: return;
312: }
313: PetscOptionsObject->count = 1;
315: *ierr = PetscOptionsString_Private(PetscOptionsObject, copt, ctext, cman, ccurrent, value, lenvalue - 1, &flag);
316: if (*ierr) return;
317: if (!FORTRANNULLBOOL(flg)) *flg = flag;
318: FREECHAR(opt, copt);
319: FREECHAR(text, ctext);
320: FREECHAR(man, cman);
321: FREECHAR(currentvalue, ccurrent);
322: FIXRETURNCHAR(flag, value, lenvalue);
323: }
325: PETSC_EXTERN void petscoptionsinsertstring_(PetscOptions *options, char *file, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
326: {
327: char *c1;
329: FIXCHAR(file, len, c1);
330: *ierr = PetscOptionsInsertString(*options, c1);
331: if (*ierr) return;
332: FREECHAR(file, c1);
333: }
335: PETSC_EXTERN void petscoptionsinsertfile_(MPI_Fint *comm, PetscOptions *options, char *file, PetscBool *require, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
336: {
337: char *c1;
339: FIXCHAR(file, len, c1);
340: *ierr = PetscOptionsInsertFile(MPI_Comm_f2c(*comm), *options, c1, *require);
341: if (*ierr) return;
342: FREECHAR(file, c1);
343: }
345: PETSC_EXTERN void petscoptionssetvalue_(PetscOptions *options, char *name, char *value, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2)
346: {
347: char *c1, *c2;
349: FIXCHAR(name, len1, c1);
350: FIXCHAR(value, len2, c2);
351: *ierr = PetscOptionsSetValue(*options, c1, c2);
352: if (*ierr) return;
353: FREECHAR(name, c1);
354: FREECHAR(value, c2);
355: }
357: PETSC_EXTERN void petscoptionsclear_(PetscOptions *options, PetscErrorCode *ierr)
358: {
359: *ierr = PetscOptionsClear(*options);
360: }
362: PETSC_EXTERN void petscoptionsclearvalue_(PetscOptions *options, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
363: {
364: char *c1;
366: FIXCHAR(name, len, c1);
367: *ierr = PetscOptionsClearValue(*options, c1);
368: if (*ierr) return;
369: FREECHAR(name, c1);
370: }
372: PETSC_EXTERN void petscoptionshasname_(PetscOptions *options, char *pre, char *name, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2)
373: {
374: char *c1, *c2;
376: FIXCHAR(pre, len1, c1);
377: FIXCHAR(name, len2, c2);
378: *ierr = PetscOptionsHasName(*options, c1, c2, flg);
379: if (*ierr) return;
380: FREECHAR(pre, c1);
381: FREECHAR(name, c2);
382: }
384: 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)
385: {
386: char *c1, *c2;
387: PetscBool flag;
389: FIXCHAR(pre, len1, c1);
390: FIXCHAR(name, len2, c2);
391: *ierr = PetscOptionsGetInt(*opt, c1, c2, ivalue, &flag);
392: if (*ierr) return;
393: if (!FORTRANNULLBOOL(flg)) *flg = flag;
394: FREECHAR(pre, c1);
395: FREECHAR(name, c2);
396: }
398: 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)
399: {
400: char *c1, *c2;
401: PetscBool flag;
403: FIXCHAR(pre, len1, c1);
404: FIXCHAR(name, len2, c2);
405: *ierr = PetscOptionsGetEnum(*options, c1, c2, list, ivalue, &flag);
406: if (*ierr) return;
407: if (!FORTRANNULLBOOL(flg)) *flg = flag;
408: FREECHAR(pre, c1);
409: FREECHAR(name, c2);
410: }
412: 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)
413: {
414: char *c1, *c2;
415: PetscBool flag;
417: FIXCHAR(pre, len1, c1);
418: FIXCHAR(name, len2, c2);
419: *ierr = PetscOptionsGetBool(*options, c1, c2, ivalue, &flag);
420: if (*ierr) return;
421: if (!FORTRANNULLBOOL(flg)) *flg = flag;
422: FREECHAR(pre, c1);
423: FREECHAR(name, c2);
424: }
426: 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)
427: {
428: char *c1, *c2;
429: PetscBool flag;
431: FIXCHAR(pre, len1, c1);
432: FIXCHAR(name, len2, c2);
433: *ierr = PetscOptionsGetBoolArray(*options, c1, c2, dvalue, nmax, &flag);
434: if (*ierr) return;
435: if (!FORTRANNULLBOOL(flg)) *flg = flag;
436: FREECHAR(pre, c1);
437: FREECHAR(name, c2);
438: }
440: 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)
441: {
442: char *c1, *c2;
443: PetscBool flag;
445: FIXCHAR(pre, len1, c1);
446: FIXCHAR(name, len2, c2);
447: *ierr = PetscOptionsGetReal(*options, c1, c2, dvalue, &flag);
448: if (*ierr) return;
449: if (!FORTRANNULLBOOL(flg)) *flg = flag;
450: FREECHAR(pre, c1);
451: FREECHAR(name, c2);
452: }
454: 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)
455: {
456: char *c1, *c2;
457: PetscBool flag;
459: FIXCHAR(pre, len1, c1);
460: FIXCHAR(name, len2, c2);
461: *ierr = PetscOptionsGetScalar(*options, c1, c2, dvalue, &flag);
462: if (*ierr) return;
463: if (!FORTRANNULLBOOL(flg)) *flg = flag;
464: FREECHAR(pre, c1);
465: FREECHAR(name, c2);
466: }
468: 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)
469: {
470: char *c1, *c2;
471: PetscBool flag;
473: FIXCHAR(pre, len1, c1);
474: FIXCHAR(name, len2, c2);
475: *ierr = PetscOptionsGetScalarArray(*options, c1, c2, dvalue, nmax, &flag);
476: if (*ierr) return;
477: if (!FORTRANNULLBOOL(flg)) *flg = flag;
478: FREECHAR(pre, c1);
479: FREECHAR(name, c2);
480: }
482: 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)
483: {
484: char *c1, *c2;
485: PetscBool flag;
487: FIXCHAR(pre, len1, c1);
488: FIXCHAR(name, len2, c2);
489: *ierr = PetscOptionsGetRealArray(*options, c1, c2, dvalue, nmax, &flag);
490: if (*ierr) return;
491: if (!FORTRANNULLBOOL(flg)) *flg = flag;
492: FREECHAR(pre, c1);
493: FREECHAR(name, c2);
494: }
496: 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)
497: {
498: char *c1, *c2;
499: PetscBool flag;
501: FIXCHAR(pre, len1, c1);
502: FIXCHAR(name, len2, c2);
503: *ierr = PetscOptionsGetIntArray(*options, c1, c2, dvalue, nmax, &flag);
504: if (*ierr) return;
505: if (!FORTRANNULLBOOL(flg)) *flg = flag;
506: FREECHAR(pre, c1);
507: FREECHAR(name, c2);
508: }
510: 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)
511: {
512: char *c1, *c2, *c3;
513: size_t len3;
514: PetscBool flag;
516: FIXCHAR(pre, len1, c1);
517: FIXCHAR(name, len2, c2);
518: c3 = string;
519: len3 = len - 1;
521: *ierr = PetscOptionsGetString(*options, c1, c2, c3, len3, &flag);
522: if (*ierr) return;
523: if (!FORTRANNULLBOOL(flg)) *flg = flag;
524: FREECHAR(pre, c1);
525: FREECHAR(name, c2);
526: FIXRETURNCHAR(flag, string, len);
527: }
529: PETSC_EXTERN void petscgetprogramname_(char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len_in)
530: {
531: char *tmp;
532: size_t len;
533: tmp = name;
534: len = len_in - 1;
535: *ierr = PetscGetProgramName(tmp, len);
536: FIXRETURNCHAR(PETSC_TRUE, name, len_in);
537: }
539: PETSC_EXTERN void petscoptionsview_(PetscOptions *options, PetscViewer *vin, PetscErrorCode *ierr)
540: {
541: PetscViewer v;
543: PetscPatchDefaultViewers_Fortran(vin, v);
544: *ierr = PetscOptionsView(*options, v);
545: }
547: PETSC_EXTERN void petscobjectviewfromoptions_(PetscObject *obj, PetscObject *bobj, char *option, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T loption)
548: {
549: char *o;
551: FIXCHAR(option, loption, o);
552: CHKFORTRANNULLOBJECT(obj);
553: *ierr = PetscObjectViewFromOptions(*obj, *bobj, o);
554: if (*ierr) return;
555: FREECHAR(option, o);
556: }
558: PETSC_EXTERN void petscsubcommgetparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr)
559: {
560: MPI_Comm tcomm;
561: *ierr = PetscSubcommGetParent(*scomm, &tcomm);
562: *pcomm = MPI_Comm_c2f(tcomm);
563: }
565: PETSC_EXTERN void petscsubcommgetcontiguousparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr)
566: {
567: MPI_Comm tcomm;
568: *ierr = PetscSubcommGetContiguousParent(*scomm, &tcomm);
569: *pcomm = MPI_Comm_c2f(tcomm);
570: }
572: PETSC_EXTERN void petscsubcommgetchild_(PetscSubcomm *scomm, MPI_Fint *ccomm, int *ierr)
573: {
574: MPI_Comm tcomm;
575: *ierr = PetscSubcommGetChild(*scomm, &tcomm);
576: *ccomm = MPI_Comm_c2f(tcomm);
577: }
579: PETSC_EXTERN void petscsubcommview_(PetscSubcomm *psubcomm, PetscViewer *viewer, int *ierr)
580: {
581: PetscViewer v;
582: PetscPatchDefaultViewers_Fortran(viewer, v);
583: *ierr = PetscSubcommView(*psubcomm, v);
584: }