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