OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cerrql.f
Go to the documentation of this file.
1*> \brief \b CERRQL
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 CERRQL( 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*> CERRQL tests the error exits for the COMPLEX 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 complex_lin
52*
53* =====================================================================
54 SUBROUTINE cerrql( 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 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
76 $ W( NMAX ), X( NMAX )
77* ..
78* .. External Subroutines ..
79 EXTERNAL alaesm, cgeql2, cgeqlf, cgeqls, chkxer, cung2l,
80 $ cungql, cunm2l, cunmql
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 cmplx, real
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 ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
104 af( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
105 10 CONTINUE
106 b( j ) = 0.
107 w( j ) = 0.
108 x( j ) = 0.
109 20 CONTINUE
110 ok = .true.
111*
112* Error exits for QL factorization
113*
114* CGEQLF
115*
116 srnamt = 'CGEQLF'
117 infot = 1
118 CALL cgeqlf( -1, 0, a, 1, b, w, 1, info )
119 CALL chkxer( 'cgeqlf', INFOT, NOUT, LERR, OK )
120 INFOT = 2
121 CALL CGEQLF( 0, -1, A, 1, B, W, 1, INFO )
122 CALL CHKXER( 'cgeqlf', INFOT, NOUT, LERR, OK )
123 INFOT = 4
124 CALL CGEQLF( 2, 1, A, 1, B, W, 1, INFO )
125 CALL CHKXER( 'cgeqlf', INFOT, NOUT, LERR, OK )
126 INFOT = 7
127 CALL CGEQLF( 1, 2, A, 1, B, W, 1, INFO )
128 CALL CHKXER( 'cgeqlf', INFOT, NOUT, LERR, OK )
129*
130* CGEQL2
131*
132 SRNAMT = 'cgeql2'
133 INFOT = 1
134 CALL CGEQL2( -1, 0, A, 1, B, W, INFO )
135 CALL CHKXER( 'cgeql2', INFOT, NOUT, LERR, OK )
136 INFOT = 2
137 CALL CGEQL2( 0, -1, A, 1, B, W, INFO )
138 CALL CHKXER( 'cgeql2', INFOT, NOUT, LERR, OK )
139 INFOT = 4
140 CALL CGEQL2( 2, 1, A, 1, B, W, INFO )
141 CALL CHKXER( 'cgeql2', INFOT, NOUT, LERR, OK )
142*
143* CGEQLS
144*
145 SRNAMT = 'cgeqls'
146 INFOT = 1
147 CALL CGEQLS( -1, 0, 0, A, 1, X, B, 1, W, 1, INFO )
148 CALL CHKXER( 'cgeqls', INFOT, NOUT, LERR, OK )
149 INFOT = 2
150 CALL CGEQLS( 0, -1, 0, A, 1, X, B, 1, W, 1, INFO )
151 CALL CHKXER( 'cgeqls', INFOT, NOUT, LERR, OK )
152 INFOT = 2
153 CALL CGEQLS( 1, 2, 0, A, 1, X, B, 1, W, 1, INFO )
154 CALL CHKXER( 'cgeqls', INFOT, NOUT, LERR, OK )
155 INFOT = 3
156 CALL CGEQLS( 0, 0, -1, A, 1, X, B, 1, W, 1, INFO )
157 CALL CHKXER( 'cgeqls', INFOT, NOUT, LERR, OK )
158 INFOT = 5
159 CALL CGEQLS( 2, 1, 0, A, 1, X, B, 2, W, 1, INFO )
160 CALL CHKXER( 'cgeqls', INFOT, NOUT, LERR, OK )
161 INFOT = 8
162 CALL CGEQLS( 2, 1, 0, A, 2, X, B, 1, W, 1, INFO )
163 CALL CHKXER( 'cgeqls', INFOT, NOUT, LERR, OK )
164 INFOT = 10
165 CALL CGEQLS( 1, 1, 2, A, 1, X, B, 1, W, 1, INFO )
166 CALL CHKXER( 'cgeqls', INFOT, NOUT, LERR, OK )
167*
168* CUNGQL
169*
170 SRNAMT = 'cungql'
171 INFOT = 1
172 CALL CUNGQL( -1, 0, 0, A, 1, X, W, 1, INFO )
173 CALL CHKXER( 'cungql', INFOT, NOUT, LERR, OK )
174 INFOT = 2
175 CALL CUNGQL( 0, -1, 0, A, 1, X, W, 1, INFO )
176 CALL CHKXER( 'cungql', INFOT, NOUT, LERR, OK )
177 INFOT = 2
178 CALL CUNGQL( 1, 2, 0, A, 1, X, W, 2, INFO )
179 CALL CHKXER( 'cungql', INFOT, NOUT, LERR, OK )
180 INFOT = 3
181 CALL CUNGQL( 0, 0, -1, A, 1, X, W, 1, INFO )
182 CALL CHKXER( 'cungql', INFOT, NOUT, LERR, OK )
183 INFOT = 3
184 CALL CUNGQL( 1, 1, 2, A, 1, X, W, 1, INFO )
185 CALL CHKXER( 'cungql', INFOT, NOUT, LERR, OK )
186 INFOT = 5
187 CALL CUNGQL( 2, 1, 0, A, 1, X, W, 1, INFO )
188 CALL CHKXER( 'cungql', INFOT, NOUT, LERR, OK )
189 INFOT = 8
190 CALL CUNGQL( 2, 2, 0, A, 2, X, W, 1, INFO )
191 CALL CHKXER( 'cungql', INFOT, NOUT, LERR, OK )
192*
193* CUNG2L
194*
195 SRNAMT = 'cung2l'
196 INFOT = 1
197 CALL CUNG2L( -1, 0, 0, A, 1, X, W, INFO )
198 CALL CHKXER( 'cung2l', INFOT, NOUT, LERR, OK )
199 INFOT = 2
200 CALL CUNG2L( 0, -1, 0, A, 1, X, W, INFO )
201 CALL CHKXER( 'cung2l', INFOT, NOUT, LERR, OK )
202 INFOT = 2
203 CALL CUNG2L( 1, 2, 0, A, 1, X, W, INFO )
204 CALL CHKXER( 'cung2l', INFOT, NOUT, LERR, OK )
205 INFOT = 3
206 CALL CUNG2L( 0, 0, -1, A, 1, X, W, INFO )
207 CALL CHKXER( 'cung2l', INFOT, NOUT, LERR, OK )
208 INFOT = 3
209 CALL CUNG2L( 2, 1, 2, A, 2, X, W, INFO )
210 CALL CHKXER( 'cung2l', INFOT, NOUT, LERR, OK )
211 INFOT = 5
212 CALL CUNG2L( 2, 1, 0, A, 1, X, W, INFO )
213 CALL CHKXER( 'cung2l', INFOT, NOUT, LERR, OK )
214*
215* CUNMQL
216*
217 SRNAMT = 'cunmql'
218 INFOT = 1
219 CALL CUNMQL( '/', 'n', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
220 CALL CHKXER( 'cunmql', INFOT, NOUT, LERR, OK )
221 INFOT = 2
222 CALL CUNMQL( 'l', '/', 0, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
223 CALL CHKXER( 'cunmql', INFOT, NOUT, LERR, OK )
224 INFOT = 3
225 CALL CUNMQL( 'l', 'n', -1, 0, 0, A, 1, X, AF, 1, W, 1, INFO )
226 CALL CHKXER( 'cunmql', INFOT, NOUT, LERR, OK )
227 INFOT = 4
228 CALL CUNMQL( 'l', 'n', 0, -1, 0, A, 1, X, AF, 1, W, 1, INFO )
229 CALL CHKXER( 'cunmql', INFOT, NOUT, LERR, OK )
230 INFOT = 5
231 CALL CUNMQL( 'l', 'n', 0, 0, -1, A, 1, X, AF, 1, W, 1, INFO )
232 CALL CHKXER( 'cunmql', INFOT, NOUT, LERR, OK )
233 INFOT = 5
234 CALL CUNMQL( 'l', 'n', 0, 1, 1, A, 1, X, AF, 1, W, 1, INFO )
235 CALL CHKXER( 'cunmql', INFOT, NOUT, LERR, OK )
236 INFOT = 5
237 CALL CUNMQL( 'r', 'n', 1, 0, 1, A, 1, X, AF, 1, W, 1, INFO )
238 CALL CHKXER( 'cunmql', INFOT, NOUT, LERR, OK )
239 INFOT = 7
240 CALL CUNMQL( 'l', 'n', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO )
241 CALL CHKXER( 'cunmql', INFOT, NOUT, LERR, OK )
242 INFOT = 7
243 CALL CUNMQL( 'r', 'n', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO )
244 CALL CHKXER( 'cunmql', INFOT, NOUT, LERR, OK )
245 INFOT = 10
246 CALL CUNMQL( 'l', 'n', 2, 1, 0, A, 2, X, AF, 1, W, 1, INFO )
247 CALL CHKXER( 'cunmql', INFOT, NOUT, LERR, OK )
248 INFOT = 12
249 CALL CUNMQL( 'l', 'n', 1, 2, 0, A, 1, X, AF, 1, W, 1, INFO )
250 CALL CHKXER( 'cunmql', INFOT, NOUT, LERR, OK )
251 INFOT = 12
252 CALL CUNMQL( 'r', 'n', 2, 1, 0, A, 1, X, AF, 2, W, 1, INFO )
253 CALL CHKXER( 'cunmql', INFOT, NOUT, LERR, OK )
254*
255* CUNM2L
256*
257 SRNAMT = 'cunm2l'
258 INFOT = 1
259 CALL CUNM2L( '/', 'n', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
260 CALL CHKXER( 'cunm2l', INFOT, NOUT, LERR, OK )
261 INFOT = 2
262 CALL CUNM2L( 'l', '/', 0, 0, 0, A, 1, X, AF, 1, W, INFO )
263 CALL CHKXER( 'cunm2l', INFOT, NOUT, LERR, OK )
264 INFOT = 3
265 CALL CUNM2L( 'l', 'n', -1, 0, 0, A, 1, X, AF, 1, W, INFO )
266 CALL CHKXER( 'cunm2l', INFOT, NOUT, LERR, OK )
267 INFOT = 4
268 CALL CUNM2L( 'l', 'n', 0, -1, 0, A, 1, X, AF, 1, W, INFO )
269 CALL CHKXER( 'cunm2l', INFOT, NOUT, LERR, OK )
270 INFOT = 5
271 CALL CUNM2L( 'l', 'n', 0, 0, -1, A, 1, X, AF, 1, W, INFO )
272 CALL CHKXER( 'cunm2l', INFOT, NOUT, LERR, OK )
273 INFOT = 5
274 CALL CUNM2L( 'l', 'n', 0, 1, 1, A, 1, X, AF, 1, W, INFO )
275 CALL CHKXER( 'cunm2l', INFOT, NOUT, LERR, OK )
276 INFOT = 5
277 CALL CUNM2L( 'r', 'n', 1, 0, 1, A, 1, X, AF, 1, W, INFO )
278 CALL CHKXER( 'cunm2l', INFOT, NOUT, LERR, OK )
279 INFOT = 7
280 CALL CUNM2L( 'l', 'n', 2, 1, 0, A, 1, X, AF, 2, W, INFO )
281 CALL CHKXER( 'cunm2l', INFOT, NOUT, LERR, OK )
282 INFOT = 7
283 CALL CUNM2L( 'r', 'n', 1, 2, 0, A, 1, X, AF, 1, W, INFO )
284 CALL CHKXER( 'cunm2l', INFOT, NOUT, LERR, OK )
285 INFOT = 10
286 CALL CUNM2L( 'l', 'n', 2, 1, 0, A, 2, X, AF, 1, W, INFO )
287 CALL CHKXER( 'cunm2l', INFOT, NOUT, LERR, OK )
288*
289* Print a summary line.
290*
291 CALL ALAESM( PATH, OK, NOUT )
292*
293 RETURN
294*
295* End of CERRQL
296*
297 END
cmplx
float cmplx[2]
Definition pblas.h:136
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
cgeqlf
subroutine cgeqlf(m, n, a, lda, tau, work, lwork, info)
CGEQLF
Definition cgeqlf.f:138
cgeql2
subroutine cgeql2(m, n, a, lda, tau, work, info)
CGEQL2 computes the QL factorization of a general rectangular matrix using an unblocked algorithm.
Definition cgeql2.f:123
cunm2l
subroutine cunm2l(side, trans, m, n, k, a, lda, tau, c, ldc, work, info)
CUNM2L multiplies a general matrix by the unitary matrix from a QL factorization determined by cgeqlf...
Definition cunm2l.f:159
cunmql
subroutine cunmql(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
CUNMQL
Definition cunmql.f:168
cungql
subroutine cungql(m, n, k, a, lda, tau, work, lwork, info)
CUNGQL
Definition cungql.f:128
cung2l
subroutine cung2l(m, n, k, a, lda, tau, work, info)
CUNG2L generates all or part of the unitary matrix Q from a QL factorization determined by cgeqlf (un...
Definition cung2l.f:114
cerrql
subroutine cerrql(path, nunit)
CERRQL
Definition cerrql.f:55
cgeqls
subroutine cgeqls(m, n, nrhs, a, lda, tau, b, ldb, work, lwork, info)
CGEQLS
Definition cgeqls.f:122