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