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 DOUBLE PRECISION RCOND
75
76
77 INTEGER IP( NMAX )
78 DOUBLE PRECISION 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.0d+0
104 a( 1, 2 ) = 2.0d+0
105 a( 2, 2 ) = 3.0d+0
106 a( 2, 1 ) = 4.0d+0
107 ok = .true.
108
109 IF(
lsamen( 2, c2,
'LS' ) )
THEN
110
111
112
113
114
115 srnamt = 'DGELS '
116 infot = 1
117 CALL dgels(
'/', 0, 0, 0, a, 1, b, 1, w, 1, info )
118 CALL chkxer(
'DGELS ', infot, nout, lerr, ok )
119 infot = 2
120 CALL dgels(
'N', -1, 0, 0, a, 1, b, 1, w, 1, info )
121 CALL chkxer(
'DGELS ', infot, nout, lerr, ok )
122 infot = 3
123 CALL dgels(
'N', 0, -1, 0, a, 1, b, 1, w, 1, info )
124 CALL chkxer(
'DGELS ', infot, nout, lerr, ok )
125 infot = 4
126 CALL dgels(
'N', 0, 0, -1, a, 1, b, 1, w, 1, info )
127 CALL chkxer(
'DGELS ', infot, nout, lerr, ok )
128 infot = 6
129 CALL dgels(
'N', 2, 0, 0, a, 1, b, 2, w, 2, info )
130 CALL chkxer(
'DGELS ', infot, nout, lerr, ok )
131 infot = 8
132 CALL dgels(
'N', 2, 0, 0, a, 2, b, 1, w, 2, info )
133 CALL chkxer(
'DGELS ', infot, nout, lerr, ok )
134 infot = 8
135 CALL dgels(
'N', 0, 2, 0, a, 1, b, 1, w, 2, info )
136 CALL chkxer(
'DGELS', infot, nout, lerr, ok )
137 infot = 10
138 CALL dgels(
'N', 1, 1, 0, a, 1, b, 1, w, 1, info )
139 CALL chkxer(
'DGELS ', infot, nout, lerr, ok )
140
141
142
143 srnamt = 'DGELST'
144 infot = 1
145 CALL dgelst(
'/', 0, 0, 0, a, 1, b, 1, w, 1, info )
146 CALL chkxer(
'DGELST', infot, nout, lerr, ok )
147 infot = 2
148 CALL dgelst(
'N', -1, 0, 0, a, 1, b, 1, w, 1, info )
149 CALL chkxer(
'DGELST', infot, nout, lerr, ok )
150 infot = 3
151 CALL dgelst(
'N', 0, -1, 0, a, 1, b, 1, w, 1, info )
152 CALL chkxer(
'DGELST', infot, nout, lerr, ok )
153 infot = 4
154 CALL dgelst(
'N', 0, 0, -1, a, 1, b, 1, w, 1, info )
155 CALL chkxer(
'DGELST', infot, nout, lerr, ok )
156 infot = 6
157 CALL dgelst(
'N', 2, 0, 0, a, 1, b, 2, w, 2, info )
158 CALL chkxer(
'DGELST', infot, nout, lerr, ok )
159 infot = 8
160 CALL dgelst(
'N', 2, 0, 0, a, 2, b, 1, w, 2, info )
161 CALL chkxer(
'DGELST', infot, nout, lerr, ok )
162 infot = 8
163 CALL dgelst(
'N', 0, 2, 0, a, 1, b, 1, w, 2, info )
164 CALL chkxer(
'DGELST', infot, nout, lerr, ok )
165 infot = 10
166 CALL dgelst(
'N', 1, 1, 0, a, 1, b, 1, w, 1, info )
167 CALL chkxer(
'DGELST', infot, nout, lerr, ok )
168
169
170
171 srnamt = 'DGETSLS'
172 infot = 1
173 CALL dgetsls(
'/', 0, 0, 0, a, 1, b, 1, w, 1, info )
174 CALL chkxer(
'DGETSLS', infot, nout, lerr, ok )
175 infot = 2
176 CALL dgetsls(
'N', -1, 0, 0, a, 1, b, 1, w, 1, info )
177 CALL chkxer(
'DGETSLS', infot, nout, lerr, ok )
178 infot = 3
179 CALL dgetsls(
'N', 0, -1, 0, a, 1, b, 1, w, 1, info )
180 CALL chkxer(
'DGETSLS', infot, nout, lerr, ok )
181 infot = 4
182 CALL dgetsls(
'N', 0, 0, -1, a, 1, b, 1, w, 1, info )
183 CALL chkxer(
'DGETSLS', infot, nout, lerr, ok )
184 infot = 6
185 CALL dgetsls(
'N', 2, 0, 0, a, 1, b, 2, w, 2, info )
186 CALL chkxer(
'DGETSLS', infot, nout, lerr, ok )
187 infot = 8
188 CALL dgetsls(
'N', 2, 0, 0, a, 2, b, 1, w, 2, info )
189 CALL chkxer(
'DGETSLS', infot, nout, lerr, ok )
190 infot = 8
191 CALL dgetsls(
'N', 0, 2, 0, a, 1, b, 1, w, 2, info )
192 CALL chkxer(
'DGETSLS', infot, nout, lerr, ok )
193
194
195
196 srnamt = 'DGELSS'
197 infot = 1
198 CALL dgelss( -1, 0, 0, a, 1, b, 1, s, rcond, irnk, w, 1, info )
199 CALL chkxer(
'DGELSS', infot, nout, lerr, ok )
200 infot = 2
201 CALL dgelss( 0, -1, 0, a, 1, b, 1, s, rcond, irnk, w, 1, info )
202 CALL chkxer(
'DGELSS', infot, nout, lerr, ok )
203 infot = 3
204 CALL dgelss( 0, 0, -1, a, 1, b, 1, s, rcond, irnk, w, 1, info )
205 CALL chkxer(
'DGELSS', infot, nout, lerr, ok )
206 infot = 5
207 CALL dgelss( 2, 0, 0, a, 1, b, 2, s, rcond, irnk, w, 2, info )
208 CALL chkxer(
'DGELSS', infot, nout, lerr, ok )
209 infot = 7
210 CALL dgelss( 2, 0, 0, a, 2, b, 1, s, rcond, irnk, w, 2, info )
211 CALL chkxer(
'DGELSS', infot, nout, lerr, ok )
212
213
214
215 srnamt = 'DGELSY'
216 infot = 1
217 CALL dgelsy( -1, 0, 0, a, 1, b, 1, ip, rcond, irnk, w, 10,
218 $ info )
219 CALL chkxer(
'DGELSY', infot, nout, lerr, ok )
220 infot = 2
221 CALL dgelsy( 0, -1, 0, a, 1, b, 1, ip, rcond, irnk, w, 10,
222 $ info )
223 CALL chkxer(
'DGELSY', infot, nout, lerr, ok )
224 infot = 3
225 CALL dgelsy( 0, 0, -1, a, 1, b, 1, ip, rcond, irnk, w, 10,
226 $ info )
227 CALL chkxer(
'DGELSY', infot, nout, lerr, ok )
228 infot = 5
229 CALL dgelsy( 2, 0, 0, a, 1, b, 2, ip, rcond, irnk, w, 10,
230 $ info )
231 CALL chkxer(
'DGELSY', infot, nout, lerr, ok )
232 infot = 7
233 CALL dgelsy( 2, 0, 0, a, 2, b, 1, ip, rcond, irnk, w, 10,
234 $ info )
235 CALL chkxer(
'DGELSY', infot, nout, lerr, ok )
236 infot = 12
237 CALL dgelsy( 2, 2, 1, a, 2, b, 2, ip, rcond, irnk, w, 1, info )
238 CALL chkxer(
'DGELSY', infot, nout, lerr, ok )
239
240
241
242 srnamt = 'DGELSD'
243 infot = 1
244 CALL dgelsd( -1, 0, 0, a, 1, b, 1, s, rcond, irnk, w, 10, ip,
245 $ info )
246 CALL chkxer(
'DGELSD', infot, nout, lerr, ok )
247 infot = 2
248 CALL dgelsd( 0, -1, 0, a, 1, b, 1, s, rcond, irnk, w, 10, ip,
249 $ info )
250 CALL chkxer(
'DGELSD', infot, nout, lerr, ok )
251 infot = 3
252 CALL dgelsd( 0, 0, -1, a, 1, b, 1, s, rcond, irnk, w, 10, ip,
253 $ info )
254 CALL chkxer(
'DGELSD', infot, nout, lerr, ok )
255 infot = 5
256 CALL dgelsd( 2, 0, 0, a, 1, b, 2, s, rcond, irnk, w, 10, ip,
257 $ info )
258 CALL chkxer(
'DGELSD', infot, nout, lerr, ok )
259 infot = 7
260 CALL dgelsd( 2, 0, 0, a, 2, b, 1, s, rcond, irnk, w, 10, ip,
261 $ info )
262 CALL chkxer(
'DGELSD', infot, nout, lerr, ok )
263 infot = 12
264 CALL dgelsd( 2, 2, 1, a, 2, b, 2, s, rcond, irnk, w, 1, ip,
265 $ info )
266 CALL chkxer(
'DGELSD', 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 dgels(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
DGELS solves overdetermined or underdetermined systems for GE matrices
subroutine dgelsd(m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, iwork, info)
DGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices
subroutine dgelss(m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, info)
DGELSS solves overdetermined or underdetermined systems for GE matrices
subroutine dgelst(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
DGELST solves overdetermined or underdetermined systems for GE matrices using QR or LQ factorization ...
subroutine dgelsy(m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank, work, lwork, info)
DGELSY solves overdetermined or underdetermined systems for GE matrices
subroutine dgetsls(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
DGETSLS
logical function lsamen(n, ca, cb)
LSAMEN