LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
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
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine cgelq(M, N, A, LDA, T, TSIZE, WORK, LWORK, INFO)
CGELQ
Definition: cgelq.f:172
subroutine cgemlq(SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, C, LDC, WORK, LWORK, INFO)
CGEMLQ
Definition: cgemlq.f:170
subroutine cgemqr(SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, C, LDC, WORK, LWORK, INFO)
CGEMQR
Definition: cgemqr.f:172
subroutine cgeqr(M, N, A, LDA, T, TSIZE, WORK, LWORK, INFO)
CGEQR
Definition: cgeqr.f:174
subroutine claswlq(M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO)
CLASWLQ
Definition: claswlq.f:164
subroutine clatsqr(M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, INFO)
CLATSQR
Definition: clatsqr.f:166
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
subroutine cerrtsqr(PATH, NUNIT)
CERRTSQR
Definition: cerrtsqr.f:55