EigenSolve_ARPACK.cpp (getdp-3.4.0-source.tgz) | : | EigenSolve_ARPACK.cpp (getdp-3.5.0-source.tgz) | ||
---|---|---|---|---|
// GetDP - Copyright (C) 1997-2021 P. Dular and C. Geuzaine, University of Liege | // GetDP - Copyright (C) 1997-2022 P. Dular and C. Geuzaine, University of Liege | |||
// | // | |||
// See the LICENSE.txt file for license information. Please report all | // See the LICENSE.txt file for license information. Please report all | |||
// issues on https://gitlab.onelab.info/getdp/getdp/issues. | // issues on https://gitlab.onelab.info/getdp/getdp/issues. | |||
// | // | |||
// Contributor(s): | // Contributor(s): | |||
// Alexandru Mustatea | // Alexandru Mustatea | |||
// Andre Nicolet | // Andre Nicolet | |||
// | // | |||
#include "GetDPConfig.h" | #include "GetDPConfig.h" | |||
skipping to change at line 24 | skipping to change at line 24 | |||
#include <string.h> | #include <string.h> | |||
#include <math.h> | #include <math.h> | |||
#include "Message.h" | #include "Message.h" | |||
#include "ProData.h" | #include "ProData.h" | |||
#include "DofData.h" | #include "DofData.h" | |||
#include "Cal_Quantity.h" | #include "Cal_Quantity.h" | |||
#include "MallocUtils.h" | #include "MallocUtils.h" | |||
#include "OS.h" | #include "OS.h" | |||
#define SQU(a) ((a)*(a)) | #define SQU(a) ((a) * (a)) | |||
#define TWO_PI 6.2831853071795865 | #define TWO_PI 6.2831853071795865 | |||
extern struct CurrentData Current ; | extern struct CurrentData Current; | |||
extern char *Name_Path ; | extern char *Name_Path; | |||
struct EigenPar { | struct EigenPar { | |||
double prec; | double prec; | |||
int size; | int size; | |||
int reortho; | int reortho; | |||
} ; | }; | |||
#if defined(HAVE_NO_UNDERSCORE) | #if defined(HAVE_NO_UNDERSCORE) | |||
#define znaupd_ znaupd | #define znaupd_ znaupd | |||
#define zneupd_ zneupd | #define zneupd_ zneupd | |||
#endif | #endif | |||
extern "C" { | extern "C" { | |||
typedef struct {double re; double im;} complex_16; | typedef struct { | |||
extern void znaupd_(int *ido, char *bmat, int *n, | double re; | |||
char *which, int *nev, double *tol, complex_16 resid[], | double im; | |||
int *ncv, complex_16 v[], int *ldv, int iparam[], | } complex_16; | |||
int ipntr[], complex_16 workd[], complex_16 workl[], int *l | extern void znaupd_(int *ido, char *bmat, int *n, char *which, int *nev, | |||
workl, | double *tol, complex_16 resid[], int *ncv, complex_16 v[], | |||
double rwork[], int *info); | int *ldv, int iparam[], int ipntr[], complex_16 workd[], | |||
extern void zneupd_(unsigned int *rvec, char *howmny, unsigned int select[], | complex_16 workl[], int *lworkl, double rwork[], int *info); | |||
complex_16 d[], complex_16 z[], int *ldz, complex_16 *sigma | extern void zneupd_(unsigned int *rvec, char *howmny, unsigned int select[], | |||
, | complex_16 d[], complex_16 z[], int *ldz, complex_16 *sigma, | |||
complex_16 workev[], char *bmat, int *n, char *which, | complex_16 workev[], char *bmat, int *n, char *which, | |||
int *nev, double *tol, complex_16 resid[], int *ncv, | int *nev, double *tol, complex_16 resid[], int *ncv, | |||
complex_16 v[], int *ldv, int iparam[], int ipntr[], | complex_16 v[], int *ldv, int iparam[], int ipntr[], | |||
complex_16 workd[], complex_16 workl[], int *lworkl, | complex_16 workd[], complex_16 workl[], int *lworkl, | |||
double rwork[], int *info); | double rwork[], int *info); | |||
} | } | |||
static void EigenGetDouble(const char *text, double *d) | static void EigenGetDouble(const char *text, double *d) | |||
{ | { | |||
char str[256]; | char str[256]; | |||
printf("%s (default=%.16g): ", text, *d); | printf("%s (default=%.16g): ", text, *d); | |||
if(fgets(str, sizeof(str), stdin)){ | if(fgets(str, sizeof(str), stdin)) { | |||
if(strlen(str) && strcmp(str, "\n")) | if(strlen(str) && strcmp(str, "\n")) *d = atof(str); | |||
*d = atof(str); | ||||
} | } | |||
} | } | |||
static void EigenGetInt(const char *text, int *i) | static void EigenGetInt(const char *text, int *i) | |||
{ | { | |||
char str[256]; | char str[256]; | |||
printf("%s (default=%d): ", text, *i); | printf("%s (default=%d): ", text, *i); | |||
if(fgets(str, sizeof(str), stdin)){ | if(fgets(str, sizeof(str), stdin)) { | |||
if(strlen(str) && strcmp(str, "\n")) | if(strlen(str) && strcmp(str, "\n")) *i = atoi(str); | |||
*i = atoi(str); | ||||
} | } | |||
} | } | |||
void EigenPar(const char *filename, struct EigenPar *par) | void EigenPar(const char *filename, struct EigenPar *par) | |||
{ | { | |||
char path[1024]; | char path[1024]; | |||
FILE *fp; | FILE *fp; | |||
/* set some defaults */ | /* set some defaults */ | |||
par->prec = 1.e-4; | par->prec = 1.e-4; | |||
par->reortho = 0; | par->reortho = 0; | |||
par->size = 50; | par->size = 50; | |||
/* try to read parameters from file */ | /* try to read parameters from file */ | |||
strcpy(path, Name_Path); | strcpy(path, Name_Path); | |||
strcat(path, filename); | strcat(path, filename); | |||
fp = FOpen(path, "r"); | fp = FOpen(path, "r"); | |||
if(fp) { | if(fp) { | |||
Message::Info("Loading eigenproblem parameter file '%s'", path); | Message::Info("Loading eigenproblem parameter file '%s'", path); | |||
if(fscanf(fp, "%lf %d %d", &par->prec, &par->reortho, &par->size) != 3){ | if(fscanf(fp, "%lf %d %d", &par->prec, &par->reortho, &par->size) != 3) { | |||
Message::Error("Could not read parameters"); | Message::Error("Could not read parameters"); | |||
} | } | |||
fclose(fp); | fclose(fp); | |||
} | } | |||
else{ | else { | |||
fp = FOpen(path, "w"); | fp = FOpen(path, "w"); | |||
if(fp){ | if(fp) { | |||
if(!Message::UseOnelab()){ | if(!Message::UseOnelab()) { | |||
/* get parameters from command line */ | /* get parameters from command line */ | |||
EigenGetDouble("Precision", &par->prec); | EigenGetDouble("Precision", &par->prec); | |||
EigenGetInt("Reorthogonalization", &par->reortho); | EigenGetInt("Reorthogonalization", &par->reortho); | |||
EigenGetInt("Krylov basis size", &par->size); | EigenGetInt("Krylov basis size", &par->size); | |||
} | } | |||
/* write file */ | /* write file */ | |||
fprintf(fp, "%.16g\n", par->prec); | fprintf(fp, "%.16g\n", par->prec); | |||
fprintf(fp, "%d\n", par->reortho); | fprintf(fp, "%d\n", par->reortho); | |||
fprintf(fp, "%d\n", par->size); | fprintf(fp, "%d\n", par->size); | |||
fprintf(fp, | fprintf( | |||
"/*\n" | fp, "/*\n" | |||
" The numbers above are the parameters for the numerical\n" | " The numbers above are the parameters for the numerical\n" | |||
" eigenvalue problem:\n" | " eigenvalue problem:\n" | |||
"\n" | "\n" | |||
" prec = aimed accuracy for eigenvectors (default=1.e-4)\n" | " prec = aimed accuracy for eigenvectors (default=1.e-4)\n" | |||
" reortho = reorthogonalisation of Krylov basis: yes=1, no=0 (def | " reortho = reorthogonalisation of Krylov basis: yes=1, no=0 " | |||
ault=0) \n" | "(default=0) \n" | |||
" size = size of the Krylov basis\n" | " size = size of the Krylov basis\n" | |||
"\n" | "\n" | |||
" The shift is given in the .pro file because its choice relies\n | " The shift is given in the .pro file because its choice relies\n" | |||
" | " on physical considerations.\n" | |||
" on physical considerations.\n" | "*/"); | |||
"*/"); | ||||
fclose(fp); | fclose(fp); | |||
} | } | |||
else{ | else { | |||
Message::Error("Unable to open file '%s'", path); | Message::Error("Unable to open file '%s'", path); | |||
} | } | |||
} | } | |||
Message::Info("Eigenproblem parameters: prec = %g, reortho = %d, size = %d", | Message::Info("Eigenproblem parameters: prec = %g, reortho = %d, size = %d", | |||
par->prec, par->reortho, par->size); | par->prec, par->reortho, par->size); | |||
} | } | |||
/* This routine uses Arpack to solve Generalized Complex Non-Hermitian | /* This routine uses Arpack to solve Generalized Complex Non-Hermitian | |||
eigenvalue problems. We don't use the "Generalized" Arpack mode | eigenvalue problems. We don't use the "Generalized" Arpack mode | |||
(bmat=='G') since it requires M to be Hermitian. Instead, we use | (bmat=='G') since it requires M to be Hermitian. Instead, we use | |||
the regular mode (bmat='I') and apply the shift "by hand", which | the regular mode (bmat='I') and apply the shift "by hand", which | |||
allows us to use arbitrary matrices K and M. */ | allows us to use arbitrary matrices K and M. */ | |||
static void Arpack2GetDP(int N, complex_16 *in, gVector *out) | static void Arpack2GetDP(int N, complex_16 *in, gVector *out) | |||
{ | { | |||
int i, j; | int i, j; | |||
double re, im; | double re, im; | |||
int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; | int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; | |||
for(i = 0; i < N; i++){ | for(i = 0; i < N; i++) { | |||
re = in[i].re; | re = in[i].re; | |||
im = in[i].im; | im = in[i].im; | |||
j = i * incr; | j = i * incr; | |||
if(Current.NbrHar == 2) | if(Current.NbrHar == 2) | |||
LinAlg_SetComplexInVector(re, im, out, j, j+1); | LinAlg_SetComplexInVector(re, im, out, j, j + 1); | |||
else | else | |||
LinAlg_SetDoubleInVector(re, out, j); | LinAlg_SetDoubleInVector(re, out, j); | |||
} | } | |||
LinAlg_AssembleVector(out); | LinAlg_AssembleVector(out); | |||
} | } | |||
static void Arpack2GetDPSplit(int N, complex_16 *in, gVector *out1, gVector *out | static void Arpack2GetDPSplit(int N, complex_16 *in, gVector *out1, | |||
2) | gVector *out2) | |||
{ | { | |||
int i, j; | int i, j; | |||
double re, im; | double re, im; | |||
int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; | int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; | |||
for(i = 0; i < N/2; i++){ | for(i = 0; i < N / 2; i++) { | |||
j = i * incr; | j = i * incr; | |||
re = in[i].re; | re = in[i].re; | |||
im = in[i].im; | im = in[i].im; | |||
if(Current.NbrHar == 2) | if(Current.NbrHar == 2) | |||
LinAlg_SetComplexInVector(re, im, out1, j, j+1); | LinAlg_SetComplexInVector(re, im, out1, j, j + 1); | |||
else | else | |||
LinAlg_SetDoubleInVector(re, out1, j); | LinAlg_SetDoubleInVector(re, out1, j); | |||
re = in[N/2+i].re; | re = in[N / 2 + i].re; | |||
im = in[N/2+i].im; | im = in[N / 2 + i].im; | |||
if(Current.NbrHar == 2) | if(Current.NbrHar == 2) | |||
LinAlg_SetComplexInVector(re, im, out2, j, j+1); | LinAlg_SetComplexInVector(re, im, out2, j, j + 1); | |||
else | else | |||
LinAlg_SetDoubleInVector(re, out2, j); | LinAlg_SetDoubleInVector(re, out2, j); | |||
} | } | |||
LinAlg_AssembleVector(out1); | LinAlg_AssembleVector(out1); | |||
LinAlg_AssembleVector(out2); | LinAlg_AssembleVector(out2); | |||
} | } | |||
static void GetDP2Arpack(gVector *in, complex_16 *out) | static void GetDP2Arpack(gVector *in, complex_16 *out) | |||
{ | { | |||
int i, N; | int i, N; | |||
double re, im = 0.; | double re, im = 0.; | |||
int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; | int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; | |||
LinAlg_GetVectorSize(in, &N); | LinAlg_GetVectorSize(in, &N); | |||
for(i = 0; i < N; i += incr){ | for(i = 0; i < N; i += incr) { | |||
if(Current.NbrHar == 2) | if(Current.NbrHar == 2) | |||
LinAlg_GetComplexInVector(&re, &im, in, i, i+1); | LinAlg_GetComplexInVector(&re, &im, in, i, i + 1); | |||
else | else | |||
LinAlg_GetDoubleInVector(&re, in, i); | LinAlg_GetDoubleInVector(&re, in, i); | |||
out[i/incr].re = re; | out[i / incr].re = re; | |||
out[i/incr].im = im; | out[i / incr].im = im; | |||
} | } | |||
} | } | |||
static void GetDP2ArpackMerge(gVector *in1, gVector *in2, complex_16 *out) | static void GetDP2ArpackMerge(gVector *in1, gVector *in2, complex_16 *out) | |||
{ | { | |||
int i, N; | int i, N; | |||
double re, im = 0.; | double re, im = 0.; | |||
int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; | int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; | |||
LinAlg_GetVectorSize(in1, &N); | LinAlg_GetVectorSize(in1, &N); | |||
for(i = 0; i < N; i += incr){ | for(i = 0; i < N; i += incr) { | |||
if(Current.NbrHar == 2) | if(Current.NbrHar == 2) | |||
LinAlg_GetComplexInVector(&re, &im, in1, i, i+1); | LinAlg_GetComplexInVector(&re, &im, in1, i, i + 1); | |||
else | else | |||
LinAlg_GetDoubleInVector(&re, in1, i); | LinAlg_GetDoubleInVector(&re, in1, i); | |||
out[i/incr].re = re; | out[i / incr].re = re; | |||
out[i/incr].im = im; | out[i / incr].im = im; | |||
if(Current.NbrHar == 2) | if(Current.NbrHar == 2) | |||
LinAlg_GetComplexInVector(&re, &im, in2, i, i+1); | LinAlg_GetComplexInVector(&re, &im, in2, i, i + 1); | |||
else | else | |||
LinAlg_GetDoubleInVector(&re, in2, i); | LinAlg_GetDoubleInVector(&re, in2, i); | |||
out[N/incr + i/incr].re = re; | out[N / incr + i / incr].re = re; | |||
out[N/incr + i/incr].im = im; | out[N / incr + i / incr].im = im; | |||
} | } | |||
} | } | |||
void EigenSolve_ARPACK(struct DofData * DofData_P, int NumEigenvalues, | void EigenSolve_ARPACK(struct DofData *DofData_P, int NumEigenvalues, | |||
double shift_r, double shift_i, int FilterExpressionIndex | double shift_r, double shift_i, | |||
) | int FilterExpressionIndex) | |||
{ | { | |||
struct EigenPar eigenpar; | struct EigenPar eigenpar; | |||
struct Solution Solution_S; | struct Solution Solution_S; | |||
gVector v1, v2, w1, w2, x, y; | gVector v1, v2, w1, w2, x, y; | |||
int n, j, k, l, newsol, quad_evp = 0; | int n, j, k, l, newsol, quad_evp = 0; | |||
double tmp, d1, d2, abs, arg; | double tmp, d1, d2, abs, arg; | |||
complex_16 f, omega, omega2; | complex_16 f, omega, omega2; | |||
gMatrix *K = &DofData_P->M1; /* matrix associated with terms with no Dt nor Dt | gMatrix *K = | |||
Dt */ | &DofData_P->M1; /* matrix associated with terms with no Dt nor DtDt */ | |||
gMatrix *L = &DofData_P->M2; /* matrix associated with Dt terms */ | gMatrix *L = &DofData_P->M2; /* matrix associated with Dt terms */ | |||
gMatrix *M = &DofData_P->M3; /* matrix associated with DtDt terms */ | gMatrix *M = &DofData_P->M3; /* matrix associated with DtDt terms */ | |||
gMatrix D; /* temp matrix for quadratic eigenvalue problem */ | gMatrix D; /* temp matrix for quadratic eigenvalue problem */ | |||
/* Arpack parameters: see below for explanation */ | /* Arpack parameters: see below for explanation */ | |||
int ido, nev, ncv, ldv, iparam[11], ipntr[14], lworkl, info, ldz; | int ido, nev, ncv, ldv, iparam[11], ipntr[14], lworkl, info, ldz; | |||
char bmat, *which, howmny; | char bmat, *which, howmny; | |||
double tol, *rwork; | double tol, *rwork; | |||
unsigned int rvec, *select; | unsigned int rvec, *select; | |||
complex_16 *resid, *v, *workd, *workl, *d, *z, sigma, *workev; | complex_16 *resid, *v, *workd, *workl, *d, *z, sigma, *workev; | |||
/* Warn if we are not in harmonic regime (we won't be able to compute/store | /* Warn if we are not in harmonic regime (we won't be able to compute/store | |||
complex eigenvectors) */ | complex eigenvectors) */ | |||
if(Current.NbrHar != 2){ | if(Current.NbrHar != 2) { | |||
Message::Info("EigenSolve will only store the real part of the eigenvectors; | Message::Info( | |||
" | "EigenSolve will only store the real part of the eigenvectors; " | |||
"Define the system with \"Type Complex\" if this is an issue") | "Define the system with \"Type Complex\" if this is an issue"); | |||
; | ||||
} | } | |||
#if defined(HAVE_PETSC) && !defined(PETSC_USE_COMPLEX) | #if defined(HAVE_PETSC) && !defined(PETSC_USE_COMPLEX) | |||
if(Current.NbrHar == 2){ | if(Current.NbrHar == 2) { | |||
Message::Warning("Using PETSc in real arithmetic for complex-simulated-real | Message::Warning( | |||
matrices"); | "Using PETSc in real arithmetic for complex-simulated-real matrices"); | |||
} | } | |||
#endif | #endif | |||
/* Sanity checks */ | /* Sanity checks */ | |||
if(DofData_P->Flag_Init[7] || DofData_P->Flag_Init[6] || | if(DofData_P->Flag_Init[7] || DofData_P->Flag_Init[6] || | |||
DofData_P->Flag_Init[5] || DofData_P->Flag_Init[4]){ | DofData_P->Flag_Init[5] || DofData_P->Flag_Init[4]) { | |||
Message::Error("High order polynomial and non-linear EVP only available with | Message::Error( | |||
SLEPc"); | "High order polynomial and non-linear EVP only available with SLEPc"); | |||
return; | return; | |||
} | } | |||
if(!DofData_P->Flag_Init[1] || !DofData_P->Flag_Init[3]){ | if(!DofData_P->Flag_Init[1] || !DofData_P->Flag_Init[3]) { | |||
Message::Error("No System available for EigenSolve: check 'DtDt' and 'Genera | Message::Error("No System available for EigenSolve: check 'DtDt' and " | |||
teSeparate'"); | "'GenerateSeparate'"); | |||
return; | return; | |||
} | } | |||
/* Check if we have a "quadratic" evp (- w^2 M x + i w L x + K x = 0) */ | /* Check if we have a "quadratic" evp (- w^2 M x + i w L x + K x = 0) */ | |||
if(DofData_P->Flag_Init[2]) | if(DofData_P->Flag_Init[2]) quad_evp = 1; | |||
quad_evp = 1; | ||||
/* Get eigenproblem parameters */ | /* Get eigenproblem parameters */ | |||
EigenPar("eigen.par", &eigenpar); | EigenPar("eigen.par", &eigenpar); | |||
/* size of the system */ | /* size of the system */ | |||
int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; | int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; | |||
n = DofData_P->NbrDof / incr; | n = DofData_P->NbrDof / incr; | |||
if(quad_evp) | if(quad_evp) n *= 2; | |||
n *= 2; | ||||
ido = 0; | ido = 0; | |||
/* Reverse communication flag. IDO must be zero on the first | /* Reverse communication flag. IDO must be zero on the first | |||
call to znaupd. IDO will be set internally to | call to znaupd. IDO will be set internally to | |||
indicate the type of operation to be performed. Control is | indicate the type of operation to be performed. Control is | |||
then given back to the calling routine which has the | then given back to the calling routine which has the | |||
responsibility to carry out the requested operation and call | responsibility to carry out the requested operation and call | |||
znaupd with the result. The operand is given in | znaupd with the result. The operand is given in | |||
WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)). | WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)). | |||
------------------------------------------------------------- | ------------------------------------------------------------- | |||
skipping to change at line 317 | skipping to change at line 323 | |||
After the initialization phase, when the routine is used in | After the initialization phase, when the routine is used in | |||
the "shift-and-invert" mode, the vector M * X is already | the "shift-and-invert" mode, the vector M * X is already | |||
available and does not need to be recomputed in forming OP*X. */ | available and does not need to be recomputed in forming OP*X. */ | |||
bmat = 'I'; | bmat = 'I'; | |||
/* BMAT specifies the type of the matrix B that defines the | /* BMAT specifies the type of the matrix B that defines the | |||
semi-inner product for the operator OP. | semi-inner product for the operator OP. | |||
BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x | BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x | |||
BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*M*x */ | BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*M*x */ | |||
which = (char*)"LM"; | which = (char *)"LM"; | |||
/* Which eigenvalues we want: | /* Which eigenvalues we want: | |||
SM = smallest magnitude ( magnitude = absolute value ) | SM = smallest magnitude ( magnitude = absolute value ) | |||
LM = largest magnitude | LM = largest magnitude | |||
SR = smallest real part | SR = smallest real part | |||
LR = largest real part | LR = largest real part | |||
SI = smallest imaginary part | SI = smallest imaginary part | |||
LI = largest imaginary part */ | LI = largest imaginary part */ | |||
nev = NumEigenvalues; | nev = NumEigenvalues; | |||
/* Number of eigenvalues of OP to be computed. 0 < NEV < N-1. | /* Number of eigenvalues of OP to be computed. 0 < NEV < N-1. | |||
Therefore, you'll be able to compute AT MOST n-2 eigenvalues! */ | Therefore, you'll be able to compute AT MOST n-2 eigenvalues! */ | |||
/* sanity check */ | /* sanity check */ | |||
if(nev >= n-1){ | if(nev >= n - 1) { | |||
Message::Warning("NumEigenvalues too large (%d < %d): setting to %d", nev, n | Message::Warning("NumEigenvalues too large (%d < %d): setting to %d", nev, | |||
-1, n-2); | n - 1, n - 2); | |||
nev = n-2; | nev = n - 2; | |||
} | } | |||
tol = eigenpar.prec; /* 1.e-4; */ | tol = eigenpar.prec; /* 1.e-4; */ | |||
/* Stopping criteria: the relative accuracy of the Ritz value | /* Stopping criteria: the relative accuracy of the Ritz value | |||
is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)) | is considered acceptable if BOUNDS(I) .LE. TOL*ABS(RITZ(I)) | |||
where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex. | where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex. | |||
DEFAULT = dlamch('EPS') (machine precision as computed | DEFAULT = dlamch('EPS') (machine precision as computed | |||
by the LAPACK auxiliary subroutine dlamch). */ | by the LAPACK auxiliary subroutine dlamch). */ | |||
resid = (complex_16*)Malloc(n * sizeof(complex_16)); | resid = (complex_16 *)Malloc(n * sizeof(complex_16)); | |||
/* On INPUT: | /* On INPUT: | |||
If INFO .EQ. 0, a random initial residual vector is used. | If INFO .EQ. 0, a random initial residual vector is used. | |||
If INFO .NE. 0, RESID contains the initial residual vector, | If INFO .NE. 0, RESID contains the initial residual vector, | |||
possibly from a previous run. | possibly from a previous run. | |||
On OUTPUT: | On OUTPUT: | |||
RESID contains the final residual vector. */ | RESID contains the final residual vector. */ | |||
ncv = eigenpar.size; /* Rule of thumb: NumEigenvalues * 2; */ | ncv = eigenpar.size; /* Rule of thumb: NumEigenvalues * 2; */ | |||
/* Number of columns of the matrix V. NCV must satisfy the two | /* Number of columns of the matrix V. NCV must satisfy the two | |||
inequalities 1 <= NCV-NEV and NCV <= N. | inequalities 1 <= NCV-NEV and NCV <= N. | |||
This will indicate how many Arnoldi vectors are generated | This will indicate how many Arnoldi vectors are generated | |||
at each iteration. After the startup phase in which NEV | at each iteration. After the startup phase in which NEV | |||
Arnoldi vectors are generated, the algorithm generates | Arnoldi vectors are generated, the algorithm generates | |||
approximately NCV-NEV Arnoldi vectors at each subsequent update | approximately NCV-NEV Arnoldi vectors at each subsequent update | |||
iteration. Most of the cost in generating each Arnoldi vector is | iteration. Most of the cost in generating each Arnoldi vector is | |||
in the matrix-vector operation OP*x. */ | in the matrix-vector operation OP*x. */ | |||
/* sanity checks */ | /* sanity checks */ | |||
if(ncv <= nev){ | if(ncv <= nev) { | |||
Message::Warning("Krylov space size too small (%d <= %d), setting to %d", nc | Message::Warning("Krylov space size too small (%d <= %d), setting to %d", | |||
v, nev, nev*2); | ncv, nev, nev * 2); | |||
ncv = nev * 2; | ncv = nev * 2; | |||
} | } | |||
if(ncv > n){ | if(ncv > n) { | |||
Message::Warning("Krylov space size too large (%d > %d), setting to %d", ncv | Message::Warning("Krylov space size too large (%d > %d), setting to %d", | |||
, n, n); | ncv, n, n); | |||
ncv = n; | ncv = n; | |||
} | } | |||
v = (complex_16*)Malloc(n * ncv * sizeof(complex_16)); | v = (complex_16 *)Malloc(n * ncv * sizeof(complex_16)); | |||
/* At the end of calculations, here will be stored the Arnoldi basis | /* At the end of calculations, here will be stored the Arnoldi basis | |||
vectors */ | vectors */ | |||
ldv = n; | ldv = n; | |||
/* Leading dimension of "v". In our case, the number of lines of | /* Leading dimension of "v". In our case, the number of lines of | |||
"v". */ | "v". */ | |||
iparam[0] = 1; | iparam[0] = 1; | |||
iparam[1] = 0; | iparam[1] = 0; | |||
iparam[2] = 10000; | iparam[2] = 10000; | |||
skipping to change at line 467 | skipping to change at line 476 | |||
IPNTR(9): pointer to the NCV RITZ values of the | IPNTR(9): pointer to the NCV RITZ values of the | |||
original system. | original system. | |||
IPNTR(10): Not Used | IPNTR(10): Not Used | |||
IPNTR(11): pointer to the NCV corresponding error bounds. | IPNTR(11): pointer to the NCV corresponding error bounds. | |||
IPNTR(12): pointer to the NCV by NCV upper triangular | IPNTR(12): pointer to the NCV by NCV upper triangular | |||
Schur matrix for H. | Schur matrix for H. | |||
IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors | IPNTR(13): pointer to the NCV by NCV matrix of eigenvectors | |||
of the upper Hessenberg matrix H. Only referenced by | of the upper Hessenberg matrix H. Only referenced by | |||
zneupd if RVEC = .TRUE. See Remark 2 below. */ | zneupd if RVEC = .TRUE. See Remark 2 below. */ | |||
workd = (complex_16*)Malloc(3 * n * sizeof(complex_16)); | workd = (complex_16 *)Malloc(3 * n * sizeof(complex_16)); | |||
/* Distributed array to be used in the basic Arnoldi iteration | /* Distributed array to be used in the basic Arnoldi iteration | |||
for reverse communication. The user should not use WORKD | for reverse communication. The user should not use WORKD | |||
as temporary workspace during the iteration !!!!!!!!!! | as temporary workspace during the iteration !!!!!!!!!! | |||
See Data Distribution Note below. */ | See Data Distribution Note below. */ | |||
lworkl = 3*ncv*ncv + 5*ncv; | lworkl = 3 * ncv * ncv + 5 * ncv; | |||
/* Dimension of the "workl" vector (see below). On must have: | /* Dimension of the "workl" vector (see below). On must have: | |||
lworkl >= 3*ncv*ncv + 5*ncv */ | lworkl >= 3*ncv*ncv + 5*ncv */ | |||
workl = (complex_16*)Malloc(lworkl * sizeof(complex_16)); | workl = (complex_16 *)Malloc(lworkl * sizeof(complex_16)); | |||
/* Private (replicated) array on each PE or array allocated on | /* Private (replicated) array on each PE or array allocated on | |||
the front end. See Data Distribution Note below. */ | the front end. See Data Distribution Note below. */ | |||
rwork = (double*)Malloc(ncv * sizeof(double)); | rwork = (double *)Malloc(ncv * sizeof(double)); | |||
/* Used as workspace */ | /* Used as workspace */ | |||
info = 0; | info = 0; | |||
/* If INFO .EQ. 0, a randomly initial residual vector is used. | /* If INFO .EQ. 0, a randomly initial residual vector is used. | |||
If INFO .NE. 0, RESID contains the initial residual vector, | If INFO .NE. 0, RESID contains the initial residual vector, | |||
possibly from a previous run. | possibly from a previous run. | |||
Error flag on output. | Error flag on output. | |||
= 0: Normal exit. | = 0: Normal exit. | |||
= 1: Maximum number of iterations taken. | = 1: Maximum number of iterations taken. | |||
All possible eigenvalues of OP has been found. IPARAM(5) | All possible eigenvalues of OP has been found. IPARAM(5) | |||
skipping to change at line 525 | skipping to change at line 534 | |||
IPARAM(5) returns the size of the current Arnoldi | IPARAM(5) returns the size of the current Arnoldi | |||
factorization. */ | factorization. */ | |||
rvec = 1; /* .true. */ | rvec = 1; /* .true. */ | |||
/* If we want Ritz vectors to be computed as well. */ | /* If we want Ritz vectors to be computed as well. */ | |||
howmny = 'A'; | howmny = 'A'; | |||
/* What do we want: Ritz or Schur vectors? For Schur, choose: howmny | /* What do we want: Ritz or Schur vectors? For Schur, choose: howmny | |||
= 'P' */ | = 'P' */ | |||
select = (unsigned int*)Malloc(ncv * sizeof(unsigned int)); | select = (unsigned int *)Malloc(ncv * sizeof(unsigned int)); | |||
/* Internal workspace */ | /* Internal workspace */ | |||
d = (complex_16*)Malloc(nev * sizeof(complex_16)); | d = (complex_16 *)Malloc(nev * sizeof(complex_16)); | |||
/* Vector containing the "nev" eigenvalues computed. | /* Vector containing the "nev" eigenvalues computed. | |||
VERY IMPORTANT: on line 69 of zneupd.f they say it should be nev+1; | VERY IMPORTANT: on line 69 of zneupd.f they say it should be nev+1; | |||
this is wrong, for see line 283 where it is declared as d(nev) */ | this is wrong, for see line 283 where it is declared as d(nev) */ | |||
z = (complex_16*)Malloc(n * nev * sizeof(complex_16)); | z = (complex_16 *)Malloc(n * nev * sizeof(complex_16)); | |||
/* On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of | /* On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of | |||
Z represents approximate eigenvectors (Ritz vectors) corresponding | Z represents approximate eigenvectors (Ritz vectors) corresponding | |||
to the NCONV=IPARAM(5) Ritz values for eigensystem | to the NCONV=IPARAM(5) Ritz values for eigensystem | |||
A*z = lambda*B*z. | A*z = lambda*B*z. | |||
If RVEC = .FALSE. or HOWMNY = 'P', then Z is NOT REFERENCED. | If RVEC = .FALSE. or HOWMNY = 'P', then Z is NOT REFERENCED. | |||
NOTE: If if RVEC = .TRUE. and a Schur basis is not required, | NOTE: If if RVEC = .TRUE. and a Schur basis is not required, | |||
the array Z may be set equal to first NEV+1 columns of the Arnoldi | the array Z may be set equal to first NEV+1 columns of the Arnoldi | |||
basis array V computed by ZNAUPD. In this case the Arnoldi basis | basis array V computed by ZNAUPD. In this case the Arnoldi basis | |||
will be destroyed and overwritten with the eigenvector basis. */ | will be destroyed and overwritten with the eigenvector basis. */ | |||
ldz = n; | ldz = n; | |||
/* Leading dimension of "z". In our case, the number of lines of "z". */ | /* Leading dimension of "z". In our case, the number of lines of "z". */ | |||
sigma.re = 0.; | sigma.re = 0.; | |||
sigma.im = 0.; | sigma.im = 0.; | |||
/* The shift. Not used in this case: we deal with the shift "by | /* The shift. Not used in this case: we deal with the shift "by | |||
hand". */ | hand". */ | |||
workev = (complex_16*)Malloc(2 * ncv * sizeof(complex_16)); | workev = (complex_16 *)Malloc(2 * ncv * sizeof(complex_16)); | |||
/* Workspace */ | /* Workspace */ | |||
if(bmat != 'I' || iparam[6] != 1){ | if(bmat != 'I' || iparam[6] != 1) { | |||
Message::Error("General and/or shift-invert mode should not be used"); | Message::Error("General and/or shift-invert mode should not be used"); | |||
return; | return; | |||
} | } | |||
/* Create temp vectors and matrices and apply shift. Warning: with | /* Create temp vectors and matrices and apply shift. Warning: with | |||
PETSc, the shifting can be very slow if the masks are very | PETSc, the shifting can be very slow if the masks are very | |||
different, for example if we are in real arithmetic and have one | different, for example if we are in real arithmetic and have one | |||
real matrix and one complex "simulated-real" matrix */ | real matrix and one complex "simulated-real" matrix */ | |||
if(!quad_evp){ | if(!quad_evp) { | |||
LinAlg_CreateVector(&v1, &DofData_P->Solver, DofData_P->NbrDof); | LinAlg_CreateVector(&v1, &DofData_P->Solver, DofData_P->NbrDof); | |||
LinAlg_CreateVector(&v2, &DofData_P->Solver, DofData_P->NbrDof); | LinAlg_CreateVector(&v2, &DofData_P->Solver, DofData_P->NbrDof); | |||
/* K = K - shift * M */ | /* K = K - shift * M */ | |||
LinAlg_AddMatrixProdMatrixDouble(K, M, -shift_r, K) ; | LinAlg_AddMatrixProdMatrixDouble(K, M, -shift_r, K); | |||
} | } | |||
else{ | else { | |||
/* This is an explanation of our approach to a quadratic | /* This is an explanation of our approach to a quadratic | |||
eigenvalue problem i.e. - w^2 M x + i w L x + K x = 0. This | eigenvalue problem i.e. - w^2 M x + i w L x + K x = 0. This | |||
system is equivalent to (y = i w x) and (i w M y + i w L x + K | system is equivalent to (y = i w x) and (i w M y + i w L x + K | |||
x = 0), or, in matrix form: | x = 0), or, in matrix form: | |||
| L M | |x| |-K 0 | |x| | | L M | |x| |-K 0 | |x| | |||
| I 0 | |y| iw = | 0 I | |y| , or | | I 0 | |y| iw = | 0 I | |y| , or | |||
|x| |x| | |x| |x| | |||
A |y| iw = B |y|. | A |y| iw = B |y|. | |||
skipping to change at line 602 | skipping to change at line 611 | |||
matrices but the Arpack vector is of size n=2*N. Only the x | matrices but the Arpack vector is of size n=2*N. Only the x | |||
part of the (x,y) eigenvectors are retained as physical | part of the (x,y) eigenvectors are retained as physical | |||
solutions. */ | solutions. */ | |||
LinAlg_CreateVector(&x, &DofData_P->Solver, DofData_P->NbrDof); | LinAlg_CreateVector(&x, &DofData_P->Solver, DofData_P->NbrDof); | |||
LinAlg_CreateVector(&y, &DofData_P->Solver, DofData_P->NbrDof); | LinAlg_CreateVector(&y, &DofData_P->Solver, DofData_P->NbrDof); | |||
LinAlg_CreateVector(&v1, &DofData_P->Solver, DofData_P->NbrDof); | LinAlg_CreateVector(&v1, &DofData_P->Solver, DofData_P->NbrDof); | |||
LinAlg_CreateVector(&w1, &DofData_P->Solver, DofData_P->NbrDof); | LinAlg_CreateVector(&w1, &DofData_P->Solver, DofData_P->NbrDof); | |||
LinAlg_CreateVector(&w2, &DofData_P->Solver, DofData_P->NbrDof); | LinAlg_CreateVector(&w2, &DofData_P->Solver, DofData_P->NbrDof); | |||
LinAlg_CreateMatrix(&D, &DofData_P->Solver, DofData_P->NbrDof, DofData_P->Nb | LinAlg_CreateMatrix(&D, &DofData_P->Solver, DofData_P->NbrDof, | |||
rDof); | DofData_P->NbrDof); | |||
/* D = -(shift^2 * M + shift * L + K) */ | /* D = -(shift^2 * M + shift * L + K) */ | |||
LinAlg_CopyMatrix(M, &D); | LinAlg_CopyMatrix(M, &D); | |||
LinAlg_AddMatrixProdMatrixDouble(L, &D, shift_r, &D); | LinAlg_AddMatrixProdMatrixDouble(L, &D, shift_r, &D); | |||
LinAlg_AddMatrixProdMatrixDouble(K, &D, shift_r, &D); | LinAlg_AddMatrixProdMatrixDouble(K, &D, shift_r, &D); | |||
LinAlg_ProdMatrixDouble(&D, -1., &D); | LinAlg_ProdMatrixDouble(&D, -1., &D); | |||
} | } | |||
/* Keep calling znaupd again and again until ido == 99 */ | /* Keep calling znaupd again and again until ido == 99 */ | |||
k = 0; | k = 0; | |||
do { | do { | |||
znaupd_(&ido, &bmat, &n, which, &nev, &tol, resid, &ncv, v, &ldv, iparam, | znaupd_(&ido, &bmat, &n, which, &nev, &tol, resid, &ncv, v, &ldv, iparam, | |||
ipntr, workd, workl, &lworkl, rwork, &info); | ipntr, workd, workl, &lworkl, rwork, &info); | |||
if(ido == 1 || ido == -1){ | if(ido == 1 || ido == -1) { | |||
Message::Info("Arpack iteration %d", k+1); | Message::Info("Arpack iteration %d", k + 1); | |||
if(!quad_evp){ | if(!quad_evp) { | |||
Arpack2GetDP(n, &workd[ipntr[0]-1], &v1); | Arpack2GetDP(n, &workd[ipntr[0] - 1], &v1); | |||
LinAlg_ProdMatrixVector(M, &v1, &v2); | LinAlg_ProdMatrixVector(M, &v1, &v2); | |||
if(!k) | if(!k) | |||
LinAlg_Solve(K, &v2, &DofData_P->Solver, &v1); | LinAlg_Solve(K, &v2, &DofData_P->Solver, &v1); | |||
else | else | |||
LinAlg_SolveAgain(K, &v2, &DofData_P->Solver, &v1); | LinAlg_SolveAgain(K, &v2, &DofData_P->Solver, &v1); | |||
GetDP2Arpack(&v1, &workd[ipntr[1]-1]); | GetDP2Arpack(&v1, &workd[ipntr[1] - 1]); | |||
} | } | |||
else{ | else { | |||
Arpack2GetDPSplit(n, &workd[ipntr[0]-1], &x, &y); | Arpack2GetDPSplit(n, &workd[ipntr[0] - 1], &x, &y); | |||
LinAlg_ProdMatrixVector(M, &y, &w2); | LinAlg_ProdMatrixVector(M, &y, &w2); | |||
LinAlg_ProdMatrixVector(L, &x, &v1); | LinAlg_ProdMatrixVector(L, &x, &v1); | |||
LinAlg_AddVectorVector(&v1, &w2, &v1); | LinAlg_AddVectorVector(&v1, &w2, &v1); | |||
LinAlg_ProdMatrixVector(M, &x, &w1); | LinAlg_ProdMatrixVector(M, &x, &w1); | |||
LinAlg_AddVectorProdVectorDouble(&v1, &w1, shift_r, &v1); | LinAlg_AddVectorProdVectorDouble(&v1, &w1, shift_r, &v1); | |||
if(!k) | if(!k) | |||
LinAlg_Solve(&D, &v1, &DofData_P->Solver, &w1); | LinAlg_Solve(&D, &v1, &DofData_P->Solver, &w1); | |||
else | else | |||
LinAlg_SolveAgain(&D, &v1, &DofData_P->Solver, &w1); | LinAlg_SolveAgain(&D, &v1, &DofData_P->Solver, &w1); | |||
LinAlg_ProdMatrixVector(K, &x, &v1); | LinAlg_ProdMatrixVector(K, &x, &v1); | |||
LinAlg_ProdVectorDouble(&v1, -1., &v1); | LinAlg_ProdVectorDouble(&v1, -1., &v1); | |||
LinAlg_AddVectorProdVectorDouble(&v1, &w2, shift_r, &v1); | LinAlg_AddVectorProdVectorDouble(&v1, &w2, shift_r, &v1); | |||
LinAlg_SolveAgain(&D, &v1, &DofData_P->Solver, &w2); | LinAlg_SolveAgain(&D, &v1, &DofData_P->Solver, &w2); | |||
GetDP2ArpackMerge(&w1, &w2, &workd[ipntr[1]-1]); | GetDP2ArpackMerge(&w1, &w2, &workd[ipntr[1] - 1]); | |||
} | } | |||
k++; | k++; | |||
} | } | |||
else if(ido == 99){ | else if(ido == 99) { | |||
/* We're done! */ | /* We're done! */ | |||
break; | break; | |||
} | } | |||
else{ | else { | |||
Message::Info("Arpack code = %d (ignored)", info); | Message::Info("Arpack code = %d (ignored)", info); | |||
} | } | |||
} while (1); | } while(1); | |||
Message::Info("Arpack required %d iterations", k); | Message::Info("Arpack required %d iterations", k); | |||
/* Testing for errors */ | /* Testing for errors */ | |||
if(info == 0){ | if(info == 0) { /* OK */ | |||
/* OK */ | ||||
} | } | |||
else if(info == 1){ | else if(info == 1) { | |||
Message::Warning("Maxmimum number of iteration reached in EigenSolve"); | Message::Warning("Maxmimum number of iteration reached in EigenSolve"); | |||
} | } | |||
else if(info == 2){ | else if(info == 2) { | |||
Message::Warning("No shifts could be applied during a cycle of the"); | Message::Warning("No shifts could be applied during a cycle of the"); | |||
Message::Warning("Implicitly restarted Arnoldi iteration. One possibility"); | Message::Warning("Implicitly restarted Arnoldi iteration. One possibility"); | |||
Message::Warning("is to increase the size of NCV relative to NEV."); | Message::Warning("is to increase the size of NCV relative to NEV."); | |||
} | } | |||
else if(info < 0){ | else if(info < 0) { | |||
Message::Error("Arpack code = %d", info); | Message::Error("Arpack code = %d", info); | |||
} | } | |||
else{ | else { | |||
Message::Warning("Arpack code = %d (unknown)", info); | Message::Warning("Arpack code = %d (unknown)", info); | |||
} | } | |||
/* Call to zneupd for post-processing */ | /* Call to zneupd for post-processing */ | |||
zneupd_(&rvec, &howmny, select, d, z, &ldz, &sigma, workev, &bmat, &n, which, | zneupd_(&rvec, &howmny, select, d, z, &ldz, &sigma, workev, &bmat, &n, which, | |||
&nev, &tol, resid, &ncv, v, &ldv, iparam, ipntr, workd, workl, &lworkl, | &nev, &tol, resid, &ncv, v, &ldv, iparam, ipntr, workd, workl, | |||
rwork, &info); | &lworkl, rwork, &info); | |||
/* Test for errors */ | /* Test for errors */ | |||
if(info != 0) | if(info != 0) | |||
Message::Error("Arpack code = %d (eigenvector post-processing)", info); | Message::Error("Arpack code = %d (eigenvector post-processing)", info); | |||
/* Compute the unshifted eigenvalues and print them, and store the | /* Compute the unshifted eigenvalues and print them, and store the | |||
associated eigenvectors */ | associated eigenvectors */ | |||
newsol = 0; | newsol = 0; | |||
for (k = 0; k < nev; k++){ | for(k = 0; k < nev; k++) { | |||
/* Unshift the eigenvalues */ | /* Unshift the eigenvalues */ | |||
tmp = SQU(d[k].re) + SQU(d[k].im); | tmp = SQU(d[k].re) + SQU(d[k].im); | |||
d[k].re = shift_r + d[k].re/tmp; | d[k].re = shift_r + d[k].re / tmp; | |||
d[k].im = shift_i - d[k].im/tmp; | d[k].im = shift_i - d[k].im / tmp; | |||
if(!quad_evp){ | if(!quad_evp) { | |||
/* Eigenvalue = omega^2 */ | /* Eigenvalue = omega^2 */ | |||
omega2.re = d[k].re; | omega2.re = d[k].re; | |||
omega2.im = d[k].im; | omega2.im = d[k].im; | |||
abs = sqrt(SQU(omega2.re) + SQU(omega2.im)); | abs = sqrt(SQU(omega2.re) + SQU(omega2.im)); | |||
arg = atan2(omega2.im, omega2.re); | arg = atan2(omega2.im, omega2.re); | |||
omega.re = sqrt(abs) * cos(0.5*arg); | omega.re = sqrt(abs) * cos(0.5 * arg); | |||
omega.im = sqrt(abs) * sin(0.5*arg); | omega.im = sqrt(abs) * sin(0.5 * arg); | |||
f.re = omega.re / TWO_PI; | f.re = omega.re / TWO_PI; | |||
f.im = omega.im / TWO_PI; | f.im = omega.im / TWO_PI; | |||
} | } | |||
else{ | else { | |||
/* Eigenvalue = i*omega */ | /* Eigenvalue = i*omega */ | |||
omega.re = d[k].im; | omega.re = d[k].im; | |||
omega.im = -d[k].re; | omega.im = -d[k].re; | |||
omega2.re = SQU(omega.re) - SQU(omega.im); | omega2.re = SQU(omega.re) - SQU(omega.im); | |||
omega2.im = 2. * omega.re * omega.im; | omega2.im = 2. * omega.re * omega.im; | |||
f.re = omega.re / TWO_PI; | f.re = omega.re / TWO_PI; | |||
f.im = omega.im / TWO_PI; | f.im = omega.im / TWO_PI; | |||
} | } | |||
Message::Info("Eigenvalue %03d: w^2 = %.12e %s %.12e * i", | Message::Info("Eigenvalue %03d: w^2 = %.12e %s %.12e * i", k + 1, omega2.re, | |||
k+1, omega2.re, (omega2.im > 0) ? "+" : "-", | (omega2.im > 0) ? "+" : "-", | |||
(omega2.im > 0) ? omega2.im : -omega2.im); | (omega2.im > 0) ? omega2.im : -omega2.im); | |||
Message::Info(" w = %.12e %s %.12e * i", | Message::Info(" w = %.12e %s %.12e * i", omega.re, | |||
omega.re, (omega.im > 0) ? "+" : "-", | (omega.im > 0) ? "+" : "-", | |||
(omega.im > 0) ? omega.im : -omega.im); | (omega.im > 0) ? omega.im : -omega.im); | |||
Message::Info(" f = %.12e %s %.12e * i", | Message::Info(" f = %.12e %s %.12e * i", f.re, | |||
f.re, (f.im > 0) ? "+" : "-", (f.im > 0) ? f.im : -f.im); | (f.im > 0) ? "+" : "-", (f.im > 0) ? f.im : -f.im); | |||
/* Update the current value of Time and TimeImag so that | /* Update the current value of Time and TimeImag so that | |||
$EigenvalueReal and $EigenvalueImag are up-to-date */ | $EigenvalueReal and $EigenvalueImag are up-to-date */ | |||
Current.Time = omega.re; | Current.Time = omega.re; | |||
Current.TimeImag = omega.im; | Current.TimeImag = omega.im; | |||
// test filter expression and continue without storing if false | // test filter expression and continue without storing if false | |||
if(FilterExpressionIndex >= 0){ | if(FilterExpressionIndex >= 0) { | |||
struct Value val; | struct Value val; | |||
Get_ValueOfExpressionByIndex(FilterExpressionIndex, NULL, 0., 0., 0., &val | Get_ValueOfExpressionByIndex(FilterExpressionIndex, NULL, 0., 0., 0., | |||
); | &val); | |||
if(!val.Val[0]){ | if(!val.Val[0]) { | |||
Message::Debug("Skipping eigenvalue %g + i * %g", omega.re, omega.im); | Message::Debug("Skipping eigenvalue %g + i * %g", omega.re, omega.im); | |||
continue; | continue; | |||
} | } | |||
} | } | |||
Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + "/Re(Omega)" | Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + | |||
, | "/Re(Omega)", | |||
std::vector<double>(1, omega.re)); | std::vector<double>(1, omega.re)); | |||
Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + "/Im(Omega)" | Message::AddOnelabNumberChoice(Message::GetOnelabClientName() + | |||
, | "/Im(Omega)", | |||
std::vector<double>(1, omega.im)); | std::vector<double>(1, omega.im)); | |||
if(newsol) { | if(newsol) { | |||
/* Create new solution */ | /* Create new solution */ | |||
Solution_S.TimeFunctionValues = NULL; | Solution_S.TimeFunctionValues = NULL; | |||
LinAlg_CreateVector(&Solution_S.x, &DofData_P->Solver, DofData_P->NbrDof); | LinAlg_CreateVector(&Solution_S.x, &DofData_P->Solver, DofData_P->NbrDof); | |||
List_Add(DofData_P->Solutions, &Solution_S); | List_Add(DofData_P->Solutions, &Solution_S); | |||
DofData_P->CurrentSolution = (struct Solution*) | DofData_P->CurrentSolution = (struct Solution *)List_Pointer( | |||
List_Pointer(DofData_P->Solutions, List_Nbr(DofData_P->Solutions)-1); | DofData_P->Solutions, List_Nbr(DofData_P->Solutions) - 1); | |||
} | } | |||
newsol = 1; | newsol = 1; | |||
DofData_P->CurrentSolution->Time = omega.re; | DofData_P->CurrentSolution->Time = omega.re; | |||
DofData_P->CurrentSolution->TimeImag = omega.im; | DofData_P->CurrentSolution->TimeImag = omega.im; | |||
DofData_P->CurrentSolution->TimeStep = (int)Current.TimeStep; | DofData_P->CurrentSolution->TimeStep = (int)Current.TimeStep; | |||
Free(DofData_P->CurrentSolution->TimeFunctionValues); | Free(DofData_P->CurrentSolution->TimeFunctionValues); | |||
DofData_P->CurrentSolution->TimeFunctionValues = NULL; | DofData_P->CurrentSolution->TimeFunctionValues = NULL; | |||
DofData_P->CurrentSolution->SolutionExist = 1; | DofData_P->CurrentSolution->SolutionExist = 1; | |||
int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; | int incr = (Current.NbrHar == 2) ? gCOMPLEX_INCREMENT : 1; | |||
for(l = 0; l < DofData_P->NbrDof; l += incr){ | for(l = 0; l < DofData_P->NbrDof; l += incr) { | |||
j = l / incr; | j = l / incr; | |||
if(Current.NbrHar == 2){ | if(Current.NbrHar == 2) { | |||
LinAlg_SetComplexInVector(z[k*n+j].re, z[k*n+j].im, | LinAlg_SetComplexInVector(z[k * n + j].re, z[k * n + j].im, | |||
&DofData_P->CurrentSolution->x, l, l+1); | &DofData_P->CurrentSolution->x, l, l + 1); | |||
} | } | |||
else{ | else { | |||
LinAlg_SetDoubleInVector(z[k*n+j].re, | LinAlg_SetDoubleInVector(z[k * n + j].re, | |||
&DofData_P->CurrentSolution->x, l); | &DofData_P->CurrentSolution->x, l); | |||
} | } | |||
} | } | |||
LinAlg_AssembleVector(&DofData_P->CurrentSolution->x); | LinAlg_AssembleVector(&DofData_P->CurrentSolution->x); | |||
/* Arpack returns eigenvectors normalized in L-2 norm. Renormalize | /* Arpack returns eigenvectors normalized in L-2 norm. Renormalize | |||
them in L-infty norm so that the absolute value of the largest | them in L-infty norm so that the absolute value of the largest | |||
element is 1 */ | element is 1 */ | |||
tmp = 0.; | tmp = 0.; | |||
for(l = 0; l < DofData_P->NbrDof; l += incr){ | for(l = 0; l < DofData_P->NbrDof; l += incr) { | |||
if(Current.NbrHar == 2){ | if(Current.NbrHar == 2) { | |||
LinAlg_GetComplexInVector(&d1, &d2, | LinAlg_GetComplexInVector(&d1, &d2, &DofData_P->CurrentSolution->x, l, | |||
&DofData_P->CurrentSolution->x, l, l+1); | l + 1); | |||
abs = sqrt(SQU(d1) + SQU(d2)); | abs = sqrt(SQU(d1) + SQU(d2)); | |||
} | } | |||
else{ | else { | |||
LinAlg_GetDoubleInVector(&d1, | LinAlg_GetDoubleInVector(&d1, &DofData_P->CurrentSolution->x, l); | |||
&DofData_P->CurrentSolution->x, l); | ||||
abs = sqrt(SQU(d1)); | abs = sqrt(SQU(d1)); | |||
} | } | |||
if(abs > tmp) tmp = abs; | if(abs > tmp) tmp = abs; | |||
} | } | |||
if(tmp > 1.e-16) | if(tmp > 1.e-16) | |||
LinAlg_ProdVectorDouble(&DofData_P->CurrentSolution->x, 1./tmp, | LinAlg_ProdVectorDouble(&DofData_P->CurrentSolution->x, 1. / tmp, | |||
&DofData_P->CurrentSolution->x); | &DofData_P->CurrentSolution->x); | |||
/* Increment the global timestep counter so that a future | /* Increment the global timestep counter so that a future | |||
GenerateSystem knows which solutions exist */ | GenerateSystem knows which solutions exist */ | |||
Current.TimeStep += 1.; | Current.TimeStep += 1.; | |||
} | } | |||
/* Deallocate */ | /* Deallocate */ | |||
if(!quad_evp){ | if(!quad_evp) { | |||
LinAlg_DestroyVector(&v1); | LinAlg_DestroyVector(&v1); | |||
LinAlg_DestroyVector(&v2); | LinAlg_DestroyVector(&v2); | |||
} | } | |||
else{ | else { | |||
LinAlg_DestroyVector(&x); | LinAlg_DestroyVector(&x); | |||
LinAlg_DestroyVector(&y); | LinAlg_DestroyVector(&y); | |||
LinAlg_DestroyVector(&v1); | LinAlg_DestroyVector(&v1); | |||
LinAlg_DestroyVector(&w1); | LinAlg_DestroyVector(&w1); | |||
LinAlg_DestroyVector(&w2); | LinAlg_DestroyVector(&w2); | |||
LinAlg_DestroyMatrix(&D); | LinAlg_DestroyMatrix(&D); | |||
} | } | |||
Free(resid); | Free(resid); | |||
Free(v); | Free(v); | |||
End of changes. 86 change blocks. | ||||
197 lines changed or deleted | 189 lines changed or added |