1*> \brief \b CUNT03
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 CUNT03( RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK,
12*                          RWORK, RESULT, INFO )
13*
14*       .. Scalar Arguments ..
15*       CHARACTER*( * )    RC
16*       INTEGER            INFO, K, LDU, LDV, LWORK, MU, MV, N
17*       REAL               RESULT
18*       ..
19*       .. Array Arguments ..
20*       REAL               RWORK( * )
21*       COMPLEX            U( LDU, * ), V( LDV, * ), WORK( * )
22*       ..
23*
24*
25*> \par Purpose:
26*  =============
27*>
28*> \verbatim
29*>
30*> CUNT03 compares two unitary matrices U and V to see if their
31*> corresponding rows or columns span the same spaces.  The rows are
32*> checked if RC = 'R', and the columns are checked if RC = 'C'.
33*>
34*> RESULT is the maximum of
35*>
36*>    | V*V' - I | / ( MV ulp ), if RC = 'R', or
37*>
38*>    | V'*V - I | / ( MV ulp ), if RC = 'C',
39*>
40*> and the maximum over rows (or columns) 1 to K of
41*>
42*>    | U(i) - S*V(i) |/ ( N ulp )
43*>
44*> where abs(S) = 1 (chosen to minimize the expression), U(i) is the
45*> i-th row (column) of U, and V(i) is the i-th row (column) of V.
46*> \endverbatim
47*
48*  Arguments:
49*  ==========
50*
51*> \param[in] RC
52*> \verbatim
53*>          RC is CHARACTER*1
54*>          If RC = 'R' the rows of U and V are to be compared.
55*>          If RC = 'C' the columns of U and V are to be compared.
56*> \endverbatim
57*>
58*> \param[in] MU
59*> \verbatim
60*>          MU is INTEGER
61*>          The number of rows of U if RC = 'R', and the number of
62*>          columns if RC = 'C'.  If MU = 0 CUNT03 does nothing.
63*>          MU must be at least zero.
64*> \endverbatim
65*>
66*> \param[in] MV
67*> \verbatim
68*>          MV is INTEGER
69*>          The number of rows of V if RC = 'R', and the number of
70*>          columns if RC = 'C'.  If MV = 0 CUNT03 does nothing.
71*>          MV must be at least zero.
72*> \endverbatim
73*>
74*> \param[in] N
75*> \verbatim
76*>          N is INTEGER
77*>          If RC = 'R', the number of columns in the matrices U and V,
78*>          and if RC = 'C', the number of rows in U and V.  If N = 0
79*>          CUNT03 does nothing.  N must be at least zero.
80*> \endverbatim
81*>
82*> \param[in] K
83*> \verbatim
84*>          K is INTEGER
85*>          The number of rows or columns of U and V to compare.
86*>          0 <= K <= max(MU,MV).
87*> \endverbatim
88*>
89*> \param[in] U
90*> \verbatim
91*>          U is COMPLEX array, dimension (LDU,N)
92*>          The first matrix to compare.  If RC = 'R', U is MU by N, and
93*>          if RC = 'C', U is N by MU.
94*> \endverbatim
95*>
96*> \param[in] LDU
97*> \verbatim
98*>          LDU is INTEGER
99*>          The leading dimension of U.  If RC = 'R', LDU >= max(1,MU),
100*>          and if RC = 'C', LDU >= max(1,N).
101*> \endverbatim
102*>
103*> \param[in] V
104*> \verbatim
105*>          V is COMPLEX array, dimension (LDV,N)
106*>          The second matrix to compare.  If RC = 'R', V is MV by N, and
107*>          if RC = 'C', V is N by MV.
108*> \endverbatim
109*>
110*> \param[in] LDV
111*> \verbatim
112*>          LDV is INTEGER
113*>          The leading dimension of V.  If RC = 'R', LDV >= max(1,MV),
114*>          and if RC = 'C', LDV >= max(1,N).
115*> \endverbatim
116*>
117*> \param[out] WORK
118*> \verbatim
119*>          WORK is COMPLEX array, dimension (LWORK)
120*> \endverbatim
121*>
122*> \param[in] LWORK
123*> \verbatim
124*>          LWORK is INTEGER
125*>          The length of the array WORK.  For best performance, LWORK
126*>          should be at least N*N if RC = 'C' or M*M if RC = 'R', but
127*>          the tests will be done even if LWORK is 0.
128*> \endverbatim
129*>
130*> \param[out] RWORK
131*> \verbatim
132*>          RWORK is REAL array, dimension (max(MV,N))
133*> \endverbatim
134*>
135*> \param[out] RESULT
136*> \verbatim
137*>          RESULT is REAL
138*>          The value computed by the test described above.  RESULT is
139*>          limited to 1/ulp to avoid overflow.
140*> \endverbatim
141*>
142*> \param[out] INFO
143*> \verbatim
144*>          INFO is INTEGER
145*>          0  indicates a successful exit
146*>          -k indicates the k-th parameter had an illegal value
147*> \endverbatim
148*
149*  Authors:
150*  ========
151*
152*> \author Univ. of Tennessee
153*> \author Univ. of California Berkeley
154*> \author Univ. of Colorado Denver
155*> \author NAG Ltd.
156*
157*> \ingroup complex_eig
158*
159*  =====================================================================
160      SUBROUTINE CUNT03( RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK,
161     $                   RWORK, RESULT, INFO )
162*
163*  -- LAPACK test routine --
164*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
165*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
166*
167*     .. Scalar Arguments ..
168      CHARACTER*( * )    RC
169      INTEGER            INFO, K, LDU, LDV, LWORK, MU, MV, N
170      REAL               RESULT
171*     ..
172*     .. Array Arguments ..
173      REAL               RWORK( * )
174      COMPLEX            U( LDU, * ), V( LDV, * ), WORK( * )
175*     ..
176*
177*  =====================================================================
178*
179*
180*     .. Parameters ..
181      REAL               ZERO, ONE
182      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
183*     ..
184*     .. Local Scalars ..
185      INTEGER            I, IRC, J, LMX
186      REAL               RES1, RES2, ULP
187      COMPLEX            S, SU, SV
188*     ..
189*     .. External Functions ..
190      LOGICAL            LSAME
191      INTEGER            ICAMAX
192      REAL               SLAMCH
193      EXTERNAL           LSAME, ICAMAX, SLAMCH
194*     ..
195*     .. Intrinsic Functions ..
196      INTRINSIC          ABS, CMPLX, MAX, MIN, REAL
197*     ..
198*     .. External Subroutines ..
199      EXTERNAL           CUNT01, XERBLA
200*     ..
201*     .. Executable Statements ..
202*
203*     Check inputs
204*
205      INFO = 0
206      IF( LSAME( RC, 'R' ) ) THEN
207         IRC = 0
208      ELSE IF( LSAME( RC, 'C' ) ) THEN
209         IRC = 1
210      ELSE
211         IRC = -1
212      END IF
213      IF( IRC.EQ.-1 ) THEN
214         INFO = -1
215      ELSE IF( MU.LT.0 ) THEN
216         INFO = -2
217      ELSE IF( MV.LT.0 ) THEN
218         INFO = -3
219      ELSE IF( N.LT.0 ) THEN
220         INFO = -4
221      ELSE IF( K.LT.0 .OR. K.GT.MAX( MU, MV ) ) THEN
222         INFO = -5
223      ELSE IF( ( IRC.EQ.0 .AND. LDU.LT.MAX( 1, MU ) ) .OR.
224     $         ( IRC.EQ.1 .AND. LDU.LT.MAX( 1, N ) ) ) THEN
225         INFO = -7
226      ELSE IF( ( IRC.EQ.0 .AND. LDV.LT.MAX( 1, MV ) ) .OR.
227     $         ( IRC.EQ.1 .AND. LDV.LT.MAX( 1, N ) ) ) THEN
228         INFO = -9
229      END IF
230      IF( INFO.NE.0 ) THEN
231         CALL XERBLA( 'CUNT03', -INFO )
232         RETURN
233      END IF
234*
235*     Initialize result
236*
237      RESULT = ZERO
238      IF( MU.EQ.0 .OR. MV.EQ.0 .OR. N.EQ.0 )
239     $   RETURN
240*
241*     Machine constants
242*
243      ULP = SLAMCH( 'Precision' )
244*
245      IF( IRC.EQ.0 ) THEN
246*
247*        Compare rows
248*
249         RES1 = ZERO
250         DO 20 I = 1, K
251            LMX = ICAMAX( N, U( I, 1 ), LDU )
252            IF( V( I, LMX ).EQ.CMPLX( ZERO ) ) THEN
253               SV = ONE
254            ELSE
255               SV = ABS( V( I, LMX ) ) / V( I, LMX )
256            END IF
257            IF( U( I, LMX ).EQ.CMPLX( ZERO ) ) THEN
258               SU = ONE
259            ELSE
260               SU = ABS( U( I, LMX ) ) / U( I, LMX )
261            END IF
262            S = SV / SU
263            DO 10 J = 1, N
264               RES1 = MAX( RES1, ABS( U( I, J )-S*V( I, J ) ) )
265   10       CONTINUE
266   20    CONTINUE
267         RES1 = RES1 / ( REAL( N )*ULP )
268*
269*        Compute orthogonality of rows of V.
270*
271         CALL CUNT01( 'Rows', MV, N, V, LDV, WORK, LWORK, RWORK, RES2 )
272*
273      ELSE
274*
275*        Compare columns
276*
277         RES1 = ZERO
278         DO 40 I = 1, K
279            LMX = ICAMAX( N, U( 1, I ), 1 )
280            IF( V( LMX, I ).EQ.CMPLX( ZERO ) ) THEN
281               SV = ONE
282            ELSE
283               SV = ABS( V( LMX, I ) ) / V( LMX, I )
284            END IF
285            IF( U( LMX, I ).EQ.CMPLX( ZERO ) ) THEN
286               SU = ONE
287            ELSE
288               SU = ABS( U( LMX, I ) ) / U( LMX, I )
289            END IF
290            S = SV / SU
291            DO 30 J = 1, N
292               RES1 = MAX( RES1, ABS( U( J, I )-S*V( J, I ) ) )
293   30       CONTINUE
294   40    CONTINUE
295         RES1 = RES1 / ( REAL( N )*ULP )
296*
297*        Compute orthogonality of columns of V.
298*
299         CALL CUNT01( 'Columns', N, MV, V, LDV, WORK, LWORK, RWORK,
300     $                RES2 )
301      END IF
302*
303      RESULT = MIN( MAX( RES1, RES2 ), ONE / ULP )
304      RETURN
305*
306*     End of CUNT03
307*
308      END
309