154 SUBROUTINE zget51( ITYPE, N, A, LDA, B, LDB, U, LDU, V, LDV, WORK,
163 INTEGER itype, lda, ldb, ldu, ldv, n
164 DOUBLE PRECISION result
167 DOUBLE PRECISION rwork( * )
168 COMPLEX*16 a( lda, * ), b( ldb, * ), u( ldu, * ),
169 $ v( ldv, * ), work( * )
175 DOUBLE PRECISION zero, one, ten
176 parameter( zero = 0.0d+0, one = 1.0d+0, ten = 10.0d+0 )
177 COMPLEX*16 czero, cone
178 parameter( czero = ( 0.0d+0, 0.0d+0 ),
179 $ cone = ( 1.0d+0, 0.0d+0 ) )
182 INTEGER jcol, jdiag, jrow
183 DOUBLE PRECISION anorm, ulp, unfl, wnorm
193 INTRINSIC dble, max, min
203 unfl =
dlamch(
'Safe minimum' )
208 IF( itype.LT.1 .OR. itype.GT.3 )
THEN
213 IF( itype.LE.2 )
THEN
217 anorm = max(
zlange(
'1', n, n, a, lda, rwork ), unfl )
219 IF( itype.EQ.1 )
THEN
223 CALL
zlacpy(
' ', n, n, a, lda, work, n )
224 CALL
zgemm(
'N',
'N', n, n, n, cone, u, ldu, b, ldb, czero,
225 $ work( n**2+1 ), n )
227 CALL
zgemm(
'N',
'C', n, n, n, -cone, work( n**2+1 ), n, v,
228 $ ldv, cone, work, n )
234 CALL
zlacpy(
' ', n, n, b, ldb, work, n )
238 work( jrow+n*( jcol-1 ) ) = work( jrow+n*( jcol-1 ) )
246 wnorm =
zlange(
'1', n, n, work, n, rwork )
248 IF( anorm.GT.wnorm )
THEN
249 result = ( wnorm / anorm ) / ( n*ulp )
251 IF( anorm.LT.one )
THEN
252 result = ( min( wnorm, n*anorm ) / anorm ) / ( n*ulp )
254 result = min( wnorm / anorm, dble( n ) ) / ( n*ulp )
264 CALL
zgemm(
'N',
'C', n, n, n, cone, u, ldu, u, ldu, czero,
268 work( ( n+1 )*( jdiag-1 )+1 ) = work( ( n+1 )*( jdiag-1 )+
272 result = min(
zlange(
'1', n, n, work, n, rwork ),
273 $ dble( n ) ) / ( n*ulp )