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 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 33 34 #define taosetobjectiveroutine_ taosetobjectiveroutine 35 #define taosetgradientroutine_ taosetgradientroutine 36 #define taosetobjectiveandgradientroutine_ taosetobjectiveandgradientroutine 37 #define taosethessianroutine_ taosethessianroutine 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 #endif 60 61 static struct { 62 PetscFortranCallbackId obj; 63 PetscFortranCallbackId grad; 64 PetscFortranCallbackId objgrad; 65 PetscFortranCallbackId hess; 66 PetscFortranCallbackId lsres; 67 PetscFortranCallbackId lsjac; 68 PetscFortranCallbackId jac; 69 PetscFortranCallbackId jacstate; 70 PetscFortranCallbackId jacdesign; 71 PetscFortranCallbackId bounds; 72 PetscFortranCallbackId mon; 73 PetscFortranCallbackId mondestroy; 74 PetscFortranCallbackId convtest; 75 PetscFortranCallbackId constraints; 76 PetscFortranCallbackId jacineq; 77 PetscFortranCallbackId jaceq; 78 PetscFortranCallbackId conineq; 79 PetscFortranCallbackId coneq; 80 PetscFortranCallbackId nfuncs; 81 PetscFortranCallbackId update; 82 #if defined(PETSC_HAVE_F90_2PTR_ARG) 83 PetscFortranCallbackId function_pgiptr; 84 #endif 85 } _cb; 86 87 static PetscErrorCode ourtaoobjectiveroutine(Tao tao, Vec x, PetscReal *f, void *ctx) 88 { 89 PetscObjectUseFortranCallback(tao,_cb.obj,(Tao*,Vec*,PetscReal*,void*,PetscErrorCode*),(&tao,&x,f,_ctx,&ierr)); 90 } 91 92 static PetscErrorCode ourtaogradientroutine(Tao tao, Vec x, Vec g, void *ctx) 93 { 94 PetscObjectUseFortranCallback(tao,_cb.grad,(Tao*,Vec*,Vec*,void*,PetscErrorCode*),(&tao,&x,&g,_ctx,&ierr)); 95 } 96 97 static PetscErrorCode ourtaoobjectiveandgradientroutine(Tao tao, Vec x, PetscReal *f, Vec g, void* ctx) 98 { 99 PetscObjectUseFortranCallback(tao,_cb.objgrad,(Tao*,Vec*,PetscReal*,Vec*,void*,PetscErrorCode*),(&tao,&x,f,&g,_ctx,&ierr)); 100 } 101 102 static PetscErrorCode ourtaohessianroutine(Tao tao, Vec x, Mat H, Mat Hpre, void *ctx) 103 { 104 PetscObjectUseFortranCallback(tao,_cb.hess,(Tao*,Vec*,Mat*,Mat*,void*,PetscErrorCode*),(&tao,&x,&H,&Hpre,_ctx,&ierr)); 105 } 106 107 static PetscErrorCode ourtaojacobianroutine(Tao tao, Vec x, Mat H, Mat Hpre, void *ctx) 108 { 109 PetscObjectUseFortranCallback(tao,_cb.jac,(Tao*,Vec*,Mat*,Mat*,void*,PetscErrorCode*),(&tao,&x,&H,&Hpre,_ctx,&ierr)); 110 } 111 112 static PetscErrorCode ourtaojacobianstateroutine(Tao tao, Vec x, Mat H, Mat Hpre, Mat Hinv, void *ctx) 113 { 114 PetscObjectUseFortranCallback(tao,_cb.jacstate,(Tao*,Vec*,Mat*,Mat*,Mat*,void*,PetscErrorCode*),(&tao,&x,&H,&Hpre,&Hinv,_ctx,&ierr)); 115 } 116 117 static PetscErrorCode ourtaojacobiandesignroutine(Tao tao, Vec x, Mat H, void *ctx) 118 { 119 PetscObjectUseFortranCallback(tao,_cb.jacdesign,(Tao*,Vec*,Mat*,void*,PetscErrorCode*),(&tao,&x,&H,_ctx,&ierr)); 120 } 121 122 static PetscErrorCode ourtaoboundsroutine(Tao tao, Vec xl, Vec xu, void *ctx) 123 { 124 PetscObjectUseFortranCallback(tao,_cb.bounds,(Tao*,Vec*,Vec*,void*,PetscErrorCode*),(&tao,&xl,&xu,_ctx,&ierr)); 125 } 126 static PetscErrorCode ourtaoresidualroutine(Tao tao, Vec x, Vec f, void *ctx) 127 { 128 PetscObjectUseFortranCallback(tao,_cb.lsres,(Tao*,Vec*,Vec*,void*,PetscErrorCode*),(&tao,&x,&f,_ctx,&ierr)); 129 } 130 131 static PetscErrorCode ourtaojacobianresidualroutine(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx) 132 { 133 PetscObjectUseFortranCallback(tao,_cb.lsjac,(Tao*,Vec*,Mat*,Mat*,void*,PetscErrorCode*),(&tao,&x,&J,&Jpre,_ctx,&ierr)); 134 } 135 136 static PetscErrorCode ourtaomonitor(Tao tao, void *ctx) 137 { 138 PetscObjectUseFortranCallback(tao,_cb.mon,(Tao *,void*,PetscErrorCode*),(&tao,_ctx,&ierr)); 139 } 140 141 static PetscErrorCode ourtaomondestroy(void **ctx) 142 { 143 Tao tao = (Tao)*ctx; 144 PetscObjectUseFortranCallback(tao,_cb.mondestroy,(void*,PetscErrorCode*),(_ctx,&ierr)); 145 } 146 static PetscErrorCode ourtaoconvergencetest(Tao tao, void *ctx) 147 { 148 PetscObjectUseFortranCallback(tao,_cb.convtest,(Tao *,void*,PetscErrorCode*),(&tao,_ctx,&ierr)); 149 } 150 151 static PetscErrorCode ourtaoconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx) 152 { 153 PetscObjectUseFortranCallback(tao,_cb.constraints,(Tao*,Vec*,Vec*,void*,PetscErrorCode*),(&tao,&x,&c,_ctx,&ierr)); 154 } 155 156 static PetscErrorCode ourtaojacobianinequalityroutine(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx) 157 { 158 PetscObjectUseFortranCallback(tao,_cb.jacineq,(Tao*,Vec*,Mat*,Mat*,void*,PetscErrorCode*),(&tao,&x,&J,&Jpre,_ctx,&ierr)); 159 } 160 161 static PetscErrorCode ourtaojacobianequalityroutine(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx) 162 { 163 PetscObjectUseFortranCallback(tao,_cb.jaceq,(Tao*,Vec*,Mat*,Mat*,void*,PetscErrorCode*),(&tao,&x,&J,&Jpre,_ctx,&ierr)); 164 } 165 166 static PetscErrorCode ourtaoinequalityconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx) 167 { 168 PetscObjectUseFortranCallback(tao,_cb.conineq,(Tao*,Vec*,Vec*,void*,PetscErrorCode*),(&tao,&x,&c,_ctx,&ierr)); 169 } 170 171 static PetscErrorCode ourtaoequalityconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx) 172 { 173 PetscObjectUseFortranCallback(tao,_cb.coneq,(Tao*,Vec*,Vec*,void*,PetscErrorCode*),(&tao,&x,&c,_ctx,&ierr)); 174 } 175 176 static PetscErrorCode ourtaoupdateroutine(Tao tao, PetscInt iter, void *ctx) 177 { 178 PetscObjectUseFortranCallback(tao,_cb.update,(Tao*,PetscInt*,void*),(&tao,&iter,_ctx)); 179 } 180 181 EXTERN_C_BEGIN 182 183 PETSC_EXTERN void PETSC_STDCALL taosetobjectiveroutine_(Tao *tao, void (PETSC_STDCALL *func)(Tao*, Vec *, PetscReal *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 184 { 185 CHKFORTRANNULLFUNCTION(func); 186 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.obj,(PetscVoidFunction)func,ctx); 187 if(!*ierr) *ierr = TaoSetObjectiveRoutine(*tao,ourtaoobjectiveroutine,ctx); 188 } 189 190 PETSC_EXTERN void PETSC_STDCALL taosetgradientroutine_(Tao *tao, void (PETSC_STDCALL *func)(Tao*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 191 { 192 CHKFORTRANNULLFUNCTION(func); 193 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.grad,(PetscVoidFunction)func,ctx); 194 if(!*ierr) *ierr = TaoSetGradientRoutine(*tao,ourtaogradientroutine,ctx); 195 } 196 197 PETSC_EXTERN void PETSC_STDCALL taosetobjectiveandgradientroutine_(Tao *tao, void (PETSC_STDCALL *func)(Tao*, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 198 { 199 CHKFORTRANNULLFUNCTION(func); 200 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.objgrad,(PetscVoidFunction)func,ctx); 201 if(!*ierr) *ierr = TaoSetObjectiveAndGradientRoutine(*tao,ourtaoobjectiveandgradientroutine,ctx); 202 } 203 204 PETSC_EXTERN void PETSC_STDCALL taosetresidualroutine_(Tao *tao, Vec *F, void (PETSC_STDCALL *func)(Tao*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 205 { 206 CHKFORTRANNULLFUNCTION(func); 207 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.lsres,(PetscVoidFunction)func,ctx); 208 if(!*ierr) *ierr = TaoSetResidualRoutine(*tao,*F,ourtaoresidualroutine,ctx); 209 } 210 211 PETSC_EXTERN void PETSC_STDCALL taosetjacobianresidualroutine_(Tao *tao, Mat *J, Mat *Jpre, void (PETSC_STDCALL *func)(Tao*, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 212 { 213 CHKFORTRANNULLFUNCTION(func); 214 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.lsjac,(PetscVoidFunction)func,ctx); 215 if(!*ierr) *ierr = TaoSetJacobianResidualRoutine(*tao,*J,*Jpre,ourtaojacobianresidualroutine,ctx); 216 } 217 218 PETSC_EXTERN void PETSC_STDCALL taosetjacobianroutine_(Tao *tao, Mat *J, Mat *Jp, void (PETSC_STDCALL *func)(Tao*, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 219 { 220 CHKFORTRANNULLFUNCTION(func); 221 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jac,(PetscVoidFunction)func,ctx); 222 if(!*ierr) *ierr = TaoSetJacobianRoutine(*tao,*J,*Jp,ourtaojacobianroutine,ctx); 223 } 224 225 PETSC_EXTERN void PETSC_STDCALL taosetjacobianstateroutine_(Tao *tao, Mat *J, Mat *Jp, Mat*Jinv, void (PETSC_STDCALL *func)(Tao*, Vec *, Mat *, Mat *, Mat*, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 226 { 227 CHKFORTRANNULLFUNCTION(func); 228 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jacstate,(PetscVoidFunction)func,ctx); 229 if(!*ierr) *ierr = TaoSetJacobianStateRoutine(*tao,*J,*Jp,*Jinv,ourtaojacobianstateroutine,ctx); 230 } 231 232 PETSC_EXTERN void PETSC_STDCALL taosetjacobiandesignroutine_(Tao *tao, Mat *J, void (PETSC_STDCALL *func)(Tao*, Vec *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 233 { 234 CHKFORTRANNULLFUNCTION(func); 235 *ierr = PetscObjectSetFortranCallback((PetscObject)tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jacdesign,(PetscVoidFunction)func,ctx); 236 if(!*ierr) *ierr = TaoSetJacobianDesignRoutine(*tao,*J,ourtaojacobiandesignroutine,ctx); 237 } 238 239 PETSC_EXTERN void PETSC_STDCALL taosethessianroutine_(Tao *tao, Mat *J, Mat *Jp, void (PETSC_STDCALL *func)(Tao*, Vec *, Mat *, Mat *,void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 240 { 241 CHKFORTRANNULLFUNCTION(func); 242 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.hess,(PetscVoidFunction)func,ctx); 243 if(!*ierr) *ierr = TaoSetHessianRoutine(*tao,*J, *Jp, ourtaohessianroutine,ctx); 244 } 245 246 PETSC_EXTERN void PETSC_STDCALL taosetvariableboundsroutine_(Tao *tao, void (PETSC_STDCALL *func)(Tao*,Vec*,Vec*,void*,PetscErrorCode*),void *ctx, PetscErrorCode *ierr) 247 { 248 CHKFORTRANNULLFUNCTION(func); 249 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.bounds,(PetscVoidFunction)func,ctx); 250 if(!*ierr) *ierr = TaoSetVariableBoundsRoutine(*tao,ourtaoboundsroutine,ctx); 251 } 252 253 PETSC_EXTERN void PETSC_STDCALL taosetmonitor_(Tao *tao, void (PETSC_STDCALL *func)(Tao*,void*,PetscErrorCode*),void *ctx, void (PETSC_STDCALL *mondestroy)(void*,PetscErrorCode*),PetscErrorCode *ierr) 254 { 255 CHKFORTRANNULLFUNCTION(mondestroy); 256 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.mon,(PetscVoidFunction)func,ctx); if (*ierr) return; 257 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.mondestroy,(PetscVoidFunction)mondestroy,ctx); if (*ierr) return; 258 *ierr = TaoSetMonitor(*tao,ourtaomonitor,*tao,ourtaomondestroy); 259 } 260 261 PETSC_EXTERN void PETSC_STDCALL taosetconvergencetest_(Tao *tao, void (PETSC_STDCALL *func)(Tao*,void*,PetscErrorCode*),void *ctx, PetscErrorCode *ierr) 262 { 263 CHKFORTRANNULLFUNCTION(func); 264 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.convtest,(PetscVoidFunction)func,ctx); 265 if(!*ierr) *ierr = TaoSetConvergenceTest(*tao,ourtaoconvergencetest,ctx); 266 } 267 268 PETSC_EXTERN void PETSC_STDCALL taosetconstraintsroutine_(Tao *tao, Vec *C, void (PETSC_STDCALL *func)(Tao*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 269 { 270 CHKFORTRANNULLFUNCTION(func); 271 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.constraints,(PetscVoidFunction)func,ctx); 272 if(!*ierr) *ierr = TaoSetConstraintsRoutine(*tao,*C,ourtaoconstraintsroutine,ctx); 273 } 274 275 PETSC_EXTERN void PETSC_STDCALL taosettype_(Tao *tao, char* type_name PETSC_MIXED_LEN(len), PetscErrorCode *ierr PETSC_END_LEN(len)) 276 { 277 char *t; 278 279 FIXCHAR(type_name,len,t); 280 *ierr = TaoSetType(*tao,t);if (*ierr) return; 281 FREECHAR(type_name,t); 282 283 } 284 285 PETSC_EXTERN void PETSC_STDCALL taoview_(Tao *tao, PetscViewer *viewer, PetscErrorCode *ierr) 286 { 287 PetscViewer v; 288 PetscPatchDefaultViewers_Fortran(viewer,v); 289 *ierr = TaoView(*tao,v); 290 } 291 292 PETSC_EXTERN void PETSC_STDCALL taogetconvergencehistory_(Tao *tao, PetscInt *nhist, PetscErrorCode *ierr) 293 { 294 *ierr = TaoGetConvergenceHistory(*tao,NULL,NULL,NULL,NULL,nhist); 295 } 296 297 PETSC_EXTERN void PETSC_STDCALL taogetoptionsprefix_(Tao *tao, char* prefix PETSC_MIXED_LEN(len), PetscErrorCode *ierr PETSC_END_LEN(len)) 298 { 299 const char *name; 300 *ierr = TaoGetOptionsPrefix(*tao,&name); 301 *ierr = PetscStrncpy(prefix,name,len); if (*ierr) return; 302 FIXRETURNCHAR(PETSC_TRUE,prefix,len); 303 304 } 305 306 PETSC_EXTERN void PETSC_STDCALL taoappendoptionsprefix_(Tao *tao, char* prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 307 { 308 char *name; 309 FIXCHAR(prefix,len,name); 310 *ierr = TaoAppendOptionsPrefix(*tao,name);if (*ierr) return; 311 FREECHAR(prefix,name); 312 } 313 314 PETSC_EXTERN void PETSC_STDCALL taosetoptionsprefix_(Tao *tao, char* prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 315 { 316 char *t; 317 FIXCHAR(prefix,len,t); 318 *ierr = TaoSetOptionsPrefix(*tao,t);if (*ierr) return; 319 FREECHAR(prefix,t); 320 } 321 322 PETSC_EXTERN void PETSC_STDCALL taogettype_(Tao *tao, char* name PETSC_MIXED_LEN(len), PetscErrorCode *ierr PETSC_END_LEN(len)) 323 { 324 const char *tname; 325 *ierr = TaoGetType(*tao,&tname); 326 *ierr = PetscStrncpy(name,tname,len); if (*ierr) return; 327 FIXRETURNCHAR(PETSC_TRUE,name,len); 328 329 } 330 331 PETSC_EXTERN void PETSC_STDCALL taosetjacobianinequalityroutine_(Tao *tao, Mat *J, Mat *Jp, void (PETSC_STDCALL *func)(Tao*, Vec *, Mat *, Mat *,void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 332 { 333 CHKFORTRANNULLFUNCTION(func); 334 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jacineq,(PetscVoidFunction)func,ctx); 335 if(!*ierr) *ierr = TaoSetJacobianInequalityRoutine(*tao,*J,*Jp,ourtaojacobianinequalityroutine,ctx); 336 } 337 338 PETSC_EXTERN void PETSC_STDCALL taosetjacobianequalityroutine_(Tao *tao, Mat *J, Mat *Jp, void (PETSC_STDCALL *func)(Tao*, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 339 { 340 CHKFORTRANNULLFUNCTION(func); 341 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jaceq,(PetscVoidFunction)func,ctx); 342 if(!*ierr) *ierr = TaoSetJacobianEqualityRoutine(*tao,*J,*Jp,ourtaojacobianequalityroutine,ctx); 343 } 344 345 PETSC_EXTERN void PETSC_STDCALL taosetinequalityconstraintsroutine_(Tao *tao, Vec *C, void (PETSC_STDCALL *func)(Tao*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 346 { 347 CHKFORTRANNULLFUNCTION(func); 348 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.conineq,(PetscVoidFunction)func,ctx); 349 if(!*ierr) *ierr = TaoSetInequalityConstraintsRoutine(*tao,*C,ourtaoinequalityconstraintsroutine,ctx); 350 } 351 352 PETSC_EXTERN void PETSC_STDCALL taosetequalityconstraintsroutine_(Tao *tao, Vec *C, void (PETSC_STDCALL *func)(Tao*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 353 { 354 CHKFORTRANNULLFUNCTION(func); 355 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.coneq,(PetscVoidFunction)func,ctx); 356 if(!*ierr) *ierr = TaoSetEqualityConstraintsRoutine(*tao, *C, ourtaoequalityconstraintsroutine,ctx); 357 } 358 359 PETSC_EXTERN void PETSC_STDCALL taosetupdate_(Tao *tao, void (PETSC_STDCALL *func)(Tao *, PetscInt *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 360 { 361 CHKFORTRANNULLFUNCTION(func); 362 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.update,(PetscVoidFunction)func,ctx); 363 if(!*ierr) *ierr = TaoSetUpdate(*tao, ourtaoupdateroutine, ctx); 364 } 365 366 EXTERN_C_END 367 368 369