1 SUBROUTINE CERRBD( PATH, NUNIT )
2 *
3 * -- LAPACK test routine (version 3.1.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * CERRBD tests the error exits for CGEBRD, CUNGBR, CUNMBR, and CBDSQR.
16 *
17 * Arguments
18 * =========
19 *
20 * PATH (input) CHARACTER*3
21 * The LAPACK path name for the routines to be tested.
22 *
23 * NUNIT (input) INTEGER
24 * The unit number for output.
25 *
26 * =====================================================================
27 *
28 * .. Parameters ..
29 INTEGER NMAX, LW
30 PARAMETER ( NMAX = 4, LW = NMAX )
31 * ..
32 * .. Local Scalars ..
33 CHARACTER*2 C2
34 INTEGER I, INFO, J, NT
35 * ..
36 * .. Local Arrays ..
37 REAL D( NMAX ), E( NMAX ), RW( 4*NMAX )
38 COMPLEX A( NMAX, NMAX ), TP( NMAX ), TQ( NMAX ),
39 $ U( NMAX, NMAX ), V( NMAX, NMAX ), W( LW )
40 * ..
41 * .. External Functions ..
42 LOGICAL LSAMEN
43 EXTERNAL LSAMEN
44 * ..
45 * .. External Subroutines ..
46 EXTERNAL CBDSQR, CGEBRD, CHKXER, CUNGBR, CUNMBR
47 * ..
48 * .. Scalars in Common ..
49 LOGICAL LERR, OK
50 CHARACTER*32 SRNAMT
51 INTEGER INFOT, NOUT
52 * ..
53 * .. Common blocks ..
54 COMMON / INFOC / INFOT, NOUT, OK, LERR
55 COMMON / SRNAMC / SRNAMT
56 * ..
57 * .. Intrinsic Functions ..
58 INTRINSIC REAL
59 * ..
60 * .. Executable Statements ..
61 *
62 NOUT = NUNIT
63 WRITE( NOUT, FMT = * )
64 C2 = PATH( 2: 3 )
65 *
66 * Set the variables to innocuous values.
67 *
68 DO 20 J = 1, NMAX
69 DO 10 I = 1, NMAX
70 A( I, J ) = 1. / REAL( I+J )
71 10 CONTINUE
72 20 CONTINUE
73 OK = .TRUE.
74 NT = 0
75 *
76 * Test error exits of the SVD routines.
77 *
78 IF( LSAMEN( 2, C2, 'BD' ) ) THEN
79 *
80 * CGEBRD
81 *
82 SRNAMT = 'CGEBRD'
83 INFOT = 1
84 CALL CGEBRD( -1, 0, A, 1, D, E, TQ, TP, W, 1, INFO )
85 CALL CHKXER( 'CGEBRD', INFOT, NOUT, LERR, OK )
86 INFOT = 2
87 CALL CGEBRD( 0, -1, A, 1, D, E, TQ, TP, W, 1, INFO )
88 CALL CHKXER( 'CGEBRD', INFOT, NOUT, LERR, OK )
89 INFOT = 4
90 CALL CGEBRD( 2, 1, A, 1, D, E, TQ, TP, W, 2, INFO )
91 CALL CHKXER( 'CGEBRD', INFOT, NOUT, LERR, OK )
92 INFOT = 10
93 CALL CGEBRD( 2, 1, A, 2, D, E, TQ, TP, W, 1, INFO )
94 CALL CHKXER( 'CGEBRD', INFOT, NOUT, LERR, OK )
95 NT = NT + 4
96 *
97 * CUNGBR
98 *
99 SRNAMT = 'CUNGBR'
100 INFOT = 1
101 CALL CUNGBR( '/', 0, 0, 0, A, 1, TQ, W, 1, INFO )
102 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
103 INFOT = 2
104 CALL CUNGBR( 'Q', -1, 0, 0, A, 1, TQ, W, 1, INFO )
105 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
106 INFOT = 3
107 CALL CUNGBR( 'Q', 0, -1, 0, A, 1, TQ, W, 1, INFO )
108 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
109 INFOT = 3
110 CALL CUNGBR( 'Q', 0, 1, 0, A, 1, TQ, W, 1, INFO )
111 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
112 INFOT = 3
113 CALL CUNGBR( 'Q', 1, 0, 1, A, 1, TQ, W, 1, INFO )
114 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
115 INFOT = 3
116 CALL CUNGBR( 'P', 1, 0, 0, A, 1, TQ, W, 1, INFO )
117 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
118 INFOT = 3
119 CALL CUNGBR( 'P', 0, 1, 1, A, 1, TQ, W, 1, INFO )
120 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
121 INFOT = 4
122 CALL CUNGBR( 'Q', 0, 0, -1, A, 1, TQ, W, 1, INFO )
123 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
124 INFOT = 6
125 CALL CUNGBR( 'Q', 2, 1, 1, A, 1, TQ, W, 1, INFO )
126 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
127 INFOT = 9
128 CALL CUNGBR( 'Q', 2, 2, 1, A, 2, TQ, W, 1, INFO )
129 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
130 NT = NT + 10
131 *
132 * CUNMBR
133 *
134 SRNAMT = 'CUNMBR'
135 INFOT = 1
136 CALL CUNMBR( '/', 'L', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
137 $ INFO )
138 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
139 INFOT = 2
140 CALL CUNMBR( 'Q', '/', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
141 $ INFO )
142 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
143 INFOT = 3
144 CALL CUNMBR( 'Q', 'L', '/', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
145 $ INFO )
146 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
147 INFOT = 4
148 CALL CUNMBR( 'Q', 'L', 'C', -1, 0, 0, A, 1, TQ, U, 1, W, 1,
149 $ INFO )
150 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
151 INFOT = 5
152 CALL CUNMBR( 'Q', 'L', 'C', 0, -1, 0, A, 1, TQ, U, 1, W, 1,
153 $ INFO )
154 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
155 INFOT = 6
156 CALL CUNMBR( 'Q', 'L', 'C', 0, 0, -1, A, 1, TQ, U, 1, W, 1,
157 $ INFO )
158 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
159 INFOT = 8
160 CALL CUNMBR( 'Q', 'L', 'C', 2, 0, 0, A, 1, TQ, U, 2, W, 1,
161 $ INFO )
162 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
163 INFOT = 8
164 CALL CUNMBR( 'Q', 'R', 'C', 0, 2, 0, A, 1, TQ, U, 1, W, 1,
165 $ INFO )
166 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
167 INFOT = 8
168 CALL CUNMBR( 'P', 'L', 'C', 2, 0, 2, A, 1, TQ, U, 2, W, 1,
169 $ INFO )
170 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
171 INFOT = 8
172 CALL CUNMBR( 'P', 'R', 'C', 0, 2, 2, A, 1, TQ, U, 1, W, 1,
173 $ INFO )
174 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
175 INFOT = 11
176 CALL CUNMBR( 'Q', 'R', 'C', 2, 0, 0, A, 1, TQ, U, 1, W, 1,
177 $ INFO )
178 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
179 INFOT = 13
180 CALL CUNMBR( 'Q', 'L', 'C', 0, 2, 0, A, 1, TQ, U, 1, W, 0,
181 $ INFO )
182 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
183 INFOT = 13
184 CALL CUNMBR( 'Q', 'R', 'C', 2, 0, 0, A, 1, TQ, U, 2, W, 0,
185 $ INFO )
186 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
187 NT = NT + 13
188 *
189 * CBDSQR
190 *
191 SRNAMT = 'CBDSQR'
192 INFOT = 1
193 CALL CBDSQR( '/', 0, 0, 0, 0, D, E, V, 1, U, 1, A, 1, RW,
194 $ INFO )
195 CALL CHKXER( 'CBDSQR', INFOT, NOUT, LERR, OK )
196 INFOT = 2
197 CALL CBDSQR( 'U', -1, 0, 0, 0, D, E, V, 1, U, 1, A, 1, RW,
198 $ INFO )
199 CALL CHKXER( 'CBDSQR', INFOT, NOUT, LERR, OK )
200 INFOT = 3
201 CALL CBDSQR( 'U', 0, -1, 0, 0, D, E, V, 1, U, 1, A, 1, RW,
202 $ INFO )
203 CALL CHKXER( 'CBDSQR', INFOT, NOUT, LERR, OK )
204 INFOT = 4
205 CALL CBDSQR( 'U', 0, 0, -1, 0, D, E, V, 1, U, 1, A, 1, RW,
206 $ INFO )
207 CALL CHKXER( 'CBDSQR', INFOT, NOUT, LERR, OK )
208 INFOT = 5
209 CALL CBDSQR( 'U', 0, 0, 0, -1, D, E, V, 1, U, 1, A, 1, RW,
210 $ INFO )
211 CALL CHKXER( 'CBDSQR', INFOT, NOUT, LERR, OK )
212 INFOT = 9
213 CALL CBDSQR( 'U', 2, 1, 0, 0, D, E, V, 1, U, 1, A, 1, RW,
214 $ INFO )
215 CALL CHKXER( 'CBDSQR', INFOT, NOUT, LERR, OK )
216 INFOT = 11
217 CALL CBDSQR( 'U', 0, 0, 2, 0, D, E, V, 1, U, 1, A, 1, RW,
218 $ INFO )
219 CALL CHKXER( 'CBDSQR', INFOT, NOUT, LERR, OK )
220 INFOT = 13
221 CALL CBDSQR( 'U', 2, 0, 0, 1, D, E, V, 1, U, 1, A, 1, RW,
222 $ INFO )
223 CALL CHKXER( 'CBDSQR', INFOT, NOUT, LERR, OK )
224 NT = NT + 8
225 END IF
226 *
227 * Print a summary line.
228 *
229 IF( OK ) THEN
230 WRITE( NOUT, FMT = 9999 )PATH, NT
231 ELSE
232 WRITE( NOUT, FMT = 9998 )PATH
233 END IF
234 *
235 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits (',
236 $ I3, ' tests done)' )
237 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ',
238 $ 'exits ***' )
239 *
240 RETURN
241 *
242 * End of CERRBD
243 *
244 END
2 *
3 * -- LAPACK test routine (version 3.1.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * CERRBD tests the error exits for CGEBRD, CUNGBR, CUNMBR, and CBDSQR.
16 *
17 * Arguments
18 * =========
19 *
20 * PATH (input) CHARACTER*3
21 * The LAPACK path name for the routines to be tested.
22 *
23 * NUNIT (input) INTEGER
24 * The unit number for output.
25 *
26 * =====================================================================
27 *
28 * .. Parameters ..
29 INTEGER NMAX, LW
30 PARAMETER ( NMAX = 4, LW = NMAX )
31 * ..
32 * .. Local Scalars ..
33 CHARACTER*2 C2
34 INTEGER I, INFO, J, NT
35 * ..
36 * .. Local Arrays ..
37 REAL D( NMAX ), E( NMAX ), RW( 4*NMAX )
38 COMPLEX A( NMAX, NMAX ), TP( NMAX ), TQ( NMAX ),
39 $ U( NMAX, NMAX ), V( NMAX, NMAX ), W( LW )
40 * ..
41 * .. External Functions ..
42 LOGICAL LSAMEN
43 EXTERNAL LSAMEN
44 * ..
45 * .. External Subroutines ..
46 EXTERNAL CBDSQR, CGEBRD, CHKXER, CUNGBR, CUNMBR
47 * ..
48 * .. Scalars in Common ..
49 LOGICAL LERR, OK
50 CHARACTER*32 SRNAMT
51 INTEGER INFOT, NOUT
52 * ..
53 * .. Common blocks ..
54 COMMON / INFOC / INFOT, NOUT, OK, LERR
55 COMMON / SRNAMC / SRNAMT
56 * ..
57 * .. Intrinsic Functions ..
58 INTRINSIC REAL
59 * ..
60 * .. Executable Statements ..
61 *
62 NOUT = NUNIT
63 WRITE( NOUT, FMT = * )
64 C2 = PATH( 2: 3 )
65 *
66 * Set the variables to innocuous values.
67 *
68 DO 20 J = 1, NMAX
69 DO 10 I = 1, NMAX
70 A( I, J ) = 1. / REAL( I+J )
71 10 CONTINUE
72 20 CONTINUE
73 OK = .TRUE.
74 NT = 0
75 *
76 * Test error exits of the SVD routines.
77 *
78 IF( LSAMEN( 2, C2, 'BD' ) ) THEN
79 *
80 * CGEBRD
81 *
82 SRNAMT = 'CGEBRD'
83 INFOT = 1
84 CALL CGEBRD( -1, 0, A, 1, D, E, TQ, TP, W, 1, INFO )
85 CALL CHKXER( 'CGEBRD', INFOT, NOUT, LERR, OK )
86 INFOT = 2
87 CALL CGEBRD( 0, -1, A, 1, D, E, TQ, TP, W, 1, INFO )
88 CALL CHKXER( 'CGEBRD', INFOT, NOUT, LERR, OK )
89 INFOT = 4
90 CALL CGEBRD( 2, 1, A, 1, D, E, TQ, TP, W, 2, INFO )
91 CALL CHKXER( 'CGEBRD', INFOT, NOUT, LERR, OK )
92 INFOT = 10
93 CALL CGEBRD( 2, 1, A, 2, D, E, TQ, TP, W, 1, INFO )
94 CALL CHKXER( 'CGEBRD', INFOT, NOUT, LERR, OK )
95 NT = NT + 4
96 *
97 * CUNGBR
98 *
99 SRNAMT = 'CUNGBR'
100 INFOT = 1
101 CALL CUNGBR( '/', 0, 0, 0, A, 1, TQ, W, 1, INFO )
102 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
103 INFOT = 2
104 CALL CUNGBR( 'Q', -1, 0, 0, A, 1, TQ, W, 1, INFO )
105 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
106 INFOT = 3
107 CALL CUNGBR( 'Q', 0, -1, 0, A, 1, TQ, W, 1, INFO )
108 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
109 INFOT = 3
110 CALL CUNGBR( 'Q', 0, 1, 0, A, 1, TQ, W, 1, INFO )
111 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
112 INFOT = 3
113 CALL CUNGBR( 'Q', 1, 0, 1, A, 1, TQ, W, 1, INFO )
114 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
115 INFOT = 3
116 CALL CUNGBR( 'P', 1, 0, 0, A, 1, TQ, W, 1, INFO )
117 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
118 INFOT = 3
119 CALL CUNGBR( 'P', 0, 1, 1, A, 1, TQ, W, 1, INFO )
120 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
121 INFOT = 4
122 CALL CUNGBR( 'Q', 0, 0, -1, A, 1, TQ, W, 1, INFO )
123 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
124 INFOT = 6
125 CALL CUNGBR( 'Q', 2, 1, 1, A, 1, TQ, W, 1, INFO )
126 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
127 INFOT = 9
128 CALL CUNGBR( 'Q', 2, 2, 1, A, 2, TQ, W, 1, INFO )
129 CALL CHKXER( 'CUNGBR', INFOT, NOUT, LERR, OK )
130 NT = NT + 10
131 *
132 * CUNMBR
133 *
134 SRNAMT = 'CUNMBR'
135 INFOT = 1
136 CALL CUNMBR( '/', 'L', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
137 $ INFO )
138 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
139 INFOT = 2
140 CALL CUNMBR( 'Q', '/', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
141 $ INFO )
142 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
143 INFOT = 3
144 CALL CUNMBR( 'Q', 'L', '/', 0, 0, 0, A, 1, TQ, U, 1, W, 1,
145 $ INFO )
146 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
147 INFOT = 4
148 CALL CUNMBR( 'Q', 'L', 'C', -1, 0, 0, A, 1, TQ, U, 1, W, 1,
149 $ INFO )
150 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
151 INFOT = 5
152 CALL CUNMBR( 'Q', 'L', 'C', 0, -1, 0, A, 1, TQ, U, 1, W, 1,
153 $ INFO )
154 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
155 INFOT = 6
156 CALL CUNMBR( 'Q', 'L', 'C', 0, 0, -1, A, 1, TQ, U, 1, W, 1,
157 $ INFO )
158 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
159 INFOT = 8
160 CALL CUNMBR( 'Q', 'L', 'C', 2, 0, 0, A, 1, TQ, U, 2, W, 1,
161 $ INFO )
162 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
163 INFOT = 8
164 CALL CUNMBR( 'Q', 'R', 'C', 0, 2, 0, A, 1, TQ, U, 1, W, 1,
165 $ INFO )
166 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
167 INFOT = 8
168 CALL CUNMBR( 'P', 'L', 'C', 2, 0, 2, A, 1, TQ, U, 2, W, 1,
169 $ INFO )
170 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
171 INFOT = 8
172 CALL CUNMBR( 'P', 'R', 'C', 0, 2, 2, A, 1, TQ, U, 1, W, 1,
173 $ INFO )
174 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
175 INFOT = 11
176 CALL CUNMBR( 'Q', 'R', 'C', 2, 0, 0, A, 1, TQ, U, 1, W, 1,
177 $ INFO )
178 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
179 INFOT = 13
180 CALL CUNMBR( 'Q', 'L', 'C', 0, 2, 0, A, 1, TQ, U, 1, W, 0,
181 $ INFO )
182 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
183 INFOT = 13
184 CALL CUNMBR( 'Q', 'R', 'C', 2, 0, 0, A, 1, TQ, U, 2, W, 0,
185 $ INFO )
186 CALL CHKXER( 'CUNMBR', INFOT, NOUT, LERR, OK )
187 NT = NT + 13
188 *
189 * CBDSQR
190 *
191 SRNAMT = 'CBDSQR'
192 INFOT = 1
193 CALL CBDSQR( '/', 0, 0, 0, 0, D, E, V, 1, U, 1, A, 1, RW,
194 $ INFO )
195 CALL CHKXER( 'CBDSQR', INFOT, NOUT, LERR, OK )
196 INFOT = 2
197 CALL CBDSQR( 'U', -1, 0, 0, 0, D, E, V, 1, U, 1, A, 1, RW,
198 $ INFO )
199 CALL CHKXER( 'CBDSQR', INFOT, NOUT, LERR, OK )
200 INFOT = 3
201 CALL CBDSQR( 'U', 0, -1, 0, 0, D, E, V, 1, U, 1, A, 1, RW,
202 $ INFO )
203 CALL CHKXER( 'CBDSQR', INFOT, NOUT, LERR, OK )
204 INFOT = 4
205 CALL CBDSQR( 'U', 0, 0, -1, 0, D, E, V, 1, U, 1, A, 1, RW,
206 $ INFO )
207 CALL CHKXER( 'CBDSQR', INFOT, NOUT, LERR, OK )
208 INFOT = 5
209 CALL CBDSQR( 'U', 0, 0, 0, -1, D, E, V, 1, U, 1, A, 1, RW,
210 $ INFO )
211 CALL CHKXER( 'CBDSQR', INFOT, NOUT, LERR, OK )
212 INFOT = 9
213 CALL CBDSQR( 'U', 2, 1, 0, 0, D, E, V, 1, U, 1, A, 1, RW,
214 $ INFO )
215 CALL CHKXER( 'CBDSQR', INFOT, NOUT, LERR, OK )
216 INFOT = 11
217 CALL CBDSQR( 'U', 0, 0, 2, 0, D, E, V, 1, U, 1, A, 1, RW,
218 $ INFO )
219 CALL CHKXER( 'CBDSQR', INFOT, NOUT, LERR, OK )
220 INFOT = 13
221 CALL CBDSQR( 'U', 2, 0, 0, 1, D, E, V, 1, U, 1, A, 1, RW,
222 $ INFO )
223 CALL CHKXER( 'CBDSQR', INFOT, NOUT, LERR, OK )
224 NT = NT + 8
225 END IF
226 *
227 * Print a summary line.
228 *
229 IF( OK ) THEN
230 WRITE( NOUT, FMT = 9999 )PATH, NT
231 ELSE
232 WRITE( NOUT, FMT = 9998 )PATH
233 END IF
234 *
235 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits (',
236 $ I3, ' tests done)' )
237 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ',
238 $ 'exits ***' )
239 *
240 RETURN
241 *
242 * End of CERRBD
243 *
244 END