/* zQsolve -- solves Qx = b, Q is an orthogonal matrix stored in compact
form a la QRfactor()
-- may be in-situ */
ZVEC *_zQsolve(ZMAT* QR, ZVEC* diag, ZVEC* b, ZVEC *x, ZVEC *tmp)
{
unsigned int dynamic;
int k, limit;
Real beta, r_ii, tmp_val;
limit = min(QR->m,QR->n);
dynamic = FALSE;
if ( ! QR || ! diag || ! b )
error(E_NULL,"_zQsolve");
if ( diag->dim < limit || b->dim != QR->m )
error(E_SIZES,"_zQsolve");
x = zv_resize(x,QR->m);
if ( tmp == ZVNULL )
dynamic = TRUE;
tmp = zv_resize(tmp,QR->m);
/* apply H/holder transforms in normal order */
x = zv_copy(b,x);
for ( k = 0 ; k < limit ; k++ )
{
zget_col(QR,k,tmp);
r_ii = zabs(tmp->ve[k]);
tmp->ve[k] = diag->ve[k];
tmp_val = (r_ii*zabs(diag->ve[k]));
beta = ( tmp_val == 0.0 ) ? 0.0 : 1.0/tmp_val;
/* hhtrvec(tmp,beta->ve[k],k,x,x); */
zhhtrvec(tmp,beta,k,x,x);
}
if ( dynamic )
ZV_FREE(tmp);
return (x);
}
void RenderMobs(void) {
Uint8 i, c;
for (i = 0; i < 128; i++)
if (mob[i][0] > 0)
if (zabs(mob[i][4] - cursorx) < 7 * 65536)
if (zabs(mob[i][5] - cursory) < 5 * 65536) {
zlpushmatrix();
zltranslate(mob[i][4], mob[i][6], -mob[i][5]);
zlrotatey(-mob[i][7]);
MobModel(i);
zlpopmatrix();
}
}
/* zmakeQ -- constructs orthogonal matrix from Householder vectors stored in
compact QR form */
ZMAT *zmakeQ(ZMAT *QR, ZVEC *diag, ZMAT *Qout)
{
STATIC ZVEC *tmp1=ZVNULL,*tmp2=ZVNULL;
unsigned int i, limit;
Real beta, r_ii, tmp_val;
int j;
limit = min(QR->m,QR->n);
if ( ! QR || ! diag )
error(E_NULL,"zmakeQ");
if ( diag->dim < limit )
error(E_SIZES,"zmakeQ");
Qout = zm_resize(Qout,QR->m,QR->m);
tmp1 = zv_resize(tmp1,QR->m); /* contains basis vec & columns of Q */
tmp2 = zv_resize(tmp2,QR->m); /* contains H/holder vectors */
MEM_STAT_REG(tmp1,TYPE_ZVEC);
MEM_STAT_REG(tmp2,TYPE_ZVEC);
for ( i=0; i<QR->m ; i++ )
{ /* get i-th column of Q */
/* set up tmp1 as i-th basis vector */
for ( j=0; j<QR->m ; j++ )
tmp1->ve[j].re = tmp1->ve[j].im = 0.0;
tmp1->ve[i].re = 1.0;
/* apply H/h transforms in reverse order */
for ( j=limit-1; j>=0; j-- )
{
zget_col(QR,j,tmp2);
r_ii = zabs(tmp2->ve[j]);
tmp2->ve[j] = diag->ve[j];
tmp_val = (r_ii*zabs(diag->ve[j]));
beta = ( tmp_val == 0.0 ) ? 0.0 : 1.0/tmp_val;
/* hhtrvec(tmp2,beta->ve[j],j,tmp1,tmp1); */
zhhtrvec(tmp2,beta,j,tmp1,tmp1);
}
/* insert into Q */
zset_col(Qout,i,tmp1);
}
#ifdef THREADSAFE
ZV_FREE(tmp1); ZV_FREE(tmp2);
#endif
return (Qout);
}
/* zQRAsolve -- solves the system (Q.R)*.x = b
-- Q & R are stored in compact form
-- returns x, which is created if necessary */
ZVEC *zQRAsolve(ZMAT *QR, ZVEC *diag, ZVEC *b, ZVEC *x)
{
int j, limit;
Real beta, r_ii, tmp_val;
STATIC ZVEC *tmp = ZVNULL;
if ( ! QR || ! diag || ! b )
error(E_NULL,"zQRAsolve");
limit = min(QR->m,QR->n);
if ( diag->dim < limit || b->dim != QR->n )
error(E_SIZES,"zQRAsolve");
x = zv_resize(x,QR->m);
x = zUAsolve(QR,b,x,0.0);
x = zv_resize(x,QR->m);
tmp = zv_resize(tmp,x->dim);
MEM_STAT_REG(tmp,TYPE_ZVEC);
/* printf("zQRAsolve: tmp->dim = %d, x->dim = %d\n", tmp->dim, x->dim); */
/* apply H/h transforms in reverse order */
for ( j=limit-1; j>=0; j-- )
{
zget_col(QR,j,tmp);
tmp = zv_resize(tmp,QR->m);
r_ii = zabs(tmp->ve[j]);
tmp->ve[j] = diag->ve[j];
tmp_val = (r_ii*zabs(diag->ve[j]));
beta = ( tmp_val == 0.0 ) ? 0.0 : 1.0/tmp_val;
zhhtrvec(tmp,beta,j,x,x);
}
#ifdef THREADSAFE
ZV_FREE(tmp);
#endif
return x;
}
void RED(long k, long l, long n,
verylong *zd, verylong **zb,
verylong **zh, verylong **zl)
{
long i;
verylong zq = 0, zr = 0, zs = 0, zt = 0;
zlshift(zl[k][l], 1l, &zr);
zcopy(zr, &zs);
zabs(&zs);
if (zcompare(zs, zd[l]) > 0) {
zadd(zr, zd[l], &zs);
zlshift(zd[l], 1l, &zr);
zdiv(zs, zr, &zq, &zt);
for (i = 1; i <= n; i++) {
zmul(zq, zh[i][l], &zr);
zsub(zh[i][k], zr, &zs);
zcopy(zs, &zh[i][k]);
zmul(zq, zb[l][i], &zr);
zsub(zb[k][i], zr, &zs);
zcopy(zs, &zb[k][i]);
}
zmul(zq, zd[l], &zr);
zsub(zl[k][l], zr, &zs);
zcopy(zs, &zl[k][l]);
for (i = 1; i <= l - 1; i++) {
zmul(zq, zl[l][i], &zr);
zsub(zl[k][i], zr, &zs);
zcopy(zs, &zl[k][i]);
}
}
zfree(&zq);
zfree(&zr);
zfree(&zs);
zfree(&zt);
}
void MobAi(void) {
Uint8 i, c, slowed;
Sint32 aix, aiy, cx, cy, speed, de, x0, y0, x1, y1, ii, x, y, tx, ty, rx,
ry, r, damage;
for (i = 0; i < 128; i++)
if (mob[i][0] > 0) {
aix = mob[i][4] / 65536 / 2;
aiy = mob[i][5] / 65536 / 2;
cx = mob[i][4] / 65536;
cy = mob[i][5] / 65536;
if (aimap[aix][aiy] == 0) { //BASE DAMAGE
mob[i][0] = 0;
for (ii = 0; ii < 76800; ii++)
screen_buffering[ii] = 4;
zl_vibro = 125;
PlaySound(1, 0);
lives--;
if (lives == 0) {
PlayMusic(0);
NextGameMode = 4;
}
}
de = (dirmap[aix][aiy] * 1024 - mob[i][7]);
if (de > 2048)
de = -4096 + de;
else if (de < -2048)
de = 4096 + de;
mob[i][7] += de / 8;
speed = mob[i][3];
slowed = 0;
damage = 0;
//TOOOOOOOOOOWERZ
x0 = cx - 5;
x1 = cx + 5;
y0 = cy - 5;
y1 = cy + 5;
if (x0 < 0)
x0 = 0;
if (x1 > 63)
x1 = 63;
if (y0 < 0)
y0 = 0;
if (y1 > 63)
y1 = 63;
for (y = y0; y < y1; y++)
for (x = x0; x < x1; x++) {
c = map[x][y];
if (c > 11)
if (c < 17) {
c = c - 12;
rx = zabs(x - cx);
ry = zabs(y - cy);
if (rx > ry)
r = rx;
else
r = ry;
if (r < rangetower[c])
switch (c) {
case 0: //minigun
if (count - turret0[x][y] > 10) {
turret0[x][y] = count;
tx = x * 65536 + 32768;
ty = y * 65536 + 32768;
rx = mob[i][4] - tx;
ry = mob[i][5] - ty;
newvline[0] = 4;
newvline[1] = 14;
newvline[2] = mob[i][4];
newvline[3] = mob[i][6];
newvline[4] = mob[i][5];
newvline[5] = tx;
newvline[6] = 30000;
newvline[7] = ty;
newvline[8] = 0;
newvline[9] = 0;
newvline[10] = 0;
newvline[11] = rx / 7;
newvline[12] = 0;
newvline[13] = ry / 7;
SpawnLine();
damage += 1;
}
break;
case 1: //antiair
if (count - turret0[x][y] > 20)
if (mob[i][6] > 5000) {
turret0[x][y] = count;
tx = x * 65536 + 32768;
ty = y * 65536 + 32768;
rx = mob[i][4] - tx;
ry = mob[i][5] - ty;
newvline[0] = 4;
newvline[1] = 14;
newvline[2] = mob[i][4];
newvline[3] = mob[i][6];
newvline[4] = mob[i][5];
newvline[5] = tx;
newvline[6] = 30000;
newvline[7] = ty;
newvline[8] = rx / 6;
newvline[9] = 0;
newvline[10] = ry / 6;
newvline[11] = rx / 7;
newvline[12] = 0;
newvline[13] = ry / 7;
SpawnLine();
damage += 5;
}
break;
case 2: //altilery
if (count - turret0[x][y] > 50)
if (mob[i][6] < 5000) {
turret0[x][y] = count;
tx = x * 65536 + 32768;
ty = y * 65536 + 32768;
rx = mob[i][4] - tx;
ry = mob[i][5] - ty;
newvline[0] = 4;
newvline[1] = 14;
newvline[2] = mob[i][4];
newvline[3] = mob[i][6];
newvline[4] = mob[i][5];
newvline[5] = tx;
newvline[6] = 30000;
newvline[7] = ty;
newvline[8] = 0;
newvline[9] = 0;
newvline[10] = 0;
newvline[11] = rx / 7;
newvline[12] = 0;
newvline[13] = ry / 7;
SpawnLine();
newvline[0] = 5;
newvline[1] = 14;
newvline[2] = mob[i][4] - 10000;
newvline[3] = mob[i][6];
newvline[4] = mob[i][5];
newvline[5] = mob[i][4];
newvline[6] = mob[i][6];
newvline[7] = mob[i][5] - 10000;
newvline[8] = -20000;
newvline[9] = 0;
newvline[10] = 0;
newvline[11] = 0;
newvline[12] = 4000;
newvline[13] = -10000;
SpawnLine();
newvline[0] = 5;
newvline[1] = 14;
newvline[2] = mob[i][4] + 10000;
newvline[3] = mob[i][6];
newvline[4] = mob[i][5];
newvline[5] = mob[i][4];
newvline[6] = mob[i][6];
newvline[7] = mob[i][5] - 10000;
newvline[8] = 20000;
newvline[9] = 0;
newvline[10] = 0;
newvline[11] = 0;
newvline[12] = 4000;
newvline[13] = -10000;
SpawnLine();
newvline[0] = 5;
newvline[1] = 14;
newvline[2] = mob[i][4] - 10000;
newvline[3] = mob[i][6];
newvline[4] = mob[i][5];
newvline[5] = mob[i][4];
newvline[6] = mob[i][6];
newvline[7] = mob[i][5] + 10000;
newvline[8] = -20000;
newvline[9] = 0;
newvline[10] = 0;
newvline[11] = 0;
newvline[12] = 4000;
newvline[13] = 10000;
SpawnLine();
newvline[0] = 5;
newvline[1] = 14;
newvline[2] = mob[i][4] + 10000;
newvline[3] = mob[i][6];
newvline[4] = mob[i][5];
newvline[5] = mob[i][4];
newvline[6] = mob[i][6];
newvline[7] = mob[i][5] + 10000;
newvline[8] = 20000;
newvline[9] = 0;
newvline[10] = 0;
newvline[11] = 0;
newvline[12] = 4000;
newvline[13] = 10000;
SpawnLine();
damage += 10;
}
break;
case 3: //slow
tx = x * 65536 + 32768;
ty = y * 65536 + 32768;
newvline[0] = 1;
newvline[1] = 5;
newvline[2] = mob[i][4];
newvline[3] = mob[i][6];
newvline[4] = mob[i][5];
newvline[5] = tx;
newvline[6] = 30000;
newvline[7] = ty;
newvline[8] = 0;
newvline[9] = 0;
newvline[10] = 0;
newvline[11] = 0;
newvline[12] = 0;
newvline[13] = 0;
SpawnLine();
slowed = 1;
break;
case 4: //sniper
if (count - turret0[x][y] > 80) {
turret0[x][y] = count;
tx = x * 65536 + 32768;
ty = y * 65536 + 32768;
rx = mob[i][4] - tx;
ry = mob[i][5] - ty;
newvline[0] = 4;
newvline[1] = 15;
newvline[2] = mob[i][4];
newvline[3] = mob[i][6];
newvline[4] = mob[i][5];
newvline[5] = tx;
newvline[6] = 80000;
newvline[7] = ty;
newvline[8] = 0;
newvline[9] = 0;
newvline[10] = 0;
newvline[11] = rx / 7;
newvline[12] = 0;
newvline[13] = ry / 7;
SpawnLine();
damage += 30;
}
break;
} //switch
}
}
if (damage) {
mob[i][10] = 1;
mob[i][0] -= damage;
if (mob[i][0] <= 0) {
mob[i][0] = 0;
funds += iwavedata[wave][5];
//DIEEEEEEEEEE
zl_vibro = 125;
newvline[0] = 20;
newvline[1] = mob[i][1];
newvline[2] = mob[i][4] - 32768;
newvline[3] = mob[i][6];
newvline[4] = mob[i][5];
newvline[5] = mob[i][4];
newvline[6] = mob[i][6];
newvline[7] = mob[i][5] + 32768;
newvline[8] = -8000;
newvline[9] = 2000;
newvline[10] = 000;
newvline[11] = 000;
newvline[12] = 2000;
newvline[13] = 8000;
SpawnLine();
newvline[0] = 20;
newvline[1] = mob[i][1];
newvline[2] = mob[i][4] + 32768;
newvline[3] = mob[i][6];
newvline[4] = mob[i][5];
newvline[5] = mob[i][4];
newvline[6] = mob[i][6];
newvline[7] = mob[i][5] + 32768;
newvline[8] = +8000;
newvline[9] = 2000;
newvline[10] = 000;
newvline[11] = 000;
newvline[12] = 2000;
newvline[13] = 8000;
SpawnLine();
newvline[0] = 20;
newvline[1] = mob[i][1];
newvline[2] = mob[i][4] - 32768;
newvline[3] = mob[i][6];
newvline[4] = mob[i][5];
newvline[5] = mob[i][4];
newvline[6] = mob[i][6];
newvline[7] = mob[i][5] - 32768;
newvline[8] = -8000;
newvline[9] = 2000;
newvline[10] = 000;
newvline[11] = 000;
newvline[12] = 2000;
newvline[13] = -8000;
SpawnLine();
newvline[0] = 20;
newvline[1] = mob[i][1];
newvline[2] = mob[i][4] + 32768;
newvline[3] = mob[i][6];
newvline[4] = mob[i][5];
newvline[5] = mob[i][4];
newvline[6] = mob[i][6];
newvline[7] = mob[i][5] - 32768;
newvline[8] = +8000;
newvline[9] = 2000;
newvline[10] = 000;
newvline[11] = 000;
newvline[12] = 2000;
newvline[13] = -8000;
SpawnLine();
//DIEEEEEEEEE end
}
}
if (slowed)
speed = speed / 2;
//TOOOOOOOOOOWERZ end
switch (dirmap[aix][aiy]) {
case 0:
mob[i][5] -= speed;
mob[i][4] = mob[i][4]
+ (((cx & 254) + 1) * 65536 - mob[i][4]) / 6;
break;
case 1:
mob[i][4] += speed;
mob[i][5] = mob[i][5]
+ (((cy & 254) + 1) * 65536 - mob[i][5]) / 6;
break;
case 2:
mob[i][5] += speed;
mob[i][4] = mob[i][4]
+ (((cx & 254) + 1) * 65536 - mob[i][4]) / 6;
break;
case 3:
mob[i][4] -= speed;
mob[i][5] = mob[i][5]
+ (((cy & 254) + 1) * 65536 - mob[i][5]) / 6;
break;
} //switch
}
}
int
ztfqmrl (
int n_matrixSize,
int type,
int symmetryflag,
InpMtx *mtxA,
FrontMtx *Precond,
DenseMtx *mtxX,
DenseMtx *mtxB,
int itermax,
double convergetol,
int msglvl,
FILE *msgFile
)
{
Chv *chv, *rootchv ;
ChvManager *chvmanager ;
DenseMtx *vecD, *vecR, *vecT, *vecU1, *vecU2, *vecV, *vecW;
DenseMtx *vecX, *vecY1, *vecY2 ;
double Alpha[2], Beta[2], Cee, Eta[2], Rho[2], Rho_new[2] ;
double Sigma[2], Tau, Theta, Rtmp[2], Ttmp[2];
double Init_norm, ratio, Res_norm;
double error_trol, m;
double t1, t2, cpus[9] ;
double one[2] = {1.0, 0.0}, zero[2] = {0.0, 0.0} ;
double Tiny = 0.1e-28;
int Iter, Imv, neqns;
int stats[6] ;
neqns = n_matrixSize;
/*
--------------------
init the vectors in ZTFQMRL
--------------------
*/
vecD = DenseMtx_new() ;
DenseMtx_init(vecD, type, 0, 0, neqns, 1, 1, neqns) ;
vecR = DenseMtx_new() ;
DenseMtx_init(vecR, type, 0, 0, neqns, 1, 1, neqns) ;
vecT = DenseMtx_new() ;
DenseMtx_init(vecT, type, 0, 0, neqns, 1, 1, neqns) ;
vecU1 = DenseMtx_new() ;
DenseMtx_init(vecU1, type, 0, 0, neqns, 1, 1, neqns) ;
vecU2 = DenseMtx_new() ;
DenseMtx_init(vecU2, type, 0, 0, neqns, 1, 1, neqns) ;
vecV = DenseMtx_new() ;
DenseMtx_init(vecV, type, 0, 0, neqns, 1, 1, neqns) ;
vecW = DenseMtx_new() ;
DenseMtx_init(vecW, type, 0, 0, neqns, 1, 1, neqns) ;
vecX = DenseMtx_new() ;
DenseMtx_init(vecX, type, 0, 0, neqns, 1, 1, neqns) ;
vecY1 = DenseMtx_new() ;
DenseMtx_init(vecY1, type, 0, 0, neqns, 1, 1, neqns) ;
vecY2 = DenseMtx_new() ;
DenseMtx_init(vecY2, type, 0, 0, neqns, 1, 1, neqns) ;
/*
--------------------------
Initialize the iterations
--------------------------
*/
/* ---- Set initial guess as zero ---- */
DenseMtx_zero(vecX) ;
DenseMtx_colCopy (vecT, 0, mtxB, 0);
/* */
FrontMtx_solve(Precond, vecR, vecT, Precond->manager,
cpus, msglvl, msgFile) ;
/* */
Init_norm = DenseMtx_twoNormOfColumn(vecR, 0);
if ( Init_norm == 0.0 ){
Init_norm = 1.0;
};
error_trol = Init_norm * convergetol ;
fprintf(msgFile, "\n ZTFQMRL Initial norml: %6.2e ", Init_norm ) ;
fprintf(msgFile, "\n ZTFQMRL Conveg. Control: %7.3e ", convergetol ) ;
fprintf(msgFile, "\n ZTFQMRL Convergen Control: %7.3e ",error_trol ) ;
DenseMtx_zero(vecD) ;
DenseMtx_zero(vecU1) ;
DenseMtx_zero(vecU2) ;
DenseMtx_zero(vecY2) ;
DenseMtx_colCopy (vecW, 0, vecR, 0);
DenseMtx_colCopy (vecY1, 0, vecR, 0);
Iter = 0;
Imv = 0;
switch ( symmetryflag ) {
case SPOOLES_SYMMETRIC :
InpMtx_sym_gmmm(mtxA, zero, vecT, one, vecY1) ;
break ;
case SPOOLES_HERMITIAN :
InpMtx_herm_gmmm(mtxA, zero, vecT, one, vecY1) ;
break ;
case SPOOLES_NONSYMMETRIC :
InpMtx_nonsym_gmmm(mtxA, zero, vecT, one, vecY1) ;
break ;
default :
fprintf(msgFile, "\n BiCGSTABL Matrix type wrong");
fprintf(msgFile, "\n Fatal error");
goto end;
}
/* */
FrontMtx_solve(Precond, vecV, vecT, Precond->manager,
cpus, msglvl, msgFile) ;
/* */
Imv++;
DenseMtx_colCopy (vecU1, 0, vecV, 0);
Eta[0] = 0.0;
Eta[1] = 0.0;
Theta = 0.0;
Tau = Init_norm ;
/* Rho = Tau * Tau ; */
Rho[0] = Tau * Tau;
Rho[1] = 0.0;
/*
------------------------------
ZTFQMRL Iteration start
------------------------------
*/
MARKTIME(t1) ;
while ( Iter <= itermax )
{
Iter++;
DenseMtx_colDotProduct (vecV, 0, vecR,0, Sigma);
if (zabs(Sigma) == 0){
fprintf(msgFile, "\n\n Fatal Error, \n"
" ZTFQMRL Breakdown, Sigma = 0 !!") ;
Imv = -1;
goto end;
};
/* Alpha = Rho/Sigma; */
zdiv(Rho, Sigma, Alpha);
/*
----------------
Odd step
---------------
*/
m = 2 * Iter - 1;
/* DenseMtx_axpy(vecW, vecU1, -Alpha); */
zsub(zero, Alpha, Rtmp);
DenseMtx_colGenAxpy (one, vecW, 0, Rtmp, vecU1, 0 );
/* Rtmp = Theta * Theta * Eta / Alpha ; */
Rtmp[0] = Theta * Theta;
Rtmp[1] = 0.0;
zmul(Rtmp, Eta, Ttmp);
zdiv(Ttmp, Alpha, Rtmp);
DenseMtx_colGenAxpy (Rtmp, vecD, 0, one, vecY1, 0 );
/* Theta = DenseMtx_fnorm(vecW)/Tau; */
Theta = DenseMtx_twoNormOfColumn(vecW, 0)/Tau;
Cee = 1.0/sqrt(1.0 + Theta*Theta);
Tau = Tau * Theta * Cee ;
/* Eta = Cee * Cee * Alpha ; */
Rtmp[0] = Cee * Cee;
Rtmp[1] = 0.0;
zmul(Rtmp, Alpha, Eta);
DenseMtx_colGenAxpy (one, vecX, 0, Eta, vecD, 0 );
fprintf(msgFile, "\n\n Odd step at %d", Imv);
fprintf(msgFile, " \n Tau is : %7.3e", Tau) ;
/*
Debug purpose: Check the convergence history
for the true residual norm
*/
/*
switch ( symmetryflag ) {
case SPOOLES_SYMMETRIC :
InpMtx_sym_gmmm(mtxA, zero, vecT, one, vecX) ;
break ;
case SPOOLES_HERMITIAN :
InpMtx_herm_gmmm(mtxA, zero, vecT, one, vecX) ;
break ;
case SPOOLES_NONSYMMETRIC :
InpMtx_nonsym_gmmm(mtxA, zero, vecT, one, vecX) ;
break ;
default :
fprintf(msgFile, "\n ZTFQMRL Matrix type wrong");
fprintf(msgFile, "\n Fatal error");
goto end;
}
DenseMtx_sub(vecT, mtxB) ;
Rtmp = DenseMtx_fnorm(vecT);
fprintf(msgFile, "\n ZTFQMRL Residual norm: %6.2e ", Rtmp) ;
*/
/*
----------------
Convergence Test
---------------
*/
if (Tau * sqrt(m + 1) <= error_trol ) {
/* */
DenseMtx_colCopy (mtxX, 0, vecX, 0);
switch ( symmetryflag ) {
case SPOOLES_SYMMETRIC :
InpMtx_sym_gmmm(mtxA, zero, vecT, one, mtxX) ;
break ;
case SPOOLES_HERMITIAN :
InpMtx_herm_gmmm(mtxA, zero, vecT, one, mtxX) ;
break ;
case SPOOLES_NONSYMMETRIC :
InpMtx_nonsym_gmmm(mtxA, zero, vecT, one, mtxX) ;
break ;
default :
fprintf(msgFile, "\n ZTFQMRL Matrix type wrong");
fprintf(msgFile, "\n Fatal error");
goto end;
}
DenseMtx_sub(vecT, mtxB) ;
Rtmp[0] = DenseMtx_twoNormOfColumn(vecT, 0);
fprintf(msgFile, "\n ZTFQMRL Residual norm: %6.2e ", Rtmp[0]) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU : Converges in time: %8.3f ", t2 - t1) ;
fprintf(msgFile, "\n # iterations = %d", Imv) ;
fprintf(msgFile, "\n\n after ZTFQMRL") ;
goto end;
};
/*
----------------
Even step
---------------
*/
DenseMtx_colCopy (vecY2, 0, vecY1, 0);
zsub(zero, Alpha, Rtmp);
DenseMtx_colGenAxpy (one, vecY2, 0, Rtmp, vecV, 0 );
switch ( symmetryflag ) {
case SPOOLES_SYMMETRIC :
InpMtx_sym_gmmm(mtxA, zero, vecT, one, vecY2) ;
break ;
case SPOOLES_HERMITIAN :
InpMtx_herm_gmmm(mtxA, zero, vecT, one, vecY2) ;
break ;
case SPOOLES_NONSYMMETRIC :
InpMtx_nonsym_gmmm(mtxA, zero, vecT, one, vecY2) ;
break ;
default :
fprintf(msgFile, "\n ZTFQMRL Matrix type wrong");
fprintf(msgFile, "\n Fatal error");
goto end;
}
FrontMtx_solve(Precond, vecU2, vecT, Precond->manager,
cpus, msglvl, msgFile) ;
Imv++;
m = 2 * Iter ;
/* DenseMtx_axpy(vecW, vecU2, -Alpha); */
zsub(zero, Alpha, Rtmp);
DenseMtx_colGenAxpy (one, vecW, 0, Rtmp, vecU2, 0 );
/*
Rtmp = Theta * Theta * Eta / Alpha ;
*/
Rtmp[0] = Theta * Theta;
Rtmp[1] = 0.0;
zmul(Rtmp, Eta, Ttmp);
zdiv(Ttmp, Alpha, Rtmp);
DenseMtx_colGenAxpy (Rtmp, vecD, 0, one, vecY2, 0 );
/* Theta = DenseMtx_fnorm(vecW)/Tau; */
Theta = DenseMtx_twoNormOfColumn(vecW, 0)/Tau;
Cee = 1.0/sqrt(1.0 + Theta*Theta);
Tau = Tau * Theta * Cee ;
/* Eta = Cee * Cee * Alpha ; */
Rtmp[0] = Cee * Cee;
Rtmp[1] = 0.0;
zmul(Rtmp, Alpha, Eta);
DenseMtx_colGenAxpy (one, vecX, 0, Eta, vecD, 0 );
fprintf(msgFile, "\n\n Even step at %d", Imv) ;
/*
----------------
Convergence Test for even step
---------------
*/
if (Tau * sqrt(m + 1) <= error_trol ) {
DenseMtx_colCopy (mtxX, 0, vecX, 0);
switch ( symmetryflag ) {
case SPOOLES_SYMMETRIC :
InpMtx_sym_gmmm(mtxA, zero, vecT, one, mtxX) ;
break ;
case SPOOLES_HERMITIAN :
InpMtx_herm_gmmm(mtxA, zero, vecT, one, mtxX) ;
break ;
case SPOOLES_NONSYMMETRIC :
InpMtx_nonsym_gmmm(mtxA, zero, vecT, one, mtxX) ;
break ;
default :
fprintf(msgFile, "\n ZTFQMRL Matrix type wrong");
fprintf(msgFile, "\n Fatal error");
goto end;
}
DenseMtx_sub(vecT, mtxB) ;
Rtmp[0] = DenseMtx_twoNormOfColumn(vecT, 0);
fprintf(msgFile, "\n ZTFQMRL Residual norm: %6.2e ", Rtmp[0]) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU : Converges in time: %8.3f ", t2 - t1) ;
fprintf(msgFile, "\n # iterations = %d", Imv) ;
fprintf(msgFile, "\n\n after ZTFQMRL") ;
goto end;
};
if (zabs(Rho) == 0){
fprintf(msgFile, "\n\n Fatal Error, \n"
" ZTFQMRL Breakdown, Rho = 0 !!") ;
Imv = -1;
goto end;
};
/*
Rho_new = DenseMtx_dot(vecW, vecR);
Beta = Rho_new / Rho;
Rho = Rho_new ;
*/
DenseMtx_colDotProduct (vecW, 0, vecR,0, Rho_new);
zdiv(Rho_new, Rho, Beta);
Rho[0]= Rho_new[0];
Rho[1]= Rho_new[1];
DenseMtx_colCopy (vecY1, 0, vecY2, 0);
DenseMtx_colGenAxpy (Beta, vecY1, 0, one, vecW, 0 );
switch ( symmetryflag ) {
case SPOOLES_SYMMETRIC :
InpMtx_sym_gmmm(mtxA, zero, vecT, one, vecY1) ;
break ;
case SPOOLES_HERMITIAN :
InpMtx_herm_gmmm(mtxA, zero, vecT, one, vecY1) ;
break ;
case SPOOLES_NONSYMMETRIC :
InpMtx_nonsym_gmmm(mtxA, zero, vecT, one, vecY1) ;
break ;
default :
fprintf(msgFile, "\n ZTFQMRL Matrix type wrong");
fprintf(msgFile, "\n Fatal error");
goto end;
}
FrontMtx_solve(Precond, vecU1, vecT, Precond->manager,
cpus, msglvl, msgFile) ;
Imv++;
/* */
DenseMtx_colCopy (vecT, 0, vecU2, 0);
DenseMtx_colGenAxpy (one, vecT, 0, Beta, vecV, 0 );
DenseMtx_colCopy (vecV, 0, vecT, 0);
DenseMtx_colGenAxpy (Beta, vecV, 0, one, vecU1, 0 );
Rtmp[0] = Tau*sqrt(m + 1)/Init_norm ;
fprintf(msgFile, "\n\n At iteration %d"
" the convergence ratio is %12.4e",
Imv, Rtmp[0]) ;
}
/* End of while loop */
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU : Total iteration time is : %8.3f ", t2 - t1) ;
fprintf(msgFile, "\n # iterations = %d", Imv) ;
fprintf(msgFile, "\n\n ZTFQMRL did not Converge !") ;
fprintf(msgFile, "\n\n after ZTFQMRL") ;
DenseMtx_colCopy (mtxX, 0, vecX, 0);
/*
------------------------
free the working storage
------------------------
*/
end:
DenseMtx_free(vecD) ;
DenseMtx_free(vecR) ;
DenseMtx_free(vecT) ;
DenseMtx_free(vecU1) ;
DenseMtx_free(vecU2) ;
DenseMtx_free(vecV) ;
DenseMtx_free(vecW) ;
DenseMtx_free(vecX) ;
DenseMtx_free(vecY1) ;
DenseMtx_free(vecY2) ;
fprintf(msgFile, "\n") ;
return(1) ; }
double c_abs(complex *z)
{
return( zabs( z->r, z->i ) );
}
int
main(void)
{
/* static because otherwise it would have to be volatile yeilding a lot of stupid
* warnings. auto variables are not guaranteed to be readable after a long jump. */
static z_t a, b, c, d, _0, _1, _2, _3;
static char buf[2000];
static int ret = 0;
static jmp_buf env, env2;
static size_t n;
#define BUF_N (sizeof(buf) - 1)
if (setjmp(env)) {
zperror(0);
ret = 2;
goto done;
}
zsetup(env);
zinit(a), zinit(b), zinit(c), zinit(d), zinit(_0), zinit(_1), zinit(_2), zinit(_3);
zsetu(_0, 0);
zsetu(_1, 1);
zsetu(_2, 2);
zsetu(_3, 3);
assert(zeven(_0), == 1);
assert(zodd(_0), == 0);
assert(zzero(_0), == 1);
assert(zsignum(_0), == 0);
assert(zeven(_1), == 0);
assert(zodd(_1), == 1);
assert(zzero(_1), == 0);
assert(zsignum(_1), == 1);
assert(zeven(_2), == 1);
assert(zodd(_2), == 0);
assert(zzero(_2), == 0);
assert(zsignum(_2), == 1);
zswap(_1, _2);
assert(zeven(_2), == 0);
assert(zodd(_2), == 1);
assert(zzero(_2), == 0);
assert(zsignum(_2), == 1);
assert(zeven(_1), == 1);
assert(zodd(_1), == 0);
assert(zzero(_1), == 0);
assert(zsignum(_1), == 1);
zswap(_2, _1);
assert(zeven(_1), == 0);
assert(zodd(_1), == 1);
assert(zzero(_1), == 0);
assert(zsignum(_1), == 1);
assert(zeven(_2), == 1);
assert(zodd(_2), == 0);
assert(zzero(_2), == 0);
assert(zsignum(_2), == 1);
assert((zneg(_2, _2), zsignum(_2)), == -1); zneg(_2, _2);
assert(zsignum(_2), == 1);
assert(zcmp(_0, _0), == 0);
assert(zcmp(_1, _1), == 0);
assert(zcmp(_0, _1), < 0);
assert(zcmp(_1, _0), > 0);
assert(zcmp(_1, _2), < 0);
assert(zcmp(_2, _1), > 0);
assert(zcmp(_0, _2), < 0);
assert(zcmp(_2, _0), > 0);
zbset(a, _0, 0, 1);
assert(zcmp(a, _1), == 0);
zbset(a, a, 1, 1);
assert(zcmp(a, _3), == 0);
zbset(a, a, 0, 0);
assert(zcmp(a, _2), == 0);
zbset(a, a, 0, 0);
assert(zcmp(a, _2), == 0);
zbset(a, a, 0, -1);
assert(zcmp(a, _3), == 0);
zbset(a, a, 0, -1);
assert(zcmp(a, _2), == 0);
zadd(a, _0, _1);
assert(zsignum(a), == 1);
assert(zcmp(a, _1), == 0);
assert(zcmpi(a, 1), == 0);
assert(zcmpu(a, 1), == 0);
zneg(a, a);
assert(zsignum(a), == -1);
assert(zcmp(a, _1), < 0);
assert(zcmpi(a, 1), < 0);
assert(zcmpu(a, 1), < 0);
zadd(a, _2, _0);
assert(zsignum(a), == 1);
assert(zcmp(a, _2), == 0);
assert(zcmpi(a, 2), == 0);
assert(zcmpu(a, 2), == 0);
zneg(a, a);
assert(zsignum(a), == -1);
assert(zcmp(a, _2), < 0);
assert(zcmpi(a, 2), < 0);
assert(zcmpu(a, 2), < 0);
assert(zsignum(_1), == 1);
zadd(a, _1, _1);
assert(zsignum(a), == 1);
assert(zcmp(a, _2), == 0);
assert(zcmpi(a, 2), == 0);
assert(zcmpu(a, 2), == 0);
zset(b, _1);
zadd(a, b, _1);
assert(zsignum(a), == 1);
assert(zcmp(a, _2), == 0);
assert(zcmpi(a, 2), == 0);
assert(zcmpu(a, 2), == 0);
zneg(a, a);
zset(b, _2);
zneg(b, b);
assert(zsignum(a), == -1);
assert(zcmp(a, b), == 0);
assert(zcmp(a, _2), < 0);
assert(zcmpmag(a, b), == 0);
assert(zcmpmag(a, _2), == 0);
assert(zcmpi(a, 2), < 0);
assert(zcmpu(a, 2), < 0);
assert(zcmpi(a, -2), == 0);
assert((zneg(_2, _2), zcmp(a, _2)), == 0); zneg(_2, _2);
zadd(a, _1, _2);
assert(zsignum(a), == 1);
assert(zcmp(a, _2), > 0);
assert(zcmpi(a, 2), > 0);
assert(zcmpu(a, 2), > 0);
zneg(a, a);
zset(b, _2);
zneg(b, b);
assert(zsignum(a), == -1);
assert(zcmpmag(a, _2), > 0);
assert(zcmpmag(a, b), > 0);
assert(zcmp(a, b), < 0);
assert(zcmp(a, _2), < 0);
assert(zcmpi(a, 2), < 0);
assert(zcmpu(a, 2), < 0);
assert(zcmpi(a, -2), < 0);
assert((zneg(_2, _2), zcmp(a, _2)), < 0); zneg(_2, _2);
zneg(b, _3);
assert(zcmp(a, b), == 0);
zunsetup();
zsetup(env);
zsub(a, _2, _1);
assert(zcmpmag(_2, _1), > 0);
assert(zcmpmag(_2, _0), > 0);
assert(zcmpmag(_1, _0), > 0);
zsub(b, _1, _2);
assert(zcmpmag(_2, _0), > 0);
assert(zcmpmag(_1, _0), > 0);
assert(zcmpmag(_2, _1), > 0);
assert(zcmpmag(a, b), == 0);
assert(zcmpmag(a, _1), == 0);
assert(zcmp(a, b), > 0);
assert(zcmp(a, _1), == 0);
assert(zcmp(b, _1), < 0);
zsub(a, _1, _1);
assert(zcmp(a, _0), == 0);
zseti(b, 0);
zsetu(c, 0);
zsub(a, b, c);
assert(zcmp(a, _0), == 0);
assert(zcmpmag(_2, _1), > 0);
assert(zcmp(_2, _1), > 0);
zsub(a, _2, _1);
assert(zsignum(a), == 1);
assert(zcmpmag(a, _1), == 0);
assert(zcmp(a, _1), == 0);
zsub(a, a, _1);
assert(zcmp(a, _0), == 0);
zsub(a, a, _0);
assert(zcmp(a, _0), == 0);
zsub(a, _1, _2);
assert(zcmp(a, _1), < 0);
assert(zcmpmag(a, _1), == 0);
zabs(a, a);
assert(zcmp(a, _1), == 0);
zabs(a, a);
assert(zcmp(a, _1), == 0);
zabs(a, _1);
assert(zcmp(a, _1), == 0);
zabs(a, _0);
assert(zcmp(a, _0), == 0);
zseti(b, -1);
zseti(c, -2);
zadd(a, _0, b);
assert(zcmp(a, _0), < 0);
assert(zcmpi(a, -1), == 0);
assert(zcmpmag(a, _1), == 0);
assert(zcmp(a, _1), < 0);
zadd(a, b, _0);
assert(zcmp(a, _0), < 0);
assert(zcmpi(a, -1), == 0);
assert(zcmpmag(a, _1), == 0);
assert(zcmp(a, _1), < 0);
zadd(a, b, c);
assert(zcmp(a, c), < 0);
assert(zcmpmag(a, _2), > 0);
zadd(a, c, b);
assert(zcmp(a, c), < 0);
assert(zcmpmag(a, _2), > 0);
zadd(a, b, _1);
assert(zcmp(a, _0), == 0);
assert(zcmpmag(a, _0), == 0);
zadd(a, _1, b);
assert(zcmp(a, _0), == 0);
assert(zcmpmag(a, _0), == 0);
zneg(b, _1);
zneg(c, _2);
zsub(a, _0, b);
assert(zcmp(a, _1), == 0);
zsub(a, b, _0);
assert(zcmpmag(a, _1), == 0);
assert(zcmp(a, _1), < 0);
zsub(a, b, c);
assert(zcmpmag(a, _1), == 0);
assert(zcmp(a, _1), == 0);
zsub(a, c, b);
assert(zcmpmag(a, _1), == 0);
assert(zcmp(a, _1), < 0);
zsub(a, b, _1);
assert(zcmpmag(a, _2), == 0);
assert(zcmp(a, _2), < 0);
assert(zcmp(a, c), == 0);
zsub(a, _1, b);
assert(zcmp(b, _1), < 0);
assert(zcmpmag(b, _1), == 0);
assert(zcmp(a, _2), == 0);
zsetu(a, 1000);
zsetu(b, 0);
assert(zcmp(a, b), != 0);
n = zsave(a, buf);
assert(n > 0, > 0);
assert_zu(zload(b, buf), n);
assert(zcmp(a, b), == 0);
zneg(b, _1);
zneg(c, _2);
assert((zadd_unsigned(a, _1, _2), zcmp(a, _3)), == 0);
assert((zadd_unsigned(a, b, c), zcmp(a, _3)), == 0);
assert((zadd_unsigned(a, b, _2), zcmp(a, _3)), == 0);
assert((zadd_unsigned(a, _1, c), zcmp(a, _3)), == 0);
assert((zadd_unsigned(a, _0, _0), zcmp(a, _0)), == 0);
assert((zadd_unsigned(a, _0, _1), zcmp(a, _1)), == 0);
assert((zadd_unsigned(a, _1, _1), zcmp(a, _2)), == 0);
assert((zadd_unsigned(a, _1, _0), zcmp(a, _1)), == 0);
zneg(_1, _1);
assert((zadd_unsigned(a, _0, _0), zcmp(a, _0)), == 0);
assert((zadd_unsigned(a, _0, _1), zcmp(a, _1)), != 0);
assert((zadd_unsigned(a, _0, _1), zcmpmag(a, _1)), == 0);
assert((zadd_unsigned(a, _1, _1), zcmp(a, _2)), == 0);
assert((zadd_unsigned(a, _1, _0), zcmp(a, _1)), != 0);
assert((zadd_unsigned(a, _1, _0), zcmpmag(a, _1)), == 0);
zneg(_1, _1);
assert((zsub_unsigned(a, _2, _1), zcmp(a, _1)), == 0);
assert((zsub_unsigned(a, _2, b), zcmp(a, _1)), == 0);
assert((zsub_unsigned(a, c, _1), zcmp(a, _1)), == 0);
assert((zsub_unsigned(a, c, b), zcmp(a, _1)), == 0);
assert((zsub_unsigned(a, _1, _2), zcmp(a, b)), == 0);
assert((zsub_unsigned(a, b, _2), zcmp(a, b)), == 0);
assert((zsub_unsigned(a, _1, c), zcmp(a, b)), == 0);
assert((zsub_unsigned(a, b, c), zcmp(a, b)), == 0);
assert_zu(zbits(_0), 1);
assert_zu(zbits(_1), 1);
assert_zu(zbits(_2), 2);
assert_zu(zbits(_3), 2);
assert_zu(zlsb(_0), SIZE_MAX);
assert_zu(zlsb(_1), 0);
assert_zu(zlsb(_2), 1);
assert_zu(zlsb(_3), 0);
assert((zand(a, _0, _0), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zand(a, _0, _1), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zand(a, _0, _2), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zand(a, _0, _3), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zand(a, _1, _1), zcmp(a, _1)), == 0);
assert((zand(a, _1, _2), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zand(a, _1, _3), zcmp(a, _1)), == 0);
assert((zand(a, _2, _2), zcmp(a, _2)), == 0);
assert((zand(a, _2, _3), zcmp(a, _2)), == 0);
assert((zand(a, _3, _3), zcmp(a, _3)), == 0);
assert((zor(a, _0, _0), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zor(a, _0, _1), zcmp(a, _1)), == 0);
assert((zor(a, _0, _2), zcmp(a, _2)), == 0);
assert((zor(a, _0, _3), zcmp(a, _3)), == 0);
assert((zor(a, _1, _1), zcmp(a, _1)), == 0);
assert((zor(a, _1, _2), zcmp(a, _3)), == 0);
assert((zor(a, _1, _3), zcmp(a, _3)), == 0);
assert((zor(a, _2, _2), zcmp(a, _2)), == 0);
assert((zor(a, _2, _3), zcmp(a, _3)), == 0);
assert((zor(a, _3, _3), zcmp(a, _3)), == 0);
assert((zxor(a, _0, _0), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zxor(a, _0, _1), zcmp(a, _1)), == 0);
assert((zxor(a, _0, _2), zcmp(a, _2)), == 0);
assert((zxor(a, _0, _3), zcmp(a, _3)), == 0);
assert((zxor(a, _1, _1), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zxor(a, _1, _2), zcmp(a, _3)), == 0);
assert((zxor(a, _1, _3), zcmp(a, _2)), == 0);
assert((zxor(a, _2, _2), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zxor(a, _2, _3), zcmp(a, _1)), == 0);
assert((zxor(a, _3, _3), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
zneg(b, _1);
zneg(c, _3);
zneg(_1, _1);
zand(a, b, c);
assert(zcmpmag(a, _1), == 0);
assert(zcmp(a, _1), == 0);
zneg(_1, _1);
assert((zand(a, b, _3), zcmp(a, _1)), == 0);
assert((zand(a, _1, c), zcmp(a, _1)), == 0);
assert((zand(a, _0, c), zcmp(a, _0)), == 0);
assert((zand(a, b, _0), zcmp(a, _0)), == 0);
zneg(b, _1);
zneg(c, _2);
zneg(_3, _3);
zor(a, b, c);
assert(zcmpmag(a, _3), == 0);
assert(zcmp(a, _3), == 0);
zor(a, b, _2);
assert(zcmpmag(a, _3), == 0);
assert(zcmp(a, _3), == 0);
zor(a, _1, c);
assert((zcmpmag(a, _3)), == 0);
assert((zcmp(a, _3)), == 0);
assert((zor(a, _0, c), zcmp(a, c)), == 0);
assert((zor(a, b, _0), zcmp(a, b)), == 0);
zneg(_3, _3);
zneg(b, _1);
zneg(c, _2);
zxor(a, b, c);
assert(zcmpmag(a, _3), == 0);
assert(zcmp(a, _3), == 0);
zneg(_3, _3);
zxor(a, b, _2);
assert(zcmpmag(a, _3), == 0);
assert(zcmp(a, _3), == 0);
zxor(a, _1, c);
assert(zcmpmag(a, _3), == 0);
assert(zcmp(a, _3), == 0);
zxor(a, b, _0);
assert(zcmpmag(a, b), == 0);
assert(zcmp(a, b), == 0);
zxor(a, _0, c);
assert(zcmpmag(a, c), == 0);
assert(zcmp(a, c), == 0);
zneg(_3, _3);
assert((zlsh(a, _0, 0), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zlsh(a, _0, 1), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zlsh(a, _1, 0), zcmp(a, _1)), == 0);
assert((zlsh(a, _1, 1), zcmp(a, _2)), == 0);
assert((zlsh(a, _1, 2), zcmp(a, _2)), > 0);
assert((zlsh(a, _2, 0), zcmp(a, _2)), == 0);
assert((zlsh(a, _2, 1), zcmp(a, _2)), > 0);
zset(a, _0);
assert((zlsh(a, a, 0), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zlsh(a, a, 1), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
zset(a, _1);
assert((zlsh(a, a, 0), zcmp(a, _1)), == 0);
assert((zlsh(a, a, 1), zcmp(a, _2)), == 0);
assert((zlsh(a, a, 2), zcmp(a, _2)), > 0);
zset(a, _2);
assert((zlsh(a, a, 0), zcmp(a, _2)), == 0);
assert((zlsh(a, a, 1), zcmp(a, _2)), > 0);
assert((zrsh(a, _0, 0), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zrsh(a, _0, 1), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zrsh(a, _1, 0), zcmp(a, _1)), == 0);
assert((zrsh(a, _1, 1), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zrsh(a, _1, 2), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zrsh(a, _2, 0), zcmp(a, _2)), == 0);
assert((zrsh(a, _2, 1), zcmp(a, _1)), == 0);
assert((zrsh(a, _2, 2), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
zset(a, _0);
assert((zrsh(a, a, 0), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zrsh(a, a, 1), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
zset(a, _1);
assert((zrsh(a, a, 0), zcmp(a, _1)), == 0);
assert((zrsh(a, a, 1), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert((zrsh(a, a, 2), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
zset(a, _2);
assert((zrsh(a, a, 0), zcmp(a, _2)), == 0);
assert((zrsh(a, a, 1), zcmp(a, _1)), == 0);
assert((zrsh(a, a, 2), zcmp(a, _0)), == 0);
assert(zzero(a), == 1);
assert(zbtest(_0, 0), == 0);
assert(zbtest(_1, 0), == 1);
assert(zbtest(_2, 0), == 0);
assert(zbtest(_3, 0), == 1);
assert(zbtest(_0, 1), == 0);
assert(zbtest(_1, 1), == 0);
assert(zbtest(_2, 1), == 1);
assert(zbtest(_3, 1), == 1);
assert(zbtest(_0, 2), == 0);
assert(zbtest(_1, 2), == 0);
assert(zbtest(_2, 2), == 0);
assert(zbtest(_3, 2), == 0);
znot(a, _2);
assert(zcmpmag(a, _1), == 0);
assert(zcmp(a, _1), != 0);
znot(a, a);
assert(zcmp(a, _0), == 0);
zsetu(a, 0x1234);
zsetu(c, 0x234);
ztrunc(a, a, 12);
assert(zcmp(a, c), == 0);
zsetu(a, 0xEEFF);
zsetu(c, 0xEE);
zsetu(d, 0xFF);
zsplit(a, b, a, 8);
assert(zcmpmag(a, c), == 0);
assert(zcmpmag(b, d), == 0);
zsetu(a, 0xEEFF);
zsplit(b, a, a, 8);
assert(zcmpmag(b, c), == 0);
assert(zcmpmag(a, d), == 0);
zmul(a, _2, _3);
assert(zcmpi(a, 6), == 0);
zneg(_3, _3);
zmul(a, _2, _3);
assert(zcmpi(a, -6), == 0);
zneg(_3, _3);
zneg(_2, _2);
zmul(a, _2, _3);
assert(zcmpi(a, -6), == 0);
zneg(_3, _3);
zmul(a, _2, _3);
assert(zcmpi(a, 6), == 0);
zneg(_3, _3);
zneg(_2, _2);
zmul(a, _3, _3);
assert(zcmpi(a, 9), == 0);
zsqr(a, _3);
assert(zcmpi(a, 9), == 0);
zneg(_3, _3);
zmul(a, _3, _3);
assert(zcmpi(a, 9), == 0);
zsqr(a, _3);
assert(zcmpi(a, 9), == 0);
zneg(_3, _3);
zseti(a, 8);
zseti(b, 2);
zdiv(c, a, b);
assert(zcmpi(c, 4), == 0);
zseti(b, -2);
zdiv(c, a, b);
assert(zcmpi(c, -4), == 0);
zseti(a, -8);
zseti(b, 2);
zdiv(c, a, b);
assert(zcmpi(c, -4), == 0);
zseti(b, -2);
zdiv(c, a, b);
assert(zcmpi(c, 4), == 0);
zseti(a, 1000);
zseti(b, 10);
zdiv(c, a, b);
assert(zcmpi(c, 100), == 0);
zseti(b, -10);
zdiv(c, a, b);
assert(zcmpi(c, -100), == 0);
zseti(a, -1000);
zseti(b, 10);
zdiv(c, a, b);
assert(zcmpi(c, -100), == 0);
zseti(b, -10);
zdiv(c, a, b);
assert(zcmpi(c, 100), == 0);
zseti(a, 7);
zseti(b, 3);
zmod(c, a, b);
assert(zcmpi(c, 1), == 0);
zseti(b, -3);
zmod(c, a, b);
assert(zcmpi(c, 1), == 0);
zseti(a, -7);
zseti(b, 3);
zmod(c, a, b);
assert(zcmpi(c, -1), == 0);
zseti(b, -3);
zmod(c, a, b);
assert(zcmpi(c, -1), == 0);
zseti(a, 7);
zseti(b, 3);
zdivmod(d, c, a, b);
assert(zcmpi(d, 2), == 0);
assert(zcmpi(c, 1), == 0);
zseti(b, -3);
zdivmod(d, c, a, b);
assert(zcmpi(d, -2), == 0);
assert(zcmpi(c, 1), == 0);
zseti(a, -7);
zseti(b, 3);
zdivmod(d, c, a, b);
assert(zcmpi(d, -2), == 0);
assert(zcmpi(c, -1), == 0);
zseti(b, -3);
zdivmod(d, c, a, b);
assert(zcmpi(d, 2), == 0);
assert(zcmpi(c, -1), == 0);
zseti(a, 10);
zseti(b, -1);
zpow(a, a, b);
assert(zcmp(a, _0), == 0);
zseti(a, 10);
zseti(b, -1);
zseti(a, 20);
zmodpow(a, a, b, c);
assert(zcmp(a, _0), == 0);
zseti(a, 10);
zseti(c, 100000L);
zpowu(a, a, 5);
assert(zcmpmag(a, c), == 0);
assert(zcmp(a, c), == 0);
zseti(a, -10);
zseti(c, -100000L);
zpowu(a, a, 5);
assert(zcmpmag(a, c), == 0);
assert(zcmp(a, c), == 0);
zseti(a, -10);
zseti(c, 10000L);
zpowu(a, a, 4);
assert(zcmpmag(a, c), == 0);
assert(zcmp(a, c), == 0);
zseti(a, 10);
zseti(c, 3);
zmodpowu(a, a, 5, c);
assert(zcmpmag(a, _1), == 0);
assert(zcmp(a, _1), == 0);
zseti(a, 10);
zseti(b, 5);
zseti(c, 100000L);
zpow(a, a, b);
assert(zcmpmag(a, c), == 0);
assert(zcmp(a, c), == 0);
zseti(a, -10);
zseti(b, 5);
zseti(c, -100000L);
zpow(a, a, b);
assert(zcmpmag(a, c), == 0);
assert(zcmp(a, c), == 0);
zseti(a, -10);
zseti(b, 4);
zseti(c, 10000L);
zpow(a, a, b);
assert(zcmpmag(a, c), == 0);
assert(zcmp(a, c), == 0);
zseti(a, 10);
zseti(b, 5);
zseti(c, 3);
zmodpow(a, a, b, c);
assert(zcmpmag(a, _1), == 0);
assert(zcmp(a, _1), == 0);
zseti(a, 102);
zseti(b, 501);
zseti(c, 5);
zmodmul(a, a, b, c);
assert(zcmp(a, _2), == 0);
zseti(b, 2 * 3 * 3 * 7);
zseti(c, 3 * 7 * 11);
zseti(d, 3 * 7);
assert((zgcd(a, _0, _0), zcmp(a, _0)), == 0);
assert((zgcd(a, b, _0), zcmp(a, b)), == 0);
assert((zgcd(a, _0, c), zcmp(a, c)), == 0);
assert((zgcd(a, b, b), zcmp(a, b)), == 0);
assert((zgcd(a, b, _2), zcmp(a, _2)), == 0);
assert((zgcd(a, _2, b), zcmp(a, _2)), == 0);
assert((zgcd(a, _2, _2), zcmp(a, _2)), == 0);
assert((zgcd(a, c, _2), zcmp(a, _1)), == 0);
assert((zgcd(a, _2, c), zcmp(a, _1)), == 0);
assert((zgcd(a, b, _1), zcmp(a, _1)), == 0);
assert((zgcd(a, _1, c), zcmp(a, _1)), == 0);
assert((zgcd(a, _1, _1), zcmp(a, _1)), == 0);
assert((zgcd(a, b, c), zcmp(a, d)), == 0);
assert((zgcd(a, c, b), zcmp(a, d)), == 0);
zsets(a, "1234");
assert(zcmpi(a, 1234), == 0);
zsets(b, "+1234");
assert(zcmp(a, b), == 0);
assert_zu(zstr_length(_0, 10), 1);
assert_zu(zstr_length(_1, 10), 1);
assert_zu(zstr_length(_2, 10), 1);
assert_zu(zstr_length(_3, 10), 1);
zneg(_2, _2);
assert_zu(zstr_length(_2, 10), 2);
zneg(_2, _2);
assert_zu(zstr_length(a, 10), 4);
zstr(a, buf, 0);
assert_s(buf, "1234");
zsets(a, "-1234");
zseti(b, -1234);
zseti(c, 1234);
assert(zcmp(a, _0), < 0);
assert(zcmp(a, b), == 0);
assert(zcmpmag(a, c), == 0);
assert(zcmp(a, c), < 0);
zstr(a, buf, 0);
assert_s(buf, "-1234");
assert_s(zstr(a, buf, 0), "-1234");
zsetu(d, 100000UL);
zrand(a, FAST_RANDOM, UNIFORM, d);
assert(zcmp(a, _0), >= 0);
assert(zcmp(a, d), <= 0);
zrand(b, SECURE_RANDOM, UNIFORM, d);
assert(zcmp(b, _0), >= 0);
assert(zcmp(b, d), <= 0);
zrand(c, FASTEST_RANDOM, UNIFORM, d);
assert(zcmp(c, _0), >= 0);
assert(zcmp(c, d), <= 0);
assert(zcmp(a, b), != 0);
assert(zcmp(a, c), != 0);
assert(zcmp(b, c), != 0);
zsetu(d, 100000UL);
zrand(a, DEFAULT_RANDOM, QUASIUNIFORM, d);
assert(zcmp(a, _0), >= 0);
assert(zcmp(a, d), <= 0);
zrand(b, DEFAULT_RANDOM, QUASIUNIFORM, d);
assert(zcmp(b, _0), >= 0);
assert(zcmp(b, d), <= 0);
zrand(c, DEFAULT_RANDOM, QUASIUNIFORM, d);
assert(zcmp(c, _0), >= 0);
assert(zcmp(c, d), <= 0);
assert(zcmp(a, b), != 0);
assert(zcmp(a, c), != 0);
assert(zcmp(b, c), != 0);
zsetu(d, 100000UL);
zrand(a, DEFAULT_RANDOM, MODUNIFORM, d);
assert(zcmp(a, _0), >= 0);
assert(zcmp(a, d), <= 0);
zrand(b, DEFAULT_RANDOM, MODUNIFORM, d);
assert(zcmp(b, _0), >= 0);
assert(zcmp(b, d), <= 0);
zrand(c, DEFAULT_RANDOM, MODUNIFORM, d);
assert(zcmp(c, _0), >= 0);
assert(zcmp(c, d), <= 0);
assert(zcmp(a, b), != 0);
assert(zcmp(a, c), != 0);
assert(zcmp(b, c), != 0);
assert((zseti(a, -5), zptest(0, a, 100)), == NONPRIME);
assert((zseti(a, -4), zptest(0, a, 100)), == NONPRIME);
assert((zseti(a, -3), zptest(0, a, 100)), == NONPRIME);
assert((zseti(a, -2), zptest(0, a, 100)), == NONPRIME);
assert((zseti(a, -1), zptest(0, a, 100)), == NONPRIME);
assert((zseti(a, 0), zptest(0, a, 100)), == NONPRIME);
assert((zseti(a, 1), zptest(0, a, 100)), == NONPRIME);
assert((zseti(a, 2), zptest(0, a, 100)), == PRIME);
assert((zseti(a, 3), zptest(0, a, 100)), == PRIME);
assert((zseti(a, 4), zptest(0, a, 100)), == NONPRIME);
assert((zseti(a, 5), zptest(0, a, 100)), != NONPRIME);
assert((zseti(a, 6), zptest(0, a, 100)), == NONPRIME);
assert((zseti(a, 7), zptest(0, a, 100)), != NONPRIME);
assert((zseti(a, 8), zptest(0, a, 100)), == NONPRIME);
assert((zseti(a, 9), zptest(0, a, 100)), == NONPRIME);
assert((zseti(a, 10), zptest(0, a, 100)), == NONPRIME);
assert((zseti(a, 11), zptest(0, a, 100)), != NONPRIME);
assert((zseti(a, 101), zptest(0, a, 100)), != NONPRIME);
#if defined(ZAHL_UNSAFE)
(void) env2;
#else
assert_nr(zdivmod(a, b, _0, _0));
assert_nr(zdivmod(a, b, _1, _0));
zdivmod(a, b, _0, _1);
zdivmod(a, b, _1, _1);
assert_nr(zdiv(a, _0, _0));
assert_nr(zdiv(a, _1, _0));
zdiv(a, _0, _1);
zdiv(a, _1, _1);
assert_nr(zmod(a, _0, _0));
assert_nr(zmod(a, _1, _0));
zmod(a, _0, _1);
zmod(a, _1, _1);
assert_nr(zpow(a, _0, _0));
assert_nr((zneg(_1, _1), zpow(a, _0, _1))); zneg(_1, _1);
zpow(a, _0, _1);
zpow(a, _1, _0);
zneg(_1, _1), zpow(a, _1, _0), zneg(_1, _1);
assert_nr(zmodmul(a, _1, _1, _0));
assert_nr(zmodpow(a, _0, _0, _1));
assert_nr((zneg(_1, _1), zmodpow(a, _0, _1, _1))); zneg(_1, _1);
zmodpow(a, _0, _1, _1);
zmodpow(a, _1, _0, _1);
zneg(_1, _1), zmodpow(a, _1, _0, _1), zneg(_1, _1);
assert_nr(zmodpow(a, _0, _0, _0));
assert_nr((zneg(_1, _1), zmodpow(a, _0, _1, _0))); zneg(_1, _1);
assert_nr(zmodpow(a, _0, _1, _0));
assert_nr(zmodpow(a, _1, _0, _0));
assert_nr((zneg(_1, _1), zmodpow(a, _1, _0, _0))); zneg(_1, _1);
assert_nr(zpowu(a, _0, 0));
zpowu(a, _0, 1);
zpowu(a, _1, 0);
zneg(_1, _1), zpowu(a, _1, 0), zneg(_1, _1);
assert_nr(zmodpowu(a, _0, 0, _1));
zmodpowu(a, _0, 1, _1);
zmodpowu(a, _1, 0, _1);
zneg(_1, _1), zmodpowu(a, _1, 0, _1), zneg(_1, _1);
assert_nr(zmodpowu(a, _0, 0, _0));
assert_nr((zneg(_1, _1), zmodpowu(a, _0, 1, _0))); zneg(_1, _1);
assert_nr(zmodpowu(a, _0, 1, _0));
assert_nr(zmodpowu(a, _1, 0, _0));
assert_nr((zneg(_1, _1), zmodpowu(a, _1, 0, _0))); zneg(_1, _1);
assert_nr(zstr_length(a, 0));
assert_nr(zstr_length(a, 1));
zstr_length(a, 2);
zstr_length(a, 3);
#endif
zsetu(a, 1LL);
assert_s(zstr(a, buf, 1), "1");
zsetu(a, 10LL);
assert_s(zstr(a, buf, 2), "10");
zsetu(a, 100LL);
assert_s(zstr(a, buf, 3), "100");
zsetu(a, 1000LL);
assert_s(zstr(a, buf, 4), "1000");
zsetu(a, 10000LL);
assert_s(zstr(a, buf, BUF_N), "10000");
zsetu(a, 100000LL);
assert_s(zstr(a, buf, BUF_N), "100000");
zsetu(a, 1000000LL);
assert_s(zstr(a, buf, BUF_N), "1000000");
zsetu(a, 10000000LL);
assert_s(zstr(a, buf, BUF_N), "10000000");
zsetu(a, 100000000LL);
assert_s(zstr(a, buf, BUF_N), "100000000");
zsetu(a, 999999999LL);
assert_s(zstr(a, buf, BUF_N), "999999999");
zsetu(a, 1000000000LL);
assert_s(zstr(a, buf, BUF_N), "1000000000");
zsetu(a, 1000000001LL);
assert_s(zstr(a, buf, BUF_N), "1000000001");
zsetu(a, 2000000000LL);
assert_s(zstr(a, buf, BUF_N), "2000000000");
zsetu(a, 2050000000LL);
assert_s(zstr(a, buf, BUF_N), "2050000000");
zsetu(a, 2100000000LL);
assert_s(zstr(a, buf, BUF_N), "2100000000");
zsetu(a, 2140000000LL);
assert_s(zstr(a, buf, BUF_N), "2140000000");
zsetu(a, 2147000000LL);
assert_s(zstr(a, buf, BUF_N), "2147000000");
zsetu(a, 2147483000LL);
assert_s(zstr(a, buf, BUF_N), "2147483000");
zsetu(a, 2147483640LL);
assert_s(zstr(a, buf, BUF_N), "2147483640");
zsetu(a, 2147483646LL);
assert_s(zstr(a, buf, BUF_N), "2147483646");
zseti(a, 2147483647LL);
assert_s(zstr(a, buf, BUF_N), "2147483647");
zseti(a, -2147483647LL);
assert_s(zstr(a, buf, BUF_N), "-2147483647");
zseti(a, -2147483647LL - 1LL);
assert_s(zstr(a, buf, BUF_N), "-2147483648");
zsetu(a, 2147483647ULL);
assert_s(zstr(a, buf, BUF_N), "2147483647");
zsetu(a, 2147483648ULL);
assert_s(zstr(a, buf, BUF_N), "2147483648");
zsetu(a, 2147483649ULL);
assert_s(zstr(a, buf, BUF_N), "2147483649");
zsetu(a, 3000000000ULL);
assert_s(zstr(a, buf, BUF_N), "3000000000");
zsetu(a, 3100000000ULL);
assert_s(zstr(a, buf, BUF_N), "3100000000");
zsetu(a, 3200000000ULL);
assert_s(zstr(a, buf, BUF_N), "3200000000");
zsetu(a, 3300000000ULL);
assert_s(zstr(a, buf, BUF_N), "3300000000");
zsetu(a, 3400000000ULL);
assert_s(zstr(a, buf, BUF_N), "3400000000");
zsetu(a, 3500000000ULL);
assert_s(zstr(a, buf, BUF_N), "3500000000");
zsetu(a, 3600000000ULL);
assert_s(zstr(a, buf, BUF_N), "3600000000");
zsetu(a, 3700000000ULL);
assert_s(zstr(a, buf, BUF_N), "3700000000");
zsetu(a, 3800000000ULL);
assert_s(zstr(a, buf, BUF_N), "3800000000");
zsetu(a, 3900000000ULL);
assert_s(zstr(a, buf, BUF_N), "3900000000");
zsetu(a, 3999999999ULL);
assert_s(zstr(a, buf, BUF_N), "3999999999");
zsetu(a, 4000000000ULL);
assert_s(zstr(a, buf, BUF_N), "4000000000");
zsetu(a, 4000000001ULL);
assert_zu(zstr_length(a, 10), 10);
assert_s(zstr(a, buf, BUF_N), "4000000001");
zsetu(a, 4000000000ULL);
zsetu(b, 4000000000ULL);
zadd(c, a, a);
zsets(d, "8000000000");
assert(zcmp(c, d), == 0);
zadd(c, a, b);
assert(zcmp(c, d), == 0);
zadd(c, c, a);
zsets(d, "12000000000");
assert(zcmp(c, d), == 0);
zsub(c, c, a);
zsets(d, "8000000000");
assert(zcmp(c, d), == 0);
zsub(c, c, a);
zsets(d, "4000000000");
assert(zcmp(c, d), == 0);
zsets(d, "8000000000");
zrsh(d, d, 1);
assert(zcmp(c, d), == 0);
zsets(a, "6234216714");
zsets(b, "9424614147");
zsets(d, "830476546");
zand(c, a, b);
assert(zcmp(c, d), == 0);
zsets(a, "234216714");
zsets(b, "9424614147");
zsets(d, "9629466379");
zor(c, a, b);
assert(zcmp(c, d), == 0);
zsets(a, "6234216714");
zsets(b, "9424614147");
zsets(d, "13997877769");
zxor(c, a, b);
assert(zcmp(c, d), == 0);
zsets(a, "34216714");
zsets(b, "9424614147");
zsets(d, "9458821129");
zxor(c, a, b);
assert(zcmp(c, d), == 0);
zsetu(a, 1000000000ULL);
zsets(d, "1000000000000000000");
zmul(c, a, a);
assert(zcmp(c, d), == 0);
zdiv(c, c, a);
assert(zcmp(c, a), == 0);
zsetu(a, 1000000000ULL);
zsets(d, "1000000000000000000");
zsqr(c, a);
assert(zcmp(c, d), == 0);
zsetu(a, 1000000000ULL);
zmodpowu(c, a, 5, _3);
assert(zcmpu(c, 1), == 0);
zsetu(a, 1000000000ULL);
zsets(d, "1");
zpowu(c, a, 0);
assert(zcmp(c, d), == 0);
zsetu(a, 1000000000ULL);
zsets(d, "1000000000");
zpowu(c, a, 1);
assert(zcmp(c, d), == 0);
zsetu(a, 1000000000ULL);
zsets(d, "1000000000000000000");
zpowu(c, a, 2);
assert(zcmp(c, d), == 0);
zsetu(a, 1000000000ULL);
zsets(b, "1000000000000000000");
zsets(d, "1000000000000000000000000000");
zmul(c, a, b);
assert(zcmp(c, d), == 0);
zsetu(a, 1000000000ULL);
zsets(d, "1000000000000000000000000000");
zmul(b, a, a);
zmul(b, b, a);
assert(zcmp(c, d), == 0);
zsetu(a, 1000000000ULL);
zsets(d, "1000000000000000000000000000");
zpowu(c, a, 3);
assert(zcmp(c, d), == 0);
zsetu(a, 1000000000ULL);
zsets(d, "1000000000000000000000000000000000000");
zpowu(c, a, 4);
assert(zcmp(c, d), == 0);
zsetu(a, 1000000000ULL);
zsets(d, "1000000000000000000000000000000000000000000000");
zpowu(c, a, 5);
assert(zcmp(c, d), == 0);
zsetu(a, 4294967294ULL);
assert_s(zstr(a, buf, BUF_N), "4294967294");
zsetu(a, 4294967295ULL);
assert_s(zstr(a, buf, BUF_N), "4294967295");
zsetu(a, 4294967296ULL);
assert_s(zstr(a, buf, BUF_N), "4294967296");
zsetu(a, 4294967297ULL);
assert_s(zstr(a, buf, BUF_N), "4294967297");
zseti(a, 9223372036854775807LL);
assert_s(zstr(a, buf, BUF_N), "9223372036854775807");
zseti(a, -9223372036854775807LL);
assert_s(zstr(a, buf, BUF_N), "-9223372036854775807");
zseti(a, -9223372036854775807LL - 1LL);
assert_s(zstr(a, buf, BUF_N), "-9223372036854775808");
zsetu(a, 18446744073709551614ULL);
assert_s(zstr(a, buf, BUF_N), "18446744073709551614");
zsetu(a, 18446744073709551615ULL);
assert_s(zstr(a, buf, BUF_N), "18446744073709551615");
zadd(a, a, _1);
assert_s(zstr(a, buf, BUF_N), "18446744073709551616");
zadd(a, a, _1);
assert_s(zstr(a, buf, BUF_N), "18446744073709551617");
zsets(a, "1000000000000000000000000000000");
assert_s(zstr(a, buf, BUF_N), "1000000000000000000000000000000");
zsets(a, "+1000000000000000000000000000000");
assert_s(zstr(a, buf, BUF_N), "1000000000000000000000000000000");
zsets(a, "-1000000000000000000000000000000");
assert_s(zstr(a, buf, BUF_N), "-1000000000000000000000000000000");
zsetu(a, 1000000000000000ULL);
zsqr(a, a);
assert_s(zstr(a, buf, BUF_N), "1000000000000000000000000000000");
#include "test-random.c"
done:
zfree(a), zfree(b), zfree(c), zfree(d), zfree(_0), zfree(_1), zfree(_2), zfree(_3);
zunsetup();
return ret;
}
/* zQRcondest -- returns an estimate of the 2-norm condition number of the
matrix factorised by QRfactor() or QRCPfactor()
-- note that as Q does not affect the 2-norm condition number,
it is not necessary to pass the diag, beta (or pivot) vectors
-- generates a lower bound on the true condition number
-- if the matrix is exactly singular, HUGE_VAL is returned
-- note that QRcondest() is likely to be more reliable for
matrices factored using QRCPfactor() */
double zQRcondest(ZMAT *QR)
{
STATIC ZVEC *y=ZVNULL;
Real norm, norm1, norm2, tmp1, tmp2;
complex sum, tmp;
int i, j, limit;
if ( QR == ZMNULL )
error(E_NULL,"zQRcondest");
limit = min(QR->m,QR->n);
for ( i = 0; i < limit; i++ )
/* if ( QR->me[i][i] == 0.0 ) */
if ( is_zero(QR->me[i][i]) )
return HUGE_VAL;
y = zv_resize(y,limit);
MEM_STAT_REG(y,TYPE_ZVEC);
/* use the trick for getting a unit vector y with ||R.y||_inf small
from the LU condition estimator */
for ( i = 0; i < limit; i++ )
{
sum.re = sum.im = 0.0;
for ( j = 0; j < i; j++ )
/* sum -= QR->me[j][i]*y->ve[j]; */
sum = zsub(sum,zmlt(QR->me[j][i],y->ve[j]));
/* sum -= (sum < 0.0) ? 1.0 : -1.0; */
norm1 = zabs(sum);
if ( norm1 == 0.0 )
sum.re = 1.0;
else
{
sum.re += sum.re / norm1;
sum.im += sum.im / norm1;
}
/* y->ve[i] = sum / QR->me[i][i]; */
y->ve[i] = zdiv(sum,QR->me[i][i]);
}
zUAmlt(QR,y,y);
/* now apply inverse power method to R*.R */
for ( i = 0; i < 3; i++ )
{
tmp1 = zv_norm2(y);
zv_mlt(zmake(1.0/tmp1,0.0),y,y);
zUAsolve(QR,y,y,0.0);
tmp2 = zv_norm2(y);
zv_mlt(zmake(1.0/tmp2,0.0),y,y);
zUsolve(QR,y,y,0.0);
}
/* now compute approximation for ||R^{-1}||_2 */
norm1 = sqrt(tmp1)*sqrt(tmp2);
/* now use complementary approach to compute approximation to ||R||_2 */
for ( i = limit-1; i >= 0; i-- )
{
sum.re = sum.im = 0.0;
for ( j = i+1; j < limit; j++ )
sum = zadd(sum,zmlt(QR->me[i][j],y->ve[j]));
if ( is_zero(QR->me[i][i]) )
return HUGE_VAL;
tmp = zdiv(sum,QR->me[i][i]);
if ( is_zero(tmp) )
{
y->ve[i].re = 1.0;
y->ve[i].im = 0.0;
}
else
{
norm = zabs(tmp);
y->ve[i].re = sum.re / norm;
y->ve[i].im = sum.im / norm;
}
/* y->ve[i] = (sum >= 0.0) ? 1.0 : -1.0; */
/* y->ve[i] = (QR->me[i][i] >= 0.0) ? y->ve[i] : - y->ve[i]; */
}
/* now apply power method to R*.R */
for ( i = 0; i < 3; i++ )
{
tmp1 = zv_norm2(y);
zv_mlt(zmake(1.0/tmp1,0.0),y,y);
zUmlt(QR,y,y);
tmp2 = zv_norm2(y);
zv_mlt(zmake(1.0/tmp2,0.0),y,y);
zUAmlt(QR,y,y);
}
norm2 = sqrt(tmp1)*sqrt(tmp2);
/* printf("QRcondest: norm1 = %g, norm2 = %g\n",norm1,norm2); */
#ifdef THREADSAFE
ZV_FREE(y);
#endif
return norm1*norm2;
}
