OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cerrtsqr.f
Go to the documentation of this file.
1*> \brief \b CERRTSQR
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 CERRTSQR( 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*> CERRTSQR tests the error exits for the COMPLEX routines
25*> that use the TSQR 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 Zenver
49*> \author NAG Ltd.
50*
51*> \ingroup double_lin
52*
53* =====================================================================
54 SUBROUTINE cerrtsqr( PATH, NUNIT )
55 IMPLICIT NONE
56*
57* -- LAPACK test routine --
58* -- LAPACK is a software package provided by Univ. of Tennessee, --
59* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
60*
61* .. Scalar Arguments ..
62 CHARACTER*3 PATH
63 INTEGER NUNIT
64* ..
65*
66* =====================================================================
67*
68* .. Parameters ..
69 INTEGER NMAX
70 parameter( nmax = 2 )
71* ..
72* .. Local Scalars ..
73 INTEGER I, INFO, J, MB, NB
74* ..
75* .. Local Arrays ..
76 COMPLEX A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ),
77 $ C( NMAX, NMAX ), TAU(NMAX)
78* ..
79* .. External Subroutines ..
80 EXTERNAL alaesm, chkxer, cgeqr,
81 $ cgemqr, cgelq, cgemlq
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 real
94* ..
95* .. Executable Statements ..
96*
97 nout = nunit
98 WRITE( nout, fmt = * )
99*
100* Set the variables to innocuous values.
101*
102 DO j = 1, nmax
103 DO i = 1, nmax
104 a( i, j ) = 1.e0 / cmplx( real( i+j ), 0.e0 )
105 c( i, j ) = 1.e0 / cmplx( real( i+j ), 0.e0 )
106 t( i, j ) = 1.e0 / cmplx( real( i+j ), 0.e0 )
107 END DO
108 w( j ) = 0.e0
109 END DO
110 ok = .true.
111*
112* Error exits for TS factorization
113*
114* CGEQR
115*
116 srnamt = 'CGEQR'
117 infot = 1
118 CALL cgeqr( -1, 0, a, 1, tau, 1, w, 1, info )
119 CALL chkxer( 'CGEQR', infot, nout, lerr, ok )
120 infot = 2
121 CALL cgeqr( 0, -1, a, 1, tau, 1, w, 1, info )
122 CALL chkxer( 'CGEQR', infot, nout, lerr, ok )
123 infot = 4
124 CALL cgeqr( 1, 1, a, 0, tau, 1, w, 1, info )
125 CALL chkxer( 'CGEQR', infot, nout, lerr, ok )
126 infot = 6
127 CALL cgeqr( 3, 2, a, 3, tau, 1, w, 1, info )
128 CALL chkxer( 'CGEQR', infot, nout, lerr, ok )
129 infot = 8
130 CALL cgeqr( 3, 2, a, 3, tau, 8, w, 0, info )
131 CALL chkxer( 'cgeqr', INFOT, NOUT, LERR, OK )
132*
133* CLATSQR
134*
135 MB = 1
136 NB = 1
137 SRNAMT = 'clatsqr'
138 INFOT = 1
139 CALL CLATSQR( -1, 0, MB, NB, A, 1, TAU, 1, W, 1, INFO )
140 CALL CHKXER( 'clatsqr', INFOT, NOUT, LERR, OK )
141 INFOT = 2
142 CALL CLATSQR( 1, 2, MB, NB, A, 1, TAU, 1, W, 1, INFO )
143 CALL CHKXER( 'clatsqr', INFOT, NOUT, LERR, OK )
144 CALL CLATSQR( 0, -1, MB, NB, A, 1, TAU, 1, W, 1, INFO )
145 CALL CHKXER( 'clatsqr', INFOT, NOUT, LERR, OK )
146 INFOT = 3
147 CALL CLATSQR( 2, 1, -1, NB, A, 2, TAU, 1, W, 1, INFO )
148 CALL CHKXER( 'clatsqr', INFOT, NOUT, LERR, OK )
149 INFOT = 4
150 CALL CLATSQR( 2, 1, MB, 2, A, 2, TAU, 1, W, 1, INFO )
151 CALL CHKXER( 'clatsqr', INFOT, NOUT, LERR, OK )
152 INFOT = 6
153 CALL CLATSQR( 2, 1, MB, NB, A, 1, TAU, 1, W, 1, INFO )
154 CALL CHKXER( 'clatsqr', INFOT, NOUT, LERR, OK )
155 INFOT = 8
156 CALL CLATSQR( 2, 1, MB, NB, A, 2, TAU, 0, W, 1, INFO )
157 CALL CHKXER( 'clatsqr', INFOT, NOUT, LERR, OK )
158 INFOT = 10
159 CALL CLATSQR( 2, 1, MB, NB, A, 2, TAU, 2, W, 0, INFO )
160 CALL CHKXER( 'clatsqr', INFOT, NOUT, LERR, OK )
161*
162* CGEMQR
163*
164 TAU(1)=1
165 TAU(2)=1
166 SRNAMT = 'cgemqr'
167 NB=1
168 INFOT = 1
169 CALL CGEMQR( '/', 'n', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO)
170 CALL CHKXER( 'cgemqr', INFOT, NOUT, LERR, OK )
171 INFOT = 2
172 CALL CGEMQR( 'l', '/', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO)
173 CALL CHKXER( 'cgemqr', INFOT, NOUT, LERR, OK )
174 INFOT = 3
175 CALL CGEMQR( 'l', 'n', -1, 0, 0, A, 1, TAU, 1, C, 1, W,1,INFO)
176 CALL CHKXER( 'cgemqr', INFOT, NOUT, LERR, OK )
177 INFOT = 4
178 CALL CGEMQR( 'l', 'n', 0, -1, 0, A, 1, TAU, 1, C, 1, W,1,INFO)
179 CALL CHKXER( 'cgemqr', INFOT, NOUT, LERR, OK )
180 INFOT = 5
181 CALL CGEMQR( 'l', 'n', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO)
182 CALL CHKXER( 'cgemqr', INFOT, NOUT, LERR, OK )
183 INFOT = 5
184 CALL CGEMQR( 'r', 'n', 0, 0, -1, A, 1, TAU, 1, C, 1, W,1,INFO)
185 CALL CHKXER( 'cgemqr', INFOT, NOUT, LERR, OK )
186 INFOT = 7
187 CALL CGEMQR( 'l', 'n', 2, 1, 0, A, 0, TAU, 1, C, 1, W, 1,INFO)
188 CALL CHKXER( 'cgemqr', INFOT, NOUT, LERR, OK )
189 INFOT = 9
190 CALL CGEMQR( 'r', 'n', 2, 2, 1, A, 2, TAU, 0, C, 1, W, 1,INFO)
191 CALL CHKXER( 'cgemqr', INFOT, NOUT, LERR, OK )
192 INFOT = 9
193 CALL CGEMQR( 'l', 'n', 2, 2, 1, A, 2, TAU, 0, C, 1, W, 1,INFO)
194 CALL CHKXER( 'cgemqr', INFOT, NOUT, LERR, OK )
195 INFOT = 11
196 CALL CGEMQR( 'l', 'n', 2, 1, 1, A, 2, TAU, 6, C, 0, W, 1,INFO)
197 CALL CHKXER( 'cgemqr', INFOT, NOUT, LERR, OK )
198 INFOT = 13
199 CALL CGEMQR( 'l', 'n', 2, 2, 1, A, 2, TAU, 6, C, 2, W, 0,INFO)
200 CALL CHKXER( 'cgemqr', INFOT, NOUT, LERR, OK )
201*
202* CGELQ
203*
204 SRNAMT = 'cgelq'
205 INFOT = 1
206 CALL CGELQ( -1, 0, A, 1, TAU, 1, W, 1, INFO )
207 CALL CHKXER( 'cgelq', INFOT, NOUT, LERR, OK )
208 INFOT = 2
209 CALL CGELQ( 0, -1, A, 1, TAU, 1, W, 1, INFO )
210 CALL CHKXER( 'cgelq', INFOT, NOUT, LERR, OK )
211 INFOT = 4
212 CALL CGELQ( 1, 1, A, 0, TAU, 1, W, 1, INFO )
213 CALL CHKXER( 'cgelq', INFOT, NOUT, LERR, OK )
214 INFOT = 6
215 CALL CGELQ( 2, 3, A, 3, TAU, 1, W, 1, INFO )
216 CALL CHKXER( 'cgelq', INFOT, NOUT, LERR, OK )
217 INFOT = 8
218 CALL CGELQ( 2, 3, A, 3, TAU, 8, W, 0, INFO )
219 CALL CHKXER( 'cgelq', INFOT, NOUT, LERR, OK )
220*
221* CLASWLQ
222*
223 MB = 1
224 NB = 1
225 SRNAMT = 'claswlq'
226 INFOT = 1
227 CALL CLASWLQ( -1, 0, MB, NB, A, 1, TAU, 1, W, 1, INFO )
228 CALL CHKXER( 'claswlq', INFOT, NOUT, LERR, OK )
229 INFOT = 2
230 CALL CLASWLQ( 2, 1, MB, NB, A, 1, TAU, 1, W, 1, INFO )
231 CALL CHKXER( 'claswlq', INFOT, NOUT, LERR, OK )
232 CALL CLASWLQ( 0, -1, MB, NB, A, 1, TAU, 1, W, 1, INFO )
233 CALL CHKXER( 'claswlq', INFOT, NOUT, LERR, OK )
234 INFOT = 3
235 CALL CLASWLQ( 1, 2, -1, NB, A, 1, TAU, 1, W, 1, INFO )
236 CALL CHKXER( 'claswlq', INFOT, NOUT, LERR, OK )
237 CALL CLASWLQ( 1, 1, 2, NB, A, 1, TAU, 1, W, 1, INFO )
238 CALL CHKXER( 'claswlq', INFOT, NOUT, LERR, OK )
239 INFOT = 4
240 CALL CLASWLQ( 1, 2, MB, -1, A, 1, TAU, 1, W, 1, INFO )
241 CALL CHKXER( 'claswlq', INFOT, NOUT, LERR, OK )
242 INFOT = 6
243 CALL CLASWLQ( 1, 2, MB, NB, A, 0, TAU, 1, W, 1, INFO )
244 CALL CHKXER( 'claswlq', INFOT, NOUT, LERR, OK )
245 INFOT = 8
246 CALL CLASWLQ( 1, 2, MB, NB, A, 1, TAU, 0, W, 1, INFO )
247 CALL CHKXER( 'claswlq', INFOT, NOUT, LERR, OK )
248 INFOT = 10
249 CALL CLASWLQ( 1, 2, MB, NB, A, 1, TAU, 1, W, 0, INFO )
250 CALL CHKXER( 'claswlq', INFOT, NOUT, LERR, OK )
251*
252* CGEMLQ
253*
254 TAU(1)=1
255 TAU(2)=1
256 SRNAMT = 'cgemlq'
257 NB=1
258 INFOT = 1
259 CALL CGEMLQ( '/', 'n', 0, 0, 0, A, 1, TAU, 1, C, 1, W, 1,INFO)
260 CALL CHKXER( 'cgemlq', INFOT, NOUT, LERR, OK )
261 INFOT = 2
262 CALL CGEMLQ( 'l', '/', 0, 0, 0, a, 1, tau, 1, c, 1, w, 1,info)
263 CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
264 infot = 3
265 CALL cgemlq( 'L', 'N', -1, 0, 0, a, 1, tau, 1, c, 1, w,1,info)
266 CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
267 infot = 4
268 CALL cgemlq( 'L', 'N', 0, -1, 0, a, 1, tau, 1, c, 1, w,1,info)
269 CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
270 infot = 5
271 CALL cgemlq( 'L', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
272 CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
273 infot = 5
274 CALL cgemlq( 'R', 'N', 0, 0, -1, a, 1, tau, 1, c, 1, w,1,info)
275 CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
276 infot = 7
277 CALL cgemlq( 'L', 'N', 1, 2, 0, a, 0, tau, 1, c, 1, w, 1,info)
278 CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
279 infot = 9
280 CALL cgemlq( 'R', 'N', 2, 2, 1, a, 1, tau, 0, c, 1, w, 1,info)
281 CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
282 infot = 9
283 CALL cgemlq( 'L', 'N', 2, 2, 1, a, 1, tau, 0, c, 1, w, 1,info)
284 CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
285 infot = 11
286 CALL cgemlq( 'L', 'N', 1, 2, 1, a, 1, tau, 6, c, 0, w, 1,info)
287 CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
288 infot = 13
289 CALL cgemlq( 'L', 'N', 2, 2, 1, a, 2, tau, 6, c, 2, w, 0,info)
290 CALL chkxer( 'CGEMLQ', infot, nout, lerr, ok )
291*
292* Print a summary line.
293*
294 CALL alaesm( path, ok, nout )
295*
296 RETURN
297*
298* End of CERRTSQR
299*
300 END
cmplx
float cmplx[2]
Definition pblas.h:136
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
cgelq
subroutine cgelq(m, n, a, lda, t, tsize, work, lwork, info)
CGELQ
Definition cgelq.f:172
cgemlq
subroutine cgemlq(side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork, info)
CGEMLQ
Definition cgemlq.f:170
cgemqr
subroutine cgemqr(side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork, info)
CGEMQR
Definition cgemqr.f:172
cgeqr
subroutine cgeqr(m, n, a, lda, t, tsize, work, lwork, info)
CGEQR
Definition cgeqr.f:174
claswlq
subroutine claswlq(m, n, mb, nb, a, lda, t, ldt, work, lwork, info)
CLASWLQ
Definition claswlq.f:164
clatsqr
subroutine clatsqr(m, n, mb, nb, a, lda, t, ldt, work, lwork, info)
CLATSQR
Definition clatsqr.f:166
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
cerrtsqr
subroutine cerrtsqr(path, nunit)
CERRTSQR
Definition cerrtsqr.f:55