154 SUBROUTINE zget51( ITYPE, N, A, LDA, B, LDB, U, LDU, V, LDV, WORK,
163 INTEGER itype, lda, ldb, ldu, ldv, n
164 DOUBLE PRECISION result
167 DOUBLE PRECISION rwork( * )
168 COMPLEX*16 a( lda, * ),
b( ldb, * ), u( ldu, * ),
169 $ v( ldv, * ), work( * )
175 DOUBLE PRECISION zero, one, ten
176 parameter( zero = 0.0d+0, one = 1.0d+0, ten = 10.0d+0 )
177 COMPLEX*16 czero, cone
178 parameter( czero = ( 0.0d+0, 0.0d+0 ),
179 $ cone = ( 1.0d+0, 0.0d+0 ) )
182 INTEGER jcol, jdiag, jrow
183 DOUBLE PRECISION anorm, ulp, unfl, wnorm
193 INTRINSIC dble, max, min
203 unfl =
dlamch(
'Safe minimum' )
208 IF( itype.LT.1 .OR. itype.GT.3 )
THEN
213 IF( itype.LE.2 )
THEN
217 anorm = max(
zlange(
'1', n, n, a, lda, rwork ), unfl )
219 IF( itype.EQ.1 )
THEN
223 CALL
zlacpy(
' ', n, n, a, lda, work, n )
224 CALL
zgemm(
'N',
'N', n, n, n, cone, u, ldu,
b, ldb, czero,
225 $ work( n**2+1 ), n )
227 CALL
zgemm(
'N',
'C', n, n, n, -cone, work( n**2+1 ), n, v,
228 $ ldv, cone, work, n )
234 CALL
zlacpy(
' ', n, n,
b, ldb, work, n )
238 work( jrow+n*( jcol-1 ) ) = work( jrow+n*( jcol-1 ) )
246 wnorm =
zlange(
'1', n, n, work, n, rwork )
248 IF( anorm.GT.wnorm )
THEN
249 result = ( wnorm / anorm ) / ( n*ulp )
251 IF( anorm.LT.one )
THEN
252 result = ( min( wnorm, n*anorm ) / anorm ) / ( n*ulp )
254 result = min( wnorm / anorm, dble( n ) ) / ( n*ulp )
264 CALL
zgemm(
'N',
'C', n, n, n, cone, u, ldu, u, ldu, czero,
268 work( ( n+1 )*( jdiag-1 )+1 ) = work( ( n+1 )*( jdiag-1 )+
272 result = min(
zlange(
'1', n, n, work, n, rwork ),
273 $ dble( n ) ) / ( n*ulp )
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
DOUBLE PRECISION function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zget51(ITYPE, N, A, LDA, B, LDB, U, LDU, V, LDV, WORK, RWORK, RESULT)
ZGET51
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH