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