1*> \brief \b ZUNBDB3
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZUNBDB3 + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zunbdb3.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zunbdb3.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zunbdb3.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
22*                           TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO )
23*
24*       .. Scalar Arguments ..
25*       INTEGER            INFO, LWORK, M, P, Q, LDX11, LDX21
26*       ..
27*       .. Array Arguments ..
28*       DOUBLE PRECISION   PHI(*), THETA(*)
29*       COMPLEX*16         TAUP1(*), TAUP2(*), TAUQ1(*), WORK(*),
30*      $                   X11(LDX11,*), X21(LDX21,*)
31*       ..
32*
33*
34*> \par Purpose:
35*> =============
36*>
37*>\verbatim
38*>
39*> ZUNBDB3 simultaneously bidiagonalizes the blocks of a tall and skinny
40*> matrix X with orthonomal columns:
41*>
42*>                            [ B11 ]
43*>      [ X11 ]   [ P1 |    ] [  0  ]
44*>      [-----] = [---------] [-----] Q1**T .
45*>      [ X21 ]   [    | P2 ] [ B21 ]
46*>                            [  0  ]
47*>
48*> X11 is P-by-Q, and X21 is (M-P)-by-Q. M-P must be no larger than P,
49*> Q, or M-Q. Routines ZUNBDB1, ZUNBDB2, and ZUNBDB4 handle cases in
50*> which M-P is not the minimum dimension.
51*>
52*> The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P),
53*> and (M-Q)-by-(M-Q), respectively. They are represented implicitly by
54*> Householder vectors.
55*>
56*> B11 and B12 are (M-P)-by-(M-P) bidiagonal matrices represented
57*> implicitly by angles THETA, PHI.
58*>
59*>\endverbatim
60*
61*  Arguments:
62*  ==========
63*
64*> \param[in] M
65*> \verbatim
66*>          M is INTEGER
67*>           The number of rows X11 plus the number of rows in X21.
68*> \endverbatim
69*>
70*> \param[in] P
71*> \verbatim
72*>          P is INTEGER
73*>           The number of rows in X11. 0 <= P <= M. M-P <= min(P,Q,M-Q).
74*> \endverbatim
75*>
76*> \param[in] Q
77*> \verbatim
78*>          Q is INTEGER
79*>           The number of columns in X11 and X21. 0 <= Q <= M.
80*> \endverbatim
81*>
82*> \param[in,out] X11
83*> \verbatim
84*>          X11 is COMPLEX*16 array, dimension (LDX11,Q)
85*>           On entry, the top block of the matrix X to be reduced. On
86*>           exit, the columns of tril(X11) specify reflectors for P1 and
87*>           the rows of triu(X11,1) specify reflectors for Q1.
88*> \endverbatim
89*>
90*> \param[in] LDX11
91*> \verbatim
92*>          LDX11 is INTEGER
93*>           The leading dimension of X11. LDX11 >= P.
94*> \endverbatim
95*>
96*> \param[in,out] X21
97*> \verbatim
98*>          X21 is COMPLEX*16 array, dimension (LDX21,Q)
99*>           On entry, the bottom block of the matrix X to be reduced. On
100*>           exit, the columns of tril(X21) specify reflectors for P2.
101*> \endverbatim
102*>
103*> \param[in] LDX21
104*> \verbatim
105*>          LDX21 is INTEGER
106*>           The leading dimension of X21. LDX21 >= M-P.
107*> \endverbatim
108*>
109*> \param[out] THETA
110*> \verbatim
111*>          THETA is DOUBLE PRECISION array, dimension (Q)
112*>           The entries of the bidiagonal blocks B11, B21 are defined by
113*>           THETA and PHI. See Further Details.
114*> \endverbatim
115*>
116*> \param[out] PHI
117*> \verbatim
118*>          PHI is DOUBLE PRECISION array, dimension (Q-1)
119*>           The entries of the bidiagonal blocks B11, B21 are defined by
120*>           THETA and PHI. See Further Details.
121*> \endverbatim
122*>
123*> \param[out] TAUP1
124*> \verbatim
125*>          TAUP1 is COMPLEX*16 array, dimension (P)
126*>           The scalar factors of the elementary reflectors that define
127*>           P1.
128*> \endverbatim
129*>
130*> \param[out] TAUP2
131*> \verbatim
132*>          TAUP2 is COMPLEX*16 array, dimension (M-P)
133*>           The scalar factors of the elementary reflectors that define
134*>           P2.
135*> \endverbatim
136*>
137*> \param[out] TAUQ1
138*> \verbatim
139*>          TAUQ1 is COMPLEX*16 array, dimension (Q)
140*>           The scalar factors of the elementary reflectors that define
141*>           Q1.
142*> \endverbatim
143*>
144*> \param[out] WORK
145*> \verbatim
146*>          WORK is COMPLEX*16 array, dimension (LWORK)
147*> \endverbatim
148*>
149*> \param[in] LWORK
150*> \verbatim
151*>          LWORK is INTEGER
152*>           The dimension of the array WORK. LWORK >= M-Q.
153*>
154*>           If LWORK = -1, then a workspace query is assumed; the routine
155*>           only calculates the optimal size of the WORK array, returns
156*>           this value as the first entry of the WORK array, and no error
157*>           message related to LWORK is issued by XERBLA.
158*> \endverbatim
159*>
160*> \param[out] INFO
161*> \verbatim
162*>          INFO is INTEGER
163*>           = 0:  successful exit.
164*>           < 0:  if INFO = -i, the i-th argument had an illegal value.
165*> \endverbatim
166*
167*  Authors:
168*  ========
169*
170*> \author Univ. of Tennessee
171*> \author Univ. of California Berkeley
172*> \author Univ. of Colorado Denver
173*> \author NAG Ltd.
174*
175*> \date July 2012
176*
177*> \ingroup complex16OTHERcomputational
178*
179*> \par Further Details:
180*  =====================
181*>
182*> \verbatim
183*>
184*>  The upper-bidiagonal blocks B11, B21 are represented implicitly by
185*>  angles THETA(1), ..., THETA(Q) and PHI(1), ..., PHI(Q-1). Every entry
186*>  in each bidiagonal band is a product of a sine or cosine of a THETA
187*>  with a sine or cosine of a PHI. See [1] or ZUNCSD for details.
188*>
189*>  P1, P2, and Q1 are represented as products of elementary reflectors.
190*>  See ZUNCSD2BY1 for details on generating P1, P2, and Q1 using ZUNGQR
191*>  and ZUNGLQ.
192*> \endverbatim
193*
194*> \par References:
195*  ================
196*>
197*>  [1] Brian D. Sutton. Computing the complete CS decomposition. Numer.
198*>      Algorithms, 50(1):33-65, 2009.
199*>
200*  =====================================================================
201      SUBROUTINE ZUNBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
202     $                    TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO )
203*
204*  -- LAPACK computational routine (version 3.5.0) --
205*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
206*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
207*     July 2012
208*
209*     .. Scalar Arguments ..
210      INTEGER            INFO, LWORK, M, P, Q, LDX11, LDX21
211*     ..
212*     .. Array Arguments ..
213      DOUBLE PRECISION   PHI(*), THETA(*)
214      COMPLEX*16         TAUP1(*), TAUP2(*), TAUQ1(*), WORK(*),
215     $                   X11(LDX11,*), X21(LDX21,*)
216*     ..
217*
218*  ====================================================================
219*
220*     .. Parameters ..
221      COMPLEX*16         ONE
222      PARAMETER          ( ONE = (1.0D0,0.0D0) )
223*     ..
224*     .. Local Scalars ..
225      DOUBLE PRECISION   C, S
226      INTEGER            CHILDINFO, I, ILARF, IORBDB5, LLARF, LORBDB5,
227     $                   LWORKMIN, LWORKOPT
228      LOGICAL            LQUERY
229*     ..
230*     .. External Subroutines ..
231      EXTERNAL           ZLARF, ZLARFGP, ZUNBDB5, ZDROT, XERBLA
232*     ..
233*     .. External Functions ..
234      DOUBLE PRECISION   DZNRM2
235      EXTERNAL           DZNRM2
236*     ..
237*     .. Intrinsic Function ..
238      INTRINSIC          ATAN2, COS, MAX, SIN, SQRT
239*     ..
240*     .. Executable Statements ..
241*
242*     Test input arguments
243*
244      INFO = 0
245      LQUERY = LWORK .EQ. -1
246*
247      IF( M .LT. 0 ) THEN
248         INFO = -1
249      ELSE IF( 2*P .LT. M .OR. P .GT. M ) THEN
250         INFO = -2
251      ELSE IF( Q .LT. M-P .OR. M-Q .LT. M-P ) THEN
252         INFO = -3
253      ELSE IF( LDX11 .LT. MAX( 1, P ) ) THEN
254         INFO = -5
255      ELSE IF( LDX21 .LT. MAX( 1, M-P ) ) THEN
256         INFO = -7
257      END IF
258*
259*     Compute workspace
260*
261      IF( INFO .EQ. 0 ) THEN
262         ILARF = 2
263         LLARF = MAX( P, M-P-1, Q-1 )
264         IORBDB5 = 2
265         LORBDB5 = Q-1
266         LWORKOPT = MAX( ILARF+LLARF-1, IORBDB5+LORBDB5-1 )
267         LWORKMIN = LWORKOPT
268         WORK(1) = LWORKOPT
269         IF( LWORK .LT. LWORKMIN .AND. .NOT.LQUERY ) THEN
270           INFO = -14
271         END IF
272      END IF
273      IF( INFO .NE. 0 ) THEN
274         CALL XERBLA( 'ZUNBDB3', -INFO )
275         RETURN
276      ELSE IF( LQUERY ) THEN
277         RETURN
278      END IF
279*
280*     Reduce rows 1, ..., M-P of X11 and X21
281*
282      DO I = 1, M-P
283*
284         IF( I .GT. 1 ) THEN
285            CALL ZDROT( Q-I+1, X11(I-1,I), LDX11, X21(I,I), LDX11, C,
286     $                  S )
287         END IF
288*
289         CALL ZLACGV( Q-I+1, X21(I,I), LDX21 )
290         CALL ZLARFGP( Q-I+1, X21(I,I), X21(I,I+1), LDX21, TAUQ1(I) )
291         S = DBLE( X21(I,I) )
292         X21(I,I) = ONE
293         CALL ZLARF( 'R', P-I+1, Q-I+1, X21(I,I), LDX21, TAUQ1(I),
294     $               X11(I,I), LDX11, WORK(ILARF) )
295         CALL ZLARF( 'R', M-P-I, Q-I+1, X21(I,I), LDX21, TAUQ1(I),
296     $               X21(I+1,I), LDX21, WORK(ILARF) )
297         CALL ZLACGV( Q-I+1, X21(I,I), LDX21 )
298         C = SQRT( DZNRM2( P-I+1, X11(I,I), 1, X11(I,I),
299     $       1 )**2 + DZNRM2( M-P-I, X21(I+1,I), 1, X21(I+1,I), 1 )**2 )
300         THETA(I) = ATAN2( S, C )
301*
302         CALL ZUNBDB5( P-I+1, M-P-I, Q-I, X11(I,I), 1, X21(I+1,I), 1,
303     $                 X11(I,I+1), LDX11, X21(I+1,I+1), LDX21,
304     $                 WORK(IORBDB5), LORBDB5, CHILDINFO )
305         CALL ZLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )
306         IF( I .LT. M-P ) THEN
307            CALL ZLARFGP( M-P-I, X21(I+1,I), X21(I+2,I), 1, TAUP2(I) )
308            PHI(I) = ATAN2( DBLE( X21(I+1,I) ), DBLE( X11(I,I) ) )
309            C = COS( PHI(I) )
310            S = SIN( PHI(I) )
311            X21(I+1,I) = ONE
312            CALL ZLARF( 'L', M-P-I, Q-I, X21(I+1,I), 1,
313     $                  DCONJG(TAUP2(I)), X21(I+1,I+1), LDX21,
314     $                  WORK(ILARF) )
315         END IF
316         X11(I,I) = ONE
317         CALL ZLARF( 'L', P-I+1, Q-I, X11(I,I), 1, DCONJG(TAUP1(I)),
318     $               X11(I,I+1), LDX11, WORK(ILARF) )
319*
320      END DO
321*
322*     Reduce the bottom-right portion of X11 to the identity matrix
323*
324      DO I = M-P + 1, Q
325         CALL ZLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )
326         X11(I,I) = ONE
327         CALL ZLARF( 'L', P-I+1, Q-I, X11(I,I), 1, DCONJG(TAUP1(I)),
328     $               X11(I,I+1), LDX11, WORK(ILARF) )
329      END DO
330*
331      RETURN
332*
333*     End of ZUNBDB3
334*
335      END
336
337