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

◆ derrgt()

subroutine derrgt ( character*3  path,
integer  nunit 
)

DERRGT

Purpose:
 DERRGT tests the error exits for the DOUBLE PRECISION 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 derrgt.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 DOUBLE PRECISION ANORM, RCOND
75* ..
76* .. Local Arrays ..
77 INTEGER IP( NMAX ), IW( NMAX )
78 DOUBLE PRECISION 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, dgtcon, dgtrfs, dgttrf, dgttrs,
88 $ dptcon, dptrfs, dpttrf, dpttrs
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.d0
105 d( 2 ) = 2.d0
106 df( 1 ) = 1.d0
107 df( 2 ) = 2.d0
108 e( 1 ) = 3.d0
109 e( 2 ) = 4.d0
110 ef( 1 ) = 3.d0
111 ef( 2 ) = 4.d0
112 anorm = 1.0d0
113 ok = .true.
114*
115 IF( lsamen( 2, c2, 'GT' ) ) THEN
116*
117* Test error exits for the general tridiagonal routines.
118*
119* DGTTRF
120*
121 srnamt = 'DGTTRF'
122 infot = 1
123 CALL dgttrf( -1, c, d, e, f, ip, info )
124 CALL chkxer( 'DGTTRF', infot, nout, lerr, ok )
125*
126* DGTTRS
127*
128 srnamt = 'DGTTRS'
129 infot = 1
130 CALL dgttrs( '/', 0, 0, c, d, e, f, ip, x, 1, info )
131 CALL chkxer( 'DGTTRS', infot, nout, lerr, ok )
132 infot = 2
133 CALL dgttrs( 'N', -1, 0, c, d, e, f, ip, x, 1, info )
134 CALL chkxer( 'DGTTRS', infot, nout, lerr, ok )
135 infot = 3
136 CALL dgttrs( 'N', 0, -1, c, d, e, f, ip, x, 1, info )
137 CALL chkxer( 'DGTTRS', infot, nout, lerr, ok )
138 infot = 10
139 CALL dgttrs( 'N', 2, 1, c, d, e, f, ip, x, 1, info )
140 CALL chkxer( 'DGTTRS', infot, nout, lerr, ok )
141*
142* DGTRFS
143*
144 srnamt = 'DGTRFS'
145 infot = 1
146 CALL dgtrfs( '/', 0, 0, c, d, e, cf, df, ef, f, ip, b, 1, x, 1,
147 $ r1, r2, w, iw, info )
148 CALL chkxer( 'DGTRFS', infot, nout, lerr, ok )
149 infot = 2
150 CALL dgtrfs( 'N', -1, 0, c, d, e, cf, df, ef, f, ip, b, 1, x,
151 $ 1, r1, r2, w, iw, info )
152 CALL chkxer( 'DGTRFS', infot, nout, lerr, ok )
153 infot = 3
154 CALL dgtrfs( 'N', 0, -1, c, d, e, cf, df, ef, f, ip, b, 1, x,
155 $ 1, r1, r2, w, iw, info )
156 CALL chkxer( 'DGTRFS', infot, nout, lerr, ok )
157 infot = 13
158 CALL dgtrfs( 'N', 2, 1, c, d, e, cf, df, ef, f, ip, b, 1, x, 2,
159 $ r1, r2, w, iw, info )
160 CALL chkxer( 'DGTRFS', infot, nout, lerr, ok )
161 infot = 15
162 CALL dgtrfs( 'N', 2, 1, c, d, e, cf, df, ef, f, ip, b, 2, x, 1,
163 $ r1, r2, w, iw, info )
164 CALL chkxer( 'DGTRFS', infot, nout, lerr, ok )
165*
166* DGTCON
167*
168 srnamt = 'DGTCON'
169 infot = 1
170 CALL dgtcon( '/', 0, c, d, e, f, ip, anorm, rcond, w, iw,
171 $ info )
172 CALL chkxer( 'DGTCON', infot, nout, lerr, ok )
173 infot = 2
174 CALL dgtcon( 'I', -1, c, d, e, f, ip, anorm, rcond, w, iw,
175 $ info )
176 CALL chkxer( 'DGTCON', infot, nout, lerr, ok )
177 infot = 8
178 CALL dgtcon( 'I', 0, c, d, e, f, ip, -anorm, rcond, w, iw,
179 $ info )
180 CALL chkxer( 'DGTCON', 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* DPTTRF
188*
189 srnamt = 'DPTTRF'
190 infot = 1
191 CALL dpttrf( -1, d, e, info )
192 CALL chkxer( 'DPTTRF', infot, nout, lerr, ok )
193*
194* DPTTRS
195*
196 srnamt = 'DPTTRS'
197 infot = 1
198 CALL dpttrs( -1, 0, d, e, x, 1, info )
199 CALL chkxer( 'DPTTRS', infot, nout, lerr, ok )
200 infot = 2
201 CALL dpttrs( 0, -1, d, e, x, 1, info )
202 CALL chkxer( 'DPTTRS', infot, nout, lerr, ok )
203 infot = 6
204 CALL dpttrs( 2, 1, d, e, x, 1, info )
205 CALL chkxer( 'DPTTRS', infot, nout, lerr, ok )
206*
207* DPTRFS
208*
209 srnamt = 'DPTRFS'
210 infot = 1
211 CALL dptrfs( -1, 0, d, e, df, ef, b, 1, x, 1, r1, r2, w, info )
212 CALL chkxer( 'DPTRFS', infot, nout, lerr, ok )
213 infot = 2
214 CALL dptrfs( 0, -1, d, e, df, ef, b, 1, x, 1, r1, r2, w, info )
215 CALL chkxer( 'DPTRFS', infot, nout, lerr, ok )
216 infot = 8
217 CALL dptrfs( 2, 1, d, e, df, ef, b, 1, x, 2, r1, r2, w, info )
218 CALL chkxer( 'DPTRFS', infot, nout, lerr, ok )
219 infot = 10
220 CALL dptrfs( 2, 1, d, e, df, ef, b, 2, x, 1, r1, r2, w, info )
221 CALL chkxer( 'DPTRFS', infot, nout, lerr, ok )
222*
223* DPTCON
224*
225 srnamt = 'DPTCON'
226 infot = 1
227 CALL dptcon( -1, d, e, anorm, rcond, w, info )
228 CALL chkxer( 'DPTCON', infot, nout, lerr, ok )
229 infot = 4
230 CALL dptcon( 0, d, e, -anorm, rcond, w, info )
231 CALL chkxer( 'DPTCON', 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 DERRGT
241*
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3224
dgtcon
subroutine dgtcon(norm, n, dl, d, du, du2, ipiv, anorm, rcond, work, iwork, info)
DGTCON
Definition dgtcon.f:146
dgtrfs
subroutine dgtrfs(trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
DGTRFS
Definition dgtrfs.f:209
dgttrf
subroutine dgttrf(n, dl, d, du, du2, ipiv, info)
DGTTRF
Definition dgttrf.f:124
dgttrs
subroutine dgttrs(trans, n, nrhs, dl, d, du, du2, ipiv, b, ldb, info)
DGTTRS
Definition dgttrs.f:138
lsamen
logical function lsamen(n, ca, cb)
LSAMEN
Definition lsamen.f:74
dptcon
subroutine dptcon(n, d, e, anorm, rcond, work, info)
DPTCON
Definition dptcon.f:118
dptrfs
subroutine dptrfs(n, nrhs, d, e, df, ef, b, ldb, x, ldx, ferr, berr, work, info)
DPTRFS
Definition dptrfs.f:163
dpttrf
subroutine dpttrf(n, d, e, info)
DPTTRF
Definition dpttrf.f:91
dpttrs
subroutine dpttrs(n, nrhs, d, e, b, ldb, info)
DPTTRS
Definition dpttrs.f:109
Here is the call graph for this function:
Here is the caller graph for this function: