Contents


NAME

     zgelsx - routine is deprecated and has been replaced by rou-
     tine CGELSY

SYNOPSIS

     SUBROUTINE ZGELSX(M, N, NRHS, A, LDA, B, LDB, JPIVOT, RCOND, IRANK,
           WORK, WORK2, INFO)

     DOUBLE COMPLEX A(LDA,*), B(LDB,*), WORK(*)
     INTEGER M, N, NRHS, LDA, LDB, IRANK, INFO
     INTEGER JPIVOT(*)
     DOUBLE PRECISION RCOND
     DOUBLE PRECISION WORK2(*)

     SUBROUTINE ZGELSX_64(M, N, NRHS, A, LDA, B, LDB, JPIVOT, RCOND,
           IRANK, WORK, WORK2, INFO)

     DOUBLE COMPLEX A(LDA,*), B(LDB,*), WORK(*)
     INTEGER*8 M, N, NRHS, LDA, LDB, IRANK, INFO
     INTEGER*8 JPIVOT(*)
     DOUBLE PRECISION RCOND
     DOUBLE PRECISION WORK2(*)

  F95 INTERFACE
     SUBROUTINE GELSX([M], [N], [NRHS], A, [LDA], B, [LDB], JPIVOT, RCOND,
            IRANK, [WORK], [WORK2], [INFO])

     COMPLEX(8), DIMENSION(:) :: WORK
     COMPLEX(8), DIMENSION(:,:) :: A, B
     INTEGER :: M, N, NRHS, LDA, LDB, IRANK, INFO
     INTEGER, DIMENSION(:) :: JPIVOT
     REAL(8) :: RCOND
     REAL(8), DIMENSION(:) :: WORK2

     SUBROUTINE GELSX_64([M], [N], [NRHS], A, [LDA], B, [LDB], JPIVOT,
            RCOND, IRANK, [WORK], [WORK2], [INFO])

     COMPLEX(8), DIMENSION(:) :: WORK
     COMPLEX(8), DIMENSION(:,:) :: A, B
     INTEGER(8) :: M, N, NRHS, LDA, LDB, IRANK, INFO
     INTEGER(8), DIMENSION(:) :: JPIVOT
     REAL(8) :: RCOND
     REAL(8), DIMENSION(:) :: WORK2

  C INTERFACE
     #include <sunperf.h>
     void zgelsx(int m, int n, int nrhs,  doublecomplex  *a,  int
               lda,  doublecomplex *b, int ldb, int *jpivot, dou-
               ble rcond, int *irank, int *info);

     void zgelsx_64(long m, long n, long nrhs, doublecomplex  *a,
               long   lda,   doublecomplex  *b,  long  ldb,  long
               *jpivot, double rcond, long *irank, long *info);

PURPOSE

     zgelsx routine is deprecated and has been replaced  by  rou-
     tine CGELSY.

     CGELSX computes  the  minimum-norm  solution  to  a  complex
     linear least squares problem:
         minimize || A * X - B ||
     using a complete orthogonal factorization 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 routine first computes a QR  factorization  with  column
     pivoting:
         A * P = Q * [ R11 R12 ]
                     [  0  R22 ]
     with R11 defined as  the  largest  leading  submatrix  whose
     estimated  condition number is less than 1/RCOND.  The order
     of R11, RANK, is the effective rank of A.

     Then, R22 is considered to be negligible, and R12 is annihi-
     lated by unitary transformations from the right, arriving at
     the complete orthogonal factorization:
        A * P = Q * [ T11 0 ] * Z
                    [  0  0 ]
     The minimum-norm solution is then
        X = P * Z' [ inv(T11)*Q1'*B ]
                   [        0       ]
     where Q1 consists of the first RANK columns of Q.

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 matrices B and X. NRHS >= 0.

     A (input/output)
               On entry, the M-by-N matrix A.   On  exit,  A  has
               been   overwritten  by  details  of  its  complete
               orthogonal factorization.

     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, the N-by-NRHS solution matrix X.  If m >=
               n and IRANK = n, the residual  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,M,N).

     JPIVOT (input/output)
               On entry, if JPIVOT(i) .ne. 0, the i-th column  of
               A  is  an  initial  column, otherwise it is a free
               column.  Before the QR  factorization  of  A,  all
               initial  columns are permuted to the leading posi-
               tions; only the remaining free columns  are  moved
               as a result of column pivoting during the factori-
               zation.  On exit, if JPIVOT(i) = k, then the  i-th
               column of A*P was the k-th column of A.

     RCOND (input)
               RCOND is used to determine the effective  rank  of
               A,  which  is  defined as the order of the largest
               leading triangular submatrix R11 in the QR factor-
               ization with pivoting of A, whose estimated condi-
               tion number < 1/RCOND.

     IRANK (output)
               The effective rank of A, i.e., the  order  of  the
               submatrix  R11.   This is the same as the order of
               the submatrix T11 in the complete orthogonal  fac-
               torization of A.
     WORK (workspace)
               (min(M,N) + max( N, 2*min(M,N)+NRHS )),

     WORK2 (workspace)
               dimension(2*N)

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