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*> \date December 2016
52*
53*> \ingroup single_lin
54*
55*  =====================================================================
56      SUBROUTINE SERRGT( PATH, NUNIT )
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      REAL               ANORM, RCOND
78*     ..
79*     .. Local Arrays ..
80      INTEGER            IP( NMAX ), IW( NMAX )
81      REAL               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, SGTCON, SGTRFS, SGTTRF, SGTTRS,
91     $                   SPTCON, SPTRFS, SPTTRF, SPTTRS
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.
108      D( 2 ) = 2.
109      DF( 1 ) = 1.
110      DF( 2 ) = 2.
111      E( 1 ) = 3.
112      E( 2 ) = 4.
113      EF( 1 ) = 3.
114      EF( 2 ) = 4.
115      ANORM = 1.0
116      OK = .TRUE.
117*
118      IF( LSAMEN( 2, C2, 'GT' ) ) THEN
119*
120*        Test error exits for the general tridiagonal routines.
121*
122*        SGTTRF
123*
124         SRNAMT = 'SGTTRF'
125         INFOT = 1
126         CALL SGTTRF( -1, C, D, E, F, IP, INFO )
127         CALL CHKXER( 'SGTTRF', INFOT, NOUT, LERR, OK )
128*
129*        SGTTRS
130*
131         SRNAMT = 'SGTTRS'
132         INFOT = 1
133         CALL SGTTRS( '/', 0, 0, C, D, E, F, IP, X, 1, INFO )
134         CALL CHKXER( 'SGTTRS', INFOT, NOUT, LERR, OK )
135         INFOT = 2
136         CALL SGTTRS( 'N', -1, 0, C, D, E, F, IP, X, 1, INFO )
137         CALL CHKXER( 'SGTTRS', INFOT, NOUT, LERR, OK )
138         INFOT = 3
139         CALL SGTTRS( 'N', 0, -1, C, D, E, F, IP, X, 1, INFO )
140         CALL CHKXER( 'SGTTRS', INFOT, NOUT, LERR, OK )
141         INFOT = 10
142         CALL SGTTRS( 'N', 2, 1, C, D, E, F, IP, X, 1, INFO )
143         CALL CHKXER( 'SGTTRS', INFOT, NOUT, LERR, OK )
144*
145*        SGTRFS
146*
147         SRNAMT = 'SGTRFS'
148         INFOT = 1
149         CALL SGTRFS( '/', 0, 0, C, D, E, CF, DF, EF, F, IP, B, 1, X, 1,
150     $                R1, R2, W, IW, INFO )
151         CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK )
152         INFOT = 2
153         CALL SGTRFS( 'N', -1, 0, C, D, E, CF, DF, EF, F, IP, B, 1, X,
154     $                1, R1, R2, W, IW, INFO )
155         CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK )
156         INFOT = 3
157         CALL SGTRFS( 'N', 0, -1, C, D, E, CF, DF, EF, F, IP, B, 1, X,
158     $                1, R1, R2, W, IW, INFO )
159         CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK )
160         INFOT = 13
161         CALL SGTRFS( 'N', 2, 1, C, D, E, CF, DF, EF, F, IP, B, 1, X, 2,
162     $                R1, R2, W, IW, INFO )
163         CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK )
164         INFOT = 15
165         CALL SGTRFS( 'N', 2, 1, C, D, E, CF, DF, EF, F, IP, B, 2, X, 1,
166     $                R1, R2, W, IW, INFO )
167         CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK )
168*
169*        SGTCON
170*
171         SRNAMT = 'SGTCON'
172         INFOT = 1
173         CALL SGTCON( '/', 0, C, D, E, F, IP, ANORM, RCOND, W, IW,
174     $                INFO )
175         CALL CHKXER( 'SGTCON', INFOT, NOUT, LERR, OK )
176         INFOT = 2
177         CALL SGTCON( 'I', -1, C, D, E, F, IP, ANORM, RCOND, W, IW,
178     $                INFO )
179         CALL CHKXER( 'SGTCON', INFOT, NOUT, LERR, OK )
180         INFOT = 8
181         CALL SGTCON( 'I', 0, C, D, E, F, IP, -ANORM, RCOND, W, IW,
182     $                INFO )
183         CALL CHKXER( 'SGTCON', 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*        SPTTRF
191*
192         SRNAMT = 'SPTTRF'
193         INFOT = 1
194         CALL SPTTRF( -1, D, E, INFO )
195         CALL CHKXER( 'SPTTRF', INFOT, NOUT, LERR, OK )
196*
197*        SPTTRS
198*
199         SRNAMT = 'SPTTRS'
200         INFOT = 1
201         CALL SPTTRS( -1, 0, D, E, X, 1, INFO )
202         CALL CHKXER( 'SPTTRS', INFOT, NOUT, LERR, OK )
203         INFOT = 2
204         CALL SPTTRS( 0, -1, D, E, X, 1, INFO )
205         CALL CHKXER( 'SPTTRS', INFOT, NOUT, LERR, OK )
206         INFOT = 6
207         CALL SPTTRS( 2, 1, D, E, X, 1, INFO )
208         CALL CHKXER( 'SPTTRS', INFOT, NOUT, LERR, OK )
209*
210*        SPTRFS
211*
212         SRNAMT = 'SPTRFS'
213         INFOT = 1
214         CALL SPTRFS( -1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W, INFO )
215         CALL CHKXER( 'SPTRFS', INFOT, NOUT, LERR, OK )
216         INFOT = 2
217         CALL SPTRFS( 0, -1, D, E, DF, EF, B, 1, X, 1, R1, R2, W, INFO )
218         CALL CHKXER( 'SPTRFS', INFOT, NOUT, LERR, OK )
219         INFOT = 8
220         CALL SPTRFS( 2, 1, D, E, DF, EF, B, 1, X, 2, R1, R2, W, INFO )
221         CALL CHKXER( 'SPTRFS', INFOT, NOUT, LERR, OK )
222         INFOT = 10
223         CALL SPTRFS( 2, 1, D, E, DF, EF, B, 2, X, 1, R1, R2, W, INFO )
224         CALL CHKXER( 'SPTRFS', INFOT, NOUT, LERR, OK )
225*
226*        SPTCON
227*
228         SRNAMT = 'SPTCON'
229         INFOT = 1
230         CALL SPTCON( -1, D, E, ANORM, RCOND, W, INFO )
231         CALL CHKXER( 'SPTCON', INFOT, NOUT, LERR, OK )
232         INFOT = 4
233         CALL SPTCON( 0, D, E, -ANORM, RCOND, W, INFO )
234         CALL CHKXER( 'SPTCON', 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 SERRGT
244*
245      END
246