 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 REAL FUNCTION STZT01( 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 REAL A( LDA, * ), AF( LDA, * ), TAU( * ), 00013 $ WORK( LWORK ) 00014 * .. 00015 * 00016 * Purpose 00017 * ======= 00018 * 00019 * STZT01 returns 00020 * || A - R*Q || / ( M * eps * ||A|| ) 00021 * for an upper trapezoidal A that was factored with STZRQF. 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) REAL array, dimension (LDA,N) 00033 * The original upper trapezoidal M by N matrix A. 00034 * 00035 * AF (input) REAL array, dimension (LDA,N) 00036 * The output of STZRQF 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) REAL array, dimension (M) 00043 * Details of the Householder transformations as returned by 00044 * STZRQF. 00045 * 00046 * WORK (workspace) REAL 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 SLAMCH, SLANGE 00066 EXTERNAL SLAMCH, SLANGE 00067 * .. 00068 * .. External Subroutines .. 00069 EXTERNAL SAXPY, SLATZM, SLASET, XERBLA 00070 * .. 00071 * .. Intrinsic Functions .. 00072 INTRINSIC MAX, REAL 00073 * .. 00074 * .. Executable Statements .. 00075 * 00076 STZT01 = ZERO 00077 * 00078 IF( LWORK.LT.M*N+M ) THEN 00079 CALL XERBLA( 'STZT01', 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 = SLANGE( 'One-norm', M, N, A, LDA, RWORK ) 00089 * 00090 * Copy upper triangle R 00091 * 00092 CALL SLASET( 'Full', M, N, ZERO, 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 SLATZM( '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 SAXPY( M, -ONE, A( 1, I ), 1, WORK( ( I-1 )*M+1 ), 1 ) 00111 40 CONTINUE 00112 * 00113 STZT01 = SLANGE( 'One-norm', M, N, WORK, M, RWORK ) 00114 * 00115 STZT01 = STZT01 / ( SLAMCH( 'Epsilon' )*REAL( MAX( M, N ) ) ) 00116 IF( NORMA.NE.ZERO ) 00117 $ STZT01 = STZT01 / NORMA 00118 * 00119 RETURN 00120 * 00121 * End of STZT01 00122 * 00123 END
1.7.3 
