|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
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
1.7.3 
