1 SUBROUTINE CERRGT( 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 * CERRGT tests the error exits for the COMPLEX 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 I, INFO
36 REAL ANORM, RCOND
37 * ..
38 * .. Local Arrays ..
39 INTEGER IP( NMAX )
40 REAL D( NMAX ), DF( NMAX ), R1( NMAX ), R2( NMAX ),
41 $ RW( NMAX )
42 COMPLEX B( NMAX ), DL( NMAX ), DLF( NMAX ), DU( NMAX ),
43 $ DU2( NMAX ), DUF( NMAX ), E( NMAX ),
44 $ EF( NMAX ), W( NMAX ), X( NMAX )
45 * ..
46 * .. External Functions ..
47 LOGICAL LSAMEN
48 EXTERNAL LSAMEN
49 * ..
50 * .. External Subroutines ..
51 EXTERNAL ALAESM, CGTCON, CGTRFS, CGTTRF, CGTTRS, CHKXER,
52 $ CPTCON, CPTRFS, CPTTRF, CPTTRS
53 * ..
54 * .. Scalars in Common ..
55 LOGICAL LERR, OK
56 CHARACTER*32 SRNAMT
57 INTEGER INFOT, NOUT
58 * ..
59 * .. Common blocks ..
60 COMMON / INFOC / INFOT, NOUT, OK, LERR
61 COMMON / SRNAMC / SRNAMT
62 * ..
63 * .. Executable Statements ..
64 *
65 NOUT = NUNIT
66 WRITE( NOUT, FMT = * )
67 C2 = PATH( 2: 3 )
68 DO 10 I = 1, NMAX
69 D( I ) = 1.
70 E( I ) = 2.
71 DL( I ) = 3.
72 DU( I ) = 4.
73 10 CONTINUE
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 * CGTTRF
82 *
83 SRNAMT = 'CGTTRF'
84 INFOT = 1
85 CALL CGTTRF( -1, DL, E, DU, DU2, IP, INFO )
86 CALL CHKXER( 'CGTTRF', INFOT, NOUT, LERR, OK )
87 *
88 * CGTTRS
89 *
90 SRNAMT = 'CGTTRS'
91 INFOT = 1
92 CALL CGTTRS( '/', 0, 0, DL, E, DU, DU2, IP, X, 1, INFO )
93 CALL CHKXER( 'CGTTRS', INFOT, NOUT, LERR, OK )
94 INFOT = 2
95 CALL CGTTRS( 'N', -1, 0, DL, E, DU, DU2, IP, X, 1, INFO )
96 CALL CHKXER( 'CGTTRS', INFOT, NOUT, LERR, OK )
97 INFOT = 3
98 CALL CGTTRS( 'N', 0, -1, DL, E, DU, DU2, IP, X, 1, INFO )
99 CALL CHKXER( 'CGTTRS', INFOT, NOUT, LERR, OK )
100 INFOT = 10
101 CALL CGTTRS( 'N', 2, 1, DL, E, DU, DU2, IP, X, 1, INFO )
102 CALL CHKXER( 'CGTTRS', INFOT, NOUT, LERR, OK )
103 *
104 * CGTRFS
105 *
106 SRNAMT = 'CGTRFS'
107 INFOT = 1
108 CALL CGTRFS( '/', 0, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1,
109 $ X, 1, R1, R2, W, RW, INFO )
110 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK )
111 INFOT = 2
112 CALL CGTRFS( 'N', -1, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B,
113 $ 1, X, 1, R1, R2, W, RW, INFO )
114 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK )
115 INFOT = 3
116 CALL CGTRFS( 'N', 0, -1, DL, E, DU, DLF, EF, DUF, DU2, IP, B,
117 $ 1, X, 1, R1, R2, W, RW, INFO )
118 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK )
119 INFOT = 13
120 CALL CGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1,
121 $ X, 2, R1, R2, W, RW, INFO )
122 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK )
123 INFOT = 15
124 CALL CGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 2,
125 $ X, 1, R1, R2, W, RW, INFO )
126 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK )
127 *
128 * CGTCON
129 *
130 SRNAMT = 'CGTCON'
131 INFOT = 1
132 CALL CGTCON( '/', 0, DL, E, DU, DU2, IP, ANORM, RCOND, W,
133 $ INFO )
134 CALL CHKXER( 'CGTCON', INFOT, NOUT, LERR, OK )
135 INFOT = 2
136 CALL CGTCON( 'I', -1, DL, E, DU, DU2, IP, ANORM, RCOND, W,
137 $ INFO )
138 CALL CHKXER( 'CGTCON', INFOT, NOUT, LERR, OK )
139 INFOT = 8
140 CALL CGTCON( 'I', 0, DL, E, DU, DU2, IP, -ANORM, RCOND, W,
141 $ INFO )
142 CALL CHKXER( 'CGTCON', 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 * CPTTRF
150 *
151 SRNAMT = 'CPTTRF'
152 INFOT = 1
153 CALL CPTTRF( -1, D, E, INFO )
154 CALL CHKXER( 'CPTTRF', INFOT, NOUT, LERR, OK )
155 *
156 * CPTTRS
157 *
158 SRNAMT = 'CPTTRS'
159 INFOT = 1
160 CALL CPTTRS( '/', 1, 0, D, E, X, 1, INFO )
161 CALL CHKXER( 'CPTTRS', INFOT, NOUT, LERR, OK )
162 INFOT = 2
163 CALL CPTTRS( 'U', -1, 0, D, E, X, 1, INFO )
164 CALL CHKXER( 'CPTTRS', INFOT, NOUT, LERR, OK )
165 INFOT = 3
166 CALL CPTTRS( 'U', 0, -1, D, E, X, 1, INFO )
167 CALL CHKXER( 'CPTTRS', INFOT, NOUT, LERR, OK )
168 INFOT = 7
169 CALL CPTTRS( 'U', 2, 1, D, E, X, 1, INFO )
170 CALL CHKXER( 'CPTTRS', INFOT, NOUT, LERR, OK )
171 *
172 * CPTRFS
173 *
174 SRNAMT = 'CPTRFS'
175 INFOT = 1
176 CALL CPTRFS( '/', 1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
177 $ RW, INFO )
178 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK )
179 INFOT = 2
180 CALL CPTRFS( 'U', -1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
181 $ RW, INFO )
182 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK )
183 INFOT = 3
184 CALL CPTRFS( 'U', 0, -1, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
185 $ RW, INFO )
186 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK )
187 INFOT = 9
188 CALL CPTRFS( 'U', 2, 1, D, E, DF, EF, B, 1, X, 2, R1, R2, W,
189 $ RW, INFO )
190 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK )
191 INFOT = 11
192 CALL CPTRFS( 'U', 2, 1, D, E, DF, EF, B, 2, X, 1, R1, R2, W,
193 $ RW, INFO )
194 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK )
195 *
196 * CPTCON
197 *
198 SRNAMT = 'CPTCON'
199 INFOT = 1
200 CALL CPTCON( -1, D, E, ANORM, RCOND, RW, INFO )
201 CALL CHKXER( 'CPTCON', INFOT, NOUT, LERR, OK )
202 INFOT = 4
203 CALL CPTCON( 0, D, E, -ANORM, RCOND, RW, INFO )
204 CALL CHKXER( 'CPTCON', INFOT, NOUT, LERR, OK )
205 END IF
206 *
207 * Print a summary line.
208 *
209 CALL ALAESM( PATH, OK, NOUT )
210 *
211 RETURN
212 *
213 * End of CERRGT
214 *
215 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 * CERRGT tests the error exits for the COMPLEX 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 I, INFO
36 REAL ANORM, RCOND
37 * ..
38 * .. Local Arrays ..
39 INTEGER IP( NMAX )
40 REAL D( NMAX ), DF( NMAX ), R1( NMAX ), R2( NMAX ),
41 $ RW( NMAX )
42 COMPLEX B( NMAX ), DL( NMAX ), DLF( NMAX ), DU( NMAX ),
43 $ DU2( NMAX ), DUF( NMAX ), E( NMAX ),
44 $ EF( NMAX ), W( NMAX ), X( NMAX )
45 * ..
46 * .. External Functions ..
47 LOGICAL LSAMEN
48 EXTERNAL LSAMEN
49 * ..
50 * .. External Subroutines ..
51 EXTERNAL ALAESM, CGTCON, CGTRFS, CGTTRF, CGTTRS, CHKXER,
52 $ CPTCON, CPTRFS, CPTTRF, CPTTRS
53 * ..
54 * .. Scalars in Common ..
55 LOGICAL LERR, OK
56 CHARACTER*32 SRNAMT
57 INTEGER INFOT, NOUT
58 * ..
59 * .. Common blocks ..
60 COMMON / INFOC / INFOT, NOUT, OK, LERR
61 COMMON / SRNAMC / SRNAMT
62 * ..
63 * .. Executable Statements ..
64 *
65 NOUT = NUNIT
66 WRITE( NOUT, FMT = * )
67 C2 = PATH( 2: 3 )
68 DO 10 I = 1, NMAX
69 D( I ) = 1.
70 E( I ) = 2.
71 DL( I ) = 3.
72 DU( I ) = 4.
73 10 CONTINUE
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 * CGTTRF
82 *
83 SRNAMT = 'CGTTRF'
84 INFOT = 1
85 CALL CGTTRF( -1, DL, E, DU, DU2, IP, INFO )
86 CALL CHKXER( 'CGTTRF', INFOT, NOUT, LERR, OK )
87 *
88 * CGTTRS
89 *
90 SRNAMT = 'CGTTRS'
91 INFOT = 1
92 CALL CGTTRS( '/', 0, 0, DL, E, DU, DU2, IP, X, 1, INFO )
93 CALL CHKXER( 'CGTTRS', INFOT, NOUT, LERR, OK )
94 INFOT = 2
95 CALL CGTTRS( 'N', -1, 0, DL, E, DU, DU2, IP, X, 1, INFO )
96 CALL CHKXER( 'CGTTRS', INFOT, NOUT, LERR, OK )
97 INFOT = 3
98 CALL CGTTRS( 'N', 0, -1, DL, E, DU, DU2, IP, X, 1, INFO )
99 CALL CHKXER( 'CGTTRS', INFOT, NOUT, LERR, OK )
100 INFOT = 10
101 CALL CGTTRS( 'N', 2, 1, DL, E, DU, DU2, IP, X, 1, INFO )
102 CALL CHKXER( 'CGTTRS', INFOT, NOUT, LERR, OK )
103 *
104 * CGTRFS
105 *
106 SRNAMT = 'CGTRFS'
107 INFOT = 1
108 CALL CGTRFS( '/', 0, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1,
109 $ X, 1, R1, R2, W, RW, INFO )
110 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK )
111 INFOT = 2
112 CALL CGTRFS( 'N', -1, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B,
113 $ 1, X, 1, R1, R2, W, RW, INFO )
114 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK )
115 INFOT = 3
116 CALL CGTRFS( 'N', 0, -1, DL, E, DU, DLF, EF, DUF, DU2, IP, B,
117 $ 1, X, 1, R1, R2, W, RW, INFO )
118 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK )
119 INFOT = 13
120 CALL CGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1,
121 $ X, 2, R1, R2, W, RW, INFO )
122 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK )
123 INFOT = 15
124 CALL CGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 2,
125 $ X, 1, R1, R2, W, RW, INFO )
126 CALL CHKXER( 'CGTRFS', INFOT, NOUT, LERR, OK )
127 *
128 * CGTCON
129 *
130 SRNAMT = 'CGTCON'
131 INFOT = 1
132 CALL CGTCON( '/', 0, DL, E, DU, DU2, IP, ANORM, RCOND, W,
133 $ INFO )
134 CALL CHKXER( 'CGTCON', INFOT, NOUT, LERR, OK )
135 INFOT = 2
136 CALL CGTCON( 'I', -1, DL, E, DU, DU2, IP, ANORM, RCOND, W,
137 $ INFO )
138 CALL CHKXER( 'CGTCON', INFOT, NOUT, LERR, OK )
139 INFOT = 8
140 CALL CGTCON( 'I', 0, DL, E, DU, DU2, IP, -ANORM, RCOND, W,
141 $ INFO )
142 CALL CHKXER( 'CGTCON', 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 * CPTTRF
150 *
151 SRNAMT = 'CPTTRF'
152 INFOT = 1
153 CALL CPTTRF( -1, D, E, INFO )
154 CALL CHKXER( 'CPTTRF', INFOT, NOUT, LERR, OK )
155 *
156 * CPTTRS
157 *
158 SRNAMT = 'CPTTRS'
159 INFOT = 1
160 CALL CPTTRS( '/', 1, 0, D, E, X, 1, INFO )
161 CALL CHKXER( 'CPTTRS', INFOT, NOUT, LERR, OK )
162 INFOT = 2
163 CALL CPTTRS( 'U', -1, 0, D, E, X, 1, INFO )
164 CALL CHKXER( 'CPTTRS', INFOT, NOUT, LERR, OK )
165 INFOT = 3
166 CALL CPTTRS( 'U', 0, -1, D, E, X, 1, INFO )
167 CALL CHKXER( 'CPTTRS', INFOT, NOUT, LERR, OK )
168 INFOT = 7
169 CALL CPTTRS( 'U', 2, 1, D, E, X, 1, INFO )
170 CALL CHKXER( 'CPTTRS', INFOT, NOUT, LERR, OK )
171 *
172 * CPTRFS
173 *
174 SRNAMT = 'CPTRFS'
175 INFOT = 1
176 CALL CPTRFS( '/', 1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
177 $ RW, INFO )
178 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK )
179 INFOT = 2
180 CALL CPTRFS( 'U', -1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
181 $ RW, INFO )
182 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK )
183 INFOT = 3
184 CALL CPTRFS( 'U', 0, -1, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
185 $ RW, INFO )
186 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK )
187 INFOT = 9
188 CALL CPTRFS( 'U', 2, 1, D, E, DF, EF, B, 1, X, 2, R1, R2, W,
189 $ RW, INFO )
190 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK )
191 INFOT = 11
192 CALL CPTRFS( 'U', 2, 1, D, E, DF, EF, B, 2, X, 1, R1, R2, W,
193 $ RW, INFO )
194 CALL CHKXER( 'CPTRFS', INFOT, NOUT, LERR, OK )
195 *
196 * CPTCON
197 *
198 SRNAMT = 'CPTCON'
199 INFOT = 1
200 CALL CPTCON( -1, D, E, ANORM, RCOND, RW, INFO )
201 CALL CHKXER( 'CPTCON', INFOT, NOUT, LERR, OK )
202 INFOT = 4
203 CALL CPTCON( 0, D, E, -ANORM, RCOND, RW, INFO )
204 CALL CHKXER( 'CPTCON', INFOT, NOUT, LERR, OK )
205 END IF
206 *
207 * Print a summary line.
208 *
209 CALL ALAESM( PATH, OK, NOUT )
210 *
211 RETURN
212 *
213 * End of CERRGT
214 *
215 END