1 #include <petsc/private/fortranimpl.h> 2 #include <petsc/private/f90impl.h> 3 #include <petsc/private/taoimpl.h> 4 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 taosetmonitor_ TAOSETMONITOR 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 taosetmonitor_ taosetmonitor 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 62 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; 88 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 } 93 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 } 98 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 } 103 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 } 108 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 } 113 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 } 118 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 } 123 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 } 132 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 } 137 138 static PetscErrorCode ourtaomonitor(Tao tao, void *ctx) 139 { 140 PetscObjectUseFortranCallback(tao, _cb.mon, (Tao *, void *, PetscErrorCode *), (&tao, _ctx, &ierr)); 141 } 142 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 } 152 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 } 157 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 } 162 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 } 167 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 } 172 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 } 177 178 static PetscErrorCode ourtaoupdateroutine(Tao tao, PetscInt iter, void *ctx) 179 { 180 PetscObjectUseFortranCallback(tao, _cb.update, (Tao *, PetscInt *, void *), (&tao, &iter, _ctx)); 181 } 182 183 EXTERN_C_BEGIN 184 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, (PetscVoidFunction)func, ctx); 189 if (!*ierr) *ierr = TaoSetObjective(*tao, ourtaoobjectiveroutine, ctx); 190 } 191 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, (PetscVoidFunction)func, ctx); 196 if (!*ierr) *ierr = TaoSetGradient(*tao, *g, ourtaogradientroutine, ctx); 197 } 198 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, (PetscVoidFunction)func, ctx); 203 if (!*ierr) *ierr = TaoSetObjectiveAndGradient(*tao, *g, ourtaoobjectiveandgradientroutine, ctx); 204 } 205 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, (PetscVoidFunction)func, ctx); 210 if (!*ierr) *ierr = TaoSetHessian(*tao, *J, *Jp, ourtaohessianroutine, ctx); 211 } 212 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, (PetscVoidFunction)func, ctx); 217 if (!*ierr) *ierr = TaoSetResidualRoutine(*tao, *F, ourtaoresidualroutine, ctx); 218 } 219 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, (PetscVoidFunction)func, ctx); 224 if (!*ierr) *ierr = TaoSetJacobianResidualRoutine(*tao, *J, *Jpre, ourtaojacobianresidualroutine, ctx); 225 } 226 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, (PetscVoidFunction)func, ctx); 231 if (!*ierr) *ierr = TaoSetJacobianRoutine(*tao, *J, *Jp, ourtaojacobianroutine, ctx); 232 } 233 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, (PetscVoidFunction)func, ctx); 238 if (!*ierr) *ierr = TaoSetJacobianStateRoutine(*tao, *J, *Jp, *Jinv, ourtaojacobianstateroutine, ctx); 239 } 240 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, (PetscVoidFunction)func, ctx); 245 if (!*ierr) *ierr = TaoSetJacobianDesignRoutine(*tao, *J, ourtaojacobiandesignroutine, ctx); 246 } 247 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, (PetscVoidFunction)func, ctx); 252 if (!*ierr) *ierr = TaoSetVariableBoundsRoutine(*tao, ourtaoboundsroutine, ctx); 253 } 254 255 PETSC_EXTERN void taosetmonitor_(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, (PetscVoidFunction)func, ctx); 259 if (*ierr) return; 260 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao, PETSC_FORTRAN_CALLBACK_CLASS, &_cb.mondestroy, (PetscVoidFunction)mondestroy, ctx); 261 if (*ierr) return; 262 *ierr = TaoSetMonitor(*tao, ourtaomonitor, *tao, ourtaomondestroy); 263 } 264 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, (PetscVoidFunction)func, ctx); 269 if (!*ierr) *ierr = TaoSetConvergenceTest(*tao, ourtaoconvergencetest, ctx); 270 } 271 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, (PetscVoidFunction)func, ctx); 276 if (!*ierr) *ierr = TaoSetConstraintsRoutine(*tao, *C, ourtaoconstraintsroutine, ctx); 277 } 278 279 PETSC_EXTERN void taosettype_(Tao *tao, char *type_name, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 280 { 281 char *t; 282 283 FIXCHAR(type_name, len, t); 284 *ierr = TaoSetType(*tao, t); 285 if (*ierr) return; 286 FREECHAR(type_name, t); 287 } 288 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 } 295 296 PETSC_EXTERN void taogetconvergencehistory_(Tao *tao, PetscInt *nhist, PetscErrorCode *ierr) 297 { 298 *ierr = TaoGetConvergenceHistory(*tao, NULL, NULL, NULL, NULL, nhist); 299 } 300 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 } 309 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 } 318 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 } 327 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 } 336 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, (PetscVoidFunction)func, ctx); 341 if (!*ierr) *ierr = TaoSetJacobianInequalityRoutine(*tao, *J, *Jp, ourtaojacobianinequalityroutine, ctx); 342 } 343 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, (PetscVoidFunction)func, ctx); 348 if (!*ierr) *ierr = TaoSetJacobianEqualityRoutine(*tao, *J, *Jp, ourtaojacobianequalityroutine, ctx); 349 } 350 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, (PetscVoidFunction)func, ctx); 355 if (!*ierr) *ierr = TaoSetInequalityConstraintsRoutine(*tao, *C, ourtaoinequalityconstraintsroutine, ctx); 356 } 357 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, (PetscVoidFunction)func, ctx); 362 if (!*ierr) *ierr = TaoSetEqualityConstraintsRoutine(*tao, *C, ourtaoequalityconstraintsroutine, ctx); 363 } 364 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, (PetscVoidFunction)func, ctx); 369 if (!*ierr) *ierr = TaoSetUpdate(*tao, ourtaoupdateroutine, ctx); 370 } 371 372 PETSC_EXTERN void taoviewfromoptions_(Tao *ao, PetscObject obj, char *type, PetscErrorCode *ierr, PETSC_FORTRAN_CHARLEN_T len) 373 { 374 char *t; 375 376 FIXCHAR(type, len, t); 377 CHKFORTRANNULLOBJECT(obj); 378 *ierr = TaoViewFromOptions(*ao, obj, t); 379 if (*ierr) return; 380 FREECHAR(type, t); 381 } 382 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 } 390 391 EXTERN_C_END 392