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 #define taodestroy_ TAODESTROY 34 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 35 36 #define taosetobjectiveroutine_ taosetobjectiveroutine 37 #define taosetgradientroutine_ taosetgradientroutine 38 #define taosetobjectiveandgradientroutine_ taosetobjectiveandgradientroutine 39 #define taosethessianroutine_ taosethessianroutine 40 #define taosetresidualroutine_ taosetresidualroutine 41 #define taosetjacobianresidualroutine_ taosetjacobianresidualroutine 42 #define taosetjacobianroutine_ taosetjacobianroutine 43 #define taosetjacobianstateroutine_ taosetjacobianstateroutine 44 #define taosetjacobiandesignroutine_ taosetjacobiandesignroutine 45 #define taosetjacobianinequalityroutine_ taosetjacobianinequalityroutine 46 #define taosetjacobianequalityroutine_ taosetjacobianequalityroutine 47 #define taosetinequalityconstraintsroutine_ taosetinequalityconstraintsroutine 48 #define taosetequalityconstraintsroutine_ taosetequalityconstraintsroutine 49 #define taosetvariableboundsroutine_ taosetvariableboundsroutine 50 #define taosetconstraintsroutine_ taosetconstraintsroutine 51 #define taosetmonitor_ taosetmonitor 52 #define taosettype_ taosettype 53 #define taoview_ taoview 54 #define taogetconvergencehistory_ taogetconvergencehistory 55 #define taosetconvergencetest_ taosetconvergencetest 56 #define taogetoptionsprefix_ taogetoptionsprefix 57 #define taosetoptionsprefix_ taosetoptionsprefix 58 #define taoappendoptionsprefix_ taoappendoptionsprefix 59 #define taogettype_ taogettype 60 #define taosetupdate_ taosetupdate 61 #define taoviewfromoptions_ taoviewfromoptions 62 #define taodestroy_ taodestroy 63 #endif 64 65 static struct { 66 PetscFortranCallbackId obj; 67 PetscFortranCallbackId grad; 68 PetscFortranCallbackId objgrad; 69 PetscFortranCallbackId hess; 70 PetscFortranCallbackId lsres; 71 PetscFortranCallbackId lsjac; 72 PetscFortranCallbackId jac; 73 PetscFortranCallbackId jacstate; 74 PetscFortranCallbackId jacdesign; 75 PetscFortranCallbackId bounds; 76 PetscFortranCallbackId mon; 77 PetscFortranCallbackId mondestroy; 78 PetscFortranCallbackId convtest; 79 PetscFortranCallbackId constraints; 80 PetscFortranCallbackId jacineq; 81 PetscFortranCallbackId jaceq; 82 PetscFortranCallbackId conineq; 83 PetscFortranCallbackId coneq; 84 PetscFortranCallbackId nfuncs; 85 PetscFortranCallbackId update; 86 #if defined(PETSC_HAVE_F90_2PTR_ARG) 87 PetscFortranCallbackId function_pgiptr; 88 #endif 89 } _cb; 90 91 static PetscErrorCode ourtaoobjectiveroutine(Tao tao, Vec x, PetscReal *f, void *ctx) 92 { 93 PetscObjectUseFortranCallback(tao,_cb.obj,(Tao*,Vec*,PetscReal*,void*,PetscErrorCode*),(&tao,&x,f,_ctx,&ierr)); 94 } 95 96 static PetscErrorCode ourtaogradientroutine(Tao tao, Vec x, Vec g, void *ctx) 97 { 98 PetscObjectUseFortranCallback(tao,_cb.grad,(Tao*,Vec*,Vec*,void*,PetscErrorCode*),(&tao,&x,&g,_ctx,&ierr)); 99 } 100 101 static PetscErrorCode ourtaoobjectiveandgradientroutine(Tao tao, Vec x, PetscReal *f, Vec g, void* ctx) 102 { 103 PetscObjectUseFortranCallback(tao,_cb.objgrad,(Tao*,Vec*,PetscReal*,Vec*,void*,PetscErrorCode*),(&tao,&x,f,&g,_ctx,&ierr)); 104 } 105 106 static PetscErrorCode ourtaohessianroutine(Tao tao, Vec x, Mat H, Mat Hpre, void *ctx) 107 { 108 PetscObjectUseFortranCallback(tao,_cb.hess,(Tao*,Vec*,Mat*,Mat*,void*,PetscErrorCode*),(&tao,&x,&H,&Hpre,_ctx,&ierr)); 109 } 110 111 static PetscErrorCode ourtaojacobianroutine(Tao tao, Vec x, Mat H, Mat Hpre, void *ctx) 112 { 113 PetscObjectUseFortranCallback(tao,_cb.jac,(Tao*,Vec*,Mat*,Mat*,void*,PetscErrorCode*),(&tao,&x,&H,&Hpre,_ctx,&ierr)); 114 } 115 116 static PetscErrorCode ourtaojacobianstateroutine(Tao tao, Vec x, Mat H, Mat Hpre, Mat Hinv, void *ctx) 117 { 118 PetscObjectUseFortranCallback(tao,_cb.jacstate,(Tao*,Vec*,Mat*,Mat*,Mat*,void*,PetscErrorCode*),(&tao,&x,&H,&Hpre,&Hinv,_ctx,&ierr)); 119 } 120 121 static PetscErrorCode ourtaojacobiandesignroutine(Tao tao, Vec x, Mat H, void *ctx) 122 { 123 PetscObjectUseFortranCallback(tao,_cb.jacdesign,(Tao*,Vec*,Mat*,void*,PetscErrorCode*),(&tao,&x,&H,_ctx,&ierr)); 124 } 125 126 static PetscErrorCode ourtaoboundsroutine(Tao tao, Vec xl, Vec xu, void *ctx) 127 { 128 PetscObjectUseFortranCallback(tao,_cb.bounds,(Tao*,Vec*,Vec*,void*,PetscErrorCode*),(&tao,&xl,&xu,_ctx,&ierr)); 129 } 130 static PetscErrorCode ourtaoresidualroutine(Tao tao, Vec x, Vec f, void *ctx) 131 { 132 PetscObjectUseFortranCallback(tao,_cb.lsres,(Tao*,Vec*,Vec*,void*,PetscErrorCode*),(&tao,&x,&f,_ctx,&ierr)); 133 } 134 135 static PetscErrorCode ourtaojacobianresidualroutine(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx) 136 { 137 PetscObjectUseFortranCallback(tao,_cb.lsjac,(Tao*,Vec*,Mat*,Mat*,void*,PetscErrorCode*),(&tao,&x,&J,&Jpre,_ctx,&ierr)); 138 } 139 140 static PetscErrorCode ourtaomonitor(Tao tao, void *ctx) 141 { 142 PetscObjectUseFortranCallback(tao,_cb.mon,(Tao *,void*,PetscErrorCode*),(&tao,_ctx,&ierr)); 143 } 144 145 static PetscErrorCode ourtaomondestroy(void **ctx) 146 { 147 Tao tao = (Tao)*ctx; 148 PetscObjectUseFortranCallback(tao,_cb.mondestroy,(void*,PetscErrorCode*),(_ctx,&ierr)); 149 } 150 static PetscErrorCode ourtaoconvergencetest(Tao tao, void *ctx) 151 { 152 PetscObjectUseFortranCallback(tao,_cb.convtest,(Tao *,void*,PetscErrorCode*),(&tao,_ctx,&ierr)); 153 } 154 155 static PetscErrorCode ourtaoconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx) 156 { 157 PetscObjectUseFortranCallback(tao,_cb.constraints,(Tao*,Vec*,Vec*,void*,PetscErrorCode*),(&tao,&x,&c,_ctx,&ierr)); 158 } 159 160 static PetscErrorCode ourtaojacobianinequalityroutine(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx) 161 { 162 PetscObjectUseFortranCallback(tao,_cb.jacineq,(Tao*,Vec*,Mat*,Mat*,void*,PetscErrorCode*),(&tao,&x,&J,&Jpre,_ctx,&ierr)); 163 } 164 165 static PetscErrorCode ourtaojacobianequalityroutine(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx) 166 { 167 PetscObjectUseFortranCallback(tao,_cb.jaceq,(Tao*,Vec*,Mat*,Mat*,void*,PetscErrorCode*),(&tao,&x,&J,&Jpre,_ctx,&ierr)); 168 } 169 170 static PetscErrorCode ourtaoinequalityconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx) 171 { 172 PetscObjectUseFortranCallback(tao,_cb.conineq,(Tao*,Vec*,Vec*,void*,PetscErrorCode*),(&tao,&x,&c,_ctx,&ierr)); 173 } 174 175 static PetscErrorCode ourtaoequalityconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx) 176 { 177 PetscObjectUseFortranCallback(tao,_cb.coneq,(Tao*,Vec*,Vec*,void*,PetscErrorCode*),(&tao,&x,&c,_ctx,&ierr)); 178 } 179 180 static PetscErrorCode ourtaoupdateroutine(Tao tao, PetscInt iter, void *ctx) 181 { 182 PetscObjectUseFortranCallback(tao,_cb.update,(Tao*,PetscInt*,void*),(&tao,&iter,_ctx)); 183 } 184 185 EXTERN_C_BEGIN 186 187 PETSC_EXTERN void taosetobjectiveroutine_(Tao *tao, void (*func)(Tao*, Vec *, PetscReal *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 188 { 189 CHKFORTRANNULLFUNCTION(func); 190 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.obj,(PetscVoidFunction)func,ctx); 191 if (!*ierr) *ierr = TaoSetObjectiveRoutine(*tao,ourtaoobjectiveroutine,ctx); 192 } 193 194 PETSC_EXTERN void taosetgradientroutine_(Tao *tao, 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.grad,(PetscVoidFunction)func,ctx); 198 if (!*ierr) *ierr = TaoSetGradientRoutine(*tao,ourtaogradientroutine,ctx); 199 } 200 201 PETSC_EXTERN void taosetobjectiveandgradientroutine_(Tao *tao, void (*func)(Tao*, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 202 { 203 CHKFORTRANNULLFUNCTION(func); 204 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.objgrad,(PetscVoidFunction)func,ctx); 205 if (!*ierr) *ierr = TaoSetObjectiveAndGradientRoutine(*tao,ourtaoobjectiveandgradientroutine,ctx); 206 } 207 208 PETSC_EXTERN void taosetresidualroutine_(Tao *tao, Vec *F, void (*func)(Tao*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 209 { 210 CHKFORTRANNULLFUNCTION(func); 211 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.lsres,(PetscVoidFunction)func,ctx); 212 if (!*ierr) *ierr = TaoSetResidualRoutine(*tao,*F,ourtaoresidualroutine,ctx); 213 } 214 215 PETSC_EXTERN void taosetjacobianresidualroutine_(Tao *tao, Mat *J, Mat *Jpre, void (*func)(Tao*, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 216 { 217 CHKFORTRANNULLFUNCTION(func); 218 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.lsjac,(PetscVoidFunction)func,ctx); 219 if (!*ierr) *ierr = TaoSetJacobianResidualRoutine(*tao,*J,*Jpre,ourtaojacobianresidualroutine,ctx); 220 } 221 222 PETSC_EXTERN void taosetjacobianroutine_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao*, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 223 { 224 CHKFORTRANNULLFUNCTION(func); 225 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jac,(PetscVoidFunction)func,ctx); 226 if (!*ierr) *ierr = TaoSetJacobianRoutine(*tao,*J,*Jp,ourtaojacobianroutine,ctx); 227 } 228 229 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) 230 { 231 CHKFORTRANNULLFUNCTION(func); 232 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jacstate,(PetscVoidFunction)func,ctx); 233 if (!*ierr) *ierr = TaoSetJacobianStateRoutine(*tao,*J,*Jp,*Jinv,ourtaojacobianstateroutine,ctx); 234 } 235 236 PETSC_EXTERN void taosetjacobiandesignroutine_(Tao *tao, Mat *J, void (*func)(Tao*, Vec *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 237 { 238 CHKFORTRANNULLFUNCTION(func); 239 *ierr = PetscObjectSetFortranCallback((PetscObject)tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jacdesign,(PetscVoidFunction)func,ctx); 240 if (!*ierr) *ierr = TaoSetJacobianDesignRoutine(*tao,*J,ourtaojacobiandesignroutine,ctx); 241 } 242 243 PETSC_EXTERN void taosethessianroutine_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao*, Vec *, Mat *, Mat *,void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 244 { 245 CHKFORTRANNULLFUNCTION(func); 246 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.hess,(PetscVoidFunction)func,ctx); 247 if (!*ierr) *ierr = TaoSetHessianRoutine(*tao,*J, *Jp, ourtaohessianroutine,ctx); 248 } 249 250 PETSC_EXTERN void taosetvariableboundsroutine_(Tao *tao, void (*func)(Tao*,Vec*,Vec*,void*,PetscErrorCode*),void *ctx, PetscErrorCode *ierr) 251 { 252 CHKFORTRANNULLFUNCTION(func); 253 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.bounds,(PetscVoidFunction)func,ctx); 254 if (!*ierr) *ierr = TaoSetVariableBoundsRoutine(*tao,ourtaoboundsroutine,ctx); 255 } 256 257 PETSC_EXTERN void taosetmonitor_(Tao *tao, void (*func)(Tao*,void*,PetscErrorCode*),void *ctx, void (*mondestroy)(void*,PetscErrorCode*),PetscErrorCode *ierr) 258 { 259 CHKFORTRANNULLFUNCTION(mondestroy); 260 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.mon,(PetscVoidFunction)func,ctx); if (*ierr) return; 261 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.mondestroy,(PetscVoidFunction)mondestroy,ctx); 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);if (*ierr) return; 285 FREECHAR(type_name,t); 286 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); if (*ierr) return; 306 FIXRETURNCHAR(PETSC_TRUE,prefix,len); 307 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);if (*ierr) return; 315 FREECHAR(prefix,name); 316 } 317 318 PETSC_EXTERN void taosetoptionsprefix_(Tao *tao, char* prefix,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 319 { 320 char *t; 321 FIXCHAR(prefix,len,t); 322 *ierr = TaoSetOptionsPrefix(*tao,t);if (*ierr) return; 323 FREECHAR(prefix,t); 324 } 325 326 PETSC_EXTERN void taogettype_(Tao *tao, char* name, PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 327 { 328 const char *tname; 329 *ierr = TaoGetType(*tao,&tname); 330 *ierr = PetscStrncpy(name,tname,len); if (*ierr) return; 331 FIXRETURNCHAR(PETSC_TRUE,name,len); 332 333 } 334 335 PETSC_EXTERN void taosetjacobianinequalityroutine_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao*, Vec *, Mat *, Mat *,void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 336 { 337 CHKFORTRANNULLFUNCTION(func); 338 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jacineq,(PetscVoidFunction)func,ctx); 339 if (!*ierr) *ierr = TaoSetJacobianInequalityRoutine(*tao,*J,*Jp,ourtaojacobianinequalityroutine,ctx); 340 } 341 342 PETSC_EXTERN void taosetjacobianequalityroutine_(Tao *tao, Mat *J, Mat *Jp, void (*func)(Tao*, Vec *, Mat *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 343 { 344 CHKFORTRANNULLFUNCTION(func); 345 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.jaceq,(PetscVoidFunction)func,ctx); 346 if (!*ierr) *ierr = TaoSetJacobianEqualityRoutine(*tao,*J,*Jp,ourtaojacobianequalityroutine,ctx); 347 } 348 349 PETSC_EXTERN void taosetinequalityconstraintsroutine_(Tao *tao, Vec *C, void (*func)(Tao*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 350 { 351 CHKFORTRANNULLFUNCTION(func); 352 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.conineq,(PetscVoidFunction)func,ctx); 353 if (!*ierr) *ierr = TaoSetInequalityConstraintsRoutine(*tao,*C,ourtaoinequalityconstraintsroutine,ctx); 354 } 355 356 PETSC_EXTERN void taosetequalityconstraintsroutine_(Tao *tao, Vec *C, void (*func)(Tao*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 357 { 358 CHKFORTRANNULLFUNCTION(func); 359 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.coneq,(PetscVoidFunction)func,ctx); 360 if (!*ierr) *ierr = TaoSetEqualityConstraintsRoutine(*tao, *C, ourtaoequalityconstraintsroutine,ctx); 361 } 362 363 PETSC_EXTERN void taosetupdate_(Tao *tao, void (*func)(Tao *, PetscInt *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 364 { 365 CHKFORTRANNULLFUNCTION(func); 366 *ierr = PetscObjectSetFortranCallback((PetscObject)*tao,PETSC_FORTRAN_CALLBACK_CLASS,&_cb.update,(PetscVoidFunction)func,ctx); 367 if (!*ierr) *ierr = TaoSetUpdate(*tao, ourtaoupdateroutine, ctx); 368 } 369 370 PETSC_EXTERN void taoviewfromoptions_(Tao *ao,PetscObject obj,char* type,PetscErrorCode *ierr,PETSC_FORTRAN_CHARLEN_T len) 371 { 372 char *t; 373 374 FIXCHAR(type,len,t); 375 CHKFORTRANNULLOBJECT(obj); 376 *ierr = TaoViewFromOptions(*ao,obj,t);if (*ierr) return; 377 FREECHAR(type,t); 378 } 379 380 PETSC_EXTERN void taodestroy_(Tao *x,int *ierr) 381 { 382 PETSC_FORTRAN_OBJECT_F_DESTROYED_TO_C_NULL(x); 383 *ierr = TaoDestroy(x); if (*ierr) return; 384 PETSC_FORTRAN_OBJECT_C_NULL_TO_F_DESTROYED(x); 385 } 386 387 EXTERN_C_END 388 389 390