xref: /petsc/src/tao/interface/ftn-custom/ztaosolverf.c (revision ffad99011bdf8bdff5e8540ef3c49b4fd8d6e6bb)
1aaa7dc30SBarry Smith #include <petsc-private/fortranimpl.h>
2ba92ff59SBarry Smith #include <petsc-private/taoimpl.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 
76441846f8SBarry Smith static PetscErrorCode ourtaoobjectiveroutine(Tao tao, Vec x, PetscReal *f, void *ctx)
77a7e14dcfSSatish Balay {
78a7e14dcfSSatish Balay     PetscErrorCode ierr = 0;
79441846f8SBarry Smith     (*(void (PETSC_STDCALL *)(Tao*,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 
85441846f8SBarry Smith static PetscErrorCode ourtaogradientroutine(Tao tao, Vec x, Vec g, void *ctx)
86a7e14dcfSSatish Balay {
87a7e14dcfSSatish Balay     PetscErrorCode ierr = 0;
88441846f8SBarry Smith     (*(void (PETSC_STDCALL *)(Tao*,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 
95441846f8SBarry Smith static PetscErrorCode ourtaoobjectiveandgradientroutine(Tao tao, Vec x, PetscReal *f, Vec g, void* ctx)
96a7e14dcfSSatish Balay {
97a7e14dcfSSatish Balay     PetscErrorCode ierr = 0;
98441846f8SBarry Smith     (*(void (PETSC_STDCALL *)(Tao*,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 
104*ffad9901SBarry Smith static PetscErrorCode ourtaohessianroutine(Tao tao, Vec x, Mat H, Mat Hpre, void *ctx)
105a7e14dcfSSatish Balay {
106a7e14dcfSSatish Balay     PetscErrorCode ierr = 0;
107*ffad9901SBarry Smith     (*(void (PETSC_STDCALL *)(Tao*,Vec*,Mat*,Mat*,void*,PetscErrorCode*))
108*ffad9901SBarry Smith      (((PetscObject)tao)->fortran_func_pointers[HESS]))(&tao,&x,&H,&Hpre,ctx,&ierr); CHKERRQ(ierr);
109a7e14dcfSSatish Balay     return 0;
110a7e14dcfSSatish Balay }
111a7e14dcfSSatish Balay 
112*ffad9901SBarry Smith static PetscErrorCode ourtaojacobianroutine(Tao tao, Vec x, Mat H, Mat Hpre, void *ctx)
113a7e14dcfSSatish Balay {
114a7e14dcfSSatish Balay     PetscErrorCode ierr = 0;
115*ffad9901SBarry Smith     (*(void (PETSC_STDCALL *)(Tao*,Vec*,Mat*,Mat*,void*,PetscErrorCode*))
116*ffad9901SBarry Smith      (((PetscObject)tao)->fortran_func_pointers[JAC]))(&tao,&x,&H,&Hpre,ctx,&ierr); CHKERRQ(ierr);
117a7e14dcfSSatish Balay     return 0;
118a7e14dcfSSatish Balay }
119a7e14dcfSSatish Balay 
120*ffad9901SBarry Smith static PetscErrorCode ourtaojacobianstateroutine(Tao tao, Vec x, Mat H, Mat Hpre, Mat Hinv, void *ctx)
121a7e14dcfSSatish Balay {
122a7e14dcfSSatish Balay     PetscErrorCode ierr = 0;
123*ffad9901SBarry Smith     (*(void (PETSC_STDCALL *)(Tao*,Vec*,Mat*,Mat*,Mat*,void*,PetscErrorCode*))
124*ffad9901SBarry Smith      (((PetscObject)tao)->fortran_func_pointers[JACSTATE]))(&tao,&x,&H,&Hpre,&Hinv,ctx,&ierr); CHKERRQ(ierr);
125a7e14dcfSSatish Balay     return 0;
126a7e14dcfSSatish Balay }
127a7e14dcfSSatish Balay 
12894ab13aaSBarry Smith static PetscErrorCode ourtaojacobiandesignroutine(Tao tao, Vec x, Mat H, void *ctx)
129a7e14dcfSSatish Balay {
130a7e14dcfSSatish Balay     PetscErrorCode ierr = 0;
131441846f8SBarry Smith     (*(void (PETSC_STDCALL *)(Tao*,Vec*,Mat*,void*,PetscErrorCode*))
13294ab13aaSBarry Smith      (((PetscObject)tao)->fortran_func_pointers[JACDESIGN]))(&tao,&x,&H,ctx,&ierr); CHKERRQ(ierr);
133a7e14dcfSSatish Balay     return 0;
134a7e14dcfSSatish Balay }
135a7e14dcfSSatish Balay 
136441846f8SBarry Smith static PetscErrorCode ourtaoboundsroutine(Tao tao, Vec xl, Vec xu, void *ctx)
137a7e14dcfSSatish Balay {
138a7e14dcfSSatish Balay     PetscErrorCode ierr = 0;
139441846f8SBarry Smith     (*(void (PETSC_STDCALL *)(Tao*,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 }
143441846f8SBarry Smith static PetscErrorCode ourtaoseparableobjectiveroutine(Tao tao, Vec x, Vec f, void *ctx)
144a7e14dcfSSatish Balay {
145a7e14dcfSSatish Balay     PetscErrorCode ierr = 0;
146441846f8SBarry Smith     (*(void (PETSC_STDCALL *)(Tao*,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 
151441846f8SBarry Smith static PetscErrorCode ourtaomonitor(Tao tao, void *ctx)
152a7e14dcfSSatish Balay {
153a7e14dcfSSatish Balay     PetscErrorCode ierr = 0;
154441846f8SBarry Smith     (*(void (PETSC_STDCALL *)(Tao *, 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;
163441846f8SBarry Smith     Tao tao = *(Tao*)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 }
169441846f8SBarry Smith static PetscErrorCode ourtaoconvergencetest(Tao tao, void *ctx)
170a7e14dcfSSatish Balay {
171a7e14dcfSSatish Balay     PetscErrorCode ierr = 0;
172441846f8SBarry Smith     (*(void (PETSC_STDCALL *)(Tao *, 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 
179441846f8SBarry Smith static PetscErrorCode ourtaoconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx)
180a7e14dcfSSatish Balay {
181a7e14dcfSSatish Balay     PetscErrorCode ierr = 0;
182441846f8SBarry Smith     (*(void (PETSC_STDCALL *)(Tao*,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 
189*ffad9901SBarry Smith static PetscErrorCode ourtaojacobianinequalityroutine(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx)
190a7e14dcfSSatish Balay {
191a7e14dcfSSatish Balay     PetscErrorCode ierr = 0;
192*ffad9901SBarry Smith     (*(void (PETSC_STDCALL *)(Tao*,Vec*,Mat*,Mat*,void*,PetscErrorCode*))
193*ffad9901SBarry Smith      (((PetscObject)tao)->fortran_func_pointers[JACINEQ]))(&tao,&x,&J,&Jpre,ctx,&ierr); CHKERRQ(ierr);
194a7e14dcfSSatish Balay     return 0;
195a7e14dcfSSatish Balay }
196a7e14dcfSSatish Balay 
197*ffad9901SBarry Smith static PetscErrorCode ourtaojacobianequalityroutine(Tao tao, Vec x, Mat J, Mat Jpre, void *ctx)
198a7e14dcfSSatish Balay {
199a7e14dcfSSatish Balay     PetscErrorCode ierr = 0;
200*ffad9901SBarry Smith     (*(void (PETSC_STDCALL *)(Tao*,Vec*,Mat*,Mat*,void*,PetscErrorCode*))
201*ffad9901SBarry Smith      (((PetscObject)tao)->fortran_func_pointers[JACEQ]))(&tao,&x,&J,&Jpre,ctx,&ierr); CHKERRQ(ierr);
202a7e14dcfSSatish Balay     return 0;
203a7e14dcfSSatish Balay }
204a7e14dcfSSatish Balay 
205441846f8SBarry Smith static PetscErrorCode ourtaoinequalityconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx)
206a7e14dcfSSatish Balay {
207a7e14dcfSSatish Balay     PetscErrorCode ierr = 0;
208441846f8SBarry Smith     (*(void (PETSC_STDCALL *)(Tao*,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 
215441846f8SBarry Smith static PetscErrorCode ourtaoequalityconstraintsroutine(Tao tao, Vec x, Vec c, void *ctx)
216a7e14dcfSSatish Balay {
217a7e14dcfSSatish Balay     PetscErrorCode ierr = 0;
218441846f8SBarry Smith     (*(void (PETSC_STDCALL *)(Tao*,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 
229441846f8SBarry Smith void PETSC_STDCALL taosetobjectiveroutine_(Tao *tao, void (PETSC_STDCALL *func)(Tao*, 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 
241441846f8SBarry Smith void PETSC_STDCALL taosetgradientroutine_(Tao *tao, void (PETSC_STDCALL *func)(Tao*, 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 
253441846f8SBarry Smith void PETSC_STDCALL taosetobjectiveandgradientroutine_(Tao *tao, void (PETSC_STDCALL *func)(Tao*, 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 
268441846f8SBarry Smith void PETSC_STDCALL taosetseparableobjectiveroutine_(Tao *tao, Vec *F, void (PETSC_STDCALL *func)(Tao*, 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 
282*ffad9901SBarry Smith void PETSC_STDCALL taosetjacobianroutine_(Tao *tao, Mat *J, Mat *Jp, void (PETSC_STDCALL *func)(Tao*, Vec *, Mat *, Mat *, 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 
294*ffad9901SBarry Smith 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)
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 
306441846f8SBarry Smith void PETSC_STDCALL taosetjacobiandesignroutine_(Tao *tao, Mat *J, void (PETSC_STDCALL *func)(Tao*, 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 
319*ffad9901SBarry Smith void PETSC_STDCALL taosethessianroutine_(Tao *tao, Mat *J, Mat *Jp, void (PETSC_STDCALL *func)(Tao*, Vec *, Mat *, Mat *,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 
331441846f8SBarry Smith void PETSC_STDCALL taosetvariableboundsroutine_(Tao *tao, void (PETSC_STDCALL *func)(Tao*,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 }
343441846f8SBarry Smith void PETSC_STDCALL taosetmonitor_(Tao *tao, void (PETSC_STDCALL *func)(Tao*,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 
357441846f8SBarry Smith void PETSC_STDCALL taosetconvergencetest_(Tao *tao, void (PETSC_STDCALL *func)(Tao*,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 
370441846f8SBarry Smith void PETSC_STDCALL taosetconstraintsroutine_(Tao *tao, Vec *C, void (PETSC_STDCALL *func)(Tao*, 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 
383441846f8SBarry Smith void PETSC_STDCALL taosettype_(Tao *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 
394441846f8SBarry Smith void PETSC_STDCALL taoview_(Tao *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 
401441846f8SBarry Smith void PETSC_STDCALL taogethistory_(Tao *tao, PetscInt *nhist, PetscErrorCode *ierr)
402a7e14dcfSSatish Balay {
403a7e14dcfSSatish Balay   *nhist  = (*tao)->hist_len;
404a7e14dcfSSatish Balay   *ierr = 0;
405a7e14dcfSSatish Balay }
406a7e14dcfSSatish Balay 
407441846f8SBarry Smith void PETSC_STDCALL taogetoptionsprefix_(Tao *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 
416441846f8SBarry Smith void PETSC_STDCALL taoappendoptionsprefix_(Tao *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 
424441846f8SBarry Smith void PETSC_STDCALL taosetoptionsprefix_(Tao *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 
432441846f8SBarry Smith void PETSC_STDCALL taogettype_(Tao *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 
442*ffad9901SBarry Smith void PETSC_STDCALL taosetjacobianinequalityroutine_(Tao *tao, Mat *J, Mat *Jp, void (PETSC_STDCALL *func)(Tao*, Vec *, Mat *, Mat *,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 
454*ffad9901SBarry Smith void PETSC_STDCALL taosetjacobianequalityroutine_(Tao *tao, Mat *J, Mat *Jp, void (PETSC_STDCALL *func)(Tao*, Vec *, Mat *, Mat *, 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 
467441846f8SBarry Smith void PETSC_STDCALL taosetinequalityconstraintsroutine_(Tao *tao, Vec *C, void (PETSC_STDCALL *func)(Tao*, 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 
479441846f8SBarry Smith void PETSC_STDCALL taosetequalityconstraintsroutine_(Tao *tao, Vec *C, void (PETSC_STDCALL *func)(Tao*, 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