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