LAPACK  3.9.0
LAPACK: Linear Algebra PACKage

◆ 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.
Date
December 2016

Definition at line 57 of file derrgt.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  DOUBLE PRECISION ANORM, RCOND
78 * ..
79 * .. Local Arrays ..
80  INTEGER IP( NMAX ), IW( NMAX )
81  DOUBLE PRECISION 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, dgtcon, dgtrfs, dgttrf, dgttrs,
91  $ dptcon, dptrfs, dpttrf, dpttrs
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.d0
108  d( 2 ) = 2.d0
109  df( 1 ) = 1.d0
110  df( 2 ) = 2.d0
111  e( 1 ) = 3.d0
112  e( 2 ) = 4.d0
113  ef( 1 ) = 3.d0
114  ef( 2 ) = 4.d0
115  anorm = 1.0d0
116  ok = .true.
117 *
118  IF( lsamen( 2, c2, 'GT' ) ) THEN
119 *
120 * Test error exits for the general tridiagonal routines.
121 *
122 * DGTTRF
123 *
124  srnamt = 'DGTTRF'
125  infot = 1
126  CALL dgttrf( -1, c, d, e, f, ip, info )
127  CALL chkxer( 'DGTTRF', infot, nout, lerr, ok )
128 *
129 * DGTTRS
130 *
131  srnamt = 'DGTTRS'
132  infot = 1
133  CALL dgttrs( '/', 0, 0, c, d, e, f, ip, x, 1, info )
134  CALL chkxer( 'DGTTRS', infot, nout, lerr, ok )
135  infot = 2
136  CALL dgttrs( 'N', -1, 0, c, d, e, f, ip, x, 1, info )
137  CALL chkxer( 'DGTTRS', infot, nout, lerr, ok )
138  infot = 3
139  CALL dgttrs( 'N', 0, -1, c, d, e, f, ip, x, 1, info )
140  CALL chkxer( 'DGTTRS', infot, nout, lerr, ok )
141  infot = 10
142  CALL dgttrs( 'N', 2, 1, c, d, e, f, ip, x, 1, info )
143  CALL chkxer( 'DGTTRS', infot, nout, lerr, ok )
144 *
145 * DGTRFS
146 *
147  srnamt = 'DGTRFS'
148  infot = 1
149  CALL dgtrfs( '/', 0, 0, c, d, e, cf, df, ef, f, ip, b, 1, x, 1,
150  $ r1, r2, w, iw, info )
151  CALL chkxer( 'DGTRFS', infot, nout, lerr, ok )
152  infot = 2
153  CALL dgtrfs( 'N', -1, 0, c, d, e, cf, df, ef, f, ip, b, 1, x,
154  $ 1, r1, r2, w, iw, info )
155  CALL chkxer( 'DGTRFS', infot, nout, lerr, ok )
156  infot = 3
157  CALL dgtrfs( 'N', 0, -1, c, d, e, cf, df, ef, f, ip, b, 1, x,
158  $ 1, r1, r2, w, iw, info )
159  CALL chkxer( 'DGTRFS', infot, nout, lerr, ok )
160  infot = 13
161  CALL dgtrfs( 'N', 2, 1, c, d, e, cf, df, ef, f, ip, b, 1, x, 2,
162  $ r1, r2, w, iw, info )
163  CALL chkxer( 'DGTRFS', infot, nout, lerr, ok )
164  infot = 15
165  CALL dgtrfs( 'N', 2, 1, c, d, e, cf, df, ef, f, ip, b, 2, x, 1,
166  $ r1, r2, w, iw, info )
167  CALL chkxer( 'DGTRFS', infot, nout, lerr, ok )
168 *
169 * DGTCON
170 *
171  srnamt = 'DGTCON'
172  infot = 1
173  CALL dgtcon( '/', 0, c, d, e, f, ip, anorm, rcond, w, iw,
174  $ info )
175  CALL chkxer( 'DGTCON', infot, nout, lerr, ok )
176  infot = 2
177  CALL dgtcon( 'I', -1, c, d, e, f, ip, anorm, rcond, w, iw,
178  $ info )
179  CALL chkxer( 'DGTCON', infot, nout, lerr, ok )
180  infot = 8
181  CALL dgtcon( 'I', 0, c, d, e, f, ip, -anorm, rcond, w, iw,
182  $ info )
183  CALL chkxer( 'DGTCON', 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 * DPTTRF
191 *
192  srnamt = 'DPTTRF'
193  infot = 1
194  CALL dpttrf( -1, d, e, info )
195  CALL chkxer( 'DPTTRF', infot, nout, lerr, ok )
196 *
197 * DPTTRS
198 *
199  srnamt = 'DPTTRS'
200  infot = 1
201  CALL dpttrs( -1, 0, d, e, x, 1, info )
202  CALL chkxer( 'DPTTRS', infot, nout, lerr, ok )
203  infot = 2
204  CALL dpttrs( 0, -1, d, e, x, 1, info )
205  CALL chkxer( 'DPTTRS', infot, nout, lerr, ok )
206  infot = 6
207  CALL dpttrs( 2, 1, d, e, x, 1, info )
208  CALL chkxer( 'DPTTRS', infot, nout, lerr, ok )
209 *
210 * DPTRFS
211 *
212  srnamt = 'DPTRFS'
213  infot = 1
214  CALL dptrfs( -1, 0, d, e, df, ef, b, 1, x, 1, r1, r2, w, info )
215  CALL chkxer( 'DPTRFS', infot, nout, lerr, ok )
216  infot = 2
217  CALL dptrfs( 0, -1, d, e, df, ef, b, 1, x, 1, r1, r2, w, info )
218  CALL chkxer( 'DPTRFS', infot, nout, lerr, ok )
219  infot = 8
220  CALL dptrfs( 2, 1, d, e, df, ef, b, 1, x, 2, r1, r2, w, info )
221  CALL chkxer( 'DPTRFS', infot, nout, lerr, ok )
222  infot = 10
223  CALL dptrfs( 2, 1, d, e, df, ef, b, 2, x, 1, r1, r2, w, info )
224  CALL chkxer( 'DPTRFS', infot, nout, lerr, ok )
225 *
226 * DPTCON
227 *
228  srnamt = 'DPTCON'
229  infot = 1
230  CALL dptcon( -1, d, e, anorm, rcond, w, info )
231  CALL chkxer( 'DPTCON', infot, nout, lerr, ok )
232  infot = 4
233  CALL dptcon( 0, d, e, -anorm, rcond, w, info )
234  CALL chkxer( 'DPTCON', 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 DERRGT
244 *
Here is the call graph for this function:
Here is the caller graph for this function:
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
dgttrs
subroutine dgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
DGTTRS
Definition: dgttrs.f:140
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:211
dpttrf
subroutine dpttrf(N, D, E, INFO)
DPTTRF
Definition: dpttrf.f:93
dptrfs
subroutine dptrfs(N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR, WORK, INFO)
DPTRFS
Definition: dptrfs.f:165
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
dpttrs
subroutine dpttrs(N, NRHS, D, E, B, LDB, INFO)
DPTTRS
Definition: dpttrs.f:111
dptcon
subroutine dptcon(N, D, E, ANORM, RCOND, WORK, INFO)
DPTCON
Definition: dptcon.f:120
dgttrf
subroutine dgttrf(N, DL, D, DU, DU2, IPIV, INFO)
DGTTRF
Definition: dgttrf.f:126
dgtcon
subroutine dgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DGTCON
Definition: dgtcon.f:148