int main(void) { _ws("\t-> Testing io routines.\n"); WI(5, 10, 20, 30, 40, 50); _ws("\tDone.\n"); return 0; }
void GeneralizedEigenSystemSolverRealGeneralMatrices(Array2 < doublevar > & Ain, Array1 <dcomplex> & W, Array2 <doublevar> & VL, Array2 <doublevar> & VR) { #ifdef USE_LAPACK //if LAPACK int N=Ain.dim[0]; Array2 <doublevar> A_temp=Ain; //,VL(N,N),VR(N,N); Array1 <doublevar> WORK,RWORK(2*N),WI(N),WR(N); WI.Resize(N); VL.Resize(N,N); VR.Resize(N,N); int info; int NB=64; int NMAX=N; int lda=NMAX; int ldb=NMAX; int LWORK=5*NMAX; WORK.Resize(LWORK); info= dgeev('V','V',N,A_temp.v, lda,WR.v,WI.v,VL.v,lda,VR.v,lda,WORK.v,LWORK); if(info>0) error("Internal error in the LAPACK routine dgeev",info); if(info<0) error("Problem with the input parameter of LAPACK routine dgeev in position ",-info); W.Resize(N); for(int i=0; i< N; i++) { W(i)=dcomplex(WR(i),WI(i)); } // for (int i=0; i<N; i++) // evals(i)=W[N-1-i]; // for (int i=0; i<N; i++) { // for (int j=0; j<N; j++) { // evecs(j,i)=A_temp(N-1-i,j); // } // } //END OF LAPACK #else //IF NO LAPACK error("need LAPACK for eigensystem solver for general matrices"); #endif //END OF NO LAPACK }
void config_write() { RECT r; GetWindowRect(hwnd_main,&r); config_x=r.left; config_y=r.top; config_w=r.right-r.left; config_h=r.bottom-r.top; WI(config_x); WI(config_y); WI(config_w); WI(config_h); WI(config_border); WI(config_color); WI(config_bcolor1); WI(config_bcolor2); WI(config_icon); }
static void config_write() { CRect r; CWindow wnd(hwnd_main); wnd.GetWindowRect(&r); config_x=r.left; config_y=r.top; config_w=r.right-r.left; config_h=r.bottom-r.top; WI(config_x); WI(config_y); WI(config_w); WI(config_h); WI(config_border); WI(config_color); WI(config_bcolor1); WI(config_bcolor2); }
// construct identity matrix vector diaggen(matrix& a) { int N=a.Rows; char JOBVL='V'; char JOBVR='V'; int INFO=0; int LDA=N; vector WR(N); vector WI(N); int LDVL=N; int LDVR=N; matrix VL(LDVL,N); matrix VR(LDVR,N); int LWORK=4*N; vector WORK(LWORK); vector W(N); FORTRAN(dgeev)(&JOBVL,&JOBVR,&N,a.TheMatrix,&LDA,WR.TheVector, WI.TheVector,VL.TheMatrix,&LDVL,VR.TheMatrix,&LDVR,WORK.TheVector, &LWORK,&INFO); if (INFO != 0) cerr<<"diagonalization failed"<<endl; return WR; }
void bob::math::eig_(const blitz::Array<double,2>& A, blitz::Array<std::complex<double>,2>& V, blitz::Array<std::complex<double>,1>& D) { // Size variable const int N = A.extent(0); // Prepares to call LAPACK function // Initialises LAPACK variables const char jobvl = 'N'; // Do NOT compute left eigen-vectors const char jobvr = 'V'; // Compute right eigen-vectors int info = 0; const int lda = N; const int ldvr = N; double VL = 0; // notice we don't compute the left eigen-values const int ldvl = 1; // Initialises LAPACK arrays blitz::Array<double,2> A_lapack = bob::core::array::ccopy(const_cast<blitz::Array<double,2>&>(A).transpose(1,0)); // temporary arrays to receive LAPACK's eigen-values and eigen-vectors blitz::Array<double,1> WR(D.shape()); //real part blitz::Array<double,1> WI(D.shape()); //imaginary part blitz::Array<double,2> VR(A.shape()); //right eigen-vectors // Calls the LAPACK function // A/ Queries the optimal size of the working arrays const int lwork_query = -1; double work_query; dgeev_( &jobvl, &jobvr, &N, A_lapack.data(), &lda, WR.data(), WI.data(), &VL, &ldvl, VR.data(), &ldvr, &work_query, &lwork_query, &info); // B/ Computes the eigenvalue decomposition const int lwork = static_cast<int>(work_query); boost::shared_array<double> work(new double[lwork]); dgeev_( &jobvl, &jobvr, &N, A_lapack.data(), &lda, WR.data(), WI.data(), &VL, &ldvl, VR.data(), &ldvr, work.get(), &lwork, &info); // Checks info variable if (info != 0) { throw std::runtime_error("the QR algorithm failed to compute all the eigenvalues, and no eigenvectors have been computed."); } // Copy results back from WR, WI => D blitz::real(D) = WR; blitz::imag(D) = WI; // Copy results back from VR => V, with two rules: // 1) If the j-th eigenvalue is real, then v(j) = VR(:,j), the j-th column of // VR. // 2) If the j-th and (j+1)-st eigenvalues form a complex conjugate pair, // then v(j) = VR(:,j) + i*VR(:,j+1) and v(j+1) = VR(:,j) - i*VR(:,j+1). blitz::Range a = blitz::Range::all(); int i=0; while (i<N) { if (std::imag(D(i)) == 0.) { //real eigen-value, consume 1 blitz::real(V(a,i)) = VR(i,a); blitz::imag(V(a,i)) = 0.; ++i; } else { //complex eigen-value, consume 2 blitz::real(V(a,i)) = VR(i,a); blitz::imag(V(a,i)) = VR(i+1,a); blitz::real(V(a,i+1)) = VR(i,a); blitz::imag(V(a,i+1)) = -VR(i+1,a); i += 2; } } }
/* Subroutine */ int dgeev_(char *jobvl, char *jobvr, integer *n, doublereal * a, integer *lda, doublereal *wr, doublereal *wi, doublereal *vl, integer *ldvl, doublereal *vr, integer *ldvr, doublereal *work, integer *lwork, integer *info) { /* -- LAPACK driver routine (version 2.0) -- Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., Courant Institute, Argonne National Lab, and Rice University September 30, 1994 Purpose ======= DGEEV computes for an N-by-N real nonsymmetric matrix A, the eigenvalues and, optionally, the left and/or right eigenvectors. The right eigenvector v(j) of A satisfies A * v(j) = lambda(j) * v(j) where lambda(j) is its eigenvalue. The left eigenvector u(j) of A satisfies u(j)**H * A = lambda(j) * u(j)**H where u(j)**H denotes the conjugate transpose of u(j). The computed eigenvectors are normalized to have Euclidean norm equal to 1 and largest component real. Arguments ========= JOBVL (input) CHARACTER*1 = 'N': left eigenvectors of A are not computed; = 'V': left eigenvectors of A are computed. JOBVR (input) CHARACTER*1 = 'N': right eigenvectors of A are not computed; = 'V': right eigenvectors of A are computed. N (input) INTEGER The order of the matrix A. N >= 0. A (input/output) DOUBLE PRECISION array, dimension (LDA,N) On entry, the N-by-N matrix A. On exit, A has been overwritten. LDA (input) INTEGER The leading dimension of the array A. LDA >= max(1,N). WR (output) DOUBLE PRECISION array, dimension (N) WI (output) DOUBLE PRECISION array, dimension (N) WR and WI contain the real and imaginary parts, respectively, of the computed eigenvalues. Complex conjugate pairs of eigenvalues appear consecutively with the eigenvalue having the positive imaginary part first. VL (output) DOUBLE PRECISION array, dimension (LDVL,N) If JOBVL = 'V', the left eigenvectors u(j) are stored one after another in the columns of VL, in the same order as their eigenvalues. If JOBVL = 'N', VL is not referenced. If the j-th eigenvalue is real, then u(j) = VL(:,j), the j-th column of VL. If the j-th and (j+1)-st eigenvalues form a complex conjugate pair, then u(j) = VL(:,j) + i*VL(:,j+1) and u(j+1) = VL(:,j) - i*VL(:,j+1). LDVL (input) INTEGER The leading dimension of the array VL. LDVL >= 1; if JOBVL = 'V', LDVL >= N. VR (output) DOUBLE PRECISION array, dimension (LDVR,N) If JOBVR = 'V', the right eigenvectors v(j) are stored one after another in the columns of VR, in the same order as their eigenvalues. If JOBVR = 'N', VR is not referenced. If the j-th eigenvalue is real, then v(j) = VR(:,j), the j-th column of VR. If the j-th and (j+1)-st eigenvalues form a complex conjugate pair, then v(j) = VR(:,j) + i*VR(:,j+1) and v(j+1) = VR(:,j) - i*VR(:,j+1). LDVR (input) INTEGER The leading dimension of the array VR. LDVR >= 1; if JOBVR = 'V', LDVR >= N. WORK (workspace/output) DOUBLE PRECISION array, dimension (LWORK) On exit, if INFO = 0, WORK(1) returns the optimal LWORK. LWORK (input) INTEGER The dimension of the array WORK. LWORK >= max(1,3*N), and if JOBVL = 'V' or JOBVR = 'V', LWORK >= 4*N. For good performance, LWORK must generally be larger. INFO (output) INTEGER = 0: successful exit < 0: if INFO = -i, the i-th argument had an illegal value. > 0: if INFO = i, the QR algorithm failed to compute all the eigenvalues, and no eigenvectors have been computed; elements i+1:N of WR and WI contain eigenvalues which have converged. ===================================================================== Test the input arguments Parameter adjustments Function Body */ /* Table of constant values */ static integer c__1 = 1; static integer c__0 = 0; static integer c__8 = 8; static integer c_n1 = -1; static integer c__4 = 4; /* System generated locals */ integer a_dim1, a_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2, i__3, i__4; doublereal d__1, d__2; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ static integer ibal; static char side[1]; static integer maxb; static doublereal anrm; static integer ierr, itau; extern /* Subroutine */ int drot_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *); static integer iwrk, nout; extern doublereal dnrm2_(integer *, doublereal *, integer *); static integer i, k; static doublereal r; extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *, integer *); extern logical lsame_(char *, char *); extern doublereal dlapy2_(doublereal *, doublereal *); extern /* Subroutine */ int dlabad_(doublereal *, doublereal *), dgebak_( char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, integer *, integer *), dgebal_(char *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *); static doublereal cs; static logical scalea; extern doublereal dlamch_(char *); static doublereal cscale; extern doublereal dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ int dgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *); static doublereal sn; extern /* Subroutine */ int dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); extern integer idamax_(integer *, doublereal *, integer *); extern /* Subroutine */ int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), xerbla_(char *, integer *); static logical select[1]; extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); static doublereal bignum; extern /* Subroutine */ int dorghr_(integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *), dhseqr_(char *, char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *, integer *), dtrevc_(char *, char *, logical *, integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *); static integer minwrk, maxwrk; static logical wantvl; static doublereal smlnum; static integer hswork; static logical wantvr; static integer ihi; static doublereal scl; static integer ilo; static doublereal dum[1], eps; #define DUM(I) dum[(I)] #define WR(I) wr[(I)-1] #define WI(I) wi[(I)-1] #define WORK(I) work[(I)-1] #define A(I,J) a[(I)-1 + ((J)-1)* ( *lda)] #define VL(I,J) vl[(I)-1 + ((J)-1)* ( *ldvl)] #define VR(I,J) vr[(I)-1 + ((J)-1)* ( *ldvr)] *info = 0; wantvl = lsame_(jobvl, "V"); wantvr = lsame_(jobvr, "V"); if (! wantvl && ! lsame_(jobvl, "N")) { *info = -1; } else if (! wantvr && ! lsame_(jobvr, "N")) { *info = -2; } else if (*n < 0) { *info = -3; } else if (*lda < max(1,*n)) { *info = -5; } else if (*ldvl < 1 || wantvl && *ldvl < *n) { *info = -9; } else if (*ldvr < 1 || wantvr && *ldvr < *n) { *info = -11; } /* Compute workspace (Note: Comments in the code beginning "Workspace:" describe the minimal amount of workspace needed at that point in the code, as well as the preferred amount for good performance. NB refers to the optimal block size for the immediately following subroutine, as returned by ILAENV. HSWORK refers to the workspace preferred by DHSEQR, as calculated below. HSWORK is computed assuming ILO=1 and IHI=N, the worst case.) */ minwrk = 1; if (*info == 0 && *lwork >= 1) { maxwrk = (*n << 1) + *n * ilaenv_(&c__1, "DGEHRD", " ", n, &c__1, n, & c__0, 6L, 1L); if (! wantvl && ! wantvr) { /* Computing MAX */ i__1 = 1, i__2 = *n * 3; minwrk = max(i__1,i__2); /* Computing MAX */ i__1 = ilaenv_(&c__8, "DHSEQR", "EN", n, &c__1, n, &c_n1, 6L, 2L); maxb = max(i__1,2); /* Computing MIN Computing MAX */ i__3 = 2, i__4 = ilaenv_(&c__4, "DHSEQR", "EN", n, &c__1, n, & c_n1, 6L, 2L); i__1 = min(maxb,*n), i__2 = max(i__3,i__4); k = min(i__1,i__2); /* Computing MAX */ i__1 = k * (k + 2), i__2 = *n << 1; hswork = max(i__1,i__2); /* Computing MAX */ i__1 = maxwrk, i__2 = *n + 1, i__1 = max(i__1,i__2), i__2 = *n + hswork; maxwrk = max(i__1,i__2); } else { /* Computing MAX */ i__1 = 1, i__2 = *n << 2; minwrk = max(i__1,i__2); /* Computing MAX */ i__1 = maxwrk, i__2 = (*n << 1) + (*n - 1) * ilaenv_(&c__1, "DOR" "GHR", " ", n, &c__1, n, &c_n1, 6L, 1L); maxwrk = max(i__1,i__2); /* Computing MAX */ i__1 = ilaenv_(&c__8, "DHSEQR", "SV", n, &c__1, n, &c_n1, 6L, 2L); maxb = max(i__1,2); /* Computing MIN Computing MAX */ i__3 = 2, i__4 = ilaenv_(&c__4, "DHSEQR", "SV", n, &c__1, n, & c_n1, 6L, 2L); i__1 = min(maxb,*n), i__2 = max(i__3,i__4); k = min(i__1,i__2); /* Computing MAX */ i__1 = k * (k + 2), i__2 = *n << 1; hswork = max(i__1,i__2); /* Computing MAX */ i__1 = maxwrk, i__2 = *n + 1, i__1 = max(i__1,i__2), i__2 = *n + hswork; maxwrk = max(i__1,i__2); /* Computing MAX */ i__1 = maxwrk, i__2 = *n << 2; maxwrk = max(i__1,i__2); } WORK(1) = (doublereal) maxwrk; } if (*lwork < minwrk) { *info = -13; } if (*info != 0) { i__1 = -(*info); xerbla_("DGEEV ", &i__1); return 0; } /* Quick return if possible */ if (*n == 0) { return 0; } /* Get machine constants */ eps = dlamch_("P"); smlnum = dlamch_("S"); bignum = 1. / smlnum; dlabad_(&smlnum, &bignum); smlnum = sqrt(smlnum) / eps; bignum = 1. / smlnum; /* Scale A if max element outside range [SMLNUM,BIGNUM] */ anrm = dlange_("M", n, n, &A(1,1), lda, dum); scalea = FALSE_; if (anrm > 0. && anrm < smlnum) { scalea = TRUE_; cscale = smlnum; } else if (anrm > bignum) { scalea = TRUE_; cscale = bignum; } if (scalea) { dlascl_("G", &c__0, &c__0, &anrm, &cscale, n, n, &A(1,1), lda, & ierr); } /* Balance the matrix (Workspace: need N) */ ibal = 1; dgebal_("B", n, &A(1,1), lda, &ilo, &ihi, &WORK(ibal), &ierr); /* Reduce to upper Hessenberg form (Workspace: need 3*N, prefer 2*N+N*NB) */ itau = ibal + *n; iwrk = itau + *n; i__1 = *lwork - iwrk + 1; dgehrd_(n, &ilo, &ihi, &A(1,1), lda, &WORK(itau), &WORK(iwrk), &i__1, &ierr); if (wantvl) { /* Want left eigenvectors Copy Householder vectors to VL */ *(unsigned char *)side = 'L'; dlacpy_("L", n, n, &A(1,1), lda, &VL(1,1), ldvl); /* Generate orthogonal matrix in VL (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB) */ i__1 = *lwork - iwrk + 1; dorghr_(n, &ilo, &ihi, &VL(1,1), ldvl, &WORK(itau), &WORK(iwrk), &i__1, &ierr); /* Perform QR iteration, accumulating Schur vectors in VL (Workspace: need N+1, prefer N+HSWORK (see comments) ) */ iwrk = itau; i__1 = *lwork - iwrk + 1; dhseqr_("S", "V", n, &ilo, &ihi, &A(1,1), lda, &WR(1), &WI(1), & VL(1,1), ldvl, &WORK(iwrk), &i__1, info); if (wantvr) { /* Want left and right eigenvectors Copy Schur vectors to VR */ *(unsigned char *)side = 'B'; dlacpy_("F", n, n, &VL(1,1), ldvl, &VR(1,1), ldvr) ; } } else if (wantvr) { /* Want right eigenvectors Copy Householder vectors to VR */ *(unsigned char *)side = 'R'; dlacpy_("L", n, n, &A(1,1), lda, &VR(1,1), ldvr); /* Generate orthogonal matrix in VR (Workspace: need 3*N-1, prefer 2*N+(N-1)*NB) */ i__1 = *lwork - iwrk + 1; dorghr_(n, &ilo, &ihi, &VR(1,1), ldvr, &WORK(itau), &WORK(iwrk), &i__1, &ierr); /* Perform QR iteration, accumulating Schur vectors in VR (Workspace: need N+1, prefer N+HSWORK (see comments) ) */ iwrk = itau; i__1 = *lwork - iwrk + 1; dhseqr_("S", "V", n, &ilo, &ihi, &A(1,1), lda, &WR(1), &WI(1), & VR(1,1), ldvr, &WORK(iwrk), &i__1, info); } else { /* Compute eigenvalues only (Workspace: need N+1, prefer N+HSWORK (see comments) ) */ iwrk = itau; i__1 = *lwork - iwrk + 1; dhseqr_("E", "N", n, &ilo, &ihi, &A(1,1), lda, &WR(1), &WI(1), & VR(1,1), ldvr, &WORK(iwrk), &i__1, info); } /* If INFO > 0 from DHSEQR, then quit */ if (*info > 0) { goto L50; } if (wantvl || wantvr) { /* Compute left and/or right eigenvectors (Workspace: need 4*N) */ dtrevc_(side, "B", select, n, &A(1,1), lda, &VL(1,1), ldvl, &VR(1,1), ldvr, n, &nout, &WORK(iwrk), &ierr); } if (wantvl) { /* Undo balancing of left eigenvectors (Workspace: need N) */ dgebak_("B", "L", n, &ilo, &ihi, &WORK(ibal), n, &VL(1,1), ldvl, &ierr); /* Normalize left eigenvectors and make largest component real */ i__1 = *n; for (i = 1; i <= *n; ++i) { if (WI(i) == 0.) { scl = 1. / dnrm2_(n, &VL(1,i), &c__1); dscal_(n, &scl, &VL(1,i), &c__1); } else if (WI(i) > 0.) { d__1 = dnrm2_(n, &VL(1,i), &c__1); d__2 = dnrm2_(n, &VL(1,i+1), &c__1); scl = 1. / dlapy2_(&d__1, &d__2); dscal_(n, &scl, &VL(1,i), &c__1); dscal_(n, &scl, &VL(1,i+1), &c__1); i__2 = *n; for (k = 1; k <= *n; ++k) { /* Computing 2nd power */ d__1 = VL(k,i); /* Computing 2nd power */ d__2 = VL(k,i+1); WORK(iwrk + k - 1) = d__1 * d__1 + d__2 * d__2; /* L10: */ } k = idamax_(n, &WORK(iwrk), &c__1); dlartg_(&VL(k,i), &VL(k,i+1), &cs, &sn, &r); drot_(n, &VL(1,i), &c__1, &VL(1,i+1), &c__1, &cs, &sn); VL(k,i+1) = 0.; } /* L20: */ } } if (wantvr) { /* Undo balancing of right eigenvectors (Workspace: need N) */ dgebak_("B", "R", n, &ilo, &ihi, &WORK(ibal), n, &VR(1,1), ldvr, &ierr); /* Normalize right eigenvectors and make largest component real */ i__1 = *n; for (i = 1; i <= *n; ++i) { if (WI(i) == 0.) { scl = 1. / dnrm2_(n, &VR(1,i), &c__1); dscal_(n, &scl, &VR(1,i), &c__1); } else if (WI(i) > 0.) { d__1 = dnrm2_(n, &VR(1,i), &c__1); d__2 = dnrm2_(n, &VR(1,i+1), &c__1); scl = 1. / dlapy2_(&d__1, &d__2); dscal_(n, &scl, &VR(1,i), &c__1); dscal_(n, &scl, &VR(1,i+1), &c__1); i__2 = *n; for (k = 1; k <= *n; ++k) { /* Computing 2nd power */ d__1 = VR(k,i); /* Computing 2nd power */ d__2 = VR(k,i+1); WORK(iwrk + k - 1) = d__1 * d__1 + d__2 * d__2; /* L30: */ } k = idamax_(n, &WORK(iwrk), &c__1); dlartg_(&VR(k,i), &VR(k,i+1), &cs, &sn, &r); drot_(n, &VR(1,i), &c__1, &VR(1,i+1), &c__1, &cs, &sn); VR(k,i+1) = 0.; } /* L40: */ } } /* Undo scaling if necessary */ L50: if (scalea) { i__1 = *n - *info; /* Computing MAX */ i__3 = *n - *info; i__2 = max(i__3,1); dlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &WR(*info + 1), &i__2, &ierr); i__1 = *n - *info; /* Computing MAX */ i__3 = *n - *info; i__2 = max(i__3,1); dlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &WI(*info + 1), &i__2, &ierr); if (*info > 0) { i__1 = ilo - 1; dlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &WR(1), n, &ierr); i__1 = ilo - 1; dlascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &WI(1), n, &ierr); } } WORK(1) = (doublereal) maxwrk; return 0; /* End of DGEEV */ } /* dgeev_ */
int main(void){ int no=5, gr; double withresh = 0.5; double pat_score; double diff_train, diff_ss; double train_pat[2][no]; train_pat[0][0] = 0; train_pat[0][1] = 0; train_pat[0][2] = 0; train_pat[0][3] = M_PI; train_pat[0][4] = M_PI; //**************** train_pat[1][0] = M_PI; train_pat[1][1] = M_PI; train_pat[1][2] = 0; train_pat[1][3] = 0; train_pat[1][4] = 0; double ss_pat_good[no]; ss_pat_good[0] = 0; ss_pat_good[1] = 0; ss_pat_good[2] = 0; ss_pat_good[3] = M_PI; ss_pat_good[4] = M_PI; double ss_pat_bad[no]; ss_pat_bad[0] = 0; ss_pat_bad[1] = M_PI; ss_pat_bad[2] = 0; ss_pat_bad[3] = M_PI; ss_pat_bad[4] = M_PI; double ss_pat_ter[no]; ss_pat_ter[0] = M_PI; ss_pat_ter[1] = M_PI; ss_pat_ter[2] = M_PI; ss_pat_ter[3] = 0; ss_pat_ter[4] = 0; //Compare train patt to good pat printf("Compare train patt to good pat:\n"); pat_score = 0; for (gr=0; gr<no; gr++){ diff_train = train_pat[0][gr]-train_pat[0][0]; diff_ss = ss_pat_good[gr]-ss_pat_good[0]; printf("diff_train: %f\tdiff_ss: %f\n", diff_train, diff_ss); if ( WI(diff_train,0,withresh) == WI(diff_ss,0,withresh) ){ printf("\tmatch in ind: %d !\n", gr); pat_score++; } } pat_score = pat_score/no; printf("pat_score: %f\n\n\n", pat_score); //Compare train patt to good pat printf("Compare train patt to bad pat:\n"); pat_score = 0; for (gr=0; gr<no; gr++){ diff_train = train_pat[0][gr]-train_pat[0][0]; diff_ss = ss_pat_bad[gr]-ss_pat_bad[0]; printf("diff_train: %f\tdiff_ss: %f\n", diff_train, diff_ss); if ( WI(diff_train,0,withresh) == WI(diff_ss,0,withresh) ){ printf("\tmatch in ind: %d !\n", gr); pat_score++; } } pat_score = pat_score/no; printf("pat_score: %f\n\n\n", pat_score); //Compare train patt to good pat printf("Compare train patt to terrible pat:\n"); pat_score = 0; for (gr=0; gr<no; gr++){ diff_train = train_pat[0][gr]-train_pat[0][0]; diff_ss = ss_pat_ter[gr]-ss_pat_ter[0]; printf("diff_train: %f\tdiff_ss: %f\n", diff_train, diff_ss); if ( WI(diff_train,0,withresh) == WI(diff_ss,0,withresh) ){ printf("\tmatch in ind: %d !\n", gr); pat_score++; } } pat_score = pat_score/no; printf("pat_score: %f\n\n\n", pat_score); return 0; }
void setup (int N, const Parameter ¶m, Array<double, 1> &WR, Array<double,2> &ev, Array<double,2> &evInv) { int Nm1 = N; int i; Array<double, 1> x; Array<double, 2> D; Array<double, 1> r; Array<double, 2> Dsec; Array<double, 1> XX; Array<double, 1> YY; Array<double, 2> A(N,N); Array<double, 2> B(N,N); Array<int, 1> IPIV(Nm1); char BALANC[1]; char JOBVL[1]; char JOBVR[1]; char SENSE[1]; int LDA; int LDVL; int LDVR; int NRHS; int LDB; int INFO; //resize output arrays WR.resize(N); ev.resize(N, N); evInv.resize(N, N); // parameters for DGEEVX Array<double, 1> WI(Nm1); // WR(Nm1), // The real and imaginary part of the eig.values Array<double, 2> VL(N, N); Array<double, 2> VR(Nm1,Nm1); //VR(Nm1,Nm1); // The left and rigth eigenvectors int ILO, IHI; // Info on the balanced output matrix Array<double, 1> SCALE(Nm1); // Scaling factors applied for balancing double ABNRM; // 1-Norm of the balanced matrix Array<double, 1> RCONDE(Nm1); // the reciprocal cond. numb of the respective eig.val Array<double, 1> RCONDV(Nm1); // the reciprocal cond. numb of the respective eig.vec int LWORK = (N+1)*(N+7); // Depending on SENSE Array<double, 1> WORK(LWORK); Array<int, 1> IWORK(2*(N+1)-2); // Compute the Chebyshev differensiation matrix and D*D // cheb(N, x, D); cheb(N, x, D); Dsec.resize(D.shape()); MatrixMatrixMultiply(D, D, Dsec); // Compute the 1. and 2. derivatives of the transformations XYmat(N, param, XX, YY, r); // Set up the full timepropagation matrix A // dy/dt = - i A y Range range(1, N); //Dsec and D have range 0, N+1. //We don't want the edge points in A A = XX(tensor::i) * Dsec(range, range) + YY(tensor::i) * D(range, range); //Transpose A for (int i=0; i<A.extent(0); i++) { for (int j=0; j<i; j++) { double t = A(i,j); A(i,j) = A(j, i); A(j,i) = t; } } // Add radialpart of non-time dependent potential here /* 2D radial for (int i=0; i<A.extent(0); i++) { A(i, i) += 0.25 / (r(i)*r(i)); } */ // Compute eigen decomposition BALANC[0] ='B'; JOBVL[0] ='V'; JOBVR[0] ='V'; SENSE[0] ='B'; LDA = Nm1; LDVL = Nm1; LDVR = Nm1; FORTRAN_NAME(dgeevx)(BALANC, JOBVL, JOBVR, SENSE, &Nm1, A.data(), &LDA, WR.data(), WI.data(), VL.data(), &LDVL, VR.data(), &LDVR, &ILO, &IHI, SCALE.data(), &ABNRM, RCONDE.data(), RCONDV.data(), WORK.data(), &LWORK, IWORK.data(), &INFO); // Compute the inverse of the eigen vector matrix NRHS = Nm1; evInv = VR ;// VL; LDB = LDA; B = 0.0; for (i=0; i<Nm1; i++) B(i,i) = 1.0; FORTRAN_NAME(dgesv)(&Nm1, &NRHS, evInv.data(), &LDA, IPIV.data(), B.data(), &LDB, &INFO); ev = VR(tensor::j, tensor::i); //Transpose evInv = B(tensor::j, tensor::i); //Transpose //cout << "Eigenvectors (right): " << ev << endl; //cout << "Eigenvectors (inv): " << evInv << endl; //printf(" Done inverse, INFO = %d \n", INFO); } // done
/* Subroutine */ int dhseqr_(char *job, char *compz, integer *n, integer *ilo, integer *ihi, doublereal *h, integer *ldh, doublereal *wr, doublereal *wi, doublereal *z, integer *ldz, doublereal *work, integer *lwork, integer *info) { /* -- LAPACK routine (version 2.0) -- Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., Courant Institute, Argonne National Lab, and Rice University September 30, 1994 Purpose ======= DHSEQR computes the eigenvalues of a real upper Hessenberg matrix H and, optionally, the matrices T and Z from the Schur decomposition H = Z T Z**T, where T is an upper quasi-triangular matrix (the Schur form), and Z is the orthogonal matrix of Schur vectors. Optionally Z may be postmultiplied into an input orthogonal matrix Q, so that this routine can give the Schur factorization of a matrix A which has been reduced to the Hessenberg form H by the orthogonal matrix Q: A = Q*H*Q**T = (QZ)*T*(QZ)**T. Arguments ========= JOB (input) CHARACTER*1 = 'E': compute eigenvalues only; = 'S': compute eigenvalues and the Schur form T. COMPZ (input) CHARACTER*1 = 'N': no Schur vectors are computed; = 'I': Z is initialized to the unit matrix and the matrix Z of Schur vectors of H is returned; = 'V': Z must contain an orthogonal matrix Q on entry, and the product Q*Z is returned. N (input) INTEGER The order of the matrix H. N >= 0. ILO (input) INTEGER IHI (input) INTEGER It is assumed that H is already upper triangular in rows and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally set by a previous call to DGEBAL, and then passed to SGEHRD when the matrix output by DGEBAL is reduced to Hessenberg form. Otherwise ILO and IHI should be set to 1 and N respectively. 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0. H (input/output) DOUBLE PRECISION array, dimension (LDH,N) On entry, the upper Hessenberg matrix H. On exit, if JOB = 'S', H contains the upper quasi-triangular matrix T from the Schur decomposition (the Schur form); 2-by-2 diagonal blocks (corresponding to complex conjugate pairs of eigenvalues) are returned in standard form, with H(i,i) = H(i+1,i+1) and H(i+1,i)*H(i,i+1) < 0. If JOB = 'E', the contents of H are unspecified on exit. LDH (input) INTEGER The leading dimension of the array H. LDH >= max(1,N). WR (output) DOUBLE PRECISION array, dimension (N) WI (output) DOUBLE PRECISION array, dimension (N) The real and imaginary parts, respectively, of the computed eigenvalues. If two eigenvalues are computed as a complex conjugate pair, they are stored in consecutive elements of WR and WI, say the i-th and (i+1)th, with WI(i) > 0 and WI(i+1) < 0. If JOB = 'S', the eigenvalues are stored in the same order as on the diagonal of the Schur form returned in H, with WR(i) = H(i,i) and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal block, WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i). Z (input/output) DOUBLE PRECISION array, dimension (LDZ,N) If COMPZ = 'N': Z is not referenced. If COMPZ = 'I': on entry, Z need not be set, and on exit, Z contains the orthogonal matrix Z of the Schur vectors of H. If COMPZ = 'V': on entry Z must contain an N-by-N matrix Q, which is assumed to be equal to the unit matrix except for the submatrix Z(ILO:IHI,ILO:IHI); on exit Z contains Q*Z. Normally Q is the orthogonal matrix generated by DORGHR after the call to DGEHRD which formed the Hessenberg matrix H. LDZ (input) INTEGER The leading dimension of the array Z. LDZ >= max(1,N) if COMPZ = 'I' or 'V'; LDZ >= 1 otherwise. WORK (workspace) DOUBLE PRECISION array, dimension (N) LWORK (input) INTEGER This argument is currently redundant. INFO (output) INTEGER = 0: successful exit < 0: if INFO = -i, the i-th argument had an illegal value > 0: if INFO = i, DHSEQR failed to compute all of the eigenvalues in a total of 30*(IHI-ILO+1) iterations; elements 1:ilo-1 and i+1:n of WR and WI contain those eigenvalues which have been successfully computed. ===================================================================== Decode and test the input parameters Parameter adjustments Function Body */ /* Table of constant values */ static doublereal c_b9 = 0.; static doublereal c_b10 = 1.; static integer c__4 = 4; static integer c_n1 = -1; static integer c__2 = 2; static integer c__8 = 8; static integer c__15 = 15; static logical c_false = FALSE_; static integer c__1 = 1; /* System generated locals */ address a__1[2]; integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3[2], i__4, i__5; doublereal d__1, d__2; char ch__1[2]; /* Builtin functions Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); /* Local variables */ static integer maxb; static doublereal absw; static integer ierr; static doublereal unfl, temp, ovfl; static integer i, j, k, l; static doublereal s[225] /* was [15][15] */, v[16]; extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *, integer *); extern logical lsame_(char *, char *); extern /* Subroutine */ int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *); static integer itemp; extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *); static integer i1, i2; static logical initz, wantt, wantz; extern doublereal dlapy2_(doublereal *, doublereal *); extern /* Subroutine */ int dlabad_(doublereal *, doublereal *); static integer ii, nh; extern doublereal dlamch_(char *); extern /* Subroutine */ int dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *); static integer nr, ns; extern integer idamax_(integer *, doublereal *, integer *); static integer nv; extern doublereal dlanhs_(char *, integer *, doublereal *, integer *, doublereal *); extern /* Subroutine */ int dlahqr_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, integer *, doublereal *, integer *, integer *); static doublereal vv[16]; extern /* Subroutine */ int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *, ftnlen, ftnlen); extern /* Subroutine */ int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), dlarfx_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *), xerbla_(char *, integer *); static doublereal smlnum; static integer itn; static doublereal tau; static integer its; static doublereal ulp, tst1; #define S(I) s[(I)] #define WAS(I) was[(I)] #define V(I) v[(I)] #define VV(I) vv[(I)] #define WR(I) wr[(I)-1] #define WI(I) wi[(I)-1] #define WORK(I) work[(I)-1] #define H(I,J) h[(I)-1 + ((J)-1)* ( *ldh)] #define Z(I,J) z[(I)-1 + ((J)-1)* ( *ldz)] wantt = lsame_(job, "S"); initz = lsame_(compz, "I"); wantz = initz || lsame_(compz, "V"); *info = 0; if (! lsame_(job, "E") && ! wantt) { *info = -1; } else if (! lsame_(compz, "N") && ! wantz) { *info = -2; } else if (*n < 0) { *info = -3; } else if (*ilo < 1 || *ilo > max(1,*n)) { *info = -4; } else if (*ihi < min(*ilo,*n) || *ihi > *n) { *info = -5; } else if (*ldh < max(1,*n)) { *info = -7; } else if (*ldz < 1 || wantz && *ldz < max(1,*n)) { *info = -11; } if (*info != 0) { i__1 = -(*info); xerbla_("DHSEQR", &i__1); return 0; } /* Initialize Z, if necessary */ if (initz) { dlaset_("Full", n, n, &c_b9, &c_b10, &Z(1,1), ldz); } /* Store the eigenvalues isolated by DGEBAL. */ i__1 = *ilo - 1; for (i = 1; i <= *ilo-1; ++i) { WR(i) = H(i,i); WI(i) = 0.; /* L10: */ } i__1 = *n; for (i = *ihi + 1; i <= *n; ++i) { WR(i) = H(i,i); WI(i) = 0.; /* L20: */ } /* Quick return if possible. */ if (*n == 0) { return 0; } if (*ilo == *ihi) { WR(*ilo) = H(*ilo,*ilo); WI(*ilo) = 0.; return 0; } /* Set rows and columns ILO to IHI to zero below the first subdiagonal. */ i__1 = *ihi - 2; for (j = *ilo; j <= *ihi-2; ++j) { i__2 = *n; for (i = j + 2; i <= *n; ++i) { H(i,j) = 0.; /* L30: */ } /* L40: */ } nh = *ihi - *ilo + 1; /* Determine the order of the multi-shift QR algorithm to be used. Writing concatenation */ i__3[0] = 1, a__1[0] = job; i__3[1] = 1, a__1[1] = compz; s_cat(ch__1, a__1, i__3, &c__2, 2L); ns = ilaenv_(&c__4, "DHSEQR", ch__1, n, ilo, ihi, &c_n1, 6L, 2L); /* Writing concatenation */ i__3[0] = 1, a__1[0] = job; i__3[1] = 1, a__1[1] = compz; s_cat(ch__1, a__1, i__3, &c__2, 2L); maxb = ilaenv_(&c__8, "DHSEQR", ch__1, n, ilo, ihi, &c_n1, 6L, 2L); if (ns <= 2 || ns > nh || maxb >= nh) { /* Use the standard double-shift algorithm */ dlahqr_(&wantt, &wantz, n, ilo, ihi, &H(1,1), ldh, &WR(1), &WI(1) , ilo, ihi, &Z(1,1), ldz, info); return 0; } maxb = max(3,maxb); /* Computing MIN */ i__1 = min(ns,maxb); ns = min(i__1,15); /* Now 2 < NS <= MAXB < NH. Set machine-dependent constants for the stopping criterion. If norm(H) <= sqrt(OVFL), overflow should not occur. */ unfl = dlamch_("Safe minimum"); ovfl = 1. / unfl; dlabad_(&unfl, &ovfl); ulp = dlamch_("Precision"); smlnum = unfl * (nh / ulp); /* I1 and I2 are the indices of the first row and last column of H to which transformations must be applied. If eigenvalues only are being computed, I1 and I2 are set inside the main loop. */ if (wantt) { i1 = 1; i2 = *n; } /* ITN is the total number of multiple-shift QR iterations allowed. */ itn = nh * 30; /* The main loop begins here. I is the loop index and decreases from IHI to ILO in steps of at most MAXB. Each iteration of the loop works with the active submatrix in rows and columns L to I. Eigenvalues I+1 to IHI have already converged. Either L = ILO or H(L,L-1) is negligible so that the matrix splits. */ i = *ihi; L50: l = *ilo; if (i < *ilo) { goto L170; } /* Perform multiple-shift QR iterations on rows and columns ILO to I until a submatrix of order at most MAXB splits off at the bottom because a subdiagonal element has become negligible. */ i__1 = itn; for (its = 0; its <= itn; ++its) { /* Look for a single small subdiagonal element. */ i__2 = l + 1; for (k = i; k >= l+1; --k) { tst1 = (d__1 = H(k-1,k-1), abs(d__1)) + (d__2 = H(k,k), abs(d__2)); if (tst1 == 0.) { i__4 = i - l + 1; tst1 = dlanhs_("1", &i__4, &H(l,l), ldh, &WORK(1)); } /* Computing MAX */ d__2 = ulp * tst1; if ((d__1 = H(k,k-1), abs(d__1)) <= max(d__2, smlnum)) { goto L70; } /* L60: */ } L70: l = k; if (l > *ilo) { /* H(L,L-1) is negligible. */ H(l,l-1) = 0.; } /* Exit from loop if a submatrix of order <= MAXB has split off . */ if (l >= i - maxb + 1) { goto L160; } /* Now the active submatrix is in rows and columns L to I. If eigenvalues only are being computed, only the active submatr ix need be transformed. */ if (! wantt) { i1 = l; i2 = i; } if (its == 20 || its == 30) { /* Exceptional shifts. */ i__2 = i; for (ii = i - ns + 1; ii <= i; ++ii) { WR(ii) = ((d__1 = H(ii,ii-1), abs(d__1)) + ( d__2 = H(ii,ii), abs(d__2))) * 1.5; WI(ii) = 0.; /* L80: */ } } else { /* Use eigenvalues of trailing submatrix of order NS as shifts. */ dlacpy_("Full", &ns, &ns, &H(i-ns+1,i-ns+1), ldh, s, &c__15); dlahqr_(&c_false, &c_false, &ns, &c__1, &ns, s, &c__15, &WR(i - ns + 1), &WI(i - ns + 1), &c__1, &ns, &Z(1,1), ldz, & ierr); if (ierr > 0) { /* If DLAHQR failed to compute all NS eigenvalues , use the unconverged diagonal elements as the remaining shifts. */ i__2 = ierr; for (ii = 1; ii <= ierr; ++ii) { WR(i - ns + ii) = S(ii + ii * 15 - 16); WI(i - ns + ii) = 0.; /* L90: */ } } } /* Form the first column of (G-w(1)) (G-w(2)) . . . (G-w(ns)) where G is the Hessenberg submatrix H(L:I,L:I) and w is the vector of shifts (stored in WR and WI). The result is stored in the local array V. */ V(0) = 1.; i__2 = ns + 1; for (ii = 2; ii <= ns+1; ++ii) { V(ii - 1) = 0.; /* L100: */ } nv = 1; i__2 = i; for (j = i - ns + 1; j <= i; ++j) { if (WI(j) >= 0.) { if (WI(j) == 0.) { /* real shift */ i__4 = nv + 1; dcopy_(&i__4, v, &c__1, vv, &c__1); i__4 = nv + 1; d__1 = -WR(j); dgemv_("No transpose", &i__4, &nv, &c_b10, &H(l,l), ldh, vv, &c__1, &d__1, v, &c__1); ++nv; } else if (WI(j) > 0.) { /* complex conjugate pair of shifts */ i__4 = nv + 1; dcopy_(&i__4, v, &c__1, vv, &c__1); i__4 = nv + 1; d__1 = WR(j) * -2.; dgemv_("No transpose", &i__4, &nv, &c_b10, &H(l,l), ldh, v, &c__1, &d__1, vv, &c__1); i__4 = nv + 1; itemp = idamax_(&i__4, vv, &c__1); /* Computing MAX */ d__2 = (d__1 = VV(itemp - 1), abs(d__1)); temp = 1. / max(d__2,smlnum); i__4 = nv + 1; dscal_(&i__4, &temp, vv, &c__1); absw = dlapy2_(&WR(j), &WI(j)); temp = temp * absw * absw; i__4 = nv + 2; i__5 = nv + 1; dgemv_("No transpose", &i__4, &i__5, &c_b10, &H(l,l), ldh, vv, &c__1, &temp, v, &c__1); nv += 2; } /* Scale V(1:NV) so that max(abs(V(i))) = 1. If V is zero, reset it to the unit vector. */ itemp = idamax_(&nv, v, &c__1); temp = (d__1 = V(itemp - 1), abs(d__1)); if (temp == 0.) { V(0) = 1.; i__4 = nv; for (ii = 2; ii <= nv; ++ii) { V(ii - 1) = 0.; /* L110: */ } } else { temp = max(temp,smlnum); d__1 = 1. / temp; dscal_(&nv, &d__1, v, &c__1); } } /* L120: */ } /* Multiple-shift QR step */ i__2 = i - 1; for (k = l; k <= i-1; ++k) { /* The first iteration of this loop determines a reflect ion G from the vector V and applies it from left and right to H, thus creating a nonzero bulge below the subdiagonal. Each subsequent iteration determines a reflection G t o restore the Hessenberg form in the (K-1)th column, an d thus chases the bulge one step toward the bottom of the ac tive submatrix. NR is the order of G. Computing MIN */ i__4 = ns + 1, i__5 = i - k + 1; nr = min(i__4,i__5); if (k > l) { dcopy_(&nr, &H(k,k-1), &c__1, v, &c__1); } dlarfg_(&nr, v, &V(1), &c__1, &tau); if (k > l) { H(k,k-1) = V(0); i__4 = i; for (ii = k + 1; ii <= i; ++ii) { H(ii,k-1) = 0.; /* L130: */ } } V(0) = 1.; /* Apply G from the left to transform the rows of the ma trix in columns K to I2. */ i__4 = i2 - k + 1; dlarfx_("Left", &nr, &i__4, v, &tau, &H(k,k), ldh, & WORK(1)); /* Apply G from the right to transform the columns of th e matrix in rows I1 to min(K+NR,I). Computing MIN */ i__5 = k + nr; i__4 = min(i__5,i) - i1 + 1; dlarfx_("Right", &i__4, &nr, v, &tau, &H(i1,k), ldh, & WORK(1)); if (wantz) { /* Accumulate transformations in the matrix Z */ dlarfx_("Right", &nh, &nr, v, &tau, &Z(*ilo,k), ldz, &WORK(1)); } /* L140: */ } /* L150: */ } /* Failure to converge in remaining number of iterations */ *info = i; return 0; L160: /* A submatrix of order <= MAXB in rows and columns L to I has split off. Use the double-shift QR algorithm to handle it. */ dlahqr_(&wantt, &wantz, n, &l, &i, &H(1,1), ldh, &WR(1), &WI(1), ilo, ihi, &Z(1,1), ldz, info); if (*info > 0) { return 0; } /* Decrement number of remaining iterations, and return to start of the main loop with a new value of I. */ itn -= its; i = l - 1; goto L50; L170: return 0; /* End of DHSEQR */ } /* dhseqr_ */
void WriteConfig() { WS(flac_cfg.title.tag_format); WI(flac_cfg.tag.reserve_space); WS(flac_cfg.title.sep); WI(flac_cfg.display.show_bps); WI(flac_cfg.output.misc.stop_err); WI(flac_cfg.output.replaygain.enable); WI(flac_cfg.output.replaygain.album_mode); WI(flac_cfg.output.replaygain.hard_limit); WI(flac_cfg.output.replaygain.preamp); WI(flac_cfg.output.resolution.normal.dither_24_to_16); WI(flac_cfg.output.resolution.replaygain.dither); WI(flac_cfg.output.resolution.replaygain.noise_shaping); WI(flac_cfg.output.resolution.replaygain.bps_out); }