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:  */