LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
derrgt.f
Go to the documentation of this file.
1 *> \brief \b DERRGT
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE DERRGT( PATH, NUNIT )
12 *
13 * .. Scalar Arguments ..
14 * CHARACTER*3 PATH
15 * INTEGER NUNIT
16 * ..
17 *
18 *
19 *> \par Purpose:
20 * =============
21 *>
22 *> \verbatim
23 *>
24 *> DERRGT tests the error exits for the DOUBLE PRECISION tridiagonal
25 *> routines.
26 *> \endverbatim
27 *
28 * Arguments:
29 * ==========
30 *
31 *> \param[in] PATH
32 *> \verbatim
33 *> PATH is CHARACTER*3
34 *> The LAPACK path name for the routines to be tested.
35 *> \endverbatim
36 *>
37 *> \param[in] NUNIT
38 *> \verbatim
39 *> NUNIT is INTEGER
40 *> The unit number for output.
41 *> \endverbatim
42 *
43 * Authors:
44 * ========
45 *
46 *> \author Univ. of Tennessee
47 *> \author Univ. of California Berkeley
48 *> \author Univ. of Colorado Denver
49 *> \author NAG Ltd.
50 *
51 *> \ingroup double_lin
52 *
53 * =====================================================================
54  SUBROUTINE derrgt( PATH, NUNIT )
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,
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 *
242  END
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
subroutine derrgt(PATH, NUNIT)
DERRGT
Definition: derrgt.f:55
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
subroutine dgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DGTCON
Definition: dgtcon.f:146
subroutine dgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
DGTTRS
Definition: dgttrs.f:138
subroutine dgttrf(N, DL, D, DU, DU2, IPIV, INFO)
DGTTRF
Definition: dgttrf.f:124
subroutine dptrfs(N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR, WORK, INFO)
DPTRFS
Definition: dptrfs.f:163
subroutine dptcon(N, D, E, ANORM, RCOND, WORK, INFO)
DPTCON
Definition: dptcon.f:118
subroutine dpttrf(N, D, E, INFO)
DPTTRF
Definition: dpttrf.f:91
subroutine dpttrs(N, NRHS, D, E, B, LDB, INFO)
DPTTRS
Definition: dpttrs.f:109