halinalg.h

Go to the documentation of this file.

#ifndef HALINALG_H
#define HALINALG_H

#define TNT_BOUNDS_CHECK

#include "haio.h" 
#include "hastring.h"
#include "const.h"       
#include "vec.h"     //   TNT library
#include "fmat.h"    
#include "f2c.h"

#include "cg_sngl.h" // include files for IML++

// typedef NumVector<double>  HaVec_double ; //!< Numerical vector of double
typedef NumVector<float>   HaVec_float ;  
typedef NumVector<int>     HaVec_int;     
typedef NumVector<short>   HaVec_short;   
typedef NumVector<integer> HaVec_integer; 
typedef NumVector<void*>   HaVec_ptr;     
// typedef Fortran_matrix<double>  HaMat_double ;
typedef Fortran_matrix<float>   HaMat_float ;
typedef Fortran_matrix<int>     HaMat_int;
typedef Fortran_matrix<integer> HaMat_integer;

class Matrix; // Forward declaration for IPACK double-precision matrix

class HaVec_double: public NumVector<double> 
{
public:
        HaVec_double() {}
        HaVec_double( const HaVec_double& A): NumVector<double>( (NumVector<double>) A) {}
        HaVec_double(Subscript N, const double& value = 0.0 ): NumVector<double>(N, value) {}
    HaVec_double(Subscript N, const double* v): NumVector<double>(N, v) {}
        HaVec_double(Subscript N, char *s): NumVector<double>(N, s) {}

        HaVec_double& operator=(const double& scalar) { set(scalar); return *this; } 
    HaVec_double& operator/(const HaVec_double &B) { return (*this)/B; } 

};

class HaMat_double : public Fortran_matrix<double>
{
public:
        HaMat_double() {}
        HaMat_double(Subscript M, Subscript N, const double& value = 0.0): 
                                               Fortran_matrix<double>(M,N,value) {} 

        HaMat_double(Subscript M, Subscript N, double* v, const int New_amode=0): 
                                               Fortran_matrix<double>(M,N,v,New_amode) {}
                                                                                   
        HaMat_double(Subscript M, Subscript N, char* s): 
                                               Fortran_matrix<double>(M,N,s) {}

        HaMat_double(const HaMat_double& A): 
                                                                                   Fortran_matrix<double>( (Fortran_matrix<double>) A) {}

        HaMat_double(const Fortran_matrix<double>& A): 
                                                                                   Fortran_matrix<double>(A) {}

        HaMat_double& operator=(const double& scalar) { set(scalar); return *this; } 

        int set_from(Matrix& ipack_mat); 

        int SetFromStr(const char* str); 

    static int mat_inverse(HaMat_double& aa);   
    static int mat_transpose(HaMat_double& aa); 
    static int mat_sdiag(const HaMat_double& aa, HaMat_double& cc, 
                                     HaVec_double& eig);  

        int SqRoot(const int isign=1); 

        static int solv_lin_syst_1(HaMat_double& a, HaMat_double& b); 

protected:

};

typedef  map<HaString,HaVec_double,less<HaString> >  StrVecMap;

class MultiVarFunctor
{
  public:
      MultiVarFunctor(); 
      virtual ~MultiVarFunctor();
      virtual double operator() (const HaVec_double& xv) = 0;
          virtual int CalcGrad(HaVec_double& grad,const HaVec_double& xv) = 0;
};

const int BFGS_MIN_METH = 0;

typedef void (*ptrMinFunc1)(integer* iptr,integer* n, double*x, double* f, double* g);

extern "C" { 
extern void va13ad_ ( integer* iptr, ptrMinFunc1 pfunc, 
                                          integer* n, double* x, double* f ,double* g,double* scale,double* acc,double* w);
}

class HaMinimizer
{
public:
        HaMinimizer();
        ~HaMinimizer();

        int min_method;

        int GetNVar();              
        void SetNVar( int nvar);    

        int SetInitPoint(HaVec_double& init_pt); 
        virtual int CalcValGrad(HaVec_double& x, double& val, HaVec_double& grad); 
                                                                                       
        int Minimize(); 

        HaVec_double vvar;  
        HaVec_double scale; 
        double fun_val;     

        int nitr;
        double flast;
        HaVec_double glast;


};


// Matrix operations as global functions:

#ifdef HALINALG_CPP

Subscript ij_indx0(Subscript i, Subscript j);
Subscript ij_indx1(Subscript i, Subscript j);

#else

extern Subscript ij_indx0(Subscript i, Subscript j);
extern Subscript ij_indx1(Subscript i, Subscript j);

extern "C" int write_dbl_array_chuncks( FILE* fp, HaVec_double& dvec, int chunck_size,  const char* form_str);
extern "C" int write_float_array_chuncks( FILE* fp, HaVec_float& fvec, int chunck_size,  const char* form_str);
extern "C" int write_int_array_chuncks( FILE* fp, HaVec_int& ivec, int chunck_size,  const char* form_str);

extern "C" int rot_vec(double a[], double n[], double cosa, double sina); 

#endif

class LanzPars
{
public:
// INPARI array:

   LanzPars();
   ~LanzPars();

   integer mat_order;       
   integer max_eigv_store;  
   integer num_eigv_search; 
   integer num_steps;       

   integer iret;            
   integer nfound;          

   integer debug_lvl;       

   integer problem_type;    

   integer inertia_check;   
   integer output_amount;   
                            //  PRINT EIGENVALUES AND INERTIAS =  64 + 4
                            //  PRINT EIGENVALUES, ESTIMATED ERRORS AND INERTIAS = 32 + 4
                            //  PRINT EIGENVALUES, ESTIMATED ERRORS, CALCULATED ERROR AND INERTIAS = 16 + 4
                            //  PRINT EIGENVALUES, ESTIMATED ERRORS,
                            //  CALCULATED ERROR, Y-ORTHOGONALITY AND INERTIAS = 16 + 4 + 2
                            //  PRINT EIGENVALUES, ESTIMATED ERRORS,
                            //  CALCULATED ERROR, Y-ORTHOGONALITY AND INERTIAS
                            //  AND THROW IN SOME FREQUENCIES 128 + 16 + 4 + 2
   integer max_steps_shift; 

//   integer buckling_flag;     //!< VIBRATION (0) OR BUCKLING (1 W/ SHIFT) (2 W/O SHIFT)
   integer search_in_boundary;  

   integer fc_mat_fmt;      
   integer m_mat_fmt;       
   integer loop_unroll_lvl; 



   integer factor_type;     





   integer dyn_shift_off;   
   integer init_guess;      
   integer lead_y_idx;      
   integer num_delay_piv;   

// INPARR array:
   double init_val;     
   double accuracy;     
   double left_bound;   
   double right_bound;  
   double store_factor;  

};

// LANZ - soubroutine to solve eigen vaalue problem with Lancos Algorithm
extern "C" {
void lanz_(integer* ldi,  
                   integer* inpari, double* inparr, 
                   double* otheta, 
                   double* oldbj,  
                   double* y,      
                   integer* onumt, 
                   double* kaux,   
                   integer* krp,   
           integer* kcp,   
                   double* maux,   
                   integer* mrp,   
                   integer* mcp,   
                   double*  r1j    
                   );
}

// LAPACK subroutines prototypes
extern "C" {

void dgesv_( integer* n,  integer* nrhs , double* a, 
                         integer* lda, integer* ipiv , double* b, 
                         integer* ldb, integer* info );
}



#endif /* !HALINALG_H */

---