/* eigs_sps - computs a few eigenvalues of a sparse symmetric matrix
* Inputs :
* n - size
* val, indx, pntrB, pntrE - represents the sparse matrix A
* which - character array, can be 'SA' 'LA' 'BE' 'SM' 'LM'
* nev - number of eigenvalues to be computed
* d - pre-allocated array, serves as the output eigenvalues
* Return Value :
* (int) 0 - process exits normally
* (int) != 0 - process exits with errors
*/
int eigs_sps(MKL_INT n, double* val, MKL_INT* indx, MKL_INT* pntrB, MKL_INT* pntrE, char* which, MKL_INT nev, double *d){
int ido = 0, ncv = int(nev*1.1+1), ldv = n, lworkl = ncv*(ncv+8), info = 0, revc = 0, ierr = 0;
int iparam[11], ipntr[11], *select;
unsigned long pntr0, pntr1;
double tol = 0, alpha = 1.0, beta = 0.0, sigma = 0.0;
double *resid, *workd, *workl, *v;
char bmat[] = {'I'}, transa[] = {'N'}, matdescra[] = {'G', 'L', 'N', 'F'}, howmny[] = {'A'};
resid = new double[n];
workd = new double[3*n];
workl = new double[lworkl];
v = new double[ncv*ldv];
select = new int[ncv];
iparam[0] = 1;
iparam[2] = 300;
iparam[6] = 1;
while(true){
dsaupd_(&ido, bmat, &n, which, &nev, &tol, resid, &ncv, v, &ldv, iparam, ipntr, workd, workl, &lworkl, &info, 1, 2);
if(ido == 1 || ido == -1){
pntr0 = (unsigned long)ipntr[0]; pntr1 = (unsigned long)ipntr[1];
mkl_dcscmv(transa, &n, &n, &alpha, matdescra, val, indx, pntrB, pntrE, (double*)pntr0, &beta, (double*)pntr1);
}
}
dseupd_(&revc, howmny, select, d, v, &ldv, &sigma, bmat, &n, which, &ncv, &tol, resid, &ncv, v, &ldv, iparam, ipntr, workd, workl, &lworkl, &ierr, 1, 1, 2);
if(ierr != 0){
printf("Error with dseupd, info = %d\n", ierr);
}
delete []resid;
delete []workd;
delete []workl;
delete []select;
delete []v;
return info;
}
int
BandArpackSolver::solve(int numModes, bool generalized, bool findSmallest)
{
if (generalized == false) {
opserr << "BandArpackSolver::solve(int numMode, bool generalized) - only solves generalized problem\n";
return -1;
}
if (theSOE == 0) {
opserr << "WARNING BandGenLinLapackSolver::solve(void)- ";
opserr << " No LinearSOE object has been set\n";
return -1;
}
int n = theSOE->size;
// check iPiv is large enough
if (iPivSize < n) {
opserr << "WARNING BandGenLinLapackSolver::solve(void)- ";
opserr << " iPiv not large enough - has setSize() been called?\n";
return -1;
}
// set some variables
int kl = theSOE->numSubD;
int ku = theSOE->numSuperD;
int ldA = 2*kl + ku +1;
int nrhs = 1;
int ldB = n;
int info;
double *Aptr = theSOE->A;
int *iPIV = iPiv;
int nev = numModes;;
int ncv = getNCV(n, nev);
// set up the space for ARPACK functions.
// this is done each time method is called!! .. this needs to be cleaned up
int ldv = n;
int lworkl = ncv*ncv + 8*ncv;
double *v = new double[ldv * ncv];
double *workl = new double[lworkl + 1];
double *workd = new double[3 * n + 1];
double *d = new double[nev];
double *z= new double[n * nev];
double *resid = new double[n];
int *iparam = new int[11];
int *ipntr = new int[11];
logical *select = new logical[ncv];
static char which[3];
if (findSmallest == true) {
strcpy(which, "LM");
} else {
strcpy(which, "SM");
}
char bmat = 'G';
char howmy = 'A';
// some more variables
int maxitr, mode;
double tol = 0.0;
info = 0;
maxitr = 1000;
mode = 3;
iparam[0] = 1;
iparam[2] = maxitr;
iparam[6] = mode;
bool rvec = true;
int ido = 0;
int ierr = 0;
// Do the factorization of Matrix (A-dM) here.
#ifdef _WIN32
DGBTRF(&n, &n, &kl, &ku, Aptr, &ldA, iPiv, &ierr);
#else
dgbtrf_(&n, &n, &kl, &ku, Aptr, &ldA, iPiv, &ierr);
#endif
if ( ierr != 0 ) {
opserr << " BandArpackSolver::Error in dgbtrf_ " << endln;
return -1;
}
while (1) {
#ifdef _WIN32
unsigned int sizeWhich =2;
unsigned int sizeBmat =1;
unsigned int sizeHowmany =1;
unsigned int sizeOne = 1;
/*
DSAUPD(&ido, &bmat, &sizeBmat, &n, which, &sizeWhich, &nev, &tol, resid,
&ncv, v, &ldv,
iparam, ipntr, workd, workl, &lworkl, &info);
*/
DSAUPD(&ido, &bmat, &n, which, &nev, &tol, resid,
&ncv, v, &ldv,
iparam, ipntr, workd, workl, &lworkl, &info);
#else
dsaupd_(&ido, &bmat, &n, which, &nev, &tol, resid, &ncv, v, &ldv,
iparam, ipntr, workd, workl, &lworkl, &info);
#endif
if (ido == -1) {
myMv(n, &workd[ipntr[0]-1], &workd[ipntr[1]-1]);
#ifdef _WIN32
/*
DGBTRS("N", &sizeOne, &n, &kl, &ku, &nrhs, Aptr, &ldA, iPIV,
&workd[ipntr[1] - 1], &ldB, &ierr);
*/
DGBTRS("N", &n, &kl, &ku, &nrhs, Aptr, &ldA, iPIV,
&workd[ipntr[1] - 1], &ldB, &ierr);
#else
dgbtrs_("N", &n, &kl, &ku, &nrhs, Aptr, &ldA, iPIV,
&workd[ipntr[1] - 1], &ldB, &ierr);
#endif
if (ierr != 0) {
opserr << "BandArpackSolver::Error with dgbtrs_ 1" <<endln;
exit(0);
}
continue;
} else if (ido == 1) {
// double ratio = 1.0;
myCopy(n, &workd[ipntr[2]-1], &workd[ipntr[1]-1]);
#ifdef _WIN32
/*
DGBTRS("N", &sizeOne, &n, &kl, &ku, &nrhs, Aptr, &ldA, iPIV,
&workd[ipntr[1] - 1], &ldB, &ierr);
*/
DGBTRS("N", &n, &kl, &ku, &nrhs, Aptr, &ldA, iPIV,
&workd[ipntr[1] - 1], &ldB, &ierr);
#else
dgbtrs_("N", &n, &kl, &ku, &nrhs, Aptr, &ldA, iPIV,
&workd[ipntr[1] - 1], &ldB, &ierr);
#endif
if (ierr != 0) {
opserr << "BandArpackSolver::Error with dgbtrs_ 2" <<endln;
exit(0);
}
continue;
} else if (ido == 2) {
myMv(n, &workd[ipntr[0]-1], &workd[ipntr[1]-1]);
continue;
}
break;
}
if (info < 0) {
opserr << "BandArpackSolver::Error with _saupd info = " << info << endln;
switch(info) {
case -1:
opserr << "N must be positive.\n";
break;
case -2:
opserr << "NEV must be positive.\n";
break;
case -3:
opserr << "NCV must be greater than NEV and less than or equal to N.\n";
break;
case -4:
opserr << "The maximum number of Arnoldi update iterations allowed";
break;
case -5:
opserr << "WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'.\n";
break;
case -6:
opserr << "BMAT must be one of 'I' or 'G'.\n";
break;
case -7:
opserr << "Length of private work array WORKL is not sufficient.\n";
break;
case -8:
opserr << "Error return from trid. eigenvalue calculation";
opserr << "Informatinal error from LAPACK routine dsteqr.\n";
break;
case -9:
opserr << "Starting vector is zero.\n";
break;
case -10:
opserr << "IPARAM(7) must be 1,2,3,4,5.\n";
break;
case -11:
opserr << "IPARAM(7) = 1 and BMAT = 'G' are incompatable.\n";
break;
case -12:
opserr << "IPARAM(1) must be equal to 0 or 1.\n";
break;
case -13:
opserr << "NEV and WHICH = 'BE' are incompatable.\n";
break;
case -9999:
opserr << "Could not build an Arnoldi factorization.";
opserr << "IPARAM(5) returns the size of the current Arnoldi\n";
opserr << "factorization. The user is advised to check that";
opserr << "enough workspace and array storage has been allocated.\n";
break;
default:
opserr << "unrecognised return value\n";
}
// clean up the memory
delete [] workl;
delete [] workd;
delete [] resid;
delete [] iparam;
delete [] v;
delete [] select;
delete [] ipntr;
delete [] d;
delete [] z;
value = 0;
eigenvector = 0;
return info;
} else {
if (info == 1) {
opserr << "BandArpackSolver::Maximum number of iteration reached." << endln;
} else if (info == 3) {
opserr << "BandArpackSolver::No Shifts could be applied during implicit,";
opserr << "Arnoldi update, try increasing NCV." << endln;
}
double sigma = theSOE->shift;
if (iparam[4] > 0) {
rvec = true;
n = theSOE->size;
ldv = n;
#ifdef _WIN32
unsigned int sizeWhich =2;
unsigned int sizeBmat =1;
unsigned int sizeHowmany =1;
/*
DSEUPD(&rvec, &howmy, &sizeHowmany, select, d, z, &ldv, &sigma, &bmat,
&sizeBmat, &n, which, &sizeWhich,
&nev, &tol, resid, &ncv, v, &ldv, iparam, ipntr, workd,
workl, &lworkl, &info);
*/
DSEUPD(&rvec, &howmy, select, d, z, &ldv, &sigma, &bmat, &n, which,
&nev, &tol, resid, &ncv, v, &ldv, iparam, ipntr, workd,
workl, &lworkl, &info);
#else
dseupd_(&rvec, &howmy, select, d, z, &ldv, &sigma, &bmat, &n, which,
&nev, &tol, resid, &ncv, v, &ldv, iparam, ipntr, workd,
workl, &lworkl, &info);
#endif
if (info != 0) {
opserr << "BandArpackSolver::Error with dseupd_" << info;
switch(info) {
case -1:
opserr << " N must be positive.\n";
break;
case -2:
opserr << " NEV must be positive.\n";
break;
case -3:
opserr << " NCV must be greater than NEV and less than or equal to N.\n";
break;
case -5:
opserr << " WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'.\n";
break;
case -6:
opserr << " BMAT must be one of 'I' or 'G'.\n";
break;
case -7:
opserr << " Length of private work WORKL array is not sufficient.\n";
break;
case -8:
opserr << " Error return from trid. eigenvalue calculation";
opserr << "Information error from LAPACK routine dsteqr.\n";
break;
case -9:
opserr << " Starting vector is zero.\n";
break;
case -10:
opserr << " IPARAM(7) must be 1,2,3,4,5.\n";
break;
case -11:
opserr << " IPARAM(7) = 1 and BMAT = 'G' are incompatibl\n";
break;
case -12:
opserr << " NEV and WHICH = 'BE' are incompatible.\n";
break;
case -14:
opserr << " DSAUPD did not find any eigenvalues to sufficient accuracy.\n";
break;
case -15:
opserr << " HOWMNY must be one of 'A' or 'S' if RVEC = .true.\n";
break;
case -16:
opserr << " HOWMNY = 'S' not yet implemented\n";
break;
default:
;
}
// clean up the memory
delete [] workl;
delete [] workd;
delete [] resid;
delete [] iparam;
delete [] v;
delete [] select;
delete [] ipntr;
delete [] d;
delete [] z;
value = 0;
eigenvector = 0;
return info;
}
}
}
value = d;
eigenvector = z;
theSOE->factored = true;
// clean up the memory
delete [] workl;
delete [] workd;
delete [] resid;
delete [] iparam;
delete [] v;
delete [] select;
delete [] ipntr;
return 0;
}
int main(int argc, char* argv[])
{
const char* program_name = "decomp_sparse_nystrom";
bool optsOK = true;
copyright(program_name);
cout << " Reads the symmetric CSC format sparse matrix from" << endl;
cout << " input-file, and computes the number of requested" << endl;
cout << " eigenvalues/vectors of the normalized laplacian" << endl;
cout << " using ARPACK and a gaussian kernel of width sigma." << endl;
cout << " The general CSC format sparse matrix is projected" << endl;
cout << " onto the eigenvectors of the symmetric matrix for" << endl;
cerr << " out-of-sample prediction." << endl;
cout << endl;
cout << " Use -h or --help to see the complete list of options." << endl;
cout << endl;
// Option vars...
double sigma_a;
int nev;
string ssm_filename;
string gsm_filename;
string evals_filename;
string evecs_filename;
string residuals_filename;
// Declare the supported options.
po::options_description cmdline_options;
po::options_description program_options("Program options");
program_options.add_options()
("help,h", "show this help message and exit")
("sigma,q", po::value<double>(&sigma_a), "Input: Standard deviation of gaussian kernel (real)")
("nevals,n", po::value<int>(&nev), "Input: Number of eigenvalues/vectors (int)")
("ssm-file,s", po::value<string>(&ssm_filename)->default_value("distances.ssm"), "Input: Symmetric sparse matrix file (string:filename)")
("gsm-file,g", po::value<string>(&gsm_filename)->default_value("distances.gsm"), "Input: General sparse matrix file (string:filename)")
("evals-file,v", po::value<string>(&evals_filename)->default_value("eigenvalues.dat"), "Output: Eigenvalues file (string:filename)")
("evecs-file,e", po::value<string>(&evecs_filename)->default_value("eigenvectors.dat"), "Output: Eigenvectors file (string:filename)")
("residuals-file,r", po::value<string>(&residuals_filename)->default_value("residuals.dat"), "Output: Residuals file (string:filename)")
;
cmdline_options.add(program_options);
po::variables_map vm;
po::store(po::parse_command_line(argc, argv, cmdline_options), vm);
po::notify(vm);
if (vm.count("help")) {
cout << "usage: " << program_name << " [options]" << endl;
cout << cmdline_options << endl;
return 1;
}
if (!vm.count("sigma")) {
cout << "ERROR: --sigma not supplied." << endl;
cout << endl;
optsOK = false;
}
if (!vm.count("nevals")) {
cout << "ERROR: --nevals not supplied." << endl;
cout << endl;
optsOK = false;
}
if (!optsOK) {
return -1;
}
cout << "Running with the following options:" << endl;
cout << "sigma = " << sigma_a << endl;
cout << "nevals = " << nev << endl;
cout << "ssm-file = " << ssm_filename << endl;
cout << "gsm-file = " << gsm_filename << endl;
cout << "evals-file = " << evals_filename << endl;
cout << "evecs-file = " << evecs_filename << endl;
cout << "residuals-file = " << residuals_filename << endl;
cout << endl;
// General
int n; // Dimension of the problem.
int m; // Outer dimension
// Main affinity matrix
int nnzA;
int *irowA;
int *pcolA;
double *A; // Pointer to an array that stores the lower
// triangular elements of A.
// Expanded affinity matrix
int nnzB;
int *irowB;
int *pcolB;
double *B; // Pointer to an array that stores the
// sparse elements of B.
// File input streams
ifstream ssm;
ifstream gsm;
// File output streams
ofstream eigenvalues;
ofstream eigenvectors;
ofstream residuals;
// EPS
double eps = 1.0;
do { eps /= 2.0; } while (1.0 + (eps / 2.0) != 1.0);
eps = sqrt(eps);
// Open files
ssm.open(ssm_filename.c_str());
gsm.open(gsm_filename.c_str());
eigenvalues.open(evals_filename.c_str());
eigenvectors.open(evecs_filename.c_str());
residuals.open(residuals_filename.c_str());
// Read symmetric CSC matrix
ssm.read((char*) &n, (sizeof(int) / sizeof(char)));
pcolA = new int[n+1];
ssm.read((char*) pcolA, (sizeof(int) / sizeof(char)) * (n+1));
nnzA = pcolA[n];
A = new double[nnzA];
irowA = new int[nnzA];
ssm.read((char*) irowA, (sizeof(int) / sizeof(char)) * nnzA);
ssm.read((char*) A, (sizeof(double) / sizeof(char)) * nnzA);
ssm.close();
// Read general CSC matrix
gsm.read((char*) &m, (sizeof(int) / sizeof(char)));
pcolB = new int[m+1];
gsm.read((char*) pcolB, (sizeof(int) / sizeof(char)) * (m+1));
nnzB = pcolB[m];
B = new double[nnzB];
irowB = new int[nnzB];
gsm.read((char*) irowB, (sizeof(int) / sizeof(char)) * nnzB);
gsm.read((char*) B, (sizeof(double) / sizeof(char)) * nnzB);
gsm.close();
// Turn distances into normalized affinities...
double *d_a = new double[n];
double *d_b = new double[m];
// Make affinity matrices...
for (int x = 0; x < nnzA; x++)
A[x] = exp(-(A[x] * A[x]) / (2.0 * sigma_a * sigma_a));
for (int x = 0; x < nnzB; x++)
B[x] = exp(-(B[x] * B[x]) / (2.0 * sigma_a * sigma_a));
// Calculate D_A
for (int x = 0; x < n; x++)
d_a[x] = 0.0;
for (int x = 0; x < n; x++) {
for (int y = pcolA[x]; y < pcolA[x+1]; y++) {
d_a[x] += A[y];
d_a[irowA[y]] += A[y];
}
}
for (int x = 0; x < n; x++)
d_a[x] = 1.0 / sqrt(d_a[x]);
// Calculate D_B
for (int x = 0; x < m; x++)
d_b[x] = 0.0;
for (int x = 0; x < m; x++) {
for (int y = pcolB[x]; y < pcolB[x+1]; y++) {
d_b[x] += B[y];
}
}
for (int x = 0; x < m; x++)
d_b[x] = 1.0 / sqrt(d_b[x]);
// Normalize the affinity matrix...
for (int x = 0; x < n; x++) {
for (int y = pcolA[x]; y < pcolA[x+1]; y++) {
A[y] *= d_a[irowA[y]] * d_a[x];
}
}
// Normalized B matrix...
for (int x = 0; x < m; x++) {
for (int y = pcolB[x]; y < pcolB[x+1]; y++) {
B[y] *= d_a[irowB[y]] * d_b[x];
}
}
delete [] d_a;
delete [] d_b;
// Eigen decomposition of nomalized affinity matrix...
// ARPACK setup...
double *Ax = new double[n]; // Array for residual calculation
double residual = 0.0;
double max_residual = 0.0;
int ido = 0;
char bmat = 'I';
char which[2];
which[0] = 'L';
which[1] = 'A';
double tol = 0.0;
double *resid = new double[n];
// NOTE: Need about one order of magnitude more arnoldi vectors to
// converge for the normalized Laplacian (according to residuals...)
int ncv = ((10*nev+1)>n)?n:(10*nev+1);
double *V = new double[(ncv*n)+1];
int ldv = n;
int *iparam = new int[12];
iparam[1] = 1;
iparam[3] = 100 * nev;
iparam[4] = 1;
iparam[7] = 1;
int *ipntr = new int[15];
double *workd = new double[(3*n)+1];
int lworkl = ncv*(ncv+9);
double *workl = new double[lworkl+1];
int info = 0;
int rvec = 1;
char HowMny = 'A';
int *lselect = new int[ncv];
double *d = new double[nev];
double *Z = &V[1];
int ldz = n;
double sigma = 0.0;
double *extrap_evec = new double[m];
double *norm_evec = new double[n];
while (ido != 99) {
dsaupd_(&ido, &bmat, &n, which,
&nev, &tol, resid,
&ncv, &V[1], &ldv,
&iparam[1], &ipntr[1], &workd[1],
&workl[1], &lworkl, &info);
if (ido == -1 || ido == 1) {
// Matrix-vector multiplication
sp_dsymv(n, irowA, pcolA, A,
&workd[ipntr[1]],
&workd[ipntr[2]]);
}
}
dseupd_(&rvec, &HowMny, lselect,
d, Z, &ldz,
&sigma, &bmat, &n,
which, &nev, &tol,
resid, &ncv, &V[1],
&ldv, &iparam[1], &ipntr[1],
&workd[1], &workl[1],
&lworkl, &info);
cout << "Number of converged eigenvalues/vectors found: "
<< iparam[5] << endl;
for (int x = nev-1; x >= 0; x--) {
#ifdef DECOMP_WRITE_DOUBLE
eigenvalues.write((char*) &d[x],(sizeof(double) / sizeof(char)));
eigenvectors.write((char*) &Z[n*x],(sizeof(double) * n) / sizeof(char));
#else
eigenvalues << d[x] << endl;
for (int y = 0; y < n; y++)
eigenvectors << Z[(n*x)+y] << " ";
#endif
// Extrapolate remaining points onto the vector space
for (int y = 0; y < n; y++)
norm_evec[y] = Z[(n*x)+y] / d[x];
sp_dgemv(m, irowB, pcolB, B, norm_evec, extrap_evec);
#ifdef DECOMP_WRITE_DOUBLE
eigenvectors.write((char*) extrap_evec,(sizeof(double) * m) / sizeof(char));
#else
for (int y = 0; y < m; y++)
eigenvectors << extrap_evec[y] << " ";
eigenvectors << endl;
#endif
// Calculate residual...
// Matrix-vector multiplication
sp_dsymv(n, irowA, pcolA, A,
&Z[n*x], Ax);
double t = -d[x];
int i = 1;
daxpy_(&n, &t, &Z[n*x], &i, Ax, &i);
residual = dnrm2_(&n, Ax, &i)/fabs(d[x]);
if (residual > max_residual)
max_residual = residual;
#ifdef DECOMP_WRITE_DOUBLE
residuals.write((char*) &residual, sizeof(double) / sizeof(char));
#else
residuals << residual << endl;
#endif
}
cout << "Max residual: " << max_residual
<< " (eps: " << eps << ")" << endl;
if (max_residual > eps) {
cout << "*** Sum of residuals too high (max_r > eps)!" << endl;
cout << "*** Please, check results manually..." << endl;
}
eigenvalues.close();
eigenvectors.close();
residuals.close();
delete [] irowA;
delete [] pcolA;
delete [] A;
delete [] irowB;
delete [] pcolB;
delete [] B;
// ARPACK
delete [] lselect;
delete [] d;
delete [] resid;
delete [] Ax;
delete [] V;
delete [] iparam;
delete [] ipntr;
delete [] workd;
delete [] workl;
delete [] norm_evec;
delete [] extrap_evec;
return 0;
}
/** Get eigenvectors and eigenvalues. They will be stored in descending
* order (largest eigenvalue first).
*/
int DataSet_Modes::CalcEigen(DataSet_2D const& mIn, int n_to_calc) {
#ifdef NO_MATHLIB
mprinterr("Error: modes: Compiled without ARPACK/LAPACK/BLAS routines.\n");
return 1;
#else
bool eigenvaluesOnly = false;
int info = 0;
if (mIn.MatrixKind() != DataSet_2D::HALF) {
mprinterr("Error: DataSet_Modes: Eigenvector/value calc only for symmetric matrices.\n");
return 1;
}
// If number to calc is 0, assume we want eigenvalues only
if (n_to_calc < 1) {
if (n_to_calc == 0) eigenvaluesOnly = true;
nmodes_ = (int)mIn.Ncols();
} else
nmodes_ = n_to_calc;
if (nmodes_ > (int)mIn.Ncols()) {
mprintf("Warning: Specified # of eigenvalues to calc (%i) > matrix dimension (%i).\n",
nmodes_, mIn.Ncols());
nmodes_ = mIn.Ncols();
mprintf("Warning: Only calculating %i eigenvalues.\n", nmodes_);
}
if (eigenvaluesOnly)
mprintf("\tCalculating %i eigenvalues only.\n", nmodes_);
else
mprintf("\tCalculating %i eigenvectors and eigenvalues.\n", nmodes_);
// -----------------------------------------------------------------
if (nmodes_ == (int)mIn.Ncols()) {
// Calculate all eigenvalues (and optionally eigenvectors).
char jobz = 'V'; // Default: Calc both eigenvectors and eigenvalues
vecsize_ = mIn.Ncols();
// Check if only calculating eigenvalues
if (eigenvaluesOnly) {
jobz = 'N';
vecsize_ = 1;
}
// Set up space to hold eigenvectors
if (evectors_ != 0) delete[] evectors_;
if (!eigenvaluesOnly)
evectors_ = new double[ nmodes_ * vecsize_ ];
else
evectors_ = 0;
// Set up space to hold eigenvalues
if (evalues_ != 0) delete[] evalues_;
evalues_ = new double[ nmodes_ ];
// Create copy of matrix since call to dspev destroys it
double* mat = mIn.MatrixArray();
// Lower triangle; not upper since fortran array layout is inverted w.r.t. C/C++
char uplo = 'L';
// Allocate temporary workspace
double* work = new double[ 3 * nmodes_ ];
// NOTE: The call to dspev is supposed to store eigenvectors in columns.
// However as mentioned above fortran array layout is inverted
// w.r.t. C/C++ so eigenvectors end up in rows.
// NOTE: Eigenvalues/vectors are returned in ascending order.
dspev_(jobz, uplo, nmodes_, mat, evalues_, evectors_, vecsize_, work, info);
// If no eigenvectors calcd set vecsize to 0
if (evectors_==0)
vecsize_ = 0;
delete[] work;
delete[] mat;
if (info != 0) {
if (info < 0) {
mprinterr("Internal Error: from dspev: Argument %i had illegal value.\n", -info);
mprinterr("Args: %c %c %i matrix %x %x %i work %i\n", jobz, uplo, nmodes_,
evalues_, evectors_, vecsize_, info);
} else { // info > 0
mprinterr("Internal Error: from dspev: The algorithm failed to converge.\n");
mprinterr("%i off-diagonal elements of an intermediate tridiagonal form\n", info);
mprinterr("did not converge to zero.\n");
}
return 1;
}
// -----------------------------------------------------------------
} else {
// Calculate up to n-1 eigenvalues/vectors using the Implicitly Restarted
// Arnoldi iteration.
// FIXME: Eigenvectors obtained with this method appear to have signs
// flipped compared to full method - is dot product wrong?
int nelem = mIn.Ncols(); // Dimension of input matrix (N)
// Allocate memory to store eigenvectors
vecsize_ = mIn.Ncols();
int ncv; // # of columns of the matrix V (evectors_), <= N (mIn.Ncols())
if (evectors_!=0) delete[] evectors_;
if (nmodes_*2 <= nelem)
ncv = nmodes_*2;
else
ncv = nelem;
evectors_ = new double[ ncv * nelem ];
// Temporary storage for eigenvectors to avoid memory overlap in dseupd
double* eigenvectors = new double[ ncv * nelem ];
// Allocate memory to store eigenvalues
if ( evalues_ != 0) delete[] evalues_;
evalues_ = new double[ nelem ] ; // NOTE: Should this be nmodes?
// Allocate workspace
double* workd = new double[ 3 * nelem ];
int lworkl = ncv * (ncv+8); // NOTE: should this be ncv^2 * (ncv+8)
double* workl = new double[ lworkl ];
double* resid = new double[ nelem ];
// Set parameters for dsaupd (Arnolid)
int ido = 0; // Reverse comm. flag; 0 = first call
// The iparam array is used to set parameters for the calc.
int iparam[11];
std::fill( iparam, iparam + 11, 0 );
iparam[0] = 1; // Method for selecting implicit shifts; 1 = exact
iparam[2] = 300; // Max # of iterations allowed
iparam[3] = 1; // blocksize to be used in the recurrence (code works with only 1).
iparam[6] = 1; // Type of eigenproblem being solved; 1: A*x = lambda*x
double tol = 0; // Stopping criterion (tolerance); 0 = arpack default
char bmat = 'I'; // Type of matrix B that defines semi-inner product; I = identity
char which[2]; // Which of the Ritz values of OP to compute;
which[0] = 'L'; // 'LA' = compute the NEV largest eigenvalues
which[1] = 'A';
// The ipntr array will hold starting locations in workd and workl arrays
// for matrices/vectors used by the Lanczos iteration.
int ipntr[11];
std::fill( ipntr, ipntr + 11, 0 );
// Create copy of matrix since it will be modified
double* mat = mIn.MatrixArray();
// LOOP
bool loop = false;
do {
if (loop) {
// Dot products
double* target = workd + (ipntr[1] - 1); // -1 since fortran indexing starts at 1
double* vec = workd + (ipntr[0] - 1);
std::fill( target, target + nelem, 0 );
for(int i = 0; i < nelem; i++) {
for(int j = i; j < nelem; j++) {
int ind = nelem * i + j - (i * (i + 1)) / 2;
target[i] += mat[ind] * vec[j];
if(i != j)
target[j] += mat[ind] * vec[i];
}
}
}
dsaupd_(ido, bmat, nelem, which, nmodes_, tol, resid,
ncv, eigenvectors, nelem, iparam, ipntr, workd, workl,
lworkl, info);
loop = (ido == -1 || ido == 1);
} while ( loop ); // END LOOP
if (info != 0) {
mprinterr("Error: DataSet_Modes: dsaupd returned %i\n",info);
} else {
int rvec = 1;
char howmny = 'A';
double sigma = 0.0;
int* select = new int[ ncv ];
dseupd_(rvec, howmny, select, evalues_, evectors_, nelem, sigma,
bmat, nelem, which, nmodes_, tol, resid,
ncv, eigenvectors, nelem, iparam, ipntr, workd, workl,
lworkl, info);
delete[] select;
}
delete[] mat;
delete[] workl;
delete[] workd;
delete[] resid;
delete[] eigenvectors;
if (info != 0) {
mprinterr("Error: DataSet_Modes: dseupd returned %i\n",info);
return 1;
}
}
// Eigenvalues and eigenvectors are in ascending order. Resort so that
// they are in descending order (i.e. largest eigenvalue first).
int pivot = nmodes_ / 2;
int nmode = nmodes_ - 1;
double* vtmp = 0;
if (evectors_ != 0)
vtmp = new double[ vecsize_ ];
for (int mode = 0; mode < pivot; ++mode) {
// Swap eigenvalue
double eval = evalues_[mode];
evalues_[mode] = evalues_[nmode];
evalues_[nmode] = eval;
// Swap eigenvector
if (vtmp != 0) {
double* Vec0 = evectors_ + (mode * vecsize_);
double* Vec1 = evectors_ + (nmode * vecsize_);
std::copy( Vec0, Vec0 + vecsize_, vtmp );
std::copy( Vec1, Vec1 + vecsize_, Vec0 );
std::copy( vtmp, vtmp + vecsize_, Vec1 );
}
--nmode;
}
if (vtmp != 0) delete[] vtmp;
return 0;
#endif
}
int
ArpackSolver::solve(int numModes, bool generalized)
{
if (generalized == false) {
opserr << "ArpackSolver::solve() - at moment only solves generalized problem\n";
return -1;
}
theSOE = theArpackSOE->theSOE;
if (theSOE == 0) {
opserr << "ArpackSolver::setSize() - no LinearSOE set\n";
return -1;
}
// set up the space for ARPACK functions.
// this is done each time method is called!! .. this needs to be cleaned up
int n = size;
int nev = numModes;
int ncv = getNCV(n, nev);
int ldv = n;
int lworkl = ncv*ncv + 8*ncv;
int processID = theArpackSOE->processID;
// set up the space for ARPACK functions.
// this is done each time method is called!! .. this needs to be cleaned up
if (numModes > numModesMax) {
if (v != 0) delete [] v;
if (workl != 0) delete [] workl;
if (workd != 0) delete [] workd;
if (eigenvalues != 0) delete [] eigenvalues;
if (eigenvectors != 0) delete [] eigenvectors;
if (resid != 0) delete [] resid;
if (select != 0) delete [] select;
v = new double[ldv * ncv];
workl = new double[lworkl + 1];
workd = new double[3 * n + 1];
eigenvalues = new double[nev];
eigenvectors = new double[n * nev];
resid = new double[n];
select = new logical[ncv];
for (int i=0; i<lworkl+1; i++)
workl[i] = 0;
for (int i=0; i<3*n+1; i++)
workd[i] = 0;
for (int i=0; i<ldv*ncv; i++)
v[i] = 0;
numModesMax = numModes;
}
static char which[3]; strcpy(which, "LM");
char bmat = 'G';
char howmy = 'A';
// some more variables
double tol = 0.0;
int info = 0;
int maxitr = 1000;
int mode = 3;
iparam[0] = 1;
iparam[2] = maxitr;
iparam[6] = mode;
bool rvec = true;
int ido = 0;
int ierr = 0;
while (1) {
#ifdef _WIN32
unsigned int sizeWhich =2;
unsigned int sizeBmat =1;
unsigned int sizeHowmany =1;
unsigned int sizeOne = 1;
DSAUPD(&ido, &bmat, &n, which, &nev, &tol, resid,
&ncv, v, &ldv,
iparam, ipntr, workd, workl, &lworkl, &info);
#else
dsaupd_(&ido, &bmat, &n, which, &nev, &tol, resid, &ncv, v, &ldv,
iparam, ipntr, workd, workl, &lworkl, &info);
#endif
if (ido == -1) {
myMv(n, &workd[ipntr[0]-1], &workd[ipntr[1]-1]);
theVector.setData(&workd[ipntr[1] - 1], size);
theSOE->setB(theVector);
ierr = theSOE->solve();
const Vector &X = theSOE->getX();
theVector = X;
continue;
} else if (ido == 1) {
// double ratio = 1.0;
myCopy(n, &workd[ipntr[2]-1], &workd[ipntr[1]-1]);
theVector.setData(&workd[ipntr[1] - 1], size);
if (processID > 0)
theSOE->zeroB();
else
theSOE->setB(theVector);
theSOE->solve();
const Vector &X = theSOE->getX();
theVector = X;
// theVector.setData(&workd[ipntr[1] - 1], size);
continue;
} else if (ido == 2) {
myMv(n, &workd[ipntr[0]-1], &workd[ipntr[1]-1]);
continue;
}
break;
}
if (info < 0) {
opserr << "ArpackSolver::Error with _saupd info = " << info << endln;
switch(info) {
case -1:
opserr << "N must be positive.\n";
break;
case -2:
opserr << "NEV must be positive.\n";
break;
case -3:
opserr << "NCV must be greater than NEV and less than or equal to N.\n";
break;
case -4:
opserr << "The maximum number of Arnoldi update iterations allowed";
break;
case -5:
opserr << "WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'.\n";
break;
case -6:
opserr << "BMAT must be one of 'I' or 'G'.\n";
break;
case -7:
opserr << "Length of private work array WORKL is not sufficient.\n";
break;
case -8:
opserr << "Error return from trid. eigenvalue calculation";
opserr << "Informatinal error from LAPACK routine dsteqr.\n";
break;
case -9:
opserr << "Starting vector is zero.\n";
break;
case -10:
opserr << "IPARAM(7) must be 1,2,3,4,5.\n";
break;
case -11:
opserr << "IPARAM(7) = 1 and BMAT = 'G' are incompatable.\n";
break;
case -12:
opserr << "IPARAM(1) must be equal to 0 or 1.\n";
break;
case -13:
opserr << "NEV and WHICH = 'BE' are incompatable.\n";
break;
case -9999:
opserr << "Could not build an Arnoldi factorization.";
opserr << "IPARAM(5) the size of the current Arnoldi factorization: is ";
opserr << iparam[4];
opserr << "factorization. The user is advised to check that";
opserr << "enough workspace and array storage has been allocated.\n";
break;
default:
opserr << "unrecognised return value\n";
}
eigenvalues = 0;
eigenvectors = 0;
return info;
} else {
if (info == 1) {
opserr << "ArpackSolver::Maximum number of iteration reached." << endln;
} else if (info == 3) {
opserr << "ArpackSolver::No Shifts could be applied during implicit,";
opserr << "Arnoldi update, try increasing NCV." << endln;
}
double sigma = shift;
if (iparam[4] > 0) {
rvec = true;
n = size;
ldv = n;
#ifdef _WIN32
unsigned int sizeWhich =2;
unsigned int sizeBmat =1;
unsigned int sizeHowmany =1;
DSEUPD(&rvec, &howmy, select, eigenvalues, eigenvectors, &ldv, &sigma, &bmat, &n, which,
&nev, &tol, resid, &ncv, v, &ldv, iparam, ipntr, workd,
workl, &lworkl, &info);
#else
dseupd_(&rvec, &howmy, select, eigenvalues, eigenvectors, &ldv, &sigma, &bmat, &n, which,
&nev, &tol, resid, &ncv, v, &ldv, iparam, ipntr, workd,
workl, &lworkl, &info);
#endif
if (info != 0) {
opserr << "ArpackSolver::Error with dseupd_" << info;
switch(info) {
case -1:
opserr << " N must be positive.\n";
break;
case -2:
opserr << " NEV must be positive.\n";
break;
case -3:
opserr << " NCV must be greater than NEV and less than or equal to N.\n";
break;
case -5:
opserr << " WHICH must be one of 'LM', 'SM', 'LA', 'SA' or 'BE'.\n";
break;
case -6:
opserr << " BMAT must be one of 'I' or 'G'.\n";
break;
case -7:
opserr << " Length of private work WORKL array is not sufficient.\n";
break;
case -8:
opserr << " Error return from trid. eigenvalue calculation";
opserr << "Information error from LAPACK routine dsteqr.\n";
break;
case -9:
opserr << " Starting vector is zero.\n";
break;
case -10:
opserr << " IPARAM(7) must be 1,2,3,4,5.\n";
break;
case -11:
opserr << " IPARAM(7) = 1 and BMAT = 'G' are incompatibl\n";
break;
case -12:
opserr << " NEV and WHICH = 'BE' are incompatible.\n";
break;
case -14:
opserr << " DSAUPD did not find any eigenvalues to sufficient accuracy.\n";
break;
case -15:
opserr << " HOWMNY must be one of 'A' or 'S' if RVEC = .true.\n";
break;
case -16:
opserr << " HOWMNY = 'S' not yet implemented\n";
break;
default:
;
}
return info;
}
}
}
numMode = numModes;
// clean up the memory
return 0;
}
/* obtain min and max of real part eigenvalues by dsaupd_()
* INPUT
* n : dimension of the matrix
* atimes (n, x, b, user_data) : routine to calc A.x and return b[]
* user_data : pointer to be passed to solver and atimes routines
* eps : required precision
* OUTPUT
* l[2] : l[0] = min
* l[1] = max
*/
void dsaupd_wrap_min_max (int n, double *l,
void (*atimes)
(int, const double *, double *, void *),
void *user_data,
double eps)
{
char bmat[2] = "I"; // standard eigenvalue problem A*x = lambda*x
char SA[3] = "SA"; // compute the NEV smallest (algebraic) eigenvalues.
char LA[3] = "LA"; // compute the NEV largest (algebraic) eigenvalues.
int nev = 1;
double *resid = (double *)malloc (sizeof (double) * n);
CHECK_MALLOC (resid, "dsaupd_wrap_min_max");
int ncv;
/*
//ncv = 2 * nev + 1;
ncv = 2 * nev * 14;
if (ncv < 4) ncv = 4;
if (ncv > n) ncv = n;
*/
ncv = n;
//fprintf (stderr, "# n = %d, nev = %d, ncv = %d\n", n, nev, ncv);
int ldv = n;
double *v = (double *)malloc (sizeof (double) * ldv*ncv);
CHECK_MALLOC (v, "dsaupd_wrap_min_max");
int iparam[11];
int ishift = 1; // exact shifts
int maxitr = 3 * n; // max iterations of Arnoldi steps
int mode = 1; // type of eigenproblem
iparam[0] = ishift; // IPARAM(1) = ISHIFT
iparam[2] = maxitr; // IPARAM(3) = MXITER
iparam[6] = mode; // IPARAM(7) = MODE
int ipntr[11];
int lworkl = ncv*(ncv+8);
double *workd = (double *)malloc (sizeof (double) * 3 * n);
double *workl = (double *)malloc (sizeof (double) * lworkl);
CHECK_MALLOC (workd, "dsaupd_wrap_min_max");
CHECK_MALLOC (workl, "dsaupd_wrap_min_max");
// for post-process
int rvec = 0; // false? (no eigenvectors)
char howmny[2] = "A"; // Compute NEV Ritz vectors;
int *select = (int *)malloc (sizeof (int) * ncv);
double *d = (double *)malloc (sizeof (double) * nev);
double *z = (double *)malloc (sizeof (double) * n * nev);
CHECK_MALLOC (select, "dsaupd_wrap_min_max");
CHECK_MALLOC (d, "dsaupd_wrap_min_max");
CHECK_MALLOC (z, "dsaupd_wrap_min_max");
int ldz = n;
double sigma;
int ierr;
// The Smallest Eigenvalue
int ido = 0; // restart
int info = 0; // a randomly initial residual vector is used.
dsaupd_(&ido, bmat, &n, SA, &nev, &eps, resid,
&ncv, v, &ldv, iparam, ipntr, workd, workl,
&lworkl, &info);
while (ido == -1 || ido == 1)
{
atimes (n,
workd + ipntr[0] - 1, // workd(ipntr(1))
workd + ipntr[1] - 1, // workd(ipntr(2))
user_data);
dsaupd_(&ido, bmat, &n, SA, &nev, &eps, resid,
&ncv, v, &ldv, iparam, ipntr, workd, workl,
&lworkl, &info);
}
if (info < 0)
{
fprintf (stdout, "Error with dsaupd;\n");
dsaupd_info (stderr, info);
}
else
{
dseupd_(&rvec, howmny, select, d, z, &ldz,
&sigma, bmat, &n, SA, &nev, &eps,
resid, &ncv, v, &ldv, iparam, ipntr, workd, workl,
&lworkl, &ierr);
if (ierr != 0)
{
fprintf (stdout, "Error with dseupd;\n");
dseupd_info (stdout, ierr);
}
else if (info != 0)
{
dsaupd_info (stderr, info);
}
/*
int nconv = iparam[4];
fprintf (stdout, " _NDRV1 \n");
fprintf (stdout, " ====== \n\n");
fprintf (stdout, " Size of the matrix is %d\n", n);
fprintf (stdout, " The number of Ritz values requested is %d\n", nev);
fprintf (stdout, " The number of Arnoldi vectors generated"
" (NCV) is %d\n", ncv);
fprintf (stdout, " What portion of the spectrum: %s\n", SA);
fprintf (stdout, " The number of converged Ritz values is %d\n",
nconv);
fprintf (stdout, " The number of Implicit Arnoldi update"
" iterations taken is %d\n", iparam[2]);
fprintf (stdout, " The number of OP*x is %d\n", iparam[8]);
fprintf (stdout, " The convergence criterion is %e\n", eps);
fprintf (stdout, "d [0] = %e + i %e\n", dr[0], di[0]);
*/
l[0] = d[0];
}
// The Largest Eigenvalue
ido = 0;
info = 0; // a randomly initial residual vector is used.
//info = 1;
/* RESID contains the initial residual vector,
* possibly from a previous run.
*/
dsaupd_(&ido, bmat, &n, LA, &nev, &eps, resid,
&ncv, v, &ldv, iparam, ipntr, workd, workl,
&lworkl, &info);
while (ido == -1 || ido == 1)
{
atimes (n,
workd + ipntr[0] - 1, // workd(ipntr(1))
workd + ipntr[1] - 1, // workd(ipntr(2))
user_data);
dsaupd_(&ido, bmat, &n, LA, &nev, &eps, resid,
&ncv, v, &ldv, iparam, ipntr, workd, workl,
&lworkl, &info);
}
if (info < 0)
{
fprintf (stdout, "Error with dsaupd;\n");
dsaupd_info (stderr, info);
}
else
{
dseupd_(&rvec, howmny, select, d, z, &ldz,
&sigma, bmat, &n, LA, &nev, &eps,
resid, &ncv, v, &ldv, iparam, ipntr, workd, workl,
&lworkl, &ierr);
if (ierr != 0)
{
fprintf (stdout, "Error with dseupd;\n");
dseupd_info (stdout, ierr);
}
else if (info != 0)
{
dsaupd_info (stderr, info);
}
/*
int nconv = iparam[4];
fprintf (stdout, "nconv = %d\n", nconv);
fprintf (stdout, " _NDRV1 \n");
fprintf (stdout, " ====== \n\n");
fprintf (stdout, " Size of the matrix is %d\n", n);
fprintf (stdout, " The number of Ritz values requested is %d\n", nev);
fprintf (stdout, " The number of Arnoldi vectors generated"
" (NCV) is %d\n", ncv);
fprintf (stdout, " What portion of the spectrum: %s\n", LA);
fprintf (stdout, " The number of converged Ritz values is %d\n",
nconv);
fprintf (stdout, " The number of Implicit Arnoldi update"
" iterations taken is %d\n", iparam[2]);
fprintf (stdout, " The number of OP*x is %d\n", iparam[8]);
fprintf (stdout, " The convergence criterion is %e\n", eps);
fprintf (stdout, "d [0] = %e + i %e\n", dr[0], di[0]);
*/
l[1] = d[0];
}
free (resid);
free (workd);
free (workl);
free (v);
free (select);
free (d);
free (z);
}
void arpack_dsaupd(double* matrix, int n, int nev, const char* which,
int mode, bool pos, double shift, double* eigenvalues,
double* eigenvectors, int& status)
{
// check if nev is greater than n
if (nev>n)
SG_SERROR("Number of required eigenpairs is greater than order of the matrix");
// check specified mode
if (mode!=1 && mode!=3)
SG_SERROR("Unknown mode specified");
// init ARPACK's reverse communication parameter
// (should be zero initially)
int ido = 0;
// specify that non-general eigenproblem will be solved
// (Ax=lGx, where G=I)
char bmat[2] = "I";
// init tolerance (zero means machine precision)
double tol = 0.0;
// allocate array to hold residuals
double* resid = new double[n];
// set number of Lanczos basis vectors to be used
// (with max(4*nev,n) sufficient for most tasks)
int ncv = nev*4>n ? n : nev*4;
// allocate array 'v' for dsaupd routine usage
int ldv = n;
double* v = new double[ldv*ncv];
// init array for i/o params for routine
int* iparam = new int[11];
// specify method for selecting implicit shifts (1 - exact shifts)
iparam[0] = 1;
// specify max number of iterations
iparam[2] = 2*2*n;
// set the computation mode (1 for regular or 3 for shift-inverse)
iparam[6] = mode;
// init array indicating locations of vectors for routine callback
int* ipntr = new int[11];
// allocate workaround arrays
double* workd = new double[3*n];
int lworkl = ncv*(ncv+8);
double* workl = new double[lworkl];
// init info holding status (should be zero at first call)
int info = 0;
// which eigenpairs to find
char* which_ = strdup(which);
// All
char* all_ = strdup("A");
// shift-invert mode
if (mode==3)
{
for (int i=0; i<n; i++)
matrix[i*n+i] -= shift;
if (pos)
{
clapack_dpotrf(CblasColMajor,CblasUpper,n,matrix,n);
clapack_dpotri(CblasColMajor,CblasUpper,n,matrix,n);
}
else
{
int* ipiv = new int[n];
clapack_dgetrf(CblasColMajor,n,n,matrix,n,ipiv);
clapack_dgetri(CblasColMajor,n,matrix,n,ipiv);
delete[] ipiv;
}
}
// main computation loop
do
{
dsaupd_(&ido, bmat, &n, which_, &nev, &tol, resid,
&ncv, v, &ldv, iparam, ipntr, workd, workl,
&lworkl, &info);
if ((ido==1)||(ido==-1))
{
cblas_dsymv(CblasColMajor,CblasUpper,
n,1.0,matrix,n,
(workd+ipntr[0]-1),1,
0.0,(workd+ipntr[1]-1),1);
}
} while ((ido==1)||(ido==-1));
// check if DSAUPD failed
if (info<0)
{
if ((info<=-1)&&(info>=-6))
SG_SWARNING("DSAUPD failed. Wrong parameter passed.");
else if (info==-7)
SG_SWARNING("DSAUPD failed. Workaround array size is not sufficient.");
else
SG_SWARNING("DSAUPD failed. Error code: %d.", info);
status = -1;
}
else
{
if (info==1)
SG_SWARNING("Maximum number of iterations reached.\n");
// allocate select for dseupd
int* select = new int[ncv];
// allocate d to hold eigenvalues
double* d = new double[2*ncv];
// sigma for dseupd
double sigma = shift;
// init ierr indicating dseupd possible errors
int ierr = 0;
// specify that eigenvectors to be computed too
int rvec = 1;
dseupd_(&rvec, all_, select, d, v, &ldv, &sigma, bmat,
&n, which_, &nev, &tol, resid, &ncv, v, &ldv,
iparam, ipntr, workd, workl, &lworkl, &ierr);
if (ierr!=0)
{
SG_SWARNING("DSEUPD failed with status=%d", ierr);
status = -1;
}
else
{
for (int i=0; i<nev; i++)
{
eigenvalues[i] = d[i];
for (int j=0; j<n; j++)
eigenvectors[j*nev+i] = v[i*n+j];
}
}
// cleanup
delete[] select;
delete[] d;
}
// cleanup
delete[] all_;
delete[] which_;
delete[] resid;
delete[] v;
delete[] iparam;
delete[] ipntr;
delete[] workd;
delete[] workl;
};
