1 SUBROUTINE DGET10( M, N, A, LDA, B, LDB, WORK, RESULT )
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER LDA, LDB, M, N
9 DOUBLE PRECISION RESULT
10 * ..
11 * .. Array Arguments ..
12 DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * DGET10 compares two matrices A and B and computes the ratio
19 * RESULT = norm( A - B ) / ( norm(A) * M * EPS )
20 *
21 * Arguments
22 * =========
23 *
24 * M (input) INTEGER
25 * The number of rows of the matrices A and B.
26 *
27 * N (input) INTEGER
28 * The number of columns of the matrices A and B.
29 *
30 * A (input) DOUBLE PRECISION array, dimension (LDA,N)
31 * The m by n matrix A.
32 *
33 * LDA (input) INTEGER
34 * The leading dimension of the array A. LDA >= max(1,M).
35 *
36 * B (input) DOUBLE PRECISION array, dimension (LDB,N)
37 * The m by n matrix B.
38 *
39 * LDB (input) INTEGER
40 * The leading dimension of the array B. LDB >= max(1,M).
41 *
42 * WORK (workspace) DOUBLE PRECISION array, dimension (M)
43 *
44 * RESULT (output) DOUBLE PRECISION
45 * RESULT = norm( A - B ) / ( norm(A) * M * EPS )
46 *
47 * =====================================================================
48 *
49 * .. Parameters ..
50 DOUBLE PRECISION ONE, ZERO
51 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
52 * ..
53 * .. Local Scalars ..
54 INTEGER J
55 DOUBLE PRECISION ANORM, EPS, UNFL, WNORM
56 * ..
57 * .. External Functions ..
58 DOUBLE PRECISION DASUM, DLAMCH, DLANGE
59 EXTERNAL DASUM, DLAMCH, DLANGE
60 * ..
61 * .. External Subroutines ..
62 EXTERNAL DAXPY, DCOPY
63 * ..
64 * .. Intrinsic Functions ..
65 INTRINSIC DBLE, MAX, MIN
66 * ..
67 * .. Executable Statements ..
68 *
69 * Quick return if possible
70 *
71 IF( M.LE.0 .OR. N.LE.0 ) THEN
72 RESULT = ZERO
73 RETURN
74 END IF
75 *
76 UNFL = DLAMCH( 'Safe minimum' )
77 EPS = DLAMCH( 'Precision' )
78 *
79 WNORM = ZERO
80 DO 10 J = 1, N
81 CALL DCOPY( M, A( 1, J ), 1, WORK, 1 )
82 CALL DAXPY( M, -ONE, B( 1, J ), 1, WORK, 1 )
83 WNORM = MAX( WNORM, DASUM( N, WORK, 1 ) )
84 10 CONTINUE
85 *
86 ANORM = MAX( DLANGE( '1', M, N, A, LDA, WORK ), UNFL )
87 *
88 IF( ANORM.GT.WNORM ) THEN
89 RESULT = ( WNORM / ANORM ) / ( M*EPS )
90 ELSE
91 IF( ANORM.LT.ONE ) THEN
92 RESULT = ( MIN( WNORM, M*ANORM ) / ANORM ) / ( M*EPS )
93 ELSE
94 RESULT = MIN( WNORM / ANORM, DBLE( M ) ) / ( M*EPS )
95 END IF
96 END IF
97 *
98 RETURN
99 *
100 * End of DGET10
101 *
102 END
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER LDA, LDB, M, N
9 DOUBLE PRECISION RESULT
10 * ..
11 * .. Array Arguments ..
12 DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * DGET10 compares two matrices A and B and computes the ratio
19 * RESULT = norm( A - B ) / ( norm(A) * M * EPS )
20 *
21 * Arguments
22 * =========
23 *
24 * M (input) INTEGER
25 * The number of rows of the matrices A and B.
26 *
27 * N (input) INTEGER
28 * The number of columns of the matrices A and B.
29 *
30 * A (input) DOUBLE PRECISION array, dimension (LDA,N)
31 * The m by n matrix A.
32 *
33 * LDA (input) INTEGER
34 * The leading dimension of the array A. LDA >= max(1,M).
35 *
36 * B (input) DOUBLE PRECISION array, dimension (LDB,N)
37 * The m by n matrix B.
38 *
39 * LDB (input) INTEGER
40 * The leading dimension of the array B. LDB >= max(1,M).
41 *
42 * WORK (workspace) DOUBLE PRECISION array, dimension (M)
43 *
44 * RESULT (output) DOUBLE PRECISION
45 * RESULT = norm( A - B ) / ( norm(A) * M * EPS )
46 *
47 * =====================================================================
48 *
49 * .. Parameters ..
50 DOUBLE PRECISION ONE, ZERO
51 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
52 * ..
53 * .. Local Scalars ..
54 INTEGER J
55 DOUBLE PRECISION ANORM, EPS, UNFL, WNORM
56 * ..
57 * .. External Functions ..
58 DOUBLE PRECISION DASUM, DLAMCH, DLANGE
59 EXTERNAL DASUM, DLAMCH, DLANGE
60 * ..
61 * .. External Subroutines ..
62 EXTERNAL DAXPY, DCOPY
63 * ..
64 * .. Intrinsic Functions ..
65 INTRINSIC DBLE, MAX, MIN
66 * ..
67 * .. Executable Statements ..
68 *
69 * Quick return if possible
70 *
71 IF( M.LE.0 .OR. N.LE.0 ) THEN
72 RESULT = ZERO
73 RETURN
74 END IF
75 *
76 UNFL = DLAMCH( 'Safe minimum' )
77 EPS = DLAMCH( 'Precision' )
78 *
79 WNORM = ZERO
80 DO 10 J = 1, N
81 CALL DCOPY( M, A( 1, J ), 1, WORK, 1 )
82 CALL DAXPY( M, -ONE, B( 1, J ), 1, WORK, 1 )
83 WNORM = MAX( WNORM, DASUM( N, WORK, 1 ) )
84 10 CONTINUE
85 *
86 ANORM = MAX( DLANGE( '1', M, N, A, LDA, WORK ), UNFL )
87 *
88 IF( ANORM.GT.WNORM ) THEN
89 RESULT = ( WNORM / ANORM ) / ( M*EPS )
90 ELSE
91 IF( ANORM.LT.ONE ) THEN
92 RESULT = ( MIN( WNORM, M*ANORM ) / ANORM ) / ( M*EPS )
93 ELSE
94 RESULT = MIN( WNORM / ANORM, DBLE( M ) ) / ( M*EPS )
95 END IF
96 END IF
97 *
98 RETURN
99 *
100 * End of DGET10
101 *
102 END