1 SUBROUTINE CERRLS( PATH, NUNIT )
2 *
3 * -- LAPACK test routine (version 3.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 * CERRLS tests the error exits for the COMPLEX least squares
16 * driver routines (CGELS, CGELSS, CGELSX, CGELSY, CGELSD).
17 *
18 * Arguments
19 * =========
20 *
21 * PATH (input) CHARACTER*3
22 * The LAPACK path name for the routines to be tested.
23 *
24 * NUNIT (input) INTEGER
25 * The unit number for output.
26 *
27 * =====================================================================
28 *
29 * .. Parameters ..
30 INTEGER NMAX
31 PARAMETER ( NMAX = 2 )
32 * ..
33 * .. Local Scalars ..
34 CHARACTER*2 C2
35 INTEGER INFO, IRNK
36 REAL RCOND
37 * ..
38 * .. Local Arrays ..
39 INTEGER IP( NMAX )
40 REAL RW( NMAX ), S( NMAX )
41 COMPLEX A( NMAX, NMAX ), B( NMAX, NMAX ), W( NMAX )
42 * ..
43 * .. External Functions ..
44 LOGICAL LSAMEN
45 EXTERNAL LSAMEN
46 * ..
47 * .. External Subroutines ..
48 EXTERNAL ALAESM, CGELS, CGELSD, CGELSS, CGELSX, CGELSY,
49 $ CHKXER
50 * ..
51 * .. Scalars in Common ..
52 LOGICAL LERR, OK
53 CHARACTER*32 SRNAMT
54 INTEGER INFOT, NOUT
55 * ..
56 * .. Common blocks ..
57 COMMON / INFOC / INFOT, NOUT, OK, LERR
58 COMMON / SRNAMC / SRNAMT
59 * ..
60 * .. Executable Statements ..
61 *
62 NOUT = NUNIT
63 C2 = PATH( 2: 3 )
64 A( 1, 1 ) = ( 1.0E+0, 0.0E+0 )
65 A( 1, 2 ) = ( 2.0E+0, 0.0E+0 )
66 A( 2, 2 ) = ( 3.0E+0, 0.0E+0 )
67 A( 2, 1 ) = ( 4.0E+0, 0.0E+0 )
68 OK = .TRUE.
69 WRITE( NOUT, FMT = * )
70 *
71 * Test error exits for the least squares driver routines.
72 *
73 IF( LSAMEN( 2, C2, 'LS' ) ) THEN
74 *
75 * CGELS
76 *
77 SRNAMT = 'CGELS '
78 INFOT = 1
79 CALL CGELS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
80 CALL CHKXER( 'CGELS ', INFOT, NOUT, LERR, OK )
81 INFOT = 2
82 CALL CGELS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
83 CALL CHKXER( 'CGELS ', INFOT, NOUT, LERR, OK )
84 INFOT = 3
85 CALL CGELS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
86 CALL CHKXER( 'CGELS ', INFOT, NOUT, LERR, OK )
87 INFOT = 4
88 CALL CGELS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
89 CALL CHKXER( 'CGELS ', INFOT, NOUT, LERR, OK )
90 INFOT = 6
91 CALL CGELS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
92 CALL CHKXER( 'CGELS ', INFOT, NOUT, LERR, OK )
93 INFOT = 8
94 CALL CGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
95 CALL CHKXER( 'CGELS ', INFOT, NOUT, LERR, OK )
96 INFOT = 10
97 CALL CGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
98 CALL CHKXER( 'CGELS ', INFOT, NOUT, LERR, OK )
99 *
100 * CGELSS
101 *
102 SRNAMT = 'CGELSS'
103 INFOT = 1
104 CALL CGELSS( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, RW,
105 $ INFO )
106 CALL CHKXER( 'CGELSS', INFOT, NOUT, LERR, OK )
107 INFOT = 2
108 CALL CGELSS( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, RW,
109 $ INFO )
110 CALL CHKXER( 'CGELSS', INFOT, NOUT, LERR, OK )
111 INFOT = 3
112 CALL CGELSS( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 1, RW,
113 $ INFO )
114 CALL CHKXER( 'CGELSS', INFOT, NOUT, LERR, OK )
115 INFOT = 5
116 CALL CGELSS( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 2, RW,
117 $ INFO )
118 CALL CHKXER( 'CGELSS', INFOT, NOUT, LERR, OK )
119 INFOT = 7
120 CALL CGELSS( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 2, RW,
121 $ INFO )
122 CALL CHKXER( 'CGELSS', INFOT, NOUT, LERR, OK )
123 *
124 * CGELSX
125 *
126 SRNAMT = 'CGELSX'
127 INFOT = 1
128 CALL CGELSX( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, RW,
129 $ INFO )
130 CALL CHKXER( 'CGELSX', INFOT, NOUT, LERR, OK )
131 INFOT = 2
132 CALL CGELSX( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, RW,
133 $ INFO )
134 CALL CHKXER( 'CGELSX', INFOT, NOUT, LERR, OK )
135 INFOT = 3
136 CALL CGELSX( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, RW,
137 $ INFO )
138 CALL CHKXER( 'CGELSX', INFOT, NOUT, LERR, OK )
139 INFOT = 5
140 CALL CGELSX( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, RW,
141 $ INFO )
142 CALL CHKXER( 'CGELSX', INFOT, NOUT, LERR, OK )
143 INFOT = 7
144 CALL CGELSX( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, RW,
145 $ INFO )
146 CALL CHKXER( 'CGELSX', INFOT, NOUT, LERR, OK )
147 *
148 * CGELSY
149 *
150 SRNAMT = 'CGELSY'
151 INFOT = 1
152 CALL CGELSY( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, RW,
153 $ INFO )
154 CALL CHKXER( 'CGELSY', INFOT, NOUT, LERR, OK )
155 INFOT = 2
156 CALL CGELSY( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, RW,
157 $ INFO )
158 CALL CHKXER( 'CGELSY', INFOT, NOUT, LERR, OK )
159 INFOT = 3
160 CALL CGELSY( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, 10, RW,
161 $ INFO )
162 CALL CHKXER( 'CGELSY', INFOT, NOUT, LERR, OK )
163 INFOT = 5
164 CALL CGELSY( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, 10, RW,
165 $ INFO )
166 CALL CHKXER( 'CGELSY', INFOT, NOUT, LERR, OK )
167 INFOT = 7
168 CALL CGELSY( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, 10, RW,
169 $ INFO )
170 CALL CHKXER( 'CGELSY', INFOT, NOUT, LERR, OK )
171 INFOT = 12
172 CALL CGELSY( 0, 3, 0, A, 1, B, 3, IP, RCOND, IRNK, W, 1, RW,
173 $ INFO )
174 CALL CHKXER( 'CGELSY', INFOT, NOUT, LERR, OK )
175 *
176 * CGELSD
177 *
178 SRNAMT = 'CGELSD'
179 INFOT = 1
180 CALL CGELSD( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10,
181 $ RW, IP, INFO )
182 CALL CHKXER( 'CGELSD', INFOT, NOUT, LERR, OK )
183 INFOT = 2
184 CALL CGELSD( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10,
185 $ RW, IP, INFO )
186 CALL CHKXER( 'CGELSD', INFOT, NOUT, LERR, OK )
187 INFOT = 3
188 CALL CGELSD( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 10,
189 $ RW, IP, INFO )
190 CALL CHKXER( 'CGELSD', INFOT, NOUT, LERR, OK )
191 INFOT = 5
192 CALL CGELSD( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 10,
193 $ RW, IP, INFO )
194 CALL CHKXER( 'CGELSD', INFOT, NOUT, LERR, OK )
195 INFOT = 7
196 CALL CGELSD( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 10,
197 $ RW, IP, INFO )
198 CALL CHKXER( 'CGELSD', INFOT, NOUT, LERR, OK )
199 INFOT = 12
200 CALL CGELSD( 2, 2, 1, A, 2, B, 2, S, RCOND, IRNK, W, 1,
201 $ RW, IP, INFO )
202 CALL CHKXER( 'CGELSD', INFOT, NOUT, LERR, OK )
203 END IF
204 *
205 * Print a summary line.
206 *
207 CALL ALAESM( PATH, OK, NOUT )
208 *
209 RETURN
210 *
211 * End of CERRLS
212 *
213 END
2 *
3 * -- LAPACK test routine (version 3.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 * CERRLS tests the error exits for the COMPLEX least squares
16 * driver routines (CGELS, CGELSS, CGELSX, CGELSY, CGELSD).
17 *
18 * Arguments
19 * =========
20 *
21 * PATH (input) CHARACTER*3
22 * The LAPACK path name for the routines to be tested.
23 *
24 * NUNIT (input) INTEGER
25 * The unit number for output.
26 *
27 * =====================================================================
28 *
29 * .. Parameters ..
30 INTEGER NMAX
31 PARAMETER ( NMAX = 2 )
32 * ..
33 * .. Local Scalars ..
34 CHARACTER*2 C2
35 INTEGER INFO, IRNK
36 REAL RCOND
37 * ..
38 * .. Local Arrays ..
39 INTEGER IP( NMAX )
40 REAL RW( NMAX ), S( NMAX )
41 COMPLEX A( NMAX, NMAX ), B( NMAX, NMAX ), W( NMAX )
42 * ..
43 * .. External Functions ..
44 LOGICAL LSAMEN
45 EXTERNAL LSAMEN
46 * ..
47 * .. External Subroutines ..
48 EXTERNAL ALAESM, CGELS, CGELSD, CGELSS, CGELSX, CGELSY,
49 $ CHKXER
50 * ..
51 * .. Scalars in Common ..
52 LOGICAL LERR, OK
53 CHARACTER*32 SRNAMT
54 INTEGER INFOT, NOUT
55 * ..
56 * .. Common blocks ..
57 COMMON / INFOC / INFOT, NOUT, OK, LERR
58 COMMON / SRNAMC / SRNAMT
59 * ..
60 * .. Executable Statements ..
61 *
62 NOUT = NUNIT
63 C2 = PATH( 2: 3 )
64 A( 1, 1 ) = ( 1.0E+0, 0.0E+0 )
65 A( 1, 2 ) = ( 2.0E+0, 0.0E+0 )
66 A( 2, 2 ) = ( 3.0E+0, 0.0E+0 )
67 A( 2, 1 ) = ( 4.0E+0, 0.0E+0 )
68 OK = .TRUE.
69 WRITE( NOUT, FMT = * )
70 *
71 * Test error exits for the least squares driver routines.
72 *
73 IF( LSAMEN( 2, C2, 'LS' ) ) THEN
74 *
75 * CGELS
76 *
77 SRNAMT = 'CGELS '
78 INFOT = 1
79 CALL CGELS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
80 CALL CHKXER( 'CGELS ', INFOT, NOUT, LERR, OK )
81 INFOT = 2
82 CALL CGELS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
83 CALL CHKXER( 'CGELS ', INFOT, NOUT, LERR, OK )
84 INFOT = 3
85 CALL CGELS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
86 CALL CHKXER( 'CGELS ', INFOT, NOUT, LERR, OK )
87 INFOT = 4
88 CALL CGELS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
89 CALL CHKXER( 'CGELS ', INFOT, NOUT, LERR, OK )
90 INFOT = 6
91 CALL CGELS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
92 CALL CHKXER( 'CGELS ', INFOT, NOUT, LERR, OK )
93 INFOT = 8
94 CALL CGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
95 CALL CHKXER( 'CGELS ', INFOT, NOUT, LERR, OK )
96 INFOT = 10
97 CALL CGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
98 CALL CHKXER( 'CGELS ', INFOT, NOUT, LERR, OK )
99 *
100 * CGELSS
101 *
102 SRNAMT = 'CGELSS'
103 INFOT = 1
104 CALL CGELSS( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, RW,
105 $ INFO )
106 CALL CHKXER( 'CGELSS', INFOT, NOUT, LERR, OK )
107 INFOT = 2
108 CALL CGELSS( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, RW,
109 $ INFO )
110 CALL CHKXER( 'CGELSS', INFOT, NOUT, LERR, OK )
111 INFOT = 3
112 CALL CGELSS( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 1, RW,
113 $ INFO )
114 CALL CHKXER( 'CGELSS', INFOT, NOUT, LERR, OK )
115 INFOT = 5
116 CALL CGELSS( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 2, RW,
117 $ INFO )
118 CALL CHKXER( 'CGELSS', INFOT, NOUT, LERR, OK )
119 INFOT = 7
120 CALL CGELSS( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 2, RW,
121 $ INFO )
122 CALL CHKXER( 'CGELSS', INFOT, NOUT, LERR, OK )
123 *
124 * CGELSX
125 *
126 SRNAMT = 'CGELSX'
127 INFOT = 1
128 CALL CGELSX( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, RW,
129 $ INFO )
130 CALL CHKXER( 'CGELSX', INFOT, NOUT, LERR, OK )
131 INFOT = 2
132 CALL CGELSX( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, RW,
133 $ INFO )
134 CALL CHKXER( 'CGELSX', INFOT, NOUT, LERR, OK )
135 INFOT = 3
136 CALL CGELSX( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, RW,
137 $ INFO )
138 CALL CHKXER( 'CGELSX', INFOT, NOUT, LERR, OK )
139 INFOT = 5
140 CALL CGELSX( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, RW,
141 $ INFO )
142 CALL CHKXER( 'CGELSX', INFOT, NOUT, LERR, OK )
143 INFOT = 7
144 CALL CGELSX( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, RW,
145 $ INFO )
146 CALL CHKXER( 'CGELSX', INFOT, NOUT, LERR, OK )
147 *
148 * CGELSY
149 *
150 SRNAMT = 'CGELSY'
151 INFOT = 1
152 CALL CGELSY( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, RW,
153 $ INFO )
154 CALL CHKXER( 'CGELSY', INFOT, NOUT, LERR, OK )
155 INFOT = 2
156 CALL CGELSY( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10, RW,
157 $ INFO )
158 CALL CHKXER( 'CGELSY', INFOT, NOUT, LERR, OK )
159 INFOT = 3
160 CALL CGELSY( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, 10, RW,
161 $ INFO )
162 CALL CHKXER( 'CGELSY', INFOT, NOUT, LERR, OK )
163 INFOT = 5
164 CALL CGELSY( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, 10, RW,
165 $ INFO )
166 CALL CHKXER( 'CGELSY', INFOT, NOUT, LERR, OK )
167 INFOT = 7
168 CALL CGELSY( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, 10, RW,
169 $ INFO )
170 CALL CHKXER( 'CGELSY', INFOT, NOUT, LERR, OK )
171 INFOT = 12
172 CALL CGELSY( 0, 3, 0, A, 1, B, 3, IP, RCOND, IRNK, W, 1, RW,
173 $ INFO )
174 CALL CHKXER( 'CGELSY', INFOT, NOUT, LERR, OK )
175 *
176 * CGELSD
177 *
178 SRNAMT = 'CGELSD'
179 INFOT = 1
180 CALL CGELSD( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10,
181 $ RW, IP, INFO )
182 CALL CHKXER( 'CGELSD', INFOT, NOUT, LERR, OK )
183 INFOT = 2
184 CALL CGELSD( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10,
185 $ RW, IP, INFO )
186 CALL CHKXER( 'CGELSD', INFOT, NOUT, LERR, OK )
187 INFOT = 3
188 CALL CGELSD( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 10,
189 $ RW, IP, INFO )
190 CALL CHKXER( 'CGELSD', INFOT, NOUT, LERR, OK )
191 INFOT = 5
192 CALL CGELSD( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 10,
193 $ RW, IP, INFO )
194 CALL CHKXER( 'CGELSD', INFOT, NOUT, LERR, OK )
195 INFOT = 7
196 CALL CGELSD( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 10,
197 $ RW, IP, INFO )
198 CALL CHKXER( 'CGELSD', INFOT, NOUT, LERR, OK )
199 INFOT = 12
200 CALL CGELSD( 2, 2, 1, A, 2, B, 2, S, RCOND, IRNK, W, 1,
201 $ RW, IP, INFO )
202 CALL CHKXER( 'CGELSD', INFOT, NOUT, LERR, OK )
203 END IF
204 *
205 * Print a summary line.
206 *
207 CALL ALAESM( PATH, OK, NOUT )
208 *
209 RETURN
210 *
211 * End of CERRLS
212 *
213 END