Go to main content
Oracle Developer Studio 12.5 Man Pages

Exit Print View

Updated: June 2017
 
 

zggrqf (3p)

Name

zggrqf - N matrix A and a P-by-N matrix B

Synopsis

SUBROUTINE ZGGRQF(M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK, LWORK,
INFO)

DOUBLE COMPLEX A(LDA,*), TAUA(*), B(LDB,*), TAUB(*), WORK(*)
INTEGER M, P, N, LDA, LDB, LWORK, INFO

SUBROUTINE ZGGRQF_64(M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK,
LWORK, INFO)

DOUBLE COMPLEX A(LDA,*), TAUA(*), B(LDB,*), TAUB(*), WORK(*)
INTEGER*8 M, P, N, LDA, LDB, LWORK, INFO




F95 INTERFACE
SUBROUTINE GGRQF(M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK,
LWORK, INFO)

COMPLEX(8), DIMENSION(:) :: TAUA, TAUB, WORK
COMPLEX(8), DIMENSION(:,:) :: A, B
INTEGER :: M, P, N, LDA, LDB, LWORK, INFO

SUBROUTINE GGRQF_64(M, P, N, A, LDA, TAUA, B, LDB, TAUB,
WORK, LWORK, INFO)

COMPLEX(8), DIMENSION(:) :: TAUA, TAUB, WORK
COMPLEX(8), DIMENSION(:,:) :: A, B
INTEGER(8) :: M, P, N, LDA, LDB, LWORK, INFO




C INTERFACE
#include <sunperf.h>

void zggrqf(int m, int p, int n, doublecomplex *a, int lda,  doublecom-
plex  *taua,  doublecomplex *b, int ldb, doublecomplex *taub,
int *info);

void zggrqf_64(long m, long p, long n, doublecomplex *a, long lda, dou-
blecomplex  *taua,  doublecomplex *b, long ldb, doublecomplex
*taub, long *info);

Description

Oracle Solaris Studio Performance Library                           zggrqf(3P)



NAME
       zggrqf  -  compute a generalized RQ factorization of an M-by-N matrix A
       and a P-by-N matrix B


SYNOPSIS
       SUBROUTINE ZGGRQF(M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK, LWORK,
             INFO)

       DOUBLE COMPLEX A(LDA,*), TAUA(*), B(LDB,*), TAUB(*), WORK(*)
       INTEGER M, P, N, LDA, LDB, LWORK, INFO

       SUBROUTINE ZGGRQF_64(M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK,
             LWORK, INFO)

       DOUBLE COMPLEX A(LDA,*), TAUA(*), B(LDB,*), TAUB(*), WORK(*)
       INTEGER*8 M, P, N, LDA, LDB, LWORK, INFO




   F95 INTERFACE
       SUBROUTINE GGRQF(M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK,
              LWORK, INFO)

       COMPLEX(8), DIMENSION(:) :: TAUA, TAUB, WORK
       COMPLEX(8), DIMENSION(:,:) :: A, B
       INTEGER :: M, P, N, LDA, LDB, LWORK, INFO

       SUBROUTINE GGRQF_64(M, P, N, A, LDA, TAUA, B, LDB, TAUB,
              WORK, LWORK, INFO)

       COMPLEX(8), DIMENSION(:) :: TAUA, TAUB, WORK
       COMPLEX(8), DIMENSION(:,:) :: A, B
       INTEGER(8) :: M, P, N, LDA, LDB, LWORK, INFO




   C INTERFACE
       #include <sunperf.h>

       void zggrqf(int m, int p, int n, doublecomplex *a, int lda,  doublecom-
                 plex  *taua,  doublecomplex *b, int ldb, doublecomplex *taub,
                 int *info);

       void zggrqf_64(long m, long p, long n, doublecomplex *a, long lda, dou-
                 blecomplex  *taua,  doublecomplex *b, long ldb, doublecomplex
                 *taub, long *info);



PURPOSE
       zggrqf computes a generalized RQ factorization of an  M-by-N  matrix  A
       and a P-by-N matrix B:

                   A = R*Q,        B = Z*T*Q,

       where  Q is an N-by-N unitary matrix, Z is a P-by-P unitary matrix, and
       R and T assume one of the forms:

       if M <= N,  R = ( 0  R12 ) M,   or if M > N,  R = ( R11 ) M-N,
                        N-M  M                           ( R21 ) N
                                                            N

       where R12 or R21 is upper triangular, and

       if P >= N,  T = ( T11 ) N  ,   or if P < N,  T = ( T11  T12 ) P,
                       (  0  ) P-N                         P   N-P
                          N

       where T11 is upper triangular.

       In particular, if B is square and nonsingular, the GRQ factorization of
       A and B implicitly gives the RQ factorization of A*inv(B):

                    A*inv(B) = (R*inv(T))*Z'

       where  inv(B)  denotes  the inverse of the matrix B, and Z' denotes the
       conjugate transpose of the matrix Z.


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


       P (input) The number of rows of the matrix B.  P >= 0.


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


       A (input/output)
                 On entry, the M-by-N matrix A.  On exit, if M <= N, the upper
                 triangle  of  the subarray A(1:M,N-M+1:N) contains the M-by-M
                 upper triangular matrix R; if M >  N,  the  elements  on  and
                 above  the  (M-N)-th  subdiagonal  contain  the  M-by-N upper
                 trapezoidal matrix R; the remaining elements, with the  array
                 TAUA,  represent the unitary matrix Q as a product of elemen-
                 tary reflectors (see Further Details).


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


       TAUA (output)
                 The scalar factors of the elementary reflectors which  repre-
                 sent the unitary matrix Q (see Further Details).


       B (input/output)
                 On  entry, the P-by-N matrix B.  On exit, the elements on and
                 above the diagonal of the  array  contain  the  min(P,N)-by-N
                 upper trapezoidal matrix T (T is upper triangular if P >= N);
                 the elements below the diagonal, with the array TAUB,  repre-
                 sent  the unitary matrix Z as a product of elementary reflec-
                 tors (see Further Details).


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


       TAUB (output)
                 The scalar factors of the elementary reflectors which  repre-
                 sent the unitary matrix Z (see Further Details).


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


       LWORK (input)
                 The  dimension of the array WORK. LWORK >= max(1,N,M,P).  For
                 optimum  performance  LWORK  >=  max(N,M,P)*max(NB1,NB2,NB3),
                 where  NB1  is the optimal blocksize for the RQ factorization
                 of an M-by-N matrix, NB2 is the optimal blocksize for the  QR
                 factorization  of  a  P-by-N  matrix,  and NB3 is the optimal
                 blocksize for a call of ZUNMRQ.

                 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.


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

FURTHER DETAILS
       The matrix Q is represented as a product of elementary reflectors

          Q = H(1) H(2) . . . H(k), where k = min(m,n).

       Each H(i) has the form

          H(i) = I - taua * v * v'

       where  taua  is  a  complex scalar, and v is a complex vector with v(n-
       k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit  in  A(m-
       k+i,1:n-k+i-1), and taua in TAUA(i).
       To form Q explicitly, use LAPACK subroutine ZUNGRQ.
       To use Q to update another matrix, use LAPACK subroutine ZUNMRQ.

       The matrix Z is represented as a product of elementary reflectors

          Z = H(1) H(2) . . . H(k), where k = min(p,n).

       Each H(i) has the form

          H(i) = I - taub * v * v'

       where taub is a complex scalar, and v is a complex vector with v(1:i-1)
       = 0 and v(i) = 1; v(i+1:p) is stored on exit in B(i+1:p,i), and taub in
       TAUB(i).
       To form Z explicitly, use LAPACK subroutine ZUNGQR.
       To use Z to update another matrix, use LAPACK subroutine ZUNMQR.




                                  7 Nov 2015                        zggrqf(3P)