OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
zerrqr.f
Go to the documentation of this file.
1*> \brief \b ZERRQR
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 ZERRQR( 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*> ZERRQR tests the error exits for the COMPLEX*16 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 complex16_lin
52*
53* =====================================================================
54 SUBROUTINE zerrqr( 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 COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
76 $ W( NMAX ), X( NMAX )
77* ..
78* .. External Subroutines ..
79 EXTERNAL alaesm, chkxer, zgeqr2, zgeqr2p, zgeqrf,
80 $ zgeqrfp, zgeqrs, zung2r, zungqr, zunm2r,
81 $ zunmqr
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, dcmplx
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 ) = dcmplx( 1.d0 / dble( i+j ),
105 $ -1.d0 / dble( i+j ) )
106 af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
107 $ -1.d0 / dble( i+j ) )
108 10 CONTINUE
109 b( j ) = 0.d0
110 w( j ) = 0.d0
111 x( j ) = 0.d0
112 20 CONTINUE
113 ok = .true.
114*
115* Error exits for QR factorization
116*
117* ZGEQRF
118*
119 srnamt = 'ZGEQRF'
120 infot = 1
121 CALL zgeqrf( -1, 0, a, 1, b, w, 1, info )
122 CALL chkxer( 'ZGEQRF', infot, nout, lerr, ok )
123 infot = 2
124 CALL zgeqrf( 0, -1, a, 1, b, w, 1, info )
125 CALL chkxer( 'ZGEQRF', infot, nout, lerr, ok )
126 infot = 4
127 CALL zgeqrf( 2, 1, a, 1, b, w, 1, info )
128 CALL chkxer( 'ZGEQRF', infot, nout, lerr, ok )
129 infot = 7
130 CALL zgeqrf( 1, 2, a, 1, b, w, 1, info )
131 CALL chkxer( 'ZGEQRF', infot, nout, lerr, ok )
132*
133* ZGEQRFP
134*
135 srnamt = 'ZGEQRFP'
136 infot = 1
137 CALL zgeqrfp( -1, 0, a, 1, b, w, 1, info )
138 CALL chkxer( 'ZGEQRFP', infot, nout, lerr, ok )
139 infot = 2
140 CALL zgeqrfp( 0, -1, a, 1, b, w, 1, info )
141 CALL chkxer( 'ZGEQRFP', infot, nout, lerr, ok )
142 infot = 4
143 CALL zgeqrfp( 2, 1, a, 1, b, w, 1, info )
144 CALL chkxer( 'ZGEQRFP', infot, nout, lerr, ok )
145 infot = 7
146 CALL zgeqrfp( 1, 2, a, 1, b, w, 1, info )
147 CALL chkxer( 'ZGEQRFP', infot, nout, lerr, ok )
148*
149* ZGEQR2
150*
151 srnamt = 'ZGEQR2'
152 infot = 1
153 CALL zgeqr2( -1, 0, a, 1, b, w, info )
154 CALL chkxer( 'ZGEQR2', infot, nout, lerr, ok )
155 infot = 2
156 CALL zgeqr2( 0, -1, a, 1, b, w, info )
157 CALL chkxer( 'ZGEQR2', infot, nout, lerr, ok )
158 infot = 4
159 CALL zgeqr2( 2, 1, a, 1, b, w, info )
160 CALL chkxer( 'ZGEQR2', infot, nout, lerr, ok )
161*
162* ZGEQR2P
163*
164 srnamt = 'ZGEQR2P'
165 infot = 1
166 CALL zgeqr2p( -1, 0, a, 1, b, w, info )
167 CALL chkxer( 'ZGEQR2P', infot, nout, lerr, ok )
168 infot = 2
169 CALL zgeqr2p( 0, -1, a, 1, b, w, info )
170 CALL chkxer( 'ZGEQR2P', infot, nout, lerr, ok )
171 infot = 4
172 CALL zgeqr2p( 2, 1, a, 1, b, w, info )
173 CALL chkxer( 'ZGEQR2P', infot, nout, lerr, ok )
174*
175* ZGEQRS
176*
177 srnamt = 'ZGEQRS'
178 infot = 1
179 CALL zgeqrs( -1, 0, 0, a, 1, x, b, 1, w, 1, info )
180 CALL chkxer( 'ZGEQRS', infot, nout, lerr, ok )
181 infot = 2
182 CALL zgeqrs( 0, -1, 0, a, 1, x, b, 1, w, 1, info )
183 CALL chkxer( 'ZGEQRS', infot, nout, lerr, ok )
184 infot = 2
185 CALL zgeqrs( 1, 2, 0, a, 2, x, b, 2, w, 1, info )
186 CALL chkxer( 'ZGEQRS', infot, nout, lerr, ok )
187 infot = 3
188 CALL zgeqrs( 0, 0, -1, a, 1, x, b, 1, w, 1, info )
189 CALL chkxer( 'ZGEQRS', infot, nout, lerr, ok )
190 infot = 5
191 CALL zgeqrs( 2, 1, 0, a, 1, x, b, 2, w, 1, info )
192 CALL chkxer( 'ZGEQRS', infot, nout, lerr, ok )
193 infot = 8
194 CALL zgeqrs( 2, 1, 0, a, 2, x, b, 1, w, 1, info )
195 CALL chkxer( 'ZGEQRS', infot, nout, lerr, ok )
196 infot = 10
197 CALL zgeqrs( 1, 1, 2, a, 1, x, b, 1, w, 1, info )
198 CALL chkxer( 'ZGEQRS', infot, nout, lerr, ok )
199*
200* ZUNGQR
201*
202 srnamt = 'ZUNGQR'
203 infot = 1
204 CALL zungqr( -1, 0, 0, a, 1, x, w, 1, info )
205 CALL chkxer( 'ZUNGQR', infot, nout, lerr, ok )
206 infot = 2
207 CALL zungqr( 0, -1, 0, a, 1, x, w, 1, info )
208 CALL chkxer( 'ZUNGQR', infot, nout, lerr, ok )
209 infot = 2
210 CALL zungqr( 1, 2, 0, a, 1, x, w, 2, info )
211 CALL chkxer( 'ZUNGQR', infot, nout, lerr, ok )
212 infot = 3
213 CALL zungqr( 0, 0, -1, a, 1, x, w, 1, info )
214 CALL chkxer( 'ZUNGQR', infot, nout, lerr, ok )
215 infot = 3
216 CALL zungqr( 1, 1, 2, a, 1, x, w, 1, info )
217 CALL chkxer( 'ZUNGQR', infot, nout, lerr, ok )
218 infot = 5
219 CALL zungqr( 2, 2, 0, a, 1, x, w, 2, info )
220 CALL chkxer( 'ZUNGQR', infot, nout, lerr, ok )
221 infot = 8
222 CALL zungqr( 2, 2, 0, a, 2, x, w, 1, info )
223 CALL chkxer( 'ZUNGQR', infot, nout, lerr, ok )
224*
225* ZUNG2R
226*
227 srnamt = 'ZUNG2R'
228 infot = 1
229 CALL zung2r( -1, 0, 0, a, 1, x, w, info )
230 CALL chkxer( 'ZUNG2R', infot, nout, lerr, ok )
231 infot = 2
232 CALL zung2r( 0, -1, 0, a, 1, x, w, info )
233 CALL chkxer( 'ZUNG2R', infot, nout, lerr, ok )
234 infot = 2
235 CALL zung2r( 1, 2, 0, a, 1, x, w, info )
236 CALL chkxer( 'ZUNG2R', infot, nout, lerr, ok )
237 infot = 3
238 CALL zung2r( 0, 0, -1, a, 1, x, w, info )
239 CALL chkxer( 'ZUNG2R', infot, nout, lerr, ok )
240 infot = 3
241 CALL zung2r( 2, 1, 2, a, 2, x, w, info )
242 CALL chkxer( 'ZUNG2R', infot, nout, lerr, ok )
243 infot = 5
244 CALL zung2r( 2, 1, 0, a, 1, x, w, info )
245 CALL chkxer( 'ZUNG2R', infot, nout, lerr, ok )
246*
247* ZUNMQR
248*
249 srnamt = 'ZUNMQR'
250 infot = 1
251 CALL zunmqr( '/', 'N', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
252 CALL chkxer( 'ZUNMQR', infot, nout, lerr, ok )
253 infot = 2
254 CALL zunmqr( 'L', '/', 0, 0, 0, a, 1, x, af, 1, w, 1, info )
255 CALL chkxer( 'ZUNMQR', infot, nout, lerr, ok )
256 infot = 3
257 CALL zunmqr( 'L', 'N', -1, 0, 0, a, 1, x, af, 1, w, 1, info )
258 CALL chkxer( 'ZUNMQR', infot, nout, lerr, ok )
259 infot = 4
260 CALL zunmqr( 'L', 'N', 0, -1, 0, a, 1, x, af, 1, w, 1, info )
261 CALL chkxer( 'ZUNMQR', infot, nout, lerr, ok )
262 infot = 5
263 CALL zunmqr( 'L', 'N', 0, 0, -1, a, 1, x, af, 1, w, 1, info )
264 CALL chkxer( 'ZUNMQR', infot, nout, lerr, ok )
265 infot = 5
266 CALL zunmqr( 'L', 'n', 0, 1, 1, A, 1, X, AF, 1, W, 1, INFO )
267 CALL CHKXER( 'zunmqr', INFOT, NOUT, LERR, OK )
268 INFOT = 5
269 CALL ZUNMQR( 'r', 'n', 1, 0, 1, A, 1, X, AF, 1, W, 1, INFO )
270 CALL CHKXER( 'zunmqr', INFOT, NOUT, LERR, OK )
271 INFOT = 7
272 CALL ZUNMQR( 'l', 'n', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO )
273 CALL CHKXER( 'zunmqr', INFOT, NOUT, LERR, OK )
274 INFOT = 7
275 CALL ZUNMQR( 'r', 'n', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO )
276 CALL CHKXER( 'zunmqr', INFOT, NOUT, LERR, OK )
277 INFOT = 10
278 CALL ZUNMQR( 'l', 'n', 2, 1, 0, A, 2, X, AF, 1, W, 1, INFO )
279 CALL CHKXER( 'zunmqr', INFOT, NOUT, LERR, OK )
280 INFOT = 12
281 CALL ZUNMQR( 'l', 'n', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO )
282 CALL CHKXER( 'zunmqr', INFOT, NOUT, LERR, OK )
283 INFOT = 12
284 CALL ZUNMQR( 'r', 'n', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO )
285 CALL CHKXER( 'zunmqr', INFOT, NOUT, LERR, OK )
286*
287* ZUNM2R
288*
289 SRNAMT = 'zunm2r'
290 INFOT = 1
291 CALL ZUNM2R( '/', 'n', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
292 CALL CHKXER( 'zunm2r', INFOT, NOUT, LERR, OK )
293 INFOT = 2
294 CALL ZUNM2R( 'l', '/', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
295 CALL CHKXER( 'zunm2r', INFOT, NOUT, LERR, OK )
296 INFOT = 3
297 CALL ZUNM2R( 'l', 'n', -1, 0, 0, A, 1, X, AF, 1, W, INFO )
298 CALL CHKXER( 'zunm2r', INFOT, NOUT, LERR, OK )
299 INFOT = 4
300 CALL ZUNM2R( 'l', 'n', 0, -1, 0, A, 1, X, AF, 1, W, INFO )
301 CALL CHKXER( 'zunm2r', INFOT, NOUT, LERR, OK )
302 INFOT = 5
303 CALL ZUNM2R( 'l', 'n', 0, 0, -1, A, 1, X, AF, 1, W, INFO )
304 CALL CHKXER( 'zunm2r', INFOT, NOUT, LERR, OK )
305 INFOT = 5
306 CALL ZUNM2R( 'l', 'n', 0, 1, 1, A, 1, X, AF, 1, W, INFO )
307 CALL CHKXER( 'zunm2r', INFOT, NOUT, LERR, OK )
308 INFOT = 5
309 CALL ZUNM2R( 'r', 'n', 1, 0, 1, A, 1, X, AF, 1, W, INFO )
310 CALL CHKXER( 'zunm2r', INFOT, NOUT, LERR, OK )
311 INFOT = 7
312 CALL ZUNM2R( 'l', 'n', 2, 1, 0, A, 1, X, AF, 2, W, INFO )
313 CALL CHKXER( 'zunm2r', INFOT, NOUT, LERR, OK )
314 INFOT = 7
315 CALL ZUNM2R( 'r', 'n', 1, 2, 0, A, 1, X, AF, 1, W, INFO )
316 CALL CHKXER( 'zunm2r', INFOT, NOUT, LERR, OK )
317 INFOT = 10
318 CALL ZUNM2R( 'l', 'n', 2, 1, 0, A, 2, X, AF, 1, W, INFO )
319 CALL CHKXER( 'zunm2r', INFOT, NOUT, LERR, OK )
320*
321* Print a summary line.
322*
323 CALL ALAESM( PATH, OK, NOUT )
324*
325 RETURN
326*
327* End of ZERRQR
328*
329 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
zgeqr2
subroutine zgeqr2(m, n, a, lda, tau, work, info)
ZGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm.
Definition zgeqr2.f:130
zgeqrfp
subroutine zgeqrfp(m, n, a, lda, tau, work, lwork, info)
ZGEQRFP
Definition zgeqrfp.f:149
zgeqr2p
subroutine zgeqr2p(m, n, a, lda, tau, work, info)
ZGEQR2P computes the QR factorization of a general rectangular matrix with non-negative diagonal elem...
Definition zgeqr2p.f:134
zunm2r
subroutine zunm2r(side, trans, m, n, k, a, lda, tau, c, ldc, work, info)
ZUNM2R multiplies a general matrix by the unitary matrix from a QR factorization determined by cgeqrf...
Definition zunm2r.f:159
zunmqr
subroutine zunmqr(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
ZUNMQR
Definition zunmqr.f:167
zungqr
subroutine zungqr(m, n, k, a, lda, tau, work, lwork, info)
ZUNGQR
Definition zungqr.f:128
zung2r
subroutine zung2r(m, n, k, a, lda, tau, work, info)
ZUNG2R
Definition zung2r.f:114
zgeqrs
subroutine zgeqrs(m, n, nrhs, a, lda, tau, b, ldb, work, lwork, info)
ZGEQRS
Definition zgeqrs.f:121
zerrqr
subroutine zerrqr(path, nunit)
ZERRQR
Definition zerrqr.f:55
zgeqrf
subroutine zgeqrf(m, n, a, lda, tau, work, lwork, info)
ZGEQRF VARIANT: left-looking Level 3 BLAS of the algorithm.
Definition zgeqrf.f:151