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: ***