static void
utest_Diagonalization(void)
{
ESL_DMATRIX *P = NULL;
ESL_DMATRIX *P2 = NULL;
ESL_DMATRIX *C = NULL;
ESL_DMATRIX *D = NULL;
double *lambda = NULL; /* eigenvalues */
ESL_DMATRIX *U = NULL; /* left eigenvectors */
ESL_DMATRIX *Ui = NULL; /* inverse of U */
int i,j;
/* Create a J/C probability matrix for t=1:
* 1/4 + 3/4 e^{-4/3 at}
* 1/4 - 1/4 e^{-4/3 at}
*/
if ((P = esl_dmatrix_Create(4, 4)) == NULL) esl_fatal("malloc failed");
if ((C = esl_dmatrix_Create(4, 4)) == NULL) esl_fatal("malloc failed");
if ((Ui = esl_dmatrix_Create(4, 4)) == NULL) esl_fatal("malloc failed");
if ((D = esl_dmatrix_Create(4, 4)) == NULL) esl_fatal("malloc failed");
if ((P2 = esl_dmatrix_Create(4, 4)) == NULL) esl_fatal("malloc failed");
for (i = 0; i < 4; i++)
for (j = 0; j < 4; j++)
if (i == j) P->mx[i][j] = 0.25 + 0.75 * exp(-4./3.);
else P->mx[i][j] = 0.25 - 0.25 * exp(-4./3.);
/* Diagonalize it
*/
if (esl_dmx_Diagonalize(P, &lambda, NULL, &U, NULL) != eslOK) esl_fatal("diagonalization failed");
/* Calculate P^k by U [diag(lambda_i)]^k U^{-1}
*/
esl_dmatrix_SetZero(D);
for (i = 0; i < P->n; i++) D->mx[i][i] = lambda[i];
esl_dmx_Invert(U, Ui);
esl_dmx_Multiply(U, D, C);
esl_dmx_Multiply(C, Ui, P2);
if (esl_dmatrix_Compare(P, P2, 1e-7) != eslOK) esl_fatal("diagonalization unit test failed");
free(lambda);
esl_dmatrix_Destroy(P2);
esl_dmatrix_Destroy(Ui);
esl_dmatrix_Destroy(U);
esl_dmatrix_Destroy(D);
esl_dmatrix_Destroy(C);
esl_dmatrix_Destroy(P);
return;
}
/* Function: esl_dst_XPairIdMx()
* Synopsis: NxN identity matrix for N aligned digital seqs.
* Incept: SRE, Thu Apr 27 09:08:11 2006 [New York]
*
* Purpose: Given a digitized multiple sequence alignment <ax>, consisting
* of <N> aligned digital sequences in alphabet <abc>; calculate
* a symmetric pairwise fractional identity matrix by $N(N-1)/2$
* calls to <esl_dst_XPairId()>, and return it in <ret_S>.
*
* Args: abc - digital alphabet in use
* ax - aligned dsq's, [0..N-1][1..alen]
* N - number of aligned sequences
* ret_S - RETURN: NxN matrix of fractional identities
*
* Returns: <eslOK> on success, and <ret_S> contains the distance
* matrix. Caller is obligated to free <S> with
* <esl_dmatrix_Destroy()>.
*
* Throws: <eslEINVAL> if a seq has a different
* length than others. On failure, <ret_S> is returned <NULL>
* and state of inputs is unchanged.
*/
int
esl_dst_XPairIdMx(const ESL_ALPHABET *abc, ESL_DSQ **ax, int N, ESL_DMATRIX **ret_S)
{
int status;
ESL_DMATRIX *S = NULL;
int i,j;
if (( S = esl_dmatrix_Create(N,N) ) == NULL) goto ERROR;
for (i = 0; i < N; i++)
{
S->mx[i][i] = 1.;
for (j = i+1; j < N; j++)
{
status = esl_dst_XPairId(abc, ax[i], ax[j], &(S->mx[i][j]), NULL, NULL);
if (status != eslOK)
ESL_XEXCEPTION(status, "Pairwise identity calculation failed at seqs %d,%d\n", i,j);
S->mx[j][i] = S->mx[i][j];
}
}
if (ret_S != NULL) *ret_S = S; else esl_dmatrix_Destroy(S);
return eslOK;
ERROR:
if (S != NULL) esl_dmatrix_Destroy(S);
if (ret_S != NULL) *ret_S = NULL;
return status;
}
int
main(void)
{
ESL_STOPWATCH *w = NULL;
ESL_DMATRIX *Q = NULL;
ESL_DMATRIX *P = NULL;
double t = 5.0;
int esl_iterations = 100;
int i;
#ifdef HAVE_LIBGSL
gsl_matrix *Qg = NULL;
gsl_matrix *Pg = NULL;
int gsl_iterations = 100;
#endif
w = esl_stopwatch_Create();
Q = esl_dmatrix_Create(20, 20);
P = esl_dmatrix_Create(20, 20);
esl_rmx_SetWAG(Q, NULL);
esl_stopwatch_Start(w);
for (i = 0; i < esl_iterations; i++)
esl_dmx_Exp(Q, t, P);
esl_stopwatch_Stop(w);
printf("Easel takes: %g sec\n", w->user / (double) esl_iterations);
#ifdef HAVE_LIBGSL
if (esl_dmx_MorphGSL(Q, &Qg) != eslOK) esl_fatal("morph to gsl_matrix failed");
if ((Pg = gsl_matrix_alloc(20, 20)) == NULL) esl_fatal("gsl alloc failed");
gsl_matrix_scale(Qg, t);
esl_stopwatch_Start(w);
for (i = 0; i < gsl_iterations; i++)
gsl_linalg_exponential_ss(Qg, Pg, GSL_PREC_DOUBLE);
esl_stopwatch_Stop(w);
printf(" GSL takes: %g sec\n", w->user / (double) gsl_iterations);
gsl_matrix_free(Qg);
gsl_matrix_free(Pg);
#endif /*HAVE_LIBGSL*/
esl_dmatrix_Destroy(Q);
esl_dmatrix_Destroy(P);
esl_stopwatch_Destroy(w);
return 0;
}
int
main(void)
{
char errbuf[eslERRBUFSIZE];
char *alphabet = "ACDEFGHIKLMNPQRSTVWY";
ESL_DMATRIX *Q = NULL;
ESL_DMATRIX *P = NULL;
gsl_matrix *Qg = NULL;
gsl_matrix *Pg = NULL;
ESL_DMATRIX *Pge = NULL;
double t = 15.0;
if ((Q = esl_dmatrix_Create(20, 20)) == NULL) esl_fatal("malloc failed");
if ((P = esl_dmatrix_Create(20, 20)) == NULL) esl_fatal("malloc failed");
if (esl_rmx_SetWAG(Q, NULL) != eslOK) esl_fatal("_SetWAG() failed");
if (esl_rmx_ValidateQ(Q, 0.0001, errbuf) != eslOK) esl_fatal("Q validation failed: %s", errbuf);
if (esl_dmx_Exp(Q, t, P) != eslOK) esl_fatal("matrix exponentiation failed");
if (esl_rmx_ValidateP(P, 0.0001, errbuf) != eslOK) esl_fatal("P validation failed: %s", errbuf);
if (esl_dmx_MorphGSL(Q, &Qg) != eslOK) esl_fatal("morph to gsl_matrix failed");
if ((Pg = gsl_matrix_alloc(20, 20)) == NULL) esl_fatal("gsl alloc failed");
gsl_matrix_scale(Qg, t);
if (gsl_linalg_exponential_ss(Qg, Pg, GSL_PREC_DOUBLE) != 0) esl_fatal("gsl's exponentiation failed");
if (esl_dmx_UnmorphGSL(Pg, &Pge) != eslOK) esl_fatal("morph from gsl_matrix failed");
esl_dmatrix_Dump(stdout, P, alphabet, alphabet);
if (esl_dmatrix_Compare(Pge, P, 0.00001) != eslOK) esl_fatal("whoops, different answers.");
esl_dmatrix_Destroy(Q);
esl_dmatrix_Destroy(P);
esl_dmatrix_Destroy(Pge);
gsl_matrix_free(Qg);
gsl_matrix_free(Pg);
return 0;
}
/* Function: esl_dst_XJukesCantorMx()
* Synopsis: NxN Jukes/Cantor distance matrix for N aligned digital seqs.
* Incept: SRE, Thu Apr 27 08:38:08 2006 [New York City]
*
* Purpose: Given a digitized multiple sequence alignment <ax>,
* consisting of <nseq> aligned digital sequences in
* bioalphabet <abc>, calculate a symmetric Jukes/Cantor
* pairwise distance matrix for all sequence pairs;
* optionally return the distance matrix in <ret_D> and
* a matrix of the large-sample variances for those ML distance
* estimates in <ret_V>.
*
* Infinite distances (and variances) are possible. They
* are represented as <HUGE_VAL> in <D> and <V>. Caller must
* be prepared to deal with them as appropriate.
*
* Args: abc - bioalphabet for <aseq>
* ax - aligned digital sequences [0.nseq-1][1..L]
* nseq - number of aseqs
* opt_D - optRETURN: [0..nseq-1]x[0..nseq-1] symmetric distance mx
* opt_V - optRETURN: matrix of variances.
*
* Returns: <eslOK> on success. <D> (and optionally <V>) contain the
* distance matrix (and variances). Caller frees these with
* <esl_dmatrix_Destroy()>.
*
* Throws: <eslEINVAL> if any pair of sequences have differing lengths
* (and thus cannot have been properly aligned).
* <eslEDIVZERO> if some pair of sequences had no aligned
* residues. On failure, <D> and <V> are both returned <NULL>
* and state of inputs is unchanged.
*/
int
esl_dst_XJukesCantorMx(const ESL_ALPHABET *abc, ESL_DSQ **ax, int nseq,
ESL_DMATRIX **opt_D, ESL_DMATRIX **opt_V)
{
ESL_DMATRIX *D = NULL;
ESL_DMATRIX *V = NULL;
int status;
int i,j;
if (( D = esl_dmatrix_Create(nseq, nseq) ) == NULL) goto ERROR;
if (( V = esl_dmatrix_Create(nseq, nseq) ) == NULL) goto ERROR;
for (i = 0; i < nseq; i++)
{
D->mx[i][i] = 0.;
V->mx[i][i] = 0.;
for (j = i+1; j < nseq; j++)
{
status = esl_dst_XJukesCantor(abc, ax[i], ax[j],
&(D->mx[i][j]), &(V->mx[i][j]));
if (status != eslOK)
ESL_XEXCEPTION(status, "J/C calculation failed at digital aseqs %d,%d", i,j);
D->mx[j][i] = D->mx[i][j];
V->mx[j][i] = V->mx[i][j];
}
}
if (opt_D != NULL) *opt_D = D; else esl_dmatrix_Destroy(D);
if (opt_V != NULL) *opt_V = V; else esl_dmatrix_Destroy(V);
return eslOK;
ERROR:
if (D != NULL) esl_dmatrix_Destroy(D);
if (V != NULL) esl_dmatrix_Destroy(V);
if (opt_D != NULL) *opt_D = NULL;
if (opt_V != NULL) *opt_V = NULL;
return status;
}
static void
utest_SetWAG(void)
{
char errbuf[eslERRBUFSIZE];
ESL_DMATRIX *Q = NULL;
ESL_DMATRIX *P = NULL;
double t = 50.0; /* sufficiently large to drive e^tQ to stationarity */
double pi[20];
int i;
if ((Q = esl_dmatrix_Create(20, 20)) == NULL) esl_fatal("malloc failed");
if ((P = esl_dmatrix_Create(20, 20)) == NULL) esl_fatal("malloc failed");
/* This tests that exponentiating WAG gives a stable conditional
* probability matrix solution. (It doesn't particularly test that
* WAG was set correctly, but how could we have screwed that up?)
*/
if (esl_rmx_SetWAG(Q, NULL) != eslOK) esl_fatal("_SetWAG() failed");
if (esl_dmx_Exp(Q, t, P) != eslOK) esl_fatal("matrix exponentiation failed");
if (esl_rmx_ValidateP(P, 1e-7, errbuf) != eslOK) esl_fatal("P validation failed: %s", errbuf);
if (esl_rmx_ValidateQ(Q, 1e-7, errbuf) != eslOK) esl_fatal("Q validation failed: %s", errbuf);
/* This tests setting WAG to different stationary pi's than default,
* then tests that exponentiating to large t reaches those stationaries.
*/
esl_vec_DSet(pi, 20, 0.05);
if (esl_rmx_SetWAG(Q, pi) != eslOK) esl_fatal("_SetWAG() failed");
if (esl_dmx_Exp(Q, t, P) != eslOK) esl_fatal("matrix exponentiation failed");
if (esl_rmx_ValidateP(P, 1e-7, errbuf) != eslOK) esl_fatal("P validation failed: %s", errbuf);
if (esl_rmx_ValidateQ(Q, 1e-7, errbuf) != eslOK) esl_fatal("Q validation failed: %s", errbuf);
for (i = 0; i < 20; i++)
if (esl_vec_DCompare(P->mx[i], pi, 20, 1e-7) != eslOK) esl_fatal("P didn't converge to right pi's");
esl_dmatrix_Destroy(Q);
esl_dmatrix_Destroy(P);
return;
}
int
main(int argc, char **argv)
{
ESL_GETOPTS *go = NULL;
char *keyfile = NULL;
char *tabfile = NULL;
ESL_KEYHASH *kh = esl_keyhash_Create();
int nkeys = 0;
ESL_DMATRIX *D = NULL;
ESL_TREE *T = NULL;
go = esl_getopts_Create(options);
if (esl_opt_ProcessCmdline(go, argc, argv) != eslOK) cmdline_failure(argv[0], go, "Failed to parse command line: %s\n", go->errbuf);
if (esl_opt_VerifyConfig(go) != eslOK) cmdline_failure(argv[0], go, "Error in app configuration: %s\n", go->errbuf);
if (esl_opt_GetBoolean(go, "-h") ) cmdline_help (argv[0], go);
if (esl_opt_ArgNumber(go) != 2) cmdline_failure(argv[0], go, "Incorrect number of command line arguments.\n");
keyfile = esl_opt_GetArg(go, 1);
tabfile = esl_opt_GetArg(go, 2);
read_keyfile(go, keyfile, kh);
nkeys = esl_keyhash_GetNumber(kh);
D = esl_dmatrix_Create(nkeys, nkeys);
read_tabfile(go, tabfile, kh, D);
esl_tree_SingleLinkage(D, &T);
//esl_tree_WriteNewick(stdout, T);
output_clusters(go, T, kh);
esl_tree_Destroy(T);
esl_dmatrix_Destroy(D);
esl_keyhash_Destroy(kh);
esl_getopts_Destroy(go);
return 0;
}
int
main(int argc, char **argv)
{
char *filename = argv[1];
FILE *fp = NULL;
ESL_DMATRIX *E = NULL;
double *pi = NULL;
int i,j,n;
E = esl_dmatrix_Create(20, 20);
pi = malloc(20 * sizeof(double));
if ((fp = fopen(filename, "r")) == NULL) esl_fatal("open failed");
if (esl_paml_ReadE(fp, E, pi) != eslOK) esl_fatal("parse failed");
n = 1;
for (i = 1; i < 20; i++)
for (j = 0; j < i; j++)
{
printf("%8.6f, ", E->mx[i][j]);
if (n++ == 10) { puts(""); n=1; }
}
puts("");
n = 1;
for (i = 0; i < 20; i++)
{
printf("%8.6f, ", pi[i]);
if (n++ == 10) { puts(""); n=1; }
}
fclose(fp);
free(pi);
esl_dmatrix_Destroy(E);
return 0;
}
int
main(int argc, char **argv)
{
ESL_ALPHABET *abc = NULL; /* sequence alphabet */
ESL_GETOPTS *go = NULL; /* command line processing */
ESL_RANDOMNESS *r = NULL; /* source of randomness */
P7_HMM *hmm = NULL; /* sampled HMM to emit from */
P7_HMM *core = NULL; /* safe copy of the HMM, before config */
P7_BG *bg = NULL; /* null model */
ESL_SQ *sq = NULL; /* sampled sequence */
P7_TRACE *tr = NULL; /* sampled trace */
P7_PROFILE *gm = NULL; /* profile */
int i,j;
int i1,i2;
int k1,k2;
int iseq;
FILE *fp = NULL;
double expected;
int do_ilocal;
char *hmmfile = NULL;
int nseq;
int do_swlike;
int do_ungapped;
int L;
int M;
int do_h2;
char *ipsfile = NULL;
char *kpsfile = NULL;
ESL_DMATRIX *imx = NULL;
ESL_DMATRIX *kmx = NULL;
ESL_DMATRIX *iref = NULL; /* reference matrix: expected i distribution under ideality */
int Lbins;
int status;
char errbuf[eslERRBUFSIZE];
/*****************************************************************
* Parse the command line
*****************************************************************/
go = esl_getopts_Create(options);
if (esl_opt_ProcessCmdline(go, argc, argv) != eslOK) esl_fatal("Failed to parse command line: %s\n", go->errbuf);
if (esl_opt_VerifyConfig(go) != eslOK) esl_fatal("Failed to parse command line: %s\n", go->errbuf);
if (esl_opt_GetBoolean(go, "-h") == TRUE) {
puts(usage);
puts("\n where options are:\n");
esl_opt_DisplayHelp(stdout, go, 0, 2, 80); /* 0=all docgroups; 2 = indentation; 80=textwidth*/
return eslOK;
}
do_ilocal = esl_opt_GetBoolean(go, "-i");
hmmfile = esl_opt_GetString (go, "-m");
nseq = esl_opt_GetInteger(go, "-n");
do_swlike = esl_opt_GetBoolean(go, "-s");
do_ungapped = esl_opt_GetBoolean(go, "-u");
L = esl_opt_GetInteger(go, "-L");
M = esl_opt_GetInteger(go, "-M");
do_h2 = esl_opt_GetBoolean(go, "-2");
ipsfile = esl_opt_GetString (go, "--ips");
kpsfile = esl_opt_GetString (go, "--kps");
if (esl_opt_ArgNumber(go) != 0) {
puts("Incorrect number of command line arguments.");
printf("Usage: %s [options]\n", argv[0]);
return eslFAIL;
}
r = esl_randomness_CreateFast(0);
if (hmmfile != NULL)
{ /* Read the HMM (and get alphabet from it) */
P7_HMMFILE *hfp = NULL;
status = p7_hmmfile_OpenE(hmmfile, NULL, &hfp, errbuf);
if (status == eslENOTFOUND) p7_Fail("File existence/permissions problem in trying to open HMM file %s.\n%s\n", hmmfile, errbuf);
else if (status == eslEFORMAT) p7_Fail("File format problem in trying to open HMM file %s.\n%s\n", hmmfile, errbuf);
else if (status != eslOK) p7_Fail("Unexpected error %d in opening HMM file %s.\n%s\n", status, hmmfile, errbuf);
if ((status = p7_hmmfile_Read(hfp, &abc, &hmm)) != eslOK) {
if (status == eslEOD) esl_fatal("read failed, HMM file %s may be truncated?", hmmfile);
else if (status == eslEFORMAT) esl_fatal("bad file format in HMM file %s", hmmfile);
else if (status == eslEINCOMPAT) esl_fatal("HMM file %s contains different alphabets", hmmfile);
else esl_fatal("Unexpected error in reading HMMs");
}
M = hmm->M;
p7_hmmfile_Close(hfp);
}
else
{ /* Or sample the HMM (create alphabet first) */
abc = esl_alphabet_Create(eslAMINO);
if (do_ungapped) p7_hmm_SampleUngapped(r, M, abc, &hmm);
else if (do_swlike) p7_hmm_SampleUniform (r, M, abc, 0.05, 0.5, 0.05, 0.2, &hmm); /* tmi, tii, tmd, tdd */
else p7_hmm_Sample (r, M, abc, &hmm);
}
Lbins = M;
imx = esl_dmatrix_Create(Lbins, Lbins);
iref = esl_dmatrix_Create(Lbins, Lbins);
kmx = esl_dmatrix_Create(M, M);
esl_dmatrix_SetZero(imx);
esl_dmatrix_SetZero(iref);
esl_dmatrix_SetZero(kmx);
tr = p7_trace_Create();
sq = esl_sq_CreateDigital(abc);
bg = p7_bg_Create(abc);
core = p7_hmm_Clone(hmm);
if (do_h2) {
gm = p7_profile_Create(hmm->M, abc);
p7_H2_ProfileConfig(hmm, bg, gm, p7_UNILOCAL);
} else {
gm = p7_profile_Create(hmm->M, abc);
p7_ProfileConfig(hmm, bg, gm, L, p7_UNILOCAL);
if (p7_hmm_Validate (hmm, NULL, 0.0001) != eslOK) esl_fatal("whoops, HMM is bad!");
if (p7_profile_Validate(gm, NULL, 0.0001) != eslOK) esl_fatal("whoops, profile is bad!");
}
/* Sample endpoints.
* Also sample an ideal reference distribution for i endpoints. i
* endpoints are prone to discretization artifacts, when emitted
* sequences have varying lengths. Taking log odds w.r.t. an ideal
* reference that is subject to the same discretization artifacts
* cancels out the effect.
*/
for (iseq = 0; iseq < nseq; iseq++)
{
if (do_ilocal) ideal_local_endpoints (r, core, sq, tr, Lbins, &i1, &i2, &k1, &k2);
else profile_local_endpoints(r, core, gm, sq, tr, Lbins, &i1, &i2, &k1, &k2);
imx->mx[i1-1][i2-1] += 1.;
kmx->mx[k1-1][k2-1] += 1.;
/* reference distribution for i */
ideal_local_endpoints (r, core, sq, tr, Lbins, &i1, &i2, &k1, &k2);
iref->mx[i1-1][i2-1] += 1.;
}
/* Adjust both mx's to log_2(obs/exp) ratio */
printf("Before normalization/log-odds:\n");
printf(" i matrix values range from %f to %f\n", dmx_upper_min(imx), dmx_upper_max(imx));
printf(" k matrix values range from %f to %f\n", dmx_upper_min(kmx), dmx_upper_max(kmx));
printf("iref matrix values range from %f to %f\n", dmx_upper_min(iref), dmx_upper_max(iref));
expected = (double) nseq * 2. / (double) (M*(M+1));
for (i = 0; i < kmx->m; i++)
for (j = i; j < kmx->n; j++)
kmx->mx[i][j] = log(kmx->mx[i][j] / expected) / log(2.0);
for (i = 0; i < imx->m; i++)
for (j = i; j < imx->m; j++)
if (iref->mx[i][j] == 0. && imx->mx[i][j] == 0.)
imx->mx[i][j] = 0.;
else if (iref->mx[i][j] == 0.)
imx->mx[i][j] = eslINFINITY;
else if (imx->mx[i][j] == 0.)
imx->mx[i][j] = -eslINFINITY;
else
imx->mx[i][j] = log(imx->mx[i][j] / iref->mx[i][j]) / log(2.0);
/* Print ps files */
if (kpsfile != NULL) {
if ((fp = fopen(kpsfile, "w")) == NULL) esl_fatal("Failed to open output postscript file %s", kpsfile);
dmx_Visualize(fp, kmx, -4., 5.);
fclose(fp);
}
if (ipsfile != NULL) {
if ((fp = fopen(ipsfile, "w")) == NULL) esl_fatal("Failed to open output postscript file %s", ipsfile);
dmx_Visualize(fp, imx, -4., 5.);
/* dmx_Visualize(fp, imx, dmx_upper_min(imx), dmx_upper_max(imx)); */
fclose(fp);
}
printf("After normalization/log-odds:\n");
printf("i matrix values range from %f to %f\n", dmx_upper_min(imx), dmx_upper_max(imx));
printf("k matrix values range from %f to %f\n", dmx_upper_min(kmx), dmx_upper_max(kmx));
p7_profile_Destroy(gm);
p7_bg_Destroy(bg);
p7_hmm_Destroy(core);
p7_hmm_Destroy(hmm);
p7_trace_Destroy(tr);
esl_sq_Destroy(sq);
esl_dmatrix_Destroy(imx);
esl_dmatrix_Destroy(kmx);
esl_alphabet_Destroy(abc);
esl_randomness_Destroy(r);
esl_getopts_Destroy(go);
return eslOK;
}
/* A: nxn real matrix
* ret_Er: RETURN: vector of eigenvalues, real part, allocated 0..n-1
* ret_Ei: RETURN: vector of eigenvalues, imaginary part, allocated 0..n-1
* ret_VL: RETURN: left eigenvectors
* ret_VR: RETURN: right eigenvectors
*/
int
esl_lapack_dgeev(ESL_DMATRIX *A, double **ret_Er, double **ret_Ei, ESL_DMATRIX **ret_VL, ESL_DMATRIX **ret_VR)
{
double *Er = NULL;
double *Ei = NULL;
ESL_DMATRIX *VL = NULL;
ESL_DMATRIX *VR = NULL;
double *work = NULL;
char jobvl, jobvr;
int lda;
int ldvl, ldvr;
int lwork;
int info;
int status;
if ((VL = esl_dmatrix_Create(A->n,A->n)) == NULL) { status = eslEMEM; goto ERROR; }
if ((VR = esl_dmatrix_Create(A->n,A->n)) == NULL) { status = eslEMEM; goto ERROR; }
ESL_ALLOC(Er, sizeof(double) * A->n);
ESL_ALLOC(Ei, sizeof(double) * A->n);
ESL_ALLOC(work, sizeof(double) * 4 * A->n);
jobvl = (ret_VL == NULL) ? 'N' : 'V'; /* do we want left eigenvectors? */
jobvr = (ret_VR == NULL) ? 'N' : 'V'; /* do we want right eigenvectors? */
lda = A->n;
ldvl = A->n;
ldvr = A->n;
lwork = 4*A->n;
/* Fortran convention is colxrow, not rowxcol; so transpose
* A before passing it to a Fortran routine.
*/
esl_dmx_Transpose(A);
/* The actual Fortran77 interface call to LAPACK.
* All args must be passed by reference.
* Fortran 2D arrays are 1D: so pass the A[0] part of a DSMX.
*/
dgeev_(&jobvl, &jobvr, &(A->n), A->mx[0], &lda, Er, Ei, VL->mx[0], &ldvl, VR->mx[0], &ldvr, work, &lwork, &info);
/* Now, VL, VR are transposed (col x row), so transpose them back to
* C convention.
*/
esl_dmx_Transpose(VL);
esl_dmx_Transpose(VR);
if (ret_VL != NULL) *ret_VL = VL; else esl_dmatrix_Destroy(VL);
if (ret_VR != NULL) *ret_VR = VR; else esl_dmatrix_Destroy(VR);
if (ret_Er != NULL) *ret_Er = Er; else free(Er);
if (ret_Ei != NULL) *ret_Ei = Ei; else free(Ei);
free(work);
return eslOK;
ERROR:
if (ret_VL != NULL) *ret_VL = NULL;
if (ret_VR != NULL) *ret_VR = NULL;
if (ret_Er != NULL) *ret_Er = NULL;
if (ret_Ei != NULL) *ret_Ei = NULL;
if (VL != NULL) free(VL);
if (VR != NULL) free(VR);
if (Er != NULL) free(Er);
if (Ei != NULL) free(Ei);
if (work != NULL) free(work);
return status;
}
