1 SUBROUTINE ZERRGT( 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 * ZERRGT tests the error exits for the COMPLEX*16 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 DOUBLE PRECISION ANORM, RCOND
37 * ..
38 * .. Local Arrays ..
39 INTEGER IP( NMAX )
40 DOUBLE PRECISION D( NMAX ), DF( NMAX ), R1( NMAX ), R2( NMAX ),
41 $ RW( NMAX )
42 COMPLEX*16 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, CHKXER, ZGTCON, ZGTRFS, ZGTTRF, ZGTTRS,
52 $ ZPTCON, ZPTRFS, ZPTTRF, ZPTTRS
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.D0
70 E( I ) = 2.D0
71 DL( I ) = 3.D0
72 DU( I ) = 4.D0
73 10 CONTINUE
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 * ZGTTRF
82 *
83 SRNAMT = 'ZGTTRF'
84 INFOT = 1
85 CALL ZGTTRF( -1, DL, E, DU, DU2, IP, INFO )
86 CALL CHKXER( 'ZGTTRF', INFOT, NOUT, LERR, OK )
87 *
88 * ZGTTRS
89 *
90 SRNAMT = 'ZGTTRS'
91 INFOT = 1
92 CALL ZGTTRS( '/', 0, 0, DL, E, DU, DU2, IP, X, 1, INFO )
93 CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK )
94 INFOT = 2
95 CALL ZGTTRS( 'N', -1, 0, DL, E, DU, DU2, IP, X, 1, INFO )
96 CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK )
97 INFOT = 3
98 CALL ZGTTRS( 'N', 0, -1, DL, E, DU, DU2, IP, X, 1, INFO )
99 CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK )
100 INFOT = 10
101 CALL ZGTTRS( 'N', 2, 1, DL, E, DU, DU2, IP, X, 1, INFO )
102 CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK )
103 *
104 * ZGTRFS
105 *
106 SRNAMT = 'ZGTRFS'
107 INFOT = 1
108 CALL ZGTRFS( '/', 0, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1,
109 $ X, 1, R1, R2, W, RW, INFO )
110 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
111 INFOT = 2
112 CALL ZGTRFS( 'N', -1, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B,
113 $ 1, X, 1, R1, R2, W, RW, INFO )
114 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
115 INFOT = 3
116 CALL ZGTRFS( 'N', 0, -1, DL, E, DU, DLF, EF, DUF, DU2, IP, B,
117 $ 1, X, 1, R1, R2, W, RW, INFO )
118 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
119 INFOT = 13
120 CALL ZGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1,
121 $ X, 2, R1, R2, W, RW, INFO )
122 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
123 INFOT = 15
124 CALL ZGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 2,
125 $ X, 1, R1, R2, W, RW, INFO )
126 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
127 *
128 * ZGTCON
129 *
130 SRNAMT = 'ZGTCON'
131 INFOT = 1
132 CALL ZGTCON( '/', 0, DL, E, DU, DU2, IP, ANORM, RCOND, W,
133 $ INFO )
134 CALL CHKXER( 'ZGTCON', INFOT, NOUT, LERR, OK )
135 INFOT = 2
136 CALL ZGTCON( 'I', -1, DL, E, DU, DU2, IP, ANORM, RCOND, W,
137 $ INFO )
138 CALL CHKXER( 'ZGTCON', INFOT, NOUT, LERR, OK )
139 INFOT = 8
140 CALL ZGTCON( 'I', 0, DL, E, DU, DU2, IP, -ANORM, RCOND, W,
141 $ INFO )
142 CALL CHKXER( 'ZGTCON', 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 * ZPTTRF
150 *
151 SRNAMT = 'ZPTTRF'
152 INFOT = 1
153 CALL ZPTTRF( -1, D, E, INFO )
154 CALL CHKXER( 'ZPTTRF', INFOT, NOUT, LERR, OK )
155 *
156 * ZPTTRS
157 *
158 SRNAMT = 'ZPTTRS'
159 INFOT = 1
160 CALL ZPTTRS( '/', 1, 0, D, E, X, 1, INFO )
161 CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK )
162 INFOT = 2
163 CALL ZPTTRS( 'U', -1, 0, D, E, X, 1, INFO )
164 CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK )
165 INFOT = 3
166 CALL ZPTTRS( 'U', 0, -1, D, E, X, 1, INFO )
167 CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK )
168 INFOT = 7
169 CALL ZPTTRS( 'U', 2, 1, D, E, X, 1, INFO )
170 CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK )
171 *
172 * ZPTRFS
173 *
174 SRNAMT = 'ZPTRFS'
175 INFOT = 1
176 CALL ZPTRFS( '/', 1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
177 $ RW, INFO )
178 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
179 INFOT = 2
180 CALL ZPTRFS( 'U', -1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
181 $ RW, INFO )
182 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
183 INFOT = 3
184 CALL ZPTRFS( 'U', 0, -1, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
185 $ RW, INFO )
186 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
187 INFOT = 9
188 CALL ZPTRFS( 'U', 2, 1, D, E, DF, EF, B, 1, X, 2, R1, R2, W,
189 $ RW, INFO )
190 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
191 INFOT = 11
192 CALL ZPTRFS( 'U', 2, 1, D, E, DF, EF, B, 2, X, 1, R1, R2, W,
193 $ RW, INFO )
194 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
195 *
196 * ZPTCON
197 *
198 SRNAMT = 'ZPTCON'
199 INFOT = 1
200 CALL ZPTCON( -1, D, E, ANORM, RCOND, RW, INFO )
201 CALL CHKXER( 'ZPTCON', INFOT, NOUT, LERR, OK )
202 INFOT = 4
203 CALL ZPTCON( 0, D, E, -ANORM, RCOND, RW, INFO )
204 CALL CHKXER( 'ZPTCON', 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 ZERRGT
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 * ZERRGT tests the error exits for the COMPLEX*16 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 DOUBLE PRECISION ANORM, RCOND
37 * ..
38 * .. Local Arrays ..
39 INTEGER IP( NMAX )
40 DOUBLE PRECISION D( NMAX ), DF( NMAX ), R1( NMAX ), R2( NMAX ),
41 $ RW( NMAX )
42 COMPLEX*16 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, CHKXER, ZGTCON, ZGTRFS, ZGTTRF, ZGTTRS,
52 $ ZPTCON, ZPTRFS, ZPTTRF, ZPTTRS
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.D0
70 E( I ) = 2.D0
71 DL( I ) = 3.D0
72 DU( I ) = 4.D0
73 10 CONTINUE
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 * ZGTTRF
82 *
83 SRNAMT = 'ZGTTRF'
84 INFOT = 1
85 CALL ZGTTRF( -1, DL, E, DU, DU2, IP, INFO )
86 CALL CHKXER( 'ZGTTRF', INFOT, NOUT, LERR, OK )
87 *
88 * ZGTTRS
89 *
90 SRNAMT = 'ZGTTRS'
91 INFOT = 1
92 CALL ZGTTRS( '/', 0, 0, DL, E, DU, DU2, IP, X, 1, INFO )
93 CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK )
94 INFOT = 2
95 CALL ZGTTRS( 'N', -1, 0, DL, E, DU, DU2, IP, X, 1, INFO )
96 CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK )
97 INFOT = 3
98 CALL ZGTTRS( 'N', 0, -1, DL, E, DU, DU2, IP, X, 1, INFO )
99 CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK )
100 INFOT = 10
101 CALL ZGTTRS( 'N', 2, 1, DL, E, DU, DU2, IP, X, 1, INFO )
102 CALL CHKXER( 'ZGTTRS', INFOT, NOUT, LERR, OK )
103 *
104 * ZGTRFS
105 *
106 SRNAMT = 'ZGTRFS'
107 INFOT = 1
108 CALL ZGTRFS( '/', 0, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1,
109 $ X, 1, R1, R2, W, RW, INFO )
110 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
111 INFOT = 2
112 CALL ZGTRFS( 'N', -1, 0, DL, E, DU, DLF, EF, DUF, DU2, IP, B,
113 $ 1, X, 1, R1, R2, W, RW, INFO )
114 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
115 INFOT = 3
116 CALL ZGTRFS( 'N', 0, -1, DL, E, DU, DLF, EF, DUF, DU2, IP, B,
117 $ 1, X, 1, R1, R2, W, RW, INFO )
118 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
119 INFOT = 13
120 CALL ZGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 1,
121 $ X, 2, R1, R2, W, RW, INFO )
122 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
123 INFOT = 15
124 CALL ZGTRFS( 'N', 2, 1, DL, E, DU, DLF, EF, DUF, DU2, IP, B, 2,
125 $ X, 1, R1, R2, W, RW, INFO )
126 CALL CHKXER( 'ZGTRFS', INFOT, NOUT, LERR, OK )
127 *
128 * ZGTCON
129 *
130 SRNAMT = 'ZGTCON'
131 INFOT = 1
132 CALL ZGTCON( '/', 0, DL, E, DU, DU2, IP, ANORM, RCOND, W,
133 $ INFO )
134 CALL CHKXER( 'ZGTCON', INFOT, NOUT, LERR, OK )
135 INFOT = 2
136 CALL ZGTCON( 'I', -1, DL, E, DU, DU2, IP, ANORM, RCOND, W,
137 $ INFO )
138 CALL CHKXER( 'ZGTCON', INFOT, NOUT, LERR, OK )
139 INFOT = 8
140 CALL ZGTCON( 'I', 0, DL, E, DU, DU2, IP, -ANORM, RCOND, W,
141 $ INFO )
142 CALL CHKXER( 'ZGTCON', 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 * ZPTTRF
150 *
151 SRNAMT = 'ZPTTRF'
152 INFOT = 1
153 CALL ZPTTRF( -1, D, E, INFO )
154 CALL CHKXER( 'ZPTTRF', INFOT, NOUT, LERR, OK )
155 *
156 * ZPTTRS
157 *
158 SRNAMT = 'ZPTTRS'
159 INFOT = 1
160 CALL ZPTTRS( '/', 1, 0, D, E, X, 1, INFO )
161 CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK )
162 INFOT = 2
163 CALL ZPTTRS( 'U', -1, 0, D, E, X, 1, INFO )
164 CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK )
165 INFOT = 3
166 CALL ZPTTRS( 'U', 0, -1, D, E, X, 1, INFO )
167 CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK )
168 INFOT = 7
169 CALL ZPTTRS( 'U', 2, 1, D, E, X, 1, INFO )
170 CALL CHKXER( 'ZPTTRS', INFOT, NOUT, LERR, OK )
171 *
172 * ZPTRFS
173 *
174 SRNAMT = 'ZPTRFS'
175 INFOT = 1
176 CALL ZPTRFS( '/', 1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
177 $ RW, INFO )
178 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
179 INFOT = 2
180 CALL ZPTRFS( 'U', -1, 0, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
181 $ RW, INFO )
182 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
183 INFOT = 3
184 CALL ZPTRFS( 'U', 0, -1, D, E, DF, EF, B, 1, X, 1, R1, R2, W,
185 $ RW, INFO )
186 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
187 INFOT = 9
188 CALL ZPTRFS( 'U', 2, 1, D, E, DF, EF, B, 1, X, 2, R1, R2, W,
189 $ RW, INFO )
190 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
191 INFOT = 11
192 CALL ZPTRFS( 'U', 2, 1, D, E, DF, EF, B, 2, X, 1, R1, R2, W,
193 $ RW, INFO )
194 CALL CHKXER( 'ZPTRFS', INFOT, NOUT, LERR, OK )
195 *
196 * ZPTCON
197 *
198 SRNAMT = 'ZPTCON'
199 INFOT = 1
200 CALL ZPTCON( -1, D, E, ANORM, RCOND, RW, INFO )
201 CALL CHKXER( 'ZPTCON', INFOT, NOUT, LERR, OK )
202 INFOT = 4
203 CALL ZPTCON( 0, D, E, -ANORM, RCOND, RW, INFO )
204 CALL CHKXER( 'ZPTCON', 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 ZERRGT
214 *
215 END