LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dbdt02.f
Go to the documentation of this file.
00001 *> \brief \b DBDT02
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 DBDT02( M, N, B, LDB, C, LDC, U, LDU, WORK, RESID )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       INTEGER            LDB, LDC, LDU, M, N
00015 *       DOUBLE PRECISION   RESID
00016 *       ..
00017 *       .. Array Arguments ..
00018 *       DOUBLE PRECISION   B( LDB, * ), C( LDC, * ), U( LDU, * ),
00019 *      $                   WORK( * )
00020 *       ..
00021 *  
00022 *
00023 *> \par Purpose:
00024 *  =============
00025 *>
00026 *> \verbatim
00027 *>
00028 *> DBDT02 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION array, dimension (M)
00091 *> \endverbatim
00092 *>
00093 *> \param[out] RESID
00094 *> \verbatim
00095 *>          RESID is DOUBLE PRECISION
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 double_eig
00110 *
00111 *  =====================================================================
00112       SUBROUTINE DBDT02( 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       DOUBLE PRECISION   RESID
00122 *     ..
00123 *     .. Array Arguments ..
00124       DOUBLE PRECISION   B( LDB, * ), C( LDC, * ), U( LDU, * ),
00125      $                   WORK( * )
00126 *     ..
00127 *
00128 * ======================================================================
00129 *
00130 *     .. Parameters ..
00131       DOUBLE PRECISION   ZERO, ONE
00132       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
00133 *     ..
00134 *     .. Local Scalars ..
00135       INTEGER            J
00136       DOUBLE PRECISION   BNORM, EPS, REALMN
00137 *     ..
00138 *     .. External Functions ..
00139       DOUBLE PRECISION   DASUM, DLAMCH, DLANGE
00140       EXTERNAL           DASUM, DLAMCH, DLANGE
00141 *     ..
00142 *     .. External Subroutines ..
00143       EXTERNAL           DCOPY, DGEMV
00144 *     ..
00145 *     .. Intrinsic Functions ..
00146       INTRINSIC          DBLE, MAX, MIN
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 = DBLE( MAX( M, N ) )
00156       EPS = DLAMCH( 'Precision' )
00157 *
00158 *     Compute norm( B - U * C )
00159 *
00160       DO 10 J = 1, N
00161          CALL DCOPY( M, B( 1, J ), 1, WORK, 1 )
00162          CALL DGEMV( 'No transpose', M, M, -ONE, U, LDU, C( 1, J ), 1,
00163      $               ONE, WORK, 1 )
00164          RESID = MAX( RESID, DASUM( M, WORK, 1 ) )
00165    10 CONTINUE
00166 *
00167 *     Compute norm of B.
00168 *
00169       BNORM = DLANGE( '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 DBDT02
00189 *
00190       END
 All Files Functions