1 #include <petsc/private/fortranimpl.h> 2 #include <petsc/private/f90impl.h> 3 #include <petsc/private/taoimpl.h> 4 5 6 #if defined(PETSC_HAVE_FORTRAN_CAPS) 7 #define taosetobjectiveroutine_ TAOSETOBJECTIVEROUTINE 8 #define taosetgradientroutine_ TAOSETGRADIENTROUTINE 9 #define taosetobjectiveandgradientroutine_ TAOSETOBJECTIVEANDGRADIENTROUTINE 10 #define taosethessianroutine_ TAOSETHESSIANROUTINE 11 #define taosetresidualroutine_ TAOSETRESIDUALROUTINE 12 #define taosetjacobianresidualroutine_ TAOSETJACOBIANRESIDUALROUTINE 13 #define taosetjacobianroutine_ TAOSETJACOBIANROUTINE 14 #define taosetjacobianstateroutine_ TAOSETJACOBIANSTATEROUTINE 15 #define taosetjacobiandesignroutine_ TAOSETJACOBIANDESIGNROUTINE 16 #define taosetjacobianinequalityroutine_ TAOSETJACOBIANINEQUALITYROUTINE 17 #define taosetjacobianequalityroutine_ TAOSETJACOBIANEQUALITYROUTINE 18 #define taosetinequalityconstraintsroutine_ TAOSETINEQUALITYCONSTRAINTSROUTINE 19 #define taosetequalityconstraintsroutine_ TAOSETEQUALITYCONSTRAINTSROUTINE 20 #define taosetvariableboundsroutine_ TAOSETVARIABLEBOUNDSROUTINE 21 #define taosetconstraintsroutine_ TAOSETCONSTRAINTSROUTINE 22 #define taosetmonitor_ TAOSETMONITOR 23 #define taosettype_ TAOSETTYPE 24 #define taoview_ TAOVIEW 25 #define taogetconvergencehistory_ TAOGETCONVERGENCEHISTORY 26 #define taosetconvergencetest_ TAOSETCONVERGENCETEST 27 #define taogetoptionsprefix_ TAOGETOPTIONSPREFIX 28 #define taosetoptionsprefix_ TAOSETOPTIONSPREFIX 29 #define taoappendoptionsprefix_ TAOAPPENDOPTIONSPREFIX 30 #define taogettype_ TAOGETTYPE 31 #define taosetupdate_ TAOSETUPDATE 32 #define taoviewfromoptions_ TAOVIEWFROMOPTIONS 33 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 34 35 #define taosetobjectiveroutine_ taosetobjectiveroutine 36 #define taosetgradientroutine_ taosetgradientroutine 37 #define taosetobjectiveandgradientroutine_ taosetobjectiveandgradientroutine 38 #define taosethessianroutine_ taosethessianroutine 39 #define taosetresidualroutine_ taosetresidualroutine 40 #define taosetjacobianresidualroutine_ taosetjacobianresidualroutine 41 #define taosetjacobianroutine_ taosetjacobianroutine 42 #define taosetjacobianstateroutine_ taosetjacobianstateroutine 43 #define taosetjacobiandesignroutine_ taosetjacobiandesignroutine 44 #define taosetjacobianinequalityroutine_ taosetjacobianinequalityroutine 45 #define taosetjacobianequalityroutine_ taosetjacobianequalityroutine 46 #define taosetinequalityconstraintsroutine_ taosetinequalityconstraintsroutine 47 #define taosetequalityconstraintsroutine_ taosetequalityconstraintsroutine 48 #define taosetvariableboundsroutine_ taosetvariableboundsroutine 49 #define taosetconstraintsroutine_ taosetconstraintsroutine 50 #define taosetmonitor_ taosetmonitor 51 #define taosettype_ taosettype 52 #define taoview_ taoview 53 #define taogetconvergencehistory_ taogetconvergencehistory 54 #define taosetconvergencetest_ taosetconvergencetest 55 #define taogetoptionsprefix_ taogetoptionsprefix 56 #define taosetoptionsprefix_ taosetoptionsprefix 57 #define taoappendoptionsprefix_ taoappendoptionsprefix 58 #define taogettype_ taogettype 59 #define taosetupdate_ taosetupdate 60 #define taoviewfromoptions_ taoviewfromoptions 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 taosetobjectiveroutine_(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 = TaoSetObjectiveRoutine(*tao,ourtaoobjectiveroutine,ctx); 190 } 191 192 PETSC_EXTERN void taosetgradientroutine_(Tao *tao, 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 = TaoSetGradientRoutine(*tao,ourtaogradientroutine,ctx); 197 } 198 199 PETSC_EXTERN void taosetobjectiveandgradientroutine_(Tao *tao, 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 = TaoSetObjectiveAndGradientRoutine(*tao,ourtaoobjectiveandgradientroutine,ctx); 204 } 205 206 PETSC_EXTERN void taosetresidualroutine_(Tao *tao, Vec *F, void (*func)(Tao*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 207 { 208 CHKFORTRANNULLFUNCTION(func); 209 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.lsres,(PetscVoidFunction)func,ctx); 210 if(!*ierr) *ierr = TaoSetResidualRoutine(*tao,*F,ourtaoresidualroutine,ctx); 211 } 212 213 PETSC_EXTERN void taosetjacobianresidualroutine_(Tao *tao, Mat *J, Mat *Jpre, void (*func)(Tao*, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 214 { 215 CHKFORTRANNULLFUNCTION(func); 216 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.lsjac,(PetscVoidFunction)func,ctx); 217 if(!*ierr) *ierr = TaoSetJacobianResidualRoutine(*tao,*J,*Jpre,ourtaojacobianresidualroutine,ctx); 218 } 219 220 PETSC_EXTERN void taosetjacobianroutine_(Tao *tao, Mat *J, Mat *Jp, 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.jac,(PetscVoidFunction)func,ctx); 224 if(!*ierr) *ierr = TaoSetJacobianRoutine(*tao,*J,*Jp,ourtaojacobianroutine,ctx); 225 } 226 227 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) 228 { 229 CHKFORTRANNULLFUNCTION(func); 230 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jacstate,(PetscVoidFunction)func,ctx); 231 if(!*ierr) *ierr = TaoSetJacobianStateRoutine(*tao,*J,*Jp,*Jinv,ourtaojacobianstateroutine,ctx); 232 } 233 234 PETSC_EXTERN void taosetjacobiandesignroutine_(Tao *tao, Mat *J, void (*func)(Tao*, Vec *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 235 { 236 CHKFORTRANNULLFUNCTION(func); 237 *ierr = PetscObjectSetFortranCallback((PetscObject)tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jacdesign,(PetscVoidFunction)func,ctx); 238 if(!*ierr) *ierr = TaoSetJacobianDesignRoutine(*tao,*J,ourtaojacobiandesignroutine,ctx); 239 } 240 241 PETSC_EXTERN void taosethessianroutine_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao*, Vec *, Mat *, Mat *,void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 242 { 243 CHKFORTRANNULLFUNCTION(func); 244 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.hess,(PetscVoidFunction)func,ctx); 245 if(!*ierr) *ierr = TaoSetHessianRoutine(*tao,*J, *Jp, ourtaohessianroutine,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); if (*ierr) return; 259 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.mondestroy,(PetscVoidFunction)mondestroy,ctx); if (*ierr) return; 260 *ierr = TaoSetMonitor(*tao,ourtaomonitor,*tao,ourtaomondestroy); 261 } 262 263 PETSC_EXTERN void taosetconvergencetest_(Tao *tao, void (*func)(Tao*,void*,PetscErrorCode*),void *ctx, PetscErrorCode *ierr) 264 { 265 CHKFORTRANNULLFUNCTION(func); 266 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.convtest,(PetscVoidFunction)func,ctx); 267 if(!*ierr) *ierr = TaoSetConvergenceTest(*tao,ourtaoconvergencetest,ctx); 268 } 269 270 PETSC_EXTERN void taosetconstraintsroutine_(Tao *tao, Vec *C, void (*func)(Tao*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 271 { 272 CHKFORTRANNULLFUNCTION(func); 273 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.constraints,(PetscVoidFunction)func,ctx); 274 if(!*ierr) *ierr = TaoSetConstraintsRoutine(*tao,*C,ourtaoconstraintsroutine,ctx); 275 } 276 277 PETSC_EXTERN void taosettype_(Tao *tao, char* type_name, PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 278 { 279 char *t; 280 281 FIXCHAR(type_name,len,t); 282 *ierr = TaoSetType(*tao,t);if (*ierr) return; 283 FREECHAR(type_name,t); 284 285 } 286 287 PETSC_EXTERN void taoview_(Tao *tao, PetscViewer *viewer, PetscErrorCode *ierr) 288 { 289 PetscViewer v; 290 PetscPatchDefaultViewers_Fortran(viewer,v); 291 *ierr = TaoView(*tao,v); 292 } 293 294 PETSC_EXTERN void taogetconvergencehistory_(Tao *tao, PetscInt *nhist, PetscErrorCode *ierr) 295 { 296 *ierr = TaoGetConvergenceHistory(*tao,NULL,NULL,NULL,NULL,nhist); 297 } 298 299 PETSC_EXTERN void taogetoptionsprefix_(Tao *tao, char* prefix, PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 300 { 301 const char *name; 302 *ierr = TaoGetOptionsPrefix(*tao,&name); 303 *ierr = PetscStrncpy(prefix,name,len); if (*ierr) return; 304 FIXRETURNCHAR(PETSC_TRUE,prefix,len); 305 306 } 307 308 PETSC_EXTERN void taoappendoptionsprefix_(Tao *tao, char* prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 309 { 310 char *name; 311 FIXCHAR(prefix,len,name); 312 *ierr = TaoAppendOptionsPrefix(*tao,name);if (*ierr) return; 313 FREECHAR(prefix,name); 314 } 315 316 PETSC_EXTERN void taosetoptionsprefix_(Tao *tao, char* prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 317 { 318 char *t; 319 FIXCHAR(prefix,len,t); 320 *ierr = TaoSetOptionsPrefix(*tao,t);if (*ierr) return; 321 FREECHAR(prefix,t); 322 } 323 324 PETSC_EXTERN void taogettype_(Tao *tao, char* name, PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 325 { 326 const char *tname; 327 *ierr = TaoGetType(*tao,&tname); 328 *ierr = PetscStrncpy(name,tname,len); if (*ierr) return; 329 FIXRETURNCHAR(PETSC_TRUE,name,len); 330 331 } 332 333 PETSC_EXTERN void taosetjacobianinequalityroutine_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao*, Vec *, Mat *, Mat *,void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 334 { 335 CHKFORTRANNULLFUNCTION(func); 336 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jacineq,(PetscVoidFunction)func,ctx); 337 if(!*ierr) *ierr = TaoSetJacobianInequalityRoutine(*tao,*J,*Jp,ourtaojacobianinequalityroutine,ctx); 338 } 339 340 PETSC_EXTERN void taosetjacobianequalityroutine_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao*, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 341 { 342 CHKFORTRANNULLFUNCTION(func); 343 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jaceq,(PetscVoidFunction)func,ctx); 344 if(!*ierr) *ierr = TaoSetJacobianEqualityRoutine(*tao,*J,*Jp,ourtaojacobianequalityroutine,ctx); 345 } 346 347 PETSC_EXTERN void taosetinequalityconstraintsroutine_(Tao *tao, Vec *C, void (*func)(Tao*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 348 { 349 CHKFORTRANNULLFUNCTION(func); 350 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.conineq,(PetscVoidFunction)func,ctx); 351 if(!*ierr) *ierr = TaoSetInequalityConstraintsRoutine(*tao,*C,ourtaoinequalityconstraintsroutine,ctx); 352 } 353 354 PETSC_EXTERN void taosetequalityconstraintsroutine_(Tao *tao, Vec *C, void (*func)(Tao*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 355 { 356 CHKFORTRANNULLFUNCTION(func); 357 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.coneq,(PetscVoidFunction)func,ctx); 358 if(!*ierr) *ierr = TaoSetEqualityConstraintsRoutine(*tao, *C, ourtaoequalityconstraintsroutine,ctx); 359 } 360 361 PETSC_EXTERN void taosetupdate_(Tao *tao, void (*func)(Tao *, PetscInt *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 362 { 363 CHKFORTRANNULLFUNCTION(func); 364 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.update,(PetscVoidFunction)func,ctx); 365 if(!*ierr) *ierr = TaoSetUpdate(*tao, ourtaoupdateroutine, ctx); 366 } 367 368 PETSC_EXTERN void taoviewfromoptions_(Tao *ao,PetscObject obj,char* type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 369 { 370 char *t; 371 372 FIXCHAR(type,len,t); 373 *ierr = TaoViewFromOptions(*ao,obj,t);if (*ierr) return; 374 FREECHAR(type,t); 375 } 376 377 EXTERN_C_END 378 379 380