LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ srzt01()

real function srzt01 ( integer  m,
integer  n,
real, dimension( lda, * )  a,
real, dimension( lda, * )  af,
integer  lda,
real, dimension( * )  tau,
real, dimension( lwork )  work,
integer  lwork 
)

SRZT01

Purpose:
 SRZT01 returns
      || A - R*Q || / ( M * eps * ||A|| )
 for an upper trapezoidal A that was factored with STZRZF.
Parameters
[in]M
          M is INTEGER
          The number of rows of the matrices A and AF.
[in]N
          N is INTEGER
          The number of columns of the matrices A and AF.
[in]A
          A is REAL array, dimension (LDA,N)
          The original upper trapezoidal M by N matrix A.
[in]AF
          AF is REAL array, dimension (LDA,N)
          The output of STZRZF for input matrix A.
          The lower triangle is not referenced.
[in]LDA
          LDA is INTEGER
          The leading dimension of the arrays A and AF.
[in]TAU
          TAU is REAL array, dimension (M)
          Details of the Householder transformations as returned by
          STZRZF.
[out]WORK
          WORK is REAL array, dimension (LWORK)
[in]LWORK
          LWORK is INTEGER
          The length of the array WORK.  LWORK >= m*n + m*nb.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 96 of file srzt01.f.

98*
99* -- LAPACK test routine --
100* -- LAPACK is a software package provided by Univ. of Tennessee, --
101* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
102*
103* .. Scalar Arguments ..
104 INTEGER LDA, LWORK, M, N
105* ..
106* .. Array Arguments ..
107 REAL A( LDA, * ), AF( LDA, * ), TAU( * ),
108 $ WORK( LWORK )
109* ..
110*
111* =====================================================================
112*
113* .. Parameters ..
114 REAL ZERO, ONE
115 parameter( zero = 0.0e+0, one = 1.0e+0 )
116* ..
117* .. Local Scalars ..
118 INTEGER I, INFO, J
119 REAL NORMA
120* ..
121* .. Local Arrays ..
122 REAL RWORK( 1 )
123* ..
124* .. External Functions ..
125 REAL SLAMCH, SLANGE
126 EXTERNAL slamch, slange
127* ..
128* .. External Subroutines ..
129 EXTERNAL saxpy, slaset, sormrz, xerbla
130* ..
131* .. Intrinsic Functions ..
132 INTRINSIC max, real
133* ..
134* .. Executable Statements ..
135*
136 srzt01 = zero
137*
138 IF( lwork.LT.m*n+m ) THEN
139 CALL xerbla( 'SRZT01', 8 )
140 RETURN
141 END IF
142*
143* Quick return if possible
144*
145 IF( m.LE.0 .OR. n.LE.0 )
146 $ RETURN
147*
148 norma = slange( 'One-norm', m, n, a, lda, rwork )
149*
150* Copy upper triangle R
151*
152 CALL slaset( 'Full', m, n, zero, zero, work, m )
153 DO 20 j = 1, m
154 DO 10 i = 1, j
155 work( ( j-1 )*m+i ) = af( i, j )
156 10 CONTINUE
157 20 CONTINUE
158*
159* R = R * P(1) * ... *P(m)
160*
161 CALL sormrz( 'Right', 'No transpose', m, n, m, n-m, af, lda, tau,
162 $ work, m, work( m*n+1 ), lwork-m*n, info )
163*
164* R = R - A
165*
166 DO 30 i = 1, n
167 CALL saxpy( m, -one, a( 1, i ), 1, work( ( i-1 )*m+1 ), 1 )
168 30 CONTINUE
169*
170 srzt01 = slange( 'One-norm', m, n, work, m, rwork )
171*
172 srzt01 = srzt01 / ( slamch( 'Epsilon' )*real( max( m, n ) ) )
173 IF( norma.NE.zero )
174 $ srzt01 = srzt01 / norma
175*
176 RETURN
177*
178* End of SRZT01
179*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine saxpy(n, sa, sx, incx, sy, incy)
SAXPY
Definition saxpy.f:89
real function slamch(cmach)
SLAMCH
Definition slamch.f:68
real function slange(norm, m, n, a, lda, work)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition slange.f:114
subroutine slaset(uplo, m, n, alpha, beta, a, lda)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition slaset.f:110
subroutine sormrz(side, trans, m, n, k, l, a, lda, tau, c, ldc, work, lwork, info)
SORMRZ
Definition sormrz.f:187
real function srzt01(m, n, a, af, lda, tau, work, lwork)
SRZT01
Definition srzt01.f:98
Here is the call graph for this function:
Here is the caller graph for this function: