void srk_exp(long exp, long k, verylong zg, verylong *zA)
{
long f[32], i, j, l, t;
verylong za = 0, *zg1;
l = pow(2, k);
zg1 = calloc(l, sizeof(verylong));
assert(zg1 != 0);
k_ary_string_replacement(exp, k, f, &t);
zcopy(zg, &zg1[1]);
for (i = 2; i <= k; i++) {
j = pow(2, i - 1) - 1;
l = pow(2, i) - 1;
zsq(zg1[j], &za);
zmul(za, zg, &zg1[l]);
}
zone(zA);
for (i = t - 1; i >= 0; i--) {
zsq(*zA, &za);
zcopy(za, zA);
j = f[i];
if (j != 0) {
zmul(*zA, zg1[j], &za);
zcopy(za, zA);
}
}
free(zg1);
zfree(&za);
}
void Garner(long t, verylong *zm, verylong *zv, verylong *zx)
/* solution of the Chinese remaider theorem */
{
long i, j;
verylong za = 0, zb = 0, zu = 0, zC[CRT_SIZE];
for (i = 0; i < CRT_SIZE; i++) zC[i] = 0;
for (i = 1; i < t; i++) {
zone(&zC[i]);
for (j = 0; j <= i - 1; j++) {
zinvmod(zm[j], zm[i], &zu);
zmulmod(zu, zC[i], zm[i], &za);
zcopy(za, &zC[i]);
}
}
zcopy(zv[0], &zu);
zcopy(zu, zx);
for (i = 1; i < t; i++) {
zsub(zv[i], *zx, &za);
zmulmod(za, zC[i], zm[i], &zu);
zone(&za);
for (j = 0; j <= i - 1; j++) {
zmul(za, zm[j], &zb);
zcopy(zb, &za);
}
zmul(za, zu, &zb);
zadd(*zx, zb, &za);
zcopy(za, zx);
}
zfree(&za);
zfree(&zb);
zfree(&zu);
for (i = 0; i < CRT_SIZE; i++) zfree(&zC[i]);
}
int BabyStepGiantStep(verylong zalpha, verylong zbeta,
verylong zn, verylong zp, verylong *zx)
/* given a generator alpha of a cyclic group G of
order n and an element beta compute the discrete
logarithm x returns 0 if not enough memory
for the problem 1 otherwise */
{
long i, j, m;
static verylong za = 0, zd = 0, zg = 0, zm = 0;
struct Element *element, temp;
zsqrt(zn, &za, &zd);
zsadd(za, 1l, &zm);
m = ztoint(zm);
element = (struct Element *) malloc(m * sizeof(struct Element));
if (element == 0) return 0;
zone(&zd);
/* construct table */
for (i = 0; i < m; i++) {
element[i].index = i;
element[i].alpha_index = 0;
zcopy(zd, &element[i].alpha_index);
zmul(zd, zalpha, &za);
zmod(za, zp, &zd);
}
/* sort on second values */
for (i = 0; i < m - 1; i++) {
for (j = i + 1; j < m; j++) {
if (zcompare(element[i].alpha_index, element[j].alpha_index) > 0) {
temp = element[i];
element[i] = element[j];
element[j] = temp;
}
}
}
zinvmod(zalpha, zp, &za);
zexp(za, zm, &zg);
zmod(zg, zp, &zd);
zcopy(zbeta, &zg);
for (i = 0; i < m; i++) {
printf("%d ", element[i].index);
zwriteln(element[i].alpha_index);
}
for (i = 0; i < m; i++) {
j = Find(m, zg, element);
if (j != - 1) {
zsmul(zm, i, &za);
zsadd(za, j, zx);
for (j = 0; j < m; j++)
zfree(&element[j].alpha_index);
free(element);
return 1;
}
zmul(zg, zd, &za);
zmod(za, zp, &zg);
}
return 0;
}
void SWAP(long k, long k1, long kmax, long n,
verylong *zd, verylong **zb,
verylong **zh, verylong **zl)
{
long i, j;
verylong zB = 0, zm = 0, zr = 0, zs = 0, zt = 0;
verylong zu = 0;
for (i = 1; i <= n; i++) {
zcopy(zh[i][k], &zt);
zcopy(zh[i][k1], &zh[i][k]);
zcopy(zt, &zh[i][k1]);
}
for (j = 1; j <= n; j++) {
zcopy(zb[k][j], &zt);
zcopy(zb[k1][j], &zb[k][j]);
zcopy(zt, &zb[k1][j]);
}
if (k > 2) {
for (j = 1; j <= k - 2; j++) {
zcopy(zl[k][j], &zt);
zcopy(zl[k1][j], &zl[k][j]);
zcopy(zt, &zl[k1][j]);
}
}
zcopy(zl[k][k1], &zm);
zmul(zd[k - 2], zd[k], &zr);
zsq(zm, &zs);
zadd(zr, zs, &zt);
zdiv(zt, zd[k1], &zB, &zr);
for (i = k + 1; i <= kmax; i++) {
zcopy(zl[i][k], &zt);
zmul(zd[k], zl[i][k1], &zr);
zmul(zm, zt, &zs);
zsub(zr, zs, &zu);
zdiv(zu, zd[k1], &zl[i][k], &zr);
zmul(zB, zt, &zr);
zmul(zm, zl[i][k], &zs);
zadd(zr, zs, &zu);
zdiv(zu, zd[k], &zl[i][k1], &zr);
}
zcopy(zB, &zd[k1]);
zfree(&zB);
zfree(&zm);
zfree(&zr);
zfree(&zs);
zfree(&zt);
zfree(&zu);
}
/*==================================================================
* Convert response to velocity first, then to specified units
*=================================================================*/
void convert_to_units(int inp, char *out_units, struct complex *data, double w) {
int out, l;
struct complex scale_val;
/* if default units were specified by the user, no conversion is made,
otherwise convert to unit the user specified. */
if (out_units != NULL && (l=strlen(out_units)) > 0) {
curr_seq_no = -1;
if(!strncmp(out_units, "DEF", 3))
return;
else if(!strncmp(out_units, "DIS", 3)) out = DIS;
else if(!strncmp(out_units, "VEL", 3)) out = VEL;
else if(!strncmp(out_units, "ACC", 3)) out = ACC;
else {
error_return(BAD_OUT_UNITS, "convert_to_units: bad output units");
}
}
else out = VEL;
if (inp == DIS) {
if (out == DIS) return;
if (w != 0.0) {
scale_val.real = 0.0; scale_val.imag = -1.0/w;
zmul(data, &scale_val);
}
else data->real = data->imag = 0.0;
}
else if (inp == ACC) {
if (out == ACC) return;
scale_val.real = 0.0; scale_val.imag = w;
zmul(data, &scale_val);
}
if (out == DIS) {
scale_val.real = 0.0; scale_val.imag = w;
zmul(data, &scale_val);
}
else if (out == ACC) {
if (w != 0.0) {
scale_val.real = 0.0; scale_val.imag = -1.0/w;
zmul(data, &scale_val);
}
else data->real = data->imag = 0.0;
}
}
/*==================================================================
* Response of analog filter
*=================================================================*/
void analog_trans(struct blkt *blkt_ptr, double freq, struct complex *out) {
int nz, np, i;
struct complex *ze, *po, denom, num, omega, temp;
double h0, mod_squared;
if (blkt_ptr->type == LAPLACE_PZ) freq = twoPi * freq;
omega.imag = freq;
omega.real = 0.0;
denom.real = denom.imag = num.real = num.imag = 1.0;
ze = blkt_ptr->blkt_info.pole_zero.zeros;
nz = blkt_ptr->blkt_info.pole_zero.nzeros;
po = blkt_ptr->blkt_info.pole_zero.poles;
np = blkt_ptr->blkt_info.pole_zero.npoles;
h0 = blkt_ptr->blkt_info.pole_zero.a0;
for (i = 0; i < nz; i++) {
/* num=num*(omega-zero[i]) */
temp.real = omega.real - ze[i].real;
temp.imag = omega.imag - ze[i].imag;
zmul(&num, &temp);
}
for (i = 0; i < np; i++) {
/* denom=denom*(omega-pole[i]) */
temp.real = omega.real - po[i].real;
temp.imag = omega.imag - po[i].imag;
zmul(&denom, &temp);
}
/* gain*num/denum */
temp.real = denom.real;
temp.imag = -denom.imag;
zmul(&temp, &num);
mod_squared = denom.real*denom.real + denom.imag*denom.imag;
temp.real /= mod_squared;
temp.imag /= mod_squared;
out->real = h0 * temp.real;
out->imag = h0 * temp.imag;
}
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 scalar(long n, verylong *za, verylong *zb,
verylong *zs)
{
/* *s = inner_product(a, b) */
long i;
verylong zt = 0, zu = 0;
zzero(zs);
for (i = 1; i <= n; i++) {
zmul(za[i], zb[i], &zt);
zadd(zt, *zs, &zu);
zcopy(zu, zs);
}
zfree(&zt);
zfree(&zu);
}
int main(void)
{
verylong zM = 0, zN = 0, zd = 0, ze = 0, zn = 0;
verylong zp = 0, zq = 0, zx = 0;
RSA_gen_keys(128l, &zd, &ze, &zp, &zq);
zintoz(65537l, &zx);
RSA_exponentiation(zx, zd, zp, zq, &zM);
zmul(zp, zq, &zn);
zexpmod(zx, zd, zn, &zN);
if (zcompare(zM, zN) == 0)
printf("RSA_exponentiation confirmed\n");
else
printf("*error*\nin RSA_exponentiation\n");
zfree(&zM);
zfree(&zN);
zfree(&zd);
zfree(&ze);
zfree(&zn);
zfree(&zp);
zfree(&zq);
zfree(&zx);
return 0;
}
void RSA_gen_keys(long length, verylong *zd,
verylong *ze, verylong *zp,
verylong *zq)
{
verylong zp1 = 0, zq1 = 0;
verylong zphi = 0, zx = 0;
srand(time(NULL));
zrstarts(time(NULL));
PROVABLE_PRIME(length, zp);
PROVABLE_PRIME(length, zq);
zsadd(*zp, - 1l, &zp1);
zsadd(*zq, - 1l, &zq1);
zmul(zp1, zq1, &zphi);
do {
do zrandomb(zphi, ze); while (zscompare(*ze, 1l) <= 0);
zgcd(*ze, zphi, &zx);
} while (zscompare(zx, 1l) != 0);
zinvmod(*ze, zphi, zd);
zfree(&zp1);
zfree(&zq1);
zfree(&zphi);
zfree(&zx);
}
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) ; }
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;
}
void zbinary_ext_gcd(verylong zx, verylong zy,
verylong *za, verylong *zb,
verylong *zv)
/* returns a * x + b * y = v, v = gcd(x, y) */
{
verylong zA = 0, zB = 0, zC = 0, zD = 0;
verylong zX = 0, zY = 0, zc = 0, zg = 0;
verylong zu = 0;
zone(&zg);
zcopy(zx, &zX);
zcopy(zy, &zY);
while (!zodd(zX) && !zodd(zY)) {
zrshift(zX, 1l, &zc);
zcopy(zc, &zX);
zrshift(zY, 1l, &zc);
zcopy(zc, &zY);
zlshift(zg, 1l, &zc);
zcopy(zc, &zg);
}
zcopy(zX, &zu);
zcopy(zY, zv);
zone(&zA);
zzero(&zB);
zzero(&zC);
zone(&zD);
do {
while (!zodd(zu)) {
zrshift(zu, 1l, &zc);
zcopy(zc, &zu);
if (!zodd(zA) && !zodd(zB)) {
zrshift(zA, 1l, &zc);
zcopy(zc, &zA);
zrshift(zB, 1l, &zc);
zcopy(zc, &zB);
}
else {
zadd(zA, zY, &zc);
zrshift(zc, 1l, &zA);
zsub(zB, zX, &zc);
zrshift(zc, 1l, &zB);
}
}
while (!zodd(*zv)) {
zrshift(*zv, 1l, &zc);
zcopy(zc, zv);
if (!zodd(zC) && !zodd(zD)) {
zrshift(zC, 1l, &zc);
zcopy(zc, &zC);
zrshift(zD, 1l, &zc);
zcopy(zc, &zD);
}
else {
zadd(zC, zY, &zc);
zrshift(zc, 1l, &zC);
zsub(zD, zX, &zc);
zrshift(zc, 1l, &zD);
}
}
if (zcompare(zu, *zv) >= 0) {
zsub(zu, *zv, &zc);
zcopy(zc, &zu);
zsub(zA, zC, &zc);
zcopy(zc, &zA);
zsub(zB, zD, &zc);
zcopy(zc, &zB);
}
else {
zsub(*zv, zu, &zc);
zcopy(zc, zv);
zsub(zC, zA, &zc);
zcopy(zc, &zC);
zsub(zD, zB, &zc);
zcopy(zc, &zD);
}
#ifdef DEBUG
zwrite(zu); printf(" ");
zwrite(*zv); printf(" ");
zwrite(zA); printf(" ");
zwrite(zB); printf(" ");
zwrite(zC); printf(" ");
zwriteln(zD);
#endif
} while (zscompare(zu, 0l) != 0);
zcopy(zC, za);
zcopy(zD, zb);
zmul(zg, *zv, &zc);
zcopy(zc, zv);
zfree(&zA);
zfree(&zB);
zfree(&zC);
zfree(&zD);
zfree(&zX);
zfree(&zY);
zfree(&zc);
zfree(&zg);
zfree(&zu);
}
int simultaneous_diophantine(double delta,
long n,
verylong zQ,
verylong *zP,
verylong *zp,
verylong *zq)
{
double P, Q, l;
int equal, found;
long i, j, n1 = n + 1;
verylong zd = 0, zl = 0, zr = 0, zs = 0, zt = 0;
verylong **zA = allocate_very_matrix(1, n1, 1, n1);
verylong **zh = allocate_very_matrix(1, n1, 1, n1);
Q = zdoub(zQ);
zintoz(pow(Q, delta), &zl);
l = 1.0 / zdoub(zl);
zmul(zl, zQ, &zd);
for (i = 1; i <= n; i++)
zcopy(zd, &zA[i][i]);
znegate(&zl);
for (i = 1; i <= n; i++)
zmul(zl, zq[i], &zA[n1][i]);
zone(&zA[n1][n1]);
int_LLL(n1, zA, zh);
found = 0;
for (j = 1; !found && j <= n1; j++) {
zcopy(zA[j][n1], zP);
if (zcompare(*zP, zQ) != 0) {
for (i = 1; i <= n; i++) {
zdiv(zA[j][i], zl, &zr, &zs);
zmul(*zP, zq[i], &zt);
zadd(zr, zt, &zs);
zdiv(zs, zQ, &zp[i], &zr);
}
P = zdoub(*zP);
#ifdef DEBUG
if (n <= 16) {
printf("p = ");
zwrite(*zP);
printf(" p[i] ");
for (i = 1; i <= n; i++) {
zwrite(zp[i]);
printf(" ");
}
printf("\n");
}
#endif
if (zcompare(*zP, 0) != 0) {
equal = 1;
for (i = 1; equal && i <= n; i++)
equal = fabs(P * zdoub(zq[i]) / Q - zdoub(zp[i]))
<= l;
}
else equal = 0;
found = equal;
}
}
free_very_matrix(zA, 1, n1, 1, n1);
free_very_matrix(zh, 1, n1, 1, n1);
zfree(&zd);
zfree(&zl);
zfree(&zr);
zfree(&zs);
zfree(&zt);
return found;
}
void int_LLL(long n, verylong **zb, verylong **zh)
{
double x, y;
long i, j, k = 2, k1, kmax = 1, l;
verylong zr = 0, zs = 0, zt = 0, zu = 0;
verylong *zB = allocate_very_vector(1, n);
verylong *zd = allocate_very_vector(0, n);
verylong **zl = allocate_very_matrix(1, n, 1, n);
zone(&zd[0]);
scalar(n, zb[1], zb[1], &zd[1]);
for (i = 1; i <= n; i++) {
for (j = 1; j <= n; j++)
zzero(&zh[i][j]);
zone(&zh[i][i]);
}
#ifdef DEBUG
if (n <= 17) {
printf("the basis to be reduced is:\n");
for (i = 1; i <= n; i++) {
for (j = 1; j <= n; j++) {
zwrite(zb[i][j]);
printf(" ");
}
printf("\n");
}
}
#endif
L2:
if (k <= kmax) goto L3;
kmax = k;
for (j = 1; j <= k; j++) {
scalar(n, zb[k], zb[j], &zu);
for (i = 1; i <= j - 1; i++) {
zmul(zd[i], zu, &zr);
zmul(zl[k][i], zl[j][i], &zs);
zsub(zr, zs, &zt);
zdiv(zt, zd[i - 1], &zu, &zr);
}
if (j < k) zcopy(zu, &zl[k][j]);
else if (j == k) {
zcopy(zu, &zd[k]);
if (zscompare(zd[k], 0l) == 0)
system_error("Failure in int_LLL.");
}
}
L3:
k1 = k - 1;
RED(k, k1, n, zd, zb, zh, zl);
zmul(zd[k], zd[k - 2], &zr);
zsq(zd[k1], &zs);
zsq(zl[k][k1], &zt);
x = zdoub(zr);
y = 3.0 * zdoub(zs) / 4.0 - zdoub(zt);
if (x < y) {
SWAP(k, k1, kmax, n, zd, zb, zh, zl);
k = max(2, k1);
goto L3;
}
for (l = k - 2; l >= 1; l--)
RED(k, l, n, zd, zb, zh, zl);
if (++k <= n) goto L2;
#ifdef DEBUG
if (n <= 17) {
printf("the LLL-reduced basis is:\n");
for (i = 1; i <= n; i++) {
for (j = 1; j <= n; j++) {
zwrite(zb[i][j]);
printf(" ");
}
printf("\n");
}
}
#endif
free_very_matrix(zl, 1, n, 1, n);
free_very_vector(zB, 1, n);
free_very_vector(zd, 0, n);
zfree(&zr);
zfree(&zs);
zfree(&zt);
zfree(&zu);
}
void PROVABLE_PRIME(long k, verylong *zn)
{
double c, r, s;
int success;
long B, m, n, p, sqrtn;
verylong zI = 0, zR = 0, za = 0, zb = 0, zc = 0;
verylong zd = 0, zk = 0, zl = 0, zq = 0, zu = 0;
if (k <= 20) {
do {
n = OddRandom(k);
sqrtn = sqrt(n);
zpstart2();
do p = zpnext(); while (n % p != 0 && p < sqrtn);
} while (p < sqrtn);
zintoz(n, zn);
}
else {
c = 0.1;
m = 20;
B = c * k * k;
if (k > 2 * m)
do {
s = rand() / (double) RAND_MAX;
r = pow(2.0, s - 1.0);
} while (k - r * k <= m);
else
r = 0.5;
PROVABLE_PRIME(r * k + 1, &zq);
zone(&za);
zlshift(za, k - 1, &zk);
zcopy(zq, &za);
zlshift(za, 1l, &zl);
zdiv(zk, zl, &zI, &za);
zsadd(zI, 1l, &zl);
zlshift(zI, 1l, &zu);
success = 0;
while (!success) {
do zrandomb(zu, &zR); while (zcompare(zR, zl) < 0);
zmul(zR, zq, &za);
zlshift(za, 1l, &zb);
zsadd(zb, 1l, zn);
zcopy(zR, &za);
zlshift(za, 1l, &zR);
zpstart2();
p = zpnext();
while (zsmod(*zn, p) != 0 && p < B) p = zpnext();
if (p >= B) {
zcopy(*zn, &zc);
zsadd(zc, - 2l, &zb);
do
zrandomb(*zn, &za);
while (zscompare(za, 2l) < 0 || zcompare(za, zb) > 0);
zsadd(*zn, - 1l, &zc);
zexpmod(za, zc, *zn, &zb);
if (zscompare(zb, 1l) == 0) {
zexpmod(za, zR, *zn, &zb);
zcopy(zb, &zd);
zsadd(zd, - 1l, &zb);
zgcd(zb, *zn, &zd);
success = zscompare(zd, 1l) == 0;
}
}
}
}
zfree(&zI);
zfree(&zR);
zfree(&za);
zfree(&zb);
zfree(&zc);
zfree(&zd);
zfree(&zk);
zfree(&zl);
zfree(&zq);
zfree(&zu);
}
/*=================================================================
* Calculate response
*=================================================================*/
void calc_resp(struct channel *chan, double *freq, int nfreqs, struct complex *output,
char *out_units, int start_stage, int stop_stage, int useTotalSensitivityFlag) {
struct blkt *blkt_ptr;
struct stage *stage_ptr;
int i, j, units_code, eval_flag = 0, nc = 0, sym_fir = 0;
double w;
int matching_stages = 0, has_stage0 = 0, deciStageEvaluated = 0;
struct complex of, val;
double corr_applied, estim_delay, delay;
/* if(start_stage && start_stage > chan->nstages) {
error_return(NO_STAGE_MATCHED, "calc_resp: %s start_stage=%d, highest stage found=%d)",
"No Matching Stages Found (requested",start_stage, chan->nstages);
} */
/* for each frequency */
for(i = 0; i < nfreqs; i++) {
w = twoPi * freq[i];
val.real = 1.0; val.imag = 0.0;
/* loop through the stages and filters for each stage, calculating
the response for each frequency for all stages */
stage_ptr = chan->first_stage;
units_code = stage_ptr->input_units;
for(j = 0; j < chan->nstages; j++) {
nc = 0;
sym_fir = 0;
deciStageEvaluated = 0;
if(!stage_ptr->sequence_no)
has_stage0 = 1;
if(start_stage >= 0 && stop_stage && (stage_ptr->sequence_no < start_stage ||
stage_ptr->sequence_no > stop_stage)) {
stage_ptr = stage_ptr->next_stage;
continue;
}
else if(start_stage >= 0 && !stop_stage && stage_ptr->sequence_no != start_stage) {
stage_ptr = stage_ptr->next_stage;
continue;
}
matching_stages++;
blkt_ptr = stage_ptr->first_blkt;
while(blkt_ptr) {
eval_flag = 0;
switch(blkt_ptr->type) {
case ANALOG_PZ:
case LAPLACE_PZ:
analog_trans(blkt_ptr, freq[i], &of);
eval_flag = 1;
break;
case IIR_PZ:
if(blkt_ptr->blkt_info.pole_zero.nzeros || blkt_ptr->blkt_info.pole_zero.npoles) {
iir_pz_trans(blkt_ptr, w, &of);
eval_flag = 1;
}
break;
case FIR_SYM_1:
case FIR_SYM_2:
if(blkt_ptr->type == FIR_SYM_1)
nc = (double) blkt_ptr->blkt_info.fir.ncoeffs*2 - 1;
else if(blkt_ptr->type == FIR_SYM_2)
nc = (double) blkt_ptr->blkt_info.fir.ncoeffs*2;
if(blkt_ptr->blkt_info.fir.ncoeffs) {
fir_sym_trans(blkt_ptr, w, &of);
sym_fir = 1;
eval_flag = 1;
}
break;
case FIR_ASYM:
nc = (double) blkt_ptr->blkt_info.fir.ncoeffs;
if(blkt_ptr->blkt_info.fir.ncoeffs) {
fir_asym_trans(blkt_ptr, w, &of);
sym_fir = -1;
eval_flag = 1;
}
break;
case DECIMATION:
if(nc != 0) {
/* IGD 08/27/08 Use estimated delay instead of calculated */
estim_delay = (double) blkt_ptr->blkt_info.decimation.estim_delay;
corr_applied = blkt_ptr->blkt_info.decimation.applied_corr;
/* Asymmetric FIR coefficients require a delay correction */
if ( sym_fir == -1 ) {
if (TRUE == use_delay(QUERY_DELAY))
delay = estim_delay;
else
delay = corr_applied;
}
/* Otherwise delay has already been handled in fir_sym_trans() */
else {
delay = 0;
}
calc_time_shift (delay, w, &of);
eval_flag = 1;
}
break;
case LIST: /* This option is added in version 2.3.17 I.Dricker*/
calc_list (blkt_ptr, i, &of); /*compute real and imag parts for the i-th ampl and phase */
eval_flag = 1;
break;
case IIR_COEFFS: /* This option is added in version 2.3.17 I.Dricker*/
iir_trans(blkt_ptr, w, &of);
eval_flag = 1;
break;
default:
break;
}
if(eval_flag)
zmul(&val, &of);
blkt_ptr = blkt_ptr->next_blkt;
}
stage_ptr = stage_ptr->next_stage;
}
/* if no matching stages were found, then report the error */
if(!matching_stages && !has_stage0) {
error_return(NO_STAGE_MATCHED, "calc_resp: %s start_stage=%d, highest stage found=%d)",
"No Matching Stages Found (requested",start_stage, chan->nstages);
}
else if(!matching_stages) {
error_return(NO_STAGE_MATCHED, "calc_resp: %s start_stage=%d, highest stage found=%d)",
"No Matching Stages Found (requested",start_stage, chan->nstages-1);
}
/* Write output for freq[i] in output[i] (note: unitScaleFact is a global variable
set by the 'check_units' function that is used to convert to 'MKS' units when the
the response was given as a displacement, velocity, or acceleration in units other
than meters) */
if (0 == useTotalSensitivityFlag) {
output[i].real = val.real * chan->calc_sensit * unitScaleFact;
output[i].imag = val.imag * chan->calc_sensit * unitScaleFact;
}
else {
output[i].real = val.real * chan->sensit * unitScaleFact;
output[i].imag = val.imag * chan->sensit * unitScaleFact;
}
convert_to_units(units_code, out_units, &output[i], w);
}
}
int DenseMtx_mmm(
char *A_opt,
char *B_opt,
double *beta,
DenseMtx *mtxC,
double *alpha,
DenseMtx *mtxA,
DenseMtx *mtxB
)
{
int nrowA, ncolA, rowincA, colincA;
int nrowB, ncolB, rowincB, colincB;
int nrowC, ncolC, rowincC, colincC;
int ierr, i, k, j, l;
double *Ai, *Bj, *Ci, r_alpha, r_beta, r_temp, im_temp, im_alpha, im_beta;
double one[2]={1.0, 0.0}, zero[2]={0.0, 0.0}, aconj[2], bconj[2] ;
double temp[2]={0.0, 0.0}, result[2]={1.0, 0.0} ;
if ( beta == NULL || alpha == NULL || mtxC == NULL ||
mtxA == NULL || mtxB == NULL ){
fprintf(stderr, "\n fatal error in Input"
"\n one or more of beta, alpha, mtxC, mtxB and"
" mtxA is NULL\n") ;
return(-1) ;
}
if ( (DENSEMTX_IS_REAL(mtxA) != DENSEMTX_IS_REAL(mtxB)) ||
(DENSEMTX_IS_REAL(mtxA) != DENSEMTX_IS_REAL(mtxC)) ){
fprintf(stderr,"mtxA, mtxB and mtxC do not have the same data type\n");
return(-2);
}
DenseMtx_dimensions(mtxA, &nrowA, &ncolA);
DenseMtx_dimensions(mtxB, &nrowB, &ncolB);
DenseMtx_dimensions(mtxC, &nrowC, &ncolC);
rowincA=DenseMtx_rowIncrement(mtxA);
colincA=DenseMtx_columnIncrement(mtxA);
rowincB=DenseMtx_rowIncrement(mtxB);
colincB=DenseMtx_columnIncrement(mtxB);
rowincC=DenseMtx_rowIncrement(mtxC);
colincC=DenseMtx_columnIncrement(mtxC);
r_alpha=*alpha;
r_beta =*beta;
r_temp =*temp;
if ( B_opt[0] == 'N' || B_opt[0] == 'n' ){
if (A_opt[0] == 'N' || A_opt[0] == 'n'){/*Form C := beta*c+alpha*A*B*/
if (ncolA != nrowB || nrowC != nrowA || ncolC != ncolB) {
fprintf(stderr,"Error in Input DenseMtx_mmm\n");
return(-3);
}
} else if ( (A_opt[0] == 'T' || A_opt[0] == 't') ||
(A_opt[0] == 'C' || A_opt[0] == 'c') ){
if (nrowA != nrowB || nrowC != ncolA || ncolC != ncolB) {
fprintf(stderr,"Error in Input DenseMtx_mmm\n");
exit(-3);
}
} else {
fprintf(stderr,"Invalid option for mtxA\n");
return(-4);
}
} else if ( (B_opt[0] == 'T' || B_opt[0] == 't') ||
(B_opt[0] == 'C' || B_opt[0] == 'c') ){
if (A_opt[0] == 'N' || A_opt[0] == 'n'){
if (ncolA != ncolB || nrowC != nrowA || ncolC != nrowB) {
fprintf(stderr,"Error in Input DenseMtx_mmm\n");
return(-3);
}
} else if ( (A_opt[0] == 'T' || A_opt[0] == 't') ||
(A_opt[0] == 'C' || A_opt[0] == 'c') ){
if (nrowA != ncolB || nrowC != ncolA || ncolC != nrowB) {
fprintf(stderr,"Error in Input DenseMtx_mmm\n");
return(-3);
}
} else {
fprintf(stderr,"Invalid option for mtxA\n");
return(-4);
}
} else {
fprintf(stderr,"Invalid option for mtxB\n");
return(-4);
}
if (DENSEMTX_IS_REAL(mtxA)) {
if ( r_alpha == *zero ) {
if( r_beta == *zero ) {
DenseMtx_zero (mtxC);
} else {
DenseMtx_scale(mtxC,&r_beta);
}
return(1);
}
if ( B_opt[0] == 'N' || B_opt[0] == 'n' ){
if (A_opt[0] == 'N' || A_opt[0] == 'n'){/*Form C := beta*c+alpha*A*B*/
for (i=0; i<nrowA; i++){
ierr=DenseMtx_row(mtxA, i, &Ai);
ierr=DenseMtx_row(mtxC, i, &Ci);
for (j=0; j<ncolB; j++){
ierr=DenseMtx_column(mtxB, j, &Bj);
r_temp = 0.0;
for (k=0; k<ncolA; k++){
r_temp += Ai[k*colincA]*Bj[k*rowincB];
}
if( r_beta == *zero ){
Ci[j*colincC] = r_alpha*r_temp;
} else {
Ci[j*colincC] = r_alpha*r_temp + r_beta*Ci[j*colincC];
}
}
}
} else {/* Form C := alpha*AT*B + beta*C. */
for (i=0; i<ncolA; i++){
ierr=DenseMtx_column(mtxA, i, &Ai);
ierr=DenseMtx_row(mtxC, i, &Ci);
for (j=0; j<ncolB; j++){
ierr=DenseMtx_column(mtxB, j, &Bj);
r_temp = 0.0;
for (k=0; k<nrowA; k++){
r_temp += Ai[k*rowincA]*Bj[k*rowincB];
}
if( r_beta == *zero ){
Ci[j*colincC] = r_alpha*r_temp;
} else {
Ci[j*colincC] = r_alpha*r_temp + r_beta*Ci[j*colincC];
}
}
}
}
} else {
if (A_opt[0] == 'N' || A_opt[0] == 'n'){/*Form C := alpha*A*B'+beta*C */
for (i=0; i<nrowA; i++){
ierr=DenseMtx_row(mtxA, i, &Ai);
ierr=DenseMtx_row(mtxC, i, &Ci);
for (j=0; j<nrowB; j++){
ierr=DenseMtx_row(mtxB, j, &Bj);
r_temp = 0.0;
for (k=0; k<ncolA; k++){
r_temp += Ai[k*colincA]*Bj[k*colincB];
}
if( r_beta == *zero ){
Ci[j*colincC] = r_alpha*r_temp;
} else {
Ci[j*colincC] = r_alpha*r_temp + r_beta*Ci[j*colincC];
}
}
}
} else { /* Form C := alpha*A'*B' + beta*C */
for (i=0; i<ncolA; i++){
ierr=DenseMtx_column(mtxA, i, &Ai);
ierr=DenseMtx_row(mtxC, i, &Ci);
for (j=0; j<nrowB; j++){
ierr=DenseMtx_row(mtxB, j, &Bj);
r_temp = 0.0;
for (k=0; k<nrowA; k++){
r_temp += Ai[k*rowincA]*Bj[k*colincB];
}
if( r_beta == *zero ){
Ci[j*colincC] = r_alpha*r_temp;
} else {
Ci[j*colincC] = r_alpha*r_temp + r_beta*Ci[j*colincC];
}
}
}
}
}
} else { /* complex case */
rowincA *= 2;
rowincB *= 2;
rowincC *= 2;
colincA *= 2;
colincB *= 2;
colincC *= 2;
im_alpha=*(alpha+1);
im_beta =*(beta+1);
im_temp =*(temp+1);
if ( r_alpha == *zero && im_alpha == *zero ) {
if( r_beta == *zero && im_beta == *zero ) {
DenseMtx_zero (mtxC);
} else {
DenseMtx_scale(mtxC,beta);
}
return(1);
}
if ( B_opt[0] == 'N' || B_opt[0] == 'n' ){
if (A_opt[0] == 'N' || A_opt[0] == 'n'){/*Form C := beta*c+alpha*A*B*/
for (i=0; i<nrowA; i++){
ierr=DenseMtx_row(mtxA, i, &Ai);
ierr=DenseMtx_row(mtxC, i, &Ci);
for (j=0; j<ncolB; j++){
temp[0] = 0.0;
temp[1] = 0.0;
ierr=DenseMtx_column(mtxB, j, &Bj);
for (k=0; k<ncolA; k++){
zmul(&Ai[k*colincA],&Bj[k*rowincB],result);
zadd(temp,result,temp);
}
if( r_beta == *zero && im_beta == *zero ){
zmul(alpha,temp,&Ci[j*colincC]);
} else {
zmul(beta,&Ci[j*colincC],&Ci[j*colincC]);
zmul(alpha,temp,temp);
zadd(temp,&Ci[j*colincC],&Ci[j*colincC]);
}
}
}
} else {/* Form C := alpha*AT*B + beta*C. */
for (i=0; i<ncolA; i++){
ierr=DenseMtx_column(mtxA, i, &Ai);
ierr=DenseMtx_row(mtxC, i, &Ci);
for (j=0; j<ncolB; j++){
ierr=DenseMtx_column(mtxB, j, &Bj);
temp[0] = 0.0;
temp[1] = 0.0;
for (k=0; k<nrowA; k++){
if (A_opt[0] == 'C' || A_opt[0] == 'c'){
/* Form C := alpha*conjg( A')*B + beta*C. */
aconj[0] = Ai[k*rowincA];
aconj[1] = -Ai[k*rowincA+1];
zmul(aconj,&Bj[k*rowincB],result);
} else {
zmul(&Ai[k*rowincA],&Bj[k*rowincB],result);
}
zadd(temp,result,temp);
}
if( r_beta == *zero ){
zmul(alpha,temp,&Ci[j*colincC]);
} else {
zmul(alpha,temp,temp);
zmul(beta,&Ci[j*colincC],&Ci[j*colincC]);
zadd(temp,&Ci[j*colincC],&Ci[j*colincC]);
}
}
}
}
} else if ( B_opt[0] == 'T' || B_opt[0] == 'T' ){
if (A_opt[0] == 'N' || A_opt[0] == 'n'){/*Form C := alpha*A*B'+beta*C */
for (i=0; i<nrowA; i++){
ierr=DenseMtx_row(mtxA, i, &Ai);
ierr=DenseMtx_row(mtxC, i, &Ci);
for (j=0; j<nrowB; j++){
ierr=DenseMtx_row(mtxB, j, &Bj);
temp[0] = 0.0;
temp[1] = 0.0;
for (k=0; k<ncolA; k++){
zmul(&Ai[k*colincA],&Bj[k*colincB],result);
zadd(temp,result,temp);
}
if( r_beta == *zero ){
zmul(alpha,temp,&Ci[j*colincC]);
} else {
zmul(alpha,temp,temp);
zmul(beta,&Ci[j*colincC],&Ci[j*colincC]);
zadd(temp,&Ci[j*colincC],&Ci[j*colincC]);
}
}
}
} else { /* Form C := alpha*A'*B' + beta*C */
for (i=0; i<ncolA; i++){
ierr=DenseMtx_column(mtxA, i, &Ai);
ierr=DenseMtx_row(mtxC, i, &Ci);
for (j=0; j<nrowB; j++){
ierr=DenseMtx_row(mtxB, j, &Bj);
temp[0] = 0.0;
temp[1] = 0.0;
for (k=0; k<nrowA; k++){
if (A_opt[0] == 'C' || A_opt[0] == 'c'){
/* Form C := alpha*conjg( A')*B' + beta*C. */
aconj[0] = Ai[k*rowincA];
aconj[1] = (-1)*Ai[k*rowincA+1];
zmul(aconj,&Bj[k*rowincB],result);
} else {
zmul(&Ai[k*rowincA],&Bj[k*rowincB],result);
}
zadd(temp,result,temp);
}
if( r_beta == *zero ){
zmul(alpha,temp,&Ci[j*colincC]);
} else {
zmul(alpha,temp,temp);
zmul(beta,&Ci[j*colincC],&Ci[j*colincC]);
zadd(temp,&Ci[j*colincC],&Ci[j*colincC]);
}
}
}
}
} else {
if (A_opt[0] == 'N' || A_opt[0] == 'n'){
/*Form C := alpha*A*conjg(B')+beta*C */
for (i=0; i<nrowA; i++){
ierr=DenseMtx_row(mtxA, i, &Ai);
ierr=DenseMtx_row(mtxC, i, &Ci);
for (j=0; j<nrowB; j++){
ierr=DenseMtx_row(mtxB, j, &Bj);
temp[0] = 0.0;
temp[1] = 0.0;
for (k=0; k<ncolA; k++){
bconj[0] = Bj[k*colincB];
bconj[1] = -Bj[k*colincB+1];
zmul(&Ai[k*colincA],bconj,result);
zadd(temp,result,temp);
}
if( r_beta == *zero ){
zmul(alpha,temp,&Ci[j*colincC]);
} else {
zmul(alpha,temp,temp);
zmul(beta,&Ci[j*colincC],&Ci[j*colincC]);
zadd(temp,&Ci[j*colincC],&Ci[j*colincC]);
}
}
}
} else { /* Form C := alpha*A'*conjg(B') + beta*C */
for (i=0; i<ncolA; i++){
ierr=DenseMtx_column(mtxA, i, &Ai);
ierr=DenseMtx_row(mtxC, i, &Ci);
for (j=0; j<nrowB; j++){
ierr=DenseMtx_row(mtxB, j, &Bj);
temp[0] = 0.0;
temp[1] = 0.0;
for (k=0; k<nrowA; k++){
bconj[0] = Bj[k*colincB];
bconj[1] = -Bj[k*colincB+1];
if (A_opt[0] == 'C' || A_opt[0] == 'c'){
/* Form C := alpha*conjg( A')*conjg(B') + beta*C. */
aconj[0] = Ai[k*rowincA];
aconj[1] = -Ai[k*rowincA+1];
zmul(aconj,bconj,result);
} else {
zmul(&Ai[k*rowincA],bconj,result);
}
zadd(temp,result,temp);
}
if( r_beta == *zero ){
zmul(alpha,temp,&Ci[j*colincC]);
} else {
zmul(alpha,temp,temp);
zmul(beta,&Ci[j*colincC],&Ci[j*colincC]);
zadd(temp,&Ci[j*colincC],&Ci[j*colincC]);
}
}
}
}
}
}
return(1); }
