LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ sget51()

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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
December 2016

Definition at line 151 of file sget51.f.

151 *
152 * -- LAPACK test routine (version 3.7.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 * December 2016
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
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
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
Here is the call graph for this function:
Here is the caller graph for this function: