LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
serrgex.f
Go to the documentation of this file.
1 *> \brief \b SERRGEX
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE SERRGE( PATH, NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * CHARACTER*3 PATH
15 * INTEGER NUNIT
16 * ..
17 *
18 *
19 *> \par Purpose:
20 * =============
21 *>
22 *> \verbatim
23 *>
24 *> SERRGE tests the error exits for the REAL routines
25 *> for general matrices.
26 *>
27 *> Note that this file is used only when the XBLAS are available,
28 *> otherwise serrge.f defines this subroutine.
29 *> \endverbatim
30 *
31 * Arguments:
32 * ==========
33 *
34 *> \param[in] PATH
35 *> \verbatim
36 *> PATH is CHARACTER*3
37 *> The LAPACK path name for the routines to be tested.
38 *> \endverbatim
39 *>
40 *> \param[in] NUNIT
41 *> \verbatim
42 *> NUNIT is INTEGER
43 *> The unit number for output.
44 *> \endverbatim
45 *
46 * Authors:
47 * ========
48 *
49 *> \author Univ. of Tennessee
50 *> \author Univ. of California Berkeley
51 *> \author Univ. of Colorado Denver
52 *> \author NAG Ltd.
53 *
54 *> \date November 2011
55 *
56 *> \ingroup single_lin
57 *
58 * =====================================================================
59  SUBROUTINE serrge( PATH, NUNIT )
60 *
61 * -- LAPACK test routine (version 3.4.0) --
62 * -- LAPACK is a software package provided by Univ. of Tennessee, --
63 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
64 * November 2011
65 *
66 * .. Scalar Arguments ..
67  CHARACTER*3 path
68  INTEGER nunit
69 * ..
70 *
71 * =====================================================================
72 *
73 * .. Parameters ..
74  INTEGER nmax, lw
75  parameter ( nmax = 4, lw = 3*nmax )
76 * ..
77 * .. Local Scalars ..
78  CHARACTER eq
79  CHARACTER*2 c2
80  INTEGER i, info, j, n_err_bnds, nparams
81  REAL anrm, ccond, rcond, berr
82 * ..
83 * .. Local Arrays ..
84  INTEGER ip( nmax ), iw( nmax )
85  REAL a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
86  $ c( nmax ), r( nmax ), r1( nmax ), r2( nmax ),
87  $ w( lw ), x( nmax ), err_bnds_n( nmax, 3 ),
88  $ err_bnds_c( nmax, 3 ), params( 1 )
89 * ..
90 * .. External Functions ..
91  LOGICAL lsamen
92  EXTERNAL lsamen
93 * ..
94 * .. External Subroutines ..
95  EXTERNAL alaesm, chkxer, sgbcon, sgbequ, sgbrfs, sgbtf2,
98  $ sgbequb, sgbrfsx
99 * ..
100 * .. Scalars in Common ..
101  LOGICAL lerr, ok
102  CHARACTER*32 srnamt
103  INTEGER infot, nout
104 * ..
105 * .. Common blocks ..
106  COMMON / infoc / infot, nout, ok, lerr
107  COMMON / srnamc / srnamt
108 * ..
109 * .. Intrinsic Functions ..
110  INTRINSIC real
111 * ..
112 * .. Executable Statements ..
113 *
114  nout = nunit
115  WRITE( nout, fmt = * )
116  c2 = path( 2: 3 )
117 *
118 * Set the variables to innocuous values.
119 *
120  DO 20 j = 1, nmax
121  DO 10 i = 1, nmax
122  a( i, j ) = 1. / REAL( i+j )
123  af( i, j ) = 1. / REAL( i+j )
124  10 CONTINUE
125  b( j ) = 0.
126  r1( j ) = 0.
127  r2( j ) = 0.
128  w( j ) = 0.
129  x( j ) = 0.
130  c( j ) = 0.
131  r( j ) = 0.
132  ip( j ) = j
133  iw( j ) = j
134  20 CONTINUE
135  ok = .true.
136 *
137  IF( lsamen( 2, c2, 'GE' ) ) THEN
138 *
139 * Test error exits of the routines that use the LU decomposition
140 * of a general matrix.
141 *
142 * SGETRF
143 *
144  srnamt = 'SGETRF'
145  infot = 1
146  CALL sgetrf( -1, 0, a, 1, ip, info )
147  CALL chkxer( 'SGETRF', infot, nout, lerr, ok )
148  infot = 2
149  CALL sgetrf( 0, -1, a, 1, ip, info )
150  CALL chkxer( 'SGETRF', infot, nout, lerr, ok )
151  infot = 4
152  CALL sgetrf( 2, 1, a, 1, ip, info )
153  CALL chkxer( 'SGETRF', infot, nout, lerr, ok )
154 *
155 * SGETF2
156 *
157  srnamt = 'SGETF2'
158  infot = 1
159  CALL sgetf2( -1, 0, a, 1, ip, info )
160  CALL chkxer( 'SGETF2', infot, nout, lerr, ok )
161  infot = 2
162  CALL sgetf2( 0, -1, a, 1, ip, info )
163  CALL chkxer( 'SGETF2', infot, nout, lerr, ok )
164  infot = 4
165  CALL sgetf2( 2, 1, a, 1, ip, info )
166  CALL chkxer( 'SGETF2', infot, nout, lerr, ok )
167 *
168 * SGETRI
169 *
170  srnamt = 'SGETRI'
171  infot = 1
172  CALL sgetri( -1, a, 1, ip, w, lw, info )
173  CALL chkxer( 'SGETRI', infot, nout, lerr, ok )
174  infot = 3
175  CALL sgetri( 2, a, 1, ip, w, lw, info )
176  CALL chkxer( 'SGETRI', infot, nout, lerr, ok )
177 *
178 * SGETRS
179 *
180  srnamt = 'SGETRS'
181  infot = 1
182  CALL sgetrs( '/', 0, 0, a, 1, ip, b, 1, info )
183  CALL chkxer( 'SGETRS', infot, nout, lerr, ok )
184  infot = 2
185  CALL sgetrs( 'N', -1, 0, a, 1, ip, b, 1, info )
186  CALL chkxer( 'SGETRS', infot, nout, lerr, ok )
187  infot = 3
188  CALL sgetrs( 'N', 0, -1, a, 1, ip, b, 1, info )
189  CALL chkxer( 'SGETRS', infot, nout, lerr, ok )
190  infot = 5
191  CALL sgetrs( 'N', 2, 1, a, 1, ip, b, 2, info )
192  CALL chkxer( 'SGETRS', infot, nout, lerr, ok )
193  infot = 8
194  CALL sgetrs( 'N', 2, 1, a, 2, ip, b, 1, info )
195  CALL chkxer( 'SGETRS', infot, nout, lerr, ok )
196 *
197 * SGERFS
198 *
199  srnamt = 'SGERFS'
200  infot = 1
201  CALL sgerfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
202  $ iw, info )
203  CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
204  infot = 2
205  CALL sgerfs( 'N', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
206  $ w, iw, info )
207  CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
208  infot = 3
209  CALL sgerfs( 'N', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
210  $ w, iw, info )
211  CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
212  infot = 5
213  CALL sgerfs( 'N', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
214  $ iw, info )
215  CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
216  infot = 7
217  CALL sgerfs( 'N', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
218  $ iw, info )
219  CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
220  infot = 10
221  CALL sgerfs( 'N', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
222  $ iw, info )
223  CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
224  infot = 12
225  CALL sgerfs( 'N', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
226  $ iw, info )
227  CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
228 *
229 * SGERFSX
230 *
231  n_err_bnds = 3
232  nparams = 0
233  srnamt = 'SGERFSX'
234  infot = 1
235  CALL sgerfsx( '/', eq, 0, 0, a, 1, af, 1, ip, r, c, b, 1, x,
236  $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
237  $ nparams, params, w, iw, info )
238  CALL chkxer( 'SGERFSX', infot, nout, lerr, ok )
239  infot = 2
240  eq = '/'
241  CALL sgerfsx( 'N', eq, 2, 1, a, 1, af, 2, ip, r, c, b, 2, x,
242  $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
243  $ nparams, params, w, iw, info )
244  CALL chkxer( 'SGERFSX', infot, nout, lerr, ok )
245  infot = 3
246  eq = 'R'
247  CALL sgerfsx( 'N', eq, -1, 0, a, 1, af, 1, ip, r, c, b, 1, x,
248  $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
249  $ nparams, params, w, iw, info )
250  CALL chkxer( 'SGERFSX', infot, nout, lerr, ok )
251  infot = 4
252  CALL sgerfsx( 'N', eq, 0, -1, a, 1, af, 1, ip, r, c, b, 1, x,
253  $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
254  $ nparams, params, w, iw, info )
255  CALL chkxer( 'SGERFSX', infot, nout, lerr, ok )
256  infot = 6
257  CALL sgerfsx( 'N', eq, 2, 1, a, 1, af, 2, ip, r, c, b, 2, x,
258  $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
259  $ nparams, params, w, iw, info )
260  CALL chkxer( 'SGERFSX', infot, nout, lerr, ok )
261  infot = 8
262  CALL sgerfsx( 'N', eq, 2, 1, a, 2, af, 1, ip, r, c, b, 2, x,
263  $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
264  $ nparams, params, w, iw, info )
265  CALL chkxer( 'SGERFSX', infot, nout, lerr, ok )
266  infot = 13
267  eq = 'C'
268  CALL sgerfsx( 'N', eq, 2, 1, a, 2, af, 2, ip, r, c, b, 1, x,
269  $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
270  $ nparams, params, w, iw, info )
271  CALL chkxer( 'SGERFSX', infot, nout, lerr, ok )
272  infot = 15
273  CALL sgerfsx( 'N', eq, 2, 1, a, 2, af, 2, ip, r, c, b, 2, x,
274  $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
275  $ nparams, params, w, iw, info )
276  CALL chkxer( 'SGERFSX', infot, nout, lerr, ok )
277 *
278 * SGECON
279 *
280  srnamt = 'SGECON'
281  infot = 1
282  CALL sgecon( '/', 0, a, 1, anrm, rcond, w, iw, info )
283  CALL chkxer( 'SGECON', infot, nout, lerr, ok )
284  infot = 2
285  CALL sgecon( '1', -1, a, 1, anrm, rcond, w, iw, info )
286  CALL chkxer( 'SGECON', infot, nout, lerr, ok )
287  infot = 4
288  CALL sgecon( '1', 2, a, 1, anrm, rcond, w, iw, info )
289  CALL chkxer( 'SGECON', infot, nout, lerr, ok )
290 *
291 * SGEEQU
292 *
293  srnamt = 'SGEEQU'
294  infot = 1
295  CALL sgeequ( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
296  CALL chkxer( 'SGEEQU', infot, nout, lerr, ok )
297  infot = 2
298  CALL sgeequ( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
299  CALL chkxer( 'SGEEQU', infot, nout, lerr, ok )
300  infot = 4
301  CALL sgeequ( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
302  CALL chkxer( 'SGEEQU', infot, nout, lerr, ok )
303 *
304 * SGEEQUB
305 *
306  srnamt = 'SGEEQUB'
307  infot = 1
308  CALL sgeequb( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
309  CALL chkxer( 'SGEEQUB', infot, nout, lerr, ok )
310  infot = 2
311  CALL sgeequb( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
312  CALL chkxer( 'SGEEQUB', infot, nout, lerr, ok )
313  infot = 4
314  CALL sgeequb( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
315  CALL chkxer( 'SGEEQUB', infot, nout, lerr, ok )
316 *
317  ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
318 *
319 * Test error exits of the routines that use the LU decomposition
320 * of a general band matrix.
321 *
322 * SGBTRF
323 *
324  srnamt = 'SGBTRF'
325  infot = 1
326  CALL sgbtrf( -1, 0, 0, 0, a, 1, ip, info )
327  CALL chkxer( 'SGBTRF', infot, nout, lerr, ok )
328  infot = 2
329  CALL sgbtrf( 0, -1, 0, 0, a, 1, ip, info )
330  CALL chkxer( 'SGBTRF', infot, nout, lerr, ok )
331  infot = 3
332  CALL sgbtrf( 1, 1, -1, 0, a, 1, ip, info )
333  CALL chkxer( 'SGBTRF', infot, nout, lerr, ok )
334  infot = 4
335  CALL sgbtrf( 1, 1, 0, -1, a, 1, ip, info )
336  CALL chkxer( 'SGBTRF', infot, nout, lerr, ok )
337  infot = 6
338  CALL sgbtrf( 2, 2, 1, 1, a, 3, ip, info )
339  CALL chkxer( 'SGBTRF', infot, nout, lerr, ok )
340 *
341 * SGBTF2
342 *
343  srnamt = 'SGBTF2'
344  infot = 1
345  CALL sgbtf2( -1, 0, 0, 0, a, 1, ip, info )
346  CALL chkxer( 'SGBTF2', infot, nout, lerr, ok )
347  infot = 2
348  CALL sgbtf2( 0, -1, 0, 0, a, 1, ip, info )
349  CALL chkxer( 'SGBTF2', infot, nout, lerr, ok )
350  infot = 3
351  CALL sgbtf2( 1, 1, -1, 0, a, 1, ip, info )
352  CALL chkxer( 'SGBTF2', infot, nout, lerr, ok )
353  infot = 4
354  CALL sgbtf2( 1, 1, 0, -1, a, 1, ip, info )
355  CALL chkxer( 'SGBTF2', infot, nout, lerr, ok )
356  infot = 6
357  CALL sgbtf2( 2, 2, 1, 1, a, 3, ip, info )
358  CALL chkxer( 'SGBTF2', infot, nout, lerr, ok )
359 *
360 * SGBTRS
361 *
362  srnamt = 'SGBTRS'
363  infot = 1
364  CALL sgbtrs( '/', 0, 0, 0, 1, a, 1, ip, b, 1, info )
365  CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
366  infot = 2
367  CALL sgbtrs( 'N', -1, 0, 0, 1, a, 1, ip, b, 1, info )
368  CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
369  infot = 3
370  CALL sgbtrs( 'N', 1, -1, 0, 1, a, 1, ip, b, 1, info )
371  CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
372  infot = 4
373  CALL sgbtrs( 'N', 1, 0, -1, 1, a, 1, ip, b, 1, info )
374  CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
375  infot = 5
376  CALL sgbtrs( 'N', 1, 0, 0, -1, a, 1, ip, b, 1, info )
377  CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
378  infot = 7
379  CALL sgbtrs( 'N', 2, 1, 1, 1, a, 3, ip, b, 2, info )
380  CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
381  infot = 10
382  CALL sgbtrs( 'N', 2, 0, 0, 1, a, 1, ip, b, 1, info )
383  CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
384 *
385 * SGBRFS
386 *
387  srnamt = 'SGBRFS'
388  infot = 1
389  CALL sgbrfs( '/', 0, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
390  $ r2, w, iw, info )
391  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
392  infot = 2
393  CALL sgbrfs( 'N', -1, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
394  $ r2, w, iw, info )
395  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
396  infot = 3
397  CALL sgbrfs( 'N', 1, -1, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
398  $ r2, w, iw, info )
399  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
400  infot = 4
401  CALL sgbrfs( 'N', 1, 0, -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
402  $ r2, w, iw, info )
403  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
404  infot = 5
405  CALL sgbrfs( 'N', 1, 0, 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1,
406  $ r2, w, iw, info )
407  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
408  infot = 7
409  CALL sgbrfs( 'N', 2, 1, 1, 1, a, 2, af, 4, ip, b, 2, x, 2, r1,
410  $ r2, w, iw, info )
411  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
412  infot = 9
413  CALL sgbrfs( 'N', 2, 1, 1, 1, a, 3, af, 3, ip, b, 2, x, 2, r1,
414  $ r2, w, iw, info )
415  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
416  infot = 12
417  CALL sgbrfs( 'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 1, x, 2, r1,
418  $ r2, w, iw, info )
419  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
420  infot = 14
421  CALL sgbrfs( 'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 2, x, 1, r1,
422  $ r2, w, iw, info )
423  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
424 *
425 * SGBRFSX
426 *
427  n_err_bnds = 3
428  nparams = 0
429  srnamt = 'SGBRFSX'
430  infot = 1
431  CALL sgbrfsx( '/', eq, 0, 0, 0, 0, a, 1, af, 1, ip, r, c, b, 1,
432  $ x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
433  $ nparams, params, w, iw, info )
434  CALL chkxer( 'SGBRFSX', infot, nout, lerr, ok )
435  infot = 2
436  eq = '/'
437  CALL sgbrfsx( 'N', eq, 2, 1, 1, 1, a, 1, af, 2, ip, r, c, b, 2,
438  $ x, 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
439  $ nparams, params, w, iw, info )
440  CALL chkxer( 'SGBRFSX', infot, nout, lerr, ok )
441  infot = 3
442  eq = 'R'
443  CALL sgbrfsx( 'N', eq, -1, 1, 1, 0, a, 1, af, 1, ip, r, c, b,
444  $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
445  $ nparams, params, w, iw, info )
446  CALL chkxer( 'SGBRFSX', infot, nout, lerr, ok )
447  infot = 4
448  eq = 'R'
449  CALL sgbrfsx( 'N', eq, 2, -1, 1, 1, a, 3, af, 4, ip, r, c, b,
450  $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
451  $ nparams, params, w, iw, info )
452  CALL chkxer( 'SGBRFSX', infot, nout, lerr, ok )
453  infot = 5
454  eq = 'R'
455  CALL sgbrfsx( 'N', eq, 2, 1, -1, 1, a, 3, af, 4, ip, r, c, b,
456  $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
457  $ nparams, params, w, iw, info )
458  CALL chkxer( 'SGBRFSX', infot, nout, lerr, ok )
459  infot = 6
460  CALL sgbrfsx( 'N', eq, 0, 0, 0, -1, a, 1, af, 1, ip, r, c, b,
461  $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
462  $ nparams, params, w, iw, info )
463  CALL chkxer( 'SGBRFSX', infot, nout, lerr, ok )
464  infot = 8
465  CALL sgbrfsx( 'N', eq, 2, 1, 1, 1, a, 1, af, 2, ip, r, c, b,
466  $ 2, x, 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
467  $ nparams, params, w, iw, info )
468  CALL chkxer( 'SGBRFSX', infot, nout, lerr, ok )
469  infot = 10
470  CALL sgbrfsx( 'N', eq, 2, 1, 1, 1, a, 3, af, 3, ip, r, c, b, 2,
471  $ x, 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
472  $ nparams, params, w, iw, info )
473  CALL chkxer( 'SGBRFSX', infot, nout, lerr, ok )
474  infot = 13
475  eq = 'C'
476  CALL sgbrfsx( 'N', eq, 2, 1, 1, 1, a, 3, af, 5, ip, r, c, b,
477  $ 1, x, 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
478  $ nparams, params, w, iw, info )
479  CALL chkxer( 'SGBRFSX', infot, nout, lerr, ok )
480  infot = 15
481  CALL sgbrfsx( 'N', eq, 2, 1, 1, 1, a, 3, af, 5, ip, r, c, b, 2,
482  $ x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
483  $ nparams, params, w, iw, info )
484  CALL chkxer( 'SGBRFSX', infot, nout, lerr, ok )
485 *
486 * SGBCON
487 *
488  srnamt = 'SGBCON'
489  infot = 1
490  CALL sgbcon( '/', 0, 0, 0, a, 1, ip, anrm, rcond, w, iw, info )
491  CALL chkxer( 'SGBCON', infot, nout, lerr, ok )
492  infot = 2
493  CALL sgbcon( '1', -1, 0, 0, a, 1, ip, anrm, rcond, w, iw,
494  $ info )
495  CALL chkxer( 'SGBCON', infot, nout, lerr, ok )
496  infot = 3
497  CALL sgbcon( '1', 1, -1, 0, a, 1, ip, anrm, rcond, w, iw,
498  $ info )
499  CALL chkxer( 'SGBCON', infot, nout, lerr, ok )
500  infot = 4
501  CALL sgbcon( '1', 1, 0, -1, a, 1, ip, anrm, rcond, w, iw,
502  $ info )
503  CALL chkxer( 'SGBCON', infot, nout, lerr, ok )
504  infot = 6
505  CALL sgbcon( '1', 2, 1, 1, a, 3, ip, anrm, rcond, w, iw, info )
506  CALL chkxer( 'SGBCON', infot, nout, lerr, ok )
507 *
508 * SGBEQU
509 *
510  srnamt = 'SGBEQU'
511  infot = 1
512  CALL sgbequ( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
513  $ info )
514  CALL chkxer( 'SGBEQU', infot, nout, lerr, ok )
515  infot = 2
516  CALL sgbequ( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
517  $ info )
518  CALL chkxer( 'SGBEQU', infot, nout, lerr, ok )
519  infot = 3
520  CALL sgbequ( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
521  $ info )
522  CALL chkxer( 'SGBEQU', infot, nout, lerr, ok )
523  infot = 4
524  CALL sgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
525  $ info )
526  CALL chkxer( 'SGBEQU', infot, nout, lerr, ok )
527  infot = 6
528  CALL sgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
529  $ info )
530  CALL chkxer( 'SGBEQU', infot, nout, lerr, ok )
531 *
532 * SGBEQUB
533 *
534  srnamt = 'SGBEQUB'
535  infot = 1
536  CALL sgbequb( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
537  $ info )
538  CALL chkxer( 'SGBEQUB', infot, nout, lerr, ok )
539  infot = 2
540  CALL sgbequb( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
541  $ info )
542  CALL chkxer( 'SGBEQUB', infot, nout, lerr, ok )
543  infot = 3
544  CALL sgbequb( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
545  $ info )
546  CALL chkxer( 'SGBEQUB', infot, nout, lerr, ok )
547  infot = 4
548  CALL sgbequb( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
549  $ info )
550  CALL chkxer( 'SGBEQUB', infot, nout, lerr, ok )
551  infot = 6
552  CALL sgbequb( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
553  $ info )
554  CALL chkxer( 'SGBEQUB', infot, nout, lerr, ok )
555  END IF
556 *
557 * Print a summary line.
558 *
559  CALL alaesm( path, ok, nout )
560 *
561  RETURN
562 *
563 * End of SERRGE
564 *
565  END
subroutine sgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SGETRS
Definition: sgetrs.f:123
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
subroutine sgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SGECON
Definition: sgecon.f:126
subroutine serrge(PATH, NUNIT)
SERRGE
Definition: serrge.f:57
subroutine sgetf2(M, N, A, LDA, IPIV, INFO)
SGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row inter...
Definition: sgetf2.f:110
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
subroutine sgetrf(M, N, A, LDA, IPIV, INFO)
SGETRF
Definition: sgetrf.f:110
subroutine sgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SGBCON
Definition: sgbcon.f:148
subroutine sgbtf2(M, N, KL, KU, AB, LDAB, IPIV, INFO)
SGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algo...
Definition: sgbtf2.f:147
subroutine sgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
SGBEQU
Definition: sgbequ.f:155
subroutine sgbrfsx(TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, R, C, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
SGBRFSX
Definition: sgbrfsx.f:442
subroutine sgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGERFS
Definition: sgerfs.f:187
subroutine sgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
SGEEQU
Definition: sgeequ.f:141
subroutine sgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
SGBTRS
Definition: sgbtrs.f:140
subroutine sgeequb(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
SGEEQUB
Definition: sgeequb.f:148
subroutine sgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
SGETRI
Definition: sgetri.f:116
subroutine sgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGBRFS
Definition: sgbrfs.f:207
subroutine sgbequb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
SGBEQUB
Definition: sgbequb.f:162
subroutine sgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
SGBTRF
Definition: sgbtrf.f:146
subroutine sgerfsx(TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, R, C, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
SGERFSX
Definition: sgerfsx.f:416