Contents


NAME

     dgelss - compute the minimum norm solution to a real  linear
     least squares problem

SYNOPSIS

     SUBROUTINE DGELSS(M, N, NRHS, A, LDA, B, LDB, SING, RCOND, IRANK,
           WORK, LDWORK, INFO)

     INTEGER M, N, NRHS, LDA, LDB, IRANK, LDWORK, INFO
     DOUBLE PRECISION RCOND
     DOUBLE PRECISION A(LDA,*), B(LDB,*), SING(*), WORK(*)

     SUBROUTINE DGELSS_64(M, N, NRHS, A, LDA, B, LDB, SING, RCOND, IRANK,
           WORK, LDWORK, INFO)

     INTEGER*8 M, N, NRHS, LDA, LDB, IRANK, LDWORK, INFO
     DOUBLE PRECISION RCOND
     DOUBLE PRECISION A(LDA,*), B(LDB,*), SING(*), WORK(*)

  F95 INTERFACE
     SUBROUTINE GELSS([M], [N], [NRHS], A, [LDA], B, [LDB], SING, RCOND,
            IRANK, [WORK], [LDWORK], [INFO])

     INTEGER :: M, N, NRHS, LDA, LDB, IRANK, LDWORK, INFO
     REAL(8) :: RCOND
     REAL(8), DIMENSION(:) :: SING, WORK
     REAL(8), DIMENSION(:,:) :: A, B

     SUBROUTINE GELSS_64([M], [N], [NRHS], A, [LDA], B, [LDB], SING,
            RCOND, IRANK, [WORK], [LDWORK], [INFO])

     INTEGER(8) :: M, N, NRHS, LDA, LDB, IRANK, LDWORK, INFO
     REAL(8) :: RCOND
     REAL(8), DIMENSION(:) :: SING, WORK
     REAL(8), DIMENSION(:,:) :: A, B

  C INTERFACE
     #include <sunperf.h>

     void dgelss(int m, int n, int nrhs, double *a, int lda, dou-
               ble  *b,  int ldb, double *sing, double rcond, int
               *irank, int *info);

     void dgelss_64(long m, long n, long nrhs,  double  *a,  long
               lda,  double  *b,  long  ldb, double *sing, double
               rcond, long *irank, long *info);

PURPOSE

     dgelss computes the minimum norm solution to a  real  linear
     least squares problem:

     Minimize 2-norm(| b - A*x |).

     using the singular value decomposition (SVD) of A. A  is  an
     M-by-N matrix which may be rank-deficient.

     Several right hand side vectors b and solution vectors x can
     be  handled in a single call; they are stored as the columns
     of the M-by-NRHS right hand side matrix B and the  N-by-NRHS
     solution matrix X.

     The effective rank of A is determined by  treating  as  zero
     those  singular  values  which are less than RCOND times the
     largest singular value.

ARGUMENTS

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

     N (input) The number of columns of the matrix A. N >= 0.

     NRHS (input)
               The number of right hand sides, i.e.,  the  number
               of columns of the matrices B and X. NRHS >= 0.

     A (input/output)
               On entry, the M-by-N matrix A.  On exit, the first
               min(m,n)  rows of A are overwritten with its right
               singular vectors, stored rowwise.

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

     B (input/output)
               On entry, the M-by-NRHS right hand side matrix  B.
               On  exit,  B is overwritten by the N-by-NRHS solu-
               tion matrix X.  If m >= n and IRANK = n, the resi-
               dual  sum-of-squares  for the solution in the i-th
               column is given by the sum of squares of  elements
               n+1:m in that column.
     LDB (input)
               The leading dimension  of  the  array  B.  LDB  >=
               max(1,max(M,N)).

     SING (output)
               The singular values of A in decreasing order.  The
               condition   number   of   A   in   the   2-norm  =
               SING(1)/SING(min(m,n)).

     RCOND (input)
               RCOND is used to determine the effective  rank  of
               A.   Singular  values SING(i) <= RCOND*SING(1) are
               treated as zero.  If RCOND < 0, machine  precision
               is used instead.

     IRANK (output)
               The effective rank  of  A,  i.e.,  the  number  of
               singular    values    which   are   greater   than
               RCOND*SING(1).

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

     LDWORK (input)
               The dimension of the array WORK. LDWORK >= 1,  and
               also:   LDWORK  >=  3*min(M,N)  + max( 2*min(M,N),
               max(M,N), NRHS  )  For  good  performance,  LDWORK
               should generally be larger.

               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.
               > 0:  the algorithm for computing the  SVD  failed
               to  converge; if INFO = i, i off-diagonal elements
               of an intermediate bidiagonal form  did  not  con-
               verge to zero.