LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cbdt02.f
Go to the documentation of this file.
00001 *> \brief \b CBDT02
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 CBDT02( M, N, B, LDB, C, LDC, U, LDU, WORK, RWORK,
00012 *                          RESID )
00013 * 
00014 *       .. Scalar Arguments ..
00015 *       INTEGER            LDB, LDC, LDU, M, N
00016 *       REAL               RESID
00017 *       ..
00018 *       .. Array Arguments ..
00019 *       REAL               RWORK( * )
00020 *       COMPLEX            B( LDB, * ), C( LDC, * ), U( LDU, * ),
00021 *      $                   WORK( * )
00022 *       ..
00023 *  
00024 *
00025 *> \par Purpose:
00026 *  =============
00027 *>
00028 *> \verbatim
00029 *>
00030 *> CBDT02 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 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 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 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 array, dimension (M)
00093 *> \endverbatim
00094 *>
00095 *> \param[out] RWORK
00096 *> \verbatim
00097 *>          RWORK is REAL array, dimension (M)
00098 *> \endverbatim
00099 *>
00100 *> \param[out] RESID
00101 *> \verbatim
00102 *>          RESID is REAL
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 complex_eig
00117 *
00118 *  =====================================================================
00119       SUBROUTINE CBDT02( 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       REAL               RESID
00130 *     ..
00131 *     .. Array Arguments ..
00132       REAL               RWORK( * )
00133       COMPLEX            B( LDB, * ), C( LDC, * ), U( LDU, * ),
00134      $                   WORK( * )
00135 *     ..
00136 *
00137 * ======================================================================
00138 *
00139 *     .. Parameters ..
00140       REAL               ZERO, ONE
00141       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
00142 *     ..
00143 *     .. Local Scalars ..
00144       INTEGER            J
00145       REAL               BNORM, EPS, REALMN
00146 *     ..
00147 *     .. External Functions ..
00148       REAL               CLANGE, SCASUM, SLAMCH
00149       EXTERNAL           CLANGE, SCASUM, SLAMCH
00150 *     ..
00151 *     .. External Subroutines ..
00152       EXTERNAL           CCOPY, CGEMV
00153 *     ..
00154 *     .. Intrinsic Functions ..
00155       INTRINSIC          CMPLX, MAX, MIN, REAL
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 = REAL( MAX( M, N ) )
00165       EPS = SLAMCH( 'Precision' )
00166 *
00167 *     Compute norm( B - U * C )
00168 *
00169       DO 10 J = 1, N
00170          CALL CCOPY( M, B( 1, J ), 1, WORK, 1 )
00171          CALL CGEMV( 'No transpose', M, M, -CMPLX( ONE ), U, LDU,
00172      $               C( 1, J ), 1, CMPLX( ONE ), WORK, 1 )
00173          RESID = MAX( RESID, SCASUM( M, WORK, 1 ) )
00174    10 CONTINUE
00175 *
00176 *     Compute norm of B.
00177 *
00178       BNORM = CLANGE( '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 CBDT02
00198 *
00199       END
 All Files Functions