55
56
57
58
59
60
61 CHARACTER*3 PATH
62 INTEGER NUNIT
63
64
65
66
67
68 INTEGER NMAX
69 parameter( nmax = 2 )
70
71
72 CHARACTER*2 C2
73 INTEGER INFO, IRNK
74 REAL RCOND
75
76
77 INTEGER IP( NMAX )
78 REAL A( NMAX, NMAX ), B( NMAX, NMAX ), S( NMAX ),
79 $ W( NMAX )
80
81
82 LOGICAL LSAMEN
84
85
88
89
90 LOGICAL LERR, OK
91 CHARACTER*32 SRNAMT
92 INTEGER INFOT, NOUT
93
94
95 COMMON / infoc / infot, nout, ok, lerr
96 COMMON / srnamc / srnamt
97
98
99
100 nout = nunit
101 WRITE( nout, fmt = * )
102 c2 = path( 2: 3 )
103 a( 1, 1 ) = 1.0e+0
104 a( 1, 2 ) = 2.0e+0
105 a( 2, 2 ) = 3.0e+0
106 a( 2, 1 ) = 4.0e+0
107 ok = .true.
108
109 IF(
lsamen( 2, c2,
'LS' ) )
THEN
110
111
112
113
114
115 srnamt = 'SGELS '
116 infot = 1
117 CALL sgels(
'/', 0, 0, 0, a, 1, b, 1, w, 1, info )
118 CALL chkxer(
'SGELS ', infot, nout, lerr, ok )
119 infot = 2
120 CALL sgels(
'N', -1, 0, 0, a, 1, b, 1, w, 1, info )
121 CALL chkxer(
'SGELS ', infot, nout, lerr, ok )
122 infot = 3
123 CALL sgels(
'N', 0, -1, 0, a, 1, b, 1, w, 1, info )
124 CALL chkxer(
'SGELS ', infot, nout, lerr, ok )
125 infot = 4
126 CALL sgels(
'N', 0, 0, -1, a, 1, b, 1, w, 1, info )
127 CALL chkxer(
'SGELS ', infot, nout, lerr, ok )
128 infot = 6
129 CALL sgels(
'N', 2, 0, 0, a, 1, b, 2, w, 2, info )
130 CALL chkxer(
'SGELS ', infot, nout, lerr, ok )
131 infot = 8
132 CALL sgels(
'N', 2, 0, 0, a, 2, b, 1, w, 2, info )
133 CALL chkxer(
'SGELS ', infot, nout, lerr, ok )
134 infot = 8
135 CALL sgels(
'N', 0, 2, 0, a, 1, b, 1, w, 2, info )
136 CALL chkxer(
'DGELS', infot, nout, lerr, ok )
137 infot = 10
138 CALL sgels(
'N', 1, 1, 0, a, 1, b, 1, w, 1, info )
139 CALL chkxer(
'SGELS ', infot, nout, lerr, ok )
140
141
142
143 srnamt = 'SGELST'
144 infot = 1
145 CALL sgelst(
'/', 0, 0, 0, a, 1, b, 1, w, 1, info )
146 CALL chkxer(
'SGELST', infot, nout, lerr, ok )
147 infot = 2
148 CALL sgelst(
'N', -1, 0, 0, a, 1, b, 1, w, 1, info )
149 CALL chkxer(
'SGELST', infot, nout, lerr, ok )
150 infot = 3
151 CALL sgelst(
'N', 0, -1, 0, a, 1, b, 1, w, 1, info )
152 CALL chkxer(
'SGELST', infot, nout, lerr, ok )
153 infot = 4
154 CALL sgelst(
'N', 0, 0, -1, a, 1, b, 1, w, 1, info )
155 CALL chkxer(
'SGELST', infot, nout, lerr, ok )
156 infot = 6
157 CALL sgelst(
'N', 2, 0, 0, a, 1, b, 2, w, 2, info )
158 CALL chkxer(
'SGELST', infot, nout, lerr, ok )
159 infot = 8
160 CALL sgelst(
'N', 2, 0, 0, a, 2, b, 1, w, 2, info )
161 CALL chkxer(
'SGELST', infot, nout, lerr, ok )
162 infot = 8
163 CALL sgelst(
'N', 0, 2, 0, a, 1, b, 1, w, 2, info )
164 CALL chkxer(
'SGELST', infot, nout, lerr, ok )
165 infot = 10
166 CALL sgelst(
'N', 1, 1, 0, a, 1, b, 1, w, 1, info )
167 CALL chkxer(
'SGELST', infot, nout, lerr, ok )
168
169
170
171 srnamt = 'SGETSLS'
172 infot = 1
173 CALL sgetsls(
'/', 0, 0, 0, a, 1, b, 1, w, 1, info )
174 CALL chkxer(
'SGETSLS', infot, nout, lerr, ok )
175 infot = 2
176 CALL sgetsls(
'N', -1, 0, 0, a, 1, b, 1, w, 1, info )
177 CALL chkxer(
'SGETSLS', infot, nout, lerr, ok )
178 infot = 3
179 CALL sgetsls(
'N', 0, -1, 0, a, 1, b, 1, w, 1, info )
180 CALL chkxer(
'SGETSLS', infot, nout, lerr, ok )
181 infot = 4
182 CALL sgetsls(
'N', 0, 0, -1, a, 1, b, 1, w, 1, info )
183 CALL chkxer(
'SGETSLS', infot, nout, lerr, ok )
184 infot = 6
185 CALL sgetsls(
'N', 2, 0, 0, a, 1, b, 2, w, 2, info )
186 CALL chkxer(
'SGETSLS', infot, nout, lerr, ok )
187 infot = 8
188 CALL sgetsls(
'N', 2, 0, 0, a, 2, b, 1, w, 2, info )
189 CALL chkxer(
'SGETSLS', infot, nout, lerr, ok )
190 infot = 8
191 CALL sgetsls(
'N', 0, 2, 0, a, 1, b, 1, w, 2, info )
192 CALL chkxer(
'SGETSLS', infot, nout, lerr, ok )
193
194
195
196 srnamt = 'SGELSS'
197 infot = 1
198 CALL sgelss( -1, 0, 0, a, 1, b, 1, s, rcond, irnk, w, 1, info )
199 CALL chkxer(
'SGELSS', infot, nout, lerr, ok )
200 infot = 2
201 CALL sgelss( 0, -1, 0, a, 1, b, 1, s, rcond, irnk, w, 1, info )
202 CALL chkxer(
'SGELSS', infot, nout, lerr, ok )
203 infot = 3
204 CALL sgelss( 0, 0, -1, a, 1, b, 1, s, rcond, irnk, w, 1, info )
205 CALL chkxer(
'SGELSS', infot, nout, lerr, ok )
206 infot = 5
207 CALL sgelss( 2, 0, 0, a, 1, b, 2, s, rcond, irnk, w, 2, info )
208 CALL chkxer(
'SGELSS', infot, nout, lerr, ok )
209 infot = 7
210 CALL sgelss( 2, 0, 0, a, 2, b, 1, s, rcond, irnk, w, 2, info )
211 CALL chkxer(
'SGELSS', infot, nout, lerr, ok )
212
213
214
215 srnamt = 'SGELSY'
216 infot = 1
217 CALL sgelsy( -1, 0, 0, a, 1, b, 1, ip, rcond, irnk, w, 10,
218 $ info )
219 CALL chkxer(
'SGELSY', infot, nout, lerr, ok )
220 infot = 2
221 CALL sgelsy( 0, -1, 0, a, 1, b, 1, ip, rcond, irnk, w, 10,
222 $ info )
223 CALL chkxer(
'SGELSY', infot, nout, lerr, ok )
224 infot = 3
225 CALL sgelsy( 0, 0, -1, a, 1, b, 1, ip, rcond, irnk, w, 10,
226 $ info )
227 CALL chkxer(
'SGELSY', infot, nout, lerr, ok )
228 infot = 5
229 CALL sgelsy( 2, 0, 0, a, 1, b, 2, ip, rcond, irnk, w, 10,
230 $ info )
231 CALL chkxer(
'SGELSY', infot, nout, lerr, ok )
232 infot = 7
233 CALL sgelsy( 2, 0, 0, a, 2, b, 1, ip, rcond, irnk, w, 10,
234 $ info )
235 CALL chkxer(
'SGELSY', infot, nout, lerr, ok )
236 infot = 12
237 CALL sgelsy( 2, 2, 1, a, 2, b, 2, ip, rcond, irnk, w, 1, info )
238 CALL chkxer(
'SGELSY', infot, nout, lerr, ok )
239
240
241
242 srnamt = 'SGELSD'
243 infot = 1
244 CALL sgelsd( -1, 0, 0, a, 1, b, 1, s, rcond, irnk, w, 10,
245 $ ip, info )
246 CALL chkxer(
'SGELSD', infot, nout, lerr, ok )
247 infot = 2
248 CALL sgelsd( 0, -1, 0, a, 1, b, 1, s, rcond, irnk, w, 10,
249 $ ip, info )
250 CALL chkxer(
'SGELSD', infot, nout, lerr, ok )
251 infot = 3
252 CALL sgelsd( 0, 0, -1, a, 1, b, 1, s, rcond, irnk, w, 10,
253 $ ip, info )
254 CALL chkxer(
'SGELSD', infot, nout, lerr, ok )
255 infot = 5
256 CALL sgelsd( 2, 0, 0, a, 1, b, 2, s, rcond, irnk, w, 10,
257 $ ip, info )
258 CALL chkxer(
'SGELSD', infot, nout, lerr, ok )
259 infot = 7
260 CALL sgelsd( 2, 0, 0, a, 2, b, 1, s, rcond, irnk, w, 10,
261 $ ip, info )
262 CALL chkxer(
'SGELSD', infot, nout, lerr, ok )
263 infot = 12
264 CALL sgelsd( 2, 2, 1, a, 2, b, 2, s, rcond, irnk, w, 1, ip,
265 $ info )
266 CALL chkxer(
'SGELSD', infot, nout, lerr, ok )
267 END IF
268
269
270
271 CALL alaesm( path, ok, nout )
272
273 RETURN
274
275
276
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine sgels(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
SGELS solves overdetermined or underdetermined systems for GE matrices
subroutine sgelsd(m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, iwork, info)
SGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices
subroutine sgelss(m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, info)
SGELSS solves overdetermined or underdetermined systems for GE matrices
subroutine sgelst(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
SGELST solves overdetermined or underdetermined systems for GE matrices using QR or LQ factorization ...
subroutine sgelsy(m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank, work, lwork, info)
SGELSY solves overdetermined or underdetermined systems for GE matrices
subroutine sgetsls(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
SGETSLS
logical function lsamen(n, ca, cb)
LSAMEN