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 petscsubcommgetparent_ PETSCSUBCOMMGETPARENT
24: #define petscsubcommgetcontiguousparent_ PETSCSUBCOMMGETCONTIGUOUSPARENT
25: #define petscsubcommgetchild_ PETSCSUBCOMMGETCHILD
26: #define petscoptionsallused_ PETSCOPTIONSALLUSED
27: #define petscoptionsgetenumprivate_ PETSCOPTIONSGETENUMPRIVATE
28: #define petscoptionsgetbool_ PETSCOPTIONSGETBOOL
29: #define petscoptionsgetboolarray_ PETSCOPTIONSGETBOOLARRAY
30: #define petscoptionsgetintarray_ PETSCOPTIONSGETINTARRAY
31: #define petscoptionsgetint_ PETSCOPTIONSGETINT
32: #define petscoptionsgetreal_ PETSCOPTIONSGETREAL
33: #define petscoptionsgetscalar_ PETSCOPTIONSGETSCALAR
34: #define petscoptionsgetscalararray_ PETSCOPTIONSGETSCALARARRAY
35: #define petscoptionsgetrealarray_ PETSCOPTIONSGETREALARRAY
36: #define petscoptionsgetstring_ PETSCOPTIONSGETSTRING
37: #define petscgetprogramname PETSCGETPROGRAMNAME
38: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
39: #define petscoptionsbegin_ petscoptionsbegin
40: #define petscoptionsend_ petscoptionsend
41: #define petscoptionsbool_ petscoptionsbool
42: #define petscoptionsboolarray_ petscoptionsboolarray
43: #define petscoptionsenumprivate_ petscoptionsenumprivate
44: #define petscoptionsint_ petscoptionsint
45: #define petscoptionsintarray_ petscoptionsintarray
46: #define petscoptionsreal_ petscoptionsreal
47: #define petscoptionsrealarray_ petscoptionsrealarray
48: #define petscoptionsscalar_ petscoptionsscalar
49: #define petscoptionsscalararray_ petscoptionsscalararray
50: #define petscoptionsstring_ petscoptionsstring
51: #define petscsubcommgetparent_ petscsubcommgetparent
52: #define petscsubcommgetcontiguousparent_ petscsubcommgetcontiguousparent
53: #define petscsubcommgetchild_ petscsubcommgetchild
54: #define petscoptionsallused_ petscoptionsallused
55: #define petscoptionsgetenumprivate_ petscoptionsgetenumprivate
56: #define petscoptionsgetbool_ petscoptionsgetbool
57: #define petscoptionsgetboolarray_ petscoptionsgetboolarray
58: #define petscoptionsgetint_ petscoptionsgetint
59: #define petscoptionsgetreal_ petscoptionsgetreal
60: #define petscoptionsgetscalar_ petscoptionsgetscalar
61: #define petscoptionsgetscalararray_ petscoptionsgetscalararray
62: #define petscoptionsgetrealarray_ petscoptionsgetrealarray
63: #define petscoptionsgetstring_ petscoptionsgetstring
64: #define petscoptionsgetintarray_ petscoptionsgetintarray
65: #define petscgetprogramname_ petscgetprogramname
66: #endif
68: static PetscOptionItems PetscOptionsObjectBase, *PetscOptionsObject = NULL;
70: 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)
71: {
72: MPI_Comm comm = MPI_Comm_f2c(*fcomm);
73: char *cprefix, *cmess, *csec;
75: FIXCHAR(prefix, lenprefix, cprefix);
76: FIXCHAR(mess, lenmess, cmess);
77: FIXCHAR(sec, lensec, csec);
78: if (PetscOptionsObject) {
79: *ierr = PETSC_ERR_ARG_WRONGSTATE;
80: return;
81: }
82: PetscOptionsObject = &PetscOptionsObjectBase;
83: *ierr = PetscMemzero(PetscOptionsObject, sizeof(*PetscOptionsObject));
84: if (*ierr) return;
85: PetscOptionsObject->count = 1;
86: *ierr = PetscOptionsBegin_Private(PetscOptionsObject, comm, cprefix, cmess, csec);
87: if (*ierr) return;
88: FREECHAR(prefix, cprefix);
89: FREECHAR(mess, cmess);
90: FREECHAR(sec, csec);
91: }
93: PETSC_EXTERN void petscoptionsend_(PetscErrorCode *ierr)
94: {
95: if (!PetscOptionsObject) {
96: *ierr = PETSC_ERR_ARG_WRONGSTATE;
97: return;
98: }
99: PetscOptionsObject->count = 1;
100: *ierr = PetscOptionsEnd_Private(PetscOptionsObject);
101: PetscOptionsObject = NULL;
102: }
104: 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)
105: {
106: char *copt, *ctext, *cman;
108: FIXCHAR(opt, lenopt, copt);
109: FIXCHAR(text, lentext, ctext);
110: FIXCHAR(man, lenman, cman);
111: if (!PetscOptionsObject) {
112: *ierr = PETSC_ERR_ARG_WRONGSTATE;
113: return;
114: }
115: PetscOptionsObject->count = 1;
116: *ierr = PetscOptionsBool_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set);
117: if (*ierr) return;
118: FREECHAR(opt, copt);
119: FREECHAR(text, ctext);
120: FREECHAR(man, cman);
121: }
123: 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)
124: {
125: char *copt, *ctext, *cman;
126: PetscBool flag;
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 = PetscOptionsBoolArray_Private(PetscOptionsObject, copt, ctext, cman, dvalue, nmax, &flag);
137: if (*ierr) return;
138: if (!FORTRANNULLBOOL(flg)) *flg = flag;
139: FREECHAR(opt, copt);
140: FREECHAR(text, ctext);
141: FREECHAR(man, cman);
142: }
144: 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)
145: {
146: char *copt, *ctext, *cman;
147: PetscBool flag;
149: FIXCHAR(opt, lenopt, copt);
150: FIXCHAR(text, lentext, ctext);
151: FIXCHAR(man, lenman, cman);
152: if (!PetscOptionsObject) {
153: *ierr = PETSC_ERR_ARG_WRONGSTATE;
154: return;
155: }
156: PetscOptionsObject->count = 1;
157: *ierr = PetscOptionsEnum_Private(PetscOptionsObject, copt, ctext, cman, list, *currentvalue, ivalue, &flag);
158: if (*ierr) return;
159: if (!FORTRANNULLBOOL(flg)) *flg = flag;
160: FREECHAR(opt, copt);
161: FREECHAR(text, ctext);
162: FREECHAR(man, cman);
163: }
165: 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)
166: {
167: char *copt, *ctext, *cman;
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 = PetscOptionsInt_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set, PETSC_INT_MIN, PETSC_INT_MAX);
178: if (*ierr) return;
179: FREECHAR(opt, copt);
180: FREECHAR(text, ctext);
181: FREECHAR(man, cman);
182: }
184: 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)
185: {
186: char *copt, *ctext, *cman;
188: FIXCHAR(opt, lenopt, copt);
189: FIXCHAR(text, lentext, ctext);
190: FIXCHAR(man, lenman, cman);
191: if (!PetscOptionsObject) {
192: *ierr = PETSC_ERR_ARG_WRONGSTATE;
193: return;
194: }
195: PetscOptionsObject->count = 1;
196: *ierr = PetscOptionsIntArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set);
197: if (*ierr) return;
198: FREECHAR(opt, copt);
199: FREECHAR(text, ctext);
200: FREECHAR(man, cman);
201: }
203: 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)
204: {
205: char *copt, *ctext, *cman;
207: FIXCHAR(opt, lenopt, copt);
208: FIXCHAR(text, lentext, ctext);
209: FIXCHAR(man, lenman, cman);
210: if (!PetscOptionsObject) {
211: *ierr = PETSC_ERR_ARG_WRONGSTATE;
212: return;
213: }
214: PetscOptionsObject->count = 1;
215: *ierr = PetscOptionsReal_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set, PETSC_MIN_REAL, PETSC_MAX_REAL);
216: if (*ierr) return;
217: FREECHAR(opt, copt);
218: FREECHAR(text, ctext);
219: FREECHAR(man, cman);
220: }
222: 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)
223: {
224: char *copt, *ctext, *cman;
226: FIXCHAR(opt, lenopt, copt);
227: FIXCHAR(text, lentext, ctext);
228: FIXCHAR(man, lenman, cman);
229: if (!PetscOptionsObject) {
230: *ierr = PETSC_ERR_ARG_WRONGSTATE;
231: return;
232: }
233: PetscOptionsObject->count = 1;
234: *ierr = PetscOptionsRealArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set);
235: if (*ierr) return;
236: FREECHAR(opt, copt);
237: FREECHAR(text, ctext);
238: FREECHAR(man, cman);
239: }
241: 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)
242: {
243: char *copt, *ctext, *cman;
245: FIXCHAR(opt, lenopt, copt);
246: FIXCHAR(text, lentext, ctext);
247: FIXCHAR(man, lenman, cman);
248: if (!PetscOptionsObject) {
249: *ierr = PETSC_ERR_ARG_WRONGSTATE;
250: return;
251: }
252: PetscOptionsObject->count = 1;
253: *ierr = PetscOptionsScalar_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set);
254: if (*ierr) return;
255: FREECHAR(opt, copt);
256: FREECHAR(text, ctext);
257: FREECHAR(man, cman);
258: }
260: 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)
261: {
262: char *copt, *ctext, *cman;
264: FIXCHAR(opt, lenopt, copt);
265: FIXCHAR(text, lentext, ctext);
266: FIXCHAR(man, lenman, cman);
267: if (!PetscOptionsObject) {
268: *ierr = PETSC_ERR_ARG_WRONGSTATE;
269: return;
270: }
271: PetscOptionsObject->count = 1;
272: *ierr = PetscOptionsScalarArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set);
273: if (*ierr) return;
274: FREECHAR(opt, copt);
275: FREECHAR(text, ctext);
276: FREECHAR(man, cman);
277: }
279: 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)
280: {
281: char *copt, *ctext, *cman, *ccurrent;
282: PetscBool flag;
284: FIXCHAR(opt, lenopt, copt);
285: FIXCHAR(text, lentext, ctext);
286: FIXCHAR(man, lenman, cman);
287: FIXCHAR(currentvalue, lencurrent, ccurrent);
289: if (!PetscOptionsObject) {
290: *ierr = PETSC_ERR_ARG_WRONGSTATE;
291: return;
292: }
293: PetscOptionsObject->count = 1;
295: *ierr = PetscOptionsString_Private(PetscOptionsObject, copt, ctext, cman, ccurrent, value, lenvalue - 1, &flag);
296: if (*ierr) return;
297: if (!FORTRANNULLBOOL(flg)) *flg = flag;
298: FREECHAR(opt, copt);
299: FREECHAR(text, ctext);
300: FREECHAR(man, cman);
301: FREECHAR(currentvalue, ccurrent);
302: FIXRETURNCHAR(flag, value, lenvalue);
303: }
305: 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)
306: {
307: char *c1, *c2;
308: PetscBool flag;
310: FIXCHAR(pre, len1, c1);
311: FIXCHAR(name, len2, c2);
312: *ierr = PetscOptionsGetInt(*opt, c1, c2, ivalue, &flag);
313: if (*ierr) return;
314: if (!FORTRANNULLBOOL(flg)) *flg = flag;
315: FREECHAR(pre, c1);
316: FREECHAR(name, c2);
317: }
319: 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)
320: {
321: char *c1, *c2;
322: PetscBool flag;
324: FIXCHAR(pre, len1, c1);
325: FIXCHAR(name, len2, c2);
326: *ierr = PetscOptionsGetEnum(*options, c1, c2, list, ivalue, &flag);
327: if (*ierr) return;
328: if (!FORTRANNULLBOOL(flg)) *flg = flag;
329: FREECHAR(pre, c1);
330: FREECHAR(name, c2);
331: }
333: 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)
334: {
335: char *c1, *c2;
336: PetscBool flag;
338: FIXCHAR(pre, len1, c1);
339: FIXCHAR(name, len2, c2);
340: *ierr = PetscOptionsGetBool(*options, c1, c2, ivalue, &flag);
341: if (*ierr) return;
342: if (!FORTRANNULLBOOL(flg)) *flg = flag;
343: FREECHAR(pre, c1);
344: FREECHAR(name, c2);
345: }
347: 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)
348: {
349: char *c1, *c2;
350: PetscBool flag;
352: FIXCHAR(pre, len1, c1);
353: FIXCHAR(name, len2, c2);
354: *ierr = PetscOptionsGetBoolArray(*options, c1, c2, dvalue, nmax, &flag);
355: if (*ierr) return;
356: if (!FORTRANNULLBOOL(flg)) *flg = flag;
357: FREECHAR(pre, c1);
358: FREECHAR(name, c2);
359: }
361: 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)
362: {
363: char *c1, *c2;
364: PetscBool flag;
366: FIXCHAR(pre, len1, c1);
367: FIXCHAR(name, len2, c2);
368: *ierr = PetscOptionsGetReal(*options, c1, c2, dvalue, &flag);
369: if (*ierr) return;
370: if (!FORTRANNULLBOOL(flg)) *flg = flag;
371: FREECHAR(pre, c1);
372: FREECHAR(name, c2);
373: }
375: 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)
376: {
377: char *c1, *c2;
378: PetscBool flag;
380: FIXCHAR(pre, len1, c1);
381: FIXCHAR(name, len2, c2);
382: *ierr = PetscOptionsGetScalar(*options, c1, c2, dvalue, &flag);
383: if (*ierr) return;
384: if (!FORTRANNULLBOOL(flg)) *flg = flag;
385: FREECHAR(pre, c1);
386: FREECHAR(name, c2);
387: }
389: 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)
390: {
391: char *c1, *c2;
392: PetscBool flag;
394: FIXCHAR(pre, len1, c1);
395: FIXCHAR(name, len2, c2);
396: *ierr = PetscOptionsGetScalarArray(*options, c1, c2, dvalue, nmax, &flag);
397: if (*ierr) return;
398: if (!FORTRANNULLBOOL(flg)) *flg = flag;
399: FREECHAR(pre, c1);
400: FREECHAR(name, c2);
401: }
403: 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)
404: {
405: char *c1, *c2;
406: PetscBool flag;
408: FIXCHAR(pre, len1, c1);
409: FIXCHAR(name, len2, c2);
410: *ierr = PetscOptionsGetRealArray(*options, c1, c2, dvalue, nmax, &flag);
411: if (*ierr) return;
412: if (!FORTRANNULLBOOL(flg)) *flg = flag;
413: FREECHAR(pre, c1);
414: FREECHAR(name, c2);
415: }
417: 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)
418: {
419: char *c1, *c2;
420: PetscBool flag;
422: FIXCHAR(pre, len1, c1);
423: FIXCHAR(name, len2, c2);
424: *ierr = PetscOptionsGetIntArray(*options, c1, c2, dvalue, nmax, &flag);
425: if (*ierr) return;
426: if (!FORTRANNULLBOOL(flg)) *flg = flag;
427: FREECHAR(pre, c1);
428: FREECHAR(name, c2);
429: }
431: 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)
432: {
433: char *c1, *c2, *c3;
434: size_t len3;
435: PetscBool flag;
437: FIXCHAR(pre, len1, c1);
438: FIXCHAR(name, len2, c2);
439: c3 = string;
440: len3 = len - 1;
442: *ierr = PetscOptionsGetString(*options, c1, c2, c3, len3, &flag);
443: if (*ierr) return;
444: if (!FORTRANNULLBOOL(flg)) *flg = flag;
445: FREECHAR(pre, c1);
446: FREECHAR(name, c2);
447: FIXRETURNCHAR(flag, string, len);
448: }
450: PETSC_EXTERN void petscgetprogramname_(char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len_in)
451: {
452: char *tmp;
453: size_t len;
454: tmp = name;
455: len = len_in - 1;
456: *ierr = PetscGetProgramName(tmp, len);
457: FIXRETURNCHAR(PETSC_TRUE, name, len_in);
458: }
460: PETSC_EXTERN void petscsubcommgetparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr)
461: {
462: MPI_Comm tcomm;
463: *ierr = PetscSubcommGetParent(*scomm, &tcomm);
464: *pcomm = MPI_Comm_c2f(tcomm);
465: }
467: PETSC_EXTERN void petscsubcommgetcontiguousparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr)
468: {
469: MPI_Comm tcomm;
470: *ierr = PetscSubcommGetContiguousParent(*scomm, &tcomm);
471: *pcomm = MPI_Comm_c2f(tcomm);
472: }
474: PETSC_EXTERN void petscsubcommgetchild_(PetscSubcomm *scomm, MPI_Fint *ccomm, int *ierr)
475: {
476: MPI_Comm tcomm;
477: *ierr = PetscSubcommGetChild(*scomm, &tcomm);
478: *ccomm = MPI_Comm_c2f(tcomm);
479: }