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