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/ftnimpl.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 petscoptionsgetstring_           PETSCOPTIONSGETSTRING
 29: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
 30:   #define petscoptionsbegin_               petscoptionsbegin
 31:   #define petscoptionsend_                 petscoptionsend
 32:   #define petscoptionsbool_                petscoptionsbool
 33:   #define petscoptionsboolarray_           petscoptionsboolarray
 34:   #define petscoptionsenumprivate_         petscoptionsenumprivate
 35:   #define petscoptionsint_                 petscoptionsint
 36:   #define petscoptionsintarray_            petscoptionsintarray
 37:   #define petscoptionsreal_                petscoptionsreal
 38:   #define petscoptionsrealarray_           petscoptionsrealarray
 39:   #define petscoptionsscalar_              petscoptionsscalar
 40:   #define petscoptionsscalararray_         petscoptionsscalararray
 41:   #define petscoptionsstring_              petscoptionsstring
 42:   #define petscsubcommgetparent_           petscsubcommgetparent
 43:   #define petscsubcommgetcontiguousparent_ petscsubcommgetcontiguousparent
 44:   #define petscsubcommgetchild_            petscsubcommgetchild
 45:   #define petscoptionsallused_             petscoptionsallused
 46:   #define petscoptionsgetenumprivate_      petscoptionsgetenumprivate
 47:   #define petscoptionsgetstring_           petscoptionsgetstring
 48: #endif

 50: static struct _n_PetscOptionItems PetscOptionsObjectBase;
 51: static PetscOptionItems           PetscOptionsObject = NULL;

 53: 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)
 54: {
 55:   MPI_Comm comm = MPI_Comm_f2c(*fcomm);
 56:   char    *cprefix, *cmess, *csec;

 58:   FIXCHAR(prefix, lenprefix, cprefix);
 59:   FIXCHAR(mess, lenmess, cmess);
 60:   FIXCHAR(sec, lensec, csec);
 61:   if (PetscOptionsObject) {
 62:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
 63:     return;
 64:   }
 65:   PetscOptionsObject = &PetscOptionsObjectBase;
 66:   *ierr              = PetscMemzero(PetscOptionsObject, sizeof(*PetscOptionsObject));
 67:   if (*ierr) return;
 68:   PetscOptionsObject->count = 1;
 69:   *ierr                     = PetscOptionsBegin_Private(PetscOptionsObject, comm, cprefix, cmess, csec);
 70:   if (*ierr) return;
 71:   FREECHAR(prefix, cprefix);
 72:   FREECHAR(mess, cmess);
 73:   FREECHAR(sec, csec);
 74: }

 76: PETSC_EXTERN void petscoptionsend_(PetscErrorCode *ierr)
 77: {
 78:   if (!PetscOptionsObject) {
 79:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
 80:     return;
 81:   }
 82:   PetscOptionsObject->count = 1;
 83:   *ierr                     = PetscOptionsEnd_Private(PetscOptionsObject);
 84:   PetscOptionsObject        = NULL;
 85: }

 87: 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)
 88: {
 89:   char *copt, *ctext, *cman;

 91:   FIXCHAR(opt, lenopt, copt);
 92:   FIXCHAR(text, lentext, ctext);
 93:   FIXCHAR(man, lenman, cman);
 94:   if (!PetscOptionsObject) {
 95:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
 96:     return;
 97:   }
 98:   PetscOptionsObject->count = 1;
 99:   *ierr                     = PetscOptionsBool_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set);
100:   if (*ierr) return;
101:   FREECHAR(opt, copt);
102:   FREECHAR(text, ctext);
103:   FREECHAR(man, cman);
104: }

106: 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)
107: {
108:   char     *copt, *ctext, *cman;
109:   PetscBool flag;

111:   FIXCHAR(opt, lenopt, copt);
112:   FIXCHAR(text, lentext, ctext);
113:   FIXCHAR(man, lenman, cman);
114:   if (!PetscOptionsObject) {
115:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
116:     return;
117:   }
118:   PetscOptionsObject->count = 1;
119:   *ierr                     = PetscOptionsBoolArray_Private(PetscOptionsObject, copt, ctext, cman, dvalue, nmax, &flag);
120:   if (*ierr) return;
121:   if (!FORTRANNULLBOOL(flg)) *flg = flag;
122:   FREECHAR(opt, copt);
123:   FREECHAR(text, ctext);
124:   FREECHAR(man, cman);
125: }

127: 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)
128: {
129:   char     *copt, *ctext, *cman;
130:   PetscBool flag;

132:   FIXCHAR(opt, lenopt, copt);
133:   FIXCHAR(text, lentext, ctext);
134:   FIXCHAR(man, lenman, cman);
135:   if (!PetscOptionsObject) {
136:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
137:     return;
138:   }
139:   PetscOptionsObject->count = 1;
140:   *ierr                     = PetscOptionsEnum_Private(PetscOptionsObject, copt, ctext, cman, list, *currentvalue, ivalue, &flag);
141:   if (*ierr) return;
142:   if (!FORTRANNULLBOOL(flg)) *flg = flag;
143:   FREECHAR(opt, copt);
144:   FREECHAR(text, ctext);
145:   FREECHAR(man, cman);
146: }

148: 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)
149: {
150:   char *copt, *ctext, *cman;

152:   FIXCHAR(opt, lenopt, copt);
153:   FIXCHAR(text, lentext, ctext);
154:   FIXCHAR(man, lenman, cman);
155:   if (!PetscOptionsObject) {
156:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
157:     return;
158:   }
159:   PetscOptionsObject->count = 1;
160:   *ierr                     = PetscOptionsInt_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set, PETSC_INT_MIN, PETSC_INT_MAX);
161:   if (*ierr) return;
162:   FREECHAR(opt, copt);
163:   FREECHAR(text, ctext);
164:   FREECHAR(man, cman);
165: }

167: 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)
168: {
169:   char *copt, *ctext, *cman;

171:   FIXCHAR(opt, lenopt, copt);
172:   FIXCHAR(text, lentext, ctext);
173:   FIXCHAR(man, lenman, cman);
174:   if (!PetscOptionsObject) {
175:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
176:     return;
177:   }
178:   PetscOptionsObject->count = 1;
179:   *ierr                     = PetscOptionsIntArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set);
180:   if (*ierr) return;
181:   FREECHAR(opt, copt);
182:   FREECHAR(text, ctext);
183:   FREECHAR(man, cman);
184: }

186: 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)
187: {
188:   char *copt, *ctext, *cman;

190:   FIXCHAR(opt, lenopt, copt);
191:   FIXCHAR(text, lentext, ctext);
192:   FIXCHAR(man, lenman, cman);
193:   if (!PetscOptionsObject) {
194:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
195:     return;
196:   }
197:   PetscOptionsObject->count = 1;
198:   *ierr                     = PetscOptionsReal_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set, PETSC_MIN_REAL, PETSC_MAX_REAL);
199:   if (*ierr) return;
200:   FREECHAR(opt, copt);
201:   FREECHAR(text, ctext);
202:   FREECHAR(man, cman);
203: }

205: 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)
206: {
207:   char *copt, *ctext, *cman;

209:   FIXCHAR(opt, lenopt, copt);
210:   FIXCHAR(text, lentext, ctext);
211:   FIXCHAR(man, lenman, cman);
212:   if (!PetscOptionsObject) {
213:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
214:     return;
215:   }
216:   PetscOptionsObject->count = 1;
217:   *ierr                     = PetscOptionsRealArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set);
218:   if (*ierr) return;
219:   FREECHAR(opt, copt);
220:   FREECHAR(text, ctext);
221:   FREECHAR(man, cman);
222: }

224: 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)
225: {
226:   char *copt, *ctext, *cman;

228:   FIXCHAR(opt, lenopt, copt);
229:   FIXCHAR(text, lentext, ctext);
230:   FIXCHAR(man, lenman, cman);
231:   if (!PetscOptionsObject) {
232:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
233:     return;
234:   }
235:   PetscOptionsObject->count = 1;
236:   *ierr                     = PetscOptionsScalar_Private(PetscOptionsObject, copt, ctext, cman, *currentvalue, value, set);
237:   if (*ierr) return;
238:   FREECHAR(opt, copt);
239:   FREECHAR(text, ctext);
240:   FREECHAR(man, cman);
241: }

243: 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)
244: {
245:   char *copt, *ctext, *cman;

247:   FIXCHAR(opt, lenopt, copt);
248:   FIXCHAR(text, lentext, ctext);
249:   FIXCHAR(man, lenman, cman);
250:   if (!PetscOptionsObject) {
251:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
252:     return;
253:   }
254:   PetscOptionsObject->count = 1;
255:   *ierr                     = PetscOptionsScalarArray_Private(PetscOptionsObject, copt, ctext, cman, currentvalue, n, set);
256:   if (*ierr) return;
257:   FREECHAR(opt, copt);
258:   FREECHAR(text, ctext);
259:   FREECHAR(man, cman);
260: }

262: 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)
263: {
264:   char     *copt, *ctext, *cman, *ccurrent;
265:   PetscBool flag;

267:   FIXCHAR(opt, lenopt, copt);
268:   FIXCHAR(text, lentext, ctext);
269:   FIXCHAR(man, lenman, cman);
270:   FIXCHAR(currentvalue, lencurrent, ccurrent);

272:   if (!PetscOptionsObject) {
273:     *ierr = PETSC_ERR_ARG_WRONGSTATE;
274:     return;
275:   }
276:   PetscOptionsObject->count = 1;

278:   *ierr = PetscOptionsString_Private(PetscOptionsObject, copt, ctext, cman, ccurrent, value, lenvalue - 1, &flag);
279:   if (*ierr) return;
280:   if (!FORTRANNULLBOOL(flg)) *flg = flag;
281:   FREECHAR(opt, copt);
282:   FREECHAR(text, ctext);
283:   FREECHAR(man, cman);
284:   FREECHAR(currentvalue, ccurrent);
285:   FIXRETURNCHAR(flag, value, lenvalue);
286: }

288: PETSC_EXTERN void petscoptionsgetenumprivate_(PetscOptions *opt, char *pre, char *name, const char *const *list, PetscEnum *ivalue, PetscBool *flg, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len1, PETSC_FORTRAN_CHARLEN_T len2)
289: {
290:   char     *c1, *c2;
291:   PetscBool flag;

293:   FIXCHAR(pre, len1, c1);
294:   FIXCHAR(name, len2, c2);
295:   *ierr = PetscOptionsGetEnum(*opt, c1, c2, list, ivalue, &flag);
296:   if (*ierr) return;
297:   if (!FORTRANNULLBOOL(flg)) *flg = flag;
298:   FREECHAR(pre, c1);
299:   FREECHAR(name, c2);
300: }

302: 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)
303: {
304:   char     *c1, *c2, *c3;
305:   size_t    len3;
306:   PetscBool flag;

308:   FIXCHAR(pre, len1, c1);
309:   FIXCHAR(name, len2, c2);
310:   c3   = string;
311:   len3 = len - 1;

313:   *ierr = PetscOptionsGetString(*options, c1, c2, c3, len3, &flag);
314:   if (*ierr) return;
315:   if (!FORTRANNULLBOOL(flg)) *flg = flag;
316:   FREECHAR(pre, c1);
317:   FREECHAR(name, c2);
318:   FIXRETURNCHAR(flag, string, len);
319: }
320: PETSC_EXTERN void petscsubcommgetparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr)
321: {
322:   MPI_Comm tcomm;

324:   *ierr  = PetscSubcommGetParent(*scomm, &tcomm);
325:   *pcomm = MPI_Comm_c2f(tcomm);
326: }

328: PETSC_EXTERN void petscsubcommgetcontiguousparent_(PetscSubcomm *scomm, MPI_Fint *pcomm, int *ierr)
329: {
330:   MPI_Comm tcomm;

332:   *ierr  = PetscSubcommGetContiguousParent(*scomm, &tcomm);
333:   *pcomm = MPI_Comm_c2f(tcomm);
334: }

336: PETSC_EXTERN void petscsubcommgetchild_(PetscSubcomm *scomm, MPI_Fint *ccomm, int *ierr)
337: {
338:   MPI_Comm tcomm;

340:   *ierr  = PetscSubcommGetChild(*scomm, &tcomm);
341:   *ccomm = MPI_Comm_c2f(tcomm);
342: }