void lis_solver_get_preconname_f(LIS_INT *solver, char *name, LIS_INT *ierr, LIS_INT len)
{
char buf[1024];
LIS_DEBUG_FUNC_IN;
*ierr = lis_solver_get_preconname(*solver, buf);
strncpy(name,buf,len);
LIS_DEBUG_FUNC_OUT;
return;
}
LIS_INT lis_eii_quad(LIS_ESOLVER esolver)
{
LIS_MATRIX A;
LIS_VECTOR x;
LIS_SCALAR evalue, ievalue;
LIS_SCALAR lshift;
LIS_INT emaxiter;
LIS_REAL tol;
LIS_INT iter,iter2,output;
LIS_REAL nrm2,resid;
LIS_QUAD_PTR qdot_xz;
LIS_VECTOR z,q;
LIS_SOLVER solver;
double time,itime,ptime,p_c_time,p_i_time;
LIS_INT err;
LIS_PRECON precon;
LIS_INT nsol, precon_type;
char solvername[128], preconname[128];
LIS_DEBUG_FUNC_IN;
emaxiter = esolver->options[LIS_EOPTIONS_MAXITER];
tol = esolver->params[LIS_EPARAMS_RESID - LIS_EOPTIONS_LEN];
lshift = esolver->lshift;
output = esolver->options[LIS_EOPTIONS_OUTPUT];
A = esolver->A;
x = esolver->x;
if (esolver->options[LIS_EOPTIONS_INITGUESS_ONES] )
{
lis_vector_set_all(1.0,x);
}
evalue = 1.0;
z = esolver->work[0];
q = esolver->work[1];
LIS_QUAD_SCALAR_MALLOC(qdot_xz,0,1);
iter=0;
ievalue = 1/(evalue);
#ifdef _LONG__DOUBLE
if( output & (A->my_rank==0) ) printf("local shift : %Le\n", lshift);
#else
if( output & (A->my_rank==0) ) printf("local shift : %e\n", lshift);
#endif
if (lshift != 0) lis_matrix_shift_diagonal(A, lshift);
lis_solver_create(&solver);
lis_solver_set_option("-i bicg -p none -precision quad",solver);
lis_solver_set_optionC(solver);
lis_solver_get_solver(solver, &nsol);
lis_solver_get_precon(solver, &precon_type);
lis_solver_get_solvername(nsol, solvername);
lis_solver_get_preconname(precon_type, preconname);
if( output & (A->my_rank==0) ) printf("linear solver : %s\n", solvername);
if( output & (A->my_rank==0) ) printf("preconditioner : %s\n", preconname);
/* create preconditioner */
solver->A = A;
err = lis_precon_create(solver, &precon);
if( err )
{
lis_solver_work_destroy(solver);
solver->retcode = err;
return err;
}
while (iter<emaxiter)
{
iter = iter+1;
/* x = x / ||x||_2 */
lis_vector_nrm2(x, &nrm2);
lis_vector_scale(1/nrm2, x);
/* z = (A - lshift I)^-1 * x */
lis_solve_kernel(A, x, z, solver, precon);
lis_solver_get_iter(solver,&iter2);
/* 1/evalue = <x,z> */
lis_vector_dotex_mmm(x, z, &qdot_xz);
lis_quad_minus((LIS_QUAD *)qdot_xz.hi);
lis_vector_axpyzex_mmmm(qdot_xz,x,z,q);
lis_quad_minus((LIS_QUAD *)qdot_xz.hi);
ievalue = qdot_xz.hi[0];
/* resid = ||z - 1/evalue * x||_2 / |1/evalue| */
lis_vector_nrm2(q, &resid);
resid = fabs(resid/ievalue);
/* x = z */
lis_vector_copy(z,x);
/* convergence check */
lis_solver_get_timeex(solver,&time,&itime,&ptime,&p_c_time,&p_i_time);
esolver->ptime += solver->ptime;
esolver->itime += solver->itime;
esolver->p_c_time += solver->p_c_time;
esolver->p_i_time += solver->p_i_time;
if( output )
{
if( output & LIS_EPRINT_MEM ) esolver->rhistory[iter] = resid;
if( output & LIS_EPRINT_OUT && A->my_rank==0 ) lis_print_rhistory(iter,resid);
}
if( tol >= resid )
{
esolver->retcode = LIS_SUCCESS;
esolver->iter[0] = iter;
esolver->resid[0] = resid;
esolver->evalue[0] = 1/ievalue;
lis_vector_nrm2(x, &nrm2);
lis_vector_scale(1/nrm2, x);
if (lshift != 0) lis_matrix_shift_diagonal(A, -lshift);
lis_precon_destroy(precon);
lis_solver_destroy(solver);
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
}
lis_precon_destroy(precon);
esolver->retcode = LIS_MAXITER;
esolver->iter[0] = iter;
esolver->resid[0] = resid;
esolver->evalue[0] = 1/ievalue;
lis_vector_nrm2(x, &nrm2);
lis_vector_scale(1/nrm2, x);
if (lshift != 0)
{
lis_matrix_shift_diagonal(A, -lshift);
}
lis_solver_destroy(solver);
LIS_DEBUG_FUNC_OUT;
return LIS_MAXITER;
}
LIS_INT lis_egpi(LIS_ESOLVER esolver)
{
LIS_Comm comm;
LIS_MATRIX A,B;
LIS_VECTOR w,v,y,q;
LIS_SCALAR eta,theta;
LIS_INT emaxiter;
LIS_REAL tol;
LIS_INT iter,iter2,output;
LIS_SCALAR oshift,ishift;
LIS_REAL nrm2,resid;
LIS_SOLVER solver;
double time,itime,ptime,p_c_time,p_i_time;
LIS_INT err;
LIS_PRECON precon;
LIS_INT nsol, precon_type;
char solvername[128], preconname[128];
LIS_DEBUG_FUNC_IN;
comm = LIS_COMM_WORLD;
emaxiter = esolver->options[LIS_EOPTIONS_MAXITER];
tol = esolver->params[LIS_EPARAMS_RESID - LIS_EOPTIONS_LEN];
output = esolver->options[LIS_EOPTIONS_OUTPUT];
#ifdef _COMPLEX
oshift = esolver->params[LIS_EPARAMS_SHIFT - LIS_EOPTIONS_LEN] + esolver->params[LIS_EPARAMS_SHIFT_IM - LIS_EOPTIONS_LEN] * _Complex_I;
#else
oshift = esolver->params[LIS_EPARAMS_SHIFT - LIS_EOPTIONS_LEN];
#endif
A = esolver->A;
B = esolver->B;
v = esolver->x;
if (esolver->options[LIS_EOPTIONS_INITGUESS_ONES] )
{
lis_vector_set_all(1.0,v);
}
w = esolver->work[0];
y = esolver->work[1];
q = esolver->work[2];
if ( esolver->ishift != 0.0 ) oshift = ishift;
if ( oshift != 0.0 ) lis_matrix_shift_matrix(A, B, oshift);
if( output )
{
#ifdef _COMPLEX
lis_printf(comm,"shift : (%e, %e)\n", (double)creal(oshift), (double)cimag(oshift));
#else
lis_printf(comm,"shift : %e\n", (double)oshift);
#endif
}
lis_solver_create(&solver);
lis_solver_set_option("-i bicg -p none",solver);
err = lis_solver_set_optionC(solver);
CHKERR(err);
lis_solver_get_solver(solver, &nsol);
lis_solver_get_precon(solver, &precon_type);
lis_solver_get_solvername(nsol, solvername);
lis_solver_get_preconname(precon_type, preconname);
if( output )
{
lis_printf(comm,"linear solver : %s\n", solvername);
lis_printf(comm,"preconditioner : %s\n", preconname);
}
/* create preconditioner */
solver->A = B;
err = lis_precon_create(solver, &precon);
if( err )
{
lis_solver_work_destroy(solver);
solver->retcode = err;
return err;
}
iter=0;
while (iter<emaxiter)
{
iter = iter+1;
/* v = v / ||v||_2 */
lis_vector_nrm2(v, &nrm2);
lis_vector_scale(1.0/nrm2, v);
/* w = A * v */
lis_matvec(A, v, w);
/* v = v / <v,w>^1/2, w = w / <v,w>^1/2 */
lis_vector_dot(v, w, &eta);
eta = sqrt(eta);
lis_vector_scale(1.0/eta, v);
lis_vector_scale(1.0/eta, w);
/* y = B^-1 * w */
err = lis_solve_kernel(B, w, y, solver, precon);
if( err )
{
lis_solver_work_destroy(solver);
solver->retcode = err;
return err;
}
lis_solver_get_iter(solver, &iter2);
/* theta = <w,y> */
lis_vector_dot(w, y, &theta);
/* resid = ||y - theta * v||_2 / |theta| */
lis_vector_axpyz(-theta, v, y, q);
lis_vector_nrm2(q, &resid);
resid = resid / fabs(theta);
/* v = y */
lis_vector_copy(y, v);
/* convergence check */
lis_solver_get_timeex(solver,&time,&itime,&ptime,&p_c_time,&p_i_time);
esolver->ptime += solver->ptime;
esolver->itime += solver->itime;
esolver->p_c_time += solver->p_c_time;
esolver->p_i_time += solver->p_i_time;
if( output )
{
if( output & LIS_EPRINT_MEM ) esolver->rhistory[iter] = resid;
if( output & LIS_EPRINT_OUT ) lis_print_rhistory(comm,iter,resid);
}
if( tol >= resid )
{
esolver->retcode = LIS_SUCCESS;
esolver->iter[0] = iter;
esolver->resid[0] = resid;
esolver->evalue[0] = theta + oshift;
lis_vector_nrm2(v, &nrm2);
lis_vector_scale(1.0/nrm2, v);
if ( oshift != 0.0 ) lis_matrix_shift_matrix(A, B, -oshift);
lis_precon_destroy(precon);
lis_solver_destroy(solver);
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
}
lis_precon_destroy(precon);
esolver->retcode = LIS_MAXITER;
esolver->iter[0] = iter;
esolver->resid[0] = resid;
esolver->evalue[0] = theta + oshift;
lis_vector_nrm2(v, &nrm2);
lis_vector_scale(1.0/nrm2, v);
if ( oshift != 0.0 ) lis_matrix_shift_matrix(A, B, -oshift);
lis_solver_destroy(solver);
LIS_DEBUG_FUNC_OUT;
return LIS_MAXITER;
}
LIS_INT lis_eai_quad(LIS_ESOLVER esolver)
{
LIS_MATRIX A;
LIS_INT ss,ic;
LIS_INT emaxiter,iter0,hqriter;
LIS_REAL tol,hqrerr,D;
LIS_INT i,j;
LIS_INT output, niesolver;
LIS_REAL nrm2,resid0;
LIS_VECTOR *v,w;
LIS_SCALAR *h,*hq,*hr,evalue,evalue0;
LIS_SOLVER solver;
LIS_ESOLVER esolver2;
char esolvername[128],solvername[128],preconname[128];
LIS_INT nsol,precon_type;
ss = esolver->options[LIS_EOPTIONS_SUBSPACE];
emaxiter = esolver->options[LIS_EOPTIONS_MAXITER];
tol = esolver->params[LIS_EPARAMS_RESID - LIS_EOPTIONS_LEN];
output = esolver->options[LIS_EOPTIONS_OUTPUT];
niesolver = esolver->options[LIS_EOPTIONS_INNER_ESOLVER];
h = (LIS_SCALAR *)lis_malloc(ss*ss*sizeof(LIS_SCALAR), "lis_eai_quad::h");
hq = (LIS_SCALAR *)lis_malloc(ss*ss*sizeof(LIS_SCALAR), "lis_eai_quad::hq");
hr = (LIS_SCALAR *)lis_malloc(ss*ss*sizeof(LIS_SCALAR), "lis_eai_quad::hr");
A = esolver->A;
w = esolver->work[0];
v = &esolver->work[1];
lis_vector_set_all(0.0,v[0]);
lis_vector_set_all(1.0,w);
lis_vector_nrm2(w, &nrm2);
lis_solver_create(&solver);
lis_solver_set_option("-i bicg -p none",solver);
lis_solver_set_optionC(solver);
lis_solver_get_solver(solver, &nsol);
lis_solver_get_precon(solver, &precon_type);
lis_solver_get_solvername(nsol, solvername);
lis_solver_get_preconname(precon_type, preconname);
lis_esolver_get_esolvername(niesolver, esolvername);
if( A->my_rank==0 ) printf("inner eigensolver : %s\n", esolvername);
if( A->my_rank==0 ) printf("linear solver : %s\n", solvername);
if( A->my_rank==0 ) printf("preconditioner : %s\n", preconname);
for (i=0;i<ss*ss;i++) h[i] = 0.0;
j=-1;
while (j<ss-1)
{
j = j+1;
lis_vector_copy(w, v[j]);
/* w = A * v(j) */
lis_matvec(A, v[j], w);
/* reorthogonalization */
for (i=0;i<=j;i++)
{
/* h(i,j) = <v(i), w> */
lis_vector_dot(v[i], w, &h[i+j*ss]);
/* w = w - h(i,j) * v(i) */
lis_vector_axpy(-h[i+j*ss], v[i], w);
}
/* h(j+1,j) = ||w||_2 */
lis_vector_nrm2(w, &h[j+1+j*ss]);
/* convergence check */
if (fabs(h[j+1+j*ss])<tol) break;
/* v(j+1) = w / h(i+1,j) */
lis_vector_scale(1/h[j+1+j*ss],w);
lis_vector_copy(w,v[j+1]);
}
/* compute eigenvalues of a real upper
Hessenberg matrix H(j) = SH'(j)S^* */
lis_array_qr(ss,h,hq,hr,&hqriter,&hqrerr);
if( A->my_rank==0 )
{
#ifdef _LONG__LONG
printf("size of subspace : %lld\n\n", ss);
#else
printf("size of subspace : %d\n\n", ss);
#endif
if( output ) printf("approximate eigenvalues in subspace:\n\n");
i=0;
while (i<ss-1)
{
i = i + 1;
if (fabs(h[i+(i-1)*ss])<tol)
{
#ifdef _LONG__LONG
printf("Arnoldi: mode number = %lld\n",i-1);
#else
printf("Arnoldi: mode number = %d\n",i-1);
#endif
#ifdef _LONG__DOUBLE
printf("Arnoldi: eigenvalue = %Le\n",h[i-1+(i-1)*ss]);
#else
printf("Arnoldi: eigenvalue = %e\n",h[i-1+(i-1)*ss]);
#endif
esolver->evalue[i-1] = h[i-1+(i-1)*ss];
}
else
{
D = (h[i-1+(i-1)*ss]-h[i+i*ss]) * (h[i-1+(i-1)*ss]-h[i+i*ss])
+ 4 * h[i-1+i*ss] * h[i+(i-1)*ss];
if (D<0)
{
#ifdef _LONG__LONG
printf("Arnoldi: mode number = %lld\n",i-1);
#else
printf("Arnoldi: mode number = %d\n",i-1);
#endif
#ifdef _LONG__DOUBLE
printf("Arnoldi: eigenvalue = %Le + %Le i\n", (h[i-1+(i-1)*ss]+h[i+i*ss])/2, sqrt(-D)/2);
#else
printf("Arnoldi: eigenvalue = %e + %e i\n", (h[i-1+(i-1)*ss]+h[i+i*ss])/2, sqrt(-D)/2);
#endif
#ifdef _LONG__LONG
printf("Arnoldi: mode number = %lld\n",i);
#else
printf("Arnoldi: mode number = %d\n",i);
#endif
#ifdef _LONG__DOUBLE
printf("Arnoldi: eigenvalue = %Le - %Le i\n", (h[i-1+(i-1)*ss]+h[i+i*ss])/2, sqrt(-D)/2);
#else
printf("Arnoldi: eigenvalue = %e - %e i\n", (h[i-1+(i-1)*ss]+h[i+i*ss])/2, sqrt(-D)/2);
#endif
esolver->evalue[i-1] = (h[i-1+(i-1)*ss]+h[i+i*ss])/2;
esolver->evalue[i] = (h[i-1+(i-1)*ss]+h[i+i*ss])/2;
i=i+1;
}
else
{
#ifdef _LONG__LONG
printf("Arnoldi: mode number = %lld\n",i-1);
#else
printf("Arnoldi: mode number = %d\n",i-1);
#endif
#ifdef _LONG__DOUBLE
printf("Arnoldi: eigenvalue = %Le\n",h[i-1+(i-1)*ss]);
#else
printf("Arnoldi: eigenvalue = %e\n",h[i-1+(i-1)*ss]);
#endif
esolver->evalue[i-1] = h[i-1+(i-1)*ss];
}
}
}
if (i<ss)
{
#ifdef _LONG__LONG
printf("Arnoldi: mode number = %lld\n",i);
#else
printf("Arnoldi: mode number = %d\n",i);
#endif
#ifdef _LONG__DOUBLE
printf("Arnoldi: eigenvalue = %Le\n",h[i+i*ss]);
#else
printf("Arnoldi: eigenvalue = %e\n",h[i+i*ss]);
#endif
}
if( output ) printf("\n");
if( output ) printf("compute refined (real) eigenpairs, where imaginary parts are currently neglected:\n\n");
}
lis_esolver_create(&esolver2);
esolver2->options[LIS_EOPTIONS_ESOLVER] = niesolver;
esolver2->options[LIS_EOPTIONS_SUBSPACE] = 1;
esolver2->options[LIS_EOPTIONS_MAXITER] = emaxiter;
esolver2->options[LIS_EOPTIONS_OUTPUT] = esolver->options[LIS_EOPTIONS_OUTPUT];
esolver2->params[LIS_EPARAMS_RESID - LIS_EOPTIONS_LEN] = tol;
esolver2->eprecision = LIS_PRECISION_QUAD;
/* compute refined (real) eigenpairs, where imaginary parts are currently neglected */
for (i=0;i<ss;i++)
{
lis_vector_duplicate(A, &esolver->evector[i]);
esolver2->lshift = -(esolver->evalue[i]);
lis_esolve(A, esolver->evector[i], &evalue, esolver2);
lis_esolver_work_destroy(esolver2);
esolver->evalue[i] = evalue - esolver2->lshift;
esolver->iter[i] = esolver2->iter[0];
esolver->resid[i] = esolver2->resid[0];
if (i==0)
{
evalue0 = esolver->evalue[0];
iter0 = esolver2->iter[0];
resid0 = esolver2->resid[0];
if( output & LIS_EPRINT_MEM )
{
for (ic=0;ic<iter0+1;ic++)
{
esolver->rhistory[ic] = esolver2->rhistory[ic];
}
}
esolver->ptime = esolver2->ptime;
esolver->itime = esolver2->itime;
esolver->p_c_time = esolver2->p_c_time;
esolver->p_i_time = esolver2->p_i_time;
}
if (A->my_rank==0)
{
#ifdef _LONG__LONG
if( output ) printf("Arnoldi: mode number = %lld\n", i);
#else
if( output ) printf("Arnoldi: mode number = %d\n", i);
#endif
#ifdef _LONG__DOUBLE
if( output ) printf("Arnoldi: eigenvalue = %Le\n", esolver->evalue[i]);
#else
if( output ) printf("Arnoldi: eigenvalue = %e\n", esolver->evalue[i]);
#endif
#ifdef _LONG__LONG
if( output ) printf("Arnoldi: number of iterations = %lld\n",esolver2->iter[0]);
#else
if( output ) printf("Arnoldi: number of iterations = %d\n",esolver2->iter[0]);
#endif
#ifdef _LONG__DOUBLE
if( output ) printf("Arnoldi: relative residual = %Le\n\n",esolver2->resid[0]);
#else
if( output ) printf("Arnoldi: relative residual = %e\n\n",esolver2->resid[0]);
#endif
}
}
esolver->evalue[0] = evalue0;
esolver->iter[0] = iter0;
esolver->resid[0] = resid0;
lis_vector_copy(esolver->evector[0], esolver->x);
lis_esolver_destroy(esolver2);
lis_free(h);
lis_free(hq);
lis_free(hr);
lis_solver_destroy(solver);
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
