LAPACK 3.3.0

ctzt01.f

Go to the documentation of this file.
00001       REAL             FUNCTION CTZT01( M, N, A, AF, LDA, TAU, WORK,
00002      $                 LWORK )
00003 *
00004 *  -- LAPACK test routine (version 3.1) --
00005 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       INTEGER            LDA, LWORK, M, N
00010 *     ..
00011 *     .. Array Arguments ..
00012       COMPLEX            A( LDA, * ), AF( LDA, * ), TAU( * ),
00013      $                   WORK( LWORK )
00014 *     ..
00015 *
00016 *  Purpose
00017 *  =======
00018 *
00019 *  CTZT01 returns
00020 *       || A - R*Q || / ( M * eps * ||A|| )
00021 *  for an upper trapezoidal A that was factored with CTZRQF.
00022 *
00023 *  Arguments
00024 *  =========
00025 *
00026 *  M       (input) INTEGER
00027 *          The number of rows of the matrices A and AF.
00028 *
00029 *  N       (input) INTEGER
00030 *          The number of columns of the matrices A and AF.
00031 *
00032 *  A       (input) COMPLEX array, dimension (LDA,N)
00033 *          The original upper trapezoidal M by N matrix A.
00034 *
00035 *  AF      (input) COMPLEX array, dimension (LDA,N)
00036 *          The output of CTZRQF for input matrix A.
00037 *          The lower triangle is not referenced.
00038 *
00039 *  LDA     (input) INTEGER
00040 *          The leading dimension of the arrays A and AF.
00041 *
00042 *  TAU     (input) COMPLEX array, dimension (M)
00043 *          Details of the  Householder transformations as returned by
00044 *          CTZRQF.
00045 *
00046 *  WORK    (workspace) COMPLEX array, dimension (LWORK)
00047 *
00048 *  LWORK   (input) INTEGER
00049 *          The length of the array WORK.  LWORK >= m*n + m.
00050 *
00051 *  =====================================================================
00052 *
00053 *     .. Parameters ..
00054       REAL               ZERO, ONE
00055       PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
00056 *     ..
00057 *     .. Local Scalars ..
00058       INTEGER            I, J
00059       REAL               NORMA
00060 *     ..
00061 *     .. Local Arrays ..
00062       REAL               RWORK( 1 )
00063 *     ..
00064 *     .. External Functions ..
00065       REAL               CLANGE, SLAMCH
00066       EXTERNAL           CLANGE, SLAMCH
00067 *     ..
00068 *     .. External Subroutines ..
00069       EXTERNAL           CAXPY, CLATZM, CLASET, XERBLA
00070 *     ..
00071 *     .. Intrinsic Functions ..
00072       INTRINSIC          CMPLX, MAX, REAL
00073 *     ..
00074 *     .. Executable Statements ..
00075 *
00076       CTZT01 = ZERO
00077 *
00078       IF( LWORK.LT.M*N+M ) THEN
00079          CALL XERBLA( 'CTZT01', 8 )
00080          RETURN
00081       END IF
00082 *
00083 *     Quick return if possible
00084 *
00085       IF( M.LE.0 .OR. N.LE.0 )
00086      $   RETURN
00087 *
00088       NORMA = CLANGE( 'One-norm', M, N, A, LDA, RWORK )
00089 *
00090 *     Copy upper triangle R
00091 *
00092       CALL CLASET( 'Full', M, N, CMPLX( ZERO ), CMPLX( ZERO ), WORK, M )
00093       DO 20 J = 1, M
00094          DO 10 I = 1, J
00095             WORK( ( J-1 )*M+I ) = AF( I, J )
00096    10    CONTINUE
00097    20 CONTINUE
00098 *
00099 *     R = R * P(1) * ... *P(m)
00100 *
00101       DO 30 I = 1, M
00102          CALL CLATZM( 'Right', I, N-M+1, AF( I, M+1 ), LDA, TAU( I ),
00103      $                WORK( ( I-1 )*M+1 ), WORK( M*M+1 ), M,
00104      $                WORK( M*N+1 ) )
00105    30 CONTINUE
00106 *
00107 *     R = R - A
00108 *
00109       DO 40 I = 1, N
00110          CALL CAXPY( M, CMPLX( -ONE ), A( 1, I ), 1,
00111      $               WORK( ( I-1 )*M+1 ), 1 )
00112    40 CONTINUE
00113 *
00114       CTZT01 = CLANGE( 'One-norm', M, N, WORK, M, RWORK )
00115 *
00116       CTZT01 = CTZT01 / ( SLAMCH( 'Epsilon' )*REAL( MAX( M, N ) ) )
00117       IF( NORMA.NE.ZERO )
00118      $   CTZT01 = CTZT01 / NORMA
00119 *
00120       RETURN
00121 *
00122 *     End of CTZT01
00123 *
00124       END
 All Files Functions