/*
-----------------------------------------------------------
purpose -- compute the checksums of the indices and entries
sums[0] = sum_{ii=0}^{nent} abs(ivec1[ii])
sums[1] = sum_{ii=0}^{nent} abs(ivec2[ii])
if real or complex entries then
sums[2] = sum_{ii=0}^{nent} magnitudes of entries
endif
created -- 98may16, cca
-----------------------------------------------------------
*/
void
InpMtx_checksums (
InpMtx *inpmtx,
double sums[]
) {
int ient, nent ;
int *ivec1, *ivec2 ;
/*
---------------
check the input
---------------
*/
if ( inpmtx == NULL ) {
fprintf(stderr, "\n fatal error in InpMtx_checksums(%p,%p)"
"\n bad input\n", inpmtx, sums) ;
exit(-1) ;
}
switch ( inpmtx->inputMode ) {
case INPMTX_INDICES_ONLY :
case SPOOLES_REAL :
case SPOOLES_COMPLEX :
break ;
default :
fprintf(stderr, "\n fatal error in InpMtx_checksums(%p,%p)"
"\n bad inputMode\n", inpmtx, sums) ;
exit(-1) ;
}
sums[0] = sums[1] = sums[2] = 0.0 ;
if ( (nent = InpMtx_nent(inpmtx)) <= 0 ) {
return ;
}
ivec1 = InpMtx_ivec1(inpmtx) ;
ivec2 = InpMtx_ivec2(inpmtx) ;
for ( ient = 0 ; ient < nent ; ient++ ) {
sums[0] += abs(ivec1[ient]) ;
sums[1] += abs(ivec2[ient]) ;
}
switch ( inpmtx->inputMode ) {
case INPMTX_INDICES_ONLY :
break ;
case SPOOLES_REAL : {
double *dvec = InpMtx_dvec(inpmtx) ;
for ( ient = 0 ; ient < nent ; ient++ ) {
sums[2] += fabs(dvec[ient]) ;
}
} break ;
case SPOOLES_COMPLEX : {
double *dvec = InpMtx_dvec(inpmtx) ;
for ( ient = 0 ; ient < nent ; ient++ ) {
sums[2] += Zabs(dvec[2*ient], dvec[2*ient+1]) ;
}
} break ;
}
return ; }
/*
-----------------------------------
compute three checksums
sums[0] = sum of row indices
sums[1] = sum of columns indices
sums[2] = sum of entry magnitudes
created -- 98may16, cca
-----------------------------------
*/
void
DenseMtx_checksums (
DenseMtx *mtx,
double sums[]
) {
double *entries ;
int ii, ncol, nent, nrow ;
int *colind, *rowind ;
/*
---------------
check the input
---------------
*/
if ( mtx == NULL || sums == NULL ) {
fprintf(stderr, "\n fatal error in DenseMtx_checksums(%p,%p)"
"\n bad input\n", mtx, sums) ;
spoolesFatal();
}
sums[0] = sums[1] = sums[2] = 0.0 ;
DenseMtx_rowIndices(mtx, &nrow, &rowind) ;
for ( ii = 0 ; ii < nrow ; ii++ ) {
sums[0] += rowind[ii] ;
}
DenseMtx_columnIndices(mtx, &ncol, &colind) ;
for ( ii = 0 ; ii < ncol ; ii++ ) {
sums[1] += colind[ii] ;
}
entries = DenseMtx_entries(mtx) ;
nent = nrow*ncol ;
if ( DENSEMTX_IS_REAL(mtx) ) {
for ( ii = 0 ; ii < nent ; ii++ ) {
sums[2] += fabs(entries[ii]) ;
}
} else if ( DENSEMTX_IS_COMPLEX(mtx) ) {
for ( ii = 0 ; ii < nent ; ii++ ) {
sums[2] += Zabs(entries[2*ii], entries[2*ii+1]) ;
}
}
return ; }
/*
----------------------------------------------------------------
compute a householder transformation
(I - beta*v*v^H)x = alpha*e_1
where v[0] = 1.0
on input,
H0 contains x,
on output,
beta0 contains beta
H0[0] = alpha
H0[1:n-1] = v[1:n] ;
created -- 98may30, cca
----------------------------------------------------------------
*/
static double
getHouseholderVector1 (
int type,
int n,
double H0[],
double *pbeta0,
int msglvl,
FILE *msgFile
) {
double beta0, ifac, ival, nops, normx, rfac, rval, sigma,
sum, v0imag, v0real, y0imag, y0real ;
int ii, jj ;
/*
--------------------------------------------
compute ||H0(1:n-1)||_2^2 and the
row that contains the last nonzero entry
--------------------------------------------
*/
sigma = 0.0 ;
beta0 = 0.0 ;
nops = 0.0 ;
if ( type == SPOOLES_REAL ) {
for ( ii = 1 ; ii < n ; ii++ ) {
rval = H0[ii] ;
sigma += rval*rval ;
}
nops += 2*(n-1) ;
} else if ( type == SPOOLES_COMPLEX ) {
for ( ii = 1, jj = 2 ; ii < n ; ii++, jj += 2 ) {
rval = H0[jj] ; ival = H0[jj+1] ;
sigma += rval*rval + ival*ival ;
}
nops += 4*(n-1) ;
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %% sigma = %12.4e", sigma) ;
}
if ( sigma != 0.0 ) {
/*
--------------------------------------------
there are nonzero entries below the diagonal
--------------------------------------------
*/
if ( type == SPOOLES_REAL ) {
rval = H0[0] ;
if ( rval == 0.0 ) {
normx = sqrt(sigma) ;
v0real = normx ;
y0real = - normx ;
nops++ ;
} else {
normx = sqrt(sigma + rval*rval) ;
rfac = normx/fabs(rval) ;
v0real = rval*(1 + rfac) ;
y0real = -rfac*rval ;
nops += 7 ;
}
} else if ( type == SPOOLES_COMPLEX ) {
rval = H0[0] ; ival = H0[1] ;
if ( rval == 0.0 && ival == 0.0 ) {
normx = sqrt(sigma) ;
v0real = normx ; v0imag = 0.0 ;
y0real = - normx ; y0imag = 0.0 ;
nops += 2 ;
} else {
normx = sqrt(sigma + rval*rval + ival*ival) ;
rfac = normx/Zabs(rval, ival) ;
v0real = rval + rfac*rval ; v0imag = ival + rfac*ival ;
y0real = -rfac*rval ; y0imag = -rfac*ival ;
nops += 16 ;
}
}
if ( msglvl > 3 ) {
fprintf(msgFile, "\n %% normx = %12.4e", normx) ;
}
/*
-------------------------------------
scale u so u1 = 1.0 and compute beta0
-------------------------------------
*/
if ( type == SPOOLES_REAL ) {
rfac = 1./v0real ;
for ( ii = 1 ; ii < n ; ii++ ) {
H0[ii] *= rfac ;
}
sum = 1.0 ;
for ( ii = 1 ; ii < n ; ii++ ) {
rval = H0[ii] ;
sum += rval*rval ;
}
nops += 3*(n-1) ;
beta0 = 2./sum ;
/*
rfac = 1./v0real ;
sum = 1.0 ;
for ( ii = 1 ; ii < n ; ii++ ) {
rval = H0[ii] = rfac*H0[ii] ;
sum += rval*rval ;
}
nops += 3*(n-1) ;
beta0 = 2./sum ;
*/
} else if ( type == SPOOLES_COMPLEX ) {
Zrecip(v0real, v0imag, &rfac, &ifac) ;
sum = 1.0 ;
for ( ii = 1, jj = 2 ; ii < n ; ii++, jj += 2 ) {
rval = H0[jj] ; ival = H0[jj+1] ;
H0[jj] = rfac*rval - ifac*ival ;
H0[jj+1] = rfac*ival + ifac*rval ;
rval = H0[jj] ; ival = H0[jj+1] ;
sum += rval*rval + ival*ival ;
}
nops += 10*(n-1) + 5 ;
beta0 = 2./sum ;
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n %% sum = %12.4e, beta0 = %12.4e",
sum, beta0) ;
}
/*
---------------------------------------------
set the first entry of the transformed column
---------------------------------------------
*/
if ( type == SPOOLES_REAL ) {
H0[0] = y0real ;
} else if ( type == SPOOLES_COMPLEX ) {
H0[0] = y0real ; H0[1] = y0imag ;
}
}
*pbeta0 = beta0 ;
/*
fprintf(msgFile, "\n H0") ;
DVfprintf(msgFile, n, H0) ;
*/
return(nops) ; }
