TESTING/LIN/drzt02.f

   1 *> \brief \b DRZT02
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       DOUBLE PRECISION FUNCTION DRZT02( M, N, AF, LDA, TAU, WORK,
  12 *                        LWORK )
  13 *
  14 *       .. Scalar Arguments ..
  15 *       INTEGER            LDA, LWORK, M, N
  16 *       ..
  17 *       .. Array Arguments ..
  18 *       DOUBLE PRECISION   AF( LDA, * ), TAU( * ), WORK( LWORK )
  19 *       ..
  20 *
  21 *
  22 *> \par Purpose:
  23 *  =============
  24 *>
  25 *> \verbatim
  26 *>
  27 *> DRZT02 returns
  28 *>      || I - Q'*Q || / ( M * eps)
  29 *> where the matrix Q is defined by the Householder transformations
  30 *> generated by DTZRZF.
  31 *> \endverbatim
  32 *
  33 *  Arguments:
  34 *  ==========
  35 *
  36 *> \param[in] M
  37 *> \verbatim
  38 *>          M is INTEGER
  39 *>          The number of rows of the matrix AF.
  40 *> \endverbatim
  41 *>
  42 *> \param[in] N
  43 *> \verbatim
  44 *>          N is INTEGER
  45 *>          The number of columns of the matrix AF.
  46 *> \endverbatim
  47 *>
  48 *> \param[in] AF
  49 *> \verbatim
  50 *>          AF is DOUBLE PRECISION array, dimension (LDA,N)
  51 *>          The output of DTZRZF.
  52 *> \endverbatim
  53 *>
  54 *> \param[in] LDA
  55 *> \verbatim
  56 *>          LDA is INTEGER
  57 *>          The leading dimension of the array AF.
  58 *> \endverbatim
  59 *>
  60 *> \param[in] TAU
  61 *> \verbatim
  62 *>          TAU is DOUBLE PRECISION array, dimension (M)
  63 *>          Details of the Householder transformations as returned by
  64 *>          DTZRZF.
  65 *> \endverbatim
  66 *>
  67 *> \param[out] WORK
  68 *> \verbatim
  69 *>          WORK is DOUBLE PRECISION array, dimension (LWORK)
  70 *> \endverbatim
  71 *>
  72 *> \param[in] LWORK
  73 *> \verbatim
  74 *>          LWORK is INTEGER
  75 *>          length of WORK array. LWORK >= N*N+N*NB.
  76 *> \endverbatim
  77 *
  78 *  Authors:
  79 *  ========
  80 *
  81 *> \author Univ. of Tennessee
  82 *> \author Univ. of California Berkeley
  83 *> \author Univ. of Colorado Denver
  84 *> \author NAG Ltd.
  85 *
  86 *> \date November 2011
  87 *
  88 *> \ingroup double_lin
  89 *
  90 *  =====================================================================
  91       DOUBLE PRECISION FUNCTION DRZT02( M, N, AF, LDA, TAU, WORK,
  92      $                 LWORK )
  93 *
  94 *  -- LAPACK test routine (version 3.4.0) --
  95 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  96 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  97 *     November 2011
  98 *
  99 *     .. Scalar Arguments ..
 100       INTEGER            LDA, LWORK, M, N
 101 *     ..
 102 *     .. Array Arguments ..
 103       DOUBLE PRECISION   AF( LDA, * ), TAU( * ), WORK( LWORK )
 104 *     ..
 105 *
 106 *  =====================================================================
 107 *
 108 *     .. Parameters ..
 109       DOUBLE PRECISION   ZERO, ONE
 110       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
 111 *     ..
 112 *     .. Local Scalars ..
 113       INTEGER            I, INFO
 114 *     ..
 115 *     .. Local Arrays ..
 116       DOUBLE PRECISION   RWORK( 1 )
 117 *     ..
 118 *     .. External Functions ..
 119       DOUBLE PRECISION   DLAMCH, DLANGE
 120       EXTERNAL           DLAMCH, DLANGE
 121 *     ..
 122 *     .. External Subroutines ..
 123       EXTERNAL           DLASET, DORMRZ, XERBLA
 124 *     ..
 125 *     .. Intrinsic Functions ..
 126       INTRINSIC          DBLE, MAX
 127 *     ..
 128 *     .. Executable Statements ..
 129 *
 130       DRZT02 = ZERO
 131 *
 132       IF( LWORK.LT.N*N+N ) THEN
 133          CALL XERBLA( 'DRZT02', 7 )
 134          RETURN
 135       END IF
 136 *
 137 *     Quick return if possible
 138 *
 139       IF( M.LE.0 .OR. N.LE.0 )
 140      $   RETURN
 141 *
 142 *     Q := I
 143 *
 144       CALL DLASET( 'Full', N, N, ZERO, ONE, WORK, N )
 145 *
 146 *     Q := P(1) * ... * P(m) * Q
 147 *
 148       CALL DORMRZ( 'Left', 'No transpose', N, N, M, N-M, AF, LDA, TAU,
 149      $             WORK, N, WORK( N*N+1 ), LWORK-N*N, INFO )
 150 *
 151 *     Q := P(m) * ... * P(1) * Q
 152 *
 153       CALL DORMRZ( 'Left', 'Transpose', N, N, M, N-M, AF, LDA, TAU,
 154      $             WORK, N, WORK( N*N+1 ), LWORK-N*N, INFO )
 155 *
 156 *     Q := Q - I
 157 *
 158       DO 10 I = 1, N
 159          WORK( ( I-1 )*N+I ) = WORK( ( I-1 )*N+I ) - ONE
 160    10 CONTINUE
 161 *
 162       DRZT02 = DLANGE( 'One-norm', N, N, WORK, N, RWORK ) /
 163      $         ( DLAMCH( 'Epsilon' )*DBLE( MAX( M, N ) ) )
 164       RETURN
 165 *
 166 *     End of DRZT02
 167 *
 168       END