1*> \brief \b ZBDT02
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 ZBDT02( M, N, B, LDB, C, LDC, U, LDU, WORK, RWORK,
12*                          RESID )
13*
14*       .. Scalar Arguments ..
15*       INTEGER            LDB, LDC, LDU, M, N
16*       DOUBLE PRECISION   RESID
17*       ..
18*       .. Array Arguments ..
19*       DOUBLE PRECISION   RWORK( * )
20*       COMPLEX*16         B( LDB, * ), C( LDC, * ), U( LDU, * ),
21*      $                   WORK( * )
22*       ..
23*
24*
25*> \par Purpose:
26*  =============
27*>
28*> \verbatim
29*>
30*> ZBDT02 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*16 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*16 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*16 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*16 array, dimension (M)
94*> \endverbatim
95*>
96*> \param[out] RWORK
97*> \verbatim
98*>          RWORK is DOUBLE PRECISION array, dimension (M)
99*> \endverbatim
100*>
101*> \param[out] RESID
102*> \verbatim
103*>          RESID is DOUBLE PRECISION
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 complex16_eig
116*
117*  =====================================================================
118      SUBROUTINE ZBDT02( 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      DOUBLE PRECISION   RESID
128*     ..
129*     .. Array Arguments ..
130      DOUBLE PRECISION   RWORK( * )
131      COMPLEX*16         B( LDB, * ), C( LDC, * ), U( LDU, * ),
132     $                   WORK( * )
133*     ..
134*
135* ======================================================================
136*
137*     .. Parameters ..
138      DOUBLE PRECISION   ZERO, ONE
139      PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
140*     ..
141*     .. Local Scalars ..
142      INTEGER            J
143      DOUBLE PRECISION   BNORM, EPS, REALMN
144*     ..
145*     .. External Functions ..
146      DOUBLE PRECISION   DLAMCH, DZASUM, ZLANGE
147      EXTERNAL           DLAMCH, DZASUM, ZLANGE
148*     ..
149*     .. External Subroutines ..
150      EXTERNAL           ZCOPY, ZGEMV
151*     ..
152*     .. Intrinsic Functions ..
153      INTRINSIC          DBLE, DCMPLX, MAX, MIN
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 = DBLE( MAX( M, N ) )
163      EPS = DLAMCH( 'Precision' )
164*
165*     Compute norm(B - U * C)
166*
167      DO 10 J = 1, N
168         CALL ZCOPY( M, B( 1, J ), 1, WORK, 1 )
169         CALL ZGEMV( 'No transpose', M, M, -DCMPLX( ONE ), U, LDU,
170     $               C( 1, J ), 1, DCMPLX( ONE ), WORK, 1 )
171         RESID = MAX( RESID, DZASUM( M, WORK, 1 ) )
172   10 CONTINUE
173*
174*     Compute norm of B.
175*
176      BNORM = ZLANGE( '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 ZBDT02
196*
197      END
198