Contents


NAME

     sgglse - solve the linear equality-constrained least squares
     (LSE) problem

SYNOPSIS

     SUBROUTINE SGGLSE(M, N, P, A, LDA, B, LDB, C, D, X, WORK, LDWORK,
           INFO)

     INTEGER M, N, P, LDA, LDB, LDWORK, INFO
     REAL A(LDA,*), B(LDB,*), C(*), D(*), X(*), WORK(*)

     SUBROUTINE SGGLSE_64(M, N, P, A, LDA, B, LDB, C, D, X, WORK, LDWORK,
           INFO)

     INTEGER*8 M, N, P, LDA, LDB, LDWORK, INFO
     REAL A(LDA,*), B(LDB,*), C(*), D(*), X(*), WORK(*)

  F95 INTERFACE
     SUBROUTINE GGLSE([M], [N], [P], A, [LDA], B, [LDB], C, D, X, [WORK],
            [LDWORK], [INFO])

     INTEGER :: M, N, P, LDA, LDB, LDWORK, INFO
     REAL, DIMENSION(:) :: C, D, X, WORK
     REAL, DIMENSION(:,:) :: A, B

     SUBROUTINE GGLSE_64([M], [N], [P], A, [LDA], B, [LDB], C, D, X, [WORK],
            [LDWORK], [INFO])

     INTEGER(8) :: M, N, P, LDA, LDB, LDWORK, INFO
     REAL, DIMENSION(:) :: C, D, X, WORK
     REAL, DIMENSION(:,:) :: A, B

  C INTERFACE
     #include <sunperf.h>

     void sgglse(int m, int n, int p, float *a,  int  lda,  float
               *b,  int  ldb,  float  *c, float *d, float *x, int
               *info);

     void sgglse_64(long m, long n, long p, float *a,  long  lda,
               float  *b, long ldb, float *c, float *d, float *x,
               long *info);

PURPOSE

     sgglse solves the linear equality-constrained least  squares
     (LSE) problem:
             minimize || c - A*x ||_2   subject to   B*x = d

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

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

     These conditions ensure that the LSE problem  has  a  unique
     solution, which is obtained using a GRQ factorization of the
     matrices B and A.

ARGUMENTS

     M (input) The number of rows of the matrix A.  M >= 0.

     N (input) The number of columns of the matrices A and  B.  N
               >= 0.

     P (input) The number of rows of the matrix B. 0 <= P <= N <=
               M+P.

     A (input/output)
               On entry, the M-by-N matrix A.  On exit, A is des-
               troyed.

     LDA (input)
               The leading dimension  of  the  array  A.  LDA  >=
               max(1,M).

     B (input/output)
               On entry, the P-by-N matrix B.  On exit, B is des-
               troyed.

     LDB (input)
               The leading dimension  of  the  array  B.  LDB  >=
               max(1,P).

     C (input/output)
               On entry, C contains the right  hand  side  vector
               for the least squares part of the LSE problem.  On
               exit, the residual sum of squares for the solution
               is  given  by the sum of squares of elements N-P+1
               to M of vector C.

     D (input/output)
               On entry, D contains the right  hand  side  vector
               for  the constrained equation.  On exit, D is des-
               troyed.

     X (output)
               On exit, X is the solution of the LSE problem.

     WORK (workspace)
               On exit, if INFO = 0, WORK(1) returns the  optimal
               LDWORK.

     LDWORK (input)
               The  dimension  of  the  array  WORK.  LDWORK   >=
               max(1,M+N+P).   For  optimum performance LDWORK >=
               P+min(M,N)+max(M,N)*NB, where NB is an upper bound
               for  the  optimal  blocksizes  for SGEQRF, SGERQF,
               SORMQR and SORMRQ.

               If LDWORK = -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 LDWORK is issued by XERBLA.

     INFO (output)
               = 0:  successful exit.
               < 0:  if INFO = -i, the i-th argument had an ille-
               gal value.