Actual source code: ztaosolverf.c
1: #include <petsc/private/ftnimpl.h>
2: #include <petsc/private/taoimpl.h>
4: #if defined(PETSC_HAVE_FORTRAN_CAPS)
5: #define taosetobjective_ TAOSETOBJECTIVE
6: #define taosetgradient_ TAOSETGRADIENT
7: #define taosetobjectiveandgradient_ TAOSETOBJECTIVEANDGRADIENT
8: #define taosethessian_ TAOSETHESSIAN
9: #define taosetresidualroutine_ TAOSETRESIDUALROUTINE
10: #define taosetjacobianresidualroutine_ TAOSETJACOBIANRESIDUALROUTINE
11: #define taosetjacobianroutine_ TAOSETJACOBIANROUTINE
12: #define taosetjacobianstateroutine_ TAOSETJACOBIANSTATEROUTINE
13: #define taosetjacobiandesignroutine_ TAOSETJACOBIANDESIGNROUTINE
14: #define taosetjacobianinequalityroutine_ TAOSETJACOBIANINEQUALITYROUTINE
15: #define taosetjacobianequalityroutine_ TAOSETJACOBIANEQUALITYROUTINE
16: #define taosetinequalityconstraintsroutine_ TAOSETINEQUALITYCONSTRAINTSROUTINE
17: #define taosetequalityconstraintsroutine_ TAOSETEQUALITYCONSTRAINTSROUTINE
18: #define taosetvariableboundsroutine_ TAOSETVARIABLEBOUNDSROUTINE
19: #define taosetconstraintsroutine_ TAOSETCONSTRAINTSROUTINE
20: #define taomonitorset_ TAOMONITORSET
21: #define taogetconvergencehistory_ TAOGETCONVERGENCEHISTORY
22: #define taosetconvergencetest_ TAOSETCONVERGENCETEST
23: #define taosetupdate_ TAOSETUPDATE
24: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
25: #define taosetobjective_ taosetobjective
26: #define taosetgradient_ taosetgradient
27: #define taosetobjectiveandgradient_ taosetobjectiveandgradient
28: #define taosethessian_ taosethessian
29: #define taosetresidualroutine_ taosetresidualroutine
30: #define taosetjacobianresidualroutine_ taosetjacobianresidualroutine
31: #define taosetjacobianroutine_ taosetjacobianroutine
32: #define taosetjacobianstateroutine_ taosetjacobianstateroutine
33: #define taosetjacobiandesignroutine_ taosetjacobiandesignroutine
34: #define taosetjacobianinequalityroutine_ taosetjacobianinequalityroutine
35: #define taosetjacobianequalityroutine_ taosetjacobianequalityroutine
36: #define taosetinequalityconstraintsroutine_ taosetinequalityconstraintsroutine
37: #define taosetequalityconstraintsroutine_ taosetequalityconstraintsroutine
38: #define taosetvariableboundsroutine_ taosetvariableboundsroutine
39: #define taosetconstraintsroutine_ taosetconstraintsroutine
40: #define taomonitorset_ taomonitorset
41: #define taogetconvergencehistory_ taogetconvergencehistory
42: #define taosetconvergencetest_ taosetconvergencetest
43: #define taosetupdate_ taosetupdate
44: #endif
46: static struct {
47: PetscFortranCallbackId obj;
48: PetscFortranCallbackId grad;
49: PetscFortranCallbackId objgrad;
50: PetscFortranCallbackId hess;
51: PetscFortranCallbackId lsres;
52: PetscFortranCallbackId lsjac;
53: PetscFortranCallbackId jac;
54: PetscFortranCallbackId jacstate;
55: PetscFortranCallbackId jacdesign;
56: PetscFortranCallbackId bounds;
57: PetscFortranCallbackId mon;
58: PetscFortranCallbackId mondestroy;
59: PetscFortranCallbackId convtest;
60: PetscFortranCallbackId constraints;
61: PetscFortranCallbackId jacineq;
62: PetscFortranCallbackId jaceq;
63: PetscFortranCallbackId conineq;
64: PetscFortranCallbackId coneq;
65: PetscFortranCallbackId nfuncs;
66: PetscFortranCallbackId update;
67: #if defined(PETSC_HAVE_F90_2PTR_ARG)
68: PetscFortranCallbackId function_pgiptr;
69: #endif
70: } _cb;
72: static PetscErrorCode ourtaoobjectiveroutine(Tao tao, Vec x, PetscReal *f, void *ctx)
73: {
74: PetscObjectUseFortranCallback(tao, _cb.obj, (Tao *, Vec *, PetscReal *, void *, PetscErrorCode *), (&tao, &x, f, _ctx, &ierr));
75: }
77: static PetscErrorCode ourtaogradientroutine(Tao tao, Vec x, Vec g, void *ctx)
78: {
79: PetscObjectUseFortranCallback(tao, _cb.grad, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &x, &g, _ctx, &ierr));
80: }
82: static PetscErrorCode ourtaoobjectiveandgradientroutine(Tao tao, Vec x, PetscReal *f, Vec g, void *ctx)
83: {
84: PetscObjectUseFortranCallback(tao, _cb.objgrad, (Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), (&tao, &x, f, &g, _ctx, &ierr));
85: }
87: static PetscErrorCode ourtaohessianroutine(Tao tao, Vec x, Mat H, Mat Hpre, void *ctx)
88: {
89: PetscObjectUseFortranCallback(tao, _cb.hess, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, &Hpre, _ctx, &ierr));
90: }
92: static PetscErrorCode ourtaojacobianroutine(Tao tao, Vec x, Mat H, Mat Hpre, void *ctx)
93: {
94: PetscObjectUseFortranCallback(tao, _cb.jac, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, &Hpre, _ctx, &ierr));
95: }
97: static PetscErrorCode ourtaojacobianstateroutine(Tao tao, Vec x, Mat H, Mat Hpre, Mat Hinv, void *ctx)
98: {
99: PetscObjectUseFortranCallback(tao, _cb.jacstate, (Tao *, Vec *, Mat *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, &Hpre, &Hinv, _ctx, &ierr));
100: }
102: static PetscErrorCode ourtaojacobiandesignroutine(Tao tao, Vec x, Mat H, void *ctx)
103: {
104: PetscObjectUseFortranCallback(tao, _cb.jacdesign, (Tao *, Vec *, Mat *, void *, PetscErrorCode *), (&tao, &x, &H, _ctx, &ierr));
105: }
107: static PetscErrorCode ourtaoboundsroutine(Tao tao, Vec xl, Vec xu, void *ctx)
108: {
109: PetscObjectUseFortranCallback(tao, _cb.bounds, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &xl, &xu, _ctx, &ierr));
110: }
111: static PetscErrorCode ourtaoresidualroutine(Tao tao, Vec x, Vec f, void *ctx)
112: {
113: PetscObjectUseFortranCallback(tao, _cb.lsres, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &x, &f, _ctx, &ierr));
114: }
116: static PetscErrorCode ourtaojacobianresidualroutine(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx)
117: {
118: PetscObjectUseFortranCallback(tao, _cb.lsjac, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &J, &Jpre, _ctx, &ierr));
119: }
121: static PetscErrorCode ourtaomonitor(Tao tao, void *ctx)
122: {
123: PetscObjectUseFortranCallback(tao, _cb.mon, (Tao *, void *, PetscErrorCode *), (&tao, _ctx, &ierr));
124: }
126: static PetscErrorCode ourtaomondestroy(void **ctx)
127: {
128: Tao tao = (Tao)*ctx;
129: PetscObjectUseFortranCallback(tao, _cb.mondestroy, (void *, PetscErrorCode *), (_ctx, &ierr));
130: }
131: static PetscErrorCode ourtaoconvergencetest(Tao tao, void *ctx)
132: {
133: PetscObjectUseFortranCallback(tao, _cb.convtest, (Tao *, void *, PetscErrorCode *), (&tao, _ctx, &ierr));
134: }
136: static PetscErrorCode ourtaoconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx)
137: {
138: PetscObjectUseFortranCallback(tao, _cb.constraints, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &x, &c, _ctx, &ierr));
139: }
141: static PetscErrorCode ourtaojacobianinequalityroutine(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx)
142: {
143: PetscObjectUseFortranCallback(tao, _cb.jacineq, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &J, &Jpre, _ctx, &ierr));
144: }
146: static PetscErrorCode ourtaojacobianequalityroutine(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx)
147: {
148: PetscObjectUseFortranCallback(tao, _cb.jaceq, (Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), (&tao, &x, &J, &Jpre, _ctx, &ierr));
149: }
151: static PetscErrorCode ourtaoinequalityconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx)
152: {
153: PetscObjectUseFortranCallback(tao, _cb.conineq, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &x, &c, _ctx, &ierr));
154: }
156: static PetscErrorCode ourtaoequalityconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx)
157: {
158: PetscObjectUseFortranCallback(tao, _cb.coneq, (Tao *, Vec *, Vec *, void *, PetscErrorCode *), (&tao, &x, &c, _ctx, &ierr));
159: }
161: static PetscErrorCode ourtaoupdateroutine(Tao tao, PetscInt iter, void *ctx)
162: {
163: PetscObjectUseFortranCallback(tao, _cb.update, (Tao *, PetscInt *, void *), (&tao, &iter, _ctx));
164: }
166: PETSC_EXTERN void taosetobjective_(Tao *tao, void (*func)(Tao *, Vec *, PetscReal *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
167: {
168: CHKFORTRANNULLFUNCTION(func);
169: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.obj, (PetscVoidFn *)func, ctx);
170: if (!*ierr) *ierr = TaoSetObjective(*tao, ourtaoobjectiveroutine, ctx);
171: }
173: PETSC_EXTERN void taosetgradient_(Tao *tao, Vec *g, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
174: {
175: CHKFORTRANNULLFUNCTION(func);
176: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.grad, (PetscVoidFn *)func, ctx);
177: if (!*ierr) *ierr = TaoSetGradient(*tao, *g, ourtaogradientroutine, ctx);
178: }
180: PETSC_EXTERN void taosetobjectiveandgradient_(Tao *tao, Vec *g, void (*func)(Tao *, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
181: {
182: CHKFORTRANNULLFUNCTION(func);
183: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.objgrad, (PetscVoidFn *)func, ctx);
184: if (!*ierr) *ierr = TaoSetObjectiveAndGradient(*tao, *g, ourtaoobjectiveandgradientroutine, ctx);
185: }
187: PETSC_EXTERN void taosethessian_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
188: {
189: CHKFORTRANNULLFUNCTION(func);
190: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.hess, (PetscVoidFn *)func, ctx);
191: if (!*ierr) *ierr = TaoSetHessian(*tao, *J, *Jp, ourtaohessianroutine, ctx);
192: }
194: PETSC_EXTERN void taosetresidualroutine_(Tao *tao, Vec *F, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
195: {
196: CHKFORTRANNULLFUNCTION(func);
197: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.lsres, (PetscVoidFn *)func, ctx);
198: if (!*ierr) *ierr = TaoSetResidualRoutine(*tao, *F, ourtaoresidualroutine, ctx);
199: }
201: PETSC_EXTERN void taosetjacobianresidualroutine_(Tao *tao, Mat *J, Mat *Jpre, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
202: {
203: CHKFORTRANNULLFUNCTION(func);
204: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.lsjac, (PetscVoidFn *)func, ctx);
205: if (!*ierr) *ierr = TaoSetJacobianResidualRoutine(*tao, *J, *Jpre, ourtaojacobianresidualroutine, ctx);
206: }
208: PETSC_EXTERN void taosetjacobianroutine_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
209: {
210: CHKFORTRANNULLFUNCTION(func);
211: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jac, (PetscVoidFn *)func, ctx);
212: if (!*ierr) *ierr = TaoSetJacobianRoutine(*tao, *J, *Jp, ourtaojacobianroutine, ctx);
213: }
215: 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)
216: {
217: CHKFORTRANNULLFUNCTION(func);
218: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacstate, (PetscVoidFn *)func, ctx);
219: if (!*ierr) *ierr = TaoSetJacobianStateRoutine(*tao, *J, *Jp, *Jinv, ourtaojacobianstateroutine, ctx);
220: }
222: PETSC_EXTERN void taosetjacobiandesignroutine_(Tao *tao, Mat *J, void (*func)(Tao *, Vec *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
223: {
224: CHKFORTRANNULLFUNCTION(func);
225: *ierr = PetscObjectSetFortranCallback((PetscObject)tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacdesign, (PetscVoidFn *)func, ctx);
226: if (!*ierr) *ierr = TaoSetJacobianDesignRoutine(*tao, *J, ourtaojacobiandesignroutine, ctx);
227: }
229: PETSC_EXTERN void taosetvariableboundsroutine_(Tao *tao, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
230: {
231: CHKFORTRANNULLFUNCTION(func);
232: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.bounds, (PetscVoidFn *)func, ctx);
233: if (!*ierr) *ierr = TaoSetVariableBoundsRoutine(*tao, ourtaoboundsroutine, ctx);
234: }
236: PETSC_EXTERN void taomonitorset_(Tao *tao, void (*func)(Tao *, void *, PetscErrorCode *), void *ctx, void (*mondestroy)(void *, PetscErrorCode *), PetscErrorCode *ierr)
237: {
238: CHKFORTRANNULLFUNCTION(mondestroy);
239: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.mon, (PetscVoidFn *)func, ctx);
240: if (*ierr) return;
241: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.mondestroy, (PetscVoidFn *)mondestroy, ctx);
242: if (*ierr) return;
243: *ierr = TaoMonitorSet(*tao, ourtaomonitor, *tao, ourtaomondestroy);
244: }
246: PETSC_EXTERN void taosetconvergencetest_(Tao *tao, void (*func)(Tao *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
247: {
248: CHKFORTRANNULLFUNCTION(func);
249: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.convtest, (PetscVoidFn *)func, ctx);
250: if (!*ierr) *ierr = TaoSetConvergenceTest(*tao, ourtaoconvergencetest, ctx);
251: }
253: PETSC_EXTERN void taosetconstraintsroutine_(Tao *tao, Vec *C, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
254: {
255: CHKFORTRANNULLFUNCTION(func);
256: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.constraints, (PetscVoidFn *)func, ctx);
257: if (!*ierr) *ierr = TaoSetConstraintsRoutine(*tao, *C, ourtaoconstraintsroutine, ctx);
258: }
260: PETSC_EXTERN void taogetconvergencehistory_(Tao *tao, PetscInt *nhist, PetscErrorCode *ierr)
261: {
262: *ierr = TaoGetConvergenceHistory(*tao, NULL, NULL, NULL, NULL, nhist);
263: }
265: PETSC_EXTERN void taosetjacobianinequalityroutine_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
266: {
267: CHKFORTRANNULLFUNCTION(func);
268: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jacineq, (PetscVoidFn *)func, ctx);
269: if (!*ierr) *ierr = TaoSetJacobianInequalityRoutine(*tao, *J, *Jp, ourtaojacobianinequalityroutine, ctx);
270: }
272: PETSC_EXTERN void taosetjacobianequalityroutine_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao *, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
273: {
274: CHKFORTRANNULLFUNCTION(func);
275: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.jaceq, (PetscVoidFn *)func, ctx);
276: if (!*ierr) *ierr = TaoSetJacobianEqualityRoutine(*tao, *J, *Jp, ourtaojacobianequalityroutine, ctx);
277: }
279: PETSC_EXTERN void taosetinequalityconstraintsroutine_(Tao *tao, Vec *C, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
280: {
281: CHKFORTRANNULLFUNCTION(func);
282: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.conineq, (PetscVoidFn *)func, ctx);
283: if (!*ierr) *ierr = TaoSetInequalityConstraintsRoutine(*tao, *C, ourtaoinequalityconstraintsroutine, ctx);
284: }
286: PETSC_EXTERN void taosetequalityconstraintsroutine_(Tao *tao, Vec *C, void (*func)(Tao *, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
287: {
288: CHKFORTRANNULLFUNCTION(func);
289: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.coneq, (PetscVoidFn *)func, ctx);
290: if (!*ierr) *ierr = TaoSetEqualityConstraintsRoutine(*tao, *C, ourtaoequalityconstraintsroutine, ctx);
291: }
293: PETSC_EXTERN void taosetupdate_(Tao *tao, void (*func)(Tao *, PetscInt *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr)
294: {
295: CHKFORTRANNULLFUNCTION(func);
296: *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.update, (PetscVoidFn *)func, ctx);
297: if (!*ierr) *ierr = TaoSetUpdate(*tao, ourtaoupdateroutine, ctx);
298: }