152 SUBROUTINE zsgt01( ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D,
153 $ work, rwork, result )
162 INTEGER ITYPE, LDA, LDB, LDZ, M, N
165 DOUBLE PRECISION D( * ), RESULT( * ), RWORK( * )
166 COMPLEX*16 A( lda, * ), B( ldb, * ), WORK( * ),
173 DOUBLE PRECISION ZERO, ONE
174 parameter( zero = 0.0d+0, one = 1.0d+0 )
175 COMPLEX*16 CZERO, CONE
176 parameter( czero = ( 0.0d+0, 0.0d+0 ),
177 $ cone = ( 1.0d+0, 0.0d+0 ) )
181 DOUBLE PRECISION ANORM, ULP
184 DOUBLE PRECISION DLAMCH, ZLANGE, ZLANHE
185 EXTERNAL dlamch, zlange, zlanhe
196 ulp = dlamch(
'Epsilon' )
200 anorm = zlanhe(
'1', uplo, n, a, lda, rwork )*
201 $ zlange(
'1', n, m, z, ldz, rwork )
205 IF( itype.EQ.1 )
THEN
209 CALL
zhemm(
'Left', uplo, n, m, cone, a, lda, z, ldz, czero,
212 CALL
zdscal( n, d( i ), z( 1, i ), 1 )
214 CALL
zhemm(
'Left', uplo, n, m, cone, b, ldb, z, ldz, -cone,
217 result( 1 ) = ( zlange(
'1', n, m, work, n, rwork ) / anorm ) /
220 ELSE IF( itype.EQ.2 )
THEN
224 CALL
zhemm(
'Left', uplo, n, m, cone, b, ldb, z, ldz, czero,
227 CALL
zdscal( n, d( i ), z( 1, i ), 1 )
229 CALL
zhemm(
'Left', uplo, n, m, cone, a, lda, work, n, -cone,
232 result( 1 ) = ( zlange(
'1', n, m, z, ldz, rwork ) / anorm ) /
235 ELSE IF( itype.EQ.3 )
THEN
239 CALL
zhemm(
'Left', uplo, n, m, cone, a, lda, z, ldz, czero,
242 CALL
zdscal( n, d( i ), z( 1, i ), 1 )
244 CALL
zhemm(
'Left', uplo, n, m, cone, b, ldb, work, n, -cone,
247 result( 1 ) = ( zlange(
'1', n, m, z, ldz, rwork ) / anorm ) /
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zsgt01(ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D, WORK, RWORK, RESULT)
ZSGT01
subroutine zhemm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZHEMM