Mercurial > hg > octave-jordi
comparison liboctave/dbleQR.cc @ 7482:29980c6b8604
don't check f77_exception_encountered
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Thu, 14 Feb 2008 21:57:50 -0500 |
parents | a1dbe9d80eee |
children | 56be6f31dd4e |
comparison
equal
deleted
inserted
replaced
7481:78f3811155f7 | 7482:29980c6b8604 |
---|---|
74 | 74 |
75 double *tmp_data = A_fact.fortran_vec (); | 75 double *tmp_data = A_fact.fortran_vec (); |
76 | 76 |
77 F77_XFCN (dgeqrf, DGEQRF, (m, n, tmp_data, m, ptau, pwork, lwork, info)); | 77 F77_XFCN (dgeqrf, DGEQRF, (m, n, tmp_data, m, ptau, pwork, lwork, info)); |
78 | 78 |
79 if (f77_exception_encountered) | 79 if (qr_type == QR::raw) |
80 (*current_liboctave_error_handler) ("unrecoverable error in dgeqrf"); | 80 { |
81 for (octave_idx_type j = 0; j < min_mn; j++) | |
82 { | |
83 octave_idx_type limit = j < min_mn - 1 ? j : min_mn - 1; | |
84 for (octave_idx_type i = limit + 1; i < m; i++) | |
85 A_fact.elem (i, j) *= tau.elem (j); | |
86 } | |
87 | |
88 r = A_fact; | |
89 | |
90 if (m > n) | |
91 r.resize (m, n); | |
92 } | |
81 else | 93 else |
82 { | 94 { |
83 if (qr_type == QR::raw) | 95 octave_idx_type n2 = (qr_type == QR::economy) ? min_mn : m; |
96 | |
97 if (qr_type == QR::economy && m > n) | |
98 r.resize (n, n, 0.0); | |
99 else | |
100 r.resize (m, n, 0.0); | |
101 | |
102 for (octave_idx_type j = 0; j < n; j++) | |
84 { | 103 { |
85 for (octave_idx_type j = 0; j < min_mn; j++) | 104 octave_idx_type limit = j < min_mn-1 ? j : min_mn-1; |
86 { | 105 for (octave_idx_type i = 0; i <= limit; i++) |
87 octave_idx_type limit = j < min_mn - 1 ? j : min_mn - 1; | 106 r.elem (i, j) = tmp_data[m*j+i]; |
88 for (octave_idx_type i = limit + 1; i < m; i++) | 107 } |
89 A_fact.elem (i, j) *= tau.elem (j); | |
90 } | |
91 | 108 |
92 r = A_fact; | 109 lwork = 32 * n2; |
110 work.resize (lwork); | |
111 double *pwork2 = work.fortran_vec (); | |
93 | 112 |
94 if (m > n) | 113 F77_XFCN (dorgqr, DORGQR, (m, n2, min_mn, tmp_data, m, ptau, |
95 r.resize (m, n); | 114 pwork2, lwork, info)); |
96 } | |
97 else | |
98 { | |
99 octave_idx_type n2 = (qr_type == QR::economy) ? min_mn : m; | |
100 | 115 |
101 if (qr_type == QR::economy && m > n) | 116 q = A_fact; |
102 r.resize (n, n, 0.0); | 117 q.resize (m, n2); |
103 else | |
104 r.resize (m, n, 0.0); | |
105 | |
106 for (octave_idx_type j = 0; j < n; j++) | |
107 { | |
108 octave_idx_type limit = j < min_mn-1 ? j : min_mn-1; | |
109 for (octave_idx_type i = 0; i <= limit; i++) | |
110 r.elem (i, j) = tmp_data[m*j+i]; | |
111 } | |
112 | |
113 lwork = 32 * n2; | |
114 work.resize (lwork); | |
115 double *pwork2 = work.fortran_vec (); | |
116 | |
117 F77_XFCN (dorgqr, DORGQR, (m, n2, min_mn, tmp_data, m, ptau, | |
118 pwork2, lwork, info)); | |
119 | |
120 if (f77_exception_encountered) | |
121 (*current_liboctave_error_handler) | |
122 ("unrecoverable error in dorgqr"); | |
123 else | |
124 { | |
125 q = A_fact; | |
126 q.resize (m, n2); | |
127 } | |
128 } | |
129 } | 118 } |
130 } | 119 } |
131 | 120 |
132 /* | 121 /* |
133 ;;; Local Variables: *** | 122 ;;; Local Variables: *** |