OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
zerrql.f
Go to the documentation of this file.
1*> \brief \b ZERRQL
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 ZERRQL( 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*> ZERRQL tests the error exits for the COMPLEX*16 routines
25*> that use the QL 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 zerrql( 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, zgeql2, zgeqlf, zgeqls, zung2l,
80 $ zungql, zunm2l, zunmql
81* ..
82* .. Scalars in Common ..
83 LOGICAL LERR, OK
84 CHARACTER*32 SRNAMT
85 INTEGER INFOT, NOUT
86* ..
87* .. Common blocks ..
88 COMMON / infoc / infot, nout, ok, lerr
89 COMMON / srnamc / srnamt
90* ..
91* .. Intrinsic Functions ..
92 INTRINSIC dble, dcmplx
93* ..
94* .. Executable Statements ..
95*
96 nout = nunit
97 WRITE( nout, fmt = * )
98*
99* Set the variables to innocuous values.
100*
101 DO 20 j = 1, nmax
102 DO 10 i = 1, nmax
103 a( i, j ) = dcmplx( 1.d0 / dble( i+j ),
104 $ -1.d0 / dble( i+j ) )
105 af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
106 $ -1.d0 / dble( i+j ) )
107 10 CONTINUE
108 b( j ) = 0.d0
109 w( j ) = 0.d0
110 x( j ) = 0.d0
111 20 CONTINUE
112 ok = .true.
113*
114* Error exits for QL factorization
115*
116* ZGEQLF
117*
118 srnamt = 'ZGEQLF'
119 infot = 1
120 CALL zgeqlf( -1, 0, a, 1, b, w, 1, info )
121 CALL chkxer( 'ZGEQLF', infot, nout, lerr, ok )
122 infot = 2
123 CALL zgeqlf( 0, -1, a, 1, b, w, 1, info )
124 CALL chkxer( 'zgeqlf', INFOT, NOUT, LERR, OK )
125 INFOT = 4
126 CALL ZGEQLF( 2, 1, A, 1, B, W, 1, INFO )
127 CALL CHKXER( 'zgeqlf', INFOT, NOUT, LERR, OK )
128 INFOT = 7
129 CALL ZGEQLF( 1, 2, A, 1, B, W, 1, INFO )
130 CALL CHKXER( 'zgeqlf', INFOT, NOUT, LERR, OK )
131*
132* ZGEQL2
133*
134 SRNAMT = 'zgeql2'
135 INFOT = 1
136 CALL ZGEQL2( -1, 0, A, 1, B, W, INFO )
137 CALL CHKXER( 'zgeql2', INFOT, NOUT, LERR, OK )
138 INFOT = 2
139 CALL ZGEQL2( 0, -1, A, 1, B, W, INFO )
140 CALL CHKXER( 'zgeql2', INFOT, NOUT, LERR, OK )
141 INFOT = 4
142 CALL ZGEQL2( 2, 1, A, 1, B, W, INFO )
143 CALL CHKXER( 'zgeql2', INFOT, NOUT, LERR, OK )
144*
145* ZGEQLS
146*
147 SRNAMT = 'zgeqls'
148 INFOT = 1
149 CALL ZGEQLS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO )
150 CALL CHKXER( 'zgeqls', INFOT, NOUT, LERR, OK )
151 INFOT = 2
152 CALL ZGEQLS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO )
153 CALL CHKXER( 'zgeqls', INFOT, NOUT, LERR, OK )
154 INFOT = 2
155 CALL ZGEQLS( 1, 2, 0, A, 1, X, B, 1, W, 1, INFO )
156 CALL CHKXER( 'zgeqls', INFOT, NOUT, LERR, OK )
157 INFOT = 3
158 CALL ZGEQLS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO )
159 CALL CHKXER( 'zgeqls', INFOT, NOUT, LERR, OK )
160 INFOT = 5
161 CALL ZGEQLS( 2, 1, 0, A, 1, X, B, 2, W, 1, INFO )
162 CALL CHKXER( 'zgeqls', INFOT, NOUT, LERR, OK )
163 INFOT = 8
164 CALL ZGEQLS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO )
165 CALL CHKXER( 'zgeqls', INFOT, NOUT, LERR, OK )
166 INFOT = 10
167 CALL ZGEQLS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO )
168 CALL CHKXER( 'zgeqls', INFOT, NOUT, LERR, OK )
169*
170* ZUNGQL
171*
172 SRNAMT = 'zungql'
173 INFOT = 1
174 CALL ZUNGQL( -1, 0, 0, A, 1, X, W, 1, INFO )
175 CALL CHKXER( 'zungql', INFOT, NOUT, LERR, OK )
176 INFOT = 2
177 CALL ZUNGQL( 0, -1, 0, A, 1, X, W, 1, INFO )
178 CALL CHKXER( 'zungql', INFOT, NOUT, LERR, OK )
179 INFOT = 2
180 CALL ZUNGQL( 1, 2, 0, A, 1, X, W, 2, INFO )
181 CALL CHKXER( 'zungql', INFOT, NOUT, LERR, OK )
182 INFOT = 3
183 CALL ZUNGQL( 0, 0, -1, A, 1, X, W, 1, INFO )
184 CALL CHKXER( 'zungql', INFOT, NOUT, LERR, OK )
185 INFOT = 3
186 CALL ZUNGQL( 1, 1, 2, A, 1, X, W, 1, INFO )
187 CALL CHKXER( 'zungql', INFOT, NOUT, LERR, OK )
188 INFOT = 5
189 CALL ZUNGQL( 2, 1, 0, A, 1, X, W, 1, INFO )
190 CALL CHKXER( 'zungql', INFOT, NOUT, LERR, OK )
191 INFOT = 8
192 CALL ZUNGQL( 2, 2, 0, A, 2, X, W, 1, INFO )
193 CALL CHKXER( 'zungql', INFOT, NOUT, LERR, OK )
194*
195* ZUNG2L
196*
197 SRNAMT = 'zung2l'
198 INFOT = 1
199 CALL ZUNG2L( -1, 0, 0, A, 1, X, W, INFO )
200 CALL CHKXER( 'zung2l', INFOT, NOUT, LERR, OK )
201 INFOT = 2
202 CALL ZUNG2L( 0, -1, 0, A, 1, X, W, INFO )
203 CALL CHKXER( 'zung2l', INFOT, NOUT, LERR, OK )
204 INFOT = 2
205 CALL ZUNG2L( 1, 2, 0, A, 1, X, W, INFO )
206 CALL CHKXER( 'zung2l', INFOT, NOUT, LERR, OK )
207 INFOT = 3
208 CALL ZUNG2L( 0, 0, -1, A, 1, X, W, INFO )
209 CALL CHKXER( 'zung2l', INFOT, NOUT, LERR, OK )
210 INFOT = 3
211 CALL ZUNG2L( 2, 1, 2, A, 2, X, W, INFO )
212 CALL CHKXER( 'zung2l', INFOT, NOUT, LERR, OK )
213 INFOT = 5
214 CALL ZUNG2L( 2, 1, 0, A, 1, X, W, INFO )
215 CALL CHKXER( 'zung2l', INFOT, NOUT, LERR, OK )
216*
217* ZUNMQL
218*
219 SRNAMT = 'zunmql'
220 INFOT = 1
221 CALL ZUNMQL( '/', 'n', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
222 CALL CHKXER( 'zunmql', INFOT, NOUT, LERR, OK )
223 INFOT = 2
224 CALL ZUNMQL( 'l', '/', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
225 CALL CHKXER( 'zunmql', INFOT, NOUT, LERR, OK )
226 INFOT = 3
227 CALL ZUNMQL( 'l', 'n', -1, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
228 CALL CHKXER( 'zunmql', INFOT, NOUT, LERR, OK )
229 INFOT = 4
230 CALL ZUNMQL( 'l', 'n', 0, -1, 0, A, 1, X, AF, 1, W, 1, INFO )
231 CALL CHKXER( 'zunmql', INFOT, NOUT, LERR, OK )
232 INFOT = 5
233 CALL ZUNMQL( 'l', 'n', 0, 0, -1, A, 1, X, AF, 1, W, 1, INFO )
234 CALL CHKXER( 'zunmql', INFOT, NOUT, LERR, OK )
235 INFOT = 5
236 CALL ZUNMQL( 'l', 'n', 0, 1, 1, A, 1, X, AF, 1, W, 1, INFO )
237 CALL CHKXER( 'zunmql', INFOT, NOUT, LERR, OK )
238 INFOT = 5
239 CALL ZUNMQL( 'r', 'n', 1, 0, 1, A, 1, X, AF, 1, W, 1, INFO )
240 CALL CHKXER( 'zunmql', INFOT, NOUT, LERR, OK )
241 INFOT = 7
242 CALL ZUNMQL( 'l', 'n', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO )
243 CALL CHKXER( 'zunmql', INFOT, NOUT, LERR, OK )
244 INFOT = 7
245 CALL ZUNMQL( 'r', 'n', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO )
246 CALL CHKXER( 'zunmql', INFOT, NOUT, LERR, OK )
247 INFOT = 10
248 CALL ZUNMQL( 'l', 'n', 2, 1, 0, A, 2, X, AF, 1, W, 1, INFO )
249 CALL CHKXER( 'zunmql', INFOT, NOUT, LERR, OK )
250 INFOT = 12
251 CALL ZUNMQL( 'l', 'n', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO )
252 CALL CHKXER( 'zunmql', INFOT, NOUT, LERR, OK )
253 INFOT = 12
254 CALL ZUNMQL( 'r', 'n', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO )
255 CALL CHKXER( 'zunmql', INFOT, NOUT, LERR, OK )
256*
257* ZUNM2L
258*
259 SRNAMT = 'zunm2l'
260 INFOT = 1
261 CALL ZUNM2L( '/', 'n', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
262 CALL CHKXER( 'zunm2l', INFOT, NOUT, LERR, OK )
263 INFOT = 2
264 CALL ZUNM2L( 'l', '/', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
265 CALL CHKXER( 'zunm2l', INFOT, NOUT, LERR, OK )
266 INFOT = 3
267 CALL ZUNM2L( 'l', 'n', -1, 0, 0, A, 1, X, AF, 1, W, INFO )
268 CALL CHKXER( 'zunm2l', INFOT, NOUT, LERR, OK )
269 INFOT = 4
270 CALL ZUNM2L( 'l', 'n', 0, -1, 0, A, 1, X, AF, 1, W, INFO )
271 CALL CHKXER( 'zunm2l', infot, nout, lerr, ok )
272 infot = 5
273 CALL zunm2l( 'L', 'N', 0, 0, -1, a, 1, x, af, 1, w, info )
274 CALL chkxer( 'ZUNM2L', infot, nout, lerr, ok )
275 infot = 5
276 CALL zunm2l( 'L', 'N', 0, 1, 1, a, 1, x, af, 1, w, info )
277 CALL chkxer( 'ZUNM2L', infot, nout, lerr, ok )
278 infot = 5
279 CALL zunm2l( 'R', 'N', 1, 0, 1, a, 1, x, af, 1, w, info )
280 CALL chkxer( 'zunm2l', INFOT, NOUT, LERR, OK )
281 INFOT = 7
282 CALL ZUNM2L( 'l', 'n', 2, 1, 0, A, 1, X, AF, 2, W, INFO )
283 CALL CHKXER( 'zunm2l', INFOT, NOUT, LERR, OK )
284 INFOT = 7
285 CALL ZUNM2L( 'r', 'n', 1, 2, 0, A, 1, X, AF, 1, W, INFO )
286 CALL CHKXER( 'zunm2l', INFOT, NOUT, LERR, OK )
287 INFOT = 10
288 CALL ZUNM2L( 'l', 'n', 2, 1, 0, A, 2, X, AF, 1, W, INFO )
289 CALL CHKXER( 'zunm2l', INFOT, NOUT, LERR, OK )
290*
291* Print a summary line.
292*
293 CALL ALAESM( PATH, OK, NOUT )
294*
295 RETURN
296*
297* End of ZERRQL
298*
299 END
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
zgeql2
subroutine zgeql2(m, n, a, lda, tau, work, info)
ZGEQL2 computes the QL factorization of a general rectangular matrix using an unblocked algorithm.
Definition zgeql2.f:123
zgeqlf
subroutine zgeqlf(m, n, a, lda, tau, work, lwork, info)
ZGEQLF
Definition zgeqlf.f:138
zung2l
subroutine zung2l(m, n, k, a, lda, tau, work, info)
ZUNG2L generates all or part of the unitary matrix Q from a QL factorization determined by cgeqlf (un...
Definition zung2l.f:114
zungql
subroutine zungql(m, n, k, a, lda, tau, work, lwork, info)
ZUNGQL
Definition zungql.f:128
zunmql
subroutine zunmql(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
ZUNMQL
Definition zunmql.f:167
zunm2l
subroutine zunm2l(side, trans, m, n, k, a, lda, tau, c, ldc, work, info)
ZUNM2L multiplies a general matrix by the unitary matrix from a QL factorization determined by cgeqlf...
Definition zunm2l.f:159
zerrql
subroutine zerrql(path, nunit)
ZERRQL
Definition zerrql.f:55
zgeqls
subroutine zgeqls(m, n, nrhs, a, lda, tau, b, ldb, work, lwork, info)
ZGEQLS
Definition zgeqls.f:122