|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 DOUBLE PRECISION FUNCTION ZTZT01( 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*16 A( LDA, * ), AF( LDA, * ), TAU( * ), 00013 $ WORK( LWORK ) 00014 * .. 00015 * 00016 * Purpose 00017 * ======= 00018 * 00019 * ZTZT01 returns 00020 * || A - R*Q || / ( M * eps * ||A|| ) 00021 * for an upper trapezoidal A that was factored with ZTZRQF. 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*16 array, dimension (LDA,N) 00033 * The original upper trapezoidal M by N matrix A. 00034 * 00035 * AF (input) COMPLEX*16 array, dimension (LDA,N) 00036 * The output of ZTZRQF 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*16 array, dimension (M) 00043 * Details of the Householder transformations as returned by 00044 * ZTZRQF. 00045 * 00046 * WORK (workspace) COMPLEX*16 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 DOUBLE PRECISION ZERO, ONE 00055 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 00056 * .. 00057 * .. Local Scalars .. 00058 INTEGER I, J 00059 DOUBLE PRECISION NORMA 00060 * .. 00061 * .. Local Arrays .. 00062 DOUBLE PRECISION RWORK( 1 ) 00063 * .. 00064 * .. External Functions .. 00065 DOUBLE PRECISION DLAMCH, ZLANGE 00066 EXTERNAL DLAMCH, ZLANGE 00067 * .. 00068 * .. External Subroutines .. 00069 EXTERNAL XERBLA, ZAXPY, ZLASET, ZLATZM 00070 * .. 00071 * .. Intrinsic Functions .. 00072 INTRINSIC DBLE, DCMPLX, MAX 00073 * .. 00074 * .. Executable Statements .. 00075 * 00076 ZTZT01 = ZERO 00077 * 00078 IF( LWORK.LT.M*N+M ) THEN 00079 CALL XERBLA( 'ZTZT01', 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 = ZLANGE( 'One-norm', M, N, A, LDA, RWORK ) 00089 * 00090 * Copy upper triangle R 00091 * 00092 CALL ZLASET( 'Full', M, N, DCMPLX( ZERO ), DCMPLX( ZERO ), WORK, 00093 $ M ) 00094 DO 20 J = 1, M 00095 DO 10 I = 1, J 00096 WORK( ( J-1 )*M+I ) = AF( I, J ) 00097 10 CONTINUE 00098 20 CONTINUE 00099 * 00100 * R = R * P(1) * ... *P(m) 00101 * 00102 DO 30 I = 1, M 00103 CALL ZLATZM( 'Right', I, N-M+1, AF( I, M+1 ), LDA, TAU( I ), 00104 $ WORK( ( I-1 )*M+1 ), WORK( M*M+1 ), M, 00105 $ WORK( M*N+1 ) ) 00106 30 CONTINUE 00107 * 00108 * R = R - A 00109 * 00110 DO 40 I = 1, N 00111 CALL ZAXPY( M, DCMPLX( -ONE ), A( 1, I ), 1, 00112 $ WORK( ( I-1 )*M+1 ), 1 ) 00113 40 CONTINUE 00114 * 00115 ZTZT01 = ZLANGE( 'One-norm', M, N, WORK, M, RWORK ) 00116 * 00117 ZTZT01 = ZTZT01 / ( DLAMCH( 'Epsilon' )*DBLE( MAX( M, N ) ) ) 00118 IF( NORMA.NE.ZERO ) 00119 $ ZTZT01 = ZTZT01 / NORMA 00120 * 00121 RETURN 00122 * 00123 * End of ZTZT01 00124 * 00125 END
1.7.3 
