 LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
 subroutine sget51 ( integer ITYPE, integer N, real, dimension( lda, * ) A, integer LDA, real, dimension( ldb, * ) B, integer LDB, real, dimension( ldu, * ) U, integer LDU, real, dimension( ldv, * ) V, integer LDV, real, dimension( * ) WORK, real RESULT )

SGET51

Purpose:
```      SGET51  generally checks a decomposition of the form

A = U B V'

where ' means transpose and U and V are orthogonal.

Specifically, if ITYPE=1

RESULT = | A - U B V' | / ( |A| n ulp )

If ITYPE=2, then:

RESULT = | A - B | / ( |A| n ulp )

If ITYPE=3, then:

RESULT = | I - UU' | / ( n ulp )```
Parameters
 [in] ITYPE ``` ITYPE is INTEGER Specifies the type of tests to be performed. =1: RESULT = | A - U B V' | / ( |A| n ulp ) =2: RESULT = | A - B | / ( |A| n ulp ) =3: RESULT = | I - UU' | / ( n ulp )``` [in] N ``` N is INTEGER The size of the matrix. If it is zero, SGET51 does nothing. It must be at least zero.``` [in] A ``` A is REAL array, dimension (LDA, N) The original (unfactored) matrix.``` [in] LDA ``` LDA is INTEGER The leading dimension of A. It must be at least 1 and at least N.``` [in] B ``` B is REAL array, dimension (LDB, N) The factored matrix.``` [in] LDB ``` LDB is INTEGER The leading dimension of B. It must be at least 1 and at least N.``` [in] U ``` U is REAL array, dimension (LDU, N) The orthogonal matrix on the left-hand side in the decomposition. Not referenced if ITYPE=2``` [in] LDU ``` LDU is INTEGER The leading dimension of U. LDU must be at least N and at least 1.``` [in] V ``` V is REAL array, dimension (LDV, N) The orthogonal matrix on the left-hand side in the decomposition. Not referenced if ITYPE=2``` [in] LDV ``` LDV is INTEGER The leading dimension of V. LDV must be at least N and at least 1.``` [out] WORK ` WORK is REAL array, dimension (2*N**2)` [out] RESULT ``` RESULT is REAL The values computed by the test specified by ITYPE. The value is currently limited to 1/ulp, to avoid overflow. Errors are flagged by RESULT=10/ulp.```
Date
November 2011

Definition at line 151 of file sget51.f.

151 *
152 * -- LAPACK test routine (version 3.4.0) --
153 * -- LAPACK is a software package provided by Univ. of Tennessee, --
154 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
155 * November 2011
156 *
157 * .. Scalar Arguments ..
158  INTEGER itype, lda, ldb, ldu, ldv, n
159  REAL result
160 * ..
161 * .. Array Arguments ..
162  REAL a( lda, * ), b( ldb, * ), u( ldu, * ),
163  \$ v( ldv, * ), work( * )
164 * ..
165 *
166 * =====================================================================
167 *
168 * .. Parameters ..
169  REAL zero, one, ten
170  parameter ( zero = 0.0, one = 1.0e0, ten = 10.0e0 )
171 * ..
172 * .. Local Scalars ..
173  INTEGER jcol, jdiag, jrow
174  REAL anorm, ulp, unfl, wnorm
175 * ..
176 * .. External Functions ..
177  REAL slamch, slange
178  EXTERNAL slamch, slange
179 * ..
180 * .. External Subroutines ..
181  EXTERNAL sgemm, slacpy
182 * ..
183 * .. Intrinsic Functions ..
184  INTRINSIC max, min, real
185 * ..
186 * .. Executable Statements ..
187 *
188  result = zero
189  IF( n.LE.0 )
190  \$ RETURN
191 *
192 * Constants
193 *
194  unfl = slamch( 'Safe minimum' )
195  ulp = slamch( 'Epsilon' )*slamch( 'Base' )
196 *
197 * Some Error Checks
198 *
199  IF( itype.LT.1 .OR. itype.GT.3 ) THEN
200  result = ten / ulp
201  RETURN
202  END IF
203 *
204  IF( itype.LE.2 ) THEN
205 *
206 * Tests scaled by the norm(A)
207 *
208  anorm = max( slange( '1', n, n, a, lda, work ), unfl )
209 *
210  IF( itype.EQ.1 ) THEN
211 *
212 * ITYPE=1: Compute W = A - UBV'
213 *
214  CALL slacpy( ' ', n, n, a, lda, work, n )
215  CALL sgemm( 'N', 'N', n, n, n, one, u, ldu, b, ldb, zero,
216  \$ work( n**2+1 ), n )
217 *
218  CALL sgemm( 'N', 'C', n, n, n, -one, work( n**2+1 ), n, v,
219  \$ ldv, one, work, n )
220 *
221  ELSE
222 *
223 * ITYPE=2: Compute W = A - B
224 *
225  CALL slacpy( ' ', n, n, b, ldb, work, n )
226 *
227  DO 20 jcol = 1, n
228  DO 10 jrow = 1, n
229  work( jrow+n*( jcol-1 ) ) = work( jrow+n*( jcol-1 ) )
230  \$ - a( jrow, jcol )
231  10 CONTINUE
232  20 CONTINUE
233  END IF
234 *
235 * Compute norm(W)/ ( ulp*norm(A) )
236 *
237  wnorm = slange( '1', n, n, work, n, work( n**2+1 ) )
238 *
239  IF( anorm.GT.wnorm ) THEN
240  result = ( wnorm / anorm ) / ( n*ulp )
241  ELSE
242  IF( anorm.LT.one ) THEN
243  result = ( min( wnorm, n*anorm ) / anorm ) / ( n*ulp )
244  ELSE
245  result = min( wnorm / anorm, REAL( N ) ) / ( n*ulp )
246  END IF
247  END IF
248 *
249  ELSE
250 *
251 * Tests not scaled by norm(A)
252 *
253 * ITYPE=3: Compute UU' - I
254 *
255  CALL sgemm( 'N', 'C', n, n, n, one, u, ldu, u, ldu, zero, work,
256  \$ n )
257 *
258  DO 30 jdiag = 1, n
259  work( ( n+1 )*( jdiag-1 )+1 ) = work( ( n+1 )*( jdiag-1 )+
260  \$ 1 ) - one
261  30 CONTINUE
262 *
263  result = min( slange( '1', n, n, work, n, work( n**2+1 ) ),
264  \$ REAL( N ) ) / ( n*ulp )
265  END IF
266 *
267  RETURN
268 *
269 * End of SGET51
270 *
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
Definition: sgemm.f:189
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:105
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:116
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69

Here is the call graph for this function:

Here is the caller graph for this function: