LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ 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 *
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
Here is the call graph for this function:
Here is the caller graph for this function: