154 SUBROUTINE dort03( RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK,
163 INTEGER INFO, K, LDU, LDV, LWORK, MU, MV, N
164 DOUBLE PRECISION RESULT
167 DOUBLE PRECISION U( LDU, * ), V( LDV, * ), WORK( * )
173 DOUBLE PRECISION ZERO, ONE
174 parameter( zero = 0.0d0, one = 1.0d0 )
177 INTEGER I, IRC, J, LMX
178 DOUBLE PRECISION RES1, RES2, S, ULP
183 DOUBLE PRECISION DLAMCH
184 EXTERNAL lsame, idamax, dlamch
187 INTRINSIC abs, dble, max, min, sign
197 IF( lsame( rc,
'R' ) )
THEN
199 ELSE IF( lsame( rc,
'C' ) )
THEN
206 ELSE IF( mu.LT.0 )
THEN
208 ELSE IF( mv.LT.0 )
THEN
210 ELSE IF( n.LT.0 )
THEN
212 ELSE IF( k.LT.0 .OR. k.GT.max( mu, mv ) )
THEN
214 ELSE IF( ( irc.EQ.0 .AND. ldu.LT.max( 1, mu ) ) .OR.
215 $ ( irc.EQ.1 .AND. ldu.LT.max( 1, n ) ) )
THEN
217 ELSE IF( ( irc.EQ.0 .AND. ldv.LT.max( 1, mv ) ) .OR.
218 $ ( irc.EQ.1 .AND. ldv.LT.max( 1, n ) ) )
THEN
222 CALL xerbla(
'DORT03', -info )
229 IF( mu.EQ.0 .OR. mv.EQ.0 .OR. n.EQ.0 )
234 ulp = dlamch(
'Precision' )
242 lmx = idamax( n, u( i, 1 ), ldu )
243 s = sign( one, u( i, lmx ) )*sign( one, v( i, lmx ) )
245 res1 = max( res1, abs( u( i, j )-s*v( i, j ) ) )
248 res1 = res1 / ( dble( n )*ulp )
252 CALL dort01(
'Rows', mv, n, v, ldv, work, lwork, res2 )
260 lmx = idamax( n, u( 1, i ), 1 )
261 s = sign( one, u( lmx, i ) )*sign( one, v( lmx, i ) )
263 res1 = max( res1, abs( u( j, i )-s*v( j, i ) ) )
266 res1 = res1 / ( dble( n )*ulp )
270 CALL dort01(
'Columns', n, mv, v, ldv, work, lwork, res2 )
273 result = min( max( res1, res2 ), one / ulp )
subroutine xerbla(srname, info)
subroutine dort01(rowcol, m, n, u, ldu, work, lwork, resid)
DORT01
subroutine dort03(rc, mu, mv, n, k, u, ldu, v, ldv, work, lwork, result, info)
DORT03