![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SBDT02 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 SBDT02( M, N, B, LDB, C, LDC, U, LDU, WORK, RESID ) 00012 * 00013 * .. Scalar Arguments .. 00014 * INTEGER LDB, LDC, LDU, M, N 00015 * REAL RESID 00016 * .. 00017 * .. Array Arguments .. 00018 * REAL B( LDB, * ), C( LDC, * ), U( LDU, * ), 00019 * $ WORK( * ) 00020 * .. 00021 * 00022 * 00023 *> \par Purpose: 00024 * ============= 00025 *> 00026 *> \verbatim 00027 *> 00028 *> SBDT02 tests the change of basis C = U' * B by computing the residual 00029 *> 00030 *> RESID = norm( B - U * C ) / ( max(m,n) * norm(B) * EPS ), 00031 *> 00032 *> where B and C are M by N matrices, U is an M by M orthogonal matrix, 00033 *> and EPS is the machine precision. 00034 *> \endverbatim 00035 * 00036 * Arguments: 00037 * ========== 00038 * 00039 *> \param[in] M 00040 *> \verbatim 00041 *> M is INTEGER 00042 *> The number of rows of the matrices B and C and the order of 00043 *> the matrix Q. 00044 *> \endverbatim 00045 *> 00046 *> \param[in] N 00047 *> \verbatim 00048 *> N is INTEGER 00049 *> The number of columns of the matrices B and C. 00050 *> \endverbatim 00051 *> 00052 *> \param[in] B 00053 *> \verbatim 00054 *> B is REAL array, dimension (LDB,N) 00055 *> The m by n matrix B. 00056 *> \endverbatim 00057 *> 00058 *> \param[in] LDB 00059 *> \verbatim 00060 *> LDB is INTEGER 00061 *> The leading dimension of the array B. LDB >= max(1,M). 00062 *> \endverbatim 00063 *> 00064 *> \param[in] C 00065 *> \verbatim 00066 *> C is REAL array, dimension (LDC,N) 00067 *> The m by n matrix C, assumed to contain U' * B. 00068 *> \endverbatim 00069 *> 00070 *> \param[in] LDC 00071 *> \verbatim 00072 *> LDC is INTEGER 00073 *> The leading dimension of the array C. LDC >= max(1,M). 00074 *> \endverbatim 00075 *> 00076 *> \param[in] U 00077 *> \verbatim 00078 *> U is REAL array, dimension (LDU,M) 00079 *> The m by m orthogonal matrix U. 00080 *> \endverbatim 00081 *> 00082 *> \param[in] LDU 00083 *> \verbatim 00084 *> LDU is INTEGER 00085 *> The leading dimension of the array U. LDU >= max(1,M). 00086 *> \endverbatim 00087 *> 00088 *> \param[out] WORK 00089 *> \verbatim 00090 *> WORK is REAL array, dimension (M) 00091 *> \endverbatim 00092 *> 00093 *> \param[out] RESID 00094 *> \verbatim 00095 *> RESID is REAL 00096 *> RESID = norm( B - U * C ) / ( max(m,n) * norm(B) * EPS ), 00097 *> \endverbatim 00098 * 00099 * Authors: 00100 * ======== 00101 * 00102 *> \author Univ. of Tennessee 00103 *> \author Univ. of California Berkeley 00104 *> \author Univ. of Colorado Denver 00105 *> \author NAG Ltd. 00106 * 00107 *> \date November 2011 00108 * 00109 *> \ingroup single_eig 00110 * 00111 * ===================================================================== 00112 SUBROUTINE SBDT02( M, N, B, LDB, C, LDC, U, LDU, WORK, RESID ) 00113 * 00114 * -- LAPACK test routine (version 3.4.0) -- 00115 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00116 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00117 * November 2011 00118 * 00119 * .. Scalar Arguments .. 00120 INTEGER LDB, LDC, LDU, M, N 00121 REAL RESID 00122 * .. 00123 * .. Array Arguments .. 00124 REAL B( LDB, * ), C( LDC, * ), U( LDU, * ), 00125 $ WORK( * ) 00126 * .. 00127 * 00128 * ====================================================================== 00129 * 00130 * .. Parameters .. 00131 REAL ZERO, ONE 00132 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) 00133 * .. 00134 * .. Local Scalars .. 00135 INTEGER J 00136 REAL BNORM, EPS, REALMN 00137 * .. 00138 * .. External Functions .. 00139 REAL SASUM, SLAMCH, SLANGE 00140 EXTERNAL SASUM, SLAMCH, SLANGE 00141 * .. 00142 * .. External Subroutines .. 00143 EXTERNAL SCOPY, SGEMV 00144 * .. 00145 * .. Intrinsic Functions .. 00146 INTRINSIC MAX, MIN, REAL 00147 * .. 00148 * .. Executable Statements .. 00149 * 00150 * Quick return if possible 00151 * 00152 RESID = ZERO 00153 IF( M.LE.0 .OR. N.LE.0 ) 00154 $ RETURN 00155 REALMN = REAL( MAX( M, N ) ) 00156 EPS = SLAMCH( 'Precision' ) 00157 * 00158 * Compute norm( B - U * C ) 00159 * 00160 DO 10 J = 1, N 00161 CALL SCOPY( M, B( 1, J ), 1, WORK, 1 ) 00162 CALL SGEMV( 'No transpose', M, M, -ONE, U, LDU, C( 1, J ), 1, 00163 $ ONE, WORK, 1 ) 00164 RESID = MAX( RESID, SASUM( M, WORK, 1 ) ) 00165 10 CONTINUE 00166 * 00167 * Compute norm of B. 00168 * 00169 BNORM = SLANGE( '1', M, N, B, LDB, WORK ) 00170 * 00171 IF( BNORM.LE.ZERO ) THEN 00172 IF( RESID.NE.ZERO ) 00173 $ RESID = ONE / EPS 00174 ELSE 00175 IF( BNORM.GE.RESID ) THEN 00176 RESID = ( RESID / BNORM ) / ( REALMN*EPS ) 00177 ELSE 00178 IF( BNORM.LT.ONE ) THEN 00179 RESID = ( MIN( RESID, REALMN*BNORM ) / BNORM ) / 00180 $ ( REALMN*EPS ) 00181 ELSE 00182 RESID = MIN( RESID / BNORM, REALMN ) / ( REALMN*EPS ) 00183 END IF 00184 END IF 00185 END IF 00186 RETURN 00187 * 00188 * End of SBDT02 00189 * 00190 END