TESTING/EIG/zbdt02.f

   1 *> \brief \b ZBDT02
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       SUBROUTINE ZBDT02( M, N, B, LDB, C, LDC, U, LDU, WORK, RWORK,
  12 *                          RESID )
  13 *
  14 *       .. Scalar Arguments ..
  15 *       INTEGER            LDB, LDC, LDU, M, N
  16 *       DOUBLE PRECISION   RESID
  17 *       ..
  18 *       .. Array Arguments ..
  19 *       DOUBLE PRECISION   RWORK( * )
  20 *       COMPLEX*16         B( LDB, * ), C( LDC, * ), U( LDU, * ),
  21 *      $                   WORK( * )
  22 *       ..
  23 *
  24 *
  25 *> \par Purpose:
  26 *  =============
  27 *>
  28 *> \verbatim
  29 *>
  30 *> ZBDT02 tests the change of basis C = U' * B by computing the residual
  31 *>
  32 *>    RESID = norm( B - U * C ) / ( max(m,n) * norm(B) * EPS ),
  33 *>
  34 *> where B and C are M by N matrices, U is an M by M orthogonal matrix,
  35 *> and EPS is the machine precision.
  36 *> \endverbatim
  37 *
  38 *  Arguments:
  39 *  ==========
  40 *
  41 *> \param[in] M
  42 *> \verbatim
  43 *>          M is INTEGER
  44 *>          The number of rows of the matrices B and C and the order of
  45 *>          the matrix Q.
  46 *> \endverbatim
  47 *>
  48 *> \param[in] N
  49 *> \verbatim
  50 *>          N is INTEGER
  51 *>          The number of columns of the matrices B and C.
  52 *> \endverbatim
  53 *>
  54 *> \param[in] B
  55 *> \verbatim
  56 *>          B is COMPLEX*16 array, dimension (LDB,N)
  57 *>          The m by n matrix B.
  58 *> \endverbatim
  59 *>
  60 *> \param[in] LDB
  61 *> \verbatim
  62 *>          LDB is INTEGER
  63 *>          The leading dimension of the array B.  LDB >= max(1,M).
  64 *> \endverbatim
  65 *>
  66 *> \param[in] C
  67 *> \verbatim
  68 *>          C is COMPLEX*16 array, dimension (LDC,N)
  69 *>          The m by n matrix C, assumed to contain U' * B.
  70 *> \endverbatim
  71 *>
  72 *> \param[in] LDC
  73 *> \verbatim
  74 *>          LDC is INTEGER
  75 *>          The leading dimension of the array C.  LDC >= max(1,M).
  76 *> \endverbatim
  77 *>
  78 *> \param[in] U
  79 *> \verbatim
  80 *>          U is COMPLEX*16 array, dimension (LDU,M)
  81 *>          The m by m orthogonal matrix U.
  82 *> \endverbatim
  83 *>
  84 *> \param[in] LDU
  85 *> \verbatim
  86 *>          LDU is INTEGER
  87 *>          The leading dimension of the array U.  LDU >= max(1,M).
  88 *> \endverbatim
  89 *>
  90 *> \param[out] WORK
  91 *> \verbatim
  92 *>          WORK is COMPLEX*16 array, dimension (M)
  93 *> \endverbatim
  94 *>
  95 *> \param[out] RWORK
  96 *> \verbatim
  97 *>          RWORK is DOUBLE PRECISION array, dimension (M)
  98 *> \endverbatim
  99 *>
 100 *> \param[out] RESID
 101 *> \verbatim
 102 *>          RESID is DOUBLE PRECISION
 103 *>          RESID = norm( B - U * C ) / ( max(m,n) * norm(B) * EPS ),
 104 *> \endverbatim
 105 *
 106 *  Authors:
 107 *  ========
 108 *
 109 *> \author Univ. of Tennessee
 110 *> \author Univ. of California Berkeley
 111 *> \author Univ. of Colorado Denver
 112 *> \author NAG Ltd.
 113 *
 114 *> \date November 2011
 115 *
 116 *> \ingroup complex16_eig
 117 *
 118 *  =====================================================================
 119       SUBROUTINE ZBDT02( M, N, B, LDB, C, LDC, U, LDU, WORK, RWORK,
 120      $                   RESID )
 121 *
 122 *  -- LAPACK test routine (version 3.4.0) --
 123 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 124 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 125 *     November 2011
 126 *
 127 *     .. Scalar Arguments ..
 128       INTEGER            LDB, LDC, LDU, M, N
 129       DOUBLE PRECISION   RESID
 130 *     ..
 131 *     .. Array Arguments ..
 132       DOUBLE PRECISION   RWORK( * )
 133       COMPLEX*16         B( LDB, * ), C( LDC, * ), U( LDU, * ),
 134      $                   WORK( * )
 135 *     ..
 136 *
 137 * ======================================================================
 138 *
 139 *     .. Parameters ..
 140       DOUBLE PRECISION   ZERO, ONE
 141       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
 142 *     ..
 143 *     .. Local Scalars ..
 144       INTEGER            J
 145       DOUBLE PRECISION   BNORM, EPS, REALMN
 146 *     ..
 147 *     .. External Functions ..
 148       DOUBLE PRECISION   DLAMCH, DZASUM, ZLANGE
 149       EXTERNAL           DLAMCH, DZASUM, ZLANGE
 150 *     ..
 151 *     .. External Subroutines ..
 152       EXTERNAL           ZCOPY, ZGEMV
 153 *     ..
 154 *     .. Intrinsic Functions ..
 155       INTRINSIC          DBLE, DCMPLX, MAX, MIN
 156 *     ..
 157 *     .. Executable Statements ..
 158 *
 159 *     Quick return if possible
 160 *
 161       RESID = ZERO
 162       IF( M.LE.0 .OR. N.LE.0 )
 163      $   RETURN
 164       REALMN = DBLE( MAX( M, N ) )
 165       EPS = DLAMCH( 'Precision' )
 166 *
 167 *     Compute norm( B - U * C )
 168 *
 169       DO 10 J = 1, N
 170          CALL ZCOPY( M, B( 1, J ), 1, WORK, 1 )
 171          CALL ZGEMV( 'No transpose', M, M, -DCMPLX( ONE ), U, LDU,
 172      $               C( 1, J ), 1, DCMPLX( ONE ), WORK, 1 )
 173          RESID = MAX( RESID, DZASUM( M, WORK, 1 ) )
 174    10 CONTINUE
 175 *
 176 *     Compute norm of B.
 177 *
 178       BNORM = ZLANGE( '1', M, N, B, LDB, RWORK )
 179 *
 180       IF( BNORM.LE.ZERO ) THEN
 181          IF( RESID.NE.ZERO )
 182      $      RESID = ONE / EPS
 183       ELSE
 184          IF( BNORM.GE.RESID ) THEN
 185             RESID = ( RESID / BNORM ) / ( REALMN*EPS )
 186          ELSE
 187             IF( BNORM.LT.ONE ) THEN
 188                RESID = ( MIN( RESID, REALMN*BNORM ) / BNORM ) /
 189      $                 ( REALMN*EPS )
 190             ELSE
 191                RESID = MIN( RESID / BNORM, REALMN ) / ( REALMN*EPS )
 192             END IF
 193          END IF
 194       END IF
 195       RETURN
 196 *
 197 *     End of ZBDT02
 198 *
 199       END