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 ) )
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 ) /
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
real function clanhe(NORM, UPLO, N, A, LDA, WORK)
CLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine csgt01(ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D, WORK, RWORK, RESULT)
CSGT01
real function slamch(CMACH)
SLAMCH
subroutine csscal(N, SA, CX, INCX)
CSSCAL
subroutine chemm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CHEMM