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