LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
cbdt02.f
Go to the documentation of this file.
1 *> \brief \b CBDT02
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 CBDT02( M, N, B, LDB, C, LDC, U, LDU, WORK, RWORK,
12 * RESID )
13 *
14 * .. Scalar Arguments ..
15 * INTEGER LDB, LDC, LDU, M, N
16 * REAL RESID
17 * ..
18 * .. Array Arguments ..
19 * REAL RWORK( * )
20 * COMPLEX B( LDB, * ), C( LDC, * ), U( LDU, * ),
21 * $ WORK( * )
22 * ..
23 *
24 *
25 *> \par Purpose:
26 * =============
27 *>
28 *> \verbatim
29 *>
30 *> CBDT02 tests the change of basis C = U' * B by computing the residual
31 *>
32 *> RESID = norm( B - U * C ) / ( max(m,n) * norm(B) * EPS ),
33 *>
34 *> where B and C are M by N matrices, U is an M by M orthogonal matrix,
35 *> and EPS is the machine precision.
36 *> \endverbatim
37 *
38 * Arguments:
39 * ==========
40 *
41 *> \param[in] M
42 *> \verbatim
43 *> M is INTEGER
44 *> The number of rows of the matrices B and C and the order of
45 *> the matrix Q.
46 *> \endverbatim
47 *>
48 *> \param[in] N
49 *> \verbatim
50 *> N is INTEGER
51 *> The number of columns of the matrices B and C.
52 *> \endverbatim
53 *>
54 *> \param[in] B
55 *> \verbatim
56 *> B is COMPLEX array, dimension (LDB,N)
57 *> The m by n matrix B.
58 *> \endverbatim
59 *>
60 *> \param[in] LDB
61 *> \verbatim
62 *> LDB is INTEGER
63 *> The leading dimension of the array B. LDB >= max(1,M).
64 *> \endverbatim
65 *>
66 *> \param[in] C
67 *> \verbatim
68 *> C is COMPLEX array, dimension (LDC,N)
69 *> The m by n matrix C, assumed to contain U' * B.
70 *> \endverbatim
71 *>
72 *> \param[in] LDC
73 *> \verbatim
74 *> LDC is INTEGER
75 *> The leading dimension of the array C. LDC >= max(1,M).
76 *> \endverbatim
77 *>
78 *> \param[in] U
79 *> \verbatim
80 *> U is COMPLEX array, dimension (LDU,M)
81 *> The m by m orthogonal matrix U.
82 *> \endverbatim
83 *>
84 *> \param[in] LDU
85 *> \verbatim
86 *> LDU is INTEGER
87 *> The leading dimension of the array U. LDU >= max(1,M).
88 *> \endverbatim
89 *>
90 *> \param[out] WORK
91 *> \verbatim
92 *> WORK is COMPLEX array, dimension (M)
93 *> \endverbatim
94 *>
95 *> \param[out] RWORK
96 *> \verbatim
97 *> RWORK is REAL array, dimension (M)
98 *> \endverbatim
99 *>
100 *> \param[out] RESID
101 *> \verbatim
102 *> RESID is REAL
103 *> RESID = norm( B - U * C ) / ( max(m,n) * norm(B) * EPS ),
104 *> \endverbatim
105 *
106 * Authors:
107 * ========
108 *
109 *> \author Univ. of Tennessee
110 *> \author Univ. of California Berkeley
111 *> \author Univ. of Colorado Denver
112 *> \author NAG Ltd.
113 *
114 *> \date November 2011
115 *
116 *> \ingroup complex_eig
117 *
118 * =====================================================================
119  SUBROUTINE cbdt02( M, N, B, LDB, C, LDC, U, LDU, WORK, RWORK,
120  $ resid )
121 *
122 * -- LAPACK test routine (version 3.4.0) --
123 * -- LAPACK is a software package provided by Univ. of Tennessee, --
124 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
125 * November 2011
126 *
127 * .. Scalar Arguments ..
128  INTEGER ldb, ldc, ldu, m, n
129  REAL resid
130 * ..
131 * .. Array Arguments ..
132  REAL rwork( * )
133  COMPLEX b( ldb, * ), c( ldc, * ), u( ldu, * ),
134  $ work( * )
135 * ..
136 *
137 * ======================================================================
138 *
139 * .. Parameters ..
140  REAL zero, one
141  parameter( zero = 0.0e+0, one = 1.0e+0 )
142 * ..
143 * .. Local Scalars ..
144  INTEGER j
145  REAL bnorm, eps, realmn
146 * ..
147 * .. External Functions ..
148  REAL clange, scasum, slamch
149  EXTERNAL clange, scasum, slamch
150 * ..
151 * .. External Subroutines ..
152  EXTERNAL ccopy, cgemv
153 * ..
154 * .. Intrinsic Functions ..
155  INTRINSIC cmplx, max, min, real
156 * ..
157 * .. Executable Statements ..
158 *
159 * Quick return if possible
160 *
161  resid = zero
162  IF( m.LE.0 .OR. n.LE.0 )
163  $ return
164  realmn = REAL( MAX( M, N ) )
165  eps = slamch( 'Precision' )
166 *
167 * Compute norm( B - U * C )
168 *
169  DO 10 j = 1, n
170  CALL ccopy( m, b( 1, j ), 1, work, 1 )
171  CALL cgemv( 'No transpose', m, m, -cmplx( one ), u, ldu,
172  $ c( 1, j ), 1, cmplx( one ), work, 1 )
173  resid = max( resid, scasum( m, work, 1 ) )
174  10 continue
175 *
176 * Compute norm of B.
177 *
178  bnorm = clange( '1', m, n, b, ldb, rwork )
179 *
180  IF( bnorm.LE.zero ) THEN
181  IF( resid.NE.zero )
182  $ resid = one / eps
183  ELSE
184  IF( bnorm.GE.resid ) THEN
185  resid = ( resid / bnorm ) / ( realmn*eps )
186  ELSE
187  IF( bnorm.LT.one ) THEN
188  resid = ( min( resid, realmn*bnorm ) / bnorm ) /
189  $ ( realmn*eps )
190  ELSE
191  resid = min( resid / bnorm, realmn ) / ( realmn*eps )
192  END IF
193  END IF
194  END IF
195  return
196 *
197 * End of CBDT02
198 *
199  END