MC++
mclapack.hpp
1 // Copyright (C) 2009-2013 Benoit Chachuat, Imperial College London.
2 // All Rights Reserved.
3 
4 #ifndef MC__MCLAPACK_H
5 #define MC__MCLAPACK_H
6 
7 #include <iostream>
8 #include <iomanip>
9 #include <string>
10 
11 #undef MC__DEBUG_EIGEN
12 
13 //extern "C" void dsyev_
14 //( const char*jobz, const char*uplo, const unsigned int*n, double*a,
15 // const unsigned int*lda, double*w, double*work, const int*lwork, int*info );
16 extern "C" void dsyev_
17 ( const char&, const char&, const long int&, double*, const long int&,
18  double*, double*, const long int&, long int& );
19 
20 namespace mc
21 {
22 
23 void pause()
24 {
25  int tmp;
26  std::cout << "ENTER <1> TO CONTINUE" << std::endl;
27  std::cin >> tmp;
28 }
29 
30 template< typename U > inline void display
31 ( const unsigned int m, const unsigned int n, const U*a, const unsigned int lda,
32  const std::string&stra, std::ostream&os )
33 {
34  os << stra << " =" << std::endl << std::scientific
35  << std::setprecision(5);
36  for( unsigned int im=0; a && im<m; im++ ){
37  for( unsigned int in=0; in<n; in++ ){
38  os << a[in*lda+im] << " ";
39  }
40  os << std::endl;
41  }
42  os << std::endl;
43 
44  if( os == std::cout || os == std::cerr ) pause();
45 }
46 
48 inline double* dsyev_wrapper
49 ( const unsigned int n, double*A, const bool eigv=false )
50 {
51  long info(1);
52  double*D = new double[n];
53 #ifdef MC__DEBUG_EIGEN
54  display( n, n, A, n, "Matrix A", std::cout );
55 #endif
56 
57  // get optimal size
58  char JOBZ = (eigv?'V':'N'), UPLO = 'U';
59  double worktmp;
60  int lwork = -1;
61  dsyev_( JOBZ, UPLO, n, A, n, D, &worktmp, lwork, info );
62 
63  // perform eigenvalue decomposition
64  lwork = (int)worktmp;
65  double*work = new double[lwork];
66  dsyev_( JOBZ, UPLO, n, A, n, D, work, lwork, info );
67 #ifdef MC__DEBUG_EIGEN
68  if( eigv ) TModel<T>::_display( n, n, A, n, "Matrix U", std::cout );
69  display( 1, n, D, 1, "Matrix D", std::cout );
70 #endif
71  delete[] work;
72 
73 #ifdef MC__DEBUG_EIGEN
74  std::cout << "INFO: " << info << std::endl;
75  pause();
76 #endif
77  if( info ){ delete[] D; return 0; }
78  return D;
79 }
80 
81 } // namespace mc
82 
83 #include "cpplapack.h"
84 
85 namespace CPPL{
86 
87 //=============================================================================
92 inline long dsysv(const dsymatrix& mat, dsymatrix& mat_inv)
93 {VERBOSE_REPORT;
94  dsymatrix mat_cp(mat);
95  mat_inv.resize(mat.n);
96  mat_inv.identity();
97  char UPLO('l');
98  long NRHS(mat.n), LDA(mat.n), *IPIV(new long[mat.n]), LDB(mat.n), LWORK(-1), INFO(1);
99  double *WORK( new double[1] );
100  dsysv_(UPLO, mat.n, NRHS, mat_cp.array, LDA, IPIV, mat_inv.array, LDB, WORK, LWORK, INFO);
101 
102  LWORK = long(WORK[0]);
103  delete [] WORK; WORK = new double[LWORK];
104  dsysv_(UPLO, mat.n, NRHS, mat_cp.array, LDA, IPIV, mat_inv.array, LDB, WORK, LWORK, INFO);
105  delete [] WORK; delete [] IPIV;
106 
107  if(INFO!=0){
108  WARNING_REPORT;
109  std::cerr << "Serious trouble happend. INFO = " << INFO << "." << std::endl;
110  }
111  return INFO;
112 }
113 
114 }//namespace CPPL
115 
116 #endif