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;
}
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;
}
}
}
// 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;
}
