162 SUBROUTINE zget52( LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA,
163 $ work, rwork, result )
172 INTEGER lda, ldb,
lde, n
175 DOUBLE PRECISION result( 2 ), rwork( * )
176 COMPLEX*16 a( lda, * ), alpha( * ),
b( ldb, * ),
177 $ beta( * ), e(
lde, * ), work( * )
183 DOUBLE PRECISION zero, one
184 parameter( zero = 0.0d+0, one = 1.0d+0 )
185 COMPLEX*16 czero, cone
186 parameter( czero = ( 0.0d+0, 0.0d+0 ),
187 $ cone = ( 1.0d+0, 0.0d+0 ) )
190 CHARACTER normab, trans
192 DOUBLE PRECISION abmax, alfmax, anorm, betmax, bnorm, enorm,
193 $ enrmer, errnrm, safmax, safmin, scale, temp1,
195 COMPLEX*16 acoeff, alphai, bcoeff, betai,
x
205 INTRINSIC abs, dble, dconjg, dimag, max
208 DOUBLE PRECISION abs1
211 abs1(
x ) = abs( dble(
x ) ) + abs( dimag(
x ) )
220 safmin =
dlamch(
'Safe minimum' )
221 safmax = one / safmin
234 anorm = max(
zlange( normab, n, n, a, lda, rwork ), safmin )
235 bnorm = max(
zlange( normab, n, n,
b, ldb, rwork ), safmin )
236 enorm = max(
zlange(
'O', n, n, e,
lde, rwork ), ulp )
237 alfmax = safmax / max( one, bnorm )
238 betmax = safmax / max( one, anorm )
244 alphai = alpha( jvec )
246 abmax = max( abs1( alphai ), abs1( betai ) )
247 IF( abs1( alphai ).GT.alfmax .OR. abs1( betai ).GT.betmax .OR.
248 $ abmax.LT.one )
THEN
249 scale = one / max( abmax, safmin )
250 alphai = scale*alphai
253 scale = one / max( abs1( alphai )*bnorm, abs1( betai )*anorm,
256 bcoeff = scale*alphai
258 acoeff = dconjg( acoeff )
259 bcoeff = dconjg( bcoeff )
261 CALL
zgemv( trans, n, n, acoeff, a, lda, e( 1, jvec ), 1,
262 $ czero, work( n*( jvec-1 )+1 ), 1 )
263 CALL
zgemv( trans, n, n, -bcoeff,
b, lda, e( 1, jvec ), 1,
264 $ cone, work( n*( jvec-1 )+1 ), 1 )
267 errnrm =
zlange(
'One', n, n, work, n, rwork ) / enorm
271 result( 1 ) = errnrm / ulp
279 temp1 = max( temp1, abs1( e(
j, jvec ) ) )
281 enrmer = max( enrmer, temp1-one )
286 result( 2 ) = enrmer / ( dble( n )*ulp )
subroutine zget52(LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA, WORK, RWORK, RESULT)
ZGET52
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
LOGICAL function lde(RI, RJ, LR)
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 ...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH