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