Go to main content
Oracle Developer Studio 12.5 Man Pages

Exit Print View

Updated: June 2017
 
 

zgelsx (3p)

Name

zgelsx - routine is deprecated and has been replaced by routine ZGELSY

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, double-
complex *b, int ldb, int *jpivot, double 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);

Description

Oracle Solaris Studio Performance Library                           zgelsx(3P)



NAME
       zgelsx - routine is deprecated and has been replaced by routine ZGELSY


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, double-
                 complex *b, int ldb, int *jpivot, double 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 routine ZGELSY.

       ZGELSX  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 con-
       dition 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 annihilated 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 overwrit-
                 ten 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 col-
                 umn 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 positions; only the remaining free columns are  moved
                 as  a result of column pivoting during the factorization.  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 subma-
                 trix  R11  in  the QR factorization with pivoting of A, whose
                 estimated condition 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 factorization 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 illegal value




                                  7 Nov 2015                        zgelsx(3P)