LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
sget10.f
Go to the documentation of this file.
1 *> \brief \b SGET10
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE SGET10( M, N, A, LDA, B, LDB, WORK, RESULT )
12 *
13 * .. Scalar Arguments ..
14 * INTEGER LDA, LDB, M, N
15 * REAL RESULT
16 * ..
17 * .. Array Arguments ..
18 * REAL A( LDA, * ), B( LDB, * ), WORK( * )
19 * ..
20 *
21 *
22 *> \par Purpose:
23 * =============
24 *>
25 *> \verbatim
26 *>
27 *> SGET10 compares two matrices A and B and computes the ratio
28 *> RESULT = norm( A - B ) / ( norm(A) * M * EPS )
29 *> \endverbatim
30 *
31 * Arguments:
32 * ==========
33 *
34 *> \param[in] M
35 *> \verbatim
36 *> M is INTEGER
37 *> The number of rows of the matrices A and B.
38 *> \endverbatim
39 *>
40 *> \param[in] N
41 *> \verbatim
42 *> N is INTEGER
43 *> The number of columns of the matrices A and B.
44 *> \endverbatim
45 *>
46 *> \param[in] A
47 *> \verbatim
48 *> A is REAL array, dimension (LDA,N)
49 *> The m by n matrix A.
50 *> \endverbatim
51 *>
52 *> \param[in] LDA
53 *> \verbatim
54 *> LDA is INTEGER
55 *> The leading dimension of the array A. LDA >= max(1,M).
56 *> \endverbatim
57 *>
58 *> \param[in] B
59 *> \verbatim
60 *> B is REAL array, dimension (LDB,N)
61 *> The m by n matrix B.
62 *> \endverbatim
63 *>
64 *> \param[in] LDB
65 *> \verbatim
66 *> LDB is INTEGER
67 *> The leading dimension of the array B. LDB >= max(1,M).
68 *> \endverbatim
69 *>
70 *> \param[out] WORK
71 *> \verbatim
72 *> WORK is REAL array, dimension (M)
73 *> \endverbatim
74 *>
75 *> \param[out] RESULT
76 *> \verbatim
77 *> RESULT is REAL
78 *> RESULT = norm( A - B ) / ( norm(A) * M * EPS )
79 *> \endverbatim
80 *
81 * Authors:
82 * ========
83 *
84 *> \author Univ. of Tennessee
85 *> \author Univ. of California Berkeley
86 *> \author Univ. of Colorado Denver
87 *> \author NAG Ltd.
88 *
89 *> \date November 2011
90 *
91 *> \ingroup single_eig
92 *
93 * =====================================================================
94  SUBROUTINE sget10( M, N, A, LDA, B, LDB, WORK, RESULT )
95 *
96 * -- LAPACK test routine (version 3.4.0) --
97 * -- LAPACK is a software package provided by Univ. of Tennessee, --
98 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
99 * November 2011
100 *
101 * .. Scalar Arguments ..
102  INTEGER lda, ldb, m, n
103  REAL result
104 * ..
105 * .. Array Arguments ..
106  REAL a( lda, * ), b( ldb, * ), work( * )
107 * ..
108 *
109 * =====================================================================
110 *
111 * .. Parameters ..
112  REAL one, zero
113  parameter( one = 1.0e+0, zero = 0.0e+0 )
114 * ..
115 * .. Local Scalars ..
116  INTEGER j
117  REAL anorm, eps, unfl, wnorm
118 * ..
119 * .. External Functions ..
120  REAL sasum, slamch, slange
121  EXTERNAL sasum, slamch, slange
122 * ..
123 * .. External Subroutines ..
124  EXTERNAL saxpy, scopy
125 * ..
126 * .. Intrinsic Functions ..
127  INTRINSIC max, min, real
128 * ..
129 * .. Executable Statements ..
130 *
131 * Quick return if possible
132 *
133  IF( m.LE.0 .OR. n.LE.0 ) THEN
134  result = zero
135  RETURN
136  END IF
137 *
138  unfl = slamch( 'Safe minimum' )
139  eps = slamch( 'Precision' )
140 *
141  wnorm = zero
142  DO 10 j = 1, n
143  CALL scopy( m, a( 1, j ), 1, work, 1 )
144  CALL saxpy( m, -one, b( 1, j ), 1, work, 1 )
145  wnorm = max( wnorm, sasum( n, work, 1 ) )
146  10 CONTINUE
147 *
148  anorm = max( slange( '1', m, n, a, lda, work ), unfl )
149 *
150  IF( anorm.GT.wnorm ) THEN
151  result = ( wnorm / anorm ) / ( m*eps )
152  ELSE
153  IF( anorm.LT.one ) THEN
154  result = ( min( wnorm, m*anorm ) / anorm ) / ( m*eps )
155  ELSE
156  result = min( wnorm / anorm, REAL( M ) ) / ( m*eps )
157  END IF
158  END IF
159 *
160  RETURN
161 *
162 * End of SGET10
163 *
164  END