Actual source code: ztao.c
1: /*$Id: ztao.c 1.45 04/03/09 14:54:52-06:00 sarich@Chico.mcs.anl.gov $*/
3: #include "src/fortran/custom/zpetsc.h"
4: #include "tao_solver.h"
6: #ifdef PETSC_HAVE_FORTRAN_CAPS
7: #define taogetterminationreason_ TAOGETTERMINATIONREASON
8: #define taocreate_ TAOCREATE
9: #define taosetmethod_ TAOSETMETHOD
10: #define taogetsolution_ TAOGETSOLUTION
11: #define taogetgradient_ TAOGETGRADIENT
12: #define taogetvariablebounds_ TAOGETVARIABLEBOUNDS
13: #define taosetlinesearch_ TAOSETLINESEARCH
14: #define taogetiterationdata_ TAOGETSOLUTIONSTATUS
15: #define taogetsolutionstatus_ TAOGETSOLUTIONSTATUS
16: #define taogetlinearsolver_ TAOGETLINEARSOLVER
17: #define taosetinitialvector_ TAOSETINITIALVECTOR
19: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
20: #define taogetterminationreason_ taogetterminationreason
21: #define taocreate_ taocreate
22: #define taosetmethod_ taosetmethod
23: #define taogetsolution_ taogetsolution
24: #define taogetgradient_ taogetgradient
25: #define taogetvariablebounds_ taogetvariablebounds
26: #define taosetlinesearch_ taosetlinesearch
27: #define taogetiterationdata_ taogetsolutionstatus
28: #define taogetsolutionstatus_ taogetsolutionstatus
29: #define taogetlinearsolver_ taogetlinearsolver
30: #define taosetinitialvector_ taosetinitialvector
32: #endif
36: void PETSC_STDCALL taocreate_(MPI_Comm *comm, CHAR type PETSC_MIXED_LEN(len1),TAO_SOLVER *outtao,int *ierr PETSC_END_LEN(len1) PETSC_END_LEN(len2)){
37: char *t;
38: PetscTruth flg1;
40: FIXCHAR(type,len1,t);
41: *PetscStrncmp(t,"",len1-1,&flg1);
43: if (flg1==PETSC_FALSE){
44: *TaoCreate((MPI_Comm)PetscToPointerComm(*comm), t,outtao);
45: } else if (flg1==PETSC_TRUE){
46: *TaoCreate((MPI_Comm)PetscToPointerComm(*comm), 0,outtao);
47: }
48: FREECHAR(type,t);
49: }
51: void PETSC_STDCALL taogetterminationreason_(TAO_SOLVER *tao,TaoTerminateReason *r,int *info)
52: {
53: *info = TaoGetTerminationReason(*tao,r);
54: }
56: void PETSC_STDCALL taosetmethod_(TAO_SOLVER *tao,CHAR type PETSC_MIXED_LEN(len),
57: int *ierr PETSC_END_LEN(len))
58: {
59: char *t;
61: FIXCHAR(type,len,t);
62: *TaoSetMethod(*tao,t);
63: FREECHAR(type,t);
64: }
67: static void (*f5)(TAO_SOLVER*,TaoVec**,TaoVec**,TaoVec**,TaoVec**,double*,double*,int*,void*,int*);
70: static int ourtaolinesearch(TAO_SOLVER tao,TaoVec* x,TaoVec* g ,TaoVec* dx,TaoVec* w,double *f,double *step,int *flag,void *ctx)
71: {
72: int info = 0;
73: (*f5)(&tao,&x,&g,&dx,&w,f,step,flag,ctx,&info);CHKERRQ(info);
74: return 0;
75: }
78: void PETSC_STDCALL taosetlinesearch_(TAO_SOLVER *tao,
79: void (*setup)(TAO_SOLVER,void*),
80: void (*options)(TAO_SOLVER,void*),
81: void (*func)(TAO_SOLVER*,TaoVec**,TaoVec**,TaoVec* *,TaoVec**,
82: double*, double*, int*, void*,int*),
83: void (*view)(TAO_SOLVER,void*),
84: void (*destroy)(TAO_SOLVER,void*),
85: void *ctx,int *info){
86: f5 = func;
87: *info = TaoSetLineSearch(*tao,0,0,ourtaolinesearch,0,0,ctx);
88: /*
89: *info = TaoSetLineSearch(*tao,setup,options,ourtaolinesearch,view,destroy,ctx);
90: */
91: }
95: /* ------------------------------------------------------------------------- */
98: void PETSC_STDCALL taogetsolution_(TAO_SOLVER *tao,TaoVec **X,int *info ){
99: *info = TaoGetSolution(*tao,X);
100: }
102: void PETSC_STDCALL taogetgradient_(TAO_SOLVER *tao,TaoVec **G,int *info ){
103: *info = TaoGetSolution(*tao,G);
104: }
108: void PETSC_STDCALL taogetvariablebounds_(TAO_SOLVER *tao,TaoVec** XL,TaoVec** XU, int *info ){
109: *info = TaoGetVariableBounds(*tao,XL,XU);
110: }
113: void PETSC_STDCALL taogetlinearsolver_(TAO_SOLVER *tao,TaoLinearSolver **S,int *info ){
114: *info = TaoGetLinearSolver(*tao,S);
115: }
118: void PETSC_STDCALL taogetsolutionstatus_(TAO_SOLVER *tao, int *it, double *f, double *fnorm, double *cnorm, double *xdiff, TaoTerminateReason *reason,int*info){
119: *info=TaoGetSolutionStatus(*tao,it,f,fnorm,cnorm,xdiff,reason);
120: }
122: /*
123: void PETSC_STDCALL taosetinitialvector_(TAO_SOLVER *tao,TaoVec **X,int *info ){
124: *info = TaoSetInitialVector(*tao,*X);
125: }
126: */
128: /*
129: Need:
130: SetMonitor
131: GetTolerances
132: GetGradientTolerances
133: SetConvergenceTest
134: GetConvergenceHistory
135: GetSolutionUpdate
136: GetDualVariables
138: */