156 SUBROUTINE sort03( RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK,
166 INTEGER info, k, ldu, ldv, lwork, mu, mv, n
170 REAL u( ldu, * ), v( ldv, * ), work( * )
177 parameter( zero = 0.0e0, one = 1.0e0 )
180 INTEGER i, irc,
j, lmx
181 REAL res1, res2, s, ulp
190 INTRINSIC abs, max, min,
REAL, 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(
'SORT03', -info )
232 IF( mu.EQ.0 .OR. mv.EQ.0 .OR. n.EQ.0 )
237 ulp =
slamch(
'Precision' )
245 lmx =
isamax( 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 / (
REAL( n )*ulp )
255 CALL
sort01(
'Rows', mv, n, v, ldv, work, lwork, res2 )
263 lmx =
isamax( 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 / (
REAL( n )*ulp )
273 CALL
sort01(
'Columns', n, mv, v, ldv, work, lwork, res2 )
276 result = min( max( res1, res2 ), one / ulp )
integer function isamax(N, SX, INCX)
ISAMAX
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sort03(RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK, RESULT, INFO)
SORT03
logical function lsame(CA, CB)
LSAME
subroutine sort01(ROWCOL, M, N, U, LDU, WORK, LWORK, RESID)
SORT01
real function slamch(CMACH)
SLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j