CompCol_Mat_double& readHB_mat(const char *filename, CompCol_Mat_double *A)
{
int M=0, N=0, nz=0, nrhs=0;
readHB_info(filename, &M, &N, &nz, &nrhs);
CompCol_Mat_double &T = *A;
T.newsize(M,N,nz);
readHB_mat_double(filename, &T.col_ptr(0), &T.row_ind(0), &T.val(0));
return T;
}
double *read_rhs(const char *filename, int j)
{
int M, N, nnz, nrhs;
readHB_info(filename, &M, &N, &nnz, &nrhs);
double *rhs = new double[nnz];
if (j >= 0 && j < nrhs)
readHB_rhs_double(filename, rhs, j);
else
printf("Error: HB rhs #%d in file '%s' not found.\n", j, filename);
return rhs;
}
CSCMatrix *read_hb_csc(const char *filename)
{
int M, N, nnz, nrhs;
readHB_info(filename, &M, &N, &nnz, &nrhs);
// square matrix
int size = N;
// allocate matrix
int *Ap = new int[size + 1];
int *Ai = new int[nnz];
double *Ax = new double[nnz];
readHB_mat_double(filename, Ap, Ai, Ax);
CSCMatrix *Acsc = new CSCMatrix(size, nnz, Ap, Ai, Ax);
return Acsc;
}
VECTOR_double& readHB_rhs(const char *filename, VECTOR_double *b, int j)
{
int M;
int N;
int nrhs;
int nz;
readHB_info(filename, &M, &N, &nz, &nrhs);
VECTOR_double T(N);
if (j >= 0 && j < nrhs)
readHB_rhs_double(filename, &T(0), j);
else
{
printf(
"Error: HB file right-hand-size vector #%d in file '%s' not found.\n",
j, filename);
exit(1);
}
return ( *b = T) ;
}
dsp_matrix_t *
dspmat_newHB( const char* filename )
{
char *type;
int nrhs; /* # of right-hand sides in file */
int m, n;
int nnz;
dsp_matrix_t* new_mat;
int min_rows_per_proc;
int rows_this_proc;
int leftover;
readHB_info( filename, &m, &n, &nnz, &type, &nrhs );
#ifndef INSANE
if( m != n ) {
fprintf( stderr, "--- Can only operate on square matrices ---\n" );
return NULL;
}
#endif
if( type[0] != 'R' && type[0] != 'r' ) {
fprintf( stderr, "--- Can only operate on real matrices ---\n" );
return NULL;
}
if( type[1] != 'S' && type[1] != 's' ) {
fprintf( stderr, "--- Can only operate on symmetric matrices ---\n" );
return NULL;
}
/* alloc matrix */
new_mat = (dsp_matrix_t *)malloc( sizeof(dsp_matrix_t) );
if( new_mat == NULL )
return NULL;
memset(new_mat, 0, sizeof(dsp_matrix_t));
#ifndef INSANE
new_mat->N = n;
#else
new_mat->N = m;
#endif
/* distribute rows */
min_rows_per_proc = new_mat->N / g_numprocs;
rows_this_proc = min_rows_per_proc;
leftover = new_mat->N % g_numprocs;
if( g_myproc < leftover ) {
rows_this_proc++;
new_mat->row_i = rows_this_proc * g_myproc;
} else {
new_mat->row_i = leftover + g_myproc * min_rows_per_proc;
}
new_mat->row_f = new_mat->row_i + rows_this_proc - 1;
new_mat->row_ptr = (int *)malloc( sizeof(int) * (rows_this_proc + 1) );
/* read in data */
dspio_readHB_mat_double( filename,
new_mat->row_i, new_mat->row_f,
&(new_mat->row_ptr),
&(new_mat->nnz),
&(new_mat->col_ind),
&(new_mat->val) );
/* synchronize A across all processors */
dspmat_vecmult_sync( new_mat );
/* clean-up */
return new_mat;
}
void main ( int argc, char *argv[] )
/*
----------------------------------------------------------
read in Harwell-Boeing matrices, use serial factor, solve,
and multiply routines based on spooles, invoke eigensolver
created -- 98mar31 jcp
modified -- 98dec18, cca
----------------------------------------------------------
*/
{
Bridge bridge ;
char *inFileName_A, *inFileName_B, *outFileName,
*parmFileName, *type ;
char buffer[20], pbtype[4], which[4] ;
double lftend, rhtend, center, shfscl, t1, t2 ;
double c__1 = 1.0, c__4 = 4.0, tolact = 2.309970868130169e-11 ;
double eigval[1000], sigma[2];
double *evec;
int error, fstevl, lfinit, lstevl, mxbksz, msglvl, ncol, ndiscd,
neig, neigvl, nfound, nnonzeros, nrhs, nrow, prbtyp, rc,
retc, rfinit, seed, warnng ;
int c__5 = 5, output = 6 ;
int *lanczos_wksp;
InpMtx *inpmtxA, *inpmtxB ;
FILE *msgFile, *parmFile;
/*--------------------------------------------------------------------*/
if ( argc != 7 ) {
fprintf(stdout,
"\n\n usage : %s msglvl msgFile parmFile seed inFileA inFileB"
"\n msglvl -- message level"
"\n msgFile -- message file"
"\n parmFile -- input parameters file"
"\n seed -- random number seed, used for ordering"
"\n inFileA -- stiffness matrix in Harwell-Boeing format"
"\n inFileB -- mass matrix in Harwell-Boeing format"
"\n used for prbtyp = 1 or 2"
"\n", argv[0]) ;
return ;
}
msglvl = atoi(argv[1]) ;
if ( strcmp(argv[2], "stdout") == 0 ) {
msgFile = stdout ;
} else if ( (msgFile = fopen(argv[2], "a")) == NULL ) {
fprintf(stderr, "\n fatal error in %s"
"\n unable to open file %s\n",
argv[0], argv[2]) ;
exit(-1) ;
}
parmFileName = argv[3] ;
seed = atoi(argv[4]) ;
inFileName_A = argv[5] ;
inFileName_B = argv[6] ;
fprintf(msgFile,
"\n %s "
"\n msglvl -- %d"
"\n msgFile -- %s"
"\n parmFile -- %s"
"\n seed -- %d"
"\n stiffness file -- %s"
"\n mass file -- %s"
"\n",
argv[0], msglvl, argv[2], parmFileName, seed,
inFileName_A, inFileName_B) ;
fflush(msgFile) ;
/*
---------------------------------------------
read in the Harwell-Boeing matrix information
---------------------------------------------
*/
if ( strcmp(inFileName_A, "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(0) ;
}
MARKTIME(t1) ;
readHB_info (inFileName_A, &nrow, &ncol, &nnonzeros, &type, &nrhs) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : read in header information for A",
t2 - t1) ;
/*--------------------------------------------------------------------*/
/*
---------------------------------------------------------------
read in eigenvalue problem data
neigvl -- # of desired eigenvalues
which -- which eigenvalues to compute
'l' or 'L' lowest (smallest magnitude)
'h' or 'H' highest (largest magnitude)
'n' or 'N' nearest to central value
'c' or 'C' nearest to central value
'a' or 'A' all eigenvalues in interval
pbtype -- type of problem
'v' or 'V' generalized symmetric problem (K,M)
with M positive semidefinite (vibration problem)
'b' or 'B' generalized symmetric problem (K,K_s)
with K positive semidefinite
with K_s posibly indefinite (buckling problem)
'o' or 'O' ordinary symmetric eigenproblem
lfinit -- if true, lftend is restriction on lower bound of
eigenvalues. if false, no restriction on lower bound
lftend -- left endpoint of interval
rfinit -- if true, rhtend is restriction on upper bound of
eigenvalues. if false, no restriction on upper bound
rhtend -- right endpoint of interval
center -- center of interval
mxbksz -- upper bound on block size for Lanczos recurrence
shfscl -- shift scaling parameter, an estimate on the magnitude
of the smallest nonzero eigenvalues
---------------------------------------------------------------
*/
MARKTIME(t1) ;
parmFile = fopen(parmFileName, "r");
fscanf(parmFile, "%d %s %s %d %le %d %le %le %d %le",
&neigvl, which, pbtype, &lfinit, &lftend,
&rfinit, &rhtend, ¢er, &mxbksz, &shfscl) ;
fclose(parmFile);
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : read in eigenvalue problem data",
t2 - t1) ;
/*
----------------------------------------
check and set the problem type parameter
----------------------------------------
*/
switch ( pbtype[1] ) {
case 'v' : case 'V' : prbtyp = 1 ; break ;
case 'b' : case 'B' : prbtyp = 2 ; break ;
case 'o' : case 'O' : prbtyp = 3 ; break ;
default :
fprintf(stderr, "\n invalid problem type %s", pbtype) ;
exit(-1) ;
}
/*
----------------------------
Initialize Lanczos workspace
----------------------------
*/
MARKTIME(t1) ;
lanczos_init_ ( &lanczos_wksp ) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : initialize lanczos workspace",
t2 - t1) ;
/*
----------------------------------
initialize communication structure
----------------------------------
*/
MARKTIME(t1) ;
lanczos_set_parm( &lanczos_wksp, "order-of-problem", &nrow, &retc );
lanczos_set_parm( &lanczos_wksp, "accuracy-tolerance", &tolact, &retc );
lanczos_set_parm( &lanczos_wksp, "max-block-size", &mxbksz, &retc );
lanczos_set_parm( &lanczos_wksp, "shift-scale", &shfscl, &retc );
lanczos_set_parm( &lanczos_wksp, "message_level", &msglvl, &retc );
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : init lanczos communication structure",
t2 - t1) ;
/*--------------------------------------------------------------------*/
/*
---------------------------------------------
create the InpMtx objects for matrix A and B
---------------------------------------------
*/
if ( strcmp(inFileName_A, "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(0) ;
}
MARKTIME(t1) ;
inpmtxA = InpMtx_new() ;
InpMtx_readFromHBfile ( inpmtxA, inFileName_A ) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : read in A", t2 - t1) ;
if ( msglvl > 2 ) {
fprintf(msgFile, "\n\n InpMtx A object after loading") ;
InpMtx_writeForHumanEye(inpmtxA, msgFile) ;
fflush(msgFile) ;
}
MARKTIME(t1) ;
lanczos_set_parm( &lanczos_wksp, "matrix-type", &c__1, &retc );
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : set A's parameters", t2 - t1) ;
if ( prbtyp != 3 ) {
if ( strcmp(inFileName_B, "none") == 0 ) {
fprintf(msgFile, "\n no file to read from") ;
exit(0) ;
}
MARKTIME(t1) ;
inpmtxB = InpMtx_new() ;
InpMtx_readFromHBfile ( inpmtxB, inFileName_B ) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : read in B", t2 - t1) ;
} else {
MARKTIME(t1) ;
inpmtxB = NULL ;
lanczos_set_parm( &lanczos_wksp, "matrix-type", &c__4, &retc );
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : set B's parameters", t2 - t1) ;
}
if ( msglvl > 2 && prbtyp != 3 ) {
fprintf(msgFile, "\n\n InpMtx B object after loading") ;
InpMtx_writeForHumanEye(inpmtxB, msgFile) ;
fflush(msgFile) ;
}
/*
-----------------------------
set up the solver environment
-----------------------------
*/
MARKTIME(t1) ;
rc = Setup((void *) &bridge, &prbtyp, &nrow, &mxbksz, inpmtxA, inpmtxB,
&seed, &msglvl, msgFile) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : set up solver environment", t2 - t1) ;
if ( rc != 1 ) {
fprintf(stderr, "\n fatal error %d from Setup()", rc) ;
exit(-1) ;
}
/*--------------------------------------------------------------------*/
/*
-----------------------------------------------
invoke eigensolver
nfound -- # of eigenvalues found and kept
ndisc -- # of additional eigenvalues discarded
-----------------------------------------------
*/
MARKTIME(t1) ;
lanczos_run(&neigvl, &which[1] , &pbtype[1], &lfinit, &lftend,
&rfinit, &rhtend, ¢er, &lanczos_wksp, &bridge, &nfound,
&ndiscd, &warnng, &error, Factor, MatMul, Solve ) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : time for lanczos run", t2 - t1) ;
/*
-------------------------
get eigenvalues and print
-------------------------
*/
MARKTIME(t1) ;
neig = nfound + ndiscd ;
lstevl = nfound ;
lanczos_eigenvalues (&lanczos_wksp, eigval, &neig, &retc);
fstevl = 1 ;
if ( nfound == 0 ) fstevl = -1 ;
if ( ndiscd > 0 ) lstevl = -ndiscd ;
hdslp5_ ("computed eigenvalues returned by hdserl",
&neig, eigval, &output, 39L ) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : get and print eigenvalues ", t2 - t1) ;
/*
-------------------------
get eigenvectors and print
-------------------------
*/
/*
MARKTIME(t1) ;
neig = min ( 50, nrow );
Lncz_ALLOCATE(evec, double, nrow, retc);
for ( i = 1 ; i <= nfound ; i++ ) {
lanczos_eigenvector ( &lanczos_wksp, &i, &i, newToOld,
evec, &nrow, &retc ) ;
hdslp5_ ( "computed eigenvector returned by hdserc",
&neig, evec, &output, 39L ) ;
}
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : get and print eigenvectors ", t2 - t1) ;
*/
/*
------------------------
free the working storage
------------------------
*/
MARKTIME(t1) ;
lanczos_free( &lanczos_wksp ) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : free lanczos workspace ", t2 - t1) ;
MARKTIME(t1) ;
rc = Cleanup(&bridge) ;
MARKTIME(t2) ;
fprintf(msgFile, "\n CPU %8.3f : free solver workspace ", t2 - t1) ;
if ( rc != 1 ) {
fprintf(stderr, "\n error return %d from Cleanup()", rc) ;
exit(-1) ;
}
fprintf(msgFile, "\n") ;
fclose(msgFile) ;
return ; }
int main(int argc, char *argv[])
{
int M, N, nonzeros, Nrhs;
int *colptr, *rowind;
double *val = NULL;
double *rhs;
int rhsentries = 0;
double *guess;
double *exact = NULL;
char *Type;
char Ptrfmt[]="(13I6)";
char Indfmt[]="(16I5)";
char Valfmt[]="(3E26.18)";
char Rhsfmt[]="(3E26.18)";
int i=0;
if (argc < 3)
{
fprintf(stderr,"Usage: %s HBfile HBfileout\n", argv[0]);
exit(-1);
}
/* Get information about the array stored in the file specified in the */
/* argument list: */
fprintf(stderr,"Reading matrix info from %s...\n",argv[1]);
readHB_info(argv[1], &M, &N, &nonzeros, &Type, &Nrhs);
fprintf(stderr,"Matrix in file %s is %d x %d, with %d nonzeros with type %s;\n",
argv[1], M, N, nonzeros, Type);
fprintf(stderr,"%d right-hand-side(s) available.\n",Nrhs);
/* Read the matrix information, generating the associated storage arrays */
fprintf(stderr,"Reading the matrix from %s...\n",argv[1]);
readHB_newmat_double(argv[1], &M, &N, &nonzeros, &colptr, &rowind, &val);
/* If a rhs is specified in the file, read one, generating the associate storage */
if (Nrhs > 0) {
fprintf(stderr,"Reading right-hand-side vector(s) from %s...\n",argv[1]);
readHB_newaux_double(argv[1], 'F', &rhs);
}
/* Generate a new Guess vector (all zeros) */
if ( Type[0] == 'R' )
rhsentries = M*Nrhs;
else if ( Type[0] == 'C' )
rhsentries = 2*M*Nrhs;
guess = (double *) malloc(rhsentries*sizeof(double));
for (i = 0; i < rhsentries ;i++)
guess[i] = 0;
if (Nrhs > 0) {
fprintf(
stderr,
"Writing the matrix and right-hand-side/guess vector(s) from %s...\n",
argv[1]
);
} else {
fprintf(
stderr,
"Writing the matrix from %s...\n",
argv[1]
);
}
writeHB_mat_double(argv[2], M, N, nonzeros, colptr, rowind, val, Nrhs, rhs,
guess, exact, "Test Title", "Test Key", Type, Ptrfmt,Indfmt,Valfmt,Rhsfmt,"FGN");
fprintf(stderr,"**** Successful completion of %s. Generated %s. ****\n",argv[0],argv[2]);
return 0;
}
