1 SUBROUTINE DERRLS( 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 * DERRLS tests the error exits for the DOUBLE PRECISION least squares
16 * driver routines (DGELS, 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 DOUBLE PRECISION RCOND
37 * ..
38 * .. Local Arrays ..
39 INTEGER IP( NMAX )
40 DOUBLE PRECISION 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, DGELS, DGELSD, DGELSS, DGELSX,
49 $ DGELSY
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.0D+0
66 A( 1, 2 ) = 2.0D+0
67 A( 2, 2 ) = 3.0D+0
68 A( 2, 1 ) = 4.0D+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 * DGELS
76 *
77 SRNAMT = 'DGELS '
78 INFOT = 1
79 CALL DGELS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
80 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
81 INFOT = 2
82 CALL DGELS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
83 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
84 INFOT = 3
85 CALL DGELS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
86 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
87 INFOT = 4
88 CALL DGELS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
89 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
90 INFOT = 6
91 CALL DGELS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
92 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
93 INFOT = 8
94 CALL DGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
95 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
96 INFOT = 10
97 CALL DGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
98 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
99 *
100 * DGELSS
101 *
102 SRNAMT = 'DGELSS'
103 INFOT = 1
104 CALL DGELSS( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
105 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
106 INFOT = 2
107 CALL DGELSS( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
108 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
109 INFOT = 3
110 CALL DGELSS( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
111 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
112 INFOT = 5
113 CALL DGELSS( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 2, INFO )
114 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
115 INFOT = 7
116 CALL DGELSS( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 2, INFO )
117 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
118 *
119 * DGELSX
120 *
121 SRNAMT = 'DGELSX'
122 INFOT = 1
123 CALL DGELSX( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, INFO )
124 CALL CHKXER( 'DGELSX', INFOT, NOUT, LERR, OK )
125 INFOT = 2
126 CALL DGELSX( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, INFO )
127 CALL CHKXER( 'DGELSX', INFOT, NOUT, LERR, OK )
128 INFOT = 3
129 CALL DGELSX( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, INFO )
130 CALL CHKXER( 'DGELSX', INFOT, NOUT, LERR, OK )
131 INFOT = 5
132 CALL DGELSX( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, INFO )
133 CALL CHKXER( 'DGELSX', INFOT, NOUT, LERR, OK )
134 INFOT = 7
135 CALL DGELSX( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, INFO )
136 CALL CHKXER( 'DGELSX', INFOT, NOUT, LERR, OK )
137 *
138 * DGELSY
139 *
140 SRNAMT = 'DGELSY'
141 INFOT = 1
142 CALL DGELSY( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
143 $ INFO )
144 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
145 INFOT = 2
146 CALL DGELSY( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
147 $ INFO )
148 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
149 INFOT = 3
150 CALL DGELSY( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
151 $ INFO )
152 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
153 INFOT = 5
154 CALL DGELSY( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, 10,
155 $ INFO )
156 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
157 INFOT = 7
158 CALL DGELSY( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, 10,
159 $ INFO )
160 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
161 INFOT = 12
162 CALL DGELSY( 2, 2, 1, A, 2, B, 2, IP, RCOND, IRNK, W, 1, INFO )
163 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
164 *
165 * DGELSD
166 *
167 SRNAMT = 'DGELSD'
168 INFOT = 1
169 CALL DGELSD( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP,
170 $ INFO )
171 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
172 INFOT = 2
173 CALL DGELSD( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP,
174 $ INFO )
175 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
176 INFOT = 3
177 CALL DGELSD( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP,
178 $ INFO )
179 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
180 INFOT = 5
181 CALL DGELSD( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 10, IP,
182 $ INFO )
183 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
184 INFOT = 7
185 CALL DGELSD( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 10, IP,
186 $ INFO )
187 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
188 INFOT = 12
189 CALL DGELSD( 2, 2, 1, A, 2, B, 2, S, RCOND, IRNK, W, 1, IP,
190 $ INFO )
191 CALL CHKXER( 'DGELSD', 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 DERRLS
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 * DERRLS tests the error exits for the DOUBLE PRECISION least squares
16 * driver routines (DGELS, 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 DOUBLE PRECISION RCOND
37 * ..
38 * .. Local Arrays ..
39 INTEGER IP( NMAX )
40 DOUBLE PRECISION 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, DGELS, DGELSD, DGELSS, DGELSX,
49 $ DGELSY
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.0D+0
66 A( 1, 2 ) = 2.0D+0
67 A( 2, 2 ) = 3.0D+0
68 A( 2, 1 ) = 4.0D+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 * DGELS
76 *
77 SRNAMT = 'DGELS '
78 INFOT = 1
79 CALL DGELS( '/', 0, 0, 0, A, 1, B, 1, W, 1, INFO )
80 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
81 INFOT = 2
82 CALL DGELS( 'N', -1, 0, 0, A, 1, B, 1, W, 1, INFO )
83 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
84 INFOT = 3
85 CALL DGELS( 'N', 0, -1, 0, A, 1, B, 1, W, 1, INFO )
86 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
87 INFOT = 4
88 CALL DGELS( 'N', 0, 0, -1, A, 1, B, 1, W, 1, INFO )
89 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
90 INFOT = 6
91 CALL DGELS( 'N', 2, 0, 0, A, 1, B, 2, W, 2, INFO )
92 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
93 INFOT = 8
94 CALL DGELS( 'N', 2, 0, 0, A, 2, B, 1, W, 2, INFO )
95 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
96 INFOT = 10
97 CALL DGELS( 'N', 1, 1, 0, A, 1, B, 1, W, 1, INFO )
98 CALL CHKXER( 'DGELS ', INFOT, NOUT, LERR, OK )
99 *
100 * DGELSS
101 *
102 SRNAMT = 'DGELSS'
103 INFOT = 1
104 CALL DGELSS( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
105 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
106 INFOT = 2
107 CALL DGELSS( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
108 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
109 INFOT = 3
110 CALL DGELSS( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 1, INFO )
111 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
112 INFOT = 5
113 CALL DGELSS( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 2, INFO )
114 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
115 INFOT = 7
116 CALL DGELSS( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 2, INFO )
117 CALL CHKXER( 'DGELSS', INFOT, NOUT, LERR, OK )
118 *
119 * DGELSX
120 *
121 SRNAMT = 'DGELSX'
122 INFOT = 1
123 CALL DGELSX( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, INFO )
124 CALL CHKXER( 'DGELSX', INFOT, NOUT, LERR, OK )
125 INFOT = 2
126 CALL DGELSX( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, INFO )
127 CALL CHKXER( 'DGELSX', INFOT, NOUT, LERR, OK )
128 INFOT = 3
129 CALL DGELSX( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, INFO )
130 CALL CHKXER( 'DGELSX', INFOT, NOUT, LERR, OK )
131 INFOT = 5
132 CALL DGELSX( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, INFO )
133 CALL CHKXER( 'DGELSX', INFOT, NOUT, LERR, OK )
134 INFOT = 7
135 CALL DGELSX( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, INFO )
136 CALL CHKXER( 'DGELSX', INFOT, NOUT, LERR, OK )
137 *
138 * DGELSY
139 *
140 SRNAMT = 'DGELSY'
141 INFOT = 1
142 CALL DGELSY( -1, 0, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
143 $ INFO )
144 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
145 INFOT = 2
146 CALL DGELSY( 0, -1, 0, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
147 $ INFO )
148 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
149 INFOT = 3
150 CALL DGELSY( 0, 0, -1, A, 1, B, 1, IP, RCOND, IRNK, W, 10,
151 $ INFO )
152 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
153 INFOT = 5
154 CALL DGELSY( 2, 0, 0, A, 1, B, 2, IP, RCOND, IRNK, W, 10,
155 $ INFO )
156 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
157 INFOT = 7
158 CALL DGELSY( 2, 0, 0, A, 2, B, 1, IP, RCOND, IRNK, W, 10,
159 $ INFO )
160 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
161 INFOT = 12
162 CALL DGELSY( 2, 2, 1, A, 2, B, 2, IP, RCOND, IRNK, W, 1, INFO )
163 CALL CHKXER( 'DGELSY', INFOT, NOUT, LERR, OK )
164 *
165 * DGELSD
166 *
167 SRNAMT = 'DGELSD'
168 INFOT = 1
169 CALL DGELSD( -1, 0, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP,
170 $ INFO )
171 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
172 INFOT = 2
173 CALL DGELSD( 0, -1, 0, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP,
174 $ INFO )
175 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
176 INFOT = 3
177 CALL DGELSD( 0, 0, -1, A, 1, B, 1, S, RCOND, IRNK, W, 10, IP,
178 $ INFO )
179 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
180 INFOT = 5
181 CALL DGELSD( 2, 0, 0, A, 1, B, 2, S, RCOND, IRNK, W, 10, IP,
182 $ INFO )
183 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
184 INFOT = 7
185 CALL DGELSD( 2, 0, 0, A, 2, B, 1, S, RCOND, IRNK, W, 10, IP,
186 $ INFO )
187 CALL CHKXER( 'DGELSD', INFOT, NOUT, LERR, OK )
188 INFOT = 12
189 CALL DGELSD( 2, 2, 1, A, 2, B, 2, S, RCOND, IRNK, W, 1, IP,
190 $ INFO )
191 CALL CHKXER( 'DGELSD', 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 DERRLS
201 *
202 END