156 SUBROUTINE dort03( RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK,
166 INTEGER info, k, ldu, ldv, lwork, mu, mv, n
167 DOUBLE PRECISION result
170 DOUBLE PRECISION u( ldu, * ), v( ldv, * ), work( * )
176 DOUBLE PRECISION zero, one
177 parameter( zero = 0.0d0, one = 1.0d0 )
180 INTEGER i, irc,
j, lmx
181 DOUBLE PRECISION res1, res2, s, ulp
190 INTRINSIC abs, dble, max, min, sign
200 IF(
lsame( rc,
'R' ) )
THEN
202 ELSE IF(
lsame( rc,
'C' ) )
THEN
209 ELSE IF( mu.LT.0 )
THEN
211 ELSE IF( mv.LT.0 )
THEN
213 ELSE IF( n.LT.0 )
THEN
215 ELSE IF( k.LT.0 .OR. k.GT.max( mu, mv ) )
THEN
217 ELSE IF( ( irc.EQ.0 .AND. ldu.LT.max( 1, mu ) ) .OR.
218 $ ( irc.EQ.1 .AND. ldu.LT.max( 1, n ) ) )
THEN
220 ELSE IF( ( irc.EQ.0 .AND. ldv.LT.max( 1, mv ) ) .OR.
221 $ ( irc.EQ.1 .AND. ldv.LT.max( 1, n ) ) )
THEN
225 CALL
xerbla(
'DORT03', -info )
232 IF( mu.EQ.0 .OR. mv.EQ.0 .OR. n.EQ.0 )
237 ulp =
dlamch(
'Precision' )
245 lmx =
idamax( n, u( i, 1 ), ldu )
246 s = sign( one, u( i, lmx ) )*sign( one, v( i, lmx ) )
248 res1 = max( res1, abs( u( i,
j )-s*v( i,
j ) ) )
251 res1 = res1 / ( dble( n )*ulp )
255 CALL
dort01(
'Rows', mv, n, v, ldv, work, lwork, res2 )
263 lmx =
idamax( n, u( 1, i ), 1 )
264 s = sign( one, u( lmx, i ) )*sign( one, v( lmx, i ) )
266 res1 = max( res1, abs( u(
j, i )-s*v(
j, i ) ) )
269 res1 = res1 / ( dble( n )*ulp )
273 CALL
dort01(
'Columns', n, mv, v, ldv, work, lwork, res2 )
276 result = min( max( res1, res2 ), one / ulp )
subroutine dort03(RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK, RESULT, INFO)
DORT03
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
integer function idamax(N, DX, INCX)
IDAMAX
subroutine dort01(ROWCOL, M, N, U, LDU, WORK, LWORK, RESID)
DORT01