1 SUBROUTINE ZHET21( ITYPE, UPLO, N, KBAND, A, LDA, D, E, U, LDU, V,
2 $ LDV, TAU, WORK, RWORK, RESULT )
3 *
4 * -- LAPACK test routine (version 3.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 CHARACTER UPLO
10 INTEGER ITYPE, KBAND, LDA, LDU, LDV, N
11 * ..
12 * .. Array Arguments ..
13 DOUBLE PRECISION D( * ), E( * ), RESULT( 2 ), RWORK( * )
14 COMPLEX*16 A( LDA, * ), TAU( * ), U( LDU, * ),
15 $ V( LDV, * ), WORK( * )
16 * ..
17 *
18 * Purpose
19 * =======
20 *
21 * ZHET21 generally checks a decomposition of the form
22 *
23 * A = U S U*
24 *
25 * where * means conjugate transpose, A is hermitian, U is unitary, and
26 * S is diagonal (if KBAND=0) or (real) symmetric tridiagonal (if
27 * KBAND=1).
28 *
29 * If ITYPE=1, then U is represented as a dense matrix; otherwise U is
30 * expressed as a product of Householder transformations, whose vectors
31 * are stored in the array "V" and whose scaling constants are in "TAU".
32 * We shall use the letter "V" to refer to the product of Householder
33 * transformations (which should be equal to U).
34 *
35 * Specifically, if ITYPE=1, then:
36 *
37 * RESULT(1) = | A - U S U* | / ( |A| n ulp ) *and*
38 * RESULT(2) = | I - UU* | / ( n ulp )
39 *
40 * If ITYPE=2, then:
41 *
42 * RESULT(1) = | A - V S V* | / ( |A| n ulp )
43 *
44 * If ITYPE=3, then:
45 *
46 * RESULT(1) = | I - UV* | / ( n ulp )
47 *
48 * For ITYPE > 1, the transformation U is expressed as a product
49 * V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)* and each
50 * vector v(j) has its first j elements 0 and the remaining n-j elements
51 * stored in V(j+1:n,j).
52 *
53 * Arguments
54 * =========
55 *
56 * ITYPE (input) INTEGER
57 * Specifies the type of tests to be performed.
58 * 1: U expressed as a dense unitary matrix:
59 * RESULT(1) = | A - U S U* | / ( |A| n ulp ) *and*
60 * RESULT(2) = | I - UU* | / ( n ulp )
61 *
62 * 2: U expressed as a product V of Housholder transformations:
63 * RESULT(1) = | A - V S V* | / ( |A| n ulp )
64 *
65 * 3: U expressed both as a dense unitary matrix and
66 * as a product of Housholder transformations:
67 * RESULT(1) = | I - UV* | / ( n ulp )
68 *
69 * UPLO (input) CHARACTER
70 * If UPLO='U', the upper triangle of A and V will be used and
71 * the (strictly) lower triangle will not be referenced.
72 * If UPLO='L', the lower triangle of A and V will be used and
73 * the (strictly) upper triangle will not be referenced.
74 *
75 * N (input) INTEGER
76 * The size of the matrix. If it is zero, ZHET21 does nothing.
77 * It must be at least zero.
78 *
79 * KBAND (input) INTEGER
80 * The bandwidth of the matrix. It may only be zero or one.
81 * If zero, then S is diagonal, and E is not referenced. If
82 * one, then S is symmetric tri-diagonal.
83 *
84 * A (input) COMPLEX*16 array, dimension (LDA, N)
85 * The original (unfactored) matrix. It is assumed to be
86 * hermitian, and only the upper (UPLO='U') or only the lower
87 * (UPLO='L') will be referenced.
88 *
89 * LDA (input) INTEGER
90 * The leading dimension of A. It must be at least 1
91 * and at least N.
92 *
93 * D (input) DOUBLE PRECISION array, dimension (N)
94 * The diagonal of the (symmetric tri-) diagonal matrix.
95 *
96 * E (input) DOUBLE PRECISION array, dimension (N-1)
97 * The off-diagonal of the (symmetric tri-) diagonal matrix.
98 * E(1) is the (1,2) and (2,1) element, E(2) is the (2,3) and
99 * (3,2) element, etc.
100 * Not referenced if KBAND=0.
101 *
102 * U (input) COMPLEX*16 array, dimension (LDU, N)
103 * If ITYPE=1 or 3, this contains the unitary matrix in
104 * the decomposition, expressed as a dense matrix. If ITYPE=2,
105 * then it is not referenced.
106 *
107 * LDU (input) INTEGER
108 * The leading dimension of U. LDU must be at least N and
109 * at least 1.
110 *
111 * V (input) COMPLEX*16 array, dimension (LDV, N)
112 * If ITYPE=2 or 3, the columns of this array contain the
113 * Householder vectors used to describe the unitary matrix
114 * in the decomposition. If UPLO='L', then the vectors are in
115 * the lower triangle, if UPLO='U', then in the upper
116 * triangle.
117 * *NOTE* If ITYPE=2 or 3, V is modified and restored. The
118 * subdiagonal (if UPLO='L') or the superdiagonal (if UPLO='U')
119 * is set to one, and later reset to its original value, during
120 * the course of the calculation.
121 * If ITYPE=1, then it is neither referenced nor modified.
122 *
123 * LDV (input) INTEGER
124 * The leading dimension of V. LDV must be at least N and
125 * at least 1.
126 *
127 * TAU (input) COMPLEX*16 array, dimension (N)
128 * If ITYPE >= 2, then TAU(j) is the scalar factor of
129 * v(j) v(j)* in the Householder transformation H(j) of
130 * the product U = H(1)...H(n-2)
131 * If ITYPE < 2, then TAU is not referenced.
132 *
133 * WORK (workspace) COMPLEX*16 array, dimension (2*N**2)
134 *
135 * RWORK (workspace) DOUBLE PRECISION array, dimension (N)
136 *
137 * RESULT (output) DOUBLE PRECISION array, dimension (2)
138 * The values computed by the two tests described above. The
139 * values are currently limited to 1/ulp, to avoid overflow.
140 * RESULT(1) is always modified. RESULT(2) is modified only
141 * if ITYPE=1.
142 *
143 * =====================================================================
144 *
145 * .. Parameters ..
146 DOUBLE PRECISION ZERO, ONE, TEN
147 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TEN = 10.0D+0 )
148 COMPLEX*16 CZERO, CONE
149 PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ),
150 $ CONE = ( 1.0D+0, 0.0D+0 ) )
151 * ..
152 * .. Local Scalars ..
153 LOGICAL LOWER
154 CHARACTER CUPLO
155 INTEGER IINFO, J, JCOL, JR, JROW
156 DOUBLE PRECISION ANORM, ULP, UNFL, WNORM
157 COMPLEX*16 VSAVE
158 * ..
159 * .. External Functions ..
160 LOGICAL LSAME
161 DOUBLE PRECISION DLAMCH, ZLANGE, ZLANHE
162 EXTERNAL LSAME, DLAMCH, ZLANGE, ZLANHE
163 * ..
164 * .. External Subroutines ..
165 EXTERNAL ZGEMM, ZHER, ZHER2, ZLACPY, ZLARFY, ZLASET,
166 $ ZUNM2L, ZUNM2R
167 * ..
168 * .. Intrinsic Functions ..
169 INTRINSIC DBLE, DCMPLX, MAX, MIN
170 * ..
171 * .. Executable Statements ..
172 *
173 RESULT( 1 ) = ZERO
174 IF( ITYPE.EQ.1 )
175 $ RESULT( 2 ) = ZERO
176 IF( N.LE.0 )
177 $ RETURN
178 *
179 IF( LSAME( UPLO, 'U' ) ) THEN
180 LOWER = .FALSE.
181 CUPLO = 'U'
182 ELSE
183 LOWER = .TRUE.
184 CUPLO = 'L'
185 END IF
186 *
187 UNFL = DLAMCH( 'Safe minimum' )
188 ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
189 *
190 * Some Error Checks
191 *
192 IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
193 RESULT( 1 ) = TEN / ULP
194 RETURN
195 END IF
196 *
197 * Do Test 1
198 *
199 * Norm of A:
200 *
201 IF( ITYPE.EQ.3 ) THEN
202 ANORM = ONE
203 ELSE
204 ANORM = MAX( ZLANHE( '1', CUPLO, N, A, LDA, RWORK ), UNFL )
205 END IF
206 *
207 * Compute error matrix:
208 *
209 IF( ITYPE.EQ.1 ) THEN
210 *
211 * ITYPE=1: error = A - U S U*
212 *
213 CALL ZLASET( 'Full', N, N, CZERO, CZERO, WORK, N )
214 CALL ZLACPY( CUPLO, N, N, A, LDA, WORK, N )
215 *
216 DO 10 J = 1, N
217 CALL ZHER( CUPLO, N, -D( J ), U( 1, J ), 1, WORK, N )
218 10 CONTINUE
219 *
220 IF( N.GT.1 .AND. KBAND.EQ.1 ) THEN
221 DO 20 J = 1, N - 1
222 CALL ZHER2( CUPLO, N, -DCMPLX( E( J ) ), U( 1, J ), 1,
223 $ U( 1, J-1 ), 1, WORK, N )
224 20 CONTINUE
225 END IF
226 WNORM = ZLANHE( '1', CUPLO, N, WORK, N, RWORK )
227 *
228 ELSE IF( ITYPE.EQ.2 ) THEN
229 *
230 * ITYPE=2: error = V S V* - A
231 *
232 CALL ZLASET( 'Full', N, N, CZERO, CZERO, WORK, N )
233 *
234 IF( LOWER ) THEN
235 WORK( N**2 ) = D( N )
236 DO 40 J = N - 1, 1, -1
237 IF( KBAND.EQ.1 ) THEN
238 WORK( ( N+1 )*( J-1 )+2 ) = ( CONE-TAU( J ) )*E( J )
239 DO 30 JR = J + 2, N
240 WORK( ( J-1 )*N+JR ) = -TAU( J )*E( J )*V( JR, J )
241 30 CONTINUE
242 END IF
243 *
244 VSAVE = V( J+1, J )
245 V( J+1, J ) = ONE
246 CALL ZLARFY( 'L', N-J, V( J+1, J ), 1, TAU( J ),
247 $ WORK( ( N+1 )*J+1 ), N, WORK( N**2+1 ) )
248 V( J+1, J ) = VSAVE
249 WORK( ( N+1 )*( J-1 )+1 ) = D( J )
250 40 CONTINUE
251 ELSE
252 WORK( 1 ) = D( 1 )
253 DO 60 J = 1, N - 1
254 IF( KBAND.EQ.1 ) THEN
255 WORK( ( N+1 )*J ) = ( CONE-TAU( J ) )*E( J )
256 DO 50 JR = 1, J - 1
257 WORK( J*N+JR ) = -TAU( J )*E( J )*V( JR, J+1 )
258 50 CONTINUE
259 END IF
260 *
261 VSAVE = V( J, J+1 )
262 V( J, J+1 ) = ONE
263 CALL ZLARFY( 'U', J, V( 1, J+1 ), 1, TAU( J ), WORK, N,
264 $ WORK( N**2+1 ) )
265 V( J, J+1 ) = VSAVE
266 WORK( ( N+1 )*J+1 ) = D( J+1 )
267 60 CONTINUE
268 END IF
269 *
270 DO 90 JCOL = 1, N
271 IF( LOWER ) THEN
272 DO 70 JROW = JCOL, N
273 WORK( JROW+N*( JCOL-1 ) ) = WORK( JROW+N*( JCOL-1 ) )
274 $ - A( JROW, JCOL )
275 70 CONTINUE
276 ELSE
277 DO 80 JROW = 1, JCOL
278 WORK( JROW+N*( JCOL-1 ) ) = WORK( JROW+N*( JCOL-1 ) )
279 $ - A( JROW, JCOL )
280 80 CONTINUE
281 END IF
282 90 CONTINUE
283 WNORM = ZLANHE( '1', CUPLO, N, WORK, N, RWORK )
284 *
285 ELSE IF( ITYPE.EQ.3 ) THEN
286 *
287 * ITYPE=3: error = U V* - I
288 *
289 IF( N.LT.2 )
290 $ RETURN
291 CALL ZLACPY( ' ', N, N, U, LDU, WORK, N )
292 IF( LOWER ) THEN
293 CALL ZUNM2R( 'R', 'C', N, N-1, N-1, V( 2, 1 ), LDV, TAU,
294 $ WORK( N+1 ), N, WORK( N**2+1 ), IINFO )
295 ELSE
296 CALL ZUNM2L( 'R', 'C', N, N-1, N-1, V( 1, 2 ), LDV, TAU,
297 $ WORK, N, WORK( N**2+1 ), IINFO )
298 END IF
299 IF( IINFO.NE.0 ) THEN
300 RESULT( 1 ) = TEN / ULP
301 RETURN
302 END IF
303 *
304 DO 100 J = 1, N
305 WORK( ( N+1 )*( J-1 )+1 ) = WORK( ( N+1 )*( J-1 )+1 ) - CONE
306 100 CONTINUE
307 *
308 WNORM = ZLANGE( '1', N, N, WORK, N, RWORK )
309 END IF
310 *
311 IF( ANORM.GT.WNORM ) THEN
312 RESULT( 1 ) = ( WNORM / ANORM ) / ( N*ULP )
313 ELSE
314 IF( ANORM.LT.ONE ) THEN
315 RESULT( 1 ) = ( MIN( WNORM, N*ANORM ) / ANORM ) / ( N*ULP )
316 ELSE
317 RESULT( 1 ) = MIN( WNORM / ANORM, DBLE( N ) ) / ( N*ULP )
318 END IF
319 END IF
320 *
321 * Do Test 2
322 *
323 * Compute UU* - I
324 *
325 IF( ITYPE.EQ.1 ) THEN
326 CALL ZGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO,
327 $ WORK, N )
328 *
329 DO 110 J = 1, N
330 WORK( ( N+1 )*( J-1 )+1 ) = WORK( ( N+1 )*( J-1 )+1 ) - CONE
331 110 CONTINUE
332 *
333 RESULT( 2 ) = MIN( ZLANGE( '1', N, N, WORK, N, RWORK ),
334 $ DBLE( N ) ) / ( N*ULP )
335 END IF
336 *
337 RETURN
338 *
339 * End of ZHET21
340 *
341 END
2 $ LDV, TAU, WORK, RWORK, RESULT )
3 *
4 * -- LAPACK test routine (version 3.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 CHARACTER UPLO
10 INTEGER ITYPE, KBAND, LDA, LDU, LDV, N
11 * ..
12 * .. Array Arguments ..
13 DOUBLE PRECISION D( * ), E( * ), RESULT( 2 ), RWORK( * )
14 COMPLEX*16 A( LDA, * ), TAU( * ), U( LDU, * ),
15 $ V( LDV, * ), WORK( * )
16 * ..
17 *
18 * Purpose
19 * =======
20 *
21 * ZHET21 generally checks a decomposition of the form
22 *
23 * A = U S U*
24 *
25 * where * means conjugate transpose, A is hermitian, U is unitary, and
26 * S is diagonal (if KBAND=0) or (real) symmetric tridiagonal (if
27 * KBAND=1).
28 *
29 * If ITYPE=1, then U is represented as a dense matrix; otherwise U is
30 * expressed as a product of Householder transformations, whose vectors
31 * are stored in the array "V" and whose scaling constants are in "TAU".
32 * We shall use the letter "V" to refer to the product of Householder
33 * transformations (which should be equal to U).
34 *
35 * Specifically, if ITYPE=1, then:
36 *
37 * RESULT(1) = | A - U S U* | / ( |A| n ulp ) *and*
38 * RESULT(2) = | I - UU* | / ( n ulp )
39 *
40 * If ITYPE=2, then:
41 *
42 * RESULT(1) = | A - V S V* | / ( |A| n ulp )
43 *
44 * If ITYPE=3, then:
45 *
46 * RESULT(1) = | I - UV* | / ( n ulp )
47 *
48 * For ITYPE > 1, the transformation U is expressed as a product
49 * V = H(1)...H(n-2), where H(j) = I - tau(j) v(j) v(j)* and each
50 * vector v(j) has its first j elements 0 and the remaining n-j elements
51 * stored in V(j+1:n,j).
52 *
53 * Arguments
54 * =========
55 *
56 * ITYPE (input) INTEGER
57 * Specifies the type of tests to be performed.
58 * 1: U expressed as a dense unitary matrix:
59 * RESULT(1) = | A - U S U* | / ( |A| n ulp ) *and*
60 * RESULT(2) = | I - UU* | / ( n ulp )
61 *
62 * 2: U expressed as a product V of Housholder transformations:
63 * RESULT(1) = | A - V S V* | / ( |A| n ulp )
64 *
65 * 3: U expressed both as a dense unitary matrix and
66 * as a product of Housholder transformations:
67 * RESULT(1) = | I - UV* | / ( n ulp )
68 *
69 * UPLO (input) CHARACTER
70 * If UPLO='U', the upper triangle of A and V will be used and
71 * the (strictly) lower triangle will not be referenced.
72 * If UPLO='L', the lower triangle of A and V will be used and
73 * the (strictly) upper triangle will not be referenced.
74 *
75 * N (input) INTEGER
76 * The size of the matrix. If it is zero, ZHET21 does nothing.
77 * It must be at least zero.
78 *
79 * KBAND (input) INTEGER
80 * The bandwidth of the matrix. It may only be zero or one.
81 * If zero, then S is diagonal, and E is not referenced. If
82 * one, then S is symmetric tri-diagonal.
83 *
84 * A (input) COMPLEX*16 array, dimension (LDA, N)
85 * The original (unfactored) matrix. It is assumed to be
86 * hermitian, and only the upper (UPLO='U') or only the lower
87 * (UPLO='L') will be referenced.
88 *
89 * LDA (input) INTEGER
90 * The leading dimension of A. It must be at least 1
91 * and at least N.
92 *
93 * D (input) DOUBLE PRECISION array, dimension (N)
94 * The diagonal of the (symmetric tri-) diagonal matrix.
95 *
96 * E (input) DOUBLE PRECISION array, dimension (N-1)
97 * The off-diagonal of the (symmetric tri-) diagonal matrix.
98 * E(1) is the (1,2) and (2,1) element, E(2) is the (2,3) and
99 * (3,2) element, etc.
100 * Not referenced if KBAND=0.
101 *
102 * U (input) COMPLEX*16 array, dimension (LDU, N)
103 * If ITYPE=1 or 3, this contains the unitary matrix in
104 * the decomposition, expressed as a dense matrix. If ITYPE=2,
105 * then it is not referenced.
106 *
107 * LDU (input) INTEGER
108 * The leading dimension of U. LDU must be at least N and
109 * at least 1.
110 *
111 * V (input) COMPLEX*16 array, dimension (LDV, N)
112 * If ITYPE=2 or 3, the columns of this array contain the
113 * Householder vectors used to describe the unitary matrix
114 * in the decomposition. If UPLO='L', then the vectors are in
115 * the lower triangle, if UPLO='U', then in the upper
116 * triangle.
117 * *NOTE* If ITYPE=2 or 3, V is modified and restored. The
118 * subdiagonal (if UPLO='L') or the superdiagonal (if UPLO='U')
119 * is set to one, and later reset to its original value, during
120 * the course of the calculation.
121 * If ITYPE=1, then it is neither referenced nor modified.
122 *
123 * LDV (input) INTEGER
124 * The leading dimension of V. LDV must be at least N and
125 * at least 1.
126 *
127 * TAU (input) COMPLEX*16 array, dimension (N)
128 * If ITYPE >= 2, then TAU(j) is the scalar factor of
129 * v(j) v(j)* in the Householder transformation H(j) of
130 * the product U = H(1)...H(n-2)
131 * If ITYPE < 2, then TAU is not referenced.
132 *
133 * WORK (workspace) COMPLEX*16 array, dimension (2*N**2)
134 *
135 * RWORK (workspace) DOUBLE PRECISION array, dimension (N)
136 *
137 * RESULT (output) DOUBLE PRECISION array, dimension (2)
138 * The values computed by the two tests described above. The
139 * values are currently limited to 1/ulp, to avoid overflow.
140 * RESULT(1) is always modified. RESULT(2) is modified only
141 * if ITYPE=1.
142 *
143 * =====================================================================
144 *
145 * .. Parameters ..
146 DOUBLE PRECISION ZERO, ONE, TEN
147 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TEN = 10.0D+0 )
148 COMPLEX*16 CZERO, CONE
149 PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ),
150 $ CONE = ( 1.0D+0, 0.0D+0 ) )
151 * ..
152 * .. Local Scalars ..
153 LOGICAL LOWER
154 CHARACTER CUPLO
155 INTEGER IINFO, J, JCOL, JR, JROW
156 DOUBLE PRECISION ANORM, ULP, UNFL, WNORM
157 COMPLEX*16 VSAVE
158 * ..
159 * .. External Functions ..
160 LOGICAL LSAME
161 DOUBLE PRECISION DLAMCH, ZLANGE, ZLANHE
162 EXTERNAL LSAME, DLAMCH, ZLANGE, ZLANHE
163 * ..
164 * .. External Subroutines ..
165 EXTERNAL ZGEMM, ZHER, ZHER2, ZLACPY, ZLARFY, ZLASET,
166 $ ZUNM2L, ZUNM2R
167 * ..
168 * .. Intrinsic Functions ..
169 INTRINSIC DBLE, DCMPLX, MAX, MIN
170 * ..
171 * .. Executable Statements ..
172 *
173 RESULT( 1 ) = ZERO
174 IF( ITYPE.EQ.1 )
175 $ RESULT( 2 ) = ZERO
176 IF( N.LE.0 )
177 $ RETURN
178 *
179 IF( LSAME( UPLO, 'U' ) ) THEN
180 LOWER = .FALSE.
181 CUPLO = 'U'
182 ELSE
183 LOWER = .TRUE.
184 CUPLO = 'L'
185 END IF
186 *
187 UNFL = DLAMCH( 'Safe minimum' )
188 ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
189 *
190 * Some Error Checks
191 *
192 IF( ITYPE.LT.1 .OR. ITYPE.GT.3 ) THEN
193 RESULT( 1 ) = TEN / ULP
194 RETURN
195 END IF
196 *
197 * Do Test 1
198 *
199 * Norm of A:
200 *
201 IF( ITYPE.EQ.3 ) THEN
202 ANORM = ONE
203 ELSE
204 ANORM = MAX( ZLANHE( '1', CUPLO, N, A, LDA, RWORK ), UNFL )
205 END IF
206 *
207 * Compute error matrix:
208 *
209 IF( ITYPE.EQ.1 ) THEN
210 *
211 * ITYPE=1: error = A - U S U*
212 *
213 CALL ZLASET( 'Full', N, N, CZERO, CZERO, WORK, N )
214 CALL ZLACPY( CUPLO, N, N, A, LDA, WORK, N )
215 *
216 DO 10 J = 1, N
217 CALL ZHER( CUPLO, N, -D( J ), U( 1, J ), 1, WORK, N )
218 10 CONTINUE
219 *
220 IF( N.GT.1 .AND. KBAND.EQ.1 ) THEN
221 DO 20 J = 1, N - 1
222 CALL ZHER2( CUPLO, N, -DCMPLX( E( J ) ), U( 1, J ), 1,
223 $ U( 1, J-1 ), 1, WORK, N )
224 20 CONTINUE
225 END IF
226 WNORM = ZLANHE( '1', CUPLO, N, WORK, N, RWORK )
227 *
228 ELSE IF( ITYPE.EQ.2 ) THEN
229 *
230 * ITYPE=2: error = V S V* - A
231 *
232 CALL ZLASET( 'Full', N, N, CZERO, CZERO, WORK, N )
233 *
234 IF( LOWER ) THEN
235 WORK( N**2 ) = D( N )
236 DO 40 J = N - 1, 1, -1
237 IF( KBAND.EQ.1 ) THEN
238 WORK( ( N+1 )*( J-1 )+2 ) = ( CONE-TAU( J ) )*E( J )
239 DO 30 JR = J + 2, N
240 WORK( ( J-1 )*N+JR ) = -TAU( J )*E( J )*V( JR, J )
241 30 CONTINUE
242 END IF
243 *
244 VSAVE = V( J+1, J )
245 V( J+1, J ) = ONE
246 CALL ZLARFY( 'L', N-J, V( J+1, J ), 1, TAU( J ),
247 $ WORK( ( N+1 )*J+1 ), N, WORK( N**2+1 ) )
248 V( J+1, J ) = VSAVE
249 WORK( ( N+1 )*( J-1 )+1 ) = D( J )
250 40 CONTINUE
251 ELSE
252 WORK( 1 ) = D( 1 )
253 DO 60 J = 1, N - 1
254 IF( KBAND.EQ.1 ) THEN
255 WORK( ( N+1 )*J ) = ( CONE-TAU( J ) )*E( J )
256 DO 50 JR = 1, J - 1
257 WORK( J*N+JR ) = -TAU( J )*E( J )*V( JR, J+1 )
258 50 CONTINUE
259 END IF
260 *
261 VSAVE = V( J, J+1 )
262 V( J, J+1 ) = ONE
263 CALL ZLARFY( 'U', J, V( 1, J+1 ), 1, TAU( J ), WORK, N,
264 $ WORK( N**2+1 ) )
265 V( J, J+1 ) = VSAVE
266 WORK( ( N+1 )*J+1 ) = D( J+1 )
267 60 CONTINUE
268 END IF
269 *
270 DO 90 JCOL = 1, N
271 IF( LOWER ) THEN
272 DO 70 JROW = JCOL, N
273 WORK( JROW+N*( JCOL-1 ) ) = WORK( JROW+N*( JCOL-1 ) )
274 $ - A( JROW, JCOL )
275 70 CONTINUE
276 ELSE
277 DO 80 JROW = 1, JCOL
278 WORK( JROW+N*( JCOL-1 ) ) = WORK( JROW+N*( JCOL-1 ) )
279 $ - A( JROW, JCOL )
280 80 CONTINUE
281 END IF
282 90 CONTINUE
283 WNORM = ZLANHE( '1', CUPLO, N, WORK, N, RWORK )
284 *
285 ELSE IF( ITYPE.EQ.3 ) THEN
286 *
287 * ITYPE=3: error = U V* - I
288 *
289 IF( N.LT.2 )
290 $ RETURN
291 CALL ZLACPY( ' ', N, N, U, LDU, WORK, N )
292 IF( LOWER ) THEN
293 CALL ZUNM2R( 'R', 'C', N, N-1, N-1, V( 2, 1 ), LDV, TAU,
294 $ WORK( N+1 ), N, WORK( N**2+1 ), IINFO )
295 ELSE
296 CALL ZUNM2L( 'R', 'C', N, N-1, N-1, V( 1, 2 ), LDV, TAU,
297 $ WORK, N, WORK( N**2+1 ), IINFO )
298 END IF
299 IF( IINFO.NE.0 ) THEN
300 RESULT( 1 ) = TEN / ULP
301 RETURN
302 END IF
303 *
304 DO 100 J = 1, N
305 WORK( ( N+1 )*( J-1 )+1 ) = WORK( ( N+1 )*( J-1 )+1 ) - CONE
306 100 CONTINUE
307 *
308 WNORM = ZLANGE( '1', N, N, WORK, N, RWORK )
309 END IF
310 *
311 IF( ANORM.GT.WNORM ) THEN
312 RESULT( 1 ) = ( WNORM / ANORM ) / ( N*ULP )
313 ELSE
314 IF( ANORM.LT.ONE ) THEN
315 RESULT( 1 ) = ( MIN( WNORM, N*ANORM ) / ANORM ) / ( N*ULP )
316 ELSE
317 RESULT( 1 ) = MIN( WNORM / ANORM, DBLE( N ) ) / ( N*ULP )
318 END IF
319 END IF
320 *
321 * Do Test 2
322 *
323 * Compute UU* - I
324 *
325 IF( ITYPE.EQ.1 ) THEN
326 CALL ZGEMM( 'N', 'C', N, N, N, CONE, U, LDU, U, LDU, CZERO,
327 $ WORK, N )
328 *
329 DO 110 J = 1, N
330 WORK( ( N+1 )*( J-1 )+1 ) = WORK( ( N+1 )*( J-1 )+1 ) - CONE
331 110 CONTINUE
332 *
333 RESULT( 2 ) = MIN( ZLANGE( '1', N, N, WORK, N, RWORK ),
334 $ DBLE( N ) ) / ( N*ULP )
335 END IF
336 *
337 RETURN
338 *
339 * End of ZHET21
340 *
341 END