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