LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine serrge ( character*3  PATH,
integer  NUNIT 
)

SERRGE

SERRGEX

Purpose: 
 SERRGE tests the error exits for the REAL routines
 for general matrices.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011
Purpose: 
 SERRGE tests the error exits for the REAL routines
 for general matrices.

 Note that this file is used only when the XBLAS are available,
 otherwise serrge.f defines this subroutine.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 57 of file serrge.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: