dort03()

subroutine dort03	(	character*( * )	rc,
		integer	mu,
		integer	mv,
		integer	n,
		integer	k,
		double precision, dimension( ldu, * )	u,
		integer	ldu,
		double precision, dimension( ldv, * )	v,
		integer	ldv,
		double precision, dimension( * )	work,
		integer	lwork,
		double precision	result,
		integer	info
	)

DORT03

Purpose:

 DORT03 compares two orthogonal matrices U and V to see if their
 corresponding rows or columns span the same spaces.  The rows are
 checked if RC = 'R', and the columns are checked if RC = 'C'.

 RESULT is the maximum of

    | V*V' - I | / ( MV ulp ), if RC = 'R', or

    | V'*V - I | / ( MV ulp ), if RC = 'C',

 and the maximum over rows (or columns) 1 to K of

    | U(i) - S*V(i) |/ ( N ulp )

 where S is +-1 (chosen to minimize the expression), U(i) is the i-th
 row (column) of U, and V(i) is the i-th row (column) of V.

Parameters

[in]	RC	RC is CHARACTER*1 If RC = 'R' the rows of U and V are to be compared. If RC = 'C' the columns of U and V are to be compared.
[in]	MU	MU is INTEGER The number of rows of U if RC = 'R', and the number of columns if RC = 'C'. If MU = 0 DORT03 does nothing. MU must be at least zero.
[in]	MV	MV is INTEGER The number of rows of V if RC = 'R', and the number of columns if RC = 'C'. If MV = 0 DORT03 does nothing. MV must be at least zero.
[in]	N	N is INTEGER If RC = 'R', the number of columns in the matrices U and V, and if RC = 'C', the number of rows in U and V. If N = 0 DORT03 does nothing. N must be at least zero.
[in]	K	K is INTEGER The number of rows or columns of U and V to compare. 0 <= K <= max(MU,MV).
[in]	U	U is DOUBLE PRECISION array, dimension (LDU,N) The first matrix to compare. If RC = 'R', U is MU by N, and if RC = 'C', U is N by MU.
[in]	LDU	LDU is INTEGER The leading dimension of U. If RC = 'R', LDU >= max(1,MU), and if RC = 'C', LDU >= max(1,N).
[in]	V	V is DOUBLE PRECISION array, dimension (LDV,N) The second matrix to compare. If RC = 'R', V is MV by N, and if RC = 'C', V is N by MV.
[in]	LDV	LDV is INTEGER The leading dimension of V. If RC = 'R', LDV >= max(1,MV), and if RC = 'C', LDV >= max(1,N).
[out]	WORK	WORK is DOUBLE PRECISION array, dimension (LWORK)
[in]	LWORK	LWORK is INTEGER The length of the array WORK. For best performance, LWORK should be at least N*N if RC = 'C' or M*M if RC = 'R', but the tests will be done even if LWORK is 0.
[out]	RESULT	RESULT is DOUBLE PRECISION The value computed by the test described above. RESULT is limited to 1/ulp to avoid overflow.
[out]	INFO	INFO is INTEGER 0 indicates a successful exit -k indicates the k-th parameter had an illegal value

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Definition at line 154 of file dort03.f.

*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER*( * )    RC
      INTEGER            INFO, K, LDU, LDV, LWORK, MU, MV, N
      DOUBLE PRECISION   RESULT
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION   U( LDU, * ), V( LDV, * ), WORK( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      DOUBLE PRECISION   ZERO, ONE
      parameter( zero = 0.0d0, one = 1.0d0 )
*     ..
*     .. Local Scalars ..
      INTEGER            I, IRC, J, LMX
      DOUBLE PRECISION   RES1, RES2, S, ULP
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      INTEGER            IDAMAX
      DOUBLE PRECISION   DLAMCH
      EXTERNAL           lsame, idamax, dlamch
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, dble, max, min, sign
*     ..
*     .. External Subroutines ..
      EXTERNAL           dort01, xerbla
*     ..
*     .. Executable Statements ..
*
*     Check inputs
*
      info = 0
      IF( lsame( rc, 'R' ) ) THEN
         irc = 0
      ELSE IF( lsame( rc, 'C' ) ) THEN
         irc = 1
      ELSE
         irc = -1
      END IF
      IF( irc.EQ.-1 ) THEN
         info = -1
      ELSE IF( mu.LT.0 ) THEN
         info = -2
      ELSE IF( mv.LT.0 ) THEN
         info = -3
      ELSE IF( n.LT.0 ) THEN
         info = -4
      ELSE IF( k.LT.0 .OR. k.GT.max( mu, mv ) ) THEN
         info = -5
      ELSE IF( ( irc.EQ.0 .AND. ldu.LT.max( 1, mu ) ) .OR.
     $         ( irc.EQ.1 .AND. ldu.LT.max( 1, n ) ) ) THEN
         info = -7
      ELSE IF( ( irc.EQ.0 .AND. ldv.LT.max( 1, mv ) ) .OR.
     $         ( irc.EQ.1 .AND. ldv.LT.max( 1, n ) ) ) THEN
         info = -9
      END IF
      IF( info.NE.0 ) THEN
         CALL xerbla( 'DORT03', -info )
         RETURN
      END IF
*
*     Initialize result
*
      result = zero
      IF( mu.EQ.0 .OR. mv.EQ.0 .OR. n.EQ.0 )
     $   RETURN
*
*     Machine constants
*
      ulp = dlamch( 'Precision' )
*
      IF( irc.EQ.0 ) THEN
*
*        Compare rows
*
         res1 = zero
         DO 20 i = 1, k
            lmx = idamax( n, u( i, 1 ), ldu )
            s = sign( one, u( i, lmx ) )*sign( one, v( i, lmx ) )
            DO 10 j = 1, n
               res1 = max( res1, abs( u( i, j )-s*v( i, j ) ) )
   10       CONTINUE
   20    CONTINUE
         res1 = res1 / ( dble( n )*ulp )
*
*        Compute orthogonality of rows of V.
*
         CALL dort01( 'Rows', mv, n, v, ldv, work, lwork, res2 )
*
      ELSE
*
*        Compare columns
*
         res1 = zero
         DO 40 i = 1, k
            lmx = idamax( n, u( 1, i ), 1 )
            s = sign( one, u( lmx, i ) )*sign( one, v( lmx, i ) )
            DO 30 j = 1, n
               res1 = max( res1, abs( u( j, i )-s*v( j, i ) ) )
   30       CONTINUE
   40    CONTINUE
         res1 = res1 / ( dble( n )*ulp )
*
*        Compute orthogonality of columns of V.
*
         CALL dort01( 'Columns', n, mv, v, ldv, work, lwork, res2 )
      END IF
*
      result = min( max( res1, res2 ), one / ulp )
      RETURN
*
*     End of DORT03
*

Here is the call graph for this function:

Here is the caller graph for this function: