LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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,
88 $ sptcon, sptrfs, spttrf, spttrs
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*
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
sgtcon
subroutine sgtcon(norm, n, dl, d, du, du2, ipiv, anorm, rcond, work, iwork, info)
SGTCON
Definition sgtcon.f:146
sgtrfs
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
sgttrf
subroutine sgttrf(n, dl, d, du, du2, ipiv, info)
SGTTRF
Definition sgttrf.f:124
sgttrs
subroutine sgttrs(trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb, info)
SGTTRS
Definition sgttrs.f:138
lsamen
logical function lsamen(n, ca, cb)
LSAMEN
Definition lsamen.f:74
sptcon
subroutine sptcon(n, d, e, anorm, rcond, work, info)
SPTCON
Definition sptcon.f:118
sptrfs
subroutine sptrfs(n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr, berr, work, info)
SPTRFS
Definition sptrfs.f:163
spttrf
subroutine spttrf(n, d, e, info)
SPTTRF
Definition spttrf.f:91
spttrs
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: