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 )