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,
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*
242      END
243