2016-01-02 14:51:32 +00:00
/*************************************************************************************
Grid physics library , www . github . com / paboyle / Grid
Source file : . / lib / algorithms / iterative / ImplicitlyRestartedLanczos . h
Copyright ( C ) 2015
Author : Peter Boyle < paboyle @ ph . ed . ac . uk >
Author : paboyle < paboyle @ ph . ed . ac . uk >
This program is free software ; you can redistribute it and / or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation ; either version 2 of the License , or
( at your option ) any later version .
This program is distributed in the hope that it will be useful ,
but WITHOUT ANY WARRANTY ; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE . See the
GNU General Public License for more details .
You should have received a copy of the GNU General Public License along
with this program ; if not , write to the Free Software Foundation , Inc . ,
51 Franklin Street , Fifth Floor , Boston , MA 02110 - 1301 USA .
See the full license in the file " LICENSE " in the top level distribution directory
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
/* END LEGAL */
2015-09-23 13:23:45 +01:00
# ifndef GRID_IRL_H
# define GRID_IRL_H
2016-01-11 16:36:45 +00:00
# include <string.h> //memset
2016-02-20 07:50:32 +00:00
# ifdef USE_LAPACK
# include <lapacke.h>
# endif
2015-10-08 23:40:25 +01:00
# include <algorithms/iterative/DenseMatrix.h>
# include <algorithms/iterative/EigenSort.h>
2015-09-23 13:23:45 +01:00
namespace Grid {
2015-10-08 23:40:25 +01:00
/////////////////////////////////////////////////////////////
// Implicitly restarted lanczos
/////////////////////////////////////////////////////////////
2015-09-23 13:23:45 +01:00
2015-10-08 23:40:25 +01:00
template < class Field >
2015-09-23 13:23:45 +01:00
class ImplicitlyRestartedLanczos {
2015-10-08 23:40:25 +01:00
const RealD small = 1.0e-16 ;
public :
int lock ;
2015-11-29 00:32:45 +00:00
int get ;
2015-09-23 13:23:45 +01:00
int Niter ;
2015-11-29 00:32:45 +00:00
int converged ;
2015-10-08 23:40:25 +01:00
2016-01-11 16:36:45 +00:00
int Nstop ; // Number of evecs checked for convergence
2015-10-08 23:40:25 +01:00
int Nk ; // Number of converged sought
int Np ; // Np -- Number of spare vecs in kryloc space
int Nm ; // Nm -- total number of vectors
RealD eresid ;
SortEigen < Field > _sort ;
2016-02-20 07:50:32 +00:00
// GridCartesian &_fgrid;
2016-01-11 16:36:45 +00:00
2015-09-23 13:23:45 +01:00
LinearOperatorBase < Field > & _Linop ;
2015-10-08 23:40:25 +01:00
2015-09-23 13:23:45 +01:00
OperatorFunction < Field > & _poly ;
2015-10-08 23:40:25 +01:00
/////////////////////////
// Constructor
/////////////////////////
void init ( void ) { } ;
void Abort ( int ff , DenseVector < RealD > & evals , DenseVector < DenseVector < RealD > > & evecs ) ;
2016-02-20 07:50:32 +00:00
ImplicitlyRestartedLanczos (
LinearOperatorBase < Field > & Linop , // op
2015-10-08 23:40:25 +01:00
OperatorFunction < Field > & poly , // polynmial
2016-01-11 16:36:45 +00:00
int _Nstop , // sought vecs
2015-10-08 23:40:25 +01:00
int _Nk , // sought vecs
int _Nm , // spare vecs
RealD _eresid , // resid in lmdue deficit
int _Niter ) : // Max iterations
_Linop ( Linop ) ,
2015-09-23 13:23:45 +01:00
_poly ( poly ) ,
2016-01-11 16:36:45 +00:00
Nstop ( _Nstop ) ,
2015-09-23 13:23:45 +01:00
Nk ( _Nk ) ,
2015-10-08 23:40:25 +01:00
Nm ( _Nm ) ,
eresid ( _eresid ) ,
Niter ( _Niter )
2015-09-23 13:23:45 +01:00
{
2015-10-08 23:40:25 +01:00
Np = Nm - Nk ; assert ( Np > 0 ) ;
2015-09-23 13:23:45 +01:00
} ;
2016-02-20 07:50:32 +00:00
ImplicitlyRestartedLanczos (
LinearOperatorBase < Field > & Linop , // op
OperatorFunction < Field > & poly , // polynmial
int _Nk , // sought vecs
int _Nm , // spare vecs
RealD _eresid , // resid in lmdue deficit
int _Niter ) : // Max iterations
_Linop ( Linop ) ,
_poly ( poly ) ,
Nstop ( _Nk ) ,
Nk ( _Nk ) ,
Nm ( _Nm ) ,
eresid ( _eresid ) ,
Niter ( _Niter )
{
Np = Nm - Nk ; assert ( Np > 0 ) ;
} ;
2015-10-08 23:40:25 +01:00
/////////////////////////
// Sanity checked this routine (step) against Saad.
/////////////////////////
void RitzMatrix ( DenseVector < Field > & evec , int k ) {
2015-11-29 00:32:45 +00:00
2015-10-08 23:40:25 +01:00
if ( 1 ) return ;
GridBase * grid = evec [ 0 ] . _grid ;
Field w ( grid ) ;
std : : cout < < " RitzMatrix " < < std : : endl ;
for ( int i = 0 ; i < k ; i + + ) {
_poly ( _Linop , evec [ i ] , w ) ;
std : : cout < < " [ " < < i < < " ] " ;
for ( int j = 0 ; j < k ; j + + ) {
ComplexD in = innerProduct ( evec [ j ] , w ) ;
if ( fabs ( ( double ) i - j ) > 1 ) {
if ( abs ( in ) > 1.0e-9 ) {
std : : cout < < " oops " < < std : : endl ;
abort ( ) ;
} else
std : : cout < < " 0 " ;
} else {
std : : cout < < " " < < in < < " " ;
}
}
std : : cout < < std : : endl ;
}
}
2015-09-23 13:23:45 +01:00
2015-10-08 23:40:25 +01:00
/* Saad PP. 195
1. Choose an initial vector v1 of 2 - norm unity . Set β 1 ≡ 0 , v0 ≡ 0
2. For k = 1 , 2 , . . . , m Do :
3. wk : = Avk − β kv_ { k − 1 }
4. α k : = ( wk , vk ) //
5. wk : = wk − α kvk // wk orthog vk
6. β k + 1 : = ∥ wk ∥ 2. If β k + 1 = 0 then Stop
7. vk + 1 : = wk / β k + 1
8. EndDo
*/
void step ( DenseVector < RealD > & lmd ,
DenseVector < RealD > & lme ,
DenseVector < Field > & evec ,
Field & w , int Nm , int k )
2015-09-23 13:23:45 +01:00
{
assert ( k < Nm ) ;
2015-10-08 23:40:25 +01:00
_poly ( _Linop , evec [ k ] , w ) ; // 3. wk:=Avk− βkv_{k− 1}
if ( k > 0 ) {
w - = lme [ k - 1 ] * evec [ k - 1 ] ;
}
2015-09-23 13:23:45 +01:00
2015-10-08 23:40:25 +01:00
ComplexD zalph = innerProduct ( evec [ k ] , w ) ; // 4. α k:=(wk,vk)
RealD alph = real ( zalph ) ;
2015-09-23 13:23:45 +01:00
2015-10-08 23:40:25 +01:00
w = w - alph * evec [ k ] ; // 5. wk:=wk− α kvk
2015-09-23 13:23:45 +01:00
2015-10-08 23:40:25 +01:00
RealD beta = normalise ( w ) ; // 6. βk+1 := ∥wk∥2. If βk+1 = 0 then Stop
// 7. vk+1 := wk/βk+1
2015-09-23 13:23:45 +01:00
2016-01-11 16:36:45 +00:00
// std::cout << "alpha = " << zalph << " beta "<<beta<<std::endl;
2015-10-08 23:40:25 +01:00
const RealD tiny = 1.0e-20 ;
if ( beta < tiny ) {
std : : cout < < " beta is tiny " < < beta < < std : : endl ;
2016-01-11 16:36:45 +00:00
}
2015-10-08 23:40:25 +01:00
lmd [ k ] = alph ;
lme [ k ] = beta ;
2015-09-23 13:23:45 +01:00
2015-10-08 23:40:25 +01:00
if ( k > 0 ) {
orthogonalize ( w , evec , k ) ; // orthonormalise
2015-09-23 13:23:45 +01:00
}
2015-10-08 23:40:25 +01:00
if ( k < Nm - 1 ) evec [ k + 1 ] = w ;
2015-09-23 13:23:45 +01:00
}
2015-10-08 23:40:25 +01:00
void qr_decomp ( DenseVector < RealD > & lmd ,
DenseVector < RealD > & lme ,
2015-09-23 13:23:45 +01:00
int Nk ,
int Nm ,
2015-10-08 23:40:25 +01:00
DenseVector < RealD > & Qt ,
RealD Dsh ,
2015-09-23 13:23:45 +01:00
int kmin ,
int kmax )
{
int k = kmin - 1 ;
RealD x ;
2015-10-08 23:40:25 +01:00
RealD Fden = 1.0 / hypot ( lmd [ k ] - Dsh , lme [ k ] ) ;
2015-09-23 13:23:45 +01:00
RealD c = ( lmd [ k ] - Dsh ) * Fden ;
RealD s = - lme [ k ] * Fden ;
RealD tmpa1 = lmd [ k ] ;
RealD tmpa2 = lmd [ k + 1 ] ;
RealD tmpb = lme [ k ] ;
lmd [ k ] = c * c * tmpa1 + s * s * tmpa2 - 2.0 * c * s * tmpb ;
lmd [ k + 1 ] = s * s * tmpa1 + c * c * tmpa2 + 2.0 * c * s * tmpb ;
lme [ k ] = c * s * ( tmpa1 - tmpa2 ) + ( c * c - s * s ) * tmpb ;
2015-10-08 23:40:25 +01:00
x = - s * lme [ k + 1 ] ;
2015-09-23 13:23:45 +01:00
lme [ k + 1 ] = c * lme [ k + 1 ] ;
for ( int i = 0 ; i < Nk ; + + i ) {
RealD Qtmp1 = Qt [ i + Nm * k ] ;
RealD Qtmp2 = Qt [ i + Nm * ( k + 1 ) ] ;
Qt [ i + Nm * k ] = c * Qtmp1 - s * Qtmp2 ;
Qt [ i + Nm * ( k + 1 ) ] = s * Qtmp1 + c * Qtmp2 ;
}
// Givens transformations
for ( int k = kmin ; k < kmax - 1 ; + + k ) {
2015-10-08 23:40:25 +01:00
RealD Fden = 1.0 / hypot ( x , lme [ k - 1 ] ) ;
2015-09-23 13:23:45 +01:00
RealD c = lme [ k - 1 ] * Fden ;
RealD s = - x * Fden ;
RealD tmpa1 = lmd [ k ] ;
RealD tmpa2 = lmd [ k + 1 ] ;
RealD tmpb = lme [ k ] ;
lmd [ k ] = c * c * tmpa1 + s * s * tmpa2 - 2.0 * c * s * tmpb ;
lmd [ k + 1 ] = s * s * tmpa1 + c * c * tmpa2 + 2.0 * c * s * tmpb ;
lme [ k ] = c * s * ( tmpa1 - tmpa2 ) + ( c * c - s * s ) * tmpb ;
lme [ k - 1 ] = c * lme [ k - 1 ] - s * x ;
if ( k ! = kmax - 2 ) {
x = - s * lme [ k + 1 ] ;
lme [ k + 1 ] = c * lme [ k + 1 ] ;
}
for ( int i = 0 ; i < Nk ; + + i ) {
RealD Qtmp1 = Qt [ i + Nm * k ] ;
RealD Qtmp2 = Qt [ i + Nm * ( k + 1 ) ] ;
Qt [ i + Nm * k ] = c * Qtmp1 - s * Qtmp2 ;
Qt [ i + Nm * ( k + 1 ) ] = s * Qtmp1 + c * Qtmp2 ;
}
}
}
2016-02-20 07:50:32 +00:00
# ifdef USE_LAPACK
2016-01-11 16:36:45 +00:00
void diagonalize_lapack ( DenseVector < RealD > & lmd ,
DenseVector < RealD > & lme ,
2016-02-20 07:50:32 +00:00
int N1 ,
int N2 ,
DenseVector < RealD > & Qt ,
GridBase * grid ) {
2016-01-11 16:36:45 +00:00
const int size = Nm ;
// tevals.resize(size);
// tevecs.resize(size);
2016-02-20 07:50:32 +00:00
int NN = N1 ;
2016-01-11 16:36:45 +00:00
double evals_tmp [ NN ] ;
double evec_tmp [ NN ] [ NN ] ;
memset ( evec_tmp [ 0 ] , 0 , sizeof ( double ) * NN * NN ) ;
2016-01-25 06:26:25 +00:00
// double AA[NN][NN];
2016-01-11 16:36:45 +00:00
double DD [ NN ] ;
double EE [ NN ] ;
for ( int i = 0 ; i < NN ; i + + )
for ( int j = i - 1 ; j < = i + 1 ; j + + )
if ( j < NN & & j > = 0 ) {
if ( i = = j ) DD [ i ] = lmd [ i ] ;
if ( i = = j ) evals_tmp [ i ] = lmd [ i ] ;
if ( j = = ( i - 1 ) ) EE [ j ] = lme [ j ] ;
}
int evals_found ;
int lwork = ( ( 18 * NN ) > ( 1 + 4 * NN + NN * NN ) ? ( 18 * NN ) : ( 1 + 4 * NN + NN * NN ) ) ;
int liwork = 3 + NN * 10 ;
int iwork [ liwork ] ;
double work [ lwork ] ;
int isuppz [ 2 * NN ] ;
char jobz = ' V ' ; // calculate evals & evecs
char range = ' I ' ; // calculate all evals
// char range = 'A'; // calculate all evals
char uplo = ' U ' ; // refer to upper half of original matrix
char compz = ' I ' ; // Compute eigenvectors of tridiagonal matrix
int ifail [ NN ] ;
int info ;
// int total = QMP_get_number_of_nodes();
// int node = QMP_get_node_number();
2016-02-20 07:50:32 +00:00
// GridBase *grid = evec[0]._grid;
int total = grid - > _Nprocessors ;
int node = grid - > _processor ;
2016-01-11 16:36:45 +00:00
int interval = ( NN / total ) + 1 ;
double vl = 0.0 , vu = 0.0 ;
int il = interval * node + 1 , iu = interval * ( node + 1 ) ;
if ( iu > NN ) iu = NN ;
double tol = 0.0 ;
if ( 1 ) {
memset ( evals_tmp , 0 , sizeof ( double ) * NN ) ;
if ( il < = NN ) {
printf ( " total=%d node=%d il=%d iu=%d \n " , total , node , il , iu ) ;
LAPACK_dstegr ( & jobz , & range , & NN ,
( double * ) DD , ( double * ) EE ,
& vl , & vu , & il , & iu , // these four are ignored if second parameteris 'A'
& tol , // tolerance
& evals_found , evals_tmp , ( double * ) evec_tmp , & NN ,
isuppz ,
work , & lwork , iwork , & liwork ,
& info ) ;
for ( int i = iu - 1 ; i > = il - 1 ; i - - ) {
printf ( " node=%d evals_found=%d evals_tmp[%d] = %g \n " , node , evals_found , i - ( il - 1 ) , evals_tmp [ i - ( il - 1 ) ] ) ;
evals_tmp [ i ] = evals_tmp [ i - ( il - 1 ) ] ;
if ( il > 1 ) evals_tmp [ i - ( il - 1 ) ] = 0. ;
for ( int j = 0 ; j < NN ; j + + ) {
evec_tmp [ i ] [ j ] = evec_tmp [ i - ( il - 1 ) ] [ j ] ;
if ( il > 1 ) evec_tmp [ i - ( il - 1 ) ] [ j ] = 0. ;
}
}
}
{
// QMP_sum_double_array(evals_tmp,NN);
// QMP_sum_double_array((double *)evec_tmp,NN*NN);
2016-02-20 07:50:32 +00:00
grid - > GlobalSumVector ( evals_tmp , NN ) ;
grid - > GlobalSumVector ( ( double * ) evec_tmp , NN * NN ) ;
2016-01-11 16:36:45 +00:00
}
}
2016-02-20 07:50:32 +00:00
// cheating a bit. It is better to sort instead of just reversing it, but the document of the routine says evals are sorted in increasing order. qr gives evals in decreasing order.
2016-01-11 16:36:45 +00:00
for ( int i = 0 ; i < NN ; i + + ) {
for ( int j = 0 ; j < NN ; j + + )
2016-02-20 07:50:32 +00:00
Qt [ ( NN - 1 - i ) * N2 + j ] = evec_tmp [ i ] [ j ] ;
lmd [ NN - 1 - i ] = evals_tmp [ i ] ;
2016-01-11 16:36:45 +00:00
}
}
2016-02-20 07:50:32 +00:00
# endif
2016-01-11 16:36:45 +00:00
2015-10-08 23:40:25 +01:00
void diagonalize ( DenseVector < RealD > & lmd ,
DenseVector < RealD > & lme ,
2016-02-20 07:50:32 +00:00
int N2 ,
int N1 ,
DenseVector < RealD > & Qt ,
GridBase * grid )
2015-09-23 13:23:45 +01:00
{
2016-01-11 16:36:45 +00:00
2016-02-20 07:50:32 +00:00
# ifdef USE_LAPACK
const int check_lapack = 0 ; // just use lapack if 0, check against lapack if 1
if ( ! check_lapack )
return diagonalize_lapack ( lmd , lme , N2 , N1 , Qt , grid ) ;
DenseVector < RealD > lmd2 ( N1 ) ;
DenseVector < RealD > lme2 ( N1 ) ;
DenseVector < RealD > Qt2 ( N1 * N1 ) ;
for ( int k = 0 ; k < N1 ; + + k ) {
2016-01-11 16:36:45 +00:00
lmd2 [ k ] = lmd [ k ] ;
lme2 [ k ] = lme [ k ] ;
}
2016-02-20 07:50:32 +00:00
for ( int k = 0 ; k < N1 * N1 ; + + k )
Qt2 [ k ] = Qt [ k ] ;
2016-01-11 16:36:45 +00:00
2016-02-20 07:50:32 +00:00
// diagonalize_lapack(lmd2,lme2,Nm2,Nm,Qt,grid);
# endif
2016-01-11 16:36:45 +00:00
2016-02-20 07:50:32 +00:00
int Niter = 100 * N1 ;
2015-09-23 13:23:45 +01:00
int kmin = 1 ;
2016-02-20 07:50:32 +00:00
int kmax = N2 ;
2015-09-23 13:23:45 +01:00
// (this should be more sophisticated)
for ( int iter = 0 ; iter < Niter ; + + iter ) {
// determination of 2x2 leading submatrix
RealD dsub = lmd [ kmax - 1 ] - lmd [ kmax - 2 ] ;
RealD dd = sqrt ( dsub * dsub + 4.0 * lme [ kmax - 2 ] * lme [ kmax - 2 ] ) ;
RealD Dsh = 0.5 * ( lmd [ kmax - 2 ] + lmd [ kmax - 1 ] + dd * ( dsub / fabs ( dsub ) ) ) ;
// (Dsh: shift)
// transformation
2016-02-20 07:50:32 +00:00
qr_decomp ( lmd , lme , N2 , N1 , Qt , Dsh , kmin , kmax ) ;
2015-09-23 13:23:45 +01:00
// Convergence criterion (redef of kmin and kamx)
for ( int j = kmax - 1 ; j > = kmin ; - - j ) {
RealD dds = fabs ( lmd [ j - 1 ] ) + fabs ( lmd [ j ] ) ;
if ( fabs ( lme [ j - 1 ] ) + dds > dds ) {
kmax = j + 1 ;
goto continued ;
}
}
Niter = iter ;
2016-02-20 07:50:32 +00:00
# ifdef USE_LAPACK
if ( check_lapack ) {
const double SMALL = 1e-8 ;
diagonalize_lapack ( lmd2 , lme2 , N2 , N1 , Qt2 , grid ) ;
DenseVector < RealD > lmd3 ( N2 ) ;
for ( int k = 0 ; k < N2 ; + + k ) lmd3 [ k ] = lmd [ k ] ;
_sort . push ( lmd3 , N2 ) ;
_sort . push ( lmd2 , N2 ) ;
for ( int k = 0 ; k < N2 ; + + k ) {
if ( fabs ( lmd2 [ k ] - lmd3 [ k ] ) > SMALL ) std : : cout < < " lmd(qr) lmd(lapack) " < < k < < " : " < < lmd2 [ k ] < < " " < < lmd3 [ k ] < < std : : endl ;
// if (fabs(lme2[k] - lme[k]) >SMALL) std::cout <<"lme(qr)-lme(lapack) "<< k << ": " << lme2[k] - lme[k] <<std::endl;
}
for ( int k = 0 ; k < N1 * N1 ; + + k ) {
// if (fabs(Qt2[k] - Qt[k]) >SMALL) std::cout <<"Qt(qr)-Qt(lapack) "<< k << ": " << Qt2[k] - Qt[k] <<std::endl;
}
}
# endif
2015-09-23 13:23:45 +01:00
return ;
continued :
for ( int j = 0 ; j < kmax - 1 ; + + j ) {
RealD dds = fabs ( lmd [ j ] ) + fabs ( lmd [ j + 1 ] ) ;
if ( fabs ( lme [ j ] ) + dds > dds ) {
kmin = j + 1 ;
break ;
}
}
}
std : : cout < < " [QL method] Error - Too many iteration: " < < Niter < < " \n " ;
abort ( ) ;
}
2016-02-20 07:50:32 +00:00
# if 1
2015-10-08 23:40:25 +01:00
static RealD normalise ( Field & v )
{
RealD nn = norm2 ( v ) ;
nn = sqrt ( nn ) ;
v = v * ( 1.0 / nn ) ;
return nn ;
}
2015-09-23 13:23:45 +01:00
void orthogonalize ( Field & w ,
2015-10-08 23:40:25 +01:00
DenseVector < Field > & evec ,
2015-09-23 13:23:45 +01:00
int k )
{
2015-10-08 23:40:25 +01:00
typedef typename Field : : scalar_type MyComplex ;
MyComplex ip ;
if ( 0 ) {
for ( int j = 0 ; j < k ; + + j ) {
normalise ( evec [ j ] ) ;
for ( int i = 0 ; i < j ; i + + ) {
ip = innerProduct ( evec [ i ] , evec [ j ] ) ; // are the evecs normalised? ; this assumes so.
evec [ j ] = evec [ j ] - ip * evec [ i ] ;
}
}
}
2015-09-23 13:23:45 +01:00
for ( int j = 0 ; j < k ; + + j ) {
2015-10-08 23:40:25 +01:00
ip = innerProduct ( evec [ j ] , w ) ; // are the evecs normalised? ; this assumes so.
w = w - ip * evec [ j ] ;
2015-09-23 13:23:45 +01:00
}
2015-10-08 23:40:25 +01:00
normalise ( w ) ;
2015-09-23 13:23:45 +01:00
}
2015-10-08 23:40:25 +01:00
void setUnit_Qt ( int Nm , DenseVector < RealD > & Qt ) {
for ( int i = 0 ; i < Qt . size ( ) ; + + i ) Qt [ i ] = 0.0 ;
for ( int k = 0 ; k < Nm ; + + k ) Qt [ k + k * Nm ] = 1.0 ;
}
/* Rudy Arthur's thesis pp.137
- - - - - - - - - - - - - - - - - - - - - - - -
Require : M > K P = M − K †
Compute the factorization AVM = VM HM + fM eM
repeat
Q = I
for i = 1 , . . . , P do
QiRi = HM − θ iI Q = QQi
H M = Q † i H M Q i
end for
β K = HM ( K + 1 , K ) σ K = Q ( M , K )
r = vK + 1 β K + rσ K
VK = VM ( 1 : M ) Q ( 1 : M , 1 : K )
HK = HM ( 1 : K , 1 : K )
→ AVK = VKHK + fKe † K † Extend to an M = K + P step factorization AVM = VMHM + fMeM
until convergence
*/
void calc ( DenseVector < RealD > & eval ,
DenseVector < Field > & evec ,
const Field & src ,
2015-09-23 13:23:45 +01:00
int & Nconv )
{
2015-10-08 23:40:25 +01:00
GridBase * grid = evec [ 0 ] . _grid ;
2016-02-20 07:50:32 +00:00
assert ( grid = = src . _grid ) ;
2015-10-08 23:40:25 +01:00
std : : cout < < " -- Nk = " < < Nk < < " Np = " < < Np < < std : : endl ;
std : : cout < < " -- Nm = " < < Nm < < std : : endl ;
std : : cout < < " -- size of eval = " < < eval . size ( ) < < std : : endl ;
std : : cout < < " -- size of evec = " < < evec . size ( ) < < std : : endl ;
2015-09-23 13:23:45 +01:00
2015-10-08 23:40:25 +01:00
assert ( Nm = = evec . size ( ) & & Nm = = eval . size ( ) ) ;
2015-09-23 13:23:45 +01:00
2015-10-08 23:40:25 +01:00
DenseVector < RealD > lme ( Nm ) ;
DenseVector < RealD > lme2 ( Nm ) ;
DenseVector < RealD > eval2 ( Nm ) ;
DenseVector < RealD > Qt ( Nm * Nm ) ;
DenseVector < int > Iconv ( Nm ) ;
DenseVector < Field > B ( Nm , grid ) ; // waste of space replicating
2015-09-23 13:23:45 +01:00
2015-10-08 23:40:25 +01:00
Field f ( grid ) ;
Field v ( grid ) ;
2015-09-23 13:23:45 +01:00
int k1 = 1 ;
2015-10-08 23:40:25 +01:00
int k2 = Nk ;
Nconv = 0 ;
2015-09-23 13:23:45 +01:00
RealD beta_k ;
// Set initial vector
2015-10-08 23:40:25 +01:00
// (uniform vector) Why not src??
// evec[0] = 1.0;
evec [ 0 ] = src ;
2016-02-20 07:50:32 +00:00
std : : cout < < " norm2(src)= " < < norm2 ( src ) < < std : : endl ;
// << src._grid << std::endl;
2015-10-08 23:40:25 +01:00
normalise ( evec [ 0 ] ) ;
2016-02-20 07:50:32 +00:00
std : : cout < < " norm2(evec[0])= " < < norm2 ( evec [ 0 ] ) < < std : : endl ;
// << evec[0]._grid << std::endl;
2015-09-23 13:23:45 +01:00
// Initial Nk steps
2015-10-08 23:40:25 +01:00
for ( int k = 0 ; k < Nk ; + + k ) step ( eval , lme , evec , f , Nm , k ) ;
2016-01-11 16:36:45 +00:00
// std:: cout <<"norm2(evec[1])= " << norm2(evec[1]) << std::endl;
// std:: cout <<"norm2(evec[2])= " << norm2(evec[2]) << std::endl;
2015-10-08 23:40:25 +01:00
RitzMatrix ( evec , Nk ) ;
2016-01-11 16:36:45 +00:00
for ( int k = 0 ; k < Nk ; + + k ) {
// std:: cout <<"eval " << k << " " <<eval[k] << std::endl;
// std:: cout <<"lme " << k << " " << lme[k] << std::endl;
}
2015-10-08 23:40:25 +01:00
2015-09-23 13:23:45 +01:00
// Restarting loop begins
2015-10-08 23:40:25 +01:00
for ( int iter = 0 ; iter < Niter ; + + iter ) {
2015-09-23 13:23:45 +01:00
2015-10-08 23:40:25 +01:00
std : : cout < < " \n Restart iteration = " < < iter < < std : : endl ;
//
// Rudy does a sort first which looks very different. Getting fed up with sorting out the algo defs.
// We loop over
//
for ( int k = Nk ; k < Nm ; + + k ) step ( eval , lme , evec , f , Nm , k ) ;
2015-09-23 13:23:45 +01:00
f * = lme [ Nm - 1 ] ;
2015-10-08 23:40:25 +01:00
RitzMatrix ( evec , k2 ) ;
2015-09-23 13:23:45 +01:00
// getting eigenvalues
2015-10-08 23:40:25 +01:00
for ( int k = 0 ; k < Nm ; + + k ) {
eval2 [ k ] = eval [ k + k1 - 1 ] ;
2015-09-23 13:23:45 +01:00
lme2 [ k ] = lme [ k + k1 - 1 ] ;
}
setUnit_Qt ( Nm , Qt ) ;
2016-02-20 07:50:32 +00:00
diagonalize ( eval2 , lme2 , Nm , Nm , Qt , grid ) ;
2015-10-08 23:40:25 +01:00
2015-09-23 13:23:45 +01:00
// sorting
2015-10-08 23:40:25 +01:00
_sort . push ( eval2 , Nm ) ;
2015-09-23 13:23:45 +01:00
// Implicitly shifted QR transformations
setUnit_Qt ( Nm , Qt ) ;
2016-01-11 16:36:45 +00:00
for ( int ip = k2 ; ip < Nm ; + + ip ) {
std : : cout < < " qr_decomp " < < ip < < " " < < eval2 [ ip ] < < std : : endl ;
2015-10-08 23:40:25 +01:00
qr_decomp ( eval , lme , Nm , Nm , Qt , eval2 [ ip ] , k1 , Nm ) ;
2016-01-11 16:36:45 +00:00
}
2015-09-23 13:23:45 +01:00
2015-10-08 23:40:25 +01:00
for ( int i = 0 ; i < ( Nk + 1 ) ; + + i ) B [ i ] = 0.0 ;
2015-09-23 13:23:45 +01:00
for ( int j = k1 - 1 ; j < k2 + 1 ; + + j ) {
for ( int k = 0 ; k < Nm ; + + k ) {
B [ j ] + = Qt [ k + Nm * j ] * evec [ k ] ;
}
}
for ( int j = k1 - 1 ; j < k2 + 1 ; + + j ) evec [ j ] = B [ j ] ;
// Compressed vector f and beta(k2)
f * = Qt [ Nm - 1 + Nm * ( k2 - 1 ) ] ;
f + = lme [ k2 - 1 ] * evec [ k2 ] ;
2015-10-08 23:40:25 +01:00
beta_k = norm2 ( f ) ;
2015-09-23 13:23:45 +01:00
beta_k = sqrt ( beta_k ) ;
2015-10-08 23:40:25 +01:00
std : : cout < < " beta(k) = " < < beta_k < < std : : endl ;
2015-09-23 13:23:45 +01:00
RealD betar = 1.0 / beta_k ;
evec [ k2 ] = betar * f ;
lme [ k2 - 1 ] = beta_k ;
// Convergence test
2015-10-08 23:40:25 +01:00
for ( int k = 0 ; k < Nm ; + + k ) {
eval2 [ k ] = eval [ k ] ;
2015-09-23 13:23:45 +01:00
lme2 [ k ] = lme [ k ] ;
}
setUnit_Qt ( Nm , Qt ) ;
2016-02-20 07:50:32 +00:00
diagonalize ( eval2 , lme2 , Nk , Nm , Qt , grid ) ;
2015-09-23 13:23:45 +01:00
2015-10-08 23:40:25 +01:00
for ( int k = 0 ; k < Nk ; + + k ) B [ k ] = 0.0 ;
2015-09-23 13:23:45 +01:00
2015-10-08 23:40:25 +01:00
for ( int j = 0 ; j < Nk ; + + j ) {
for ( int k = 0 ; k < Nk ; + + k ) {
2015-09-23 13:23:45 +01:00
B [ j ] + = Qt [ k + j * Nm ] * evec [ k ] ;
}
2016-02-20 07:50:32 +00:00
// std::cout << "norm(B["<<j<<"])="<<norm2(B[j])<<std::endl;
2015-09-23 13:23:45 +01:00
}
2016-02-20 07:50:32 +00:00
// _sort.push(eval2,B,Nk);
2015-09-23 13:23:45 +01:00
2015-10-08 23:40:25 +01:00
Nconv = 0 ;
// std::cout << std::setiosflags(std::ios_base::scientific);
for ( int i = 0 ; i < Nk ; + + i ) {
2016-02-20 07:50:32 +00:00
// _poly(_Linop,B[i],v);
_Linop . HermOp ( B [ i ] , v ) ;
2015-09-23 13:23:45 +01:00
2015-10-08 23:40:25 +01:00
RealD vnum = real ( innerProduct ( B [ i ] , v ) ) ; // HermOp.
RealD vden = norm2 ( B [ i ] ) ;
eval2 [ i ] = vnum / vden ;
v - = eval2 [ i ] * B [ i ] ;
RealD vv = norm2 ( v ) ;
2015-09-23 13:23:45 +01:00
2016-02-20 07:50:32 +00:00
std : : cout . precision ( 13 ) ;
2015-10-08 23:40:25 +01:00
std : : cout < < " [ " < < std : : setw ( 3 ) < < std : : setiosflags ( std : : ios_base : : right ) < < i < < " ] " ;
std : : cout < < " eval = " < < std : : setw ( 25 ) < < std : : setiosflags ( std : : ios_base : : left ) < < eval2 [ i ] ;
std : : cout < < " |H B[i] - eval[i]B[i]|^2 " < < std : : setw ( 25 ) < < std : : setiosflags ( std : : ios_base : : right ) < < vv < < std : : endl ;
2015-09-23 13:23:45 +01:00
2016-02-20 07:50:32 +00:00
// change the criteria as evals are supposed to be sorted, all evals smaller(larger) than Nstop should have converged
if ( ( vv < eresid * eresid ) & & ( i = = Nconv ) ) {
2015-10-08 23:40:25 +01:00
Iconv [ Nconv ] = i ;
+ + Nconv ;
2015-09-23 13:23:45 +01:00
}
2015-10-08 23:40:25 +01:00
2015-09-23 13:23:45 +01:00
} // i-loop end
2015-10-08 23:40:25 +01:00
// std::cout << std::resetiosflags(std::ios_base::scientific);
2015-09-23 13:23:45 +01:00
2015-10-08 23:40:25 +01:00
std : : cout < < " #modes converged: " < < Nconv < < std : : endl ;
2015-09-23 13:23:45 +01:00
2016-01-11 16:36:45 +00:00
if ( Nconv > = Nstop ) {
2015-09-23 13:23:45 +01:00
goto converged ;
}
} // end of iter loop
std : : cout < < " \n NOT converged. \n " ;
abort ( ) ;
converged :
2016-03-30 08:16:02 +01:00
// Sorting
eval . resize ( Nconv ) ;
evec . resize ( Nconv , grid ) ;
for ( int i = 0 ; i < Nconv ; + + i ) {
eval [ i ] = eval2 [ Iconv [ i ] ] ;
evec [ i ] = B [ Iconv [ i ] ] ;
}
_sort . push ( eval , evec , Nconv ) ;
std : : cout < < " \n Converged \n Summary : \n " ;
std : : cout < < " -- Iterations = " < < Nconv < < " \n " ;
std : : cout < < " -- beta(k) = " < < beta_k < < " \n " ;
std : : cout < < " -- Nconv = " < < Nconv < < " \n " ;
}
2015-10-08 23:40:25 +01:00
2015-11-29 00:32:45 +00:00
/////////////////////////////////////////////////
2015-10-08 23:40:25 +01:00
// Adapted from Rudy's lanczos factor routine
2015-11-29 00:32:45 +00:00
/////////////////////////////////////////////////
2015-10-08 23:40:25 +01:00
int Lanczos_Factor ( int start , int end , int cont ,
DenseVector < Field > & bq ,
Field & bf ,
DenseMatrix < RealD > & H ) {
GridBase * grid = bq [ 0 ] . _grid ;
RealD beta ;
RealD sqbt ;
RealD alpha ;
for ( int i = start ; i < Nm ; i + + ) {
for ( int j = start ; j < Nm ; j + + ) {
H [ i ] [ j ] = 0.0 ;
}
}
std : : cout < < " Lanczos_Factor start/end " < < start < < " / " < < end < < std : : endl ;
// Starting from scratch, bq[0] contains a random vector and |bq[0]| = 1
int first ;
if ( start = = 0 ) {
std : : cout < < " start == 0 \n " ; //TESTING
_poly ( _Linop , bq [ 0 ] , bf ) ;
alpha = real ( innerProduct ( bq [ 0 ] , bf ) ) ; //alpha = bq[0]^dag A bq[0]
std : : cout < < " alpha = " < < alpha < < std : : endl ;
bf = bf - alpha * bq [ 0 ] ; //bf = A bq[0] - alpha bq[0]
H [ 0 ] [ 0 ] = alpha ;
std : : cout < < " Set H(0,0) to " < < H [ 0 ] [ 0 ] < < std : : endl ;
first = 1 ;
} else {
first = start ;
}
// I think start==0 and cont==zero are the same. Test this
// If so I can drop "cont" parameter?
if ( cont ) assert ( start ! = 0 ) ;
if ( start = = 0 ) assert ( cont ! = 0 ) ;
if ( cont ) {
beta = 0 ; sqbt = 0 ;
std : : cout < < " cont is true so setting beta to zero \n " ;
} else {
beta = norm2 ( bf ) ;
sqbt = sqrt ( beta ) ;
std : : cout < < " beta = " < < beta < < std : : endl ;
}
for ( int j = first ; j < end ; j + + ) {
std : : cout < < " Factor j " < < j < < std : : endl ;
if ( cont ) { // switches to factoring; understand start!=0 and initial bf value is right.
bq [ j ] = bf ; cont = false ;
} else {
bq [ j ] = ( 1.0 / sqbt ) * bf ;
H [ j ] [ j - 1 ] = H [ j - 1 ] [ j ] = sqbt ;
}
_poly ( _Linop , bq [ j ] , bf ) ;
bf = bf - ( 1.0 / sqbt ) * bq [ j - 1 ] ; //bf = A bq[j] - beta bq[j-1] // PAB this comment was incorrect in beta term??
alpha = real ( innerProduct ( bq [ j ] , bf ) ) ; //alpha = bq[j]^dag A bq[j]
bf = bf - alpha * bq [ j ] ; //bf = A bq[j] - beta bq[j-1] - alpha bq[j]
RealD fnorm = norm2 ( bf ) ;
RealD bck = sqrt ( real ( conjugate ( alpha ) * alpha ) + beta ) ;
beta = fnorm ;
sqbt = sqrt ( beta ) ;
std : : cout < < " alpha = " < < alpha < < " fnorm = " < < fnorm < < ' \n ' ;
///Iterative refinement of orthogonality V = [ bq[0] bq[1] ... bq[M] ]
int re = 0 ;
2015-11-29 00:32:45 +00:00
// FIXME undefined params; how set in Rudy's code
int ref = 0 ;
Real rho = 1.0e-8 ;
2015-10-08 23:40:25 +01:00
while ( re = = ref | | ( sqbt < rho * bck & & re < 5 ) ) {
2015-11-29 00:32:45 +00:00
Field tmp2 ( grid ) ;
Field tmp1 ( grid ) ;
2015-10-08 23:40:25 +01:00
//bex = V^dag bf
DenseVector < ComplexD > bex ( j + 1 ) ;
for ( int k = 0 ; k < j + 1 ; k + + ) {
bex [ k ] = innerProduct ( bq [ k ] , bf ) ;
}
zero_fermion ( tmp2 ) ;
//tmp2 = V s
for ( int l = 0 ; l < j + 1 ; l + + ) {
RealD nrm = norm2 ( bq [ l ] ) ;
axpy ( tmp1 , 0.0 , bq [ l ] , bq [ l ] ) ; scale ( tmp1 , bex [ l ] ) ; //tmp1 = V[j] bex[j]
axpy ( tmp2 , 1.0 , tmp2 , tmp1 ) ; //tmp2 += V[j] bex[j]
}
//bf = bf - V V^dag bf. Subtracting off any component in span { V[j] }
RealD btc = axpy_norm ( bf , - 1.0 , tmp2 , bf ) ;
2015-11-29 00:32:45 +00:00
alpha = alpha + real ( bex [ j ] ) ; sqbt = sqrt ( real ( btc ) ) ;
// FIXME is alpha real in RUDY's code?
2015-10-08 23:40:25 +01:00
RealD nmbex = 0 ; for ( int k = 0 ; k < j + 1 ; k + + ) { nmbex = nmbex + real ( conjugate ( bex [ k ] ) * bex [ k ] ) ; }
bck = sqrt ( nmbex ) ;
re + + ;
}
std : : cout < < " Iteratively refined orthogonality, changes alpha \n " ;
if ( re > 1 ) std : : cout < < " orthagonality refined " < < re < < " times " < < std : : endl ;
H [ j ] [ j ] = alpha ;
2015-09-23 13:23:45 +01:00
}
2015-10-08 23:40:25 +01:00
return end ;
}
void EigenSort ( DenseVector < double > evals ,
DenseVector < Field > evecs ) {
int N = evals . size ( ) ;
_sort . push ( evals , evecs , evals . size ( ) , N ) ;
}
void ImplicitRestart ( int TM , DenseVector < RealD > & evals , DenseVector < DenseVector < RealD > > & evecs , DenseVector < Field > & bq , Field & bf , int cont )
{
std : : cout < < " ImplicitRestart begin. Eigensort starting \n " ;
DenseMatrix < RealD > H ; Resize ( H , Nm , Nm ) ;
EigenSort ( evals , evecs ) ;
///Assign shifts
int K = Nk ;
int M = Nm ;
int P = Np ;
int converged = 0 ;
if ( K - converged < 4 ) P = ( M - K - 1 ) ; //one
// DenseVector<RealD> shifts(P + shift_extra.size());
DenseVector < RealD > shifts ( P ) ;
for ( int k = 0 ; k < P ; + + k )
shifts [ k ] = evals [ k ] ;
/// Shift to form a new H and q
DenseMatrix < RealD > Q ; Resize ( Q , TM , TM ) ;
Unity ( Q ) ;
Shift ( Q , shifts ) ; // H is implicitly passed in in Rudy's Shift routine
int ff = K ;
/// Shifted H defines a new K step Arnoldi factorization
RealD beta = H [ ff ] [ ff - 1 ] ;
RealD sig = Q [ TM - 1 ] [ ff - 1 ] ;
std : : cout < < " beta = " < < beta < < " sig = " < < real ( sig ) < < std : : endl ;
std : : cout < < " TM = " < < TM < < " " ;
std : : cout < < norm2 ( bq [ 0 ] ) < < " -- before " < < std : : endl ;
/// q -> q Q
times_real ( bq , Q , TM ) ;
std : : cout < < norm2 ( bq [ 0 ] ) < < " -- after " < < ff < < std : : endl ;
bf = beta * bq [ ff ] + sig * bf ;
/// Do the rest of the factorization
ff = Lanczos_Factor ( ff , M , cont , bq , bf , H ) ;
if ( ff < M )
Abort ( ff , evals , evecs ) ;
}
///Run the Eigensolver
void Run ( int cont , DenseVector < Field > & bq , Field & bf , DenseVector < DenseVector < RealD > > & evecs , DenseVector < RealD > & evals )
{
init ( ) ;
int M = Nm ;
DenseMatrix < RealD > H ; Resize ( H , Nm , Nm ) ;
2015-11-29 11:14:44 +00:00
Resize ( evals , Nm ) ;
2015-10-08 23:40:25 +01:00
Resize ( evecs , Nm ) ;
int ff = Lanczos_Factor ( 0 , M , cont , bq , bf , H ) ; // 0--M to begin with
if ( ff < M ) {
std : : cout < < " Krylov: aborting ff " < < ff < < " " < < M < < std : : endl ;
abort ( ) ; // Why would this happen?
}
int itcount = 0 ;
bool stop = false ;
for ( int it = 0 ; it < Niter & & ( converged < Nk ) ; + + it ) {
std : : cout < < " Krylov: Iteration --> " < < it < < std : : endl ;
int lock_num = lock ? converged : 0 ;
DenseVector < RealD > tevals ( M - lock_num ) ;
DenseMatrix < RealD > tevecs ; Resize ( tevecs , M - lock_num , M - lock_num ) ;
//check residual of polynominal
TestConv ( H , M , tevals , tevecs ) ;
if ( converged > = Nk )
break ;
ImplicitRestart ( ff , tevals , tevecs , H ) ;
}
Wilkinson < RealD > ( H , evals , evecs , small ) ;
// Check();
std : : cout < < " Done " < < std : : endl ;
}
///H - shift I = QR; H = Q* H Q
void Shift ( DenseMatrix < RealD > & H , DenseMatrix < RealD > & Q , DenseVector < RealD > shifts ) {
int P ; Size ( shifts , P ) ;
int M ; SizeSquare ( Q , M ) ;
Unity ( Q ) ;
int lock_num = lock ? converged : 0 ;
RealD t_Househoulder_vector ( 0.0 ) ;
RealD t_Househoulder_mult ( 0.0 ) ;
for ( int i = 0 ; i < P ; i + + ) {
RealD x , y , z ;
DenseVector < RealD > ck ( 3 ) , v ( 3 ) ;
x = H [ lock_num + 0 ] [ lock_num + 0 ] - shifts [ i ] ;
y = H [ lock_num + 1 ] [ lock_num + 0 ] ;
ck [ 0 ] = x ; ck [ 1 ] = y ; ck [ 2 ] = 0 ;
normalise ( ck ) ; ///Normalization cancels in PHP anyway
RealD beta ;
Householder_vector < RealD > ( ck , 0 , 2 , v , beta ) ;
Householder_mult < RealD > ( H , v , beta , 0 , lock_num + 0 , lock_num + 2 , 0 ) ;
Householder_mult < RealD > ( H , v , beta , 0 , lock_num + 0 , lock_num + 2 , 1 ) ;
///Accumulate eigenvector
Householder_mult < RealD > ( Q , v , beta , 0 , lock_num + 0 , lock_num + 2 , 1 ) ;
int sw = 0 ;
for ( int k = lock_num + 0 ; k < M - 2 ; k + + ) {
x = H [ k + 1 ] [ k ] ;
y = H [ k + 2 ] [ k ] ;
z = ( RealD ) 0.0 ;
if ( k + 3 < = M - 1 ) {
z = H [ k + 3 ] [ k ] ;
} else {
sw = 1 ; v [ 2 ] = 0.0 ;
}
ck [ 0 ] = x ; ck [ 1 ] = y ; ck [ 2 ] = z ;
normalise ( ck ) ;
Householder_vector < RealD > ( ck , 0 , 2 - sw , v , beta ) ;
Householder_mult < RealD > ( H , v , beta , 0 , k + 1 , k + 3 - sw , 0 ) ;
Householder_mult < RealD > ( H , v , beta , 0 , k + 1 , k + 3 - sw , 1 ) ;
///Accumulate eigenvector
Householder_mult < RealD > ( Q , v , beta , 0 , k + 1 , k + 3 - sw , 1 ) ;
}
}
}
void TestConv ( DenseMatrix < RealD > & H , int SS ,
DenseVector < Field > & bq , Field & bf ,
DenseVector < RealD > & tevals , DenseVector < DenseVector < RealD > > & tevecs ,
int lock , int converged )
{
std : : cout < < " Converged " < < converged < < " so far. " < < std : : endl ;
int lock_num = lock ? converged : 0 ;
int M = Nm ;
///Active Factorization
DenseMatrix < RealD > AH ; Resize ( AH , SS - lock_num , SS - lock_num ) ;
AH = GetSubMtx ( H , lock_num , SS , lock_num , SS ) ;
int NN = tevals . size ( ) ;
int AHsize = SS - lock_num ;
RealD small = 1.0e-16 ;
Wilkinson < RealD > ( AH , tevals , tevecs , small ) ;
EigenSort ( tevals , tevecs ) ;
RealD resid_nrm = norm2 ( bf ) ;
if ( ! lock ) converged = 0 ;
2015-11-29 11:14:44 +00:00
#if 0
2015-10-08 23:40:25 +01:00
for ( int i = SS - lock_num - 1 ; i > = SS - Nk & & i > = 0 ; - - i ) {
RealD diff = 0 ;
2015-11-29 11:14:44 +00:00
diff = abs ( tevecs [ i ] [ Nm - 1 - lock_num ] ) * resid_nrm ;
2015-10-08 23:40:25 +01:00
std : : cout < < " residual estimate " < < SS - 1 - i < < " " < < diff < < " of ( " < < tevals [ i ] < < " ) " < < std : : endl ;
if ( diff < converged ) {
if ( lock ) {
DenseMatrix < RealD > Q ; Resize ( Q , M , M ) ;
bool herm = true ;
Lock ( H , Q , tevals [ i ] , converged , small , SS , herm ) ;
times_real ( bq , Q , bq . size ( ) ) ;
bf = Q [ M - 1 ] [ M - 1 ] * bf ;
lock_num + + ;
}
converged + + ;
std : : cout < < " converged on eval " < < converged < < " of " < < Nk < < std : : endl ;
} else {
break ;
}
}
2015-11-29 11:14:44 +00:00
# endif
2015-10-08 23:40:25 +01:00
std : : cout < < " Got " < < converged < < " so far " < < std : : endl ;
}
2015-11-29 00:32:45 +00:00
2015-10-08 23:40:25 +01:00
///Check
2015-11-29 00:32:45 +00:00
void Check ( DenseVector < RealD > & evals ,
DenseVector < DenseVector < RealD > > & evecs ) {
DenseVector < RealD > goodval ( this - > get ) ;
2015-10-08 23:40:25 +01:00
EigenSort ( evals , evecs ) ;
int NM = Nm ;
2015-11-29 00:32:45 +00:00
DenseVector < DenseVector < RealD > > V ; Size ( V , NM ) ;
DenseVector < RealD > QZ ( NM * NM ) ;
2015-10-08 23:40:25 +01:00
for ( int i = 0 ; i < NM ; i + + ) {
for ( int j = 0 ; j < NM ; j + + ) {
2015-11-29 00:32:45 +00:00
// evecs[i][j];
2015-10-08 23:40:25 +01:00
}
}
}
/**
There is some matrix Q such that for any vector y
Q . e_1 = y and Q is unitary .
* */
template < class T >
static T orthQ ( DenseMatrix < T > & Q , DenseVector < T > y ) {
int N = y . size ( ) ; //Matrix Size
Fill ( Q , 0.0 ) ;
T tau ;
for ( int i = 0 ; i < N ; i + + ) {
Q [ i ] [ 0 ] = y [ i ] ;
}
T sig = conj ( y [ 0 ] ) * y [ 0 ] ;
T tau0 = abs ( sqrt ( sig ) ) ;
for ( int j = 1 ; j < N ; j + + ) {
sig + = conj ( y [ j ] ) * y [ j ] ;
tau = abs ( sqrt ( sig ) ) ;
if ( abs ( tau0 ) > 0.0 ) {
T gam = conj ( ( y [ j ] / tau ) / tau0 ) ;
for ( int k = 0 ; k < = j - 1 ; k + + ) {
Q [ k ] [ j ] = - gam * y [ k ] ;
}
Q [ j ] [ j ] = tau0 / tau ;
} else {
Q [ j - 1 ] [ j ] = 1.0 ;
}
tau0 = tau ;
}
return tau ;
}
/**
There is some matrix Q such that for any vector y
Q . e_k = y and Q is unitary .
* */
template < class T >
static T orthU ( DenseMatrix < T > & Q , DenseVector < T > y ) {
T tau = orthQ ( Q , y ) ;
SL ( Q ) ;
return tau ;
}
/**
Wind up with a matrix with the first con rows untouched
say con = 2
Q is such that Qdag H Q has { x , x , val , 0 , 0 , 0 , 0 , . . . } as 1 st colum
and the matrix is upper hessenberg
and with f and Q appropriately modidied with Q is the arnoldi factorization
* */
template < class T >
static void Lock ( DenseMatrix < T > & H , ///Hess mtx
DenseMatrix < T > & Q , ///Lock Transform
T val , ///value to be locked
int con , ///number already locked
RealD small ,
int dfg ,
bool herm )
{
//ForceTridiagonal(H);
int M = H . dim ;
DenseVector < T > vec ; Resize ( vec , M - con ) ;
DenseMatrix < T > AH ; Resize ( AH , M - con , M - con ) ;
AH = GetSubMtx ( H , con , M , con , M ) ;
DenseMatrix < T > QQ ; Resize ( QQ , M - con , M - con ) ;
Unity ( Q ) ; Unity ( QQ ) ;
DenseVector < T > evals ; Resize ( evals , M - con ) ;
DenseMatrix < T > evecs ; Resize ( evecs , M - con , M - con ) ;
Wilkinson < T > ( AH , evals , evecs , small ) ;
int k = 0 ;
RealD cold = abs ( val - evals [ k ] ) ;
for ( int i = 1 ; i < M - con ; i + + ) {
RealD cnew = abs ( val - evals [ i ] ) ;
if ( cnew < cold ) { k = i ; cold = cnew ; }
}
vec = evecs [ k ] ;
ComplexD tau ;
orthQ ( QQ , vec ) ;
//orthQM(QQ,AH,vec);
AH = Hermitian ( QQ ) * AH ;
AH = AH * QQ ;
for ( int i = con ; i < M ; i + + ) {
for ( int j = con ; j < M ; j + + ) {
Q [ i ] [ j ] = QQ [ i - con ] [ j - con ] ;
H [ i ] [ j ] = AH [ i - con ] [ j - con ] ;
}
}
for ( int j = M - 1 ; j > con + 2 ; j - - ) {
DenseMatrix < T > U ; Resize ( U , j - 1 - con , j - 1 - con ) ;
DenseVector < T > z ; Resize ( z , j - 1 - con ) ;
T nm = norm ( z ) ;
for ( int k = con + 0 ; k < j - 1 ; k + + ) {
z [ k - con ] = conj ( H ( j , k + 1 ) ) ;
}
normalise ( z ) ;
RealD tmp = 0 ;
for ( int i = 0 ; i < z . size ( ) - 1 ; i + + ) { tmp = tmp + abs ( z [ i ] ) ; }
if ( tmp < small / ( ( RealD ) z . size ( ) - 1.0 ) ) { continue ; }
tau = orthU ( U , z ) ;
DenseMatrix < T > Hb ; Resize ( Hb , j - 1 - con , M ) ;
for ( int a = 0 ; a < M ; a + + ) {
for ( int b = 0 ; b < j - 1 - con ; b + + ) {
T sum = 0 ;
for ( int c = 0 ; c < j - 1 - con ; c + + ) {
sum + = H [ a ] [ con + 1 + c ] * U [ c ] [ b ] ;
} //sum += H(a,con+1+c)*U(c,b);}
Hb [ b ] [ a ] = sum ;
}
}
for ( int k = con + 1 ; k < j ; k + + ) {
for ( int l = 0 ; l < M ; l + + ) {
H [ l ] [ k ] = Hb [ k - 1 - con ] [ l ] ;
}
} //H(Hb[k-1-con][l] , l,k);}}
DenseMatrix < T > Qb ; Resize ( Qb , M , M ) ;
for ( int a = 0 ; a < M ; a + + ) {
for ( int b = 0 ; b < j - 1 - con ; b + + ) {
T sum = 0 ;
for ( int c = 0 ; c < j - 1 - con ; c + + ) {
sum + = Q [ a ] [ con + 1 + c ] * U [ c ] [ b ] ;
} //sum += Q(a,con+1+c)*U(c,b);}
Qb [ b ] [ a ] = sum ;
}
}
for ( int k = con + 1 ; k < j ; k + + ) {
for ( int l = 0 ; l < M ; l + + ) {
Q [ l ] [ k ] = Qb [ k - 1 - con ] [ l ] ;
}
} //Q(Qb[k-1-con][l] , l,k);}}
DenseMatrix < T > Hc ; Resize ( Hc , M , M ) ;
for ( int a = 0 ; a < j - 1 - con ; a + + ) {
for ( int b = 0 ; b < M ; b + + ) {
T sum = 0 ;
for ( int c = 0 ; c < j - 1 - con ; c + + ) {
sum + = conj ( U [ c ] [ a ] ) * H [ con + 1 + c ] [ b ] ;
} //sum += conj( U(c,a) )*H(con+1+c,b);}
Hc [ b ] [ a ] = sum ;
}
}
for ( int k = 0 ; k < M ; k + + ) {
for ( int l = con + 1 ; l < j ; l + + ) {
H [ l ] [ k ] = Hc [ k ] [ l - 1 - con ] ;
}
} //H(Hc[k][l-1-con] , l,k);}}
}
}
2016-02-20 07:50:32 +00:00
# endif
2015-10-08 23:40:25 +01:00
} ;
2015-09-23 13:23:45 +01:00
}
# endif
2015-11-29 00:32:45 +00:00