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
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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine dscal(N, DA, DX, INCX)
DSCAL
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
double precision function dlamch(CMACH)
DLAMCH
double precision function dlansy(NORM, UPLO, N, A, LDA, WORK)
DLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix.