int wrap_gsl_linalg_SV_decomp_mod(gsl_matrix* A, gsl_matrix* X,
gsl_matrix* V, gsl_matrix* S,
gsl_matrix* work)
{
gsl_vector_view _S = gsl_matrix_diagonal(S);
gsl_vector_view _work = gsl_matrix_row(work, 0);
return gsl_linalg_SV_decomp_mod(A, X, V, &_S.vector, &_work.vector);
}
CAMLprim value ml_gsl_linalg_SV_decomp_mod(value A, value X, value V,
value S, value WORK)
{
_DECLARE_MATRIX3(A, V, X);
_DECLARE_VECTOR2(S, WORK);
_CONVERT_MATRIX3(A, V, X);
_CONVERT_VECTOR2(S, WORK);
gsl_linalg_SV_decomp_mod(&m_A, &m_X, &m_V, &v_S, &v_WORK);
return Val_unit;
}
void SVD_mod(
matrix& A,
matrix& X,
matrix& V,
vector& S,
vector& work) {
int ret = gsl_linalg_SV_decomp_mod(
A.ptr_,
X.ptr_,
V.ptr_,
S.ptr_,
work.ptr_);
}
inline void SVD::solve(std::vector<std::vector<double> > &src){
if(src.size()<=0)
{ std::cerr << "invalid matrix" <<std::endl; return;}
//--- matrix allocation ---
Allocation(src[0].size(), src.size());
// copy into gsl_matrix* A
for(size_t i=0; i<m; ++i) for(size_t j=0; j<n; ++j) gsl_matrix_set(A, i, j, src[j][i]);
if(m<n) { std::cerr << "invalid matrix" <<std::endl; return;}
//--- the condition of m >> n is assumed as m > 100*n
if(m < 100*n) // Golub Reinsch method;
gsl_linalg_SV_decomp(A, V, S, work);
else // modified Golub Reinsch method;
gsl_linalg_SV_decomp_mod(A, X, V, S, work);
}
int main (int argc, char** argv, char** env) {
int i, j;
const gsl_rng_type *T;
gsl_rng *r;
gsl_rng_env_setup();
T = gsl_rng_default;
r = gsl_rng_alloc (T);
gsl_matrix *x = gsl_matrix_alloc (SIZE1, SIZE2);
#ifdef DEBUG
printf ("Start allocating matrix...\n");
#endif
for (i = 0; i < (x -> size1); i++) {
for (j = 0; j < (x -> size2); j++) {
gsl_matrix_set(x, i, j, gsl_ran_gaussian(r, 1.0));
}
}
#ifdef DEBUG
printf ("matrix allocation finished\n");
#endif
gsl_matrix *v = gsl_matrix_alloc (SIZE2, SIZE2);
gsl_vector *s = gsl_vector_alloc (SIZE2);
gsl_vector *work = gsl_vector_alloc (SIZE2);
gsl_linalg_SV_decomp (x, v, s, work);
#ifdef DEBUG
printf("%e\n", gsl_matrix_get(x, rand() % SIZE1 + 1, rand() % SIZE2 + 2));
#endif
#ifdef SVD_MOD
gsl_matrix *mx = gsl_matrix_alloc (SIZE2, SIZE2);
gsl_linalg_SV_decomp_mod (x, mx, v, s, work);
#endif
#iddef CLAPACK_SVD
dgesvd
#endif
return 0;
}
/**
* C++ version of gsl_linalg_SV_decomp_mod().
* @param A A matrix
* @param X A matrix
* @param V A matrix (part of SVD)
* @param S A vector
* @param work A vector
* @return Error code on failure
*/
inline int SV_decomp_mod( matrix& A, matrix& X, matrix& V, vector& S, vector& work ){
return gsl_linalg_SV_decomp_mod( A.get(), X.get(), V.get(), S.get(), work.get() ); }
static int
multifit_wlinear_svd (const gsl_matrix * X,
const gsl_vector * w,
const gsl_vector * y,
double tol,
int balance,
size_t * rank,
gsl_vector * c,
gsl_matrix * cov,
double *chisq, gsl_multifit_linear_workspace * work)
{
if (X->size1 != y->size)
{
GSL_ERROR
("number of observations in y does not match rows of matrix X",
GSL_EBADLEN);
}
else if (X->size2 != c->size)
{
GSL_ERROR ("number of parameters c does not match columns of matrix X",
GSL_EBADLEN);
}
else if (w->size != y->size)
{
GSL_ERROR ("number of weights does not match number of observations",
GSL_EBADLEN);
}
else if (cov->size1 != cov->size2)
{
GSL_ERROR ("covariance matrix is not square", GSL_ENOTSQR);
}
else if (c->size != cov->size1)
{
GSL_ERROR
("number of parameters does not match size of covariance matrix",
GSL_EBADLEN);
}
else if (X->size1 != work->n || X->size2 != work->p)
{
GSL_ERROR
("size of workspace does not match size of observation matrix",
GSL_EBADLEN);
}
else
{
const size_t n = X->size1;
const size_t p = X->size2;
size_t i, j, p_eff;
gsl_matrix *A = work->A;
gsl_matrix *Q = work->Q;
gsl_matrix *QSI = work->QSI;
gsl_vector *S = work->S;
gsl_vector *t = work->t;
gsl_vector *xt = work->xt;
gsl_vector *D = work->D;
/* Scale X, A = sqrt(w) X */
gsl_matrix_memcpy (A, X);
for (i = 0; i < n; i++)
{
double wi = gsl_vector_get (w, i);
if (wi < 0)
wi = 0;
{
gsl_vector_view row = gsl_matrix_row (A, i);
gsl_vector_scale (&row.vector, sqrt (wi));
}
}
/* Balance the columns of the matrix A if requested */
if (balance)
{
gsl_linalg_balance_columns (A, D);
}
else
{
gsl_vector_set_all (D, 1.0);
}
/* Decompose A into U S Q^T */
gsl_linalg_SV_decomp_mod (A, QSI, Q, S, xt);
/* Solve sqrt(w) y = A c for c, by first computing t = sqrt(w) y */
for (i = 0; i < n; i++)
{
double wi = gsl_vector_get (w, i);
double yi = gsl_vector_get (y, i);
if (wi < 0)
wi = 0;
gsl_vector_set (t, i, sqrt (wi) * yi);
}
gsl_blas_dgemv (CblasTrans, 1.0, A, t, 0.0, xt);
/* Scale the matrix Q, Q' = Q S^-1 */
gsl_matrix_memcpy (QSI, Q);
{
double alpha0 = gsl_vector_get (S, 0);
p_eff = 0;
for (j = 0; j < p; j++)
{
gsl_vector_view column = gsl_matrix_column (QSI, j);
double alpha = gsl_vector_get (S, j);
if (alpha <= tol * alpha0) {
alpha = 0.0;
} else {
alpha = 1.0 / alpha;
p_eff++;
}
gsl_vector_scale (&column.vector, alpha);
}
*rank = p_eff;
}
gsl_vector_set_zero (c);
/* Solution */
gsl_blas_dgemv (CblasNoTrans, 1.0, QSI, xt, 0.0, c);
/* Unscale the balancing factors */
gsl_vector_div (c, D);
/* Compute chisq, from residual r = y - X c */
{
double r2 = 0;
for (i = 0; i < n; i++)
{
double yi = gsl_vector_get (y, i);
double wi = gsl_vector_get (w, i);
gsl_vector_const_view row = gsl_matrix_const_row (X, i);
double y_est, ri;
gsl_blas_ddot (&row.vector, c, &y_est);
ri = yi - y_est;
r2 += wi * ri * ri;
}
*chisq = r2;
/* Form covariance matrix cov = (X^T W X)^-1 = (Q S^-1) (Q S^-1)^T */
for (i = 0; i < p; i++)
{
gsl_vector_view row_i = gsl_matrix_row (QSI, i);
double d_i = gsl_vector_get (D, i);
for (j = i; j < p; j++)
{
gsl_vector_view row_j = gsl_matrix_row (QSI, j);
double d_j = gsl_vector_get (D, j);
double s;
gsl_blas_ddot (&row_i.vector, &row_j.vector, &s);
gsl_matrix_set (cov, i, j, s / (d_i * d_j));
gsl_matrix_set (cov, j, i, s / (d_i * d_j));
}
}
}
return GSL_SUCCESS;
}
}
int
gsl_multifit_linear_svd (const gsl_matrix * X,
const gsl_vector * y,
double tol,
size_t * rank,
gsl_vector * c,
gsl_matrix * cov,
double *chisq, gsl_multifit_linear_workspace * work)
{
if (X->size1 != y->size)
{
GSL_ERROR
("number of observations in y does not match rows of matrix X",
GSL_EBADLEN);
}
else if (X->size2 != c->size)
{
GSL_ERROR ("number of parameters c does not match columns of matrix X",
GSL_EBADLEN);
}
else if (cov->size1 != cov->size2)
{
GSL_ERROR ("covariance matrix is not square", GSL_ENOTSQR);
}
else if (c->size != cov->size1)
{
GSL_ERROR
("number of parameters does not match size of covariance matrix",
GSL_EBADLEN);
}
else if (X->size1 != work->n || X->size2 != work->p)
{
GSL_ERROR
("size of workspace does not match size of observation matrix",
GSL_EBADLEN);
}
else if (tol <= 0)
{
GSL_ERROR ("tolerance must be positive", GSL_EINVAL);
}
else
{
const size_t n = X->size1;
const size_t p = X->size2;
size_t i, j, p_eff;
gsl_matrix *A = work->A;
gsl_matrix *Q = work->Q;
gsl_matrix *QSI = work->QSI;
gsl_vector *S = work->S;
gsl_vector *xt = work->xt;
gsl_vector *D = work->D;
/* Copy X to workspace, A <= X */
gsl_matrix_memcpy (A, X);
/* Balance the columns of the matrix A */
gsl_linalg_balance_columns (A, D);
/* Decompose A into U S Q^T */
gsl_linalg_SV_decomp_mod (A, QSI, Q, S, xt);
/* Solve y = A c for c */
gsl_blas_dgemv (CblasTrans, 1.0, A, y, 0.0, xt);
/* Scale the matrix Q, Q' = Q S^-1 */
gsl_matrix_memcpy (QSI, Q);
{
double alpha0 = gsl_vector_get (S, 0);
p_eff = 0;
for (j = 0; j < p; j++)
{
gsl_vector_view column = gsl_matrix_column (QSI, j);
double alpha = gsl_vector_get (S, j);
if (alpha <= tol * alpha0) {
alpha = 0.0;
} else {
alpha = 1.0 / alpha;
p_eff++;
}
gsl_vector_scale (&column.vector, alpha);
}
*rank = p_eff;
}
gsl_vector_set_zero (c);
gsl_blas_dgemv (CblasNoTrans, 1.0, QSI, xt, 0.0, c);
/* Unscale the balancing factors */
gsl_vector_div (c, D);
/* Compute chisq, from residual r = y - X c */
{
double s2 = 0, r2 = 0;
for (i = 0; i < n; i++)
{
double yi = gsl_vector_get (y, i);
gsl_vector_const_view row = gsl_matrix_const_row (X, i);
double y_est, ri;
gsl_blas_ddot (&row.vector, c, &y_est);
ri = yi - y_est;
r2 += ri * ri;
}
s2 = r2 / (n - p_eff); /* p_eff == rank */
*chisq = r2;
/* Form variance-covariance matrix cov = s2 * (Q S^-1) (Q S^-1)^T */
for (i = 0; i < p; i++)
{
gsl_vector_view row_i = gsl_matrix_row (QSI, i);
double d_i = gsl_vector_get (D, i);
for (j = i; j < p; j++)
{
gsl_vector_view row_j = gsl_matrix_row (QSI, j);
double d_j = gsl_vector_get (D, j);
double s;
gsl_blas_ddot (&row_i.vector, &row_j.vector, &s);
gsl_matrix_set (cov, i, j, s * s2 / (d_i * d_j));
gsl_matrix_set (cov, j, i, s * s2 / (d_i * d_j));
}
}
}
return GSL_SUCCESS;
}
}
SaLSA::SaLSA(const Everything& e, const FluidSolverParams& fsp)
: PCM(e, fsp), siteShape(fsp.solvents[0]->molecule.sites.size())
{
logPrintf(" Initializing non-local response weight functions:\n");
const double dG = gInfo.dGradial, Gmax = gInfo.GmaxGrid;
unsigned nGradial = unsigned(ceil(Gmax/dG))+5;
//Initialize fluid molecule's spherically-averaged electron density kernel:
const auto& solvent = fsp.solvents[0];
std::vector<double> nFluidSamples(nGradial);
for(unsigned i=0; i<nGradial; i++)
{ double G = i*dG;
nFluidSamples[i] = 0.;
for(const auto& site: solvent->molecule.sites)
{ double nTilde = site->elecKernel(G);
for(const vector3<>& r: site->positions)
nFluidSamples[i] += nTilde * bessel_jl(0, G*r.length());
}
}
nFluid.init(0, nFluidSamples, dG);
//Determine dipole correlation factors:
double chiRot = 0., chiPol = 0.;
for(const auto& c: fsp.components)
{ chiRot += c->Nbulk * c->molecule.getDipole().length_squared()/(3.*fsp.T);
chiPol += c->Nbulk * c->molecule.getAlphaTot();
}
double sqrtCrot = (epsBulk>epsInf && chiRot) ? sqrt((epsBulk-epsInf)/(4.*M_PI*chiRot)) : 1.;
double epsInfEff = chiRot ? epsInf : epsBulk; //constrain to epsBulk for molecules with no rotational susceptibility
double sqrtCpol = (epsInfEff>1. && chiPol) ? sqrt((epsInfEff-1.)/(4.*M_PI*chiPol)) : 1.;
//Rotational and translational response (includes ionic response):
const double bessel_jl_by_Gl_zero[4] = {1., 1./3, 1./15, 1./105}; //G->0 limit of j_l(G)/G^l
for(const auto& c: fsp.components)
for(int l=0; l<=fsp.lMax; l++)
{ //Calculate radial densities for all m:
gsl_matrix* V = gsl_matrix_calloc(nGradial, 2*l+1); //allocate and set to zero
double prefac = sqrt(4.*M_PI*c->Nbulk/fsp.T);
for(unsigned iG=0; iG<nGradial; iG++)
{ double G = iG*dG;
for(const auto& site: c->molecule.sites)
{ double Vsite = prefac * site->chargeKernel(G);
for(const vector3<>& r: site->positions)
{ double rLength = r.length();
double bessel_jl_by_Gl = G ? bessel_jl(l,G*rLength)/pow(G,l) : bessel_jl_by_Gl_zero[l]*pow(rLength,l);
vector3<> rHat = (rLength ? 1./rLength : 0.) * r;
for(int m=-l; m<=+l; m++)
*gsl_matrix_ptr(V,iG,l+m) += Vsite * bessel_jl_by_Gl * Ylm(l,m, rHat);
}
}
}
//Scale dipole active modes:
for(int lm=0; lm<2l+1; lm++)
if(l==1 && fabs(gsl_matrix_get(V,0,lm))>1e-6)
for(unsigned iG=0; iG<nGradial; iG++)
*gsl_matrix_ptr(V,iG,lm) *= sqrtCrot;
//Get linearly-independent non-zero modes by performing an SVD:
gsl_vector* S = gsl_vector_alloc(2*l+1);
gsl_matrix* U = gsl_matrix_alloc(2*l+1, 2*l+1);
gsl_matrix* tmpMat = gsl_matrix_alloc(2*l+1, 2*l+1);
gsl_vector* tmpVec = gsl_vector_alloc(2*l+1);
gsl_linalg_SV_decomp_mod(V, tmpMat, U, S, tmpVec);
gsl_vector_free(tmpVec);
gsl_matrix_free(tmpMat);
gsl_matrix_free(U);
//Add response functions for non-singular modes:
for(int mode=0; mode<2*l+1; mode++)
{ double Smode = gsl_vector_get(S, mode);
if(Smode*Smode < 1e-3) break;
std::vector<double> Vsamples(nGradial);
for(unsigned iG=0; iG<nGradial; iG++)
Vsamples[iG] = Smode * gsl_matrix_get(V, iG, mode);
response.push_back(std::make_shared<MultipoleResponse>(l, -1, 1, Vsamples, dG));
}
gsl_vector_free(S);
gsl_matrix_free(V);
}
//Polarizability response:
for(unsigned iSite=0; iSite<solvent->molecule.sites.size(); iSite++)
{ const Molecule::Site& site = *(solvent->molecule.sites[iSite]);
if(site.polKernel)
{ std::vector<double> Vsamples(nGradial);
double prefac = sqrtCpol * sqrt(solvent->Nbulk * site.alpha);
for(unsigned iG=0; iG<nGradial; iG++)
Vsamples[iG] = prefac * site.polKernel(iG*dG);
response.push_back(std::make_shared<MultipoleResponse>(1, iSite, site.positions.size(), Vsamples, dG));
}
}
const double GzeroTol = 1e-12;
//Compute bulk properties and print summary:
double epsBulk = 1.; double k2factor = 0.; std::map<int,int> lCount;
for(const std::shared_ptr<MultipoleResponse>& resp: response)
{ lCount[resp->l]++;
double respGzero = (4*M_PI) * pow(resp->V(0), 2) * resp->siteMultiplicity;
if(resp->l==0) k2factor += respGzero;
if(resp->l==1) epsBulk += respGzero;
}
for(auto lInfo: lCount)
logPrintf(" l: %d #weight-functions: %d\n", lInfo.first, lInfo.second);
logPrintf(" Bulk dielectric-constant: %lg", epsBulk);
if(k2factor > GzeroTol) logPrintf(" screening-length: %lg bohrs.\n", sqrt(epsBulk/k2factor));
else logPrintf("\n");
if(fsp.lMax >= 1) myassert(fabs(epsBulk-this->epsBulk) < 1e-3); //verify consistency of correlation factors
myassert(fabs(k2factor-this->k2factor) < 1e-3); //verify consistency of site charges
//Initialize preconditioner kernel:
std::vector<double> KkernelSamples(nGradial);
for(unsigned i=0; i<nGradial; i++)
{ double G = i*dG, G2=G*G;
//Compute diagonal part of the hessian ( 4pi(Vc^-1 + chi) ):
double diagH = G2;
for(const auto& resp: response)
diagH += pow(G2,resp->l) * pow(resp->V(G), 2);
//Set its inverse square-root as the preconditioner:
KkernelSamples[i] = (diagH>GzeroTol) ? 1./sqrt(diagH) : 0.;
}
Kkernel.init(0, KkernelSamples, dG);
//MPI division:
TaskDivision(response.size(), mpiUtil).myRange(rStart, rStop);
}
