Actual source code: ztao.c
1: /*$Id$*/
3: #include "private/fortranimpl.h"
4: #include "tao_solver.h"
7: #ifdef PETSC_HAVE_FORTRAN_CAPS
8: #define taogetterminationreason_ TAOGETTERMINATIONREASON
9: #define taocreate_ TAOCREATE
10: #define taosetmethod_ TAOSETMETHOD
11: #define taogetsolution_ TAOGETSOLUTION
12: #define taogetgradient_ TAOGETGRADIENT
13: #define taogetvariablebounds_ TAOGETVARIABLEBOUNDS
14: #define taosetlinesearch_ TAOSETLINESEARCH
15: #define taogetiterationdata_ TAOGETSOLUTIONSTATUS
16: #define taogetsolutionstatus_ TAOGETSOLUTIONSTATUS
17: #define taogetlinearsolver_ TAOGETLINEARSOLVER
18: #define taosetoptionsprefix_ TAOSETOPTIONSPREFIX
19: #define taoappendoptionsprefix_ TAOAPPENDOPTIONSPREFIX
20: #define taogetoptionsprefix_ TAOGETOPTIONSPREFIX
22: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
23: #define taogetterminationreason_ taogetterminationreason
24: #define taocreate_ taocreate
25: #define taosetmethod_ taosetmethod
26: #define taogetsolution_ taogetsolution
27: #define taogetgradient_ taogetgradient
28: #define taogetvariablebounds_ taogetvariablebounds
29: #define taosetlinesearch_ taosetlinesearch
30: #define taogetiterationdata_ taogetsolutionstatus
31: #define taogetsolutionstatus_ taogetsolutionstatus
32: #define taogetlinearsolver_ taogetlinearsolver
33: #define taosetoptionsprefix_ taosetoptionsprefix
34: #define taoappendoptionsprefix_ taoappendoptionsprefix
35: #define taogetoptionsprefix_ taogetoptionsprefix
37: #endif
41: 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)){
42: char *t;
43: PetscTruth flg1;
45: FIXCHAR(type,len1,t);
46: *PetscStrncmp(t,"",len1-1,&flg1);
48: if (flg1==PETSC_FALSE){
49: *TaoCreate(MPI_Comm_f2c(*(MPI_Fint *)&*comm), t,outtao);
50: } else if (flg1==PETSC_TRUE){
51: *TaoCreate(MPI_Comm_f2c(*(MPI_Fint *)&*comm), 0,outtao);
52: }
53: FREECHAR(type,t);
54: }
56: void PETSC_STDCALL taogetterminationreason_(TAO_SOLVER *tao,TaoTerminateReason *r,int *info)
57: {
58: *info = TaoGetTerminationReason(*tao,r);
59: }
61: void PETSC_STDCALL taosetmethod_(TAO_SOLVER *tao,CHAR type PETSC_MIXED_LEN(len),
62: int *ierr PETSC_END_LEN(len))
63: {
64: char *t;
66: FIXCHAR(type,len,t);
67: *TaoSetMethod(*tao,t);
68: FREECHAR(type,t);
69: }
72: static void (*f5)(TAO_SOLVER*,TaoVec**,TaoVec**,TaoVec**,TaoVec**,double*,double*,double*,TaoInt*,void*,int*);
75: static int ourtaolinesearch(TAO_SOLVER tao,TaoVec* x,TaoVec* g ,TaoVec* dx,TaoVec* w,double *f,double *f_full, double *step,TaoInt *flag,void *ctx)
76: {
77: int info = 0;
78: (*f5)(&tao,&x,&g,&dx,&w,f,f_full,step,flag,ctx,&info);CHKERRQ(info);
79: return 0;
80: }
83: void PETSC_STDCALL taosetlinesearch_(TAO_SOLVER *tao,
84: void (*setup)(TAO_SOLVER,void*),
85: void (*options)(TAO_SOLVER,void*),
86: void (*func)(TAO_SOLVER*,TaoVec**,TaoVec**,TaoVec* *,TaoVec**,
87: double*, double*, double*, TaoInt*, void*,int*),
88: void (*view)(TAO_SOLVER,void*),
89: void (*destroy)(TAO_SOLVER,void*),
90: void *ctx,int *info){
91: f5 = func;
92: *info = TaoSetLineSearch(*tao,0,0,ourtaolinesearch,0,0,ctx);
93: /*
94: *info = TaoSetLineSearch(*tao,setup,options,ourtaolinesearch,view,destroy,ctx);
95: */
96: }
98:
100: /* ------------------------------------------------------------------------- */
103: void PETSC_STDCALL taogetsolution_(TAO_SOLVER *tao,TaoVec **X,int *info ){
104: *info = TaoGetSolution(*tao,X);
105: }
108: void PETSC_STDCALL taogetgradient_(TAO_SOLVER *tao,TaoVec **G,int *info ){
109: *info = TaoGetSolution(*tao,G);
110: }
114: void PETSC_STDCALL taogetvariablebounds_(TAO_SOLVER *tao,TaoVec** XL,TaoVec** XU, int *info ){
115: *info = TaoGetVariableBounds(*tao,XL,XU);
116: }
120: void PETSC_STDCALL taogetlinearsolver_(TAO_SOLVER *tao,TaoLinearSolver **S,int *info ){
121: *info = TaoGetLinearSolver(*tao,S);
122: }
125: void PETSC_STDCALL taogetsolutionstatus_(TAO_SOLVER *tao, TaoInt *it, double *f, double *fnorm, double *cnorm, double *xdiff, TaoTerminateReason *reason,int*info){
126: *info=TaoGetSolutionStatus(*tao,it,f,fnorm,cnorm,xdiff,reason);
127: }
129: void PETSC_STDCALL taosetoptionsprefix_(TAO_SOLVER *tao, CHAR prefix PETSC_MIXED_LEN(len), int *ierr PETSC_END_LEN(len))
130: {
131: char *t;
132: FIXCHAR(prefix,len,t);
133: *TaoSetOptionsPrefix(*tao,t);
134: FREECHAR(prefix,t);
135: }
137: void PETSC_STDCALL taoappendoptionsprefix_(TAO_SOLVER *tao, CHAR prefix PETSC_MIXED_LEN(len), int *ierr PETSC_END_LEN(len))
138: {
139: char *t;
140: FIXCHAR(prefix,len,t);
141: *TaoAppendOptionsPrefix(*tao,t);
142: FREECHAR(prefix,t);
143: }
145: void PETSC_STDCALL taogetoptionsprefix_(TAO_SOLVER *tao, CHAR prefix PETSC_MIXED_LEN(len), int *ierr PETSC_END_LEN(len))
146: {
147: const char *tname;
148: *TaoGetOptionsPrefix(*tao,&tname);
149: *PetscStrncpy(prefix,tname,len);
150: }
154: #ifdef PETSC_HAVE_FORTRAN_CAPS
155: #define taogetconvergencehistory_ TAOGETCONVERGENCEHISTORY
156: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
157: #define taogetconvergencehistory_ taogetconvergencehistory
158: #endif
160: void PETSC_STDCALL taogetconvergencehistory_(TAO_SOLVER *tao,
161: TaoInt *na, int *info) {
162: TaoInt *cits;
163: PetscScalar *ca;
164: *info = TaoGetConvergenceHistory(*tao,&ca,&cits,na);
166: }