LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ zggglm()

subroutine zggglm ( integer  n,
integer  m,
integer  p,
complex*16, dimension( lda, * )  a,
integer  lda,
complex*16, dimension( ldb, * )  b,
integer  ldb,
complex*16, dimension( * )  d,
complex*16, dimension( * )  x,
complex*16, dimension( * )  y,
complex*16, dimension( * )  work,
integer  lwork,
integer  info 
)

ZGGGLM

Download ZGGGLM + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 ZGGGLM solves a general Gauss-Markov linear model (GLM) problem:

         minimize || y ||_2   subject to   d = A*x + B*y
             x

 where A is an N-by-M matrix, B is an N-by-P matrix, and d is a
 given N-vector. It is assumed that M <= N <= M+P, and

            rank(A) = M    and    rank( A B ) = N.

 Under these assumptions, the constrained equation is always
 consistent, and there is a unique solution x and a minimal 2-norm
 solution y, which is obtained using a generalized QR factorization
 of the matrices (A, B) given by

    A = Q*(R),   B = Q*T*Z.
          (0)

 In particular, if matrix B is square nonsingular, then the problem
 GLM is equivalent to the following weighted linear least squares
 problem

              minimize || inv(B)*(d-A*x) ||_2
                  x

 where inv(B) denotes the inverse of B.
Parameters
[in]N
          N is INTEGER
          The number of rows of the matrices A and B.  N >= 0.
[in]M
          M is INTEGER
          The number of columns of the matrix A.  0 <= M <= N.
[in]P
          P is INTEGER
          The number of columns of the matrix B.  P >= N-M.
[in,out]A
          A is COMPLEX*16 array, dimension (LDA,M)
          On entry, the N-by-M matrix A.
          On exit, the upper triangular part of the array A contains
          the M-by-M upper triangular matrix R.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A. LDA >= max(1,N).
[in,out]B
          B is COMPLEX*16 array, dimension (LDB,P)
          On entry, the N-by-P matrix B.
          On exit, if N <= P, the upper triangle of the subarray
          B(1:N,P-N+1:P) contains the N-by-N upper triangular matrix T;
          if N > P, the elements on and above the (N-P)th subdiagonal
          contain the N-by-P upper trapezoidal matrix T.
[in]LDB
          LDB is INTEGER
          The leading dimension of the array B. LDB >= max(1,N).
[in,out]D
          D is COMPLEX*16 array, dimension (N)
          On entry, D is the left hand side of the GLM equation.
          On exit, D is destroyed.
[out]X
          X is COMPLEX*16 array, dimension (M)
[out]Y
          Y is COMPLEX*16 array, dimension (P)

          On exit, X and Y are the solutions of the GLM problem.
[out]WORK
          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
[in]LWORK
          LWORK is INTEGER
          The dimension of the array WORK. LWORK >= max(1,N+M+P).
          For optimum performance, LWORK >= M+min(N,P)+max(N,P)*NB,
          where NB is an upper bound for the optimal blocksizes for
          ZGEQRF, ZGERQF, ZUNMQR and ZUNMRQ.

          If LWORK = -1, then a workspace query is assumed; the routine
          only calculates the optimal size of the WORK array, returns
          this value as the first entry of the WORK array, and no error
          message related to LWORK is issued by XERBLA.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit.
          < 0:  if INFO = -i, the i-th argument had an illegal value.
          = 1:  the upper triangular factor R associated with A in the
                generalized QR factorization of the pair (A, B) is
                singular, so that rank(A) < M; the least squares
                solution could not be computed.
          = 2:  the bottom (N-M) by (N-M) part of the upper trapezoidal
                factor T associated with B in the generalized QR
                factorization of the pair (A, B) is singular, so that
                rank( A B ) < N; the least squares solution could not
                be computed.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 183 of file zggglm.f.

185*
186* -- LAPACK driver routine --
187* -- LAPACK is a software package provided by Univ. of Tennessee, --
188* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
189*
190* .. Scalar Arguments ..
191 INTEGER INFO, LDA, LDB, LWORK, M, N, P
192* ..
193* .. Array Arguments ..
194 COMPLEX*16 A( LDA, * ), B( LDB, * ), D( * ), WORK( * ),
195 $ X( * ), Y( * )
196* ..
197*
198* ===================================================================
199*
200* .. Parameters ..
201 COMPLEX*16 CZERO, CONE
202 parameter( czero = ( 0.0d+0, 0.0d+0 ),
203 $ cone = ( 1.0d+0, 0.0d+0 ) )
204* ..
205* .. Local Scalars ..
206 LOGICAL LQUERY
207 INTEGER I, LOPT, LWKMIN, LWKOPT, NB, NB1, NB2, NB3,
208 $ NB4, NP
209* ..
210* .. External Subroutines ..
211 EXTERNAL xerbla, zcopy, zgemv, zggqrf, ztrtrs, zunmqr,
212 $ zunmrq
213* ..
214* .. External Functions ..
215 INTEGER ILAENV
216 EXTERNAL ilaenv
217* ..
218* .. Intrinsic Functions ..
219 INTRINSIC int, max, min
220* ..
221* .. Executable Statements ..
222*
223* Test the input parameters
224*
225 info = 0
226 np = min( n, p )
227 lquery = ( lwork.EQ.-1 )
228 IF( n.LT.0 ) THEN
229 info = -1
230 ELSE IF( m.LT.0 .OR. m.GT.n ) THEN
231 info = -2
232 ELSE IF( p.LT.0 .OR. p.LT.n-m ) THEN
233 info = -3
234 ELSE IF( lda.LT.max( 1, n ) ) THEN
235 info = -5
236 ELSE IF( ldb.LT.max( 1, n ) ) THEN
237 info = -7
238 END IF
239*
240* Calculate workspace
241*
242 IF( info.EQ.0) THEN
243 IF( n.EQ.0 ) THEN
244 lwkmin = 1
245 lwkopt = 1
246 ELSE
247 nb1 = ilaenv( 1, 'ZGEQRF', ' ', n, m, -1, -1 )
248 nb2 = ilaenv( 1, 'ZGERQF', ' ', n, m, -1, -1 )
249 nb3 = ilaenv( 1, 'ZUNMQR', ' ', n, m, p, -1 )
250 nb4 = ilaenv( 1, 'ZUNMRQ', ' ', n, m, p, -1 )
251 nb = max( nb1, nb2, nb3, nb4 )
252 lwkmin = m + n + p
253 lwkopt = m + np + max( n, p )*nb
254 END IF
255 work( 1 ) = lwkopt
256*
257 IF( lwork.LT.lwkmin .AND. .NOT.lquery ) THEN
258 info = -12
259 END IF
260 END IF
261*
262 IF( info.NE.0 ) THEN
263 CALL xerbla( 'ZGGGLM', -info )
264 RETURN
265 ELSE IF( lquery ) THEN
266 RETURN
267 END IF
268*
269* Quick return if possible
270*
271 IF( n.EQ.0 ) THEN
272 DO i = 1, m
273 x(i) = czero
274 END DO
275 DO i = 1, p
276 y(i) = czero
277 END DO
278 RETURN
279 END IF
280*
281* Compute the GQR factorization of matrices A and B:
282*
283* Q**H*A = ( R11 ) M, Q**H*B*Z**H = ( T11 T12 ) M
284* ( 0 ) N-M ( 0 T22 ) N-M
285* M M+P-N N-M
286*
287* where R11 and T22 are upper triangular, and Q and Z are
288* unitary.
289*
290 CALL zggqrf( n, m, p, a, lda, work, b, ldb, work( m+1 ),
291 $ work( m+np+1 ), lwork-m-np, info )
292 lopt = int( work( m+np+1 ) )
293*
294* Update left-hand-side vector d = Q**H*d = ( d1 ) M
295* ( d2 ) N-M
296*
297 CALL zunmqr( 'Left', 'Conjugate transpose', n, 1, m, a, lda, work,
298 $ d, max( 1, n ), work( m+np+1 ), lwork-m-np, info )
299 lopt = max( lopt, int( work( m+np+1 ) ) )
300*
301* Solve T22*y2 = d2 for y2
302*
303 IF( n.GT.m ) THEN
304 CALL ztrtrs( 'Upper', 'No transpose', 'Non unit', n-m, 1,
305 $ b( m+1, m+p-n+1 ), ldb, d( m+1 ), n-m, info )
306*
307 IF( info.GT.0 ) THEN
308 info = 1
309 RETURN
310 END IF
311*
312 CALL zcopy( n-m, d( m+1 ), 1, y( m+p-n+1 ), 1 )
313 END IF
314*
315* Set y1 = 0
316*
317 DO 10 i = 1, m + p - n
318 y( i ) = czero
319 10 CONTINUE
320*
321* Update d1 = d1 - T12*y2
322*
323 CALL zgemv( 'No transpose', m, n-m, -cone, b( 1, m+p-n+1 ), ldb,
324 $ y( m+p-n+1 ), 1, cone, d, 1 )
325*
326* Solve triangular system: R11*x = d1
327*
328 IF( m.GT.0 ) THEN
329 CALL ztrtrs( 'Upper', 'No Transpose', 'Non unit', m, 1, a, lda,
330 $ d, m, info )
331*
332 IF( info.GT.0 ) THEN
333 info = 2
334 RETURN
335 END IF
336*
337* Copy D to X
338*
339 CALL zcopy( m, d, 1, x, 1 )
340 END IF
341*
342* Backward transformation y = Z**H *y
343*
344 CALL zunmrq( 'Left', 'Conjugate transpose', p, 1, np,
345 $ b( max( 1, n-p+1 ), 1 ), ldb, work( m+1 ), y,
346 $ max( 1, p ), work( m+np+1 ), lwork-m-np, info )
347 work( 1 ) = m + np + max( lopt, int( work( m+np+1 ) ) )
348*
349 RETURN
350*
351* End of ZGGGLM
352*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine zcopy(n, zx, incx, zy, incy)
ZCOPY
Definition zcopy.f:81
subroutine zgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
ZGEMV
Definition zgemv.f:160
subroutine zggqrf(n, m, p, a, lda, taua, b, ldb, taub, work, lwork, info)
ZGGQRF
Definition zggqrf.f:215
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
Definition ilaenv.f:162
subroutine ztrtrs(uplo, trans, diag, n, nrhs, a, lda, b, ldb, info)
ZTRTRS
Definition ztrtrs.f:140
subroutine zunmqr(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
ZUNMQR
Definition zunmqr.f:167
subroutine zunmrq(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
ZUNMRQ
Definition zunmrq.f:167
Here is the call graph for this function:
Here is the caller graph for this function: