1*> \brief \b SERRGT
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 SERRGT( 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*> SERRGT tests the error exits for the REAL 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 single_lin
52*
53*  =====================================================================
54      SUBROUTINE SERRGT( 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      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*
242      END
243