LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ cggglm()

subroutine cggglm ( integer  N,
integer  M,
integer  P,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( ldb, * )  B,
integer  LDB,
complex, dimension( * )  D,
complex, dimension( * )  X,
complex, dimension( * )  Y,
complex, dimension( * )  WORK,
integer  LWORK,
integer  INFO 
)

CGGGLM

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

Purpose:
 CGGGLM 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 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 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 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 array, dimension (M)
[out]Y
          Y is COMPLEX array, dimension (P)

          On exit, X and Y are the solutions of the GLM problem.
[out]WORK
          WORK is COMPLEX 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
          CGEQRF, CGERQF, CUNMQR and CUNMRQ.

          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 cggglm.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 A( LDA, * ), B( LDB, * ), D( * ), WORK( * ),
195  $ X( * ), Y( * )
196 * ..
197 *
198 * ===================================================================
199 *
200 * .. Parameters ..
201  COMPLEX CZERO, CONE
202  parameter( czero = ( 0.0e+0, 0.0e+0 ),
203  $ cone = ( 1.0e+0, 0.0e+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 ccopy, cgemv, cggqrf, ctrtrs, cunmqr, cunmrq,
212  $ xerbla
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, 'CGEQRF', ' ', n, m, -1, -1 )
248  nb2 = ilaenv( 1, 'CGERQF', ' ', n, m, -1, -1 )
249  nb3 = ilaenv( 1, 'CUNMQR', ' ', n, m, p, -1 )
250  nb4 = ilaenv( 1, 'CUNMRQ', ' ', 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( 'CGGGLM', -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 cggqrf( n, m, p, a, lda, work, b, ldb, work( m+1 ),
291  $ work( m+np+1 ), lwork-m-np, info )
292  lopt = real( work( m+np+1 ) )
293 *
294 * Update left-hand-side vector d = Q**H*d = ( d1 ) M
295 * ( d2 ) N-M
296 *
297  CALL cunmqr( '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 ctrtrs( '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 ccopy( 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 cgemv( '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 ctrtrs( '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 ccopy( m, d, 1, x, 1 )
340  END IF
341 *
342 * Backward transformation y = Z**H *y
343 *
344  CALL cunmrq( '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 CGGGLM
352 *
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
ILAENV
Definition: ilaenv.f:162
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
Definition: ccopy.f:81
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
Definition: cgemv.f:158
subroutine ctrtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
CTRTRS
Definition: ctrtrs.f:140
subroutine cunmqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMQR
Definition: cunmqr.f:168
subroutine cunmrq(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMRQ
Definition: cunmrq.f:168
subroutine cggqrf(N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, LWORK, INFO)
CGGQRF
Definition: cggqrf.f:215
Here is the call graph for this function:
Here is the caller graph for this function: