LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zrzt01.f
Go to the documentation of this file.
00001 *> \brief \b ZRZT01
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 ZRZT01( M, N, A, AF, LDA, TAU, WORK,
00012 *                        LWORK )
00013 * 
00014 *       .. Scalar Arguments ..
00015 *       INTEGER            LDA, LWORK, M, N
00016 *       ..
00017 *       .. Array Arguments ..
00018 *       COMPLEX*16         A( LDA, * ), AF( LDA, * ), TAU( * ),
00019 *      $                   WORK( LWORK )
00020 *       ..
00021 *  
00022 *
00023 *> \par Purpose:
00024 *  =============
00025 *>
00026 *> \verbatim
00027 *>
00028 *> ZRZT01 returns
00029 *>      || A - R*Q || / ( M * eps * ||A|| )
00030 *> for an upper trapezoidal A that was factored with ZTZRZF.
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 COMPLEX*16 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 COMPLEX*16 array, dimension (LDA,N)
00057 *>          The output of ZTZRZF 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 COMPLEX*16 array, dimension (M)
00070 *>          Details of the  Householder transformations as returned by
00071 *>          ZTZRZF.
00072 *> \endverbatim
00073 *>
00074 *> \param[out] WORK
00075 *> \verbatim
00076 *>          WORK is COMPLEX*16 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 complex16_lin
00096 *
00097 *  =====================================================================
00098       DOUBLE PRECISION FUNCTION ZRZT01( 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       COMPLEX*16         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, INFO, J
00122       DOUBLE PRECISION   NORMA
00123 *     ..
00124 *     .. Local Arrays ..
00125       DOUBLE PRECISION   RWORK( 1 )
00126 *     ..
00127 *     .. External Functions ..
00128       DOUBLE PRECISION   DLAMCH, ZLANGE
00129       EXTERNAL           DLAMCH, ZLANGE
00130 *     ..
00131 *     .. External Subroutines ..
00132       EXTERNAL           XERBLA, ZAXPY, ZLASET, ZUNMRZ
00133 *     ..
00134 *     .. Intrinsic Functions ..
00135       INTRINSIC          DBLE, DCMPLX, MAX
00136 *     ..
00137 *     .. Executable Statements ..
00138 *
00139       ZRZT01 = ZERO
00140 *
00141       IF( LWORK.LT.M*N+M ) THEN
00142          CALL XERBLA( 'ZRZT01', 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 = ZLANGE( 'One-norm', M, N, A, LDA, RWORK )
00152 *
00153 *     Copy upper triangle R
00154 *
00155       CALL ZLASET( 'Full', M, N, DCMPLX( ZERO ), DCMPLX( ZERO ), WORK,
00156      $             M )
00157       DO 20 J = 1, M
00158          DO 10 I = 1, J
00159             WORK( ( J-1 )*M+I ) = AF( I, J )
00160    10    CONTINUE
00161    20 CONTINUE
00162 *
00163 *     R = R * P(1) * ... *P(m)
00164 *
00165       CALL ZUNMRZ( 'Right', 'No tranpose', M, N, M, N-M, AF, LDA, TAU,
00166      $             WORK, M, WORK( M*N+1 ), LWORK-M*N, INFO )
00167 *
00168 *     R = R - A
00169 *
00170       DO 30 I = 1, N
00171          CALL ZAXPY( M, DCMPLX( -ONE ), A( 1, I ), 1,
00172      $               WORK( ( I-1 )*M+1 ), 1 )
00173    30 CONTINUE
00174 *
00175       ZRZT01 = ZLANGE( 'One-norm', M, N, WORK, M, RWORK )
00176 *
00177       ZRZT01 = ZRZT01 / ( DLAMCH( 'Epsilon' )*DBLE( MAX( M, N ) ) )
00178       IF( NORMA.NE.ZERO )
00179      $   ZRZT01 = ZRZT01 / NORMA
00180 *
00181       RETURN
00182 *
00183 *     End of ZRZT01
00184 *
00185       END
 All Files Functions