LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
zerrbd.f
Go to the documentation of this file.
1 *> \brief \b ZERRBD
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 ZERRBD( 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 *> ZERRBD tests the error exits for ZGEBRD, ZUNGBR, ZUNMBR, and ZBDSQR.
25 *> \endverbatim
26 *
27 * Arguments:
28 * ==========
29 *
30 *> \param[in] PATH
31 *> \verbatim
32 *> PATH is CHARACTER*3
33 *> The LAPACK path name for the routines to be tested.
34 *> \endverbatim
35 *>
36 *> \param[in] NUNIT
37 *> \verbatim
38 *> NUNIT is INTEGER
39 *> The unit number for output.
40 *> \endverbatim
41 *
42 * Authors:
43 * ========
44 *
45 *> \author Univ. of Tennessee
46 *> \author Univ. of California Berkeley
47 *> \author Univ. of Colorado Denver
48 *> \author NAG Ltd.
49 *
50 *> \ingroup complex16_eig
51 *
52 * =====================================================================
53  SUBROUTINE zerrbd( PATH, NUNIT )
54 *
55 * -- LAPACK test routine --
56 * -- LAPACK is a software package provided by Univ. of Tennessee, --
57 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
58 *
59 * .. Scalar Arguments ..
60  CHARACTER*3 PATH
61  INTEGER NUNIT
62 * ..
63 *
64 * =====================================================================
65 *
66 * .. Parameters ..
67  INTEGER NMAX, LW
68  parameter( nmax = 4, lw = nmax )
69 * ..
70 * .. Local Scalars ..
71  CHARACTER*2 C2
72  INTEGER I, INFO, J, NT
73 * ..
74 * .. Local Arrays ..
75  DOUBLE PRECISION D( NMAX ), E( NMAX ), RW( 4*NMAX )
76  COMPLEX*16 A( NMAX, NMAX ), TP( NMAX ), TQ( NMAX ),
77  $ U( NMAX, NMAX ), V( NMAX, NMAX ), W( LW )
78 * ..
79 * .. External Functions ..
80  LOGICAL LSAMEN
81  EXTERNAL lsamen
82 * ..
83 * .. External Subroutines ..
84  EXTERNAL chkxer, zbdsqr, zgebrd, zungbr, zunmbr
85 * ..
86 * .. Scalars in Common ..
87  LOGICAL LERR, OK
88  CHARACTER*32 SRNAMT
89  INTEGER INFOT, NOUT
90 * ..
91 * .. Common blocks ..
92  COMMON / infoc / infot, nout, ok, lerr
93  COMMON / srnamc / srnamt
94 * ..
95 * .. Intrinsic Functions ..
96  INTRINSIC dble
97 * ..
98 * .. Executable Statements ..
99 *
100  nout = nunit
101  WRITE( nout, fmt = * )
102  c2 = path( 2: 3 )
103 *
104 * Set the variables to innocuous values.
105 *
106  DO 20 j = 1, nmax
107  DO 10 i = 1, nmax
108  a( i, j ) = 1.d0 / dble( i+j )
109  10 CONTINUE
110  20 CONTINUE
111  ok = .true.
112  nt = 0
113 *
114 * Test error exits of the SVD routines.
115 *
116  IF( lsamen( 2, c2, 'BD' ) ) THEN
117 *
118 * ZGEBRD
119 *
120  srnamt = 'ZGEBRD'
121  infot = 1
122  CALL zgebrd( -1, 0, a, 1, d, e, tq, tp, w, 1, info )
123  CALL chkxer( 'ZGEBRD', infot, nout, lerr, ok )
124  infot = 2
125  CALL zgebrd( 0, -1, a, 1, d, e, tq, tp, w, 1, info )
126  CALL chkxer( 'ZGEBRD', infot, nout, lerr, ok )
127  infot = 4
128  CALL zgebrd( 2, 1, a, 1, d, e, tq, tp, w, 2, info )
129  CALL chkxer( 'ZGEBRD', infot, nout, lerr, ok )
130  infot = 10
131  CALL zgebrd( 2, 1, a, 2, d, e, tq, tp, w, 1, info )
132  CALL chkxer( 'ZGEBRD', infot, nout, lerr, ok )
133  nt = nt + 4
134 *
135 * ZUNGBR
136 *
137  srnamt = 'ZUNGBR'
138  infot = 1
139  CALL zungbr( '/', 0, 0, 0, a, 1, tq, w, 1, info )
140  CALL chkxer( 'ZUNGBR', infot, nout, lerr, ok )
141  infot = 2
142  CALL zungbr( 'Q', -1, 0, 0, a, 1, tq, w, 1, info )
143  CALL chkxer( 'ZUNGBR', infot, nout, lerr, ok )
144  infot = 3
145  CALL zungbr( 'Q', 0, -1, 0, a, 1, tq, w, 1, info )
146  CALL chkxer( 'ZUNGBR', infot, nout, lerr, ok )
147  infot = 3
148  CALL zungbr( 'Q', 0, 1, 0, a, 1, tq, w, 1, info )
149  CALL chkxer( 'ZUNGBR', infot, nout, lerr, ok )
150  infot = 3
151  CALL zungbr( 'Q', 1, 0, 1, a, 1, tq, w, 1, info )
152  CALL chkxer( 'ZUNGBR', infot, nout, lerr, ok )
153  infot = 3
154  CALL zungbr( 'P', 1, 0, 0, a, 1, tq, w, 1, info )
155  CALL chkxer( 'ZUNGBR', infot, nout, lerr, ok )
156  infot = 3
157  CALL zungbr( 'P', 0, 1, 1, a, 1, tq, w, 1, info )
158  CALL chkxer( 'ZUNGBR', infot, nout, lerr, ok )
159  infot = 4
160  CALL zungbr( 'Q', 0, 0, -1, a, 1, tq, w, 1, info )
161  CALL chkxer( 'ZUNGBR', infot, nout, lerr, ok )
162  infot = 6
163  CALL zungbr( 'Q', 2, 1, 1, a, 1, tq, w, 1, info )
164  CALL chkxer( 'ZUNGBR', infot, nout, lerr, ok )
165  infot = 9
166  CALL zungbr( 'Q', 2, 2, 1, a, 2, tq, w, 1, info )
167  CALL chkxer( 'ZUNGBR', infot, nout, lerr, ok )
168  nt = nt + 10
169 *
170 * ZUNMBR
171 *
172  srnamt = 'ZUNMBR'
173  infot = 1
174  CALL zunmbr( '/', 'L', 'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
175  $ info )
176  CALL chkxer( 'ZUNMBR', infot, nout, lerr, ok )
177  infot = 2
178  CALL zunmbr( 'Q', '/', 'T', 0, 0, 0, a, 1, tq, u, 1, w, 1,
179  $ info )
180  CALL chkxer( 'ZUNMBR', infot, nout, lerr, ok )
181  infot = 3
182  CALL zunmbr( 'Q', 'L', '/', 0, 0, 0, a, 1, tq, u, 1, w, 1,
183  $ info )
184  CALL chkxer( 'ZUNMBR', infot, nout, lerr, ok )
185  infot = 4
186  CALL zunmbr( 'Q', 'L', 'C', -1, 0, 0, a, 1, tq, u, 1, w, 1,
187  $ info )
188  CALL chkxer( 'ZUNMBR', infot, nout, lerr, ok )
189  infot = 5
190  CALL zunmbr( 'Q', 'L', 'C', 0, -1, 0, a, 1, tq, u, 1, w, 1,
191  $ info )
192  CALL chkxer( 'ZUNMBR', infot, nout, lerr, ok )
193  infot = 6
194  CALL zunmbr( 'Q', 'L', 'C', 0, 0, -1, a, 1, tq, u, 1, w, 1,
195  $ info )
196  CALL chkxer( 'ZUNMBR', infot, nout, lerr, ok )
197  infot = 8
198  CALL zunmbr( 'Q', 'L', 'C', 2, 0, 0, a, 1, tq, u, 2, w, 1,
199  $ info )
200  CALL chkxer( 'ZUNMBR', infot, nout, lerr, ok )
201  infot = 8
202  CALL zunmbr( 'Q', 'R', 'C', 0, 2, 0, a, 1, tq, u, 1, w, 1,
203  $ info )
204  CALL chkxer( 'ZUNMBR', infot, nout, lerr, ok )
205  infot = 8
206  CALL zunmbr( 'P', 'L', 'C', 2, 0, 2, a, 1, tq, u, 2, w, 1,
207  $ info )
208  CALL chkxer( 'ZUNMBR', infot, nout, lerr, ok )
209  infot = 8
210  CALL zunmbr( 'P', 'R', 'C', 0, 2, 2, a, 1, tq, u, 1, w, 1,
211  $ info )
212  CALL chkxer( 'ZUNMBR', infot, nout, lerr, ok )
213  infot = 11
214  CALL zunmbr( 'Q', 'R', 'C', 2, 0, 0, a, 1, tq, u, 1, w, 1,
215  $ info )
216  CALL chkxer( 'ZUNMBR', infot, nout, lerr, ok )
217  infot = 13
218  CALL zunmbr( 'Q', 'L', 'C', 0, 2, 0, a, 1, tq, u, 1, w, 0,
219  $ info )
220  CALL chkxer( 'ZUNMBR', infot, nout, lerr, ok )
221  infot = 13
222  CALL zunmbr( 'Q', 'R', 'C', 2, 0, 0, a, 1, tq, u, 2, w, 0,
223  $ info )
224  CALL chkxer( 'ZUNMBR', infot, nout, lerr, ok )
225  nt = nt + 13
226 *
227 * ZBDSQR
228 *
229  srnamt = 'ZBDSQR'
230  infot = 1
231  CALL zbdsqr( '/', 0, 0, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
232  $ info )
233  CALL chkxer( 'ZBDSQR', infot, nout, lerr, ok )
234  infot = 2
235  CALL zbdsqr( 'U', -1, 0, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
236  $ info )
237  CALL chkxer( 'ZBDSQR', infot, nout, lerr, ok )
238  infot = 3
239  CALL zbdsqr( 'U', 0, -1, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
240  $ info )
241  CALL chkxer( 'ZBDSQR', infot, nout, lerr, ok )
242  infot = 4
243  CALL zbdsqr( 'U', 0, 0, -1, 0, d, e, v, 1, u, 1, a, 1, rw,
244  $ info )
245  CALL chkxer( 'ZBDSQR', infot, nout, lerr, ok )
246  infot = 5
247  CALL zbdsqr( 'U', 0, 0, 0, -1, d, e, v, 1, u, 1, a, 1, rw,
248  $ info )
249  CALL chkxer( 'ZBDSQR', infot, nout, lerr, ok )
250  infot = 9
251  CALL zbdsqr( 'U', 2, 1, 0, 0, d, e, v, 1, u, 1, a, 1, rw,
252  $ info )
253  CALL chkxer( 'ZBDSQR', infot, nout, lerr, ok )
254  infot = 11
255  CALL zbdsqr( 'U', 0, 0, 2, 0, d, e, v, 1, u, 1, a, 1, rw,
256  $ info )
257  CALL chkxer( 'ZBDSQR', infot, nout, lerr, ok )
258  infot = 13
259  CALL zbdsqr( 'U', 2, 0, 0, 1, d, e, v, 1, u, 1, a, 1, rw,
260  $ info )
261  CALL chkxer( 'ZBDSQR', infot, nout, lerr, ok )
262  nt = nt + 8
263  END IF
264 *
265 * Print a summary line.
266 *
267  IF( ok ) THEN
268  WRITE( nout, fmt = 9999 )path, nt
269  ELSE
270  WRITE( nout, fmt = 9998 )path
271  END IF
272 *
273  9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits (',
274  $ i3, ' tests done)' )
275  9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
276  $ 'exits ***' )
277 *
278  RETURN
279 *
280 * End of ZERRBD
281 *
282  END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine zerrbd(PATH, NUNIT)
ZERRBD
Definition: zerrbd.f:54
subroutine zungbr(VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGBR
Definition: zungbr.f:157
subroutine zgebrd(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO)
ZGEBRD
Definition: zgebrd.f:205
subroutine zbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, RWORK, INFO)
ZBDSQR
Definition: zbdsqr.f:222
subroutine zunmbr(VECT, SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMBR
Definition: zunmbr.f:196