146 SUBROUTINE dsgt01( ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D,
156 INTEGER ITYPE, LDA, LDB, LDZ, M, N
159 DOUBLE PRECISION A( lda, * ), B( ldb, * ), D( * ), RESULT( * ),
160 $ work( * ), z( ldz, * )
166 DOUBLE PRECISION ZERO, ONE
167 parameter( zero = 0.0d0, one = 1.0d0 )
171 DOUBLE PRECISION ANORM, ULP
174 DOUBLE PRECISION DLAMCH, DLANGE, DLANSY
175 EXTERNAL dlamch, dlange, dlansy
186 ulp = dlamch(
'Epsilon' )
190 anorm = dlansy(
'1', uplo, n, a, lda, work )*
191 $ dlange(
'1', n, m, z, ldz, work )
195 IF( itype.EQ.1 )
THEN
199 CALL
dsymm(
'Left', uplo, n, m, one, a, lda, z, ldz, zero,
202 CALL
dscal( n, d( i ), z( 1, i ), 1 )
204 CALL
dsymm(
'Left', uplo, n, m, one, b, ldb, z, ldz, -one,
207 result( 1 ) = ( dlange(
'1', n, m, work, n, work ) / anorm ) /
210 ELSE IF( itype.EQ.2 )
THEN
214 CALL
dsymm(
'Left', uplo, n, m, one, b, ldb, z, ldz, zero,
217 CALL
dscal( n, d( i ), z( 1, i ), 1 )
219 CALL
dsymm(
'Left', uplo, n, m, one, a, lda, work, n, -one, z,
222 result( 1 ) = ( dlange(
'1', n, m, z, ldz, work ) / anorm ) /
225 ELSE IF( itype.EQ.3 )
THEN
229 CALL
dsymm(
'Left', uplo, n, m, one, a, lda, z, ldz, zero,
232 CALL
dscal( n, d( i ), z( 1, i ), 1 )
234 CALL
dsymm(
'Left', uplo, n, m, one, b, ldb, work, n, -one, z,
237 result( 1 ) = ( dlange(
'1', n, m, z, ldz, work ) / anorm ) /
subroutine dsgt01(ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D, WORK, RESULT)
DSGT01
subroutine dsymm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DSYMM
subroutine dscal(N, DA, DX, INCX)
DSCAL