LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dtzt01.f
Go to the documentation of this file.
00001 *> \brief \b DTZT01
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       DOUBLE PRECISION FUNCTION DTZT01( M, N, A, AF, LDA, TAU, WORK,
00012 *                        LWORK )
00013 * 
00014 *       .. Scalar Arguments ..
00015 *       INTEGER            LDA, LWORK, M, N
00016 *       ..
00017 *       .. Array Arguments ..
00018 *       DOUBLE PRECISION   A( LDA, * ), AF( LDA, * ), TAU( * ),
00019 *      $                   WORK( LWORK )
00020 *       ..
00021 *  
00022 *
00023 *> \par Purpose:
00024 *  =============
00025 *>
00026 *> \verbatim
00027 *>
00028 *> DTZT01 returns
00029 *>      || A - R*Q || / ( M * eps * ||A|| )
00030 *> for an upper trapezoidal A that was factored with DTZRQF.
00031 *> \endverbatim
00032 *
00033 *  Arguments:
00034 *  ==========
00035 *
00036 *> \param[in] M
00037 *> \verbatim
00038 *>          M is INTEGER
00039 *>          The number of rows of the matrices A and AF.
00040 *> \endverbatim
00041 *>
00042 *> \param[in] N
00043 *> \verbatim
00044 *>          N is INTEGER
00045 *>          The number of columns of the matrices A and AF.
00046 *> \endverbatim
00047 *>
00048 *> \param[in] A
00049 *> \verbatim
00050 *>          A is DOUBLE PRECISION array, dimension (LDA,N)
00051 *>          The original upper trapezoidal M by N matrix A.
00052 *> \endverbatim
00053 *>
00054 *> \param[in] AF
00055 *> \verbatim
00056 *>          AF is DOUBLE PRECISION array, dimension (LDA,N)
00057 *>          The output of DTZRQF for input matrix A.
00058 *>          The lower triangle is not referenced.
00059 *> \endverbatim
00060 *>
00061 *> \param[in] LDA
00062 *> \verbatim
00063 *>          LDA is INTEGER
00064 *>          The leading dimension of the arrays A and AF.
00065 *> \endverbatim
00066 *>
00067 *> \param[in] TAU
00068 *> \verbatim
00069 *>          TAU is DOUBLE PRECISION array, dimension (M)
00070 *>          Details of the  Householder transformations as returned by
00071 *>          DTZRQF.
00072 *> \endverbatim
00073 *>
00074 *> \param[out] WORK
00075 *> \verbatim
00076 *>          WORK is DOUBLE PRECISION array, dimension (LWORK)
00077 *> \endverbatim
00078 *>
00079 *> \param[in] LWORK
00080 *> \verbatim
00081 *>          LWORK is INTEGER
00082 *>          The length of the array WORK.  LWORK >= m*n + m.
00083 *> \endverbatim
00084 *
00085 *  Authors:
00086 *  ========
00087 *
00088 *> \author Univ. of Tennessee 
00089 *> \author Univ. of California Berkeley 
00090 *> \author Univ. of Colorado Denver 
00091 *> \author NAG Ltd. 
00092 *
00093 *> \date November 2011
00094 *
00095 *> \ingroup double_lin
00096 *
00097 *  =====================================================================
00098       DOUBLE PRECISION FUNCTION DTZT01( M, N, A, AF, LDA, TAU, WORK,
00099      $                 LWORK )
00100 *
00101 *  -- LAPACK test routine (version 3.4.0) --
00102 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00103 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00104 *     November 2011
00105 *
00106 *     .. Scalar Arguments ..
00107       INTEGER            LDA, LWORK, M, N
00108 *     ..
00109 *     .. Array Arguments ..
00110       DOUBLE PRECISION   A( LDA, * ), AF( LDA, * ), TAU( * ),
00111      $                   WORK( LWORK )
00112 *     ..
00113 *
00114 *  =====================================================================
00115 *
00116 *     .. Parameters ..
00117       DOUBLE PRECISION   ZERO, ONE
00118       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
00119 *     ..
00120 *     .. Local Scalars ..
00121       INTEGER            I, J
00122       DOUBLE PRECISION   NORMA
00123 *     ..
00124 *     .. Local Arrays ..
00125       DOUBLE PRECISION   RWORK( 1 )
00126 *     ..
00127 *     .. External Functions ..
00128       DOUBLE PRECISION   DLAMCH, DLANGE
00129       EXTERNAL           DLAMCH, DLANGE
00130 *     ..
00131 *     .. External Subroutines ..
00132       EXTERNAL           DAXPY, DLASET, DLATZM, XERBLA
00133 *     ..
00134 *     .. Intrinsic Functions ..
00135       INTRINSIC          DBLE, MAX
00136 *     ..
00137 *     .. Executable Statements ..
00138 *
00139       DTZT01 = ZERO
00140 *
00141       IF( LWORK.LT.M*N+M ) THEN
00142          CALL XERBLA( 'DTZT01', 8 )
00143          RETURN
00144       END IF
00145 *
00146 *     Quick return if possible
00147 *
00148       IF( M.LE.0 .OR. N.LE.0 )
00149      $   RETURN
00150 *
00151       NORMA = DLANGE( 'One-norm', M, N, A, LDA, RWORK )
00152 *
00153 *     Copy upper triangle R
00154 *
00155       CALL DLASET( 'Full', M, N, ZERO, ZERO, WORK, M )
00156       DO 20 J = 1, M
00157          DO 10 I = 1, J
00158             WORK( ( J-1 )*M+I ) = AF( I, J )
00159    10    CONTINUE
00160    20 CONTINUE
00161 *
00162 *     R = R * P(1) * ... *P(m)
00163 *
00164       DO 30 I = 1, M
00165          CALL DLATZM( 'Right', I, N-M+1, AF( I, M+1 ), LDA, TAU( I ),
00166      $                WORK( ( I-1 )*M+1 ), WORK( M*M+1 ), M,
00167      $                WORK( M*N+1 ) )
00168    30 CONTINUE
00169 *
00170 *     R = R - A
00171 *
00172       DO 40 I = 1, N
00173          CALL DAXPY( M, -ONE, A( 1, I ), 1, WORK( ( I-1 )*M+1 ), 1 )
00174    40 CONTINUE
00175 *
00176       DTZT01 = DLANGE( 'One-norm', M, N, WORK, M, RWORK )
00177 *
00178       DTZT01 = DTZT01 / ( DLAMCH( 'Epsilon' )*DBLE( MAX( M, N ) ) )
00179       IF( NORMA.NE.ZERO )
00180      $   DTZT01 = DTZT01 / NORMA
00181 *
00182       RETURN
00183 *
00184 *     End of DTZT01
00185 *
00186       END
 All Files Functions