![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
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