void expm(gsl_matrix_complex * L, gsl_complex t, gsl_matrix * m) { int i,j,s; gsl_vector_complex *eval = gsl_vector_complex_alloc(4); gsl_matrix_complex *evec = gsl_matrix_complex_alloc(4, 4); gsl_eigen_nonsymmv_workspace * w = gsl_eigen_nonsymmv_alloc(4); gsl_matrix_complex *evalmat = gsl_matrix_complex_alloc(4, 4); gsl_matrix_complex *vd = gsl_matrix_complex_alloc(4, 4); gsl_complex one = gsl_complex_rect(1, 0); gsl_complex zero = gsl_complex_rect(0, 0); gsl_matrix_complex *K = gsl_matrix_complex_alloc(4, 4); gsl_permutation *p = gsl_permutation_alloc(4); gsl_vector_complex *x = gsl_vector_complex_alloc(4); gsl_vector_complex_view bp; gsl_complex z; gsl_eigen_nonsymmv(m, eval, evec, w); gsl_eigen_nonsymmv_sort(eval, evec, GSL_EIGEN_SORT_ABS_DESC); gsl_eigen_nonsymmv_free(w); // clear workspace for (i = 0; i < 4; i++) { gsl_complex eval_i = gsl_vector_complex_get(eval, i); gsl_complex expeval = gsl_complex_mul(eval_i,t); expeval = gsl_complex_exp(expeval); gsl_matrix_complex_set(evalmat, i, i, expeval); } gsl_vector_complex_free(eval); // clear vector for eigenvalues // v'L'=De'v' gsl_blas_zgemm(CblasTrans, CblasTrans, one, evalmat, evec, zero, vd); gsl_matrix_complex_transpose(evec);//transpose v gsl_matrix_complex_memcpy(K,evec); for (i = 0; i < 4; i++) { bp = gsl_matrix_complex_column(vd, i); gsl_linalg_complex_LU_decomp(evec, p, &s); gsl_linalg_complex_LU_solve(evec, p, &bp.vector, x); for (j = 0; j < 4; j++) { z = gsl_vector_complex_get(x, j); gsl_matrix_complex_set(L,i,j,z); //'through the looking glass' transpose } gsl_matrix_complex_memcpy(evec,K); } gsl_permutation_free(p); gsl_vector_complex_free(x); gsl_matrix_complex_free(vd); gsl_matrix_complex_free(evec); gsl_matrix_complex_free(evalmat); gsl_matrix_complex_free(K); }
static int mc_solve(lua_State *L) { mMatComplex *m = qlua_checkMatComplex(L, 1); mVecComplex *v = qlua_checkVecComplex(L, 2); mMatComplex *lu; mVecComplex *x; gsl_permutation *p; /* XXX assume GSL and QLA_D_Complex use compatible layout */ gsl_vector_complex_view vb = gsl_vector_complex_view_array((void *)&v->val[0], v->size); gsl_vector_complex_view vx; int signum; if (m->l_size != m->r_size) return luaL_error(L, "square matrix expected"); if (m->l_size != v->size) return luaL_error(L, "vector dim mismatch matrix size"); p = new_permutation(L, m->l_size); lu = qlua_newMatComplex(L, m->l_size, m->l_size); x = qlua_newVecComplex(L, m->l_size); /* XXX assume GSL and QLA_D_Complex use compatible layout */ vx = gsl_vector_complex_view_array((void *)&x->val[0], x->size); gsl_matrix_complex_memcpy(lu->m, m->m); gsl_linalg_complex_LU_decomp(lu->m, p, &signum); if (gsl_linalg_complex_LU_solve(lu->m, p, &vb.vector, &vx.vector)) luaL_error(L, "matrix:solve() failed"); gsl_permutation_free(p); return 1; }
Real DAESolver::solve() { if (the_system_size_ == 0) { return 0.0; } const VariableArray::size_type a_size(the_system_size_); gsl_linalg_LU_solve(the_jacobian_matrix1_, the_permutation1_, the_velocity_vector1_, the_solution_vector1_); gsl_linalg_complex_LU_solve(the_jacobian_matrix2_, the_permutation2_, the_velocity_vector2_, the_solution_vector2_); Real a_norm(0.0); Real delta_w(0.0); gsl_complex comp; VariableArray a_tmp_value_buffer = the_value_differential_buffer_; a_tmp_value_buffer.insert( a_tmp_value_buffer.end(), the_value_algebraic_buffer_.begin(), the_value_algebraic_buffer_.end()); for (VariableArray::size_type c(0); c < a_size; ++c) { Real a_tolerance2(rtoler_ * fabs(a_tmp_value_buffer[c]) + atoler_); a_tolerance2 = a_tolerance2 * a_tolerance2; delta_w = gsl_vector_get(the_solution_vector1_, c); the_w_[c] += delta_w; a_norm += delta_w * delta_w / a_tolerance2; comp = gsl_vector_complex_get(the_solution_vector2_, c); delta_w = GSL_REAL(comp); the_w_[c + a_size] += delta_w; a_norm += delta_w * delta_w / a_tolerance2; delta_w = GSL_IMAG(comp); the_w_[c + a_size * 2] += delta_w; a_norm += delta_w * delta_w / a_tolerance2; } return sqrt(a_norm / (3 * a_size)); }
static VALUE rb_gsl_linalg_complex_LU_solve(int argc, VALUE *argv, VALUE obj) { gsl_matrix_complex *m = NULL, *mtmp = NULL; gsl_permutation *p = NULL; gsl_vector_complex *b = NULL, *x = NULL; int flagm = 0, flagx = 0, itmp, signum; switch (TYPE(obj)) { case T_MODULE: case T_CLASS: case T_OBJECT: if (argc < 2 || argc > 4) rb_raise(rb_eArgError, "Usage: solve(m, b), solve(m, b, x), solve(lu, p, b), solve(lu, p, b, x)"); CHECK_MATRIX(argv[0]); Data_Get_Struct(argv[0], gsl_matrix_complex, m); if (CLASS_OF(argv[0]) != cgsl_matrix_complex_LU) { flagm = 1; mtmp = gsl_matrix_complex_alloc(m->size1, m->size2); gsl_matrix_complex_memcpy(mtmp, m); } else { mtmp = m; } itmp = 1; break; default: if (argc < 1 || argc > 3) rb_raise(rb_eArgError, "Usage: LU_solve(b), LU_solve(p, b), LU_solve(b, x), solve(p, b, x)"); Data_Get_Struct(obj, gsl_matrix_complex, m); if (CLASS_OF(obj) != cgsl_matrix_complex_LU) { flagm = 1; mtmp = gsl_matrix_complex_alloc(m->size1, m->size2); gsl_matrix_complex_memcpy(mtmp, m); } else { mtmp = m; } itmp = 0; } if (flagm == 1) { if (itmp != argc-1) rb_raise(rb_eArgError, "Usage: m.LU_solve(b)"); Data_Get_Struct(argv[itmp], gsl_vector_complex, b); x = gsl_vector_complex_alloc(b->size); p = gsl_permutation_alloc(b->size); gsl_linalg_complex_LU_decomp(mtmp, p, &signum); } else { Data_Get_Struct(argv[itmp], gsl_permutation, p); itmp++; Data_Get_Struct(argv[itmp], gsl_vector_complex, b); itmp++; if (itmp == argc-1) { Data_Get_Struct(argv[itmp], gsl_vector_complex, x); flagx = 1; } else { x = gsl_vector_complex_alloc(m->size1); } } gsl_linalg_complex_LU_solve(mtmp, p, b, x); if (flagm == 1) { gsl_matrix_complex_free(mtmp); gsl_permutation_free(p); } if (flagx == 0) return Data_Wrap_Struct(cgsl_vector_complex, 0, gsl_vector_complex_free, x); else return argv[argc-1]; }
/** * C++ version of gsl_linalg_complex_LU_solve(). * @param LU An LU decomposition matrix * @param p A permutation * @param b A vector * @param x A vector * @return Error code on failure */ inline int complex_LU_solve( matrix_complex const& LU, permutation const& p, vector_complex const& b, vector_complex& x ){ return gsl_linalg_complex_LU_solve( LU.get(), p.get(), b.get(), x.get() ); }
double Calculator::getIntensity(double Q) { std::complex<double> cppf1, cppf2; gsl_complex alpha, beta; gsl_complex gslf1, gslf2; int s; double avFactor; cppf1 = m_sf1->F(0.0, 0.0, Q, m_energy); cppf2 = m_sf2->F(0.0, 0.0, Q, m_energy); gslf1 = gsl_complex_rect(cppf1.real(), cppf1.imag()); gslf2 = gsl_complex_rect(cppf2.real(), cppf2.imag()); avFactor = exp(-2.0 / m_N); alpha = gsl_complex_rect (1.0, 0.0); beta = gsl_complex_rect (0.0, 0.0); /*set vector F (scattering factors)*/ gsl_vector_complex_set(F, 0, gslf1); gsl_vector_complex_set(F, 1, gslf2); /*set vector conj(F) (scattering factors)*/ gsl_vector_complex_set(Fconj, 0, gsl_complex_conjugate(gslf1)); gsl_vector_complex_set(Fconj, 1, gsl_complex_conjugate(gslf2)); /*set exp matrix*/ setMatrixExp(m_Exp, Q); /*find W = P * Exp * Ps * conj(F) vector:*/ /* (1) W = alpha * Ps * conj(F) + beta * W */ gsl_blas_zgemv (CblasNoTrans, alpha, m_Ps, Fconj, beta, W); /*printf("W(1):\n"); gsl_vector_complex_fprintf (stdout, W, "%g");*/ /* (2) W = alpha * Exp * tmp_vec + beta * W */ gsl_blas_zgemv (CblasNoTrans, alpha, m_Exp, W, beta, tmp_vec); /*printf("W(2):\n"); gsl_vector_complex_fprintf (stdout, tmp_vec, "%g");*/ /* (3) W = alpha * P * tmp_vec + beta * W */ gsl_blas_zgemv (CblasNoTrans, alpha, m_P, tmp_vec, beta, W); /*Find J0 = F.(Ps * conj(F)) */ gsl_blas_zgemv (CblasNoTrans, alpha, m_Ps, Fconj, beta, tmp_vec); gsl_blas_zdotu (F, tmp_vec, &J0); /*alpha = exp(-2 / N)*/ alpha = gsl_complex_rect (avFactor, 0.0); beta = gsl_complex_rect (0.0, 0.0); /*find T matrix: T = alpha * P * exp + beta * T*/ gsl_blas_zgemm (CblasNoTrans, CblasNoTrans, alpha, m_P, m_Exp, beta, T); /*printf("T:\n"); gsl_matrix_complex_fprintf (stdout, T, "%g");*/ /*Find Jns = F. (G * W) */ /*tmp_mat = I */ gsl_matrix_complex_set_identity (tmp_mat); /*tmp_mat = I - T */ gsl_matrix_complex_sub (tmp_mat, T); /*LU decomposition*/ gsl_linalg_complex_LU_decomp(tmp_mat, perm, &s); /*calculate product G * W = (I - T)^(-1) W directly using LU decomposition*/ gsl_linalg_complex_LU_solve (tmp_mat, perm, W, tmp_vec); /*calculate F.(G * W)*/ gsl_blas_zdotu (F, tmp_vec, &Jns); /*Find Js = F.(G^2 * (I - T^N) * W) however, this term should be negligible*/ /*result = N *(2 * Jns + J0) - Js */ alpha = gsl_complex_mul_real (Jns, 2.0 * avFactor); alpha = gsl_complex_add (alpha, J0); return m_N * m_I0 * GSL_REAL(alpha) * getPLGfactor(getTheta(Q)) + m_Ibg; }