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