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