LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ cerrtsqr()

subroutine cerrtsqr ( character*3  path,
integer  nunit 
)

CERRTSQR

Purpose:
 CERRTSQR tests the error exits for the COMPLEX routines
 that use the TSQR decomposition of a general matrix.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Zenver
NAG Ltd.

Definition at line 54 of file cerrtsqr.f.

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*
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
cgelq
subroutine cgelq(m, n, a, lda, t, tsize, work, lwork, info)
CGELQ
Definition cgelq.f:174
cgemlq
subroutine cgemlq(side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork, info)
CGEMLQ
Definition cgemlq.f:172
cgemqr
subroutine cgemqr(side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork, info)
CGEMQR
Definition cgemqr.f:174
cgeqr
subroutine cgeqr(m, n, a, lda, t, tsize, work, lwork, info)
CGEQR
Definition cgeqr.f:176
claswlq
subroutine claswlq(m, n, mb, nb, a, lda, t, ldt, work, lwork, info)
CLASWLQ
Definition claswlq.f:167
clatsqr
subroutine clatsqr(m, n, mb, nb, a, lda, t, ldt, work, lwork, info)
CLATSQR
Definition clatsqr.f:169
Here is the call graph for this function:
Here is the caller graph for this function: