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