Mercurial > hg > octave-nkf

comparison liboctave/dbleQRP.cc @ 7482:29980c6b8604

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 445d27d79f4e
comparison
equal deleted inserted replaced
7481:78f3811155f7 7482:29980c6b8604
86 86
87 // Code to enforce a certain permutation could go here... 87 // Code to enforce a certain permutation could go here...
88 88
89 F77_XFCN (dgeqpf, DGEQPF, (m, n, tmp_data, m, pjpvt, ptau, pwork, info)); 89 F77_XFCN (dgeqpf, DGEQPF, (m, n, tmp_data, m, pjpvt, ptau, pwork, info));
90 90
91 if (f77_exception_encountered) 91 // Form Permutation matrix (if economy is requested, return the
92 (*current_liboctave_error_handler) ("unrecoverable error in dgeqpf"); 92 // indices only!)
93
94 if (qr_type == QR::economy)
95 {
96 p.resize (1, n, 0.0);
97 for (octave_idx_type j = 0; j < n; j++)
98 p.elem (0, j) = jpvt.elem (j);
99 }
93 else 100 else
94 { 101 {
95 // Form Permutation matrix (if economy is requested, return the 102 p.resize (n, n, 0.0);
96 // indices only!) 103 for (octave_idx_type j = 0; j < n; j++)
104 p.elem (jpvt.elem (j) - 1, j) = 1.0;
105 }
97 106
98 if (qr_type == QR::economy) 107 octave_idx_type n2 = (qr_type == QR::economy) ? min_mn : m;
99 {
100 p.resize (1, n, 0.0);
101 for (octave_idx_type j = 0; j < n; j++)
102 p.elem (0, j) = jpvt.elem (j);
103 }
104 else
105 {
106 p.resize (n, n, 0.0);
107 for (octave_idx_type j = 0; j < n; j++)
108 p.elem (jpvt.elem (j) - 1, j) = 1.0;
109 }
110 108
111 octave_idx_type n2 = (qr_type == QR::economy) ? min_mn : m; 109 if (qr_type == QR::economy && m > n)
110 r.resize (n, n, 0.0);
111 else
112 r.resize (m, n, 0.0);
112 113
113 if (qr_type == QR::economy && m > n) 114 for (octave_idx_type j = 0; j < n; j++)
114 r.resize (n, n, 0.0); 115 {
115 else 116 octave_idx_type limit = j < min_mn-1 ? j : min_mn-1;
116 r.resize (m, n, 0.0); 117 for (octave_idx_type i = 0; i <= limit; i++)
118 r.elem (i, j) = A_fact.elem (i, j);
119 }
117 120
118 for (octave_idx_type j = 0; j < n; j++) 121 F77_XFCN (dorgqr, DORGQR, (m, n2, min_mn, tmp_data, m, ptau,
119 { 122 pwork, lwork, info));
120 octave_idx_type limit = j < min_mn-1 ? j : min_mn-1;
121 for (octave_idx_type i = 0; i <= limit; i++)
122 r.elem (i, j) = A_fact.elem (i, j);
123 }
124 123
125 F77_XFCN (dorgqr, DORGQR, (m, n2, min_mn, tmp_data, m, ptau, 124 q = A_fact;
126 pwork, lwork, info)); 125 q.resize (m, n2);
127
128 if (f77_exception_encountered)
129 (*current_liboctave_error_handler) ("unrecoverable error in dorgqr");
130 else
131 {
132 q = A_fact;
133 q.resize (m, n2);
134 }
135 }
136 } 126 }
137 127
138 /* 128 /*
139 ;;; Local Variables: *** 129 ;;; Local Variables: ***
140 ;;; mode: C++ *** 130 ;;; mode: C++ ***