OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dget10.f
Go to the documentation of this file.
1*> \brief \b DGET10
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 DGET10( M, N, A, LDA, B, LDB, WORK, RESULT )
12*
13* .. Scalar Arguments ..
14* INTEGER LDA, LDB, M, N
15* DOUBLE PRECISION RESULT
16* ..
17* .. Array Arguments ..
18* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
19* ..
20*
21*
22*> \par Purpose:
23* =============
24*>
25*> \verbatim
26*>
27*> DGET10 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION array, dimension (M)
73*> \endverbatim
74*>
75*> \param[out] RESULT
76*> \verbatim
77*> RESULT is DOUBLE PRECISION
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*> \ingroup double_eig
90*
91* =====================================================================
92 SUBROUTINE dget10( M, N, A, LDA, B, LDB, WORK, RESULT )
93*
94* -- LAPACK test routine --
95* -- LAPACK is a software package provided by Univ. of Tennessee, --
96* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
97*
98* .. Scalar Arguments ..
99 INTEGER LDA, LDB, M, N
100 DOUBLE PRECISION RESULT
101* ..
102* .. Array Arguments ..
103 DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
104* ..
105*
106* =====================================================================
107*
108* .. Parameters ..
109 DOUBLE PRECISION ONE, ZERO
110 parameter( one = 1.0d+0, zero = 0.0d+0 )
111* ..
112* .. Local Scalars ..
113 INTEGER J
114 DOUBLE PRECISION ANORM, EPS, UNFL, WNORM
115* ..
116* .. External Functions ..
117 DOUBLE PRECISION DASUM, DLAMCH, DLANGE
118 EXTERNAL dasum, dlamch, dlange
119* ..
120* .. External Subroutines ..
121 EXTERNAL daxpy, dcopy
122* ..
123* .. Intrinsic Functions ..
124 INTRINSIC dble, max, min
125* ..
126* .. Executable Statements ..
127*
128* Quick return if possible
129*
130 IF( m.LE.0 .OR. n.LE.0 ) THEN
131 result = zero
132 RETURN
133 END IF
134*
135 unfl = dlamch( 'safe minimum' )
136 EPS = DLAMCH( 'precision' )
137*
138 WNORM = ZERO
139 DO 10 J = 1, N
140 CALL DCOPY( M, A( 1, J ), 1, WORK, 1 )
141 CALL DAXPY( M, -ONE, B( 1, J ), 1, WORK, 1 )
142 WNORM = MAX( WNORM, DASUM( N, WORK, 1 ) )
143 10 CONTINUE
144*
145 ANORM = MAX( DLANGE( '1', M, N, A, LDA, WORK ), UNFL )
146*
147.GT. IF( ANORMWNORM ) THEN
148 RESULT = ( WNORM / ANORM ) / ( M*EPS )
149 ELSE
150.LT. IF( ANORMONE ) THEN
151 RESULT = ( MIN( WNORM, M*ANORM ) / ANORM ) / ( M*EPS )
152 ELSE
153 RESULT = MIN( WNORM / ANORM, DBLE( M ) ) / ( M*EPS )
154 END IF
155 END IF
156*
157 RETURN
158*
159* End of DGET10
160*
161 END
subroutine daxpy(n, da, dx, incx, dy, incy)
DAXPY
Definition daxpy.f:89
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY
Definition dcopy.f:82
subroutine dget10(m, n, a, lda, b, ldb, work, result)
DGET10
Definition dget10.f:93
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21