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

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