Actual source code: ztaosolverf.c
1: #include <petsc/private/fortranimpl.h>
2: #include <petsc/private/f90impl.h>
3: #include <petsc/private/taoimpl.h>
5: #if defined(PETSC_HAVE_FORTRAN_CAPS)
6: #define taosetobjective_ TAOSETOBJECTIVE
7: #define taosetgradient_ TAOSETGRADIENT
8: #define taosetobjectiveandgradient_ TAOSETOBJECTIVEANDGRADIENT
9: #define taosethessian_ TAOSETHESSIAN
10: #define taosetresidualroutine_ TAOSETRESIDUALROUTINE
11: #define taosetjacobianresidualroutine_ TAOSETJACOBIANRESIDUALROUTINE
12: #define taosetjacobianroutine_ TAOSETJACOBIANROUTINE
13: #define taosetjacobianstateroutine_ TAOSETJACOBIANSTATEROUTINE
14: #define taosetjacobiandesignroutine_ TAOSETJACOBIANDESIGNROUTINE
15: #define taosetjacobianinequalityroutine_ TAOSETJACOBIANINEQUALITYROUTINE
16: #define taosetjacobianequalityroutine_ TAOSETJACOBIANEQUALITYROUTINE
17: #define taosetinequalityconstraintsroutine_ TAOSETINEQUALITYCONSTRAINTSROUTINE
18: #define taosetequalityconstraintsroutine_ TAOSETEQUALITYCONSTRAINTSROUTINE
19: #define taosetvariableboundsroutine_ TAOSETVARIABLEBOUNDSROUTINE
20: #define taosetconstraintsroutine_ TAOSETCONSTRAINTSROUTINE
21: #define taomonitorset_ TAOMONITORSET
22: #define taosettype_ TAOSETTYPE
23: #define taoview_ TAOVIEW
24: #define taogetconvergencehistory_ TAOGETCONVERGENCEHISTORY
25: #define taosetconvergencetest_ TAOSETCONVERGENCETEST
26: #define taogetoptionsprefix_ TAOGETOPTIONSPREFIX
27: #define taosetoptionsprefix_ TAOSETOPTIONSPREFIX
28: #define taoappendoptionsprefix_ TAOAPPENDOPTIONSPREFIX
29: #define taogettype_ TAOGETTYPE
30: #define taosetupdate_ TAOSETUPDATE
31: #define taoviewfromoptions_ TAOVIEWFROMOPTIONS
32: #define taodestroy_ TAODESTROY
33: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
34: #define taosetobjective_ taosetobjective
35: #define taosetgradient_ taosetgradient
36: #define taosetobjectiveandgradient_ taosetobjectiveandgradient
37: #define taosethessian_ taosethessian
38: #define taosetresidualroutine_ taosetresidualroutine
39: #define taosetjacobianresidualroutine_ taosetjacobianresidualroutine
40: #define taosetjacobianroutine_ taosetjacobianroutine
41: #define taosetjacobianstateroutine_ taosetjacobianstateroutine
42: #define taosetjacobiandesignroutine_ taosetjacobiandesignroutine
43: #define taosetjacobianinequalityroutine_ taosetjacobianinequalityroutine
44: #define taosetjacobianequalityroutine_ taosetjacobianequalityroutine
45: #define taosetinequalityconstraintsroutine_ taosetinequalityconstraintsroutine
46: #define taosetequalityconstraintsroutine_ taosetequalityconstraintsroutine
47: #define taosetvariableboundsroutine_ taosetvariableboundsroutine
48: #define taosetconstraintsroutine_ taosetconstraintsroutine
49: #define taomonitorset_ taomonitorset
50: #define taosettype_ taosettype
51: #define taoview_ taoview
52: #define taogetconvergencehistory_ taogetconvergencehistory
53: #define taosetconvergencetest_ taosetconvergencetest
54: #define taogetoptionsprefix_ taogetoptionsprefix
55: #define taosetoptionsprefix_ taosetoptionsprefix
56: #define taoappendoptionsprefix_ taoappendoptionsprefix
57: #define taogettype_ taogettype
58: #define taosetupdate_ taosetupdate
59: #define taoviewfromoptions_ taoviewfromoptions
60: #define taodestroy_ taodestroy
61: #endif
63: static struct {
64: PetscFortranCallbackId obj;
65: PetscFortranCallbackId grad;
66: PetscFortranCallbackId objgrad;
67: PetscFortranCallbackId hess;
68: PetscFortranCallbackId lsres;
69: PetscFortranCallbackId lsjac;
70: PetscFortranCallbackId jac;
71: PetscFortranCallbackId jacstate;
72: PetscFortranCallbackId jacdesign;
73: PetscFortranCallbackId bounds;
74: PetscFortranCallbackId mon;
75: PetscFortranCallbackId mondestroy;
76: PetscFortranCallbackId convtest;
77: PetscFortranCallbackId constraints;
78: PetscFortranCallbackId jacineq;
79: PetscFortranCallbackId jaceq;
80: PetscFortranCallbackId conineq;
81: PetscFortranCallbackId coneq;
82: PetscFortranCallbackId nfuncs;
83: PetscFortranCallbackId update;
84: #if defined(PETSC_HAVE_F90_2PTR_ARG)
85: PetscFortranCallbackId function_pgiptr;
86: #endif
87: } _cb;
89: static PetscErrorCode ourtaoobjectiveroutine(Tao tao, Vec x, PetscReal *f, void *ctx)
90: {
91: PetscObjectUseFortranCallback(tao, _cb.obj, (Tao *, Vec *, PetscReal *, void *, PetscErrorCode *), (&tao, &x, f, _ctx, &ierr));
92: }
94: static PetscErrorCode ourtaogradientroutine(Tao tao, Vec x, Vec g, void *ctx)
95: {
96: PetscObjectUseFortranCallback(tao, _cb.grad, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &x, &g, _ctx, &ierr));
97: }
99: static PetscErrorCode ourtaoobjectiveandgradientroutine(Tao tao, Vec x, PetscReal *f, Vec g, void *ctx)
100: {
101: PetscObjectUseFortranCallback(tao, _cb.objgrad, (Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), (&tao, &x, f, &g, _ctx, &ierr));
102: }
104: static PetscErrorCode ourtaohessianroutine(Tao tao, Vec x, Mat H, Mat Hpre, void *ctx)
105: {
106: PetscObjectUseFortranCallback(tao, _cb.hess, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, &Hpre, _ctx, &ierr));
107: }
109: static PetscErrorCode ourtaojacobianroutine(Tao tao, Vec x, Mat H, Mat Hpre, void *ctx)
110: {
111: PetscObjectUseFortranCallback(tao, _cb.jac, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, &Hpre, _ctx, &ierr));
112: }
114: static PetscErrorCode ourtaojacobianstateroutine(Tao tao, Vec x, Mat H, Mat Hpre, Mat Hinv, void *ctx)
115: {
116: PetscObjectUseFortranCallback(tao, _cb.jacstate, (Tao *, Vec *, Mat *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, &Hpre, &Hinv, _ctx, &ierr));
117: }
119: static PetscErrorCode ourtaojacobiandesignroutine(Tao tao, Vec x, Mat H, void *ctx)
120: {
121: PetscObjectUseFortranCallback(tao, _cb.jacdesign, (Tao *, Vec *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, _ctx, &ierr));
122: }
124: static PetscErrorCode ourtaoboundsroutine(Tao tao, Vec xl, Vec xu, void *ctx)
125: {
126: PetscObjectUseFortranCallback(tao, _cb.bounds, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &xl, &xu, _ctx, &ierr));
127: }
128: static PetscErrorCode ourtaoresidualroutine(Tao tao, Vec x, Vec f, void *ctx)
129: {
130: PetscObjectUseFortranCallback(tao, _cb.lsres, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &x, &f, _ctx, &ierr));
131: }
133: static PetscErrorCode ourtaojacobianresidualroutine(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx)
134: {
135: PetscObjectUseFortranCallback(tao, _cb.lsjac, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &J, &Jpre, _ctx, &ierr));
136: }
138: static PetscErrorCode ourtaomonitor(Tao tao, void *ctx)
139: {
140: PetscObjectUseFortranCallback(tao, _cb.mon, (Tao *, void *, PetscErrorCode *), (&tao, _ctx, &ierr));
141: }
143: static PetscErrorCode ourtaomondestroy(void **ctx)
144: {
145: Tao tao = (Tao)*ctx;
146: PetscObjectUseFortranCallback(tao, _cb.mondestroy, (void *, PetscErrorCode *), (_ctx, &ierr));
147: }
148: static PetscErrorCode ourtaoconvergencetest(Tao tao, void *ctx)
149: {
150: PetscObjectUseFortranCallback(tao, _cb.convtest, (Tao *, void *, PetscErrorCode *), (&tao, _ctx, &ierr));
151: }
153: static PetscErrorCode ourtaoconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx)
154: {
155: PetscObjectUseFortranCallback(tao, _cb.constraints, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &x, &c, _ctx, &ierr));
156: }
158: static PetscErrorCode ourtaojacobianinequalityroutine(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx)
159: {
160: PetscObjectUseFortranCallback(tao, _cb.jacineq, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &J, &Jpre, _ctx, &ierr));
161: }
163: static PetscErrorCode ourtaojacobianequalityroutine(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx)
164: {
165: PetscObjectUseFortranCallback(tao, _cb.jaceq, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &J, &Jpre, _ctx, &ierr));
166: }
168: static PetscErrorCode ourtaoinequalityconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx)
169: {
170: PetscObjectUseFortranCallback(tao, _cb.conineq, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &x, &c, _ctx, &ierr));
171: }
173: static PetscErrorCode ourtaoequalityconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx)
174: {
175: PetscObjectUseFortranCallback(tao, _cb.coneq, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &x, &c, _ctx, &ierr));
176: }
178: static PetscErrorCode ourtaoupdateroutine(Tao tao, PetscInt iter, void *ctx)
179: {
180: PetscObjectUseFortranCallback(tao, _cb.update, (Tao *, PetscInt *, void *), (&tao, &iter, _ctx));
181: }
183: EXTERN_C_BEGIN
185: PETSC_EXTERN void taosetobjective_(Tao *tao, void (*func)(Tao *, Vec *, PetscReal *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
186: {
187: CHKFORTRANNULLFUNCTION(func);
188: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.obj, (PetscVoidFn *)func, ctx);
189: if (!*ierr) *ierr = TaoSetObjective(*tao, ourtaoobjectiveroutine, ctx);
190: }
192: PETSC_EXTERN void taosetgradient_(Tao *tao, Vec *g, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
193: {
194: CHKFORTRANNULLFUNCTION(func);
195: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.grad, (PetscVoidFn *)func, ctx);
196: if (!*ierr) *ierr = TaoSetGradient(*tao, *g, ourtaogradientroutine, ctx);
197: }
199: PETSC_EXTERN void taosetobjectiveandgradient_(Tao *tao, Vec *g, void (*func)(Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
200: {
201: CHKFORTRANNULLFUNCTION(func);
202: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objgrad, (PetscVoidFn *)func, ctx);
203: if (!*ierr) *ierr = TaoSetObjectiveAndGradient(*tao, *g, ourtaoobjectiveandgradientroutine, ctx);
204: }
206: PETSC_EXTERN void taosethessian_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
207: {
208: CHKFORTRANNULLFUNCTION(func);
209: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.hess, (PetscVoidFn *)func, ctx);
210: if (!*ierr) *ierr = TaoSetHessian(*tao, *J, *Jp, ourtaohessianroutine, ctx);
211: }
213: PETSC_EXTERN void taosetresidualroutine_(Tao *tao, Vec *F, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
214: {
215: CHKFORTRANNULLFUNCTION(func);
216: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.lsres, (PetscVoidFn *)func, ctx);
217: if (!*ierr) *ierr = TaoSetResidualRoutine(*tao, *F, ourtaoresidualroutine, ctx);
218: }
220: PETSC_EXTERN void taosetjacobianresidualroutine_(Tao *tao, Mat *J, Mat *Jpre, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
221: {
222: CHKFORTRANNULLFUNCTION(func);
223: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.lsjac, (PetscVoidFn *)func, ctx);
224: if (!*ierr) *ierr = TaoSetJacobianResidualRoutine(*tao, *J, *Jpre, ourtaojacobianresidualroutine, ctx);
225: }
227: PETSC_EXTERN void taosetjacobianroutine_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
228: {
229: CHKFORTRANNULLFUNCTION(func);
230: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jac, (PetscVoidFn *)func, ctx);
231: if (!*ierr) *ierr = TaoSetJacobianRoutine(*tao, *J, *Jp, ourtaojacobianroutine, ctx);
232: }
234: PETSC_EXTERN void taosetjacobianstateroutine_(Tao *tao, Mat *J, Mat *Jp, Mat *Jinv, void (*func)(Tao *, Vec *, Mat *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
235: {
236: CHKFORTRANNULLFUNCTION(func);
237: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacstate, (PetscVoidFn *)func, ctx);
238: if (!*ierr) *ierr = TaoSetJacobianStateRoutine(*tao, *J, *Jp, *Jinv, ourtaojacobianstateroutine, ctx);
239: }
241: PETSC_EXTERN void taosetjacobiandesignroutine_(Tao *tao, Mat *J, void (*func)(Tao *, Vec *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
242: {
243: CHKFORTRANNULLFUNCTION(func);
244: *ierr = PetscObjectSetFortranCallback((PetscObject)tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacdesign, (PetscVoidFn *)func, ctx);
245: if (!*ierr) *ierr = TaoSetJacobianDesignRoutine(*tao, *J, ourtaojacobiandesignroutine, ctx);
246: }
248: PETSC_EXTERN void taosetvariableboundsroutine_(Tao *tao, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
249: {
250: CHKFORTRANNULLFUNCTION(func);
251: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.bounds, (PetscVoidFn *)func, ctx);
252: if (!*ierr) *ierr = TaoSetVariableBoundsRoutine(*tao, ourtaoboundsroutine, ctx);
253: }
255: PETSC_EXTERN void taomonitorset_(Tao *tao, void (*func)(Tao *, void *, PetscErrorCode *), void *ctx, void (*mondestroy)(void *, PetscErrorCode *), PetscErrorCode *ierr)
256: {
257: CHKFORTRANNULLFUNCTION(mondestroy);
258: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.mon, (PetscVoidFn *)func, ctx);
259: if (*ierr) return;
260: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.mondestroy, (PetscVoidFn *)mondestroy, ctx);
261: if (*ierr) return;
262: *ierr = TaoMonitorSet(*tao, ourtaomonitor, *tao, ourtaomondestroy);
263: }
265: PETSC_EXTERN void taosetconvergencetest_(Tao *tao, void (*func)(Tao *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
266: {
267: CHKFORTRANNULLFUNCTION(func);
268: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.convtest, (PetscVoidFn *)func, ctx);
269: if (!*ierr) *ierr = TaoSetConvergenceTest(*tao, ourtaoconvergencetest, ctx);
270: }
272: PETSC_EXTERN void taosetconstraintsroutine_(Tao *tao, Vec *C, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
273: {
274: CHKFORTRANNULLFUNCTION(func);
275: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.constraints, (PetscVoidFn *)func, ctx);
276: if (!*ierr) *ierr = TaoSetConstraintsRoutine(*tao, *C, ourtaoconstraintsroutine, ctx);
277: }
279: PETSC_EXTERN void taosettype_(Tao *tao, char *type_name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
280: {
281: char *t;
283: FIXCHAR(type_name, len, t);
284: *ierr = TaoSetType(*tao, t);
285: if (*ierr) return;
286: FREECHAR(type_name, t);
287: }
289: PETSC_EXTERN void taoview_(Tao *tao, PetscViewer *viewer, PetscErrorCode *ierr)
290: {
291: PetscViewer v;
292: PetscPatchDefaultViewers_Fortran(viewer, v);
293: *ierr = TaoView(*tao, v);
294: }
296: PETSC_EXTERN void taogetconvergencehistory_(Tao *tao, PetscInt *nhist, PetscErrorCode *ierr)
297: {
298: *ierr = TaoGetConvergenceHistory(*tao, NULL, NULL, NULL, NULL, nhist);
299: }
301: PETSC_EXTERN void taogetoptionsprefix_(Tao *tao, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
302: {
303: const char *name;
304: *ierr = TaoGetOptionsPrefix(*tao, &name);
305: *ierr = PetscStrncpy(prefix, name, len);
306: if (*ierr) return;
307: FIXRETURNCHAR(PETSC_TRUE, prefix, len);
308: }
310: PETSC_EXTERN void taoappendoptionsprefix_(Tao *tao, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
311: {
312: char *name;
313: FIXCHAR(prefix, len, name);
314: *ierr = TaoAppendOptionsPrefix(*tao, name);
315: if (*ierr) return;
316: FREECHAR(prefix, name);
317: }
319: PETSC_EXTERN void taosetoptionsprefix_(Tao *tao, char *prefix, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
320: {
321: char *t;
322: FIXCHAR(prefix, len, t);
323: *ierr = TaoSetOptionsPrefix(*tao, t);
324: if (*ierr) return;
325: FREECHAR(prefix, t);
326: }
328: PETSC_EXTERN void taogettype_(Tao *tao, char *name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
329: {
330: const char *tname;
331: *ierr = TaoGetType(*tao, &tname);
332: *ierr = PetscStrncpy(name, tname, len);
333: if (*ierr) return;
334: FIXRETURNCHAR(PETSC_TRUE, name, len);
335: }
337: PETSC_EXTERN void taosetjacobianinequalityroutine_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
338: {
339: CHKFORTRANNULLFUNCTION(func);
340: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacineq, (PetscVoidFn *)func, ctx);
341: if (!*ierr) *ierr = TaoSetJacobianInequalityRoutine(*tao, *J, *Jp, ourtaojacobianinequalityroutine, ctx);
342: }
344: PETSC_EXTERN void taosetjacobianequalityroutine_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
345: {
346: CHKFORTRANNULLFUNCTION(func);
347: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jaceq, (PetscVoidFn *)func, ctx);
348: if (!*ierr) *ierr = TaoSetJacobianEqualityRoutine(*tao, *J, *Jp, ourtaojacobianequalityroutine, ctx);
349: }
351: PETSC_EXTERN void taosetinequalityconstraintsroutine_(Tao *tao, Vec *C, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
352: {
353: CHKFORTRANNULLFUNCTION(func);
354: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.conineq, (PetscVoidFn *)func, ctx);
355: if (!*ierr) *ierr = TaoSetInequalityConstraintsRoutine(*tao, *C, ourtaoinequalityconstraintsroutine, ctx);
356: }
358: PETSC_EXTERN void taosetequalityconstraintsroutine_(Tao *tao, Vec *C, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
359: {
360: CHKFORTRANNULLFUNCTION(func);
361: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.coneq, (PetscVoidFn *)func, ctx);
362: if (!*ierr) *ierr = TaoSetEqualityConstraintsRoutine(*tao, *C, ourtaoequalityconstraintsroutine, ctx);
363: }
365: PETSC_EXTERN void taosetupdate_(Tao *tao, void (*func)(Tao *, PetscInt *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
366: {
367: CHKFORTRANNULLFUNCTION(func);
368: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.update, (PetscVoidFn *)func, ctx);
369: if (!*ierr) *ierr = TaoSetUpdate(*tao, ourtaoupdateroutine, ctx);
370: }
372: PETSC_EXTERN void taoviewfromoptions_(Tao *ao, PetscObject obj, char *type, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len)
373: {
374: char *t;
376: FIXCHAR(type, len, t);
377: CHKFORTRANNULLOBJECT(obj);
378: *ierr = TaoViewFromOptions(*ao, obj, t);
379: if (*ierr) return;
380: FREECHAR(type, t);
381: }
383: PETSC_EXTERN void taodestroy_(Tao *x, int *ierr)
384: {
385: PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(x);
386: *ierr = TaoDestroy(x);
387: if (*ierr) return;
388: PETSC_FORTRAN_OBJECT_C_NULL_TO_F_DESTROYED(x);
389: }
391: EXTERN_C_END