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: }