152 SUBROUTINE csgt01( ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D,
153 $ work, rwork, result )
162 INTEGER ITYPE, LDA, LDB, LDZ, M, N
165 REAL D( * ), RESULT( * ), RWORK( * )
166 COMPLEX A( lda, * ), B( ldb, * ), WORK( * ),
174 parameter( zero = 0.0e+0, one = 1.0e+0 )
176 parameter( czero = ( 0.0e+0, 0.0e+0 ),
177 $ cone = ( 1.0e+0, 0.0e+0 ) )
184 REAL CLANGE, CLANHE, SLAMCH
185 EXTERNAL clange, clanhe, slamch
196 ulp = slamch(
'Epsilon' )
200 anorm = clanhe(
'1', uplo, n, a, lda, rwork )*
201 $ clange(
'1', n, m, z, ldz, rwork )
205 IF( itype.EQ.1 )
THEN
209 CALL
chemm(
'Left', uplo, n, m, cone, a, lda, z, ldz, czero,
212 CALL
csscal( n, d( i ), z( 1, i ), 1 )
214 CALL
chemm(
'Left', uplo, n, m, cone, b, ldb, z, ldz, -cone,
217 result( 1 ) = ( clange(
'1', n, m, work, n, rwork ) / anorm ) /
220 ELSE IF( itype.EQ.2 )
THEN
224 CALL
chemm(
'Left', uplo, n, m, cone, b, ldb, z, ldz, czero,
227 CALL
csscal( n, d( i ), z( 1, i ), 1 )
229 CALL
chemm(
'Left', uplo, n, m, cone, a, lda, work, n, -cone,
232 result( 1 ) = ( clange(
'1', n, m, z, ldz, rwork ) / anorm ) /
235 ELSE IF( itype.EQ.3 )
THEN
239 CALL
chemm(
'Left', uplo, n, m, cone, a, lda, z, ldz, czero,
242 CALL
csscal( n, d( i ), z( 1, i ), 1 )
244 CALL
chemm(
'Left', uplo, n, m, cone, b, ldb, work, n, -cone,
247 result( 1 ) = ( clange(
'1', n, m, z, ldz, rwork ) / anorm ) /
subroutine csgt01(ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D, WORK, RWORK, RESULT)
CSGT01
subroutine csscal(N, SA, CX, INCX)
CSSCAL
subroutine chemm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CHEMM