OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
derrqr.f
Go to the documentation of this file.
1*> \brief \b DERRQR
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE DERRQR( PATH, NUNIT )
12*
13* .. Scalar Arguments ..
14* CHARACTER*3 PATH
15* INTEGER NUNIT
16* ..
17*
18*
19*> \par Purpose:
20* =============
21*>
22*> \verbatim
23*>
24*> DERRQR tests the error exits for the DOUBLE PRECISION routines
25*> that use the QR decomposition of a general matrix.
26*> \endverbatim
27*
28* Arguments:
29* ==========
30*
31*> \param[in] PATH
32*> \verbatim
33*> PATH is CHARACTER*3
34*> The LAPACK path name for the routines to be tested.
35*> \endverbatim
36*>
37*> \param[in] NUNIT
38*> \verbatim
39*> NUNIT is INTEGER
40*> The unit number for output.
41*> \endverbatim
42*
43* Authors:
44* ========
45*
46*> \author Univ. of Tennessee
47*> \author Univ. of California Berkeley
48*> \author Univ. of Colorado Denver
49*> \author NAG Ltd.
50*
51*> \ingroup double_lin
52*
53* =====================================================================
54 SUBROUTINE derrqr( PATH, NUNIT )
55*
56* -- LAPACK test routine --
57* -- LAPACK is a software package provided by Univ. of Tennessee, --
58* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59*
60* .. Scalar Arguments ..
61 CHARACTER*3 PATH
62 INTEGER NUNIT
63* ..
64*
65* =====================================================================
66*
67* .. Parameters ..
68 INTEGER NMAX
69 parameter( nmax = 2 )
70* ..
71* .. Local Scalars ..
72 INTEGER I, INFO, J
73* ..
74* .. Local Arrays ..
75 DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
76 $ W( NMAX ), X( NMAX )
77* ..
78* .. External Subroutines ..
79 EXTERNAL alaesm, chkxer, dgeqr2, dgeqr2p, dgeqrf,
80 $ dgeqrfp, dgeqrs, dorg2r, dorgqr, dorm2r,
81 $ dormqr
82* ..
83* .. Scalars in Common ..
84 LOGICAL LERR, OK
85 CHARACTER*32 SRNAMT
86 INTEGER INFOT, NOUT
87* ..
88* .. Common blocks ..
89 COMMON / infoc / infot, nout, ok, lerr
90 COMMON / srnamc / srnamt
91* ..
92* .. Intrinsic Functions ..
93 INTRINSIC dble
94* ..
95* .. Executable Statements ..
96*
97 nout = nunit
98 WRITE( nout, fmt = * )
99*
100* Set the variables to innocuous values.
101*
102 DO 20 j = 1, nmax
103 DO 10 i = 1, nmax
104 a( i, j ) = 1.d0 / dble( i+j )
105 af( i, j ) = 1.d0 / dble( i+j )
106 10 CONTINUE
107 b( j ) = 0.d0
108 w( j ) = 0.d0
109 x( j ) = 0.d0
110 20 CONTINUE
111 ok = .true.
112*
113* Error exits for QR factorization
114*
115* DGEQRF
116*
117 srnamt = 'DGEQRF'
118 infot = 1
119 CALL dgeqrf( -1, 0, a, 1, b, w, 1, info )
120 CALL chkxer( 'DGEQRF', infot, nout, lerr, ok )
121 infot = 2
122 CALL dgeqrf( 0, -1, a, 1, b, w, 1, info )
123 CALL chkxer( 'DGEQRF', infot, nout, lerr, ok )
124 infot = 4
125 CALL dgeqrf( 2, 1, a, 1, b, w, 1, info )
126 CALL chkxer( 'dgeqrf', INFOT, NOUT, LERR, OK )
127 INFOT = 7
128 CALL DGEQRF( 1, 2, A, 1, B, W, 1, INFO )
129 CALL CHKXER( 'dgeqrf', INFOT, NOUT, LERR, OK )
130*
131* DGEQRFP
132*
133 SRNAMT = 'dgeqrfp'
134 INFOT = 1
135 CALL DGEQRFP( -1, 0, A, 1, B, W, 1, INFO )
136 CALL CHKXER( 'dgeqrfp', INFOT, NOUT, LERR, OK )
137 INFOT = 2
138 CALL DGEQRFP( 0, -1, A, 1, B, W, 1, INFO )
139 CALL CHKXER( 'dgeqrfp', INFOT, NOUT, LERR, OK )
140 INFOT = 4
141 CALL DGEQRFP( 2, 1, A, 1, B, W, 1, INFO )
142 CALL CHKXER( 'dgeqrfp', INFOT, NOUT, LERR, OK )
143 INFOT = 7
144 CALL DGEQRFP( 1, 2, A, 1, B, W, 1, INFO )
145 CALL CHKXER( 'dgeqrfp', INFOT, NOUT, LERR, OK )
146*
147* DGEQR2
148*
149 SRNAMT = 'dgeqr2'
150 INFOT = 1
151 CALL DGEQR2( -1, 0, A, 1, B, W, INFO )
152 CALL CHKXER( 'dgeqr2', INFOT, NOUT, LERR, OK )
153 INFOT = 2
154 CALL DGEQR2( 0, -1, A, 1, B, W, INFO )
155 CALL CHKXER( 'dgeqr2', INFOT, NOUT, LERR, OK )
156 INFOT = 4
157 CALL DGEQR2( 2, 1, A, 1, B, W, INFO )
158 CALL CHKXER( 'dgeqr2', INFOT, NOUT, LERR, OK )
159*
160* DGEQR2P
161*
162 SRNAMT = 'dgeqr2p'
163 INFOT = 1
164 CALL DGEQR2P( -1, 0, A, 1, B, W, INFO )
165 CALL CHKXER( 'dgeqr2p', INFOT, NOUT, LERR, OK )
166 INFOT = 2
167 CALL DGEQR2P( 0, -1, A, 1, B, W, INFO )
168 CALL CHKXER( 'dgeqr2p', INFOT, NOUT, LERR, OK )
169 INFOT = 4
170 CALL DGEQR2P( 2, 1, A, 1, B, W, INFO )
171 CALL CHKXER( 'dgeqr2p', INFOT, NOUT, LERR, OK )
172*
173* DGEQRS
174*
175 SRNAMT = 'dgeqrs'
176 INFOT = 1
177 CALL DGEQRS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO )
178 CALL CHKXER( 'dgeqrs', INFOT, NOUT, LERR, OK )
179 INFOT = 2
180 CALL DGEQRS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO )
181 CALL CHKXER( 'dgeqrs', INFOT, NOUT, LERR, OK )
182 INFOT = 2
183 CALL DGEQRS( 1, 2, 0, A, 2, X, B, 2, W, 1, INFO )
184 CALL CHKXER( 'dgeqrs', INFOT, NOUT, LERR, OK )
185 INFOT = 3
186 CALL DGEQRS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO )
187 CALL CHKXER( 'dgeqrs', INFOT, NOUT, LERR, OK )
188 INFOT = 5
189 CALL DGEQRS( 2, 1, 0, A, 1, X, B, 2, W, 1, INFO )
190 CALL CHKXER( 'dgeqrs', INFOT, NOUT, LERR, OK )
191 INFOT = 8
192 CALL DGEQRS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO )
193 CALL CHKXER( 'dgeqrs', INFOT, NOUT, LERR, OK )
194 INFOT = 10
195 CALL DGEQRS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO )
196 CALL CHKXER( 'dgeqrs', INFOT, NOUT, LERR, OK )
197*
198* DORGQR
199*
200 SRNAMT = 'dorgqr'
201 INFOT = 1
202 CALL DORGQR( -1, 0, 0, A, 1, X, W, 1, INFO )
203 CALL CHKXER( 'dorgqr', INFOT, NOUT, LERR, OK )
204 INFOT = 2
205 CALL DORGQR( 0, -1, 0, A, 1, X, W, 1, INFO )
206 CALL CHKXER( 'dorgqr', INFOT, NOUT, LERR, OK )
207 INFOT = 2
208 CALL DORGQR( 1, 2, 0, A, 1, X, W, 2, INFO )
209 CALL CHKXER( 'dorgqr', INFOT, NOUT, LERR, OK )
210 INFOT = 3
211 CALL DORGQR( 0, 0, -1, A, 1, X, W, 1, INFO )
212 CALL CHKXER( 'dorgqr', INFOT, NOUT, LERR, OK )
213 INFOT = 3
214 CALL DORGQR( 1, 1, 2, A, 1, X, W, 1, INFO )
215 CALL CHKXER( 'dorgqr', INFOT, NOUT, LERR, OK )
216 INFOT = 5
217 CALL DORGQR( 2, 2, 0, A, 1, X, W, 2, INFO )
218 CALL CHKXER( 'dorgqr', INFOT, NOUT, LERR, OK )
219 INFOT = 8
220 CALL DORGQR( 2, 2, 0, A, 2, X, W, 1, INFO )
221 CALL CHKXER( 'dorgqr', INFOT, NOUT, LERR, OK )
222*
223* DORG2R
224*
225 SRNAMT = 'dorg2r'
226 INFOT = 1
227 CALL DORG2R( -1, 0, 0, A, 1, X, W, INFO )
228 CALL CHKXER( 'dorg2r', INFOT, NOUT, LERR, OK )
229 INFOT = 2
230 CALL DORG2R( 0, -1, 0, A, 1, X, W, INFO )
231 CALL CHKXER( 'dorg2r', INFOT, NOUT, LERR, OK )
232 INFOT = 2
233 CALL DORG2R( 1, 2, 0, A, 1, X, W, INFO )
234 CALL CHKXER( 'dorg2r', INFOT, NOUT, LERR, OK )
235 INFOT = 3
236 CALL DORG2R( 0, 0, -1, A, 1, X, W, INFO )
237 CALL CHKXER( 'dorg2r', INFOT, NOUT, LERR, OK )
238 INFOT = 3
239 CALL DORG2R( 2, 1, 2, A, 2, X, W, INFO )
240 CALL CHKXER( 'dorg2r', INFOT, NOUT, LERR, OK )
241 INFOT = 5
242 CALL DORG2R( 2, 1, 0, A, 1, X, W, INFO )
243 CALL CHKXER( 'dorg2r', INFOT, NOUT, LERR, OK )
244*
245* DORMQR
246*
247 SRNAMT = 'dormqr'
248 INFOT = 1
249 CALL DORMQR( '/', 'n', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
250 CALL CHKXER( 'dormqr', INFOT, NOUT, LERR, OK )
251 INFOT = 2
252 CALL DORMQR( 'l', '/', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
253 CALL CHKXER( 'dormqr', INFOT, NOUT, LERR, OK )
254 INFOT = 3
255 CALL DORMQR( 'l', 'n', -1, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
256 CALL CHKXER( 'dormqr', infot, nout, lerr, ok )
257 infot = 4
258 CALL dormqr( 'L', 'N', 0, -1, 0, a, 1, x, af, 1, w, 1, info )
259 CALL chkxer( 'DORMQR', infot, nout, lerr, ok )
260 infot = 5
261 CALL dormqr( 'L', 'N', 0, 0, -1, a, 1, x, af, 1, w, 1, info )
262 CALL chkxer( 'DORMQR', infot, nout, lerr, ok )
263 infot = 5
264 CALL dormqr( 'L', 'N', 0, 1, 1, a, 1, x, af, 1, w, 1, info )
265 CALL chkxer( 'DORMQR', infot, nout, lerr, ok )
266 infot = 5
267 CALL dormqr( 'R', 'N', 1, 0, 1, a, 1, x, af, 1, w, 1, info )
268 CALL chkxer( 'DORMQR', infot, nout, lerr, ok )
269 infot = 7
270 CALL dormqr( 'L', 'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
271 CALL chkxer( 'DORMQR', infot, nout, lerr, ok )
272 infot = 7
273 CALL dormqr( 'R', 'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
274 CALL chkxer( 'DORMQR', infot, nout, lerr, ok )
275 infot = 10
276 CALL dormqr( 'L', 'N', 2, 1, 0, a, 2, x, af, 1, w, 1, info )
277 CALL chkxer( 'DORMQR', infot, nout, lerr, ok )
278 infot = 12
279 CALL dormqr( 'L', 'N', 1, 2, 0, a, 1, x, af, 1, w, 1, info )
280 CALL chkxer( 'DORMQR', infot, nout, lerr, ok )
281 infot = 12
282 CALL dormqr( 'R', 'N', 2, 1, 0, a, 1, x, af, 2, w, 1, info )
283 CALL chkxer( 'DORMQR', infot, nout, lerr, ok )
284*
285* DORM2R
286*
287 srnamt = 'DORM2R'
288 infot = 1
289 CALL dorm2r( '/', 'N', 0, 0, 0, a, 1, x, af, 1, w, info )
290 CALL chkxer( 'DORM2R', infot, nout, lerr, ok )
291 infot = 2
292 CALL dorm2r( 'L', '/', 0, 0, 0, a, 1, x, af, 1, w, info )
293 CALL chkxer( 'DORM2R', infot, nout, lerr, ok )
294 infot = 3
295 CALL dorm2r( 'L', 'N', -1, 0, 0, a, 1, x, af, 1, w, info )
296 CALL chkxer( 'DORM2R', infot, nout, lerr, ok )
297 infot = 4
298 CALL dorm2r( 'L', 'N', 0, -1, 0, a, 1, x, af, 1, w, info )
299 CALL chkxer( 'DORM2R', infot, nout, lerr, ok )
300 infot = 5
301 CALL dorm2r( 'L', 'N', 0, 0, -1, a, 1, x, af, 1, w, info )
302 CALL chkxer( 'DORM2R', infot, nout, lerr, ok )
303 infot = 5
304 CALL dorm2r( 'L', 'N', 0, 1, 1, a, 1, x, af, 1, w, info )
305 CALL chkxer( 'DORM2R', infot, nout, lerr, ok )
306 infot = 5
307 CALL dorm2r( 'R', 'N', 1, 0, 1, a, 1, x, af, 1, w, info )
308 CALL chkxer( 'DORM2R', infot, nout, lerr, ok )
309 infot = 7
310 CALL dorm2r( 'L', 'N', 2, 1, 0, a, 1, x, af, 2, w, info )
311 CALL chkxer( 'DORM2R', infot, nout, lerr, ok )
312 infot = 7
313 CALL dorm2r( 'R', 'N', 1, 2, 0, a, 1, x, af, 1, w, info )
314 CALL chkxer( 'DORM2R', infot, nout, lerr, ok )
315 infot = 10
316 CALL dorm2r( 'L', 'N', 2, 1, 0, a, 2, x, af, 1, w, info )
317 CALL chkxer( 'DORM2R', infot, nout, lerr, ok )
318*
319* Print a summary line.
320*
321 CALL alaesm( path, ok, nout )
322*
323 RETURN
324*
325* End of DERRQR
326*
327 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
dgeqr2
subroutine dgeqr2(m, n, a, lda, tau, work, info)
DGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm.
Definition dgeqr2.f:130
dgeqr2p
subroutine dgeqr2p(m, n, a, lda, tau, work, info)
DGEQR2P computes the QR factorization of a general rectangular matrix with non-negative diagonal elem...
Definition dgeqr2p.f:134
dgeqrfp
subroutine dgeqrfp(m, n, a, lda, tau, work, lwork, info)
DGEQRFP
Definition dgeqrfp.f:149
dgeqrf
subroutine dgeqrf(m, n, a, lda, tau, work, lwork, info)
DGEQRF
Definition dgeqrf.f:146
dorm2r
subroutine dorm2r(side, trans, m, n, k, a, lda, tau, c, ldc, work, info)
DORM2R multiplies a general matrix by the orthogonal matrix from a QR factorization determined by sge...
Definition dorm2r.f:159
dormqr
subroutine dormqr(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
DORMQR
Definition dormqr.f:167
dorg2r
subroutine dorg2r(m, n, k, a, lda, tau, work, info)
DORG2R generates all or part of the orthogonal matrix Q from a QR factorization determined by sgeqrf ...
Definition dorg2r.f:114
dorgqr
subroutine dorgqr(m, n, k, a, lda, tau, work, lwork, info)
DORGQR
Definition dorgqr.f:128
dgeqrs
subroutine dgeqrs(m, n, nrhs, a, lda, tau, b, ldb, work, lwork, info)
DGEQRS
Definition dgeqrs.f:121
derrqr
subroutine derrqr(path, nunit)
DERRQR
Definition derrqr.f:55