1 SUBROUTINE DERRGT( 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 * DERRGT tests the error exits for the DOUBLE PRECISION 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 DOUBLE PRECISION ANORM, RCOND
37 * ..
38 * .. Local Arrays ..
39 INTEGER IP( NMAX ), IW( NMAX )
40 DOUBLE PRECISION 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, DGTCON, DGTRFS, DGTTRF, DGTTRS,
50 $ DPTCON, DPTRFS, DPTTRF, DPTTRS
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.D0
67 D( 2 ) = 2.D0
68 DF( 1 ) = 1.D0
69 DF( 2 ) = 2.D0
70 E( 1 ) = 3.D0
71 E( 2 ) = 4.D0
72 EF( 1 ) = 3.D0
73 EF( 2 ) = 4.D0
74 ANORM = 1.0D0
75 OK = .TRUE.
76 *
77 IF( LSAMEN( 2, C2, 'GT' ) ) THEN
78 *
79 * Test error exits for the general tridiagonal routines.
80 *
81 * DGTTRF
82 *
83 SRNAMT = 'DGTTRF'
84 INFOT = 1
85 CALL DGTTRF( -1, C, D, E, F, IP, INFO )
86 CALL CHKXER( 'DGTTRF', INFOT, NOUT, LERR, OK )
87 *
88 * DGTTRS
89 *
90 SRNAMT = 'DGTTRS'
91 INFOT = 1
92 CALL DGTTRS( '/', 0, 0, C, D, E, F, IP, X, 1, INFO )
93 CALL CHKXER( 'DGTTRS', INFOT, NOUT, LERR, OK )
94 INFOT = 2
95 CALL DGTTRS( 'N', -1, 0, C, D, E, F, IP, X, 1, INFO )
96 CALL CHKXER( 'DGTTRS', INFOT, NOUT, LERR, OK )
97 INFOT = 3
98 CALL DGTTRS( 'N', 0, -1, C, D, E, F, IP, X, 1, INFO )
99 CALL CHKXER( 'DGTTRS', INFOT, NOUT, LERR, OK )
100 INFOT = 10
101 CALL DGTTRS( 'N', 2, 1, C, D, E, F, IP, X, 1, INFO )
102 CALL CHKXER( 'DGTTRS', INFOT, NOUT, LERR, OK )
103 *
104 * DGTRFS
105 *
106 SRNAMT = 'DGTRFS'
107 INFOT = 1
108 CALL DGTRFS( '/', 0, 0, C, D, E, CF, DF, EF, F, IP, B, 1, X, 1,
109 $ R1, R2, W, IW, INFO )
110 CALL CHKXER( 'DGTRFS', INFOT, NOUT, LERR, OK )
111 INFOT = 2
112 CALL DGTRFS( 'N', -1, 0, C, D, E, CF, DF, EF, F, IP, B, 1, X,
113 $ 1, R1, R2, W, IW, INFO )
114 CALL CHKXER( 'DGTRFS', INFOT, NOUT, LERR, OK )
115 INFOT = 3
116 CALL DGTRFS( 'N', 0, -1, C, D, E, CF, DF, EF, F, IP, B, 1, X,
117 $ 1, R1, R2, W, IW, INFO )
118 CALL CHKXER( 'DGTRFS', INFOT, NOUT, LERR, OK )
119 INFOT = 13
120 CALL DGTRFS( 'N', 2, 1, C, D, E, CF, DF, EF, F, IP, B, 1, X, 2,
121 $ R1, R2, W, IW, INFO )
122 CALL CHKXER( 'DGTRFS', INFOT, NOUT, LERR, OK )
123 INFOT = 15
124 CALL DGTRFS( 'N', 2, 1, C, D, E, CF, DF, EF, F, IP, B, 2, X, 1,
125 $ R1, R2, W, IW, INFO )
126 CALL CHKXER( 'DGTRFS', INFOT, NOUT, LERR, OK )
127 *
128 * DGTCON
129 *
130 SRNAMT = 'DGTCON'
131 INFOT = 1
132 CALL DGTCON( '/', 0, C, D, E, F, IP, ANORM, RCOND, W, IW,
133 $ INFO )
134 CALL CHKXER( 'DGTCON', INFOT, NOUT, LERR, OK )
135 INFOT = 2
136 CALL DGTCON( 'I', -1, C, D, E, F, IP, ANORM, RCOND, W, IW,
137 $ INFO )
138 CALL CHKXER( 'DGTCON', INFOT, NOUT, LERR, OK )
139 INFOT = 8
140 CALL DGTCON( 'I', 0, C, D, E, F, IP, -ANORM, RCOND, W, IW,
141 $ INFO )
142 CALL CHKXER( 'DGTCON', 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 * DPTTRF
150 *
151 SRNAMT = 'DPTTRF'
152 INFOT = 1
153 CALL DPTTRF( -1, D, E, INFO )
154 CALL CHKXER( 'DPTTRF', INFOT, NOUT, LERR, OK )
155 *
156 * DPTTRS
157 *
158 SRNAMT = 'DPTTRS'
159 INFOT = 1
160 CALL DPTTRS( -1, 0, D, E, X, 1, INFO )
161 CALL CHKXER( 'DPTTRS', INFOT, NOUT, LERR, OK )
162 INFOT = 2
163 CALL DPTTRS( 0, -1, D, E, X, 1, INFO )
164 CALL CHKXER( 'DPTTRS', INFOT, NOUT, LERR, OK )
165 INFOT = 6
166 CALL DPTTRS( 2, 1, D, E, X, 1, INFO )
167 CALL CHKXER( 'DPTTRS', INFOT, NOUT, LERR, OK )
168 *
169 * DPTRFS
170 *
171 SRNAMT = 'DPTRFS'
172 INFOT = 1
173 CALL DPTRFS( -1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W, INFO )
174 CALL CHKXER( 'DPTRFS', INFOT, NOUT, LERR, OK )
175 INFOT = 2
176 CALL DPTRFS( 0, -1, D, E, DF, EF, B, 1, X, 1, R1, R2, W, INFO )
177 CALL CHKXER( 'DPTRFS', INFOT, NOUT, LERR, OK )
178 INFOT = 8
179 CALL DPTRFS( 2, 1, D, E, DF, EF, B, 1, X, 2, R1, R2, W, INFO )
180 CALL CHKXER( 'DPTRFS', INFOT, NOUT, LERR, OK )
181 INFOT = 10
182 CALL DPTRFS( 2, 1, D, E, DF, EF, B, 2, X, 1, R1, R2, W, INFO )
183 CALL CHKXER( 'DPTRFS', INFOT, NOUT, LERR, OK )
184 *
185 * DPTCON
186 *
187 SRNAMT = 'DPTCON'
188 INFOT = 1
189 CALL DPTCON( -1, D, E, ANORM, RCOND, W, INFO )
190 CALL CHKXER( 'DPTCON', INFOT, NOUT, LERR, OK )
191 INFOT = 4
192 CALL DPTCON( 0, D, E, -ANORM, RCOND, W, INFO )
193 CALL CHKXER( 'DPTCON', 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 DERRGT
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 * DERRGT tests the error exits for the DOUBLE PRECISION 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 DOUBLE PRECISION ANORM, RCOND
37 * ..
38 * .. Local Arrays ..
39 INTEGER IP( NMAX ), IW( NMAX )
40 DOUBLE PRECISION 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, DGTCON, DGTRFS, DGTTRF, DGTTRS,
50 $ DPTCON, DPTRFS, DPTTRF, DPTTRS
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.D0
67 D( 2 ) = 2.D0
68 DF( 1 ) = 1.D0
69 DF( 2 ) = 2.D0
70 E( 1 ) = 3.D0
71 E( 2 ) = 4.D0
72 EF( 1 ) = 3.D0
73 EF( 2 ) = 4.D0
74 ANORM = 1.0D0
75 OK = .TRUE.
76 *
77 IF( LSAMEN( 2, C2, 'GT' ) ) THEN
78 *
79 * Test error exits for the general tridiagonal routines.
80 *
81 * DGTTRF
82 *
83 SRNAMT = 'DGTTRF'
84 INFOT = 1
85 CALL DGTTRF( -1, C, D, E, F, IP, INFO )
86 CALL CHKXER( 'DGTTRF', INFOT, NOUT, LERR, OK )
87 *
88 * DGTTRS
89 *
90 SRNAMT = 'DGTTRS'
91 INFOT = 1
92 CALL DGTTRS( '/', 0, 0, C, D, E, F, IP, X, 1, INFO )
93 CALL CHKXER( 'DGTTRS', INFOT, NOUT, LERR, OK )
94 INFOT = 2
95 CALL DGTTRS( 'N', -1, 0, C, D, E, F, IP, X, 1, INFO )
96 CALL CHKXER( 'DGTTRS', INFOT, NOUT, LERR, OK )
97 INFOT = 3
98 CALL DGTTRS( 'N', 0, -1, C, D, E, F, IP, X, 1, INFO )
99 CALL CHKXER( 'DGTTRS', INFOT, NOUT, LERR, OK )
100 INFOT = 10
101 CALL DGTTRS( 'N', 2, 1, C, D, E, F, IP, X, 1, INFO )
102 CALL CHKXER( 'DGTTRS', INFOT, NOUT, LERR, OK )
103 *
104 * DGTRFS
105 *
106 SRNAMT = 'DGTRFS'
107 INFOT = 1
108 CALL DGTRFS( '/', 0, 0, C, D, E, CF, DF, EF, F, IP, B, 1, X, 1,
109 $ R1, R2, W, IW, INFO )
110 CALL CHKXER( 'DGTRFS', INFOT, NOUT, LERR, OK )
111 INFOT = 2
112 CALL DGTRFS( 'N', -1, 0, C, D, E, CF, DF, EF, F, IP, B, 1, X,
113 $ 1, R1, R2, W, IW, INFO )
114 CALL CHKXER( 'DGTRFS', INFOT, NOUT, LERR, OK )
115 INFOT = 3
116 CALL DGTRFS( 'N', 0, -1, C, D, E, CF, DF, EF, F, IP, B, 1, X,
117 $ 1, R1, R2, W, IW, INFO )
118 CALL CHKXER( 'DGTRFS', INFOT, NOUT, LERR, OK )
119 INFOT = 13
120 CALL DGTRFS( 'N', 2, 1, C, D, E, CF, DF, EF, F, IP, B, 1, X, 2,
121 $ R1, R2, W, IW, INFO )
122 CALL CHKXER( 'DGTRFS', INFOT, NOUT, LERR, OK )
123 INFOT = 15
124 CALL DGTRFS( 'N', 2, 1, C, D, E, CF, DF, EF, F, IP, B, 2, X, 1,
125 $ R1, R2, W, IW, INFO )
126 CALL CHKXER( 'DGTRFS', INFOT, NOUT, LERR, OK )
127 *
128 * DGTCON
129 *
130 SRNAMT = 'DGTCON'
131 INFOT = 1
132 CALL DGTCON( '/', 0, C, D, E, F, IP, ANORM, RCOND, W, IW,
133 $ INFO )
134 CALL CHKXER( 'DGTCON', INFOT, NOUT, LERR, OK )
135 INFOT = 2
136 CALL DGTCON( 'I', -1, C, D, E, F, IP, ANORM, RCOND, W, IW,
137 $ INFO )
138 CALL CHKXER( 'DGTCON', INFOT, NOUT, LERR, OK )
139 INFOT = 8
140 CALL DGTCON( 'I', 0, C, D, E, F, IP, -ANORM, RCOND, W, IW,
141 $ INFO )
142 CALL CHKXER( 'DGTCON', 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 * DPTTRF
150 *
151 SRNAMT = 'DPTTRF'
152 INFOT = 1
153 CALL DPTTRF( -1, D, E, INFO )
154 CALL CHKXER( 'DPTTRF', INFOT, NOUT, LERR, OK )
155 *
156 * DPTTRS
157 *
158 SRNAMT = 'DPTTRS'
159 INFOT = 1
160 CALL DPTTRS( -1, 0, D, E, X, 1, INFO )
161 CALL CHKXER( 'DPTTRS', INFOT, NOUT, LERR, OK )
162 INFOT = 2
163 CALL DPTTRS( 0, -1, D, E, X, 1, INFO )
164 CALL CHKXER( 'DPTTRS', INFOT, NOUT, LERR, OK )
165 INFOT = 6
166 CALL DPTTRS( 2, 1, D, E, X, 1, INFO )
167 CALL CHKXER( 'DPTTRS', INFOT, NOUT, LERR, OK )
168 *
169 * DPTRFS
170 *
171 SRNAMT = 'DPTRFS'
172 INFOT = 1
173 CALL DPTRFS( -1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W, INFO )
174 CALL CHKXER( 'DPTRFS', INFOT, NOUT, LERR, OK )
175 INFOT = 2
176 CALL DPTRFS( 0, -1, D, E, DF, EF, B, 1, X, 1, R1, R2, W, INFO )
177 CALL CHKXER( 'DPTRFS', INFOT, NOUT, LERR, OK )
178 INFOT = 8
179 CALL DPTRFS( 2, 1, D, E, DF, EF, B, 1, X, 2, R1, R2, W, INFO )
180 CALL CHKXER( 'DPTRFS', INFOT, NOUT, LERR, OK )
181 INFOT = 10
182 CALL DPTRFS( 2, 1, D, E, DF, EF, B, 2, X, 1, R1, R2, W, INFO )
183 CALL CHKXER( 'DPTRFS', INFOT, NOUT, LERR, OK )
184 *
185 * DPTCON
186 *
187 SRNAMT = 'DPTCON'
188 INFOT = 1
189 CALL DPTCON( -1, D, E, ANORM, RCOND, W, INFO )
190 CALL CHKXER( 'DPTCON', INFOT, NOUT, LERR, OK )
191 INFOT = 4
192 CALL DPTCON( 0, D, E, -ANORM, RCOND, W, INFO )
193 CALL CHKXER( 'DPTCON', 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 DERRGT
203 *
204 END