| 1 | /**
|
|---|
| 2 | * @file dsysv.hpp
|
|---|
| 3 | * @author Julian Iseringhausen <isering@ins.uni-bonn.de>
|
|---|
| 4 | * @date Mon Apr 18 13:09:54 2011
|
|---|
| 5 | *
|
|---|
| 6 | * @brief Lapack solver for symmetric matrices
|
|---|
| 7 | *
|
|---|
| 8 | */
|
|---|
| 9 |
|
|---|
| 10 | #ifndef DSYSV_HPP_
|
|---|
| 11 | #define DSYSV_HPP_
|
|---|
| 12 |
|
|---|
| 13 | #ifndef HAVE_LAPACK
|
|---|
| 14 | #error You need LAPACK in order to use MGDSYSV
|
|---|
| 15 | #endif
|
|---|
| 16 |
|
|---|
| 17 | #include <cassert>
|
|---|
| 18 | #include <cstddef>
|
|---|
| 19 |
|
|---|
| 20 | #include "base/defs.hpp"
|
|---|
| 21 |
|
|---|
| 22 | namespace VMG
|
|---|
| 23 | {
|
|---|
| 24 |
|
|---|
| 25 | extern "C"
|
|---|
| 26 | {
|
|---|
| 27 |
|
|---|
| 28 | void FC_FUNC(dsysv, DSYSV) (const char* UPLO, const int* N, const int* NRHS,
|
|---|
| 29 | double* A, const int* LDA, int* IPIV, double* B,
|
|---|
| 30 | const int* LDB, double* WORK, const int* LWORK,
|
|---|
| 31 | int* INFO);
|
|---|
| 32 |
|
|---|
| 33 | void FC_FUNC(dsyrfs, DSYRFS) (const char* UPLO, const int* N, const int* NRHS,
|
|---|
| 34 | const vmg_float* A, const int* LDA, double* AF,
|
|---|
| 35 | const int* LDAF, const int* IPIV, const vmg_float* B,
|
|---|
| 36 | const int* LDB, double* X, const int* LDX,
|
|---|
| 37 | double* FERR, double* BERR, double* WORK, int* IWORK,
|
|---|
| 38 | int* INFO);
|
|---|
| 39 |
|
|---|
| 40 | void FC_FUNC(ssysv, SSYSV) (const char* UPLO, const int* N, const int* NRHS, float* A,
|
|---|
| 41 | const int* LDA, int* IPIV, float* B, const int* LDB,
|
|---|
| 42 | float* WORK, const int* LWORK, int* INFO);
|
|---|
| 43 |
|
|---|
| 44 | void FC_FUNC(ssyrfs, SSYRFS) (const char* UPLO, const int* N, const int* NRHS,
|
|---|
| 45 | const vmg_float* A, const int* LDA, float* AF,
|
|---|
| 46 | const int* LDAF, const int* IPIV, const vmg_float* B,
|
|---|
| 47 | const int* LDB, float* X, const int* LDX, float* FERR,
|
|---|
| 48 | float* BERR, double* WORK, int* IWORK, int* INFO);
|
|---|
| 49 |
|
|---|
| 50 | } /* extern "C" */
|
|---|
| 51 |
|
|---|
| 52 | /* By default, assume fcs_float is double. */
|
|---|
| 53 | #if defined(FCS_FLOAT_IS_FLOAT)
|
|---|
| 54 | #define dsysv FC_FUNC(ssysv, SSYSV)
|
|---|
| 55 | #define dsyrfs FC_FUNC(ssyrfs, SSYRFS)
|
|---|
| 56 | #else
|
|---|
| 57 | #define dsysv FC_FUNC(dsysv, DSYSV)
|
|---|
| 58 | #define dsyrfs FC_FUNC(dsyrfs, DSYRFS)
|
|---|
| 59 | #endif
|
|---|
| 60 |
|
|---|
| 61 | template<class T>
|
|---|
| 62 | class DSYSV : public T
|
|---|
| 63 | {
|
|---|
| 64 | public:
|
|---|
| 65 | DSYSV() :
|
|---|
| 66 | T()
|
|---|
| 67 | {Init();}
|
|---|
| 68 |
|
|---|
| 69 | DSYSV(int size) :
|
|---|
| 70 | T(size)
|
|---|
| 71 | {Init();}
|
|---|
| 72 |
|
|---|
| 73 | virtual ~DSYSV();
|
|---|
| 74 |
|
|---|
| 75 | protected:
|
|---|
| 76 | void Compute();
|
|---|
| 77 |
|
|---|
| 78 | private:
|
|---|
| 79 | void Init();
|
|---|
| 80 | void Realloc();
|
|---|
| 81 |
|
|---|
| 82 | char la_uplo;
|
|---|
| 83 | int la_n, la_nrhs, *la_ipiv, la_lwork, la_info, *la_iwork;
|
|---|
| 84 | vmg_float *la_A, *la_A_orig, *la_B, *la_B_orig, *la_work, *la_work2;
|
|---|
| 85 |
|
|---|
| 86 | int cur_lapack_size, max_lapack_size;
|
|---|
| 87 | };
|
|---|
| 88 |
|
|---|
| 89 | template<class T>
|
|---|
| 90 | void DSYSV<T>::Compute()
|
|---|
| 91 | {
|
|---|
| 92 | vmg_float ferr, berr;
|
|---|
| 93 | vmg_float opt_work;
|
|---|
| 94 |
|
|---|
| 95 | this->Realloc();
|
|---|
| 96 |
|
|---|
| 97 | for (int i=0; i<this->cur_lapack_size; i++) {
|
|---|
| 98 | la_B[i] = la_B_orig[i] = this->Rhs(i);
|
|---|
| 99 | for (int j=i; j<this->cur_lapack_size; j++)
|
|---|
| 100 | la_A[j + i*this->cur_lapack_size] = la_A_orig[j + i*this->cur_lapack_size] = this->Mat(i,j);
|
|---|
| 101 | }
|
|---|
| 102 |
|
|---|
| 103 | // Determine optimal size of working space
|
|---|
| 104 | this->la_lwork = -1;
|
|---|
| 105 | dsysv (&la_uplo, &la_n, &la_nrhs, la_A, &la_n, la_ipiv, la_B, &la_n, &opt_work, &la_lwork, &la_info);
|
|---|
| 106 |
|
|---|
| 107 | // Resize working space
|
|---|
| 108 | this->la_lwork = static_cast<int>(opt_work);
|
|---|
| 109 | delete [] this->la_work;
|
|---|
| 110 | this->la_work = new vmg_float[this->la_lwork];
|
|---|
| 111 |
|
|---|
| 112 | // Solve system
|
|---|
| 113 | dsysv (&la_uplo, &la_n, &la_nrhs, la_A, &la_n, la_ipiv, la_B, &la_n, la_work, &la_lwork, &la_info);
|
|---|
| 114 |
|
|---|
| 115 | // Improve computed solution
|
|---|
| 116 | dsyrfs (&la_uplo, &la_n, &la_nrhs, la_A_orig, &la_n, la_A, &la_n, la_ipiv, la_B_orig, &la_n, la_B, &la_n, &ferr, &berr, la_work2, la_iwork, &la_info);
|
|---|
| 117 |
|
|---|
| 118 | // Write solution back
|
|---|
| 119 | for (int i=0; i<this->cur_lapack_size; i++)
|
|---|
| 120 | this->Sol(i) = this->la_B[i];
|
|---|
| 121 | }
|
|---|
| 122 |
|
|---|
| 123 | template<class T>
|
|---|
| 124 | void DSYSV<T>::Realloc()
|
|---|
| 125 | {
|
|---|
| 126 | this->cur_lapack_size = this->Size();
|
|---|
| 127 |
|
|---|
| 128 | if (this->cur_lapack_size > this->max_lapack_size) {
|
|---|
| 129 |
|
|---|
| 130 | delete [] la_A;
|
|---|
| 131 | delete [] la_A_orig;
|
|---|
| 132 | delete [] la_B;
|
|---|
| 133 | delete [] la_B_orig;
|
|---|
| 134 | delete [] la_ipiv;
|
|---|
| 135 | delete [] la_work2;
|
|---|
| 136 | delete [] la_iwork;
|
|---|
| 137 |
|
|---|
| 138 | this->la_A = new vmg_float[this->cur_lapack_size * this->cur_lapack_size];
|
|---|
| 139 | this->la_A_orig = new vmg_float[this->cur_lapack_size * this->cur_lapack_size];
|
|---|
| 140 | this->la_B = new vmg_float[this->cur_lapack_size];
|
|---|
| 141 | this->la_B_orig = new vmg_float[this->cur_lapack_size];
|
|---|
| 142 | this->la_ipiv = new int[this->cur_lapack_size];
|
|---|
| 143 | this->la_work2 = new vmg_float[3 * this->cur_lapack_size];
|
|---|
| 144 | this->la_iwork = new int[this->cur_lapack_size];
|
|---|
| 145 |
|
|---|
| 146 | this->la_n = this->cur_lapack_size;
|
|---|
| 147 |
|
|---|
| 148 | this->max_lapack_size = this->cur_lapack_size;
|
|---|
| 149 |
|
|---|
| 150 | }
|
|---|
| 151 | }
|
|---|
| 152 |
|
|---|
| 153 | template<class T>
|
|---|
| 154 | void DSYSV<T>::Init()
|
|---|
| 155 | {
|
|---|
| 156 | this->cur_lapack_size = 0;
|
|---|
| 157 | this->max_lapack_size = 0;
|
|---|
| 158 |
|
|---|
| 159 | this->la_A = NULL;
|
|---|
| 160 | this->la_A_orig = NULL;
|
|---|
| 161 | this->la_B = NULL;
|
|---|
| 162 | this->la_B_orig = NULL;
|
|---|
| 163 | this->la_work = NULL;
|
|---|
| 164 | this->la_ipiv = NULL;
|
|---|
| 165 | this->la_work2 = NULL;
|
|---|
| 166 | this->la_iwork = NULL;
|
|---|
| 167 |
|
|---|
| 168 | this->la_nrhs = 1;
|
|---|
| 169 | this->la_uplo = 'L';
|
|---|
| 170 | }
|
|---|
| 171 |
|
|---|
| 172 | template<class T>
|
|---|
| 173 | DSYSV<T>::~DSYSV()
|
|---|
| 174 | {
|
|---|
| 175 | delete [] this->la_A;
|
|---|
| 176 | delete [] this->la_A_orig;
|
|---|
| 177 | delete [] this->la_B;
|
|---|
| 178 | delete [] this->la_B_orig;
|
|---|
| 179 | delete [] this->la_work;
|
|---|
| 180 | delete [] this->la_ipiv;
|
|---|
| 181 | delete [] this->la_work2;
|
|---|
| 182 | delete [] this->la_iwork;
|
|---|
| 183 | }
|
|---|
| 184 |
|
|---|
| 185 | }
|
|---|
| 186 |
|
|---|
| 187 | #endif /* DSYSV_HPP_ */
|
|---|