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 taogetconvergencehistory_ TAOGETCONVERGENCEHISTORY
23: #define taosetconvergencetest_ TAOSETCONVERGENCETEST
24: #define taosetupdate_ TAOSETUPDATE
25: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
26: #define taosetobjective_ taosetobjective
27: #define taosetgradient_ taosetgradient
28: #define taosetobjectiveandgradient_ taosetobjectiveandgradient
29: #define taosethessian_ taosethessian
30: #define taosetresidualroutine_ taosetresidualroutine
31: #define taosetjacobianresidualroutine_ taosetjacobianresidualroutine
32: #define taosetjacobianroutine_ taosetjacobianroutine
33: #define taosetjacobianstateroutine_ taosetjacobianstateroutine
34: #define taosetjacobiandesignroutine_ taosetjacobiandesignroutine
35: #define taosetjacobianinequalityroutine_ taosetjacobianinequalityroutine
36: #define taosetjacobianequalityroutine_ taosetjacobianequalityroutine
37: #define taosetinequalityconstraintsroutine_ taosetinequalityconstraintsroutine
38: #define taosetequalityconstraintsroutine_ taosetequalityconstraintsroutine
39: #define taosetvariableboundsroutine_ taosetvariableboundsroutine
40: #define taosetconstraintsroutine_ taosetconstraintsroutine
41: #define taomonitorset_ taomonitorset
42: #define taogetconvergencehistory_ taogetconvergencehistory
43: #define taosetconvergencetest_ taosetconvergencetest
44: #define taosetupdate_ taosetupdate
45: #endif
47: static struct {
48: PetscFortranCallbackId obj;
49: PetscFortranCallbackId grad;
50: PetscFortranCallbackId objgrad;
51: PetscFortranCallbackId hess;
52: PetscFortranCallbackId lsres;
53: PetscFortranCallbackId lsjac;
54: PetscFortranCallbackId jac;
55: PetscFortranCallbackId jacstate;
56: PetscFortranCallbackId jacdesign;
57: PetscFortranCallbackId bounds;
58: PetscFortranCallbackId mon;
59: PetscFortranCallbackId mondestroy;
60: PetscFortranCallbackId convtest;
61: PetscFortranCallbackId constraints;
62: PetscFortranCallbackId jacineq;
63: PetscFortranCallbackId jaceq;
64: PetscFortranCallbackId conineq;
65: PetscFortranCallbackId coneq;
66: PetscFortranCallbackId nfuncs;
67: PetscFortranCallbackId update;
68: #if defined(PETSC_HAVE_F90_2PTR_ARG)
69: PetscFortranCallbackId function_pgiptr;
70: #endif
71: } _cb;
73: static PetscErrorCode ourtaoobjectiveroutine(Tao tao, Vec x, PetscReal *f, void *ctx)
74: {
75: PetscObjectUseFortranCallback(tao, _cb.obj, (Tao *, Vec *, PetscReal *, void *, PetscErrorCode *), (&tao, &x, f, _ctx, &ierr));
76: }
78: static PetscErrorCode ourtaogradientroutine(Tao tao, Vec x, Vec g, void *ctx)
79: {
80: PetscObjectUseFortranCallback(tao, _cb.grad, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &x, &g, _ctx, &ierr));
81: }
83: static PetscErrorCode ourtaoobjectiveandgradientroutine(Tao tao, Vec x, PetscReal *f, Vec g, void *ctx)
84: {
85: PetscObjectUseFortranCallback(tao, _cb.objgrad, (Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), (&tao, &x, f, &g, _ctx, &ierr));
86: }
88: static PetscErrorCode ourtaohessianroutine(Tao tao, Vec x, Mat H, Mat Hpre, void *ctx)
89: {
90: PetscObjectUseFortranCallback(tao, _cb.hess, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, &Hpre, _ctx, &ierr));
91: }
93: static PetscErrorCode ourtaojacobianroutine(Tao tao, Vec x, Mat H, Mat Hpre, void *ctx)
94: {
95: PetscObjectUseFortranCallback(tao, _cb.jac, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, &Hpre, _ctx, &ierr));
96: }
98: static PetscErrorCode ourtaojacobianstateroutine(Tao tao, Vec x, Mat H, Mat Hpre, Mat Hinv, void *ctx)
99: {
100: PetscObjectUseFortranCallback(tao, _cb.jacstate, (Tao *, Vec *, Mat *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, &Hpre, &Hinv, _ctx, &ierr));
101: }
103: static PetscErrorCode ourtaojacobiandesignroutine(Tao tao, Vec x, Mat H, void *ctx)
104: {
105: PetscObjectUseFortranCallback(tao, _cb.jacdesign, (Tao *, Vec *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, _ctx, &ierr));
106: }
108: static PetscErrorCode ourtaoboundsroutine(Tao tao, Vec xl, Vec xu, void *ctx)
109: {
110: PetscObjectUseFortranCallback(tao, _cb.bounds, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &xl, &xu, _ctx, &ierr));
111: }
112: static PetscErrorCode ourtaoresidualroutine(Tao tao, Vec x, Vec f, void *ctx)
113: {
114: PetscObjectUseFortranCallback(tao, _cb.lsres, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &x, &f, _ctx, &ierr));
115: }
117: static PetscErrorCode ourtaojacobianresidualroutine(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx)
118: {
119: PetscObjectUseFortranCallback(tao, _cb.lsjac, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &J, &Jpre, _ctx, &ierr));
120: }
122: static PetscErrorCode ourtaomonitor(Tao tao, void *ctx)
123: {
124: PetscObjectUseFortranCallback(tao, _cb.mon, (Tao *, void *, PetscErrorCode *), (&tao, _ctx, &ierr));
125: }
127: static PetscErrorCode ourtaomondestroy(void **ctx)
128: {
129: Tao tao = (Tao)*ctx;
130: PetscObjectUseFortranCallback(tao, _cb.mondestroy, (void *, PetscErrorCode *), (_ctx, &ierr));
131: }
132: static PetscErrorCode ourtaoconvergencetest(Tao tao, void *ctx)
133: {
134: PetscObjectUseFortranCallback(tao, _cb.convtest, (Tao *, void *, PetscErrorCode *), (&tao, _ctx, &ierr));
135: }
137: static PetscErrorCode ourtaoconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx)
138: {
139: PetscObjectUseFortranCallback(tao, _cb.constraints, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &x, &c, _ctx, &ierr));
140: }
142: static PetscErrorCode ourtaojacobianinequalityroutine(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx)
143: {
144: PetscObjectUseFortranCallback(tao, _cb.jacineq, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &J, &Jpre, _ctx, &ierr));
145: }
147: static PetscErrorCode ourtaojacobianequalityroutine(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx)
148: {
149: PetscObjectUseFortranCallback(tao, _cb.jaceq, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &J, &Jpre, _ctx, &ierr));
150: }
152: static PetscErrorCode ourtaoinequalityconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx)
153: {
154: PetscObjectUseFortranCallback(tao, _cb.conineq, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &x, &c, _ctx, &ierr));
155: }
157: static PetscErrorCode ourtaoequalityconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx)
158: {
159: PetscObjectUseFortranCallback(tao, _cb.coneq, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &x, &c, _ctx, &ierr));
160: }
162: static PetscErrorCode ourtaoupdateroutine(Tao tao, PetscInt iter, void *ctx)
163: {
164: PetscObjectUseFortranCallback(tao, _cb.update, (Tao *, PetscInt *, void *), (&tao, &iter, _ctx));
165: }
167: PETSC_EXTERN void taosetobjective_(Tao *tao, void (*func)(Tao *, Vec *, PetscReal *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
168: {
169: CHKFORTRANNULLFUNCTION(func);
170: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.obj, (PetscVoidFn *)func, ctx);
171: if (!*ierr) *ierr = TaoSetObjective(*tao, ourtaoobjectiveroutine, ctx);
172: }
174: PETSC_EXTERN void taosetgradient_(Tao *tao, Vec *g, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
175: {
176: CHKFORTRANNULLFUNCTION(func);
177: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.grad, (PetscVoidFn *)func, ctx);
178: if (!*ierr) *ierr = TaoSetGradient(*tao, *g, ourtaogradientroutine, ctx);
179: }
181: PETSC_EXTERN void taosetobjectiveandgradient_(Tao *tao, Vec *g, void (*func)(Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
182: {
183: CHKFORTRANNULLFUNCTION(func);
184: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objgrad, (PetscVoidFn *)func, ctx);
185: if (!*ierr) *ierr = TaoSetObjectiveAndGradient(*tao, *g, ourtaoobjectiveandgradientroutine, ctx);
186: }
188: PETSC_EXTERN void taosethessian_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
189: {
190: CHKFORTRANNULLFUNCTION(func);
191: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.hess, (PetscVoidFn *)func, ctx);
192: if (!*ierr) *ierr = TaoSetHessian(*tao, *J, *Jp, ourtaohessianroutine, ctx);
193: }
195: PETSC_EXTERN void taosetresidualroutine_(Tao *tao, Vec *F, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
196: {
197: CHKFORTRANNULLFUNCTION(func);
198: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.lsres, (PetscVoidFn *)func, ctx);
199: if (!*ierr) *ierr = TaoSetResidualRoutine(*tao, *F, ourtaoresidualroutine, ctx);
200: }
202: PETSC_EXTERN void taosetjacobianresidualroutine_(Tao *tao, Mat *J, Mat *Jpre, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
203: {
204: CHKFORTRANNULLFUNCTION(func);
205: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.lsjac, (PetscVoidFn *)func, ctx);
206: if (!*ierr) *ierr = TaoSetJacobianResidualRoutine(*tao, *J, *Jpre, ourtaojacobianresidualroutine, ctx);
207: }
209: PETSC_EXTERN void taosetjacobianroutine_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
210: {
211: CHKFORTRANNULLFUNCTION(func);
212: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jac, (PetscVoidFn *)func, ctx);
213: if (!*ierr) *ierr = TaoSetJacobianRoutine(*tao, *J, *Jp, ourtaojacobianroutine, ctx);
214: }
216: 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)
217: {
218: CHKFORTRANNULLFUNCTION(func);
219: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacstate, (PetscVoidFn *)func, ctx);
220: if (!*ierr) *ierr = TaoSetJacobianStateRoutine(*tao, *J, *Jp, *Jinv, ourtaojacobianstateroutine, ctx);
221: }
223: PETSC_EXTERN void taosetjacobiandesignroutine_(Tao *tao, Mat *J, void (*func)(Tao *, Vec *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
224: {
225: CHKFORTRANNULLFUNCTION(func);
226: *ierr = PetscObjectSetFortranCallback((PetscObject)tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacdesign, (PetscVoidFn *)func, ctx);
227: if (!*ierr) *ierr = TaoSetJacobianDesignRoutine(*tao, *J, ourtaojacobiandesignroutine, ctx);
228: }
230: PETSC_EXTERN void taosetvariableboundsroutine_(Tao *tao, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
231: {
232: CHKFORTRANNULLFUNCTION(func);
233: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.bounds, (PetscVoidFn *)func, ctx);
234: if (!*ierr) *ierr = TaoSetVariableBoundsRoutine(*tao, ourtaoboundsroutine, ctx);
235: }
237: PETSC_EXTERN void taomonitorset_(Tao *tao, void (*func)(Tao *, void *, PetscErrorCode *), void *ctx, void (*mondestroy)(void *, PetscErrorCode *), PetscErrorCode *ierr)
238: {
239: CHKFORTRANNULLFUNCTION(mondestroy);
240: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.mon, (PetscVoidFn *)func, ctx);
241: if (*ierr) return;
242: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.mondestroy, (PetscVoidFn *)mondestroy, ctx);
243: if (*ierr) return;
244: *ierr = TaoMonitorSet(*tao, ourtaomonitor, *tao, ourtaomondestroy);
245: }
247: PETSC_EXTERN void taosetconvergencetest_(Tao *tao, void (*func)(Tao *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
248: {
249: CHKFORTRANNULLFUNCTION(func);
250: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.convtest, (PetscVoidFn *)func, ctx);
251: if (!*ierr) *ierr = TaoSetConvergenceTest(*tao, ourtaoconvergencetest, ctx);
252: }
254: PETSC_EXTERN void taosetconstraintsroutine_(Tao *tao, Vec *C, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
255: {
256: CHKFORTRANNULLFUNCTION(func);
257: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.constraints, (PetscVoidFn *)func, ctx);
258: if (!*ierr) *ierr = TaoSetConstraintsRoutine(*tao, *C, ourtaoconstraintsroutine, ctx);
259: }
261: PETSC_EXTERN void taogetconvergencehistory_(Tao *tao, PetscInt *nhist, PetscErrorCode *ierr)
262: {
263: *ierr = TaoGetConvergenceHistory(*tao, NULL, NULL, NULL, NULL, nhist);
264: }
266: PETSC_EXTERN void taosetjacobianinequalityroutine_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
267: {
268: CHKFORTRANNULLFUNCTION(func);
269: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacineq, (PetscVoidFn *)func, ctx);
270: if (!*ierr) *ierr = TaoSetJacobianInequalityRoutine(*tao, *J, *Jp, ourtaojacobianinequalityroutine, ctx);
271: }
273: PETSC_EXTERN void taosetjacobianequalityroutine_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
274: {
275: CHKFORTRANNULLFUNCTION(func);
276: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jaceq, (PetscVoidFn *)func, ctx);
277: if (!*ierr) *ierr = TaoSetJacobianEqualityRoutine(*tao, *J, *Jp, ourtaojacobianequalityroutine, ctx);
278: }
280: PETSC_EXTERN void taosetinequalityconstraintsroutine_(Tao *tao, Vec *C, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
281: {
282: CHKFORTRANNULLFUNCTION(func);
283: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.conineq, (PetscVoidFn *)func, ctx);
284: if (!*ierr) *ierr = TaoSetInequalityConstraintsRoutine(*tao, *C, ourtaoinequalityconstraintsroutine, ctx);
285: }
287: PETSC_EXTERN void taosetequalityconstraintsroutine_(Tao *tao, Vec *C, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
288: {
289: CHKFORTRANNULLFUNCTION(func);
290: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.coneq, (PetscVoidFn *)func, ctx);
291: if (!*ierr) *ierr = TaoSetEqualityConstraintsRoutine(*tao, *C, ourtaoequalityconstraintsroutine, ctx);
292: }
294: PETSC_EXTERN void taosetupdate_(Tao *tao, void (*func)(Tao *, PetscInt *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
295: {
296: CHKFORTRANNULLFUNCTION(func);
297: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.update, (PetscVoidFn *)func, ctx);
298: if (!*ierr) *ierr = TaoSetUpdate(*tao, ourtaoupdateroutine, ctx);
299: }