55
56
57
58
59
60
61 CHARACTER*3 PATH
62 INTEGER NUNIT
63
64
65
66
67
68 INTEGER NMAX
69 parameter( nmax = 4 )
70
71
72 CHARACTER EQ
73 CHARACTER*2 C2
74 INTEGER I, INFO, J
75 DOUBLE PRECISION RCOND
76
77
78 INTEGER IP( NMAX ), IW( NMAX )
79 DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
80 $ C( NMAX ), E( NMAX ), R( NMAX ), R1( NMAX ),
81 $ R2( NMAX ), W( 2*NMAX ), X( NMAX )
82
83
84 LOGICAL LSAMEN
86
87
93
94
95 LOGICAL LERR, OK
96 CHARACTER*32 SRNAMT
97 INTEGER INFOT, NOUT
98
99
100 COMMON / infoc / infot, nout, ok, lerr
101 COMMON / srnamc / srnamt
102
103
104 INTRINSIC dble
105
106
107
108 nout = nunit
109 WRITE( nout, fmt = * )
110 c2 = path( 2: 3 )
111
112
113
114 DO 20 j = 1, nmax
115 DO 10 i = 1, nmax
116 a( i, j ) = 1.d0 / dble( i+j )
117 af( i, j ) = 1.d0 / dble( i+j )
118 10 CONTINUE
119 b( j ) = 0.d+0
120 e( j ) = 0.d+0
121 r1( j ) = 0.d+0
122 r2( j ) = 0.d+0
123 w( j ) = 0.d+0
124 x( j ) = 0.d+0
125 c( j ) = 0.d+0
126 r( j ) = 0.d+0
127 ip( j ) = j
128 20 CONTINUE
129 eq = ' '
130 ok = .true.
131
132 IF(
lsamen( 2, c2,
'GE' ) )
THEN
133
134
135
136 srnamt = 'DGESV '
137 infot = 1
138 CALL dgesv( -1, 0, a, 1, ip, b, 1, info )
139 CALL chkxer(
'DGESV ', infot, nout, lerr, ok )
140 infot = 2
141 CALL dgesv( 0, -1, a, 1, ip, b, 1, info )
142 CALL chkxer(
'DGESV ', infot, nout, lerr, ok )
143 infot = 4
144 CALL dgesv( 2, 1, a, 1, ip, b, 2, info )
145 CALL chkxer(
'DGESV ', infot, nout, lerr, ok )
146 infot = 7
147 CALL dgesv( 2, 1, a, 2, ip, b, 1, info )
148 CALL chkxer(
'DGESV ', infot, nout, lerr, ok )
149
150
151
152 srnamt = 'DGESVX'
153 infot = 1
154 CALL dgesvx(
'/',
'N', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
155 $ x, 1, rcond, r1, r2, w, iw, info )
156 CALL chkxer(
'DGESVX', infot, nout, lerr, ok )
157 infot = 2
158 CALL dgesvx(
'N',
'/', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
159 $ x, 1, rcond, r1, r2, w, iw, info )
160 CALL chkxer(
'DGESVX', infot, nout, lerr, ok )
161 infot = 3
162 CALL dgesvx(
'N',
'N', -1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
163 $ x, 1, rcond, r1, r2, w, iw, info )
164 CALL chkxer(
'DGESVX', infot, nout, lerr, ok )
165 infot = 4
166 CALL dgesvx(
'N',
'N', 0, -1, a, 1, af, 1, ip, eq, r, c, b, 1,
167 $ x, 1, rcond, r1, r2, w, iw, info )
168 CALL chkxer(
'DGESVX', infot, nout, lerr, ok )
169 infot = 6
170 CALL dgesvx(
'N',
'N', 2, 1, a, 1, af, 2, ip, eq, r, c, b, 2,
171 $ x, 2, rcond, r1, r2, w, iw, info )
172 CALL chkxer(
'DGESVX', infot, nout, lerr, ok )
173 infot = 8
174 CALL dgesvx(
'N',
'N', 2, 1, a, 2, af, 1, ip, eq, r, c, b, 2,
175 $ x, 2, rcond, r1, r2, w, iw, info )
176 CALL chkxer(
'DGESVX', infot, nout, lerr, ok )
177 infot = 10
178 eq = '/'
179 CALL dgesvx(
'F',
'N', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
180 $ x, 1, rcond, r1, r2, w, iw, info )
181 CALL chkxer(
'DGESVX', infot, nout, lerr, ok )
182 infot = 11
183 eq = 'R'
184 CALL dgesvx(
'F',
'N', 1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
185 $ x, 1, rcond, r1, r2, w, iw, info )
186 CALL chkxer(
'DGESVX', infot, nout, lerr, ok )
187 infot = 12
188 eq = 'C'
189 CALL dgesvx(
'F',
'N', 1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
190 $ x, 1, rcond, r1, r2, w, iw, info )
191 CALL chkxer(
'DGESVX', infot, nout, lerr, ok )
192 infot = 14
193 CALL dgesvx(
'N',
'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b, 1,
194 $ x, 2, rcond, r1, r2, w, iw, info )
195 CALL chkxer(
'DGESVX', infot, nout, lerr, ok )
196 infot = 16
197 CALL dgesvx(
'N',
'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b, 2,
198 $ x, 1, rcond, r1, r2, w, iw, info )
199 CALL chkxer(
'DGESVX', infot, nout, lerr, ok )
200
201 ELSE IF(
lsamen( 2, c2,
'GB' ) )
THEN
202
203
204
205 srnamt = 'DGBSV '
206 infot = 1
207 CALL dgbsv( -1, 0, 0, 0, a, 1, ip, b, 1, info )
208 CALL chkxer(
'DGBSV ', infot, nout, lerr, ok )
209 infot = 2
210 CALL dgbsv( 1, -1, 0, 0, a, 1, ip, b, 1, info )
211 CALL chkxer(
'DGBSV ', infot, nout, lerr, ok )
212 infot = 3
213 CALL dgbsv( 1, 0, -1, 0, a, 1, ip, b, 1, info )
214 CALL chkxer(
'DGBSV ', infot, nout, lerr, ok )
215 infot = 4
216 CALL dgbsv( 0, 0, 0, -1, a, 1, ip, b, 1, info )
217 CALL chkxer(
'DGBSV ', infot, nout, lerr, ok )
218 infot = 6
219 CALL dgbsv( 1, 1, 1, 0, a, 3, ip, b, 1, info )
220 CALL chkxer(
'DGBSV ', infot, nout, lerr, ok )
221 infot = 9
222 CALL dgbsv( 2, 0, 0, 0, a, 1, ip, b, 1, info )
223 CALL chkxer(
'DGBSV ', infot, nout, lerr, ok )
224
225
226
227 srnamt = 'DGBSVX'
228 infot = 1
229 CALL dgbsvx(
'/',
'N', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
230 $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
231 CALL chkxer(
'DGBSVX', infot, nout, lerr, ok )
232 infot = 2
233 CALL dgbsvx(
'N',
'/', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
234 $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
235 CALL chkxer(
'DGBSVX', infot, nout, lerr, ok )
236 infot = 3
237 CALL dgbsvx(
'N',
'N', -1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
238 $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
239 CALL chkxer(
'DGBSVX', infot, nout, lerr, ok )
240 infot = 4
241 CALL dgbsvx(
'N',
'N', 1, -1, 0, 0, a, 1, af, 1, ip, eq, r, c,
242 $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
243 CALL chkxer(
'DGBSVX', infot, nout, lerr, ok )
244 infot = 5
245 CALL dgbsvx(
'N',
'N', 1, 0, -1, 0, a, 1, af, 1, ip, eq, r, c,
246 $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
247 CALL chkxer(
'DGBSVX', infot, nout, lerr, ok )
248 infot = 6
249 CALL dgbsvx(
'N',
'N', 0, 0, 0, -1, a, 1, af, 1, ip, eq, r, c,
250 $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
251 CALL chkxer(
'DGBSVX', infot, nout, lerr, ok )
252 infot = 8
253 CALL dgbsvx(
'N',
'N', 1, 1, 1, 0, a, 2, af, 4, ip, eq, r, c,
254 $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
255 CALL chkxer(
'DGBSVX', infot, nout, lerr, ok )
256 infot = 10
257 CALL dgbsvx(
'N',
'N', 1, 1, 1, 0, a, 3, af, 3, ip, eq, r, c,
258 $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
259 CALL chkxer(
'DGBSVX', infot, nout, lerr, ok )
260 infot = 12
261 eq = '/'
262 CALL dgbsvx(
'F',
'N', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
263 $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
264 CALL chkxer(
'DGBSVX', infot, nout, lerr, ok )
265 infot = 13
266 eq = 'R'
267 CALL dgbsvx(
'F',
'N', 1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
268 $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
269 CALL chkxer(
'DGBSVX', infot, nout, lerr, ok )
270 infot = 14
271 eq = 'C'
272 CALL dgbsvx(
'F',
'N', 1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
273 $ b, 1, x, 1, rcond, r1, r2, w, iw, info )
274 CALL chkxer(
'DGBSVX', infot, nout, lerr, ok )
275 infot = 16
276 CALL dgbsvx(
'N',
'N', 2, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
277 $ b, 1, x, 2, rcond, r1, r2, w, iw, info )
278 CALL chkxer(
'DGBSVX', infot, nout, lerr, ok )
279 infot = 18
280 CALL dgbsvx(
'N',
'N', 2, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
281 $ b, 2, x, 1, rcond, r1, r2, w, iw, info )
282 CALL chkxer(
'DGBSVX', infot, nout, lerr, ok )
283
284 ELSE IF(
lsamen( 2, c2,
'GT' ) )
THEN
285
286
287
288 srnamt = 'DGTSV '
289 infot = 1
290 CALL dgtsv( -1, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1,
291 $ info )
292 CALL chkxer(
'DGTSV ', infot, nout, lerr, ok )
293 infot = 2
294 CALL dgtsv( 0, -1, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1,
295 $ info )
296 CALL chkxer(
'DGTSV ', infot, nout, lerr, ok )
297 infot = 7
298 CALL dgtsv( 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1, info )
299 CALL chkxer(
'DGTSV ', infot, nout, lerr, ok )
300
301
302
303 srnamt = 'DGTSVX'
304 infot = 1
305 CALL dgtsvx(
'/',
'N', 0, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
306 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
307 $ ip, b, 1, x, 1, rcond, r1, r2, w, iw, info )
308 CALL chkxer(
'DGTSVX', infot, nout, lerr, ok )
309 infot = 2
310 CALL dgtsvx(
'N',
'/', 0, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
311 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
312 $ ip, b, 1, x, 1, rcond, r1, r2, w, iw, info )
313 CALL chkxer(
'DGTSVX', infot, nout, lerr, ok )
314 infot = 3
315 CALL dgtsvx(
'N',
'N', -1, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
316 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
317 $ ip, b, 1, x, 1, rcond, r1, r2, w, iw, info )
318 CALL chkxer(
'DGTSVX', infot, nout, lerr, ok )
319 infot = 4
320 CALL dgtsvx(
'N',
'N', 0, -1, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
321 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
322 $ ip, b, 1, x, 1, rcond, r1, r2, w, iw, info )
323 CALL chkxer(
'DGTSVX', infot, nout, lerr, ok )
324 infot = 14
325 CALL dgtsvx(
'N',
'N', 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
326 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
327 $ ip, b, 1, x, 2, rcond, r1, r2, w, iw, info )
328 CALL chkxer(
'DGTSVX', infot, nout, lerr, ok )
329 infot = 16
330 CALL dgtsvx(
'N',
'N', 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
331 $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
332 $ ip, b, 2, x, 1, rcond, r1, r2, w, iw, info )
333 CALL chkxer(
'DGTSVX', infot, nout, lerr, ok )
334
335 ELSE IF(
lsamen( 2, c2,
'PO' ) )
THEN
336
337
338
339 srnamt = 'DPOSV '
340 infot = 1
341 CALL dposv(
'/', 0, 0, a, 1, b, 1, info )
342 CALL chkxer(
'DPOSV ', infot, nout, lerr, ok )
343 infot = 2
344 CALL dposv(
'U', -1, 0, a, 1, b, 1, info )
345 CALL chkxer(
'DPOSV ', infot, nout, lerr, ok )
346 infot = 3
347 CALL dposv(
'U', 0, -1, a, 1, b, 1, info )
348 CALL chkxer(
'DPOSV ', infot, nout, lerr, ok )
349 infot = 5
350 CALL dposv(
'U', 2, 0, a, 1, b, 2, info )
351 CALL chkxer(
'DPOSV ', infot, nout, lerr, ok )
352 infot = 7
353 CALL dposv(
'U', 2, 0, a, 2, b, 1, info )
354 CALL chkxer(
'DPOSV ', infot, nout, lerr, ok )
355
356
357
358 srnamt = 'DPOSVX'
359 infot = 1
360 CALL dposvx(
'/',
'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
361 $ rcond, r1, r2, w, iw, info )
362 CALL chkxer(
'DPOSVX', infot, nout, lerr, ok )
363 infot = 2
364 CALL dposvx(
'N',
'/', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
365 $ rcond, r1, r2, w, iw, info )
366 CALL chkxer(
'DPOSVX', infot, nout, lerr, ok )
367 infot = 3
368 CALL dposvx(
'N',
'U', -1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
369 $ rcond, r1, r2, w, iw, info )
370 CALL chkxer(
'DPOSVX', infot, nout, lerr, ok )
371 infot = 4
372 CALL dposvx(
'N',
'U', 0, -1, a, 1, af, 1, eq, c, b, 1, x, 1,
373 $ rcond, r1, r2, w, iw, info )
374 CALL chkxer(
'DPOSVX', infot, nout, lerr, ok )
375 infot = 6
376 CALL dposvx(
'N',
'U', 2, 0, a, 1, af, 2, eq, c, b, 2, x, 2,
377 $ rcond, r1, r2, w, iw, info )
378 CALL chkxer(
'DPOSVX', infot, nout, lerr, ok )
379 infot = 8
380 CALL dposvx(
'N',
'U', 2, 0, a, 2, af, 1, eq, c, b, 2, x, 2,
381 $ rcond, r1, r2, w, iw, info )
382 CALL chkxer(
'DPOSVX', infot, nout, lerr, ok )
383 infot = 9
384 eq = '/'
385 CALL dposvx(
'F',
'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
386 $ rcond, r1, r2, w, iw, info )
387 CALL chkxer(
'DPOSVX', infot, nout, lerr, ok )
388 infot = 10
389 eq = 'Y'
390 CALL dposvx(
'F',
'U', 1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
391 $ rcond, r1, r2, w, iw, info )
392 CALL chkxer(
'DPOSVX', infot, nout, lerr, ok )
393 infot = 12
394 CALL dposvx(
'N',
'U', 2, 0, a, 2, af, 2, eq, c, b, 1, x, 2,
395 $ rcond, r1, r2, w, iw, info )
396 CALL chkxer(
'DPOSVX', infot, nout, lerr, ok )
397 infot = 14
398 CALL dposvx(
'N',
'U', 2, 0, a, 2, af, 2, eq, c, b, 2, x, 1,
399 $ rcond, r1, r2, w, iw, info )
400 CALL chkxer(
'DPOSVX', infot, nout, lerr, ok )
401
402 ELSE IF(
lsamen( 2, c2,
'PP' ) )
THEN
403
404
405
406 srnamt = 'DPPSV '
407 infot = 1
408 CALL dppsv(
'/', 0, 0, a, b, 1, info )
409 CALL chkxer(
'DPPSV ', infot, nout, lerr, ok )
410 infot = 2
411 CALL dppsv(
'U', -1, 0, a, b, 1, info )
412 CALL chkxer(
'DPPSV ', infot, nout, lerr, ok )
413 infot = 3
414 CALL dppsv(
'U', 0, -1, a, b, 1, info )
415 CALL chkxer(
'DPPSV ', infot, nout, lerr, ok )
416 infot = 6
417 CALL dppsv(
'U', 2, 0, a, b, 1, info )
418 CALL chkxer(
'DPPSV ', infot, nout, lerr, ok )
419
420
421
422 srnamt = 'DPPSVX'
423 infot = 1
424 CALL dppsvx(
'/',
'U', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
425 $ r1, r2, w, iw, info )
426 CALL chkxer(
'DPPSVX', infot, nout, lerr, ok )
427 infot = 2
428 CALL dppsvx(
'N',
'/', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
429 $ r1, r2, w, iw, info )
430 CALL chkxer(
'DPPSVX', infot, nout, lerr, ok )
431 infot = 3
432 CALL dppsvx(
'N',
'U', -1, 0, a, af, eq, c, b, 1, x, 1, rcond,
433 $ r1, r2, w, iw, info )
434 CALL chkxer(
'DPPSVX', infot, nout, lerr, ok )
435 infot = 4
436 CALL dppsvx(
'N',
'U', 0, -1, a, af, eq, c, b, 1, x, 1, rcond,
437 $ r1, r2, w, iw, info )
438 CALL chkxer(
'DPPSVX', infot, nout, lerr, ok )
439 infot = 7
440 eq = '/'
441 CALL dppsvx(
'F',
'U', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
442 $ r1, r2, w, iw, info )
443 CALL chkxer(
'DPPSVX', infot, nout, lerr, ok )
444 infot = 8
445 eq = 'Y'
446 CALL dppsvx(
'F',
'U', 1, 0, a, af, eq, c, b, 1, x, 1, rcond,
447 $ r1, r2, w, iw, info )
448 CALL chkxer(
'DPPSVX', infot, nout, lerr, ok )
449 infot = 10
450 CALL dppsvx(
'N',
'U', 2, 0, a, af, eq, c, b, 1, x, 2, rcond,
451 $ r1, r2, w, iw, info )
452 CALL chkxer(
'DPPSVX', infot, nout, lerr, ok )
453 infot = 12
454 CALL dppsvx(
'N',
'U', 2, 0, a, af, eq, c, b, 2, x, 1, rcond,
455 $ r1, r2, w, iw, info )
456 CALL chkxer(
'DPPSVX', infot, nout, lerr, ok )
457
458 ELSE IF(
lsamen( 2, c2,
'PB' ) )
THEN
459
460
461
462 srnamt = 'DPBSV '
463 infot = 1
464 CALL dpbsv(
'/', 0, 0, 0, a, 1, b, 1, info )
465 CALL chkxer(
'DPBSV ', infot, nout, lerr, ok )
466 infot = 2
467 CALL dpbsv(
'U', -1, 0, 0, a, 1, b, 1, info )
468 CALL chkxer(
'DPBSV ', infot, nout, lerr, ok )
469 infot = 3
470 CALL dpbsv(
'U', 1, -1, 0, a, 1, b, 1, info )
471 CALL chkxer(
'DPBSV ', infot, nout, lerr, ok )
472 infot = 4
473 CALL dpbsv(
'U', 0, 0, -1, a, 1, b, 1, info )
474 CALL chkxer(
'DPBSV ', infot, nout, lerr, ok )
475 infot = 6
476 CALL dpbsv(
'U', 1, 1, 0, a, 1, b, 2, info )
477 CALL chkxer(
'DPBSV ', infot, nout, lerr, ok )
478 infot = 8
479 CALL dpbsv(
'U', 2, 0, 0, a, 1, b, 1, info )
480 CALL chkxer(
'DPBSV ', infot, nout, lerr, ok )
481
482
483
484 srnamt = 'DPBSVX'
485 infot = 1
486 CALL dpbsvx(
'/',
'U', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
487 $ rcond, r1, r2, w, iw, info )
488 CALL chkxer(
'DPBSVX', infot, nout, lerr, ok )
489 infot = 2
490 CALL dpbsvx(
'N',
'/', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
491 $ rcond, r1, r2, w, iw, info )
492 CALL chkxer(
'DPBSVX', infot, nout, lerr, ok )
493 infot = 3
494 CALL dpbsvx(
'N',
'U', -1, 0, 0, a, 1, af, 1, eq, c, b, 1, x,
495 $ 1, rcond, r1, r2, w, iw, info )
496 CALL chkxer(
'DPBSVX', infot, nout, lerr, ok )
497 infot = 4
498 CALL dpbsvx(
'N',
'U', 1, -1, 0, a, 1, af, 1, eq, c, b, 1, x,
499 $ 1, rcond, r1, r2, w, iw, info )
500 CALL chkxer(
'DPBSVX', infot, nout, lerr, ok )
501 infot = 5
502 CALL dpbsvx(
'N',
'U', 0, 0, -1, a, 1, af, 1, eq, c, b, 1, x,
503 $ 1, rcond, r1, r2, w, iw, info )
504 CALL chkxer(
'DPBSVX', infot, nout, lerr, ok )
505 infot = 7
506 CALL dpbsvx(
'N',
'U', 1, 1, 0, a, 1, af, 2, eq, c, b, 2, x, 2,
507 $ rcond, r1, r2, w, iw, info )
508 CALL chkxer(
'DPBSVX', infot, nout, lerr, ok )
509 infot = 9
510 CALL dpbsvx(
'N',
'U', 1, 1, 0, a, 2, af, 1, eq, c, b, 2, x, 2,
511 $ rcond, r1, r2, w, iw, info )
512 CALL chkxer(
'DPBSVX', infot, nout, lerr, ok )
513 infot = 10
514 eq = '/'
515 CALL dpbsvx(
'F',
'U', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
516 $ rcond, r1, r2, w, iw, info )
517 CALL chkxer(
'DPBSVX', infot, nout, lerr, ok )
518 infot = 11
519 eq = 'Y'
520 CALL dpbsvx(
'F',
'U', 1, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
521 $ rcond, r1, r2, w, iw, info )
522 CALL chkxer(
'DPBSVX', infot, nout, lerr, ok )
523 infot = 13
524 CALL dpbsvx(
'N',
'U', 2, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 2,
525 $ rcond, r1, r2, w, iw, info )
526 CALL chkxer(
'DPBSVX', infot, nout, lerr, ok )
527 infot = 15
528 CALL dpbsvx(
'N',
'U', 2, 0, 0, a, 1, af, 1, eq, c, b, 2, x, 1,
529 $ rcond, r1, r2, w, iw, info )
530 CALL chkxer(
'DPBSVX', infot, nout, lerr, ok )
531
532 ELSE IF(
lsamen( 2, c2,
'PT' ) )
THEN
533
534
535
536 srnamt = 'DPTSV '
537 infot = 1
538 CALL dptsv( -1, 0, a( 1, 1 ), a( 1, 2 ), b, 1, info )
539 CALL chkxer(
'DPTSV ', infot, nout, lerr, ok )
540 infot = 2
541 CALL dptsv( 0, -1, a( 1, 1 ), a( 1, 2 ), b, 1, info )
542 CALL chkxer(
'DPTSV ', infot, nout, lerr, ok )
543 infot = 6
544 CALL dptsv( 2, 0, a( 1, 1 ), a( 1, 2 ), b, 1, info )
545 CALL chkxer(
'DPTSV ', infot, nout, lerr, ok )
546
547
548
549 srnamt = 'DPTSVX'
550 infot = 1
551 CALL dptsvx(
'/', 0, 0, a( 1, 1 ), a( 1, 2 ), af( 1, 1 ),
552 $ af( 1, 2 ), b, 1, x, 1, rcond, r1, r2, w, info )
553 CALL chkxer(
'DPTSVX', infot, nout, lerr, ok )
554 infot = 2
555 CALL dptsvx(
'N', -1, 0, a( 1, 1 ), a( 1, 2 ), af( 1, 1 ),
556 $ af( 1, 2 ), b, 1, x, 1, rcond, r1, r2, w, info )
557 CALL chkxer(
'DPTSVX', infot, nout, lerr, ok )
558 infot = 3
559 CALL dptsvx(
'N', 0, -1, a( 1, 1 ), a( 1, 2 ), af( 1, 1 ),
560 $ af( 1, 2 ), b, 1, x, 1, rcond, r1, r2, w, info )
561 CALL chkxer(
'DPTSVX', infot, nout, lerr, ok )
562 infot = 9
563 CALL dptsvx(
'N', 2, 0, a( 1, 1 ), a( 1, 2 ), af( 1, 1 ),
564 $ af( 1, 2 ), b, 1, x, 2, rcond, r1, r2, w, info )
565 CALL chkxer(
'DPTSVX', infot, nout, lerr, ok )
566 infot = 11
567 CALL dptsvx(
'N', 2, 0, a( 1, 1 ), a( 1, 2 ), af( 1, 1 ),
568 $ af( 1, 2 ), b, 2, x, 1, rcond, r1, r2, w, info )
569 CALL chkxer(
'DPTSVX', infot, nout, lerr, ok )
570
571 ELSE IF(
lsamen( 2, c2,
'SY' ) )
THEN
572
573
574
575 srnamt = 'DSYSV '
576 infot = 1
577 CALL dsysv(
'/', 0, 0, a, 1, ip, b, 1, w, 1, info )
578 CALL chkxer(
'DSYSV ', infot, nout, lerr, ok )
579 infot = 2
580 CALL dsysv(
'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
581 CALL chkxer(
'DSYSV ', infot, nout, lerr, ok )
582 infot = 3
583 CALL dsysv(
'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
584 CALL chkxer(
'DSYSV ', infot, nout, lerr, ok )
585 infot = 5
586 CALL dsysv(
'U', 2, 0, a, 1, ip, b, 2, w, 1, info )
587 CALL chkxer(
'DSYSV_ROOK', infot, nout, lerr, ok )
588 infot = 8
589 CALL dsysv(
'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
590 CALL chkxer(
'DSYSV ', infot, nout, lerr, ok )
591 infot = 10
592 CALL dsysv(
'U', 0, 0, a, 1, ip, b, 1, w, 0, info )
593 CALL chkxer(
'DSYSV ', infot, nout, lerr, ok )
594 infot = 10
595 CALL dsysv(
'U', 0, 0, a, 1, ip, b, 1, w, -2, info )
596 CALL chkxer(
'DSYSV ', infot, nout, lerr, ok )
597
598
599
600 srnamt = 'DSYSVX'
601 infot = 1
602 CALL dsysvx(
'/',
'U', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
603 $ rcond, r1, r2, w, 1, iw, info )
604 CALL chkxer(
'DSYSVX', infot, nout, lerr, ok )
605 infot = 2
606 CALL dsysvx(
'N',
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
607 $ rcond, r1, r2, w, 1, iw, info )
608 CALL chkxer(
'DSYSVX', infot, nout, lerr, ok )
609 infot = 3
610 CALL dsysvx(
'N',
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1,
611 $ rcond, r1, r2, w, 1, iw, info )
612 CALL chkxer(
'DSYSVX', infot, nout, lerr, ok )
613 infot = 4
614 CALL dsysvx(
'N',
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1,
615 $ rcond, r1, r2, w, 1, iw, info )
616 CALL chkxer(
'DSYSVX', infot, nout, lerr, ok )
617 infot = 6
618 CALL dsysvx(
'N',
'U', 2, 0, a, 1, af, 2, ip, b, 2, x, 2,
619 $ rcond, r1, r2, w, 4, iw, info )
620 CALL chkxer(
'DSYSVX', infot, nout, lerr, ok )
621 infot = 8
622 CALL dsysvx(
'N',
'U', 2, 0, a, 2, af, 1, ip, b, 2, x, 2,
623 $ rcond, r1, r2, w, 4, iw, info )
624 CALL chkxer(
'DSYSVX', infot, nout, lerr, ok )
625 infot = 11
626 CALL dsysvx(
'N',
'U', 2, 0, a, 2, af, 2, ip, b, 1, x, 2,
627 $ rcond, r1, r2, w, 4, iw, info )
628 CALL chkxer(
'DSYSVX', infot, nout, lerr, ok )
629 infot = 13
630 CALL dsysvx(
'N',
'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 1,
631 $ rcond, r1, r2, w, 4, iw, info )
632 CALL chkxer(
'DSYSVX', infot, nout, lerr, ok )
633 infot = 18
634 CALL dsysvx(
'N',
'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 2,
635 $ rcond, r1, r2, w, 3, iw, info )
636 CALL chkxer(
'DSYSVX', infot, nout, lerr, ok )
637
638 ELSE IF(
lsamen( 2, c2,
'SR' ) )
THEN
639
640
641
642 srnamt = 'DSYSV_ROOK'
643 infot = 1
644 CALL dsysv_rook(
'/', 0, 0, a, 1, ip, b, 1, w, 1, info )
645 CALL chkxer(
'DSYSV_ROOK', infot, nout, lerr, ok )
646 infot = 2
647 CALL dsysv_rook(
'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
648 CALL chkxer(
'DSYSV_ROOK', infot, nout, lerr, ok )
649 infot = 3
650 CALL dsysv_rook(
'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
651 CALL chkxer(
'DSYSV_ROOK', infot, nout, lerr, ok )
652 infot = 5
653 CALL dsysv_rook(
'U', 2, 0, a, 1, ip, b, 2, w, 1, info )
654 CALL chkxer(
'DSYSV_ROOK', infot, nout, lerr, ok )
655 infot = 8
656 CALL dsysv_rook(
'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
657 CALL chkxer(
'DSYSV_ROOK', infot, nout, lerr, ok )
658 infot = 10
659 CALL dsysv_rook(
'U', 0, 0, a, 1, ip, b, 1, w, 0, info )
660 CALL chkxer(
'DSYSV_ROOK', infot, nout, lerr, ok )
661 infot = 10
662 CALL dsysv_rook(
'U', 0, 0, a, 1, ip, b, 1, w, -2, info )
663 CALL chkxer(
'DSYSV_ROOK', infot, nout, lerr, ok )
664
665 ELSE IF(
lsamen( 2, c2,
'SK' ) )
THEN
666
667
668
669
670
671
672
673
674
675
676
677 srnamt = 'DSYSV_RK'
678 infot = 1
679 CALL dsysv_rk(
'/', 0, 0, a, 1, e, ip, b, 1, w, 1, info )
680 CALL chkxer(
'DSYSV_RK', infot, nout, lerr, ok )
681 infot = 2
682 CALL dsysv_rk(
'U', -1, 0, a, 1, e, ip, b, 1, w, 1, info )
683 CALL chkxer(
'DSYSV_RK', infot, nout, lerr, ok )
684 infot = 3
685 CALL dsysv_rk(
'U', 0, -1, a, 1, e, ip, b, 1, w, 1, info )
686 CALL chkxer(
'DSYSV_RK', infot, nout, lerr, ok )
687 infot = 5
688 CALL dsysv_rk(
'U', 2, 0, a, 1, e, ip, b, 2, w, 1, info )
689 CALL chkxer(
'DSYSV_RK', infot, nout, lerr, ok )
690 infot = 9
691 CALL dsysv_rk(
'U', 2, 0, a, 2, e, ip, b, 1, w, 1, info )
692 CALL chkxer(
'DSYSV_RK', infot, nout, lerr, ok )
693 infot = 11
694 CALL dsysv_rk(
'U', 0, 0, a, 1, e, ip, b, 1, w, 0, info )
695 CALL chkxer(
'DSYSV_RK', infot, nout, lerr, ok )
696 infot = 11
697 CALL dsysv_rk(
'U', 0, 0, a, 1, e, ip, b, 1, w, -2, info )
698 CALL chkxer(
'DSYSV_RK', infot, nout, lerr, ok )
699
700 ELSE IF(
lsamen( 2, c2,
'SA' ) )
THEN
701
702
703
704 srnamt = 'DSYSV_AA'
705 infot = 1
706 CALL dsysv_aa(
'/', 0, 0, a, 1, ip, b, 1, w, 1, info )
707 CALL chkxer(
'DSYSV_AA', infot, nout, lerr, ok )
708 infot = 2
709 CALL dsysv_aa(
'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
710 CALL chkxer(
'DSYSV_AA', infot, nout, lerr, ok )
711 infot = 3
712 CALL dsysv_aa(
'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
713 CALL chkxer(
'DSYSV_AA', infot, nout, lerr, ok )
714 infot = 5
715 CALL dsysv_aa(
'U', 2, 0, a, 1, ip, b, 2, w, 1, info )
716 CALL chkxer(
'DSYSV_AA', infot, nout, lerr, ok )
717 infot = 8
718 CALL dsysv_aa(
'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
719 CALL chkxer(
'DSYSV_AA', infot, nout, lerr, ok )
720 infot = 10
721 CALL dsysv_aa(
'U', 3, 1, a, 3, ip, b, 3, w, 6, info )
722 CALL chkxer(
'DSYSV_AA', infot, nout, lerr, ok )
723
724 ELSE IF(
lsamen( 2, c2,
'S2' ) )
THEN
725
726
727
728 srnamt = 'DSYSV_AA_2STAGE'
729 infot = 1
730 CALL dsysv_aa_2stage(
'/', 0, 0, a, 1, a, 1, ip, ip, b, 1,
731 $ w, 1, info )
732 CALL chkxer(
'DSYSV_AA_2STAGE', infot, nout, lerr, ok )
733 infot = 2
734 CALL dsysv_aa_2stage(
'U', -1, 0, a, 1, a, 1, ip, ip, b, 1,
735 $ w, 1, info )
736 CALL chkxer(
'DSYSV_AA_2STAGE', infot, nout, lerr, ok )
737 infot = 3
738 CALL dsysv_aa_2stage(
'U', 0, -1, a, 1, a, 1, ip, ip, b, 1,
739 $ w, 1, info )
740 CALL chkxer(
'DSYSV_AA_2STAGE', infot, nout, lerr, ok )
741 infot = 5
742 CALL dsysv_aa_2stage(
'U', 2, 1, a, 1, a, 1, ip, ip, b, 1,
743 $ w, 1, info )
744 CALL chkxer(
'DSYSV_AA_2STAGE', infot, nout, lerr, ok )
745 infot = 7
746 CALL dsysv_aa_2stage(
'U', 2, 1, a, 2, a, 1, ip, ip, b, 2,
747 $ w, 1, info )
748 CALL chkxer(
'DSYSV_AA_2STAGE', infot, nout, lerr, ok )
749 infot = 11
750 CALL dsysv_aa_2stage(
'U', 2, 1, a, 2, a, 8, ip, ip, b, 1,
751 $ w, 1, info )
752 CALL chkxer(
'DSYSV_AA_2STAGE', infot, nout, lerr, ok )
753 infot = 13
754 CALL dsysv_aa_2stage(
'U', 2, 1, a, 2, a, 8, ip, ip, b, 2,
755 $ w, 1, info )
756 CALL chkxer(
'DSYSV_AA_2STAGE', infot, nout, lerr, ok )
757
758 ELSE IF(
lsamen( 2, c2,
'SP' ) )
THEN
759
760
761
762 srnamt = 'DSPSV '
763 infot = 1
764 CALL dspsv(
'/', 0, 0, a, ip, b, 1, info )
765 CALL chkxer(
'DSPSV ', infot, nout, lerr, ok )
766 infot = 2
767 CALL dspsv(
'U', -1, 0, a, ip, b, 1, info )
768 CALL chkxer(
'DSPSV ', infot, nout, lerr, ok )
769 infot = 3
770 CALL dspsv(
'U', 0, -1, a, ip, b, 1, info )
771 CALL chkxer(
'DSPSV ', infot, nout, lerr, ok )
772 infot = 7
773 CALL dspsv(
'U', 2, 0, a, ip, b, 1, info )
774 CALL chkxer(
'DSPSV ', infot, nout, lerr, ok )
775
776
777
778 srnamt = 'DSPSVX'
779 infot = 1
780 CALL dspsvx(
'/',
'U', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
781 $ r2, w, iw, info )
782 CALL chkxer(
'DSPSVX', infot, nout, lerr, ok )
783 infot = 2
784 CALL dspsvx(
'N',
'/', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
785 $ r2, w, iw, info )
786 CALL chkxer(
'DSPSVX', infot, nout, lerr, ok )
787 infot = 3
788 CALL dspsvx(
'N',
'U', -1, 0, a, af, ip, b, 1, x, 1, rcond, r1,
789 $ r2, w, iw, info )
790 CALL chkxer(
'DSPSVX', infot, nout, lerr, ok )
791 infot = 4
792 CALL dspsvx(
'N',
'U', 0, -1, a, af, ip, b, 1, x, 1, rcond, r1,
793 $ r2, w, iw, info )
794 CALL chkxer(
'DSPSVX', infot, nout, lerr, ok )
795 infot = 9
796 CALL dspsvx(
'N',
'U', 2, 0, a, af, ip, b, 1, x, 2, rcond, r1,
797 $ r2, w, iw, info )
798 CALL chkxer(
'DSPSVX', infot, nout, lerr, ok )
799 infot = 11
800 CALL dspsvx(
'N',
'U', 2, 0, a, af, ip, b, 2, x, 1, rcond, r1,
801 $ r2, w, iw, info )
802 CALL chkxer(
'DSPSVX', infot, nout, lerr, ok )
803 END IF
804
805
806
807 IF( ok ) THEN
808 WRITE( nout, fmt = 9999 )path
809 ELSE
810 WRITE( nout, fmt = 9998 )path
811 END IF
812
813 9999 FORMAT( 1x, a3, ' drivers passed the tests of the error exits' )
814 9998 FORMAT( ' *** ', a3, ' drivers failed the tests of the error ',
815 $ 'exits ***' )
816
817 RETURN
818
819
820
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine dgbsv(n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
DGBSV computes the solution to system of linear equations A * X = B for GB matrices (simple driver)
subroutine dgbsvx(fact, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, equed, r, c, b, ldb, x, ldx, rcond, ferr, berr, work, iwork, info)
DGBSVX computes the solution to system of linear equations A * X = B for GB matrices
subroutine dgesv(n, nrhs, a, lda, ipiv, b, ldb, info)
Download DGESV + dependencies <a href="http://www.netlib.org/cgi-bin/netlibfiles....
subroutine dgesvx(fact, trans, n, nrhs, a, lda, af, ldaf, ipiv, equed, r, c, b, ldb, x, ldx, rcond, ferr, berr, work, iwork, info)
DGESVX computes the solution to system of linear equations A * X = B for GE matrices
subroutine dgtsv(n, nrhs, dl, d, du, b, ldb, info)
DGTSV computes the solution to system of linear equations A * X = B for GT matrices
subroutine dgtsvx(fact, trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, iwork, info)
DGTSVX computes the solution to system of linear equations A * X = B for GT matrices
subroutine dsysv_aa_2stage(uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, work, lwork, info)
DSYSV_AA_2STAGE computes the solution to system of linear equations A * X = B for SY matrices
subroutine dsysv_aa(uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info)
DSYSV_AA computes the solution to system of linear equations A * X = B for SY matrices
subroutine dsysv_rk(uplo, n, nrhs, a, lda, e, ipiv, b, ldb, work, lwork, info)
DSYSV_RK computes the solution to system of linear equations A * X = B for SY matrices
subroutine dsysv_rook(uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info)
DSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices
subroutine dsysv(uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info)
DSYSV computes the solution to system of linear equations A * X = B for SY matrices
subroutine dsysvx(fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, lwork, iwork, info)
DSYSVX computes the solution to system of linear equations A * X = B for SY matrices
subroutine dspsv(uplo, n, nrhs, ap, ipiv, b, ldb, info)
DSPSV computes the solution to system of linear equations A * X = B for OTHER matrices
subroutine dspsvx(fact, uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, iwork, info)
DSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices
logical function lsamen(n, ca, cb)
LSAMEN
subroutine dpbsv(uplo, n, kd, nrhs, ab, ldab, b, ldb, info)
DPBSV computes the solution to system of linear equations A * X = B for OTHER matrices
subroutine dpbsvx(fact, uplo, n, kd, nrhs, ab, ldab, afb, ldafb, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, iwork, info)
DPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices
subroutine dposv(uplo, n, nrhs, a, lda, b, ldb, info)
DPOSV computes the solution to system of linear equations A * X = B for PO matrices
subroutine dposvx(fact, uplo, n, nrhs, a, lda, af, ldaf, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, iwork, info)
DPOSVX computes the solution to system of linear equations A * X = B for PO matrices
subroutine dppsv(uplo, n, nrhs, ap, b, ldb, info)
DPPSV computes the solution to system of linear equations A * X = B for OTHER matrices
subroutine dppsvx(fact, uplo, n, nrhs, ap, afp, equed, s, b, ldb, x, ldx, rcond, ferr, berr, work, iwork, info)
DPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices
subroutine dptsv(n, nrhs, d, e, b, ldb, info)
DPTSV computes the solution to system of linear equations A * X = B for PT matrices
subroutine dptsvx(fact, n, nrhs, d, e, df, ef, b, ldb, x, ldx, rcond, ferr, berr, work, info)
DPTSVX computes the solution to system of linear equations A * X = B for PT matrices