LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ serrgt()

subroutine serrgt ( character*3  PATH,
integer  NUNIT 
)

SERRGT

Purpose:
 SERRGT tests the error exits for the REAL tridiagonal
 routines.
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
December 2016

Definition at line 57 of file serrgt.f.

57 *
58 * -- LAPACK test routine (version 3.7.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 * December 2016
62 *
63 * .. Scalar Arguments ..
64  CHARACTER*3 path
65  INTEGER nunit
66 * ..
67 *
68 * =====================================================================
69 *
70 * .. Parameters ..
71  INTEGER nmax
72  parameter( nmax = 2 )
73 * ..
74 * .. Local Scalars ..
75  CHARACTER*2 c2
76  INTEGER info
77  REAL anorm, rcond
78 * ..
79 * .. Local Arrays ..
80  INTEGER ip( nmax ), iw( nmax )
81  REAL b( nmax ), c( nmax ), cf( nmax ), d( nmax ),
82  $ df( nmax ), e( nmax ), ef( nmax ), f( nmax ),
83  $ r1( nmax ), r2( nmax ), w( nmax ), x( nmax )
84 * ..
85 * .. External Functions ..
86  LOGICAL lsamen
87  EXTERNAL lsamen
88 * ..
89 * .. External Subroutines ..
90  EXTERNAL alaesm, chkxer, sgtcon, sgtrfs, sgttrf, sgttrs,
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 * .. Executable Statements ..
103 *
104  nout = nunit
105  WRITE( nout, fmt = * )
106  c2 = path( 2: 3 )
107  d( 1 ) = 1.
108  d( 2 ) = 2.
109  df( 1 ) = 1.
110  df( 2 ) = 2.
111  e( 1 ) = 3.
112  e( 2 ) = 4.
113  ef( 1 ) = 3.
114  ef( 2 ) = 4.
115  anorm = 1.0
116  ok = .true.
117 *
118  IF( lsamen( 2, c2, 'GT' ) ) THEN
119 *
120 * Test error exits for the general tridiagonal routines.
121 *
122 * SGTTRF
123 *
124  srnamt = 'SGTTRF'
125  infot = 1
126  CALL sgttrf( -1, c, d, e, f, ip, info )
127  CALL chkxer( 'SGTTRF', infot, nout, lerr, ok )
128 *
129 * SGTTRS
130 *
131  srnamt = 'SGTTRS'
132  infot = 1
133  CALL sgttrs( '/', 0, 0, c, d, e, f, ip, x, 1, info )
134  CALL chkxer( 'SGTTRS', infot, nout, lerr, ok )
135  infot = 2
136  CALL sgttrs( 'N', -1, 0, c, d, e, f, ip, x, 1, info )
137  CALL chkxer( 'SGTTRS', infot, nout, lerr, ok )
138  infot = 3
139  CALL sgttrs( 'N', 0, -1, c, d, e, f, ip, x, 1, info )
140  CALL chkxer( 'SGTTRS', infot, nout, lerr, ok )
141  infot = 10
142  CALL sgttrs( 'N', 2, 1, c, d, e, f, ip, x, 1, info )
143  CALL chkxer( 'SGTTRS', infot, nout, lerr, ok )
144 *
145 * SGTRFS
146 *
147  srnamt = 'SGTRFS'
148  infot = 1
149  CALL sgtrfs( '/', 0, 0, c, d, e, cf, df, ef, f, ip, b, 1, x, 1,
150  $ r1, r2, w, iw, info )
151  CALL chkxer( 'SGTRFS', infot, nout, lerr, ok )
152  infot = 2
153  CALL sgtrfs( 'N', -1, 0, c, d, e, cf, df, ef, f, ip, b, 1, x,
154  $ 1, r1, r2, w, iw, info )
155  CALL chkxer( 'SGTRFS', infot, nout, lerr, ok )
156  infot = 3
157  CALL sgtrfs( 'N', 0, -1, c, d, e, cf, df, ef, f, ip, b, 1, x,
158  $ 1, r1, r2, w, iw, info )
159  CALL chkxer( 'SGTRFS', infot, nout, lerr, ok )
160  infot = 13
161  CALL sgtrfs( 'N', 2, 1, c, d, e, cf, df, ef, f, ip, b, 1, x, 2,
162  $ r1, r2, w, iw, info )
163  CALL chkxer( 'SGTRFS', infot, nout, lerr, ok )
164  infot = 15
165  CALL sgtrfs( 'N', 2, 1, c, d, e, cf, df, ef, f, ip, b, 2, x, 1,
166  $ r1, r2, w, iw, info )
167  CALL chkxer( 'SGTRFS', infot, nout, lerr, ok )
168 *
169 * SGTCON
170 *
171  srnamt = 'SGTCON'
172  infot = 1
173  CALL sgtcon( '/', 0, c, d, e, f, ip, anorm, rcond, w, iw,
174  $ info )
175  CALL chkxer( 'SGTCON', infot, nout, lerr, ok )
176  infot = 2
177  CALL sgtcon( 'I', -1, c, d, e, f, ip, anorm, rcond, w, iw,
178  $ info )
179  CALL chkxer( 'SGTCON', infot, nout, lerr, ok )
180  infot = 8
181  CALL sgtcon( 'I', 0, c, d, e, f, ip, -anorm, rcond, w, iw,
182  $ info )
183  CALL chkxer( 'SGTCON', infot, nout, lerr, ok )
184 *
185  ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
186 *
187 * Test error exits for the positive definite tridiagonal
188 * routines.
189 *
190 * SPTTRF
191 *
192  srnamt = 'SPTTRF'
193  infot = 1
194  CALL spttrf( -1, d, e, info )
195  CALL chkxer( 'SPTTRF', infot, nout, lerr, ok )
196 *
197 * SPTTRS
198 *
199  srnamt = 'SPTTRS'
200  infot = 1
201  CALL spttrs( -1, 0, d, e, x, 1, info )
202  CALL chkxer( 'SPTTRS', infot, nout, lerr, ok )
203  infot = 2
204  CALL spttrs( 0, -1, d, e, x, 1, info )
205  CALL chkxer( 'SPTTRS', infot, nout, lerr, ok )
206  infot = 6
207  CALL spttrs( 2, 1, d, e, x, 1, info )
208  CALL chkxer( 'SPTTRS', infot, nout, lerr, ok )
209 *
210 * SPTRFS
211 *
212  srnamt = 'SPTRFS'
213  infot = 1
214  CALL sptrfs( -1, 0, d, e, df, ef, b, 1, x, 1, r1, r2, w, info )
215  CALL chkxer( 'SPTRFS', infot, nout, lerr, ok )
216  infot = 2
217  CALL sptrfs( 0, -1, d, e, df, ef, b, 1, x, 1, r1, r2, w, info )
218  CALL chkxer( 'SPTRFS', infot, nout, lerr, ok )
219  infot = 8
220  CALL sptrfs( 2, 1, d, e, df, ef, b, 1, x, 2, r1, r2, w, info )
221  CALL chkxer( 'SPTRFS', infot, nout, lerr, ok )
222  infot = 10
223  CALL sptrfs( 2, 1, d, e, df, ef, b, 2, x, 1, r1, r2, w, info )
224  CALL chkxer( 'SPTRFS', infot, nout, lerr, ok )
225 *
226 * SPTCON
227 *
228  srnamt = 'SPTCON'
229  infot = 1
230  CALL sptcon( -1, d, e, anorm, rcond, w, info )
231  CALL chkxer( 'SPTCON', infot, nout, lerr, ok )
232  infot = 4
233  CALL sptcon( 0, d, e, -anorm, rcond, w, info )
234  CALL chkxer( 'SPTCON', infot, nout, lerr, ok )
235  END IF
236 *
237 * Print a summary line.
238 *
239  CALL alaesm( path, ok, nout )
240 *
241  RETURN
242 *
243 * End of SERRGT
244 *
subroutine sptcon(N, D, E, ANORM, RCOND, WORK, INFO)
SPTCON
Definition: sptcon.f:120
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
subroutine sgtrfs(TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGTRFS
Definition: sgtrfs.f:211
subroutine sgttrf(N, DL, D, DU, DU2, IPIV, INFO)
SGTTRF
Definition: sgttrf.f:126
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
subroutine sgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
SGTTRS
Definition: sgttrs.f:140
subroutine sgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SGTCON
Definition: sgtcon.f:148
subroutine sptrfs(N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR, WORK, INFO)
SPTRFS
Definition: sptrfs.f:165
subroutine spttrf(N, D, E, INFO)
SPTTRF
Definition: spttrf.f:93
subroutine spttrs(N, NRHS, D, E, B, LDB, INFO)
SPTTRS
Definition: spttrs.f:111
Here is the call graph for this function:
Here is the caller graph for this function: