LAPACK 3.3.0
|
00001 REAL FUNCTION SRZT01( 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 * SRZT01 returns 00020 * || A - R*Q || / ( M * eps * ||A|| ) 00021 * for an upper trapezoidal A that was factored with STZRZF. 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 STZRZF 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 * STZRZF. 00045 * 00046 * WORK (workspace) REAL array, dimension (LWORK) 00047 * 00048 * LWORK (input) INTEGER 00049 * The length of the array WORK. LWORK >= m*n + m*nb. 00050 * 00051 * ===================================================================== 00052 * 00053 * .. Parameters .. 00054 REAL ZERO, ONE 00055 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) 00056 * .. 00057 * .. Local Scalars .. 00058 INTEGER I, INFO, 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, SLASET, SORMRZ, XERBLA 00070 * .. 00071 * .. Intrinsic Functions .. 00072 INTRINSIC MAX, REAL 00073 * .. 00074 * .. Executable Statements .. 00075 * 00076 SRZT01 = ZERO 00077 * 00078 IF( LWORK.LT.M*N+M ) THEN 00079 CALL XERBLA( 'SRZT01', 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 CALL SORMRZ( 'Right', 'No tranpose', M, N, M, N-M, AF, LDA, TAU, 00102 $ WORK, M, WORK( M*N+1 ), LWORK-M*N, INFO ) 00103 * 00104 * R = R - A 00105 * 00106 DO 30 I = 1, N 00107 CALL SAXPY( M, -ONE, A( 1, I ), 1, WORK( ( I-1 )*M+1 ), 1 ) 00108 30 CONTINUE 00109 * 00110 SRZT01 = SLANGE( 'One-norm', M, N, WORK, M, RWORK ) 00111 * 00112 SRZT01 = SRZT01 / ( SLAMCH( 'Epsilon' )*REAL( MAX( M, N ) ) ) 00113 IF( NORMA.NE.ZERO ) 00114 $ SRZT01 = SRZT01 / NORMA 00115 * 00116 RETURN 00117 * 00118 * End of SRZT01 00119 * 00120 END