LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ serrge()

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.
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.

Definition at line 54 of file serrge.f.

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 *
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:74
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
Here is the call graph for this function:
Here is the caller graph for this function: