LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
zunbdb1.f
Go to the documentation of this file.
1 *> \brief \b ZUNBDB1
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download ZUNBDB1 + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zunbdb1.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zunbdb1.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zunbdb1.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE ZUNBDB1( 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 *> ZUNBDB1 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. Q must be no larger than P,
49 *> M-P, or M-Q. Routines ZUNBDB2, ZUNBDB3, and ZUNBDB4 handle cases in
50 *> which Q 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 Q-by-Q bidiagonal matrices represented implicitly by
57 *> 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.
74 *> \endverbatim
75 *>
76 *> \param[in] Q
77 *> \verbatim
78 *> Q is INTEGER
79 *> The number of columns in X11 and X21. 0 <= Q <=
80 *> MIN(P,M-P,M-Q).
81 *> \endverbatim
82 *>
83 *> \param[in,out] X11
84 *> \verbatim
85 *> X11 is COMPLEX*16 array, dimension (LDX11,Q)
86 *> On entry, the top block of the matrix X to be reduced. On
87 *> exit, the columns of tril(X11) specify reflectors for P1 and
88 *> the rows of triu(X11,1) specify reflectors for Q1.
89 *> \endverbatim
90 *>
91 *> \param[in] LDX11
92 *> \verbatim
93 *> LDX11 is INTEGER
94 *> The leading dimension of X11. LDX11 >= P.
95 *> \endverbatim
96 *>
97 *> \param[in,out] X21
98 *> \verbatim
99 *> X21 is COMPLEX*16 array, dimension (LDX21,Q)
100 *> On entry, the bottom block of the matrix X to be reduced. On
101 *> exit, the columns of tril(X21) specify reflectors for P2.
102 *> \endverbatim
103 *>
104 *> \param[in] LDX21
105 *> \verbatim
106 *> LDX21 is INTEGER
107 *> The leading dimension of X21. LDX21 >= M-P.
108 *> \endverbatim
109 *>
110 *> \param[out] THETA
111 *> \verbatim
112 *> THETA is DOUBLE PRECISION array, dimension (Q)
113 *> The entries of the bidiagonal blocks B11, B21 are defined by
114 *> THETA and PHI. See Further Details.
115 *> \endverbatim
116 *>
117 *> \param[out] PHI
118 *> \verbatim
119 *> PHI is DOUBLE PRECISION array, dimension (Q-1)
120 *> The entries of the bidiagonal blocks B11, B21 are defined by
121 *> THETA and PHI. See Further Details.
122 *> \endverbatim
123 *>
124 *> \param[out] TAUP1
125 *> \verbatim
126 *> TAUP1 is COMPLEX*16 array, dimension (P)
127 *> The scalar factors of the elementary reflectors that define
128 *> P1.
129 *> \endverbatim
130 *>
131 *> \param[out] TAUP2
132 *> \verbatim
133 *> TAUP2 is COMPLEX*16 array, dimension (M-P)
134 *> The scalar factors of the elementary reflectors that define
135 *> P2.
136 *> \endverbatim
137 *>
138 *> \param[out] TAUQ1
139 *> \verbatim
140 *> TAUQ1 is COMPLEX*16 array, dimension (Q)
141 *> The scalar factors of the elementary reflectors that define
142 *> Q1.
143 *> \endverbatim
144 *>
145 *> \param[out] WORK
146 *> \verbatim
147 *> WORK is COMPLEX*16 array, dimension (LWORK)
148 *> \endverbatim
149 *>
150 *> \param[in] LWORK
151 *> \verbatim
152 *> LWORK is INTEGER
153 *> The dimension of the array WORK. LWORK >= M-Q.
154 *>
155 *> If LWORK = -1, then a workspace query is assumed; the routine
156 *> only calculates the optimal size of the WORK array, returns
157 *> this value as the first entry of the WORK array, and no error
158 *> message related to LWORK is issued by XERBLA.
159 *> \endverbatim
160 *>
161 *> \param[out] INFO
162 *> \verbatim
163 *> INFO is INTEGER
164 *> = 0: successful exit.
165 *> < 0: if INFO = -i, the i-th argument had an illegal value.
166 *> \endverbatim
167 *>
168 *
169 * Authors:
170 * ========
171 *
172 *> \author Univ. of Tennessee
173 *> \author Univ. of California Berkeley
174 *> \author Univ. of Colorado Denver
175 *> \author NAG Ltd.
176 *
177 *> \date July 2012
178 *
179 *> \ingroup complex16OTHERcomputational
180 *
181 *> \par Further Details:
182 * =====================
183 *>
184 *> \verbatim
185 *>
186 *> The upper-bidiagonal blocks B11, B21 are represented implicitly by
187 *> angles THETA(1), ..., THETA(Q) and PHI(1), ..., PHI(Q-1). Every entry
188 *> in each bidiagonal band is a product of a sine or cosine of a THETA
189 *> with a sine or cosine of a PHI. See [1] or ZUNCSD for details.
190 *>
191 *> P1, P2, and Q1 are represented as products of elementary reflectors.
192 *> See ZUNCSD2BY1 for details on generating P1, P2, and Q1 using ZUNGQR
193 *> and ZUNGLQ.
194 *> \endverbatim
195 *
196 *> \par References:
197 * ================
198 *>
199 *> [1] Brian D. Sutton. Computing the complete CS decomposition. Numer.
200 *> Algorithms, 50(1):33-65, 2009.
201 *>
202 * =====================================================================
203  SUBROUTINE zunbdb1( M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI,
204  $ taup1, taup2, tauq1, work, lwork, info )
205 *
206 * -- LAPACK computational routine (version 3.6.1) --
207 * -- LAPACK is a software package provided by Univ. of Tennessee, --
208 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
209 * July 2012
210 *
211 * .. Scalar Arguments ..
212  INTEGER INFO, LWORK, M, P, Q, LDX11, LDX21
213 * ..
214 * .. Array Arguments ..
215  DOUBLE PRECISION PHI(*), THETA(*)
216  COMPLEX*16 TAUP1(*), TAUP2(*), TAUQ1(*), WORK(*),
217  $ x11(ldx11,*), x21(ldx21,*)
218 * ..
219 *
220 * ====================================================================
221 *
222 * .. Parameters ..
223  COMPLEX*16 ONE
224  parameter ( one = (1.0d0,0.0d0) )
225 * ..
226 * .. Local Scalars ..
227  DOUBLE PRECISION C, S
228  INTEGER CHILDINFO, I, ILARF, IORBDB5, LLARF, LORBDB5,
229  $ lworkmin, lworkopt
230  LOGICAL LQUERY
231 * ..
232 * .. External Subroutines ..
233  EXTERNAL zlarf, zlarfgp, zunbdb5, zdrot, xerbla
234  EXTERNAL zlacgv
235 * ..
236 * .. External Functions ..
237  DOUBLE PRECISION DZNRM2
238  EXTERNAL dznrm2
239 * ..
240 * .. Intrinsic Function ..
241  INTRINSIC atan2, cos, max, sin, sqrt
242 * ..
243 * .. Executable Statements ..
244 *
245 * Test input arguments
246 *
247  info = 0
248  lquery = lwork .EQ. -1
249 *
250  IF( m .LT. 0 ) THEN
251  info = -1
252  ELSE IF( p .LT. q .OR. m-p .LT. q ) THEN
253  info = -2
254  ELSE IF( q .LT. 0 .OR. m-q .LT. q ) THEN
255  info = -3
256  ELSE IF( ldx11 .LT. max( 1, p ) ) THEN
257  info = -5
258  ELSE IF( ldx21 .LT. max( 1, m-p ) ) THEN
259  info = -7
260  END IF
261 *
262 * Compute workspace
263 *
264  IF( info .EQ. 0 ) THEN
265  ilarf = 2
266  llarf = max( p-1, m-p-1, q-1 )
267  iorbdb5 = 2
268  lorbdb5 = q-2
269  lworkopt = max( ilarf+llarf-1, iorbdb5+lorbdb5-1 )
270  lworkmin = lworkopt
271  work(1) = lworkopt
272  IF( lwork .LT. lworkmin .AND. .NOT.lquery ) THEN
273  info = -14
274  END IF
275  END IF
276  IF( info .NE. 0 ) THEN
277  CALL xerbla( 'ZUNBDB1', -info )
278  RETURN
279  ELSE IF( lquery ) THEN
280  RETURN
281  END IF
282 *
283 * Reduce columns 1, ..., Q of X11 and X21
284 *
285  DO i = 1, q
286 *
287  CALL zlarfgp( p-i+1, x11(i,i), x11(i+1,i), 1, taup1(i) )
288  CALL zlarfgp( m-p-i+1, x21(i,i), x21(i+1,i), 1, taup2(i) )
289  theta(i) = atan2( dble( x21(i,i) ), dble( x11(i,i) ) )
290  c = cos( theta(i) )
291  s = sin( theta(i) )
292  x11(i,i) = one
293  x21(i,i) = one
294  CALL zlarf( 'L', p-i+1, q-i, x11(i,i), 1, dconjg(taup1(i)),
295  $ x11(i,i+1), ldx11, work(ilarf) )
296  CALL zlarf( 'L', m-p-i+1, q-i, x21(i,i), 1, dconjg(taup2(i)),
297  $ x21(i,i+1), ldx21, work(ilarf) )
298 *
299  IF( i .LT. q ) THEN
300  CALL zdrot( q-i, x11(i,i+1), ldx11, x21(i,i+1), ldx21, c,
301  $ s )
302  CALL zlacgv( q-i, x21(i,i+1), ldx21 )
303  CALL zlarfgp( q-i, x21(i,i+1), x21(i,i+2), ldx21, tauq1(i) )
304  s = dble( x21(i,i+1) )
305  x21(i,i+1) = one
306  CALL zlarf( 'R', p-i, q-i, x21(i,i+1), ldx21, tauq1(i),
307  $ x11(i+1,i+1), ldx11, work(ilarf) )
308  CALL zlarf( 'R', m-p-i, q-i, x21(i,i+1), ldx21, tauq1(i),
309  $ x21(i+1,i+1), ldx21, work(ilarf) )
310  CALL zlacgv( q-i, x21(i,i+1), ldx21 )
311  c = sqrt( dznrm2( p-i, x11(i+1,i+1), 1 )**2
312  $ + dznrm2( m-p-i, x21(i+1,i+1), 1 )**2 )
313  phi(i) = atan2( s, c )
314  CALL zunbdb5( p-i, m-p-i, q-i-1, x11(i+1,i+1), 1,
315  $ x21(i+1,i+1), 1, x11(i+1,i+2), ldx11,
316  $ x21(i+1,i+2), ldx21, work(iorbdb5), lorbdb5,
317  $ childinfo )
318  END IF
319 *
320  END DO
321 *
322  RETURN
323 *
324 * End of ZUNBDB1
325 *
326  END
327 
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine zdrot(N, CX, INCX, CY, INCY, C, S)
ZDROT
Definition: zdrot.f:100
subroutine zunbdb1(M, P, Q, X11, LDX11, X21, LDX21, THETA, PHI, TAUP1, TAUP2, TAUQ1, WORK, LWORK, INFO)
ZUNBDB1
Definition: zunbdb1.f:205
subroutine zunbdb5(M1, M2, N, X1, INCX1, X2, INCX2, Q1, LDQ1, Q2, LDQ2, WORK, LWORK, INFO)
ZUNBDB5
Definition: zunbdb5.f:158
subroutine zlarfgp(N, ALPHA, X, INCX, TAU)
ZLARFGP generates an elementary reflector (Householder matrix) with non-negative beta.
Definition: zlarfgp.f:106
subroutine zlarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
ZLARF applies an elementary reflector to a general rectangular matrix.
Definition: zlarf.f:130
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
Definition: zlacgv.f:76