1 SUBROUTINE SERRLS( 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 * SERRLS tests the error exits for the REAL least squares
16 * driver routines (SGELS, SGELSS, SGELSX, SGELSY, SGELSD).
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 A( NMAX, NMAX ), B( NMAX, NMAX ), S( NMAX ),
41 $ W( NMAX )
42 * ..
43 * .. External Functions ..
44 LOGICAL LSAMEN
45 EXTERNAL LSAMEN
46 * ..
47 * .. External Subroutines ..
48 EXTERNAL ALAESM, CHKXER, SGELS, SGELSD, SGELSS, SGELSX,
49 $ SGELSY
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 WRITE( NOUT, FMT = * )
64 C2 = PATH( 2: 3 )
65 A( 1, 1 ) = 1.0E+0
66 A( 1, 2 ) = 2.0E+0
67 A( 2, 2 ) = 3.0E+0
68 A( 2, 1 ) = 4.0E+0
69 OK = .TRUE.
70 *
71 IF( LSAMEN( 2, C2, 'LS' ) ) THEN
72 *
73 * Test error exits for the least squares driver routines.
74 *
75 * SGELS
76 *
77 SRNAMT = 'SGELS '
78 INFOT = 1
79 CALL SGELS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
80 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK )
81 INFOT = 2
82 CALL SGELS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
83 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK )
84 INFOT = 3
85 CALL SGELS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
86 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK )
87 INFOT = 4
88 CALL SGELS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
89 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK )
90 INFOT = 6
91 CALL SGELS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
92 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK )
93 INFOT = 8
94 CALL SGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
95 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK )
96 INFOT = 10
97 CALL SGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
98 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK )
99 *
100 * SGELSS
101 *
102 SRNAMT = 'SGELSS'
103 INFOT = 1
104 CALL SGELSS( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
105 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK )
106 INFOT = 2
107 CALL SGELSS( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
108 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK )
109 INFOT = 3
110 CALL SGELSS( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
111 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK )
112 INFOT = 5
113 CALL SGELSS( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 2, INFO )
114 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK )
115 INFOT = 7
116 CALL SGELSS( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 2, INFO )
117 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK )
118 *
119 * SGELSX
120 *
121 SRNAMT = 'SGELSX'
122 INFOT = 1
123 CALL SGELSX( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, INFO )
124 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK )
125 INFOT = 2
126 CALL SGELSX( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, INFO )
127 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK )
128 INFOT = 3
129 CALL SGELSX( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, INFO )
130 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK )
131 INFOT = 5
132 CALL SGELSX( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, INFO )
133 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK )
134 INFOT = 7
135 CALL SGELSX( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, INFO )
136 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK )
137 *
138 * SGELSY
139 *
140 SRNAMT = 'SGELSY'
141 INFOT = 1
142 CALL SGELSY( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
143 $ INFO )
144 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK )
145 INFOT = 2
146 CALL SGELSY( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
147 $ INFO )
148 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK )
149 INFOT = 3
150 CALL SGELSY( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
151 $ INFO )
152 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK )
153 INFOT = 5
154 CALL SGELSY( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, 10,
155 $ INFO )
156 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK )
157 INFOT = 7
158 CALL SGELSY( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, 10,
159 $ INFO )
160 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK )
161 INFOT = 12
162 CALL SGELSY( 2, 2, 1, A, 2, B, 2, IP, RCOND, IRNK, W, 1, INFO )
163 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK )
164 *
165 * SGELSD
166 *
167 SRNAMT = 'SGELSD'
168 INFOT = 1
169 CALL SGELSD( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10,
170 $ IP, INFO )
171 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK )
172 INFOT = 2
173 CALL SGELSD( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10,
174 $ IP, INFO )
175 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK )
176 INFOT = 3
177 CALL SGELSD( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 10,
178 $ IP, INFO )
179 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK )
180 INFOT = 5
181 CALL SGELSD( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 10,
182 $ IP, INFO )
183 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK )
184 INFOT = 7
185 CALL SGELSD( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 10,
186 $ IP, INFO )
187 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK )
188 INFOT = 12
189 CALL SGELSD( 2, 2, 1, A, 2, B, 2, S, RCOND, IRNK, W, 1, IP,
190 $ INFO )
191 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK )
192 END IF
193 *
194 * Print a summary line.
195 *
196 CALL ALAESM( PATH, OK, NOUT )
197 *
198 RETURN
199 *
200 * End of SERRLS
201 *
202 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 * SERRLS tests the error exits for the REAL least squares
16 * driver routines (SGELS, SGELSS, SGELSX, SGELSY, SGELSD).
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 A( NMAX, NMAX ), B( NMAX, NMAX ), S( NMAX ),
41 $ W( NMAX )
42 * ..
43 * .. External Functions ..
44 LOGICAL LSAMEN
45 EXTERNAL LSAMEN
46 * ..
47 * .. External Subroutines ..
48 EXTERNAL ALAESM, CHKXER, SGELS, SGELSD, SGELSS, SGELSX,
49 $ SGELSY
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 WRITE( NOUT, FMT = * )
64 C2 = PATH( 2: 3 )
65 A( 1, 1 ) = 1.0E+0
66 A( 1, 2 ) = 2.0E+0
67 A( 2, 2 ) = 3.0E+0
68 A( 2, 1 ) = 4.0E+0
69 OK = .TRUE.
70 *
71 IF( LSAMEN( 2, C2, 'LS' ) ) THEN
72 *
73 * Test error exits for the least squares driver routines.
74 *
75 * SGELS
76 *
77 SRNAMT = 'SGELS '
78 INFOT = 1
79 CALL SGELS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
80 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK )
81 INFOT = 2
82 CALL SGELS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
83 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK )
84 INFOT = 3
85 CALL SGELS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
86 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK )
87 INFOT = 4
88 CALL SGELS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
89 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK )
90 INFOT = 6
91 CALL SGELS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
92 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK )
93 INFOT = 8
94 CALL SGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
95 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK )
96 INFOT = 10
97 CALL SGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
98 CALL CHKXER( 'SGELS ', INFOT, NOUT, LERR, OK )
99 *
100 * SGELSS
101 *
102 SRNAMT = 'SGELSS'
103 INFOT = 1
104 CALL SGELSS( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
105 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK )
106 INFOT = 2
107 CALL SGELSS( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
108 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK )
109 INFOT = 3
110 CALL SGELSS( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
111 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK )
112 INFOT = 5
113 CALL SGELSS( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 2, INFO )
114 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK )
115 INFOT = 7
116 CALL SGELSS( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 2, INFO )
117 CALL CHKXER( 'SGELSS', INFOT, NOUT, LERR, OK )
118 *
119 * SGELSX
120 *
121 SRNAMT = 'SGELSX'
122 INFOT = 1
123 CALL SGELSX( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, INFO )
124 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK )
125 INFOT = 2
126 CALL SGELSX( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, INFO )
127 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK )
128 INFOT = 3
129 CALL SGELSX( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, INFO )
130 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK )
131 INFOT = 5
132 CALL SGELSX( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, INFO )
133 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK )
134 INFOT = 7
135 CALL SGELSX( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, INFO )
136 CALL CHKXER( 'SGELSX', INFOT, NOUT, LERR, OK )
137 *
138 * SGELSY
139 *
140 SRNAMT = 'SGELSY'
141 INFOT = 1
142 CALL SGELSY( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
143 $ INFO )
144 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK )
145 INFOT = 2
146 CALL SGELSY( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
147 $ INFO )
148 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK )
149 INFOT = 3
150 CALL SGELSY( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
151 $ INFO )
152 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK )
153 INFOT = 5
154 CALL SGELSY( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, 10,
155 $ INFO )
156 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK )
157 INFOT = 7
158 CALL SGELSY( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, 10,
159 $ INFO )
160 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK )
161 INFOT = 12
162 CALL SGELSY( 2, 2, 1, A, 2, B, 2, IP, RCOND, IRNK, W, 1, INFO )
163 CALL CHKXER( 'SGELSY', INFOT, NOUT, LERR, OK )
164 *
165 * SGELSD
166 *
167 SRNAMT = 'SGELSD'
168 INFOT = 1
169 CALL SGELSD( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10,
170 $ IP, INFO )
171 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK )
172 INFOT = 2
173 CALL SGELSD( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10,
174 $ IP, INFO )
175 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK )
176 INFOT = 3
177 CALL SGELSD( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 10,
178 $ IP, INFO )
179 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK )
180 INFOT = 5
181 CALL SGELSD( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 10,
182 $ IP, INFO )
183 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK )
184 INFOT = 7
185 CALL SGELSD( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 10,
186 $ IP, INFO )
187 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK )
188 INFOT = 12
189 CALL SGELSD( 2, 2, 1, A, 2, B, 2, S, RCOND, IRNK, W, 1, IP,
190 $ INFO )
191 CALL CHKXER( 'SGELSD', INFOT, NOUT, LERR, OK )
192 END IF
193 *
194 * Print a summary line.
195 *
196 CALL ALAESM( PATH, OK, NOUT )
197 *
198 RETURN
199 *
200 * End of SERRLS
201 *
202 END