/*! \brief Solve system of linear equations
Subroutine to solve the matrix equation lu*x=b where l is a unit
lower triangular matrix and u is an upper triangular matrix both
of which are stored in a. the rhs vector b is input and the
solution is returned through vector b. (matrix transposed)
*/
void solve_lapack( int n, complex_array& a, int_array& ip,
complex_array& b, int64_t ndim )
{
DEBUG_TRACE("solve_lapack(" << n << "," << ndim << ")");
int info = clapack_zgetrs (CblasColMajor, CblasNoTrans,
n, 1, (void*) a.data(), ndim, ip.data(), b.data(), n);
if (0 != info) {
/*
The factorization has been completed, but the factor U is exactly singular,
and division by zero will occur if it is used to solve a system of equations.
*/
throw new nec_exception("nec++: Solving Failed: ",info);
}
}
/*! \brief Use lapack to perform LU decomposition
*/
void lu_decompose_lapack(nec_output_file& s_output, int64_t n, complex_array& a_in, int_array& ip, int64_t ndim)
{
UNUSED(s_output);
DEBUG_TRACE("lu_decompose_lapack(" << n << "," << ndim << ")");
ASSERT(n <= ndim);
#ifdef NEC_MATRIX_CHECK
cout << "atlas_a = ";
to_octave(a_in,n,ndim);
#endif
/* Un-transpose the matrix for Gauss elimination */
for (int i = 1; i < n; i++ ) {
int i_offset = i * ndim;
int j_offset = 0;
for (int j = 0; j < i; j++ ) {
nec_complex aij = a_in[i+j_offset];
a_in[i+j_offset] = a_in[j+i_offset];
a_in[j+i_offset] = aij;
j_offset += ndim;
}
}
/* Now call the LAPACK LU-Decomposition
ZGETRF computes an LU factorization of a general M-by-N matrix A
* using partial pivoting with row interchanges.
*
* The factorization has the form
* A = P * L * U
* where P is a permutation matrix, L is lower triangular with unit
* diagonal elements (lower trapezoidal if m > n), and U is upper
* triangular (upper trapezoidal if m < n).
Arguments
* =========
*
* M (input) INTEGER
* The number of rows of the matrix A. M >= 0.
*
* N (input) INTEGER
* The number of columns of the matrix A. N >= 0.
*
* A (input/output) COMPLEX*16 array, dimension (LDA,N)
* On entry, the M-by-N matrix to be factored.
* On exit, the factors L and U from the factorization
* A = P*L*U; the unit diagonal elements of L are not stored.
*
* LDA (input) INTEGER
* The leading dimension of the array A. LDA >= max(1,M).
*
* IPIV (output) INTEGER array, dimension (min(M,N))
* The pivot indices; for 1 <= i <= min(M,N), row i of the
* matrix was interchanged with row IPIV(i).
*
* INFO (output) INTEGER
* = 0: successful exit
* < 0: if INFO = -i, the i-th argument had an illegal value
* > 0: if INFO = i, U(i,i) is exactly zero. The factorization
* has been completed, but the factor U is exactly
* singular, and division by zero will occur if it is used
* to solve a system of equations.
*/
int info = clapack_zgetrf (CblasColMajor, n, n,
(void*) a_in.data(), ndim, ip.data());
if (0 != info) {
/*
The factorization has been completed, but the factor U is exactly singular,
and division by zero will occur if it is used to solve a system of equations.
*/
throw new nec_exception("nec++: LU Decomposition Failed: ",info);
}
#ifdef NEC_MATRIX_CHECK
cout << "atlas_solved = ";
to_octave(a_in,n,ndim);
cout << "atlas_ip = ";
to_octave(ip,n);
#endif
}
void to_octave(complex_array& a, int n, int ndim) {
to_octave(a.data(),n,ndim);
}
