void CLOP_sub::genpu(const Epetra_IntVector *LD,
const Epetra_MultiVector *Coords, double rhs[],
double sol[], double temp[], int atype_sub, int ndim_sub,
double WORK[], int LWORK, double Edof_sub[],
int & nneg)
{
int i, j, k, nrhs, nnz_rhs, dof;
double *coords;
atype = atype_sub;
ndim = ndim_sub;
LD->ExtractView(&locdof);
int ndof_proc = Coords->Stride();
Coords->ExtractView(&coords, &ndof_proc);
x = &coords[0];
y = &coords[ndof_proc];
z = &coords[2*ndof_proc];
xcent = 0; ycent = 0; zcent = 0;
for (i=0; i<ndof; i++) {
dof = subdofs[i]; xcent += x[dof]; ycent += y[dof]; zcent += z[dof];
}
xcent /= ndof; ycent /= ndof; zcent /= ndof;
if (atype == 1) {
csdim_max = 1;
nrhs = ndim + 1;
nnz_rhs = ndof*nrhs;
myzero(rhs, nnz_rhs);
if (ndim == 2) {
for (i=0; i<ndof; i++) {
dof = subdofs[i];
rhs[i+0*ndof] = 1;
rhs[i+1*ndof] = x[dof] - xcent;
rhs[i+2*ndof] = y[dof] - ycent;
}
}
if (ndim == 3) {
for (i=0; i<ndof; i++) {
dof = subdofs[i];
rhs[i+0*ndof] = 1;
rhs[i+1*ndof] = x[dof] - xcent;
rhs[i+2*ndof] = y[dof] - ycent;
rhs[i+3*ndof] = z[dof] - zcent;
}
}
//
// check to make sure coordinate data is meaningful
//
int coord_flag = 0;
for (i=0; i<ndof; i++) {
dof = subdofs[i];
if (x[dof] != 0) {
coord_flag = 1;
break;
}
}
if (coord_flag == 0) nrhs = 1;
}
if (atype == 2) {
if (ndim == 2) {
csdim_max = 3;
nrhs = 6;
nnz_rhs = ndof*nrhs;
myzero(rhs, nnz_rhs);
for (i=0; i<ndof; i++) {
dof = subdofs[i];
if (abs(locdof[dof]) == 1) {
rhs[i+0*ndof] = 1;
rhs[i+1*ndof] = x[dof] - xcent;
rhs[i+2*ndof] = y[dof] - ycent;
}
if (abs(locdof[dof]) == 2) {
rhs[i+3*ndof] = 1;
rhs[i+4*ndof] = x[dof] - xcent;
rhs[i+5*ndof] = y[dof] - ycent;
}
}
}
if (ndim == 3) {
csdim_max = 6;
nrhs = 12;
nnz_rhs = ndof*nrhs;
if (ndof < nrhs) nnz_rhs = nrhs*nrhs;
myzero(rhs, nnz_rhs);
for (i=0; i<ndof; i++) {
dof = subdofs[i];
if (abs(locdof[dof]) == 1) {
rhs[i+0*ndof] = 1;
rhs[i+1*ndof] = x[dof] - xcent;
rhs[i+2*ndof] = y[dof] - ycent;
rhs[i+3*ndof] = z[dof] - zcent;
}
if (abs(locdof[dof]) == 2) {
rhs[i+4*ndof] = 1;
rhs[i+5*ndof] = x[dof] - xcent;
rhs[i+6*ndof] = y[dof] - ycent;
rhs[i+7*ndof] = z[dof] - zcent;
}
if (abs(locdof[dof]) == 3) {
rhs[i+8*ndof] = 1;
rhs[i+9*ndof] = x[dof] - xcent;
rhs[i+10*ndof] = y[dof] - ycent;
rhs[i+11*ndof] = z[dof] - zcent;
}
}
}
}
if (atype == 3) {
csdim_max = 3;
nrhs = 9;
nnz_rhs = ndof*nrhs;
if (ndof < nrhs) nnz_rhs = nrhs*nrhs;
myzero(rhs, nnz_rhs);
for (i=0; i<ndof; i++) {
dof = subdofs[i];
if (abs(locdof[dof]) == 1) {
rhs[i+0*ndof] = 1;
rhs[i+1*ndof] = x[dof] - xcent;
rhs[i+2*ndof] = y[dof] - ycent;
}
if (abs(locdof[dof]) == 2) {
rhs[i+3*ndof] = 1;
rhs[i+4*ndof] = x[dof] - xcent;
rhs[i+5*ndof] = y[dof] - ycent;
}
if (abs(locdof[dof]) == 3) {
rhs[i+6*ndof] = 1;
rhs[i+7*ndof] = x[dof] - xcent;
rhs[i+8*ndof] = y[dof] - ycent;
}
}
}
A_sub->sol(nrhs, rhs, sol, temp);
//
// form SOL' * K * SOL = SOL' * RHS
//
char TRANSA = 'T'; char TRANSB = 'N';
double ALPHA = 1, BETA = 0;
Epetra_BLAS EB;
if (ndof == 0) {
Edof = new double[0];
int duma1(0), duma2;
Comm->MaxAll(&duma1, &duma2, 1);
return;
}
EB.GEMM(TRANSA, TRANSB, nrhs, nrhs, ndof, ALPHA,
sol, ndof, rhs, ndof, BETA, temp, nrhs);
//
// eigenvalues of SOL' * K * SOL are positive if K is positive, but
// may be negative if K has one or more negative eigenvalues. check
// the signs of eigenvalues of SOL' * K * SOL and make zero if
// any are found to be negative
//
char JOBZ('V'), UPLO('U');
double S[60];
for (i=0; i<nrhs*nrhs; i++) rhs[i] = temp[i];
DSYEV_F77(&JOBZ, &UPLO, &nrhs, temp, &nrhs, S, WORK, &LWORK, &INFO, 1, 1);
assert(INFO == 0);
nneg = 0;
double max_mag(0), tol_neg_eig(1e-8);
for (i=0; i<nrhs; i++) if (fabs(S[i]) > max_mag) max_mag = fabs(S[i]);
for (i=0; i<nrhs; i++) if (S[i] < -tol_neg_eig*max_mag) nneg++;
if (nneg > 0) {
myzero(rhs, nrhs*nrhs);
for (i=0; i<nrhs; i++) {
if (S[i] > tol_neg_eig*max_mag) {
for (j=0; j<nrhs; j++) {
for (k=0; k<nrhs; k++) rhs[j+nrhs*k] +=
S[i]*temp[i*nrhs+j]*temp[i*nrhs+k];
}
}
}
}
for (i=0; i<nrhs*nrhs; i++) temp[i] = rhs[i];
//
// calculate pseudo-inverse
//
double RCOND = 1e-8;
int RANK;
double rhs_sol[60], sol_sol[60];
myzero(rhs, nrhs*nrhs);
for (i=0; i<nrhs; i++) rhs[i*(nrhs+1)] = 1;
DGELSS_F77(&nrhs, &nrhs, &nrhs, temp, &nrhs, rhs, &nrhs, S, &RCOND, &RANK,
WORK, &LWORK, &INFO);
assert(INFO == 0);
//
// calculate diagonal of flexibility matrix
//
Edof = new double[ndof];
TRANSA = 'N';
double Edof_max(0), tol_Edof(1e-8);
for (i=0; i<ndof; i++) {
for (j=0; j<nrhs; j++) sol_sol[j] = sol[i+j*ndof];
EB.GEMV(TRANSA, nrhs, nrhs, ALPHA, rhs, nrhs,
sol_sol, BETA, rhs_sol);
Edof[i] = EB.DOT(nrhs, sol_sol, rhs_sol);
if (Edof[i] > Edof_max) Edof_max = Edof[i];
// assert(Edof[i] >= 0);
}
for (i=0; i<ndof; i++) {
if (Edof[i] < tol_Edof*Edof_max) Edof[i] = tol_Edof*Edof_max;
Edof_sub[subdofs[i]] += Edof[i];
}
/*
if (MyPID == 0) {
cout << "xcent, ycent = " << xcent << " " << ycent << endl;
cout << "singular values = " << endl;
for (i=0; i<nrhs; i++) cout << S[i] << endl;
// cout << "x, y, Edof_orig" << endl;
// for (i=0; i<ndof; i++) {
// cout << x[dofa[i]] << " " << y[dofa[i]] << " " << Edof[i] << endl;
// }
}
*/
}
//=============================================================================
void Epetra_LAPACK::SYEV(const char JOBZ, const char UPLO, const int N, double* A, const int LDA, double* W, double* WORK, const int LWORK, int* INFO) const{
DSYEV_F77(CHAR_MACRO(JOBZ), CHAR_MACRO(UPLO), &N, A, &LDA, W, WORK, &LWORK, INFO);
}
