LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
sort03.f
Go to the documentation of this file.
00001 *> \brief \b SORT03
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE SORT03( RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK,
00012 *                          RESULT, INFO )
00013 * 
00014 *       .. Scalar Arguments ..
00015 *       CHARACTER*( * )    RC
00016 *       INTEGER            INFO, K, LDU, LDV, LWORK, MU, MV, N
00017 *       REAL               RESULT
00018 *       ..
00019 *       .. Array Arguments ..
00020 *       REAL               U( LDU, * ), V( LDV, * ), WORK( * )
00021 *       ..
00022 *  
00023 *
00024 *> \par Purpose:
00025 *  =============
00026 *>
00027 *> \verbatim
00028 *>
00029 *> SORT03 compares two orthogonal matrices U and V to see if their
00030 *> corresponding rows or columns span the same spaces.  The rows are
00031 *> checked if RC = 'R', and the columns are checked if RC = 'C'.
00032 *>
00033 *> RESULT is the maximum of
00034 *>
00035 *>    | V*V' - I | / ( MV ulp ), if RC = 'R', or
00036 *>
00037 *>    | V'*V - I | / ( MV ulp ), if RC = 'C',
00038 *>
00039 *> and the maximum over rows (or columns) 1 to K of
00040 *>
00041 *>    | U(i) - S*V(i) |/ ( N ulp )
00042 *>
00043 *> where S is +-1 (chosen to minimize the expression), U(i) is the i-th
00044 *> row (column) of U, and V(i) is the i-th row (column) of V.
00045 *> \endverbatim
00046 *
00047 *  Arguments:
00048 *  ==========
00049 *
00050 *> \param[in] RC
00051 *> \verbatim
00052 *>          RC is CHARACTER*1
00053 *>          If RC = 'R' the rows of U and V are to be compared.
00054 *>          If RC = 'C' the columns of U and V are to be compared.
00055 *> \endverbatim
00056 *>
00057 *> \param[in] MU
00058 *> \verbatim
00059 *>          MU is INTEGER
00060 *>          The number of rows of U if RC = 'R', and the number of
00061 *>          columns if RC = 'C'.  If MU = 0 SORT03 does nothing.
00062 *>          MU must be at least zero.
00063 *> \endverbatim
00064 *>
00065 *> \param[in] MV
00066 *> \verbatim
00067 *>          MV is INTEGER
00068 *>          The number of rows of V if RC = 'R', and the number of
00069 *>          columns if RC = 'C'.  If MV = 0 SORT03 does nothing.
00070 *>          MV must be at least zero.
00071 *> \endverbatim
00072 *>
00073 *> \param[in] N
00074 *> \verbatim
00075 *>          N is INTEGER
00076 *>          If RC = 'R', the number of columns in the matrices U and V,
00077 *>          and if RC = 'C', the number of rows in U and V.  If N = 0
00078 *>          SORT03 does nothing.  N must be at least zero.
00079 *> \endverbatim
00080 *>
00081 *> \param[in] K
00082 *> \verbatim
00083 *>          K is INTEGER
00084 *>          The number of rows or columns of U and V to compare.
00085 *>          0 <= K <= max(MU,MV).
00086 *> \endverbatim
00087 *>
00088 *> \param[in] U
00089 *> \verbatim
00090 *>          U is REAL array, dimension (LDU,N)
00091 *>          The first matrix to compare.  If RC = 'R', U is MU by N, and
00092 *>          if RC = 'C', U is N by MU.
00093 *> \endverbatim
00094 *>
00095 *> \param[in] LDU
00096 *> \verbatim
00097 *>          LDU is INTEGER
00098 *>          The leading dimension of U.  If RC = 'R', LDU >= max(1,MU),
00099 *>          and if RC = 'C', LDU >= max(1,N).
00100 *> \endverbatim
00101 *>
00102 *> \param[in] V
00103 *> \verbatim
00104 *>          V is REAL array, dimension (LDV,N)
00105 *>          The second matrix to compare.  If RC = 'R', V is MV by N, and
00106 *>          if RC = 'C', V is N by MV.
00107 *> \endverbatim
00108 *>
00109 *> \param[in] LDV
00110 *> \verbatim
00111 *>          LDV is INTEGER
00112 *>          The leading dimension of V.  If RC = 'R', LDV >= max(1,MV),
00113 *>          and if RC = 'C', LDV >= max(1,N).
00114 *> \endverbatim
00115 *>
00116 *> \param[out] WORK
00117 *> \verbatim
00118 *>          WORK is REAL array, dimension (LWORK)
00119 *> \endverbatim
00120 *>
00121 *> \param[in] LWORK
00122 *> \verbatim
00123 *>          LWORK is INTEGER
00124 *>          The length of the array WORK.  For best performance, LWORK
00125 *>          should be at least N*N if RC = 'C' or M*M if RC = 'R', but
00126 *>          the tests will be done even if LWORK is 0.
00127 *> \endverbatim
00128 *>
00129 *> \param[out] RESULT
00130 *> \verbatim
00131 *>          RESULT is REAL
00132 *>          The value computed by the test described above.  RESULT is
00133 *>          limited to 1/ulp to avoid overflow.
00134 *> \endverbatim
00135 *>
00136 *> \param[out] INFO
00137 *> \verbatim
00138 *>          INFO is INTEGER
00139 *>          0  indicates a successful exit
00140 *>          -k indicates the k-th parameter had an illegal value
00141 *> \endverbatim
00142 *
00143 *  Authors:
00144 *  ========
00145 *
00146 *> \author Univ. of Tennessee 
00147 *> \author Univ. of California Berkeley 
00148 *> \author Univ. of Colorado Denver 
00149 *> \author NAG Ltd. 
00150 *
00151 *> \date November 2011
00152 *
00153 *> \ingroup single_eig
00154 *
00155 *  =====================================================================
00156       SUBROUTINE SORT03( RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK,
00157      $                   RESULT, INFO )
00158 *
00159 *  -- LAPACK test routine (version 3.4.0) --
00160 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00161 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00162 *     November 2011
00163 *
00164 *     .. Scalar Arguments ..
00165       CHARACTER*( * )    RC
00166       INTEGER            INFO, K, LDU, LDV, LWORK, MU, MV, N
00167       REAL               RESULT
00168 *     ..
00169 *     .. Array Arguments ..
00170       REAL               U( LDU, * ), V( LDV, * ), WORK( * )
00171 *     ..
00172 *
00173 *  =====================================================================
00174 *
00175 *     .. Parameters ..
00176       REAL               ZERO, ONE
00177       PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
00178 *     ..
00179 *     .. Local Scalars ..
00180       INTEGER            I, IRC, J, LMX
00181       REAL               RES1, RES2, S, ULP
00182 *     ..
00183 *     .. External Functions ..
00184       LOGICAL            LSAME
00185       INTEGER            ISAMAX
00186       REAL               SLAMCH
00187       EXTERNAL           LSAME, ISAMAX, SLAMCH
00188 *     ..
00189 *     .. Intrinsic Functions ..
00190       INTRINSIC          ABS, MAX, MIN, REAL, SIGN
00191 *     ..
00192 *     .. External Subroutines ..
00193       EXTERNAL           SORT01, XERBLA
00194 *     ..
00195 *     .. Executable Statements ..
00196 *
00197 *     Check inputs
00198 *
00199       INFO = 0
00200       IF( LSAME( RC, 'R' ) ) THEN
00201          IRC = 0
00202       ELSE IF( LSAME( RC, 'C' ) ) THEN
00203          IRC = 1
00204       ELSE
00205          IRC = -1
00206       END IF
00207       IF( IRC.EQ.-1 ) THEN
00208          INFO = -1
00209       ELSE IF( MU.LT.0 ) THEN
00210          INFO = -2
00211       ELSE IF( MV.LT.0 ) THEN
00212          INFO = -3
00213       ELSE IF( N.LT.0 ) THEN
00214          INFO = -4
00215       ELSE IF( K.LT.0 .OR. K.GT.MAX( MU, MV ) ) THEN
00216          INFO = -5
00217       ELSE IF( ( IRC.EQ.0 .AND. LDU.LT.MAX( 1, MU ) ) .OR.
00218      $         ( IRC.EQ.1 .AND. LDU.LT.MAX( 1, N ) ) ) THEN
00219          INFO = -7
00220       ELSE IF( ( IRC.EQ.0 .AND. LDV.LT.MAX( 1, MV ) ) .OR.
00221      $         ( IRC.EQ.1 .AND. LDV.LT.MAX( 1, N ) ) ) THEN
00222          INFO = -9
00223       END IF
00224       IF( INFO.NE.0 ) THEN
00225          CALL XERBLA( 'SORT03', -INFO )
00226          RETURN
00227       END IF
00228 *
00229 *     Initialize result
00230 *
00231       RESULT = ZERO
00232       IF( MU.EQ.0 .OR. MV.EQ.0 .OR. N.EQ.0 )
00233      $   RETURN
00234 *
00235 *     Machine constants
00236 *
00237       ULP = SLAMCH( 'Precision' )
00238 *
00239       IF( IRC.EQ.0 ) THEN
00240 *
00241 *        Compare rows
00242 *
00243          RES1 = ZERO
00244          DO 20 I = 1, K
00245             LMX = ISAMAX( N, U( I, 1 ), LDU )
00246             S = SIGN( ONE, U( I, LMX ) )*SIGN( ONE, V( I, LMX ) )
00247             DO 10 J = 1, N
00248                RES1 = MAX( RES1, ABS( U( I, J )-S*V( I, J ) ) )
00249    10       CONTINUE
00250    20    CONTINUE
00251          RES1 = RES1 / ( REAL( N )*ULP )
00252 *
00253 *        Compute orthogonality of rows of V.
00254 *
00255          CALL SORT01( 'Rows', MV, N, V, LDV, WORK, LWORK, RES2 )
00256 *
00257       ELSE
00258 *
00259 *        Compare columns
00260 *
00261          RES1 = ZERO
00262          DO 40 I = 1, K
00263             LMX = ISAMAX( N, U( 1, I ), 1 )
00264             S = SIGN( ONE, U( LMX, I ) )*SIGN( ONE, V( LMX, I ) )
00265             DO 30 J = 1, N
00266                RES1 = MAX( RES1, ABS( U( J, I )-S*V( J, I ) ) )
00267    30       CONTINUE
00268    40    CONTINUE
00269          RES1 = RES1 / ( REAL( N )*ULP )
00270 *
00271 *        Compute orthogonality of columns of V.
00272 *
00273          CALL SORT01( 'Columns', N, MV, V, LDV, WORK, LWORK, RES2 )
00274       END IF
00275 *
00276       RESULT = MIN( MAX( RES1, RES2 ), ONE / ULP )
00277       RETURN
00278 *
00279 *     End of SORT03
00280 *
00281       END
 All Files Functions