1 SUBROUTINE SERRGT( PATH, NUNIT )
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * SERRGT tests the error exits for the REAL tridiagonal
16 * routines.
17 *
18 * Arguments
19 * =========
20 *
21 * PATH (input) CHARACTER*3
22 * The LAPACK path name for the routines to be tested.
23 *
24 * NUNIT (input) INTEGER
25 * The unit number for output.
26 *
27 * =====================================================================
28 *
29 * .. Parameters ..
30 INTEGER NMAX
31 PARAMETER ( NMAX = 2 )
32 * ..
33 * .. Local Scalars ..
34 CHARACTER*2 C2
35 INTEGER INFO
36 REAL ANORM, RCOND
37 * ..
38 * .. Local Arrays ..
39 INTEGER IP( NMAX ), IW( NMAX )
40 REAL B( NMAX ), C( NMAX ), CF( NMAX ), D( NMAX ),
41 $ DF( NMAX ), E( NMAX ), EF( NMAX ), F( NMAX ),
42 $ R1( NMAX ), R2( NMAX ), W( NMAX ), X( NMAX )
43 * ..
44 * .. External Functions ..
45 LOGICAL LSAMEN
46 EXTERNAL LSAMEN
47 * ..
48 * .. External Subroutines ..
49 EXTERNAL ALAESM, CHKXER, SGTCON, SGTRFS, SGTTRF, SGTTRS,
50 $ SPTCON, SPTRFS, SPTTRF, SPTTRS
51 * ..
52 * .. Scalars in Common ..
53 LOGICAL LERR, OK
54 CHARACTER*32 SRNAMT
55 INTEGER INFOT, NOUT
56 * ..
57 * .. Common blocks ..
58 COMMON / INFOC / INFOT, NOUT, OK, LERR
59 COMMON / SRNAMC / SRNAMT
60 * ..
61 * .. Executable Statements ..
62 *
63 NOUT = NUNIT
64 WRITE( NOUT, FMT = * )
65 C2 = PATH( 2: 3 )
66 D( 1 ) = 1.
67 D( 2 ) = 2.
68 DF( 1 ) = 1.
69 DF( 2 ) = 2.
70 E( 1 ) = 3.
71 E( 2 ) = 4.
72 EF( 1 ) = 3.
73 EF( 2 ) = 4.
74 ANORM = 1.0
75 OK = .TRUE.
76 *
77 IF( LSAMEN( 2, C2, 'GT' ) ) THEN
78 *
79 * Test error exits for the general tridiagonal routines.
80 *
81 * SGTTRF
82 *
83 SRNAMT = 'SGTTRF'
84 INFOT = 1
85 CALL SGTTRF( -1, C, D, E, F, IP, INFO )
86 CALL CHKXER( 'SGTTRF', INFOT, NOUT, LERR, OK )
87 *
88 * SGTTRS
89 *
90 SRNAMT = 'SGTTRS'
91 INFOT = 1
92 CALL SGTTRS( '/', 0, 0, C, D, E, F, IP, X, 1, INFO )
93 CALL CHKXER( 'SGTTRS', INFOT, NOUT, LERR, OK )
94 INFOT = 2
95 CALL SGTTRS( 'N', -1, 0, C, D, E, F, IP, X, 1, INFO )
96 CALL CHKXER( 'SGTTRS', INFOT, NOUT, LERR, OK )
97 INFOT = 3
98 CALL SGTTRS( 'N', 0, -1, C, D, E, F, IP, X, 1, INFO )
99 CALL CHKXER( 'SGTTRS', INFOT, NOUT, LERR, OK )
100 INFOT = 10
101 CALL SGTTRS( 'N', 2, 1, C, D, E, F, IP, X, 1, INFO )
102 CALL CHKXER( 'SGTTRS', INFOT, NOUT, LERR, OK )
103 *
104 * SGTRFS
105 *
106 SRNAMT = 'SGTRFS'
107 INFOT = 1
108 CALL SGTRFS( '/', 0, 0, C, D, E, CF, DF, EF, F, IP, B, 1, X, 1,
109 $ R1, R2, W, IW, INFO )
110 CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK )
111 INFOT = 2
112 CALL SGTRFS( 'N', -1, 0, C, D, E, CF, DF, EF, F, IP, B, 1, X,
113 $ 1, R1, R2, W, IW, INFO )
114 CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK )
115 INFOT = 3
116 CALL SGTRFS( 'N', 0, -1, C, D, E, CF, DF, EF, F, IP, B, 1, X,
117 $ 1, R1, R2, W, IW, INFO )
118 CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK )
119 INFOT = 13
120 CALL SGTRFS( 'N', 2, 1, C, D, E, CF, DF, EF, F, IP, B, 1, X, 2,
121 $ R1, R2, W, IW, INFO )
122 CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK )
123 INFOT = 15
124 CALL SGTRFS( 'N', 2, 1, C, D, E, CF, DF, EF, F, IP, B, 2, X, 1,
125 $ R1, R2, W, IW, INFO )
126 CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK )
127 *
128 * SGTCON
129 *
130 SRNAMT = 'SGTCON'
131 INFOT = 1
132 CALL SGTCON( '/', 0, C, D, E, F, IP, ANORM, RCOND, W, IW,
133 $ INFO )
134 CALL CHKXER( 'SGTCON', INFOT, NOUT, LERR, OK )
135 INFOT = 2
136 CALL SGTCON( 'I', -1, C, D, E, F, IP, ANORM, RCOND, W, IW,
137 $ INFO )
138 CALL CHKXER( 'SGTCON', INFOT, NOUT, LERR, OK )
139 INFOT = 8
140 CALL SGTCON( 'I', 0, C, D, E, F, IP, -ANORM, RCOND, W, IW,
141 $ INFO )
142 CALL CHKXER( 'SGTCON', INFOT, NOUT, LERR, OK )
143 *
144 ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN
145 *
146 * Test error exits for the positive definite tridiagonal
147 * routines.
148 *
149 * SPTTRF
150 *
151 SRNAMT = 'SPTTRF'
152 INFOT = 1
153 CALL SPTTRF( -1, D, E, INFO )
154 CALL CHKXER( 'SPTTRF', INFOT, NOUT, LERR, OK )
155 *
156 * SPTTRS
157 *
158 SRNAMT = 'SPTTRS'
159 INFOT = 1
160 CALL SPTTRS( -1, 0, D, E, X, 1, INFO )
161 CALL CHKXER( 'SPTTRS', INFOT, NOUT, LERR, OK )
162 INFOT = 2
163 CALL SPTTRS( 0, -1, D, E, X, 1, INFO )
164 CALL CHKXER( 'SPTTRS', INFOT, NOUT, LERR, OK )
165 INFOT = 6
166 CALL SPTTRS( 2, 1, D, E, X, 1, INFO )
167 CALL CHKXER( 'SPTTRS', INFOT, NOUT, LERR, OK )
168 *
169 * SPTRFS
170 *
171 SRNAMT = 'SPTRFS'
172 INFOT = 1
173 CALL SPTRFS( -1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W, INFO )
174 CALL CHKXER( 'SPTRFS', INFOT, NOUT, LERR, OK )
175 INFOT = 2
176 CALL SPTRFS( 0, -1, D, E, DF, EF, B, 1, X, 1, R1, R2, W, INFO )
177 CALL CHKXER( 'SPTRFS', INFOT, NOUT, LERR, OK )
178 INFOT = 8
179 CALL SPTRFS( 2, 1, D, E, DF, EF, B, 1, X, 2, R1, R2, W, INFO )
180 CALL CHKXER( 'SPTRFS', INFOT, NOUT, LERR, OK )
181 INFOT = 10
182 CALL SPTRFS( 2, 1, D, E, DF, EF, B, 2, X, 1, R1, R2, W, INFO )
183 CALL CHKXER( 'SPTRFS', INFOT, NOUT, LERR, OK )
184 *
185 * SPTCON
186 *
187 SRNAMT = 'SPTCON'
188 INFOT = 1
189 CALL SPTCON( -1, D, E, ANORM, RCOND, W, INFO )
190 CALL CHKXER( 'SPTCON', INFOT, NOUT, LERR, OK )
191 INFOT = 4
192 CALL SPTCON( 0, D, E, -ANORM, RCOND, W, INFO )
193 CALL CHKXER( 'SPTCON', INFOT, NOUT, LERR, OK )
194 END IF
195 *
196 * Print a summary line.
197 *
198 CALL ALAESM( PATH, OK, NOUT )
199 *
200 RETURN
201 *
202 * End of SERRGT
203 *
204 END
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * SERRGT tests the error exits for the REAL tridiagonal
16 * routines.
17 *
18 * Arguments
19 * =========
20 *
21 * PATH (input) CHARACTER*3
22 * The LAPACK path name for the routines to be tested.
23 *
24 * NUNIT (input) INTEGER
25 * The unit number for output.
26 *
27 * =====================================================================
28 *
29 * .. Parameters ..
30 INTEGER NMAX
31 PARAMETER ( NMAX = 2 )
32 * ..
33 * .. Local Scalars ..
34 CHARACTER*2 C2
35 INTEGER INFO
36 REAL ANORM, RCOND
37 * ..
38 * .. Local Arrays ..
39 INTEGER IP( NMAX ), IW( NMAX )
40 REAL B( NMAX ), C( NMAX ), CF( NMAX ), D( NMAX ),
41 $ DF( NMAX ), E( NMAX ), EF( NMAX ), F( NMAX ),
42 $ R1( NMAX ), R2( NMAX ), W( NMAX ), X( NMAX )
43 * ..
44 * .. External Functions ..
45 LOGICAL LSAMEN
46 EXTERNAL LSAMEN
47 * ..
48 * .. External Subroutines ..
49 EXTERNAL ALAESM, CHKXER, SGTCON, SGTRFS, SGTTRF, SGTTRS,
50 $ SPTCON, SPTRFS, SPTTRF, SPTTRS
51 * ..
52 * .. Scalars in Common ..
53 LOGICAL LERR, OK
54 CHARACTER*32 SRNAMT
55 INTEGER INFOT, NOUT
56 * ..
57 * .. Common blocks ..
58 COMMON / INFOC / INFOT, NOUT, OK, LERR
59 COMMON / SRNAMC / SRNAMT
60 * ..
61 * .. Executable Statements ..
62 *
63 NOUT = NUNIT
64 WRITE( NOUT, FMT = * )
65 C2 = PATH( 2: 3 )
66 D( 1 ) = 1.
67 D( 2 ) = 2.
68 DF( 1 ) = 1.
69 DF( 2 ) = 2.
70 E( 1 ) = 3.
71 E( 2 ) = 4.
72 EF( 1 ) = 3.
73 EF( 2 ) = 4.
74 ANORM = 1.0
75 OK = .TRUE.
76 *
77 IF( LSAMEN( 2, C2, 'GT' ) ) THEN
78 *
79 * Test error exits for the general tridiagonal routines.
80 *
81 * SGTTRF
82 *
83 SRNAMT = 'SGTTRF'
84 INFOT = 1
85 CALL SGTTRF( -1, C, D, E, F, IP, INFO )
86 CALL CHKXER( 'SGTTRF', INFOT, NOUT, LERR, OK )
87 *
88 * SGTTRS
89 *
90 SRNAMT = 'SGTTRS'
91 INFOT = 1
92 CALL SGTTRS( '/', 0, 0, C, D, E, F, IP, X, 1, INFO )
93 CALL CHKXER( 'SGTTRS', INFOT, NOUT, LERR, OK )
94 INFOT = 2
95 CALL SGTTRS( 'N', -1, 0, C, D, E, F, IP, X, 1, INFO )
96 CALL CHKXER( 'SGTTRS', INFOT, NOUT, LERR, OK )
97 INFOT = 3
98 CALL SGTTRS( 'N', 0, -1, C, D, E, F, IP, X, 1, INFO )
99 CALL CHKXER( 'SGTTRS', INFOT, NOUT, LERR, OK )
100 INFOT = 10
101 CALL SGTTRS( 'N', 2, 1, C, D, E, F, IP, X, 1, INFO )
102 CALL CHKXER( 'SGTTRS', INFOT, NOUT, LERR, OK )
103 *
104 * SGTRFS
105 *
106 SRNAMT = 'SGTRFS'
107 INFOT = 1
108 CALL SGTRFS( '/', 0, 0, C, D, E, CF, DF, EF, F, IP, B, 1, X, 1,
109 $ R1, R2, W, IW, INFO )
110 CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK )
111 INFOT = 2
112 CALL SGTRFS( 'N', -1, 0, C, D, E, CF, DF, EF, F, IP, B, 1, X,
113 $ 1, R1, R2, W, IW, INFO )
114 CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK )
115 INFOT = 3
116 CALL SGTRFS( 'N', 0, -1, C, D, E, CF, DF, EF, F, IP, B, 1, X,
117 $ 1, R1, R2, W, IW, INFO )
118 CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK )
119 INFOT = 13
120 CALL SGTRFS( 'N', 2, 1, C, D, E, CF, DF, EF, F, IP, B, 1, X, 2,
121 $ R1, R2, W, IW, INFO )
122 CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK )
123 INFOT = 15
124 CALL SGTRFS( 'N', 2, 1, C, D, E, CF, DF, EF, F, IP, B, 2, X, 1,
125 $ R1, R2, W, IW, INFO )
126 CALL CHKXER( 'SGTRFS', INFOT, NOUT, LERR, OK )
127 *
128 * SGTCON
129 *
130 SRNAMT = 'SGTCON'
131 INFOT = 1
132 CALL SGTCON( '/', 0, C, D, E, F, IP, ANORM, RCOND, W, IW,
133 $ INFO )
134 CALL CHKXER( 'SGTCON', INFOT, NOUT, LERR, OK )
135 INFOT = 2
136 CALL SGTCON( 'I', -1, C, D, E, F, IP, ANORM, RCOND, W, IW,
137 $ INFO )
138 CALL CHKXER( 'SGTCON', INFOT, NOUT, LERR, OK )
139 INFOT = 8
140 CALL SGTCON( 'I', 0, C, D, E, F, IP, -ANORM, RCOND, W, IW,
141 $ INFO )
142 CALL CHKXER( 'SGTCON', INFOT, NOUT, LERR, OK )
143 *
144 ELSE IF( LSAMEN( 2, C2, 'PT' ) ) THEN
145 *
146 * Test error exits for the positive definite tridiagonal
147 * routines.
148 *
149 * SPTTRF
150 *
151 SRNAMT = 'SPTTRF'
152 INFOT = 1
153 CALL SPTTRF( -1, D, E, INFO )
154 CALL CHKXER( 'SPTTRF', INFOT, NOUT, LERR, OK )
155 *
156 * SPTTRS
157 *
158 SRNAMT = 'SPTTRS'
159 INFOT = 1
160 CALL SPTTRS( -1, 0, D, E, X, 1, INFO )
161 CALL CHKXER( 'SPTTRS', INFOT, NOUT, LERR, OK )
162 INFOT = 2
163 CALL SPTTRS( 0, -1, D, E, X, 1, INFO )
164 CALL CHKXER( 'SPTTRS', INFOT, NOUT, LERR, OK )
165 INFOT = 6
166 CALL SPTTRS( 2, 1, D, E, X, 1, INFO )
167 CALL CHKXER( 'SPTTRS', INFOT, NOUT, LERR, OK )
168 *
169 * SPTRFS
170 *
171 SRNAMT = 'SPTRFS'
172 INFOT = 1
173 CALL SPTRFS( -1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W, INFO )
174 CALL CHKXER( 'SPTRFS', INFOT, NOUT, LERR, OK )
175 INFOT = 2
176 CALL SPTRFS( 0, -1, D, E, DF, EF, B, 1, X, 1, R1, R2, W, INFO )
177 CALL CHKXER( 'SPTRFS', INFOT, NOUT, LERR, OK )
178 INFOT = 8
179 CALL SPTRFS( 2, 1, D, E, DF, EF, B, 1, X, 2, R1, R2, W, INFO )
180 CALL CHKXER( 'SPTRFS', INFOT, NOUT, LERR, OK )
181 INFOT = 10
182 CALL SPTRFS( 2, 1, D, E, DF, EF, B, 2, X, 1, R1, R2, W, INFO )
183 CALL CHKXER( 'SPTRFS', INFOT, NOUT, LERR, OK )
184 *
185 * SPTCON
186 *
187 SRNAMT = 'SPTCON'
188 INFOT = 1
189 CALL SPTCON( -1, D, E, ANORM, RCOND, W, INFO )
190 CALL CHKXER( 'SPTCON', INFOT, NOUT, LERR, OK )
191 INFOT = 4
192 CALL SPTCON( 0, D, E, -ANORM, RCOND, W, INFO )
193 CALL CHKXER( 'SPTCON', INFOT, NOUT, LERR, OK )
194 END IF
195 *
196 * Print a summary line.
197 *
198 CALL ALAESM( PATH, OK, NOUT )
199 *
200 RETURN
201 *
202 * End of SERRGT
203 *
204 END