 LAPACK  3.8.0 LAPACK: Linear Algebra PACKage

## ◆ dget51()

 subroutine dget51 ( integer ITYPE, integer N, double precision, dimension( lda, * ) A, integer LDA, double precision, dimension( ldb, * ) B, integer LDB, double precision, dimension( ldu, * ) U, integer LDU, double precision, dimension( ldv, * ) V, integer LDV, double precision, dimension( * ) WORK, double precision RESULT )

DGET51

Purpose:
```      DGET51  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, DGET51 does nothing. It must be at least zero.``` [in] A ``` A is DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION array, dimension (2*N**2)` [out] RESULT ``` RESULT is DOUBLE PRECISION 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
December 2016

Definition at line 151 of file dget51.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  DOUBLE PRECISION result
160 * ..
161 * .. Array Arguments ..
162  DOUBLE PRECISION a( lda, * ), b( ldb, * ), u( ldu, * ),
163  \$ v( ldv, * ), work( * )
164 * ..
165 *
166 * =====================================================================
167 *
168 * .. Parameters ..
169  DOUBLE PRECISION zero, one, ten
170  parameter( zero = 0.0d0, one = 1.0d0, ten = 10.0d0 )
171 * ..
172 * .. Local Scalars ..
173  INTEGER jcol, jdiag, jrow
174  DOUBLE PRECISION anorm, ulp, unfl, wnorm
175 * ..
176 * .. External Functions ..
177  DOUBLE PRECISION dlamch, dlange
178  EXTERNAL dlamch, dlange
179 * ..
180 * .. External Subroutines ..
181  EXTERNAL dgemm, dlacpy
182 * ..
183 * .. Intrinsic Functions ..
184  INTRINSIC dble, max, min
185 * ..
186 * .. Executable Statements ..
187 *
188  result = zero
189  IF( n.LE.0 )
190  \$ RETURN
191 *
192 * Constants
193 *
194  unfl = dlamch( 'Safe minimum' )
195  ulp = dlamch( 'Epsilon' )*dlamch( '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( dlange( '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 dlacpy( ' ', n, n, a, lda, work, n )
215  CALL dgemm( 'N', 'N', n, n, n, one, u, ldu, b, ldb, zero,
216  \$ work( n**2+1 ), n )
217 *
218  CALL dgemm( '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 dlacpy( ' ', 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 = dlange( '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, dble( 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 dgemm( '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( dlange( '1', n, n, work, n, work( n**2+1 ) ),
264  \$ dble( n ) ) / ( n*ulp )
265  END IF
266 *
267  RETURN
268 *
269 * End of DGET51
270 *
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
Definition: dgemm.f:189
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:116
Here is the call graph for this function:
Here is the caller graph for this function: