1*aaa7dc30SBarry Smith #include <petsc-private/fortranimpl.h> 2*aaa7dc30SBarry Smith #include <petsc-private/taosolverimpl.h> 3a7e14dcfSSatish Balay 4a7e14dcfSSatish Balay 5a7e14dcfSSatish Balay #if defined(PETSC_HAVE_FORTRAN_CAPS) 6a7e14dcfSSatish Balay #define taosetobjectiveroutine_ TAOSETOBJECTIVEROUTINE 7a7e14dcfSSatish Balay #define taosetgradientroutine_ TAOSETGRADIENTROUTINE 8a7e14dcfSSatish Balay #define taosetobjectiveandgradientroutine_ TAOSETOBJECTIVEANDGRADIENTROUTINE 9a7e14dcfSSatish Balay #define taosethessianroutine_ TAOSETHESSIANROUTINE 10a7e14dcfSSatish Balay #define taosetseparableobjectiveroutine_ TAOSETSEPARABLEOBJECTIVEROUTINE 11a7e14dcfSSatish Balay #define taosetjacobianroutine_ TAOSETJACOBIANROUTINE 12a7e14dcfSSatish Balay #define taosetjacobianstateroutine_ TAOSETJACOBIANSTATEROUTINE 13a7e14dcfSSatish Balay #define taosetjacobiandesignroutine_ TAOSETJACOBIANDESIGNROUTINE 14a7e14dcfSSatish Balay #define taosetjacobianinequalityroutine_ TAOSETJACOBIANINEQUALITYROUTINE 15a7e14dcfSSatish Balay #define taosetjacobianequalityroutine_ TAOSETJACOBIANEQUALITYROUTINE 16a7e14dcfSSatish Balay #define taosetinequalityconstraintsroutine_ TAOSETINEQUALITYCONSTRAINTSROUTINE 17a7e14dcfSSatish Balay #define taosetequalityconstraintsroutine_ TAOSETEQUALITYCONSTRAINTSROUTINE 18a7e14dcfSSatish Balay #define taosetvariableboundsroutine_ TAOSETVARIABLEBOUNDSROUTINE 19a7e14dcfSSatish Balay #define taosetconstraintsroutine_ TAOSETCONSTRAINTSROUTINE 20a7e14dcfSSatish Balay #define taosetmonitor_ TAOSETMONITOR 21a7e14dcfSSatish Balay #define taosettype_ TAOSETTYPE 22a7e14dcfSSatish Balay #define taoview_ TAOVIEW 23a7e14dcfSSatish Balay #define taogethistory_ TAOGETHISTORY 24a7e14dcfSSatish Balay #define taosetconvergencetest_ TAOSETCONVERGENCETEST 25a7e14dcfSSatish Balay #define taogetoptionsprefix_ TAOGETOPTIONSPREFIX 26a7e14dcfSSatish Balay #define taosetoptionsprefix_ TAOSETOPTIONSPREFIX 27a7e14dcfSSatish Balay #define taoappendoptionsprefix_ TAOAPPENDOPTIONSPREFIX 28a7e14dcfSSatish Balay #define taogettype_ TAOGETTYPE 29a7e14dcfSSatish Balay #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) 30a7e14dcfSSatish Balay 31a7e14dcfSSatish Balay #define taosetobjectiveroutine_ taosetobjectiveroutine 32a7e14dcfSSatish Balay #define taosetgradientroutine_ taosetgradientroutine 33a7e14dcfSSatish Balay #define taosetobjectiveandgradientroutine_ taosetobjectiveandgradientroutine 34a7e14dcfSSatish Balay #define taosethessianroutine_ taosethessianroutine 35a7e14dcfSSatish Balay #define taosetseparableobjectiveroutine_ taosetseparableobjectiveroutine 36a7e14dcfSSatish Balay #define taosetjacobianroutine_ taosetjacobianroutine 37a7e14dcfSSatish Balay #define taosetjacobianstateroutine_ taosetjacobianstateroutine 38a7e14dcfSSatish Balay #define taosetjacobiandesignroutine_ taosetjacobiandesignroutine 39a7e14dcfSSatish Balay #define taosetjacobianinequalityroutine_ taosetjacobianinequalityroutine 40a7e14dcfSSatish Balay #define taosetjacobianequalityroutine_ taosetjacobianequalityroutine 41a7e14dcfSSatish Balay #define taosetinequalityconstraintsroutine_ taosetinequalityconstraintsroutine 42a7e14dcfSSatish Balay #define taosetequalityconstraintsroutine_ taosetequalityconstraintsroutine 43a7e14dcfSSatish Balay #define taosetvariableboundsroutine_ taosetvariableboundsroutine 44a7e14dcfSSatish Balay #define taosetconstraintsroutine_ taosetconstraintsroutine 45a7e14dcfSSatish Balay #define taosetmonitor_ taosetmonitor 46a7e14dcfSSatish Balay #define taosettype_ taosettype 47a7e14dcfSSatish Balay #define taoview_ taoview 48a7e14dcfSSatish Balay #define taogethistory_ taogethistory 49a7e14dcfSSatish Balay #define taosetconvergencetest_ taosetconvergencetest 50a7e14dcfSSatish Balay #define taogetoptionsprefix_ taogetoptionsprefix 51a7e14dcfSSatish Balay #define taosetoptionsprefix_ taosetoptionsprefix 52a7e14dcfSSatish Balay #define taoappendoptionsprefix_ taoappendoptionsprefix 53a7e14dcfSSatish Balay #define taogettype_ taogettype 54a7e14dcfSSatish Balay #endif 55a7e14dcfSSatish Balay 56a7e14dcfSSatish Balay static int OBJ=0; /* objective routine index */ 57a7e14dcfSSatish Balay static int GRAD=1; /* gradient routine index */ 58a7e14dcfSSatish Balay static int OBJGRAD=2; /* objective and gradient routine */ 59a7e14dcfSSatish Balay static int HESS=3; /* hessian routine index */ 60a7e14dcfSSatish Balay static int SEPOBJ=4; /* separable objective routine index */ 61a7e14dcfSSatish Balay static int JAC=5; /* jacobian routine index */ 62a7e14dcfSSatish Balay static int JACSTATE=6; /* jacobian state routine index */ 63a7e14dcfSSatish Balay static int JACDESIGN=7; /* jacobian design routine index */ 64a7e14dcfSSatish Balay static int BOUNDS=8; 65a7e14dcfSSatish Balay static int MON=9; /* monitor routine index */ 66a7e14dcfSSatish Balay static int MONCTX=10; /* monitor routine index */ 67a7e14dcfSSatish Balay static int MONDESTROY=11; /* monitor destroy index */ 68a7e14dcfSSatish Balay static int CONVTEST=12; /* */ 69a7e14dcfSSatish Balay static int CONSTRAINTS=13; 70a7e14dcfSSatish Balay static int JACINEQ=14; 71a7e14dcfSSatish Balay static int JACEQ=15; 72a7e14dcfSSatish Balay static int CONINEQ=16; 73a7e14dcfSSatish Balay static int CONEQ=17; 74a7e14dcfSSatish Balay static int NFUNCS=18; 75a7e14dcfSSatish Balay 76a7e14dcfSSatish Balay static PetscErrorCode ourtaoobjectiveroutine(TaoSolver tao, Vec x, PetscReal *f, void *ctx) 77a7e14dcfSSatish Balay { 78a7e14dcfSSatish Balay PetscErrorCode ierr = 0; 79a7e14dcfSSatish Balay (*(void (PETSC_STDCALL *)(TaoSolver*,Vec*,PetscReal*,void*,PetscErrorCode*)) 80a7e14dcfSSatish Balay (((PetscObject)tao)->fortran_func_pointers[OBJ]))(&tao,&x,f,ctx,&ierr); 81a7e14dcfSSatish Balay CHKERRQ(ierr); 82a7e14dcfSSatish Balay return 0; 83a7e14dcfSSatish Balay } 84a7e14dcfSSatish Balay 85a7e14dcfSSatish Balay static PetscErrorCode ourtaogradientroutine(TaoSolver tao, Vec x, Vec g, void *ctx) 86a7e14dcfSSatish Balay { 87a7e14dcfSSatish Balay PetscErrorCode ierr = 0; 88a7e14dcfSSatish Balay (*(void (PETSC_STDCALL *)(TaoSolver*,Vec*,Vec*,void*,PetscErrorCode*)) 89a7e14dcfSSatish Balay (((PetscObject)tao)->fortran_func_pointers[GRAD]))(&tao,&x,&g,ctx,&ierr); 90a7e14dcfSSatish Balay CHKERRQ(ierr); 91a7e14dcfSSatish Balay return 0; 92a7e14dcfSSatish Balay 93a7e14dcfSSatish Balay } 94a7e14dcfSSatish Balay 95a7e14dcfSSatish Balay static PetscErrorCode ourtaoobjectiveandgradientroutine(TaoSolver tao, Vec x, PetscReal *f, Vec g, void* ctx) 96a7e14dcfSSatish Balay { 97a7e14dcfSSatish Balay PetscErrorCode ierr = 0; 98a7e14dcfSSatish Balay (*(void (PETSC_STDCALL *)(TaoSolver*,Vec*,PetscReal*,Vec*,void*,PetscErrorCode*)) 99a7e14dcfSSatish Balay (((PetscObject)tao)->fortran_func_pointers[OBJGRAD]))(&tao,&x,f,&g,ctx,&ierr); 100a7e14dcfSSatish Balay CHKERRQ(ierr); 101a7e14dcfSSatish Balay return 0; 102a7e14dcfSSatish Balay } 103a7e14dcfSSatish Balay 104a7e14dcfSSatish Balay static PetscErrorCode ourtaohessianroutine(TaoSolver tao, Vec x, Mat *H, Mat *Hpre, MatStructure *type, void *ctx) 105a7e14dcfSSatish Balay { 106a7e14dcfSSatish Balay PetscErrorCode ierr = 0; 107a7e14dcfSSatish Balay (*(void (PETSC_STDCALL *)(TaoSolver*,Vec*,Mat*,Mat*,MatStructure*,void*,PetscErrorCode*)) 108a7e14dcfSSatish Balay (((PetscObject)tao)->fortran_func_pointers[HESS]))(&tao,&x,H,Hpre,type,ctx,&ierr); CHKERRQ(ierr); 109a7e14dcfSSatish Balay return 0; 110a7e14dcfSSatish Balay } 111a7e14dcfSSatish Balay 112a7e14dcfSSatish Balay static PetscErrorCode ourtaojacobianroutine(TaoSolver tao, Vec x, Mat *H, Mat *Hpre, MatStructure *type, void *ctx) 113a7e14dcfSSatish Balay { 114a7e14dcfSSatish Balay PetscErrorCode ierr = 0; 115a7e14dcfSSatish Balay (*(void (PETSC_STDCALL *)(TaoSolver*,Vec*,Mat*,Mat*,MatStructure*,void*,PetscErrorCode*)) 116a7e14dcfSSatish Balay (((PetscObject)tao)->fortran_func_pointers[JAC]))(&tao,&x,H,Hpre,type,ctx,&ierr); CHKERRQ(ierr); 117a7e14dcfSSatish Balay return 0; 118a7e14dcfSSatish Balay } 119a7e14dcfSSatish Balay 120a7e14dcfSSatish Balay static PetscErrorCode ourtaojacobianstateroutine(TaoSolver tao, Vec x, Mat *H, Mat *Hpre, Mat *Hinv, MatStructure *type, void *ctx) 121a7e14dcfSSatish Balay { 122a7e14dcfSSatish Balay PetscErrorCode ierr = 0; 123a7e14dcfSSatish Balay (*(void (PETSC_STDCALL *)(TaoSolver*,Vec*,Mat*,Mat*,Mat*,MatStructure*,void*,PetscErrorCode*)) 124a7e14dcfSSatish Balay (((PetscObject)tao)->fortran_func_pointers[JACSTATE]))(&tao,&x,H,Hpre,Hinv,type,ctx,&ierr); CHKERRQ(ierr); 125a7e14dcfSSatish Balay return 0; 126a7e14dcfSSatish Balay } 127a7e14dcfSSatish Balay 128a7e14dcfSSatish Balay static PetscErrorCode ourtaojacobiandesignroutine(TaoSolver tao, Vec x, Mat *H, void *ctx) 129a7e14dcfSSatish Balay { 130a7e14dcfSSatish Balay PetscErrorCode ierr = 0; 131a7e14dcfSSatish Balay (*(void (PETSC_STDCALL *)(TaoSolver*,Vec*,Mat*,void*,PetscErrorCode*)) 132a7e14dcfSSatish Balay (((PetscObject)tao)->fortran_func_pointers[JACDESIGN]))(&tao,&x,H,ctx,&ierr); CHKERRQ(ierr); 133a7e14dcfSSatish Balay return 0; 134a7e14dcfSSatish Balay } 135a7e14dcfSSatish Balay 136a7e14dcfSSatish Balay static PetscErrorCode ourtaoboundsroutine(TaoSolver tao, Vec xl, Vec xu, void *ctx) 137a7e14dcfSSatish Balay { 138a7e14dcfSSatish Balay PetscErrorCode ierr = 0; 139a7e14dcfSSatish Balay (*(void (PETSC_STDCALL *)(TaoSolver*,Vec*,Vec*,void*,PetscErrorCode*)) 140a7e14dcfSSatish Balay (((PetscObject)tao)->fortran_func_pointers[BOUNDS]))(&tao,&xl,&xu,ctx,&ierr); CHKERRQ(ierr); 141a7e14dcfSSatish Balay return 0; 142a7e14dcfSSatish Balay } 143a7e14dcfSSatish Balay static PetscErrorCode ourtaoseparableobjectiveroutine(TaoSolver tao, Vec x, Vec f, void *ctx) 144a7e14dcfSSatish Balay { 145a7e14dcfSSatish Balay PetscErrorCode ierr = 0; 146a7e14dcfSSatish Balay (*(void (PETSC_STDCALL *)(TaoSolver*,Vec*,Vec*,void*,PetscErrorCode*)) 147a7e14dcfSSatish Balay (((PetscObject)tao)->fortran_func_pointers[SEPOBJ]))(&tao,&x,&f,ctx,&ierr); 148a7e14dcfSSatish Balay return 0; 149a7e14dcfSSatish Balay } 150a7e14dcfSSatish Balay 151a7e14dcfSSatish Balay static PetscErrorCode ourtaomonitor(TaoSolver tao, void *ctx) 152a7e14dcfSSatish Balay { 153a7e14dcfSSatish Balay PetscErrorCode ierr = 0; 154a7e14dcfSSatish Balay (*(void (PETSC_STDCALL *)(TaoSolver *, void*, PetscErrorCode*)) 155a7e14dcfSSatish Balay (((PetscObject)tao)->fortran_func_pointers[MON]))(&tao,ctx,&ierr); 156a7e14dcfSSatish Balay CHKERRQ(ierr); 157a7e14dcfSSatish Balay return 0; 158a7e14dcfSSatish Balay } 159a7e14dcfSSatish Balay 160a7e14dcfSSatish Balay static PetscErrorCode ourtaomondestroy(void **ctx) 161a7e14dcfSSatish Balay { 162a7e14dcfSSatish Balay PetscErrorCode ierr = 0; 163a7e14dcfSSatish Balay TaoSolver tao = *(TaoSolver*)ctx; 1648e3154b5SSatish Balay (*(void (PETSC_STDCALL *)(void*,PetscErrorCode*))(((PetscObject)tao)->fortran_func_pointers[MONDESTROY])) 1651176053aSJason Sarich ((void*)(PETSC_UINTPTR_T)((PetscObject)tao)->fortran_func_pointers[MONCTX],&ierr); 1668e3154b5SSatish Balay CHKERRQ(ierr); 167a7e14dcfSSatish Balay return 0; 168a7e14dcfSSatish Balay } 169a7e14dcfSSatish Balay static PetscErrorCode ourtaoconvergencetest(TaoSolver tao, void *ctx) 170a7e14dcfSSatish Balay { 171a7e14dcfSSatish Balay PetscErrorCode ierr = 0; 172a7e14dcfSSatish Balay (*(void (PETSC_STDCALL *)(TaoSolver *, void*, PetscErrorCode*)) 173a7e14dcfSSatish Balay (((PetscObject)tao)->fortran_func_pointers[CONVTEST]))(&tao,ctx,&ierr); 174a7e14dcfSSatish Balay CHKERRQ(ierr); 175a7e14dcfSSatish Balay return 0; 176a7e14dcfSSatish Balay } 177a7e14dcfSSatish Balay 178a7e14dcfSSatish Balay 179a7e14dcfSSatish Balay static PetscErrorCode ourtaoconstraintsroutine(TaoSolver tao, Vec x, Vec c, void *ctx) 180a7e14dcfSSatish Balay { 181a7e14dcfSSatish Balay PetscErrorCode ierr = 0; 182a7e14dcfSSatish Balay (*(void (PETSC_STDCALL *)(TaoSolver*,Vec*,Vec*,void*,PetscErrorCode*)) 183a7e14dcfSSatish Balay (((PetscObject)tao)->fortran_func_pointers[CONSTRAINTS]))(&tao,&x,&c,ctx,&ierr); 184a7e14dcfSSatish Balay CHKERRQ(ierr); 185a7e14dcfSSatish Balay return 0; 186a7e14dcfSSatish Balay 187a7e14dcfSSatish Balay } 188a7e14dcfSSatish Balay 189a7e14dcfSSatish Balay static PetscErrorCode ourtaojacobianinequalityroutine(TaoSolver tao, Vec x, Mat *J, Mat *Jpre, MatStructure *type, void *ctx) 190a7e14dcfSSatish Balay { 191a7e14dcfSSatish Balay PetscErrorCode ierr = 0; 192a7e14dcfSSatish Balay (*(void (PETSC_STDCALL *)(TaoSolver*,Vec*,Mat*,Mat*,MatStructure*,void*,PetscErrorCode*)) 193a7e14dcfSSatish Balay (((PetscObject)tao)->fortran_func_pointers[JACINEQ]))(&tao,&x,J,Jpre,type,ctx,&ierr); CHKERRQ(ierr); 194a7e14dcfSSatish Balay return 0; 195a7e14dcfSSatish Balay } 196a7e14dcfSSatish Balay 197a7e14dcfSSatish Balay static PetscErrorCode ourtaojacobianequalityroutine(TaoSolver tao, Vec x, Mat *J, Mat *Jpre, MatStructure *type, void *ctx) 198a7e14dcfSSatish Balay { 199a7e14dcfSSatish Balay PetscErrorCode ierr = 0; 200a7e14dcfSSatish Balay (*(void (PETSC_STDCALL *)(TaoSolver*,Vec*,Mat*,Mat*,MatStructure*,void*,PetscErrorCode*)) 201a7e14dcfSSatish Balay (((PetscObject)tao)->fortran_func_pointers[JACEQ]))(&tao,&x,J,Jpre,type,ctx,&ierr); CHKERRQ(ierr); 202a7e14dcfSSatish Balay return 0; 203a7e14dcfSSatish Balay } 204a7e14dcfSSatish Balay 205a7e14dcfSSatish Balay static PetscErrorCode ourtaoinequalityconstraintsroutine(TaoSolver tao, Vec x, Vec c, void *ctx) 206a7e14dcfSSatish Balay { 207a7e14dcfSSatish Balay PetscErrorCode ierr = 0; 208a7e14dcfSSatish Balay (*(void (PETSC_STDCALL *)(TaoSolver*,Vec*,Vec*,void*,PetscErrorCode*)) 209a7e14dcfSSatish Balay (((PetscObject)tao)->fortran_func_pointers[CONINEQ]))(&tao,&x,&c,ctx,&ierr); 210a7e14dcfSSatish Balay CHKERRQ(ierr); 211a7e14dcfSSatish Balay return 0; 212a7e14dcfSSatish Balay 213a7e14dcfSSatish Balay } 214a7e14dcfSSatish Balay 215a7e14dcfSSatish Balay static PetscErrorCode ourtaoequalityconstraintsroutine(TaoSolver tao, Vec x, Vec c, void *ctx) 216a7e14dcfSSatish Balay { 217a7e14dcfSSatish Balay PetscErrorCode ierr = 0; 218a7e14dcfSSatish Balay (*(void (PETSC_STDCALL *)(TaoSolver*,Vec*,Vec*,void*,PetscErrorCode*)) 219a7e14dcfSSatish Balay (((PetscObject)tao)->fortran_func_pointers[CONEQ]))(&tao,&x,&c,ctx,&ierr); 220a7e14dcfSSatish Balay CHKERRQ(ierr); 221a7e14dcfSSatish Balay return 0; 222a7e14dcfSSatish Balay 223a7e14dcfSSatish Balay } 224a7e14dcfSSatish Balay 225a7e14dcfSSatish Balay 226a7e14dcfSSatish Balay EXTERN_C_BEGIN 227a7e14dcfSSatish Balay 228a7e14dcfSSatish Balay 229a7e14dcfSSatish Balay void PETSC_STDCALL taosetobjectiveroutine_(TaoSolver *tao, void (PETSC_STDCALL *func)(TaoSolver*, Vec *, PetscReal *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 230a7e14dcfSSatish Balay { 231a7e14dcfSSatish Balay CHKFORTRANNULLOBJECT(ctx); 232a7e14dcfSSatish Balay PetscObjectAllocateFortranPointers(*tao,NFUNCS); 233a7e14dcfSSatish Balay if (!func) { 234a7e14dcfSSatish Balay *ierr = TaoSetObjectiveRoutine(*tao,0,ctx); 235a7e14dcfSSatish Balay } else { 236a7e14dcfSSatish Balay ((PetscObject)*tao)->fortran_func_pointers[OBJ] = (PetscVoidFunction)func; 237a7e14dcfSSatish Balay *ierr = TaoSetObjectiveRoutine(*tao, ourtaoobjectiveroutine,ctx); 238a7e14dcfSSatish Balay } 239a7e14dcfSSatish Balay } 240a7e14dcfSSatish Balay 241a7e14dcfSSatish Balay void PETSC_STDCALL taosetgradientroutine_(TaoSolver *tao, void (PETSC_STDCALL *func)(TaoSolver*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 242a7e14dcfSSatish Balay { 243a7e14dcfSSatish Balay CHKFORTRANNULLOBJECT(ctx); 244a7e14dcfSSatish Balay PetscObjectAllocateFortranPointers(*tao,NFUNCS); 245a7e14dcfSSatish Balay if (!func) { 246a7e14dcfSSatish Balay *ierr = TaoSetGradientRoutine(*tao,0,ctx); 247a7e14dcfSSatish Balay } else { 248a7e14dcfSSatish Balay ((PetscObject)*tao)->fortran_func_pointers[GRAD] = (PetscVoidFunction)func; 249a7e14dcfSSatish Balay *ierr = TaoSetGradientRoutine(*tao, ourtaogradientroutine,ctx); 250a7e14dcfSSatish Balay } 251a7e14dcfSSatish Balay } 252a7e14dcfSSatish Balay 253a7e14dcfSSatish Balay void PETSC_STDCALL taosetobjectiveandgradientroutine_(TaoSolver *tao, void (PETSC_STDCALL *func)(TaoSolver*, Vec *, PetscReal *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 254a7e14dcfSSatish Balay { 255a7e14dcfSSatish Balay CHKFORTRANNULLOBJECT(ctx); 256a7e14dcfSSatish Balay PetscObjectAllocateFortranPointers(*tao,NFUNCS); 257a7e14dcfSSatish Balay if (!func) { 258a7e14dcfSSatish Balay *ierr = TaoSetObjectiveAndGradientRoutine(*tao,0,ctx); 259a7e14dcfSSatish Balay } else { 260a7e14dcfSSatish Balay ((PetscObject)*tao)->fortran_func_pointers[OBJGRAD] = (PetscVoidFunction)func; 261a7e14dcfSSatish Balay *ierr = TaoSetObjectiveAndGradientRoutine(*tao, ourtaoobjectiveandgradientroutine,ctx); 262a7e14dcfSSatish Balay } 263a7e14dcfSSatish Balay } 264a7e14dcfSSatish Balay 265a7e14dcfSSatish Balay 266a7e14dcfSSatish Balay 267a7e14dcfSSatish Balay 268a7e14dcfSSatish Balay void PETSC_STDCALL taosetseparableobjectiveroutine_(TaoSolver *tao, Vec *F, void (PETSC_STDCALL *func)(TaoSolver*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 269a7e14dcfSSatish Balay { 270a7e14dcfSSatish Balay CHKFORTRANNULLOBJECT(ctx); 271a7e14dcfSSatish Balay PetscObjectAllocateFortranPointers(*tao,NFUNCS); 272a7e14dcfSSatish Balay if (!func) { 273a7e14dcfSSatish Balay *ierr = TaoSetSeparableObjectiveRoutine(*tao,*F,0,ctx); 274a7e14dcfSSatish Balay } else { 275a7e14dcfSSatish Balay ((PetscObject)*tao)->fortran_func_pointers[SEPOBJ] = (PetscVoidFunction)func; 276a7e14dcfSSatish Balay *ierr = TaoSetSeparableObjectiveRoutine(*tao,*F, ourtaoseparableobjectiveroutine,ctx); 277a7e14dcfSSatish Balay } 278a7e14dcfSSatish Balay } 279a7e14dcfSSatish Balay 280a7e14dcfSSatish Balay 281a7e14dcfSSatish Balay 282a7e14dcfSSatish Balay void PETSC_STDCALL taosetjacobianroutine_(TaoSolver *tao, Mat *J, Mat *Jp, void (PETSC_STDCALL *func)(TaoSolver*, Vec *, Mat *, Mat *, MatStructure *,void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 283a7e14dcfSSatish Balay { 284a7e14dcfSSatish Balay CHKFORTRANNULLOBJECT(ctx); 285a7e14dcfSSatish Balay PetscObjectAllocateFortranPointers(*tao,NFUNCS); 286a7e14dcfSSatish Balay if (!func) { 287a7e14dcfSSatish Balay *ierr = TaoSetJacobianRoutine(*tao,*J,*Jp,0,ctx); 288a7e14dcfSSatish Balay } else { 289a7e14dcfSSatish Balay ((PetscObject)*tao)->fortran_func_pointers[JAC] = (PetscVoidFunction)func; 290a7e14dcfSSatish Balay *ierr = TaoSetJacobianRoutine(*tao,*J, *Jp, ourtaojacobianroutine,ctx); 291a7e14dcfSSatish Balay } 292a7e14dcfSSatish Balay } 293a7e14dcfSSatish Balay 294a7e14dcfSSatish Balay void PETSC_STDCALL taosetjacobianstateroutine_(TaoSolver *tao, Mat *J, Mat *Jp, Mat*Jinv, void (PETSC_STDCALL *func)(TaoSolver*, Vec *, Mat *, Mat *, Mat*, MatStructure *,void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 295a7e14dcfSSatish Balay { 296a7e14dcfSSatish Balay CHKFORTRANNULLOBJECT(ctx); 297a7e14dcfSSatish Balay PetscObjectAllocateFortranPointers(*tao,NFUNCS); 298a7e14dcfSSatish Balay if (!func) { 299a7e14dcfSSatish Balay *ierr = TaoSetJacobianStateRoutine(*tao,*J,*Jp,*Jinv,0,ctx); 300a7e14dcfSSatish Balay } else { 301a7e14dcfSSatish Balay ((PetscObject)*tao)->fortran_func_pointers[JACSTATE] = (PetscVoidFunction)func; 302a7e14dcfSSatish Balay *ierr = TaoSetJacobianStateRoutine(*tao,*J, *Jp, *Jinv, ourtaojacobianstateroutine,ctx); 303a7e14dcfSSatish Balay } 304a7e14dcfSSatish Balay } 305a7e14dcfSSatish Balay 306a7e14dcfSSatish Balay void PETSC_STDCALL taosetjacobiandesignroutine_(TaoSolver *tao, Mat *J, void (PETSC_STDCALL *func)(TaoSolver*, Vec *, Mat *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 307a7e14dcfSSatish Balay { 308a7e14dcfSSatish Balay CHKFORTRANNULLOBJECT(ctx); 309a7e14dcfSSatish Balay PetscObjectAllocateFortranPointers(*tao,NFUNCS); 310a7e14dcfSSatish Balay if (!func) { 311a7e14dcfSSatish Balay *ierr = TaoSetJacobianDesignRoutine(*tao,*J,0,ctx); 312a7e14dcfSSatish Balay } else { 313a7e14dcfSSatish Balay ((PetscObject)*tao)->fortran_func_pointers[JACDESIGN] = (PetscVoidFunction)func; 314a7e14dcfSSatish Balay *ierr = TaoSetJacobianDesignRoutine(*tao,*J, ourtaojacobiandesignroutine,ctx); 315a7e14dcfSSatish Balay } 316a7e14dcfSSatish Balay } 317a7e14dcfSSatish Balay 318a7e14dcfSSatish Balay 319a7e14dcfSSatish Balay void PETSC_STDCALL taosethessianroutine_(TaoSolver *tao, Mat *J, Mat *Jp, void (PETSC_STDCALL *func)(TaoSolver*, Vec *, Mat *, Mat *, MatStructure *,void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 320a7e14dcfSSatish Balay { 321a7e14dcfSSatish Balay CHKFORTRANNULLOBJECT(ctx); 322a7e14dcfSSatish Balay PetscObjectAllocateFortranPointers(*tao,NFUNCS); 323a7e14dcfSSatish Balay if (!func) { 324a7e14dcfSSatish Balay *ierr = TaoSetHessianRoutine(*tao,*J,*Jp,0,ctx); 325a7e14dcfSSatish Balay } else { 326a7e14dcfSSatish Balay ((PetscObject)*tao)->fortran_func_pointers[HESS] = (PetscVoidFunction)func; 327a7e14dcfSSatish Balay *ierr = TaoSetHessianRoutine(*tao,*J, *Jp, ourtaohessianroutine,ctx); 328a7e14dcfSSatish Balay } 329a7e14dcfSSatish Balay } 330a7e14dcfSSatish Balay 331a7e14dcfSSatish Balay void PETSC_STDCALL taosetvariableboundsroutine_(TaoSolver *tao, void (PETSC_STDCALL *func)(TaoSolver*,Vec*,Vec*,void*,PetscErrorCode*),void *ctx, PetscErrorCode *ierr) 332a7e14dcfSSatish Balay { 333a7e14dcfSSatish Balay CHKFORTRANNULLOBJECT(ctx); 334a7e14dcfSSatish Balay PetscObjectAllocateFortranPointers(*tao,NFUNCS); 335a7e14dcfSSatish Balay if (func) { 336a7e14dcfSSatish Balay ((PetscObject)*tao)->fortran_func_pointers[BOUNDS] = (PetscVoidFunction)func; 337a7e14dcfSSatish Balay *ierr = TaoSetVariableBoundsRoutine(*tao,ourtaoboundsroutine,ctx); 338a7e14dcfSSatish Balay } else { 339a7e14dcfSSatish Balay *ierr = TaoSetVariableBoundsRoutine(*tao,0,ctx); 340a7e14dcfSSatish Balay } 341a7e14dcfSSatish Balay 342a7e14dcfSSatish Balay } 343a7e14dcfSSatish Balay void PETSC_STDCALL taosetmonitor_(TaoSolver *tao, void (PETSC_STDCALL *func)(TaoSolver*,void*,PetscErrorCode*),void *ctx, void (PETSC_STDCALL *mondestroy)(void*,PetscErrorCode*),PetscErrorCode *ierr) 344a7e14dcfSSatish Balay { 345a7e14dcfSSatish Balay CHKFORTRANNULLOBJECT(ctx); 346a7e14dcfSSatish Balay PetscObjectAllocateFortranPointers(*tao,NFUNCS); 347a7e14dcfSSatish Balay if (func) { 348a7e14dcfSSatish Balay ((PetscObject)*tao)->fortran_func_pointers[MON] = (PetscVoidFunction)func; 349a7e14dcfSSatish Balay if (FORTRANNULLFUNCTION(mondestroy)){ 3506c23d075SBarry Smith *ierr = TaoSetMonitor(*tao,ourtaomonitor,*tao,NULL); 351a7e14dcfSSatish Balay } else { 352a7e14dcfSSatish Balay *ierr = TaoSetMonitor(*tao,ourtaomonitor,*tao,ourtaomondestroy); 353a7e14dcfSSatish Balay } 354a7e14dcfSSatish Balay } 355a7e14dcfSSatish Balay } 356a7e14dcfSSatish Balay 357a7e14dcfSSatish Balay void PETSC_STDCALL taosetconvergencetest_(TaoSolver *tao, void (PETSC_STDCALL *func)(TaoSolver*,void*,PetscErrorCode*),void *ctx, PetscErrorCode *ierr) 358a7e14dcfSSatish Balay { 359a7e14dcfSSatish Balay CHKFORTRANNULLOBJECT(ctx); 360a7e14dcfSSatish Balay PetscObjectAllocateFortranPointers(*tao,NFUNCS); 361a7e14dcfSSatish Balay if (!func) { 362a7e14dcfSSatish Balay *ierr = TaoSetConvergenceTest(*tao,0,ctx); 363a7e14dcfSSatish Balay } else { 364a7e14dcfSSatish Balay ((PetscObject)*tao)->fortran_func_pointers[CONVTEST] = (PetscVoidFunction)func; 365a7e14dcfSSatish Balay *ierr = TaoSetConvergenceTest(*tao,ourtaoconvergencetest,ctx); 366a7e14dcfSSatish Balay } 367a7e14dcfSSatish Balay } 368a7e14dcfSSatish Balay 369a7e14dcfSSatish Balay 370a7e14dcfSSatish Balay void PETSC_STDCALL taosetconstraintsroutine_(TaoSolver *tao, Vec *C, void (PETSC_STDCALL *func)(TaoSolver*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 371a7e14dcfSSatish Balay { 372a7e14dcfSSatish Balay CHKFORTRANNULLOBJECT(ctx); 373a7e14dcfSSatish Balay PetscObjectAllocateFortranPointers(*tao,NFUNCS); 374a7e14dcfSSatish Balay if (!func) { 375a7e14dcfSSatish Balay *ierr = TaoSetConstraintsRoutine(*tao,*C,0,ctx); 376a7e14dcfSSatish Balay } else { 377a7e14dcfSSatish Balay ((PetscObject)*tao)->fortran_func_pointers[CONSTRAINTS] = (PetscVoidFunction)func; 378a7e14dcfSSatish Balay *ierr = TaoSetConstraintsRoutine(*tao, *C, ourtaoconstraintsroutine,ctx); 379a7e14dcfSSatish Balay } 380a7e14dcfSSatish Balay } 381a7e14dcfSSatish Balay 382a7e14dcfSSatish Balay 383a7e14dcfSSatish Balay void PETSC_STDCALL taosettype_(TaoSolver *tao, CHAR type_name PETSC_MIXED_LEN(len), PetscErrorCode *ierr PETSC_END_LEN(len)) 384a7e14dcfSSatish Balay 385a7e14dcfSSatish Balay { 386a7e14dcfSSatish Balay char *t; 387a7e14dcfSSatish Balay 388a7e14dcfSSatish Balay FIXCHAR(type_name,len,t); 389a7e14dcfSSatish Balay *ierr = TaoSetType(*tao,t); 390a7e14dcfSSatish Balay FREECHAR(type_name,t); 391a7e14dcfSSatish Balay 392a7e14dcfSSatish Balay } 393a7e14dcfSSatish Balay 394a7e14dcfSSatish Balay void PETSC_STDCALL taoview_(TaoSolver *tao, PetscViewer *viewer, PetscErrorCode *ierr) 395a7e14dcfSSatish Balay { 396a7e14dcfSSatish Balay PetscViewer v; 397a7e14dcfSSatish Balay PetscPatchDefaultViewers_Fortran(viewer,v); 398a7e14dcfSSatish Balay *ierr = TaoView(*tao,v); 399a7e14dcfSSatish Balay } 400a7e14dcfSSatish Balay 401a7e14dcfSSatish Balay void PETSC_STDCALL taogethistory_(TaoSolver *tao, PetscInt *nhist, PetscErrorCode *ierr) 402a7e14dcfSSatish Balay { 403a7e14dcfSSatish Balay *nhist = (*tao)->hist_len; 404a7e14dcfSSatish Balay *ierr = 0; 405a7e14dcfSSatish Balay } 406a7e14dcfSSatish Balay 407a7e14dcfSSatish Balay void PETSC_STDCALL taogetoptionsprefix_(TaoSolver *tao, CHAR prefix PETSC_MIXED_LEN(len), PetscErrorCode *ierr PETSC_END_LEN(len)) 408a7e14dcfSSatish Balay { 409a7e14dcfSSatish Balay const char *name; 410a7e14dcfSSatish Balay *ierr = TaoGetOptionsPrefix(*tao,&name); 411a7e14dcfSSatish Balay *ierr = PetscStrncpy(prefix,name,len); if (*ierr) return; 412a7e14dcfSSatish Balay FIXRETURNCHAR(PETSC_TRUE,prefix,len); 413a7e14dcfSSatish Balay 414a7e14dcfSSatish Balay } 415a7e14dcfSSatish Balay 416a7e14dcfSSatish Balay void PETSC_STDCALL taoappendoptionsprefix_(TaoSolver *tao, CHAR prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 417a7e14dcfSSatish Balay { 418a7e14dcfSSatish Balay char *name; 419a7e14dcfSSatish Balay FIXCHAR(prefix,len,name); 420a7e14dcfSSatish Balay *ierr = TaoAppendOptionsPrefix(*tao,name); 421a7e14dcfSSatish Balay FREECHAR(prefix,name); 422a7e14dcfSSatish Balay } 423a7e14dcfSSatish Balay 424a7e14dcfSSatish Balay void PETSC_STDCALL taosetoptionsprefix_(TaoSolver *tao, CHAR prefix PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len)) 425a7e14dcfSSatish Balay { 426a7e14dcfSSatish Balay char *t; 427a7e14dcfSSatish Balay FIXCHAR(prefix,len,t); 428a7e14dcfSSatish Balay *ierr = TaoSetOptionsPrefix(*tao,t); 429a7e14dcfSSatish Balay FREECHAR(prefix,t); 430a7e14dcfSSatish Balay } 431a7e14dcfSSatish Balay 432a7e14dcfSSatish Balay void PETSC_STDCALL taogettype_(TaoSolver *tao, CHAR name PETSC_MIXED_LEN(len), PetscErrorCode *ierr PETSC_END_LEN(len)) 433a7e14dcfSSatish Balay { 434a7e14dcfSSatish Balay const char *tname; 435a7e14dcfSSatish Balay *ierr = TaoGetType(*tao,&tname); 436a7e14dcfSSatish Balay *ierr = PetscStrncpy(name,tname,len); if (*ierr) return; 437a7e14dcfSSatish Balay FIXRETURNCHAR(PETSC_TRUE,name,len); 438a7e14dcfSSatish Balay 439a7e14dcfSSatish Balay } 440a7e14dcfSSatish Balay 441a7e14dcfSSatish Balay 442a7e14dcfSSatish Balay void PETSC_STDCALL taosetjacobianinequalityroutine_(TaoSolver *tao, Mat *J, Mat *Jp, void (PETSC_STDCALL *func)(TaoSolver*, Vec *, Mat *, Mat *, MatStructure *,void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 443a7e14dcfSSatish Balay { 444a7e14dcfSSatish Balay CHKFORTRANNULLOBJECT(ctx); 445a7e14dcfSSatish Balay PetscObjectAllocateFortranPointers(*tao,NFUNCS); 446a7e14dcfSSatish Balay if (!func) { 447a7e14dcfSSatish Balay *ierr = TaoSetJacobianInequalityRoutine(*tao,*J,*Jp,0,ctx); 448a7e14dcfSSatish Balay } else { 449a7e14dcfSSatish Balay ((PetscObject)*tao)->fortran_func_pointers[JACINEQ] = (PetscVoidFunction)func; 450a7e14dcfSSatish Balay *ierr = TaoSetJacobianInequalityRoutine(*tao,*J, *Jp, ourtaojacobianinequalityroutine,ctx); 451a7e14dcfSSatish Balay } 452a7e14dcfSSatish Balay } 453a7e14dcfSSatish Balay 454a7e14dcfSSatish Balay void PETSC_STDCALL taosetjacobianequalityroutine_(TaoSolver *tao, Mat *J, Mat *Jp, void (PETSC_STDCALL *func)(TaoSolver*, Vec *, Mat *, Mat *, MatStructure *,void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 455a7e14dcfSSatish Balay { 456a7e14dcfSSatish Balay CHKFORTRANNULLOBJECT(ctx); 457a7e14dcfSSatish Balay PetscObjectAllocateFortranPointers(*tao,NFUNCS); 458a7e14dcfSSatish Balay if (!func) { 459a7e14dcfSSatish Balay *ierr = TaoSetJacobianEqualityRoutine(*tao,*J,*Jp,0,ctx); 460a7e14dcfSSatish Balay } else { 461a7e14dcfSSatish Balay ((PetscObject)*tao)->fortran_func_pointers[JACEQ] = (PetscVoidFunction)func; 462a7e14dcfSSatish Balay *ierr = TaoSetJacobianEqualityRoutine(*tao,*J, *Jp, ourtaojacobianequalityroutine,ctx); 463a7e14dcfSSatish Balay } 464a7e14dcfSSatish Balay } 465a7e14dcfSSatish Balay 466a7e14dcfSSatish Balay 467a7e14dcfSSatish Balay void PETSC_STDCALL taosetinequalityconstraintsroutine_(TaoSolver *tao, Vec *C, void (PETSC_STDCALL *func)(TaoSolver*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 468a7e14dcfSSatish Balay { 469a7e14dcfSSatish Balay CHKFORTRANNULLOBJECT(ctx); 470a7e14dcfSSatish Balay PetscObjectAllocateFortranPointers(*tao,NFUNCS); 471a7e14dcfSSatish Balay if (!func) { 472a7e14dcfSSatish Balay *ierr = TaoSetInequalityConstraintsRoutine(*tao,*C,0,ctx); 473a7e14dcfSSatish Balay } else { 474a7e14dcfSSatish Balay ((PetscObject)*tao)->fortran_func_pointers[CONINEQ] = (PetscVoidFunction)func; 475a7e14dcfSSatish Balay *ierr = TaoSetInequalityConstraintsRoutine(*tao, *C, ourtaoinequalityconstraintsroutine,ctx); 476a7e14dcfSSatish Balay } 477a7e14dcfSSatish Balay } 478a7e14dcfSSatish Balay 479a7e14dcfSSatish Balay void PETSC_STDCALL taosetequalityconstraintsroutine_(TaoSolver *tao, Vec *C, void (PETSC_STDCALL *func)(TaoSolver*, Vec *, Vec *, void *, PetscErrorCode *), void *ctx, PetscErrorCode *ierr) 480a7e14dcfSSatish Balay { 481a7e14dcfSSatish Balay CHKFORTRANNULLOBJECT(ctx); 482a7e14dcfSSatish Balay PetscObjectAllocateFortranPointers(*tao,NFUNCS); 483a7e14dcfSSatish Balay if (!func) { 484a7e14dcfSSatish Balay *ierr = TaoSetEqualityConstraintsRoutine(*tao,*C,0,ctx); 485a7e14dcfSSatish Balay } else { 486a7e14dcfSSatish Balay ((PetscObject)*tao)->fortran_func_pointers[CONEQ] = (PetscVoidFunction)func; 487a7e14dcfSSatish Balay *ierr = TaoSetEqualityConstraintsRoutine(*tao, *C, ourtaoequalityconstraintsroutine,ctx); 488a7e14dcfSSatish Balay } 489a7e14dcfSSatish Balay } 490a7e14dcfSSatish Balay 491a7e14dcfSSatish Balay 492a7e14dcfSSatish Balay EXTERN_C_END 493a7e14dcfSSatish Balay 494a7e14dcfSSatish Balay 495