LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
serrge.f
Go to the documentation of this file.
1 *> \brief \b SERRGE
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 *> \endverbatim
27 *
28 * Arguments:
29 * ==========
30 *
31 *> \param[in] PATH
32 *> \verbatim
33 *> PATH is CHARACTER*3
34 *> The LAPACK path name for the routines to be tested.
35 *> \endverbatim
36 *>
37 *> \param[in] NUNIT
38 *> \verbatim
39 *> NUNIT is INTEGER
40 *> The unit number for output.
41 *> \endverbatim
42 *
43 * Authors:
44 * ========
45 *
46 *> \author Univ. of Tennessee
47 *> \author Univ. of California Berkeley
48 *> \author Univ. of Colorado Denver
49 *> \author NAG Ltd.
50 *
51 *> \ingroup single_lin
52 *
53 * =====================================================================
54  SUBROUTINE serrge( PATH, NUNIT )
55 *
56 * -- LAPACK test routine --
57 * -- LAPACK is a software package provided by Univ. of Tennessee, --
58 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59 *
60 * .. Scalar Arguments ..
61  CHARACTER*3 PATH
62  INTEGER NUNIT
63 * ..
64 *
65 * =====================================================================
66 *
67 * .. Parameters ..
68  INTEGER NMAX, LW
69  parameter( nmax = 4, lw = 3*nmax )
70 * ..
71 * .. Local Scalars ..
72  CHARACTER*2 C2
73  INTEGER I, INFO, J
74  REAL ANRM, CCOND, RCOND
75 * ..
76 * .. Local Arrays ..
77  INTEGER IP( NMAX ), IW( NMAX )
78  REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
79  $ R1( NMAX ), R2( NMAX ), W( LW ), X( NMAX )
80 * ..
81 * .. External Functions ..
82  LOGICAL LSAMEN
83  EXTERNAL lsamen
84 * ..
85 * .. External Subroutines ..
86  EXTERNAL alaesm, chkxer, sgbcon, sgbequ, sgbrfs, sgbtf2,
88  $ sgetrf, sgetri, sgetrs
89 * ..
90 * .. Scalars in Common ..
91  LOGICAL LERR, OK
92  CHARACTER*32 SRNAMT
93  INTEGER INFOT, NOUT
94 * ..
95 * .. Common blocks ..
96  COMMON / infoc / infot, nout, ok, lerr
97  COMMON / srnamc / srnamt
98 * ..
99 * .. Intrinsic Functions ..
100  INTRINSIC real
101 * ..
102 * .. Executable Statements ..
103 *
104  nout = nunit
105  WRITE( nout, fmt = * )
106  c2 = path( 2: 3 )
107 *
108 * Set the variables to innocuous values.
109 *
110  DO 20 j = 1, nmax
111  DO 10 i = 1, nmax
112  a( i, j ) = 1. / real( i+j )
113  af( i, j ) = 1. / real( i+j )
114  10 CONTINUE
115  b( j ) = 0.
116  r1( j ) = 0.
117  r2( j ) = 0.
118  w( j ) = 0.
119  x( j ) = 0.
120  ip( j ) = j
121  iw( j ) = j
122  20 CONTINUE
123  ok = .true.
124 *
125  IF( lsamen( 2, c2, 'GE' ) ) THEN
126 *
127 * Test error exits of the routines that use the LU decomposition
128 * of a general matrix.
129 *
130 * SGETRF
131 *
132  srnamt = 'SGETRF'
133  infot = 1
134  CALL sgetrf( -1, 0, a, 1, ip, info )
135  CALL chkxer( 'SGETRF', infot, nout, lerr, ok )
136  infot = 2
137  CALL sgetrf( 0, -1, a, 1, ip, info )
138  CALL chkxer( 'SGETRF', infot, nout, lerr, ok )
139  infot = 4
140  CALL sgetrf( 2, 1, a, 1, ip, info )
141  CALL chkxer( 'SGETRF', infot, nout, lerr, ok )
142 *
143 * SGETF2
144 *
145  srnamt = 'SGETF2'
146  infot = 1
147  CALL sgetf2( -1, 0, a, 1, ip, info )
148  CALL chkxer( 'SGETF2', infot, nout, lerr, ok )
149  infot = 2
150  CALL sgetf2( 0, -1, a, 1, ip, info )
151  CALL chkxer( 'SGETF2', infot, nout, lerr, ok )
152  infot = 4
153  CALL sgetf2( 2, 1, a, 1, ip, info )
154  CALL chkxer( 'SGETF2', infot, nout, lerr, ok )
155 *
156 * SGETRI
157 *
158  srnamt = 'SGETRI'
159  infot = 1
160  CALL sgetri( -1, a, 1, ip, w, lw, info )
161  CALL chkxer( 'SGETRI', infot, nout, lerr, ok )
162  infot = 3
163  CALL sgetri( 2, a, 1, ip, w, lw, info )
164  CALL chkxer( 'SGETRI', infot, nout, lerr, ok )
165 *
166 * SGETRS
167 *
168  srnamt = 'SGETRS'
169  infot = 1
170  CALL sgetrs( '/', 0, 0, a, 1, ip, b, 1, info )
171  CALL chkxer( 'SGETRS', infot, nout, lerr, ok )
172  infot = 2
173  CALL sgetrs( 'N', -1, 0, a, 1, ip, b, 1, info )
174  CALL chkxer( 'SGETRS', infot, nout, lerr, ok )
175  infot = 3
176  CALL sgetrs( 'N', 0, -1, a, 1, ip, b, 1, info )
177  CALL chkxer( 'SGETRS', infot, nout, lerr, ok )
178  infot = 5
179  CALL sgetrs( 'N', 2, 1, a, 1, ip, b, 2, info )
180  CALL chkxer( 'SGETRS', infot, nout, lerr, ok )
181  infot = 8
182  CALL sgetrs( 'N', 2, 1, a, 2, ip, b, 1, info )
183  CALL chkxer( 'SGETRS', infot, nout, lerr, ok )
184 *
185 * SGERFS
186 *
187  srnamt = 'SGERFS'
188  infot = 1
189  CALL sgerfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
190  $ iw, info )
191  CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
192  infot = 2
193  CALL sgerfs( 'N', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
194  $ w, iw, info )
195  CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
196  infot = 3
197  CALL sgerfs( 'N', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
198  $ w, iw, info )
199  CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
200  infot = 5
201  CALL sgerfs( 'N', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
202  $ iw, info )
203  CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
204  infot = 7
205  CALL sgerfs( 'N', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
206  $ iw, info )
207  CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
208  infot = 10
209  CALL sgerfs( 'N', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
210  $ iw, info )
211  CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
212  infot = 12
213  CALL sgerfs( 'N', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
214  $ iw, info )
215  CALL chkxer( 'SGERFS', infot, nout, lerr, ok )
216 *
217 * SGECON
218 *
219  srnamt = 'SGECON'
220  infot = 1
221  CALL sgecon( '/', 0, a, 1, anrm, rcond, w, iw, info )
222  CALL chkxer( 'SGECON', infot, nout, lerr, ok )
223  infot = 2
224  CALL sgecon( '1', -1, a, 1, anrm, rcond, w, iw, info )
225  CALL chkxer( 'SGECON', infot, nout, lerr, ok )
226  infot = 4
227  CALL sgecon( '1', 2, a, 1, anrm, rcond, w, iw, info )
228  CALL chkxer( 'SGECON', infot, nout, lerr, ok )
229 *
230 * SGEEQU
231 *
232  srnamt = 'SGEEQU'
233  infot = 1
234  CALL sgeequ( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
235  CALL chkxer( 'SGEEQU', infot, nout, lerr, ok )
236  infot = 2
237  CALL sgeequ( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
238  CALL chkxer( 'SGEEQU', infot, nout, lerr, ok )
239  infot = 4
240  CALL sgeequ( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
241  CALL chkxer( 'SGEEQU', infot, nout, lerr, ok )
242 *
243  ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
244 *
245 * Test error exits of the routines that use the LU decomposition
246 * of a general band matrix.
247 *
248 * SGBTRF
249 *
250  srnamt = 'SGBTRF'
251  infot = 1
252  CALL sgbtrf( -1, 0, 0, 0, a, 1, ip, info )
253  CALL chkxer( 'SGBTRF', infot, nout, lerr, ok )
254  infot = 2
255  CALL sgbtrf( 0, -1, 0, 0, a, 1, ip, info )
256  CALL chkxer( 'SGBTRF', infot, nout, lerr, ok )
257  infot = 3
258  CALL sgbtrf( 1, 1, -1, 0, a, 1, ip, info )
259  CALL chkxer( 'SGBTRF', infot, nout, lerr, ok )
260  infot = 4
261  CALL sgbtrf( 1, 1, 0, -1, a, 1, ip, info )
262  CALL chkxer( 'SGBTRF', infot, nout, lerr, ok )
263  infot = 6
264  CALL sgbtrf( 2, 2, 1, 1, a, 3, ip, info )
265  CALL chkxer( 'SGBTRF', infot, nout, lerr, ok )
266 *
267 * SGBTF2
268 *
269  srnamt = 'SGBTF2'
270  infot = 1
271  CALL sgbtf2( -1, 0, 0, 0, a, 1, ip, info )
272  CALL chkxer( 'SGBTF2', infot, nout, lerr, ok )
273  infot = 2
274  CALL sgbtf2( 0, -1, 0, 0, a, 1, ip, info )
275  CALL chkxer( 'SGBTF2', infot, nout, lerr, ok )
276  infot = 3
277  CALL sgbtf2( 1, 1, -1, 0, a, 1, ip, info )
278  CALL chkxer( 'SGBTF2', infot, nout, lerr, ok )
279  infot = 4
280  CALL sgbtf2( 1, 1, 0, -1, a, 1, ip, info )
281  CALL chkxer( 'SGBTF2', infot, nout, lerr, ok )
282  infot = 6
283  CALL sgbtf2( 2, 2, 1, 1, a, 3, ip, info )
284  CALL chkxer( 'SGBTF2', infot, nout, lerr, ok )
285 *
286 * SGBTRS
287 *
288  srnamt = 'SGBTRS'
289  infot = 1
290  CALL sgbtrs( '/', 0, 0, 0, 1, a, 1, ip, b, 1, info )
291  CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
292  infot = 2
293  CALL sgbtrs( 'N', -1, 0, 0, 1, a, 1, ip, b, 1, info )
294  CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
295  infot = 3
296  CALL sgbtrs( 'N', 1, -1, 0, 1, a, 1, ip, b, 1, info )
297  CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
298  infot = 4
299  CALL sgbtrs( 'N', 1, 0, -1, 1, a, 1, ip, b, 1, info )
300  CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
301  infot = 5
302  CALL sgbtrs( 'N', 1, 0, 0, -1, a, 1, ip, b, 1, info )
303  CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
304  infot = 7
305  CALL sgbtrs( 'N', 2, 1, 1, 1, a, 3, ip, b, 2, info )
306  CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
307  infot = 10
308  CALL sgbtrs( 'N', 2, 0, 0, 1, a, 1, ip, b, 1, info )
309  CALL chkxer( 'SGBTRS', infot, nout, lerr, ok )
310 *
311 * SGBRFS
312 *
313  srnamt = 'SGBRFS'
314  infot = 1
315  CALL sgbrfs( '/', 0, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
316  $ r2, w, iw, info )
317  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
318  infot = 2
319  CALL sgbrfs( 'N', -1, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
320  $ r2, w, iw, info )
321  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
322  infot = 3
323  CALL sgbrfs( 'N', 1, -1, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
324  $ r2, w, iw, info )
325  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
326  infot = 4
327  CALL sgbrfs( 'N', 1, 0, -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
328  $ r2, w, iw, info )
329  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
330  infot = 5
331  CALL sgbrfs( 'N', 1, 0, 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1,
332  $ r2, w, iw, info )
333  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
334  infot = 7
335  CALL sgbrfs( 'N', 2, 1, 1, 1, a, 2, af, 4, ip, b, 2, x, 2, r1,
336  $ r2, w, iw, info )
337  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
338  infot = 9
339  CALL sgbrfs( 'N', 2, 1, 1, 1, a, 3, af, 3, ip, b, 2, x, 2, r1,
340  $ r2, w, iw, info )
341  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
342  infot = 12
343  CALL sgbrfs( 'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 1, x, 2, r1,
344  $ r2, w, iw, info )
345  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
346  infot = 14
347  CALL sgbrfs( 'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 2, x, 1, r1,
348  $ r2, w, iw, info )
349  CALL chkxer( 'SGBRFS', infot, nout, lerr, ok )
350 *
351 * SGBCON
352 *
353  srnamt = 'SGBCON'
354  infot = 1
355  CALL sgbcon( '/', 0, 0, 0, a, 1, ip, anrm, rcond, w, iw, info )
356  CALL chkxer( 'SGBCON', infot, nout, lerr, ok )
357  infot = 2
358  CALL sgbcon( '1', -1, 0, 0, a, 1, ip, anrm, rcond, w, iw,
359  $ info )
360  CALL chkxer( 'SGBCON', infot, nout, lerr, ok )
361  infot = 3
362  CALL sgbcon( '1', 1, -1, 0, a, 1, ip, anrm, rcond, w, iw,
363  $ info )
364  CALL chkxer( 'SGBCON', infot, nout, lerr, ok )
365  infot = 4
366  CALL sgbcon( '1', 1, 0, -1, a, 1, ip, anrm, rcond, w, iw,
367  $ info )
368  CALL chkxer( 'SGBCON', infot, nout, lerr, ok )
369  infot = 6
370  CALL sgbcon( '1', 2, 1, 1, a, 3, ip, anrm, rcond, w, iw, info )
371  CALL chkxer( 'SGBCON', infot, nout, lerr, ok )
372 *
373 * SGBEQU
374 *
375  srnamt = 'SGBEQU'
376  infot = 1
377  CALL sgbequ( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
378  $ info )
379  CALL chkxer( 'SGBEQU', infot, nout, lerr, ok )
380  infot = 2
381  CALL sgbequ( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
382  $ info )
383  CALL chkxer( 'SGBEQU', infot, nout, lerr, ok )
384  infot = 3
385  CALL sgbequ( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
386  $ info )
387  CALL chkxer( 'SGBEQU', infot, nout, lerr, ok )
388  infot = 4
389  CALL sgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
390  $ info )
391  CALL chkxer( 'SGBEQU', infot, nout, lerr, ok )
392  infot = 6
393  CALL sgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
394  $ info )
395  CALL chkxer( 'SGBEQU', infot, nout, lerr, ok )
396  END IF
397 *
398 * Print a summary line.
399 *
400  CALL alaesm( path, ok, nout )
401 *
402  RETURN
403 *
404 * End of SERRGE
405 *
406  END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
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:145
subroutine sgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
SGBTRS
Definition: sgbtrs.f:138
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:205
subroutine sgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SGBCON
Definition: sgbcon.f:146
subroutine sgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
SGBTRF
Definition: sgbtrf.f:144
subroutine sgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
SGBEQU
Definition: sgbequ.f:153
subroutine sgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
SGETRI
Definition: sgetri.f:114
subroutine sgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
SGEEQU
Definition: sgeequ.f:139
subroutine sgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGERFS
Definition: sgerfs.f:185
subroutine sgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SGECON
Definition: sgecon.f:124
subroutine sgetrf(M, N, A, LDA, IPIV, INFO)
SGETRF
Definition: sgetrf.f:108
subroutine sgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SGETRS
Definition: sgetrs.f:121
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:108
subroutine serrge(PATH, NUNIT)
SERRGE
Definition: serrge.f:55