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 RW( NMAX ), S( NMAX )
79 COMPLEX A( NMAX, NMAX ), B( NMAX, NMAX ), 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 c2 = path( 2: 3 )
102 a( 1, 1 ) = ( 1.0e+0, 0.0e+0 )
103 a( 1, 2 ) = ( 2.0e+0, 0.0e+0 )
104 a( 2, 2 ) = ( 3.0e+0, 0.0e+0 )
105 a( 2, 1 ) = ( 4.0e+0, 0.0e+0 )
106 ok = .true.
107 WRITE( nout, fmt = * )
108
109
110
111 IF(
lsamen( 2, c2,
'LS' ) )
THEN
112
113
114
115 srnamt = 'CGELS '
116 infot = 1
117 CALL cgels(
'/', 0, 0, 0, a, 1, b, 1, w, 1, info )
118 CALL chkxer(
'CGELS ', infot, nout, lerr, ok )
119 infot = 2
120 CALL cgels(
'N', -1, 0, 0, a, 1, b, 1, w, 1, info )
121 CALL chkxer(
'CGELS ', infot, nout, lerr, ok )
122 infot = 3
123 CALL cgels(
'N', 0, -1, 0, a, 1, b, 1, w, 1, info )
124 CALL chkxer(
'CGELS ', infot, nout, lerr, ok )
125 infot = 4
126 CALL cgels(
'N', 0, 0, -1, a, 1, b, 1, w, 1, info )
127 CALL chkxer(
'CGELS ', infot, nout, lerr, ok )
128 infot = 6
129 CALL cgels(
'N', 2, 0, 0, a, 1, b, 2, w, 2, info )
130 CALL chkxer(
'CGELS ', infot, nout, lerr, ok )
131 infot = 8
132 CALL cgels(
'N', 2, 0, 0, a, 2, b, 1, w, 2, info )
133 CALL chkxer(
'CGELS ', infot, nout, lerr, ok )
134 infot = 8
135 CALL cgels(
'N', 0, 2, 0, a, 1, b, 1, w, 2, info )
136 CALL chkxer(
'CGELS', infot, nout, lerr, ok )
137 infot = 10
138 CALL cgels(
'N', 1, 1, 0, a, 1, b, 1, w, 1, info )
139 CALL chkxer(
'CGELS ', infot, nout, lerr, ok )
140
141
142
143 srnamt = 'CGELST'
144 infot = 1
145 CALL cgelst(
'/', 0, 0, 0, a, 1, b, 1, w, 1, info )
146 CALL chkxer(
'CGELST', infot, nout, lerr, ok )
147 infot = 2
148 CALL cgelst(
'N', -1, 0, 0, a, 1, b, 1, w, 1, info )
149 CALL chkxer(
'CGELST', infot, nout, lerr, ok )
150 infot = 3
151 CALL cgelst(
'N', 0, -1, 0, a, 1, b, 1, w, 1, info )
152 CALL chkxer(
'CGELST', infot, nout, lerr, ok )
153 infot = 4
154 CALL cgelst(
'N', 0, 0, -1, a, 1, b, 1, w, 1, info )
155 CALL chkxer(
'CGELST', infot, nout, lerr, ok )
156 infot = 6
157 CALL cgelst(
'N', 2, 0, 0, a, 1, b, 2, w, 2, info )
158 CALL chkxer(
'CGELST', infot, nout, lerr, ok )
159 infot = 8
160 CALL cgelst(
'N', 2, 0, 0, a, 2, b, 1, w, 2, info )
161 CALL chkxer(
'CGELST', infot, nout, lerr, ok )
162 infot = 8
163 CALL cgelst(
'N', 0, 2, 0, a, 1, b, 1, w, 2, info )
164 CALL chkxer(
'CGELST', infot, nout, lerr, ok )
165 infot = 10
166 CALL cgelst(
'N', 1, 1, 0, a, 1, b, 1, w, 1, info )
167 CALL chkxer(
'CGELST', infot, nout, lerr, ok )
168
169
170
171 srnamt = 'CGETSLS'
172 infot = 1
173 CALL cgetsls(
'/', 0, 0, 0, a, 1, b, 1, w, 1, info )
174 CALL chkxer(
'CGETSLS', infot, nout, lerr, ok )
175 infot = 2
176 CALL cgetsls(
'N', -1, 0, 0, a, 1, b, 1, w, 1, info )
177 CALL chkxer(
'CGETSLS', infot, nout, lerr, ok )
178 infot = 3
179 CALL cgetsls(
'N', 0, -1, 0, a, 1, b, 1, w, 1, info )
180 CALL chkxer(
'CGETSLS', infot, nout, lerr, ok )
181 infot = 4
182 CALL cgetsls(
'N', 0, 0, -1, a, 1, b, 1, w, 1, info )
183 CALL chkxer(
'CGETSLS', infot, nout, lerr, ok )
184 infot = 6
185 CALL cgetsls(
'N', 2, 0, 0, a, 1, b, 2, w, 2, info )
186 CALL chkxer(
'CGETSLS', infot, nout, lerr, ok )
187 infot = 8
188 CALL cgetsls(
'N', 2, 0, 0, a, 2, b, 1, w, 2, info )
189 CALL chkxer(
'CGETSLS', infot, nout, lerr, ok )
190 infot = 8
191 CALL cgetsls(
'N', 0, 2, 0, a, 1, b, 1, w, 2, info )
192 CALL chkxer(
'CGETSLS', infot, nout, lerr, ok )
193
194
195
196 srnamt = 'CGELSS'
197 infot = 1
198 CALL cgelss( -1, 0, 0, a, 1, b, 1, s, rcond, irnk, w, 1, rw,
199 $ info )
200 CALL chkxer(
'CGELSS', infot, nout, lerr, ok )
201 infot = 2
202 CALL cgelss( 0, -1, 0, a, 1, b, 1, s, rcond, irnk, w, 1, rw,
203 $ info )
204 CALL chkxer(
'CGELSS', infot, nout, lerr, ok )
205 infot = 3
206 CALL cgelss( 0, 0, -1, a, 1, b, 1, s, rcond, irnk, w, 1, rw,
207 $ info )
208 CALL chkxer(
'CGELSS', infot, nout, lerr, ok )
209 infot = 5
210 CALL cgelss( 2, 0, 0, a, 1, b, 2, s, rcond, irnk, w, 2, rw,
211 $ info )
212 CALL chkxer(
'CGELSS', infot, nout, lerr, ok )
213 infot = 7
214 CALL cgelss( 2, 0, 0, a, 2, b, 1, s, rcond, irnk, w, 2, rw,
215 $ info )
216 CALL chkxer(
'CGELSS', infot, nout, lerr, ok )
217
218
219
220 srnamt = 'CGELSY'
221 infot = 1
222 CALL cgelsy( -1, 0, 0, a, 1, b, 1, ip, rcond, irnk, w, 10, rw,
223 $ info )
224 CALL chkxer(
'CGELSY', infot, nout, lerr, ok )
225 infot = 2
226 CALL cgelsy( 0, -1, 0, a, 1, b, 1, ip, rcond, irnk, w, 10, rw,
227 $ info )
228 CALL chkxer(
'CGELSY', infot, nout, lerr, ok )
229 infot = 3
230 CALL cgelsy( 0, 0, -1, a, 1, b, 1, ip, rcond, irnk, w, 10, rw,
231 $ info )
232 CALL chkxer(
'CGELSY', infot, nout, lerr, ok )
233 infot = 5
234 CALL cgelsy( 2, 0, 0, a, 1, b, 2, ip, rcond, irnk, w, 10, rw,
235 $ info )
236 CALL chkxer(
'CGELSY', infot, nout, lerr, ok )
237 infot = 7
238 CALL cgelsy( 2, 0, 0, a, 2, b, 1, ip, rcond, irnk, w, 10, rw,
239 $ info )
240 CALL chkxer(
'CGELSY', infot, nout, lerr, ok )
241 infot = 12
242 CALL cgelsy( 0, 3, 0, a, 1, b, 3, ip, rcond, irnk, w, 1, rw,
243 $ info )
244 CALL chkxer(
'CGELSY', infot, nout, lerr, ok )
245
246
247
248 srnamt = 'CGELSD'
249 infot = 1
250 CALL cgelsd( -1, 0, 0, a, 1, b, 1, s, rcond, irnk, w, 10,
251 $ rw, ip, info )
252 CALL chkxer(
'CGELSD', infot, nout, lerr, ok )
253 infot = 2
254 CALL cgelsd( 0, -1, 0, a, 1, b, 1, s, rcond, irnk, w, 10,
255 $ rw, ip, info )
256 CALL chkxer(
'CGELSD', infot, nout, lerr, ok )
257 infot = 3
258 CALL cgelsd( 0, 0, -1, a, 1, b, 1, s, rcond, irnk, w, 10,
259 $ rw, ip, info )
260 CALL chkxer(
'CGELSD', infot, nout, lerr, ok )
261 infot = 5
262 CALL cgelsd( 2, 0, 0, a, 1, b, 2, s, rcond, irnk, w, 10,
263 $ rw, ip, info )
264 CALL chkxer(
'CGELSD', infot, nout, lerr, ok )
265 infot = 7
266 CALL cgelsd( 2, 0, 0, a, 2, b, 1, s, rcond, irnk, w, 10,
267 $ rw, ip, info )
268 CALL chkxer(
'CGELSD', infot, nout, lerr, ok )
269 infot = 12
270 CALL cgelsd( 2, 2, 1, a, 2, b, 2, s, rcond, irnk, w, 1,
271 $ rw, ip, info )
272 CALL chkxer(
'CGELSD', infot, nout, lerr, ok )
273 END IF
274
275
276
277 CALL alaesm( path, ok, nout )
278
279 RETURN
280
281
282
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine cgels(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
CGELS solves overdetermined or underdetermined systems for GE matrices
subroutine cgelsd(m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, rwork, iwork, info)
CGELSD computes the minimum-norm solution to a linear least squares problem for GE matrices
subroutine cgelss(m, n, nrhs, a, lda, b, ldb, s, rcond, rank, work, lwork, rwork, info)
CGELSS solves overdetermined or underdetermined systems for GE matrices
subroutine cgelst(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
CGELST solves overdetermined or underdetermined systems for GE matrices using QR or LQ factorization ...
subroutine cgelsy(m, n, nrhs, a, lda, b, ldb, jpvt, rcond, rank, work, lwork, rwork, info)
CGELSY solves overdetermined or underdetermined systems for GE matrices
subroutine cgetsls(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
CGETSLS
logical function lsamen(n, ca, cb)
LSAMEN