// COMPUTES L2 FIXED-SHIFT H POLYNOMIALS AND TESTS FOR CONVERGENCE.
// INITIATES A VARIABLE-SHIFT ITERATION AND RETURNS WITH THE
// APPROXIMATE ZERO IF SUCCESSFUL.
// L2 - LIMIT OF FIXED SHIFT STEPS
// ZR,ZI - APPROXIMATE ZERO IF CONV IS .TRUE.
// CONV - LOGICAL INDICATING CONVERGENCE OF STAGE 3 ITERATION
//
static bool fxshft(const int l2, int deg, xcomplex *P, xcomplex *p, xcomplex *H, xcomplex *h, xcomplex *zero, xcomplex *s){
bool bol, conv; // boolean for convergence of stage 2
bool test, pasd;
xcomplex old_T, old_S, Ps, t;
xcomplex Tmp[deg+1];
Ps = polyev(deg, *s, P, p);
test = true;
pasd = false;
// Calculate first T = -P(S)/H(S)
t = calct(&bol, deg, Ps, H, h, *s);
// Main loop for second stage
for(int j = 1; j <= l2; j++){
old_T = t;
// Compute the next H Polynomial and new t
nexth(bol, deg, t, H, h, p);
t = calct(&bol, deg, Ps, H, h, *s);
*zero = *s + t;
// Test for convergence unless stage 3 has failed once or this
// is the last H Polynomial
if(!(bol || !test || j == l2)){
if(xabs(t - old_T) < 0.5 * xabs(*zero)) {
if(pasd) {
// The weak convergence test has been passwed twice, start the third stage
// Iteration, after saving the current H polynomial and shift
for(int i = 0; i < deg; i++)
Tmp[i] = H[i];
old_S = *s;
conv = vrshft(10, deg, P, p, H, h, zero, s);
if(conv) return conv;
//The iteration failed to converge. Turn off testing and restore h,s,pv and T
test = false;
for(int i = 0; i < deg; i++)
H[i] = Tmp[i];
*s = old_S;
Ps = polyev(deg, *s, P, p);
t = calct(&bol, deg, Ps, H, h, *s);
continue;
}
pasd = true;
}
else
pasd = false;
}
}
// Attempt an iteration with final H polynomial from second stage
conv = vrshft(10, deg, P, p, H, h, zero, s);
return conv;
}
// COMPUTES T = -P(S)/H(S).
// BOOL - LOGICAL, SET TRUE IF H(S) IS ESSENTIALLY ZERO.
//
static xcomplex calct(bool *bol, int deg, xcomplex Ps, xcomplex *H, xcomplex *h, xcomplex s){
xcomplex Hs;
Hs = polyev(deg-1, s, H, h);
*bol = xnorm(Hs) <= xeta(H[deg-1])*xeta(H[deg-1]) * 10*10 * xnorm(H[deg-1]);
if(!*bol)
return -Ps / Hs;
else
return xdata.ZERO;
}
void CPoly<T>::calct( int *bol )
{
int n;
T hvr, hvi;
n = nn;
// evaluate h(s)
polyev( n - 1, sr, si, hr, hi, qhr, qhi, &hvr, &hvi );
*bol = cmod( hvr, hvi ) <= are * 10 * cmod( hr[ n - 1 ], hi[ n - 1 ] ) ? 1 : 0;
if( !*bol )
{
cdivid( -pvr, -pvi, hvr, hvi, &tr, &ti );
return;
}
tr = 0;
ti = 0;
}
static int calct(void)
/* Computes t = -p(s)/h(s)
Returns TRUE if h(s) is essentially zero
*/
{
double hvr,hvi;
int n = nn-1, boolvar;
/* Evaluate h(s) */
polyev(n,sr,si,hr,hi,qhr,qhi,&hvr,&hvi);
boolvar = (cmod(hvr,hvi) <= are*10.0*cmod(hr[n-1],hi[n-1]));
if (!boolvar) {
cdivid(-pvr,-pvi,hvr,hvi,&tr,&ti);
} else {
tr = 0.0;
ti = 0.0;
}
return boolvar;
}
void CPoly<T>::vrshft( const int l3, T *zr, T *zi, int *conv )
{
int b, bol;
int i, j;
T mp, ms, omp, relstp, r1, r2, tp;
*conv = 0;
b = 0;
sr = *zr;
si = *zi;
// Main loop for stage three
for( i = 1; i <= l3; i++ )
{
// Evaluate P at S and test for convergence
polyev( nn, sr, si, pr, pi, qpr, qpi, &pvr, &pvi );
mp = cmod( pvr, pvi );
ms = cmod( sr, si );
if( mp <= 20 * errev( nn, qpr, qpi, ms, mp, are, mre ) )
{
// Polynomial value is smaller in value than a bound onthe error
// in evaluationg P, terminate the ietartion
*conv = 1;
*zr = sr;
*zi = si;
return;
}
if( i != 1 )
{
if( !( b || mp < omp || relstp >= 0.05 ) )
{
// Iteration has stalled. Probably a cluster of zeros. Do 5 fixed
// shift steps into the cluster to force one zero to dominate
tp = relstp;
b = 1;
if( relstp < eta ) tp = eta;
r1 = sqrt( tp );
r2 = sr * ( 1 + r1 ) - si * r1;
si = sr * r1 + si * ( 1 + r1 );
sr = r2;
polyev( nn, sr, si, pr, pi, qpr, qpi, &pvr, &pvi );
for( j = 1; j <= 5; j++ )
{
calct( &bol );
nexth( bol );
}
omp = infin;
goto _20;
}
// Exit if polynomial value increase significantly
if( mp *0.1 > omp ) return;
}
omp = mp;
// Calculate next iterate
_20: calct( &bol );
nexth( bol );
calct( &bol );
if( !bol )
{
relstp = cmod( tr, ti ) / cmod( sr, si );
sr += tr;
si += ti;
}
}
}
void CPoly<T>::fxshft( const int l2, T *zr, T *zi, int *conv )
{
int i, j, n;
int test, pasd, bol;
T otr, oti, svsr, svsi;
n = nn;
polyev( nn, sr, si, pr, pi, qpr, qpi, &pvr, &pvi );
test = 1;
pasd = 0;
// Calculate first T = -P(S)/H(S)
calct( &bol );
// Main loop for second stage
for( j = 1; j <= l2; j++ )
{
otr = tr;
oti = ti;
// Compute the next H Polynomial and new t
nexth( bol );
calct( &bol );
*zr = sr + tr;
*zi = si + ti;
// Test for convergence unless stage 3 has failed once or this
// is the last H Polynomial
if( !( bol || !test || j == 12 ) )
{
if( cmod( tr - otr, ti - oti ) < 0.5 * cmod( *zr, *zi ) )
{
if( pasd )
{
// The weak convergence test has been passed twice, start the third stage
// Iteration, after saving the current H polynomial and shift
for( i = 0; i < n; i++ )
{
shr[ i ] = hr[ i ];
shi[ i ] = hi[ i ];
}
svsr = sr;
svsi = si;
vrshft( 10, zr, zi, conv );
if( *conv ) return;
//The iteration failed to converge. Turn off testing and restore h,s,pv and T
test = 0;
for( i = 0; i < n; i++ )
{
hr[ i ] = shr[ i ];
hi[ i ] = shi[ i ];
}
sr = svsr;
si = svsi;
polyev( nn, sr, si, pr, pi, qpr, qpi, &pvr, &pvi );
calct( &bol );
continue;
}
pasd = 1;
}
else
pasd = 0;
}
}
// Attempt an iteration with final H polynomial from second stage
vrshft( 10, zr, zi, conv );
}
static int vrshft(int l3, double *zr, double *zi)
/* Carries out the third stage iteration
l3 - Limit of steps in stage 3
zr,zi - On entry contains the initial iterate,
On exit, it contains the final iterate (if it converges).
conv - TRUE if iteration converges
*/
{
double mp,ms,omp,relstp,r1,r2,tp;
int i,j,conv,b,boolvar;
conv = FALSE;
b = FALSE;
sr = *zr;
si = *zi;
/* Main loop for stage three */
for (i=0; i<l3;i++) {
/* Evaluate p at s and test for convergence */
polyev(nn,sr,si,pr,pi,qpr,qpi,&pvr,&pvi);
mp = cmod(pvr,pvi);
ms = cmod(sr,si);
if (mp <= 20.0L*errev(nn,qpr,qpi,ms,mp)) {
/* Polynomial value is smaller in value than a bound on the error
in evaluating p, terminate the iteration */
conv = TRUE;
*zr = sr;
*zi = si;
return conv;
} else {
if (i!=0) {
if (!b && mp>=omp && relstp < .05L) {
/* Iteration has stalled, probably a cluster of zeros
Do 5 fixed shift steps into the cluster to force one zero
to dominate */
b = TRUE;
if (relstp < eta)
tp = eta;
else
tp = relstp;
r1 = sqrt(tp);
r2 = sr*(1.0L+r1)-si*r1;
si = sr*r1+si*(1.0L+r1);
sr = r2;
polyev(nn,sr,si,pr,pi,qpr,qpi,&pvr,&pvi);
for (j=0;j<5;j++) {
boolvar = calct();
nexth(boolvar);
}
omp = infin;
} else {
/* Exit if polynomial value increases significantly */
if (mp*0.1L > omp)
return conv;
omp = mp;
}
} else {
omp = mp;
}
}
/* Calculate next iterate. */
boolvar = calct();
nexth(boolvar);
boolvar = calct();
if (!boolvar) {
relstp = cmod(tr,ti)/cmod(sr,si);
sr += tr;
si += ti;
}
}
return conv;
}
static int fxshft(int l2, double *zr, double *zi)
/* Computes l2 fixed-shift h polynomials and tests for convergence
Initiates a variable-shift iteration and returns with the
approximate zero if successful.
l2 - Limit of fixed shift steps
zr,zi - Approximate zero if conv is .true.
conv - Flag indicating convergence of stage 3 iteration
*/
{
double otr,oti,svsr,svsi;
int conv,test,pasd,boolvar;
int i,j,n = nn-1;
/* Evaluate p at s */
polyev(nn,sr,si,pr,pi,qpr,qpi,&pvr,&pvi);
test = TRUE;
pasd = FALSE;
/* Calculate first t = -p(s)/h(s) */
boolvar = calct();
/* Main loop for one second stage step */
for (j=0;j<l2;j++) {
otr = tr;
oti = ti;
/* Compute next h polynomial and new t */
nexth(boolvar);
boolvar = calct();
*zr = sr+tr;
*zi = si+ti;
/* Test for convergence unless stage 3 has failed once or
this is the last h polynomial */
if (!boolvar && test && j != l2) {
if (cmod(tr-otr,ti-oti) < .5*cmod(*zr,*zi)) {
if (pasd) {
/* The weak convergence test has been passed twice, start the
third stage iteration, after saving the current h polynomial
and shift */
for (i=0;i<n;i++) {
shr[i] = hr[i];
shi[i] = hi[i];
}
svsr = sr;
svsi = si;
conv = vrshft(10,zr,zi);
if (conv)
return conv;
/* The iteration failed to converge
Turn off testing and restore h,s,pv and t */
test = FALSE;
for (i=0;i<n;i++) {
hr[i] = shr[i];
hi[i] = shi[i];
}
sr = svsr;
si = svsi;
polyev(nn,sr,si,pr,pi,qpr,qpi,&pvr,&pvi);
boolvar = calct();
} else {
pasd = TRUE;
}
}
} else {
pasd = FALSE;
}
}
/* Attempt an iteration with final h polynomial from second stage */
conv = vrshft(10,zr,zi);
return conv;
}
// CARRIES OUT THE THIRD STAGE ITERATION.
// L3 - LIMIT OF STEPS IN STAGE 3.
// ZR,ZI - ON ENTRY CONTAINS THE INITIAL ITERATE, IF THE
// ITERATION CONVERGES IT CONTAINS THE FINAL ITERATE ON EXIT.
// CONV - .TRUE. IF ITERATION CONVERGES
//
static bool vrshft(const int l3, int deg, xcomplex *P, xcomplex *p, xcomplex *H, xcomplex *h, xcomplex *zero, xcomplex *s){
bool bol, conv, b;
int i, j;
xcomplex Ps, t;
xreal mp, ms, omp = 0.0, relstp = 0.0, tp;
conv = b = false;
*s = *zero;
// Main loop for stage three
for(i = 1; i <= l3; i++) {
// Evaluate P at S and test for convergence
Ps = polyev(deg, *s, P, p);
mp = xabs(Ps);
ms = xabs(*s);
if(mp <= 20 * errev(deg, p, ms, mp)) {
// Polynomial value is smaller in value than a bound on the error
// in evaluating P, terminate the iteration
conv = true;
*zero = *s;
return conv;
}
if(i != 1) {
if(!(b || mp < omp || relstp >= 0.05)){
// if(!(b || xlogb(mp) < omp || real(relstp) >= 0.05)){
// Iteration has stalled. Probably a cluster of zeros. Do 5 fixed
// shift steps into the cluster to force one zero to dominate
tp = relstp;
b = true;
if(relstp < xeta(P[0])) tp = xeta(P[0]);
*s *= 1.0 + (1.0+1.0i)*sqrt(tp);
Ps = polyev(deg, *s, P, p);
for(j = 1; j <= 5; j++){
t = calct(&bol, deg, Ps, H, h, *s);
nexth(bol, deg, t, H, h, p);
}
omp = xdata.INFIN;
goto _20;
}
// Exit if polynomial value increase significantly
if(mp * 0.1 > omp) return conv;
}
omp = mp;
// Calculate next iterate
_20: t = calct(&bol, deg, Ps, H, h, *s);
nexth(bol, deg, t, H, h, p);
t = calct(&bol, deg, Ps, H, h, *s);
if(!bol) {
relstp = xabs(t) / xabs(*s);
*s += t;
}
} // end for
return conv;
}
