Actual source code: ztao.c

  1: /*$Id$*/

  3: #include "zpetsc.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

 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

 31: #endif


 35: 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)){
 36:   char *t;
 37:   PetscTruth flg1;

 39:   FIXCHAR(type,len1,t);
 40:   *PetscStrncmp(t,"",len1-1,&flg1);

 42:   if (flg1==PETSC_FALSE){
 43:     *TaoCreate((MPI_Comm)PetscToPointerComm(*comm), t,outtao);
 44:   } else if (flg1==PETSC_TRUE){
 45:     *TaoCreate((MPI_Comm)PetscToPointerComm(*comm), 0,outtao);
 46:   }
 47:   FREECHAR(type,t);
 48: }

 50: void PETSC_STDCALL taogetterminationreason_(TAO_SOLVER *tao,TaoTerminateReason *r,int *info)
 51: {
 52:   *info = TaoGetTerminationReason(*tao,r);
 53: }

 55: void PETSC_STDCALL taosetmethod_(TAO_SOLVER *tao,CHAR type PETSC_MIXED_LEN(len),
 56:                                 int *ierr PETSC_END_LEN(len))
 57: {
 58:   char *t;

 60:   FIXCHAR(type,len,t);
 61:   *TaoSetMethod(*tao,t);
 62:   FREECHAR(type,t);
 63: }


 66: static void (*f5)(TAO_SOLVER*,TaoVec**,TaoVec**,TaoVec**,TaoVec**,double*,double*,double*,int*,void*,int*);

 69: static int ourtaolinesearch(TAO_SOLVER tao,TaoVec* x,TaoVec* g ,TaoVec* dx,TaoVec* w,double *f,double *f_full, double *step,int *flag,void *ctx)
 70: {
 71:   int info = 0;
 72:   (*f5)(&tao,&x,&g,&dx,&w,f,f_full,step,flag,ctx,&info);CHKERRQ(info);
 73:   return 0;
 74: }

 77: void PETSC_STDCALL taosetlinesearch_(TAO_SOLVER *tao,
 78:                                      void (*setup)(TAO_SOLVER,void*),
 79:                                      void (*options)(TAO_SOLVER,void*),
 80:                                      void (*func)(TAO_SOLVER*,TaoVec**,TaoVec**,TaoVec* *,TaoVec**, 
 81:                                                   double*, double*, double*, int*, void*,int*),
 82:                                      void (*view)(TAO_SOLVER,void*),
 83:                                      void (*destroy)(TAO_SOLVER,void*),
 84:                                      void *ctx,int *info){
 85:   f5 = func;
 86:   *info = TaoSetLineSearch(*tao,0,0,ourtaolinesearch,0,0,ctx);
 87:   /*  
 88:    *info = TaoSetLineSearch(*tao,setup,options,ourtaolinesearch,view,destroy,ctx);
 89:    */
 90: }

 92:                                              

 94: /* ------------------------------------------------------------------------- */


 97: void PETSC_STDCALL taogetsolution_(TAO_SOLVER *tao,TaoVec **X,int *info ){
 98:   *info = TaoGetSolution(*tao,X);
 99: }


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



114: void PETSC_STDCALL taogetlinearsolver_(TAO_SOLVER *tao,TaoLinearSolver **S,int *info ){
115:   *info = TaoGetLinearSolver(*tao,S);
116: }


119: void PETSC_STDCALL taogetsolutionstatus_(TAO_SOLVER *tao, int *it, double *f, double *fnorm, double *cnorm, double *xdiff, TaoTerminateReason *reason,int*info){
120:   *info=TaoGetSolutionStatus(*tao,it,f,fnorm,cnorm,xdiff,reason);
121: }



125: #ifdef PETSC_HAVE_FORTRAN_CAPS
126: #define taogetconvergencehistory_   TAOGETCONVERGENCEHISTORY
127: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
128: #define taogetconvergencehistory_   taogetconvergencehistory
129: #endif

131: void PETSC_STDCALL taogetconvergencehistory_(TAO_SOLVER *tao,
132:                                              int *na, int *info) {
133:   int *cits;
134:   PetscScalar *ca;
135:   *info = TaoGetConvergenceHistory(*tao,&ca,&cits,na);

137: }