Go to main content
Oracle Developer Studio 12.5 Man Pages

Exit Print View

Updated: June 2017
 
 

dorbdb (3p)

Name

dorbdb - tioned orthogonal matrix

Synopsis

SUBROUTINE DORBDB(TRANS, SIGNS, M, P, Q, X11, LDX11, X12,  LDX12,  X21,
LDX21,  X22,  LDX22,  THETA, PHI, TAUP1, TAUP2, TAUQ1, TAUQ2,
WORK, LWORK, INFO)


CHARACTER*1 SIGNS, TRANS

INTEGER INFO, LDX11, LDX12, LDX21, LDX22, LWORK, M, P, Q

DOUBLE PRECISION PHI(*), THETA(*)

DOUBLE  PRECISION  TAUP1(*),  TAUP2(*),  TAUQ1(*),  TAUQ2(*),  WORK(*),
X11(LDX11,*), X12(LDX12,*), X21(LDX21,*), X22(LDX22,*)


SUBROUTINE  DORBDB_64(TRANS,  SIGNS,  M,  P, Q, X11, LDX11, X12, LDX12,
X21, LDX21, X22, LDX22,  THETA,  PHI,  TAUP1,  TAUP2,  TAUQ1,
TAUQ2, WORK, LWORK, INFO)


CHARACTER*1 SIGNS, TRANS

INTEGER*8 INFO, LDX11, LDX12, LDX21, LDX22, LWORK, M, P, Q

DOUBLE PRECISION PHI(*), THETA(*)

DOUBLE  PRECISION  TAUP1(*),  TAUP2(*),  TAUQ1(*),  TAUQ2(*),  WORK(*),
X11(LDX11,*), X12(LDX12,*), X21(LDX21,*), X22(LDX22,*)


F95 INTERFACE
SUBROUTINE ORBDB(TRANS, SIGNS, M, P, Q, X11, LDX11,  X12,  LDX12,  X21,
LDX21,  X22,  LDX22,  THETA, PHI, TAUP1, TAUP2, TAUQ1, TAUQ2,
WORK, LWORK, INFO)


INTEGER :: M, P, Q, LDX11, LDX12, LDX21, LDX22, LWORK, INFO

CHARACTER(LEN=1) :: TRANS, SIGNS

REAL(8), DIMENSION(:,:) :: X11, X12, X21, X22

REAL(8), DIMENSION(:) :: THETA, PHI, TAUP1, TAUP2, TAUQ1, TAUQ2, WORK


SUBROUTINE ORBDB_64(TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X21,
LDX21,  X22,  LDX22,  THETA, PHI, TAUP1, TAUP2, TAUQ1, TAUQ2,
WORK, LWORK, INFO)


INTEGER(8) :: M, P, Q, LDX11, LDX12, LDX21, LDX22, LWORK, INFO

CHARACTER(LEN=1) :: TRANS, SIGNS

REAL(8), DIMENSION(:,:) :: X11, X12, X21, X22

REAL(8), DIMENSION(:) :: THETA, PHI, TAUP1, TAUP2, TAUQ1, TAUQ2, WORK


C INTERFACE
#include <sunperf.h>

void dorbdb (char trans, char signs, int m, int p, int q, double  *x11,
int  ldx11,  double  *x12, int ldx12, double *x21, int ldx21,
double *x22, int ldx22, double *theta,  double  *phi,  double
*taup1,  double  *taup2,  double  *tauq1,  double *tauq2, int
*info);


void dorbdb_64 (char trans, char signs, long m, long p, long q,  double
*x11,  long ldx11, double *x12, long ldx12, double *x21, long
ldx21, double *x22, long ldx22, double *theta,  double  *phi,
double  *taup1,  double *taup2, double *tauq1, double *tauq2,
long *info);

Description

Oracle Solaris Studio Performance Library                           dorbdb(3P)



NAME
       dorbdb  -  simultaneously  bidiagonalize the blocks of an M-by-M parti-
       tioned orthogonal matrix


SYNOPSIS
       SUBROUTINE DORBDB(TRANS, SIGNS, M, P, Q, X11, LDX11, X12,  LDX12,  X21,
                 LDX21,  X22,  LDX22,  THETA, PHI, TAUP1, TAUP2, TAUQ1, TAUQ2,
                 WORK, LWORK, INFO)


       CHARACTER*1 SIGNS, TRANS

       INTEGER INFO, LDX11, LDX12, LDX21, LDX22, LWORK, M, P, Q

       DOUBLE PRECISION PHI(*), THETA(*)

       DOUBLE  PRECISION  TAUP1(*),  TAUP2(*),  TAUQ1(*),  TAUQ2(*),  WORK(*),
                 X11(LDX11,*), X12(LDX12,*), X21(LDX21,*), X22(LDX22,*)


       SUBROUTINE  DORBDB_64(TRANS,  SIGNS,  M,  P, Q, X11, LDX11, X12, LDX12,
                 X21, LDX21, X22, LDX22,  THETA,  PHI,  TAUP1,  TAUP2,  TAUQ1,
                 TAUQ2, WORK, LWORK, INFO)


       CHARACTER*1 SIGNS, TRANS

       INTEGER*8 INFO, LDX11, LDX12, LDX21, LDX22, LWORK, M, P, Q

       DOUBLE PRECISION PHI(*), THETA(*)

       DOUBLE  PRECISION  TAUP1(*),  TAUP2(*),  TAUQ1(*),  TAUQ2(*),  WORK(*),
                 X11(LDX11,*), X12(LDX12,*), X21(LDX21,*), X22(LDX22,*)


   F95 INTERFACE
       SUBROUTINE ORBDB(TRANS, SIGNS, M, P, Q, X11, LDX11,  X12,  LDX12,  X21,
                 LDX21,  X22,  LDX22,  THETA, PHI, TAUP1, TAUP2, TAUQ1, TAUQ2,
                 WORK, LWORK, INFO)


       INTEGER :: M, P, Q, LDX11, LDX12, LDX21, LDX22, LWORK, INFO

       CHARACTER(LEN=1) :: TRANS, SIGNS

       REAL(8), DIMENSION(:,:) :: X11, X12, X21, X22

       REAL(8), DIMENSION(:) :: THETA, PHI, TAUP1, TAUP2, TAUQ1, TAUQ2, WORK


       SUBROUTINE ORBDB_64(TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12, X21,
                 LDX21,  X22,  LDX22,  THETA, PHI, TAUP1, TAUP2, TAUQ1, TAUQ2,
                 WORK, LWORK, INFO)


       INTEGER(8) :: M, P, Q, LDX11, LDX12, LDX21, LDX22, LWORK, INFO

       CHARACTER(LEN=1) :: TRANS, SIGNS

       REAL(8), DIMENSION(:,:) :: X11, X12, X21, X22

       REAL(8), DIMENSION(:) :: THETA, PHI, TAUP1, TAUP2, TAUQ1, TAUQ2, WORK


   C INTERFACE
       #include <sunperf.h>

       void dorbdb (char trans, char signs, int m, int p, int q, double  *x11,
                 int  ldx11,  double  *x12, int ldx12, double *x21, int ldx21,
                 double *x22, int ldx22, double *theta,  double  *phi,  double
                 *taup1,  double  *taup2,  double  *tauq1,  double *tauq2, int
                 *info);


       void dorbdb_64 (char trans, char signs, long m, long p, long q,  double
                 *x11,  long ldx11, double *x12, long ldx12, double *x21, long
                 ldx21, double *x22, long ldx22, double *theta,  double  *phi,
                 double  *taup1,  double *taup2, double *tauq1, double *tauq2,
                 long *info);


PURPOSE
       dorbdb simultaneously bidiagonalizes the blocks  of  an  M-by-M  parti-
       tioned orthogonal matrix X:

                                       [ B11 | B12 0  0 ]
           [ X11 | X12 ]   [ P1 |    ] [  0  |  0 -I  0 ] [ Q1 |    ]**T
       X = [-----------] = [---------] [----------------] [---------]   .
           [ X21 | X22 ]   [    | P2 ] [ B21 | B22 0  0 ] [    | Q2 ]
                                       [  0  |  0  0  I ]

       X11 is P-by-Q. Q must be no larger than P, M-P, or M-Q. (If this is not
       the case, then X must be transposed and/or permuted. This can  be  done
       in  constant  time  using  the  TRANS and SIGNS options. See DORCSD for
       details.)

       The orthogonal matrices P1, P2, Q1, and Q2 are P-by-P, (M-P)-by- (M-P),
       Q-by-Q,  and (M-Q)-by-(M-Q), respectively. They are represented implic-
       itly by Householder vectors.

       B11, B12, B21, and  B22  are  Q-by-Q  bidiagonal  matrices  represented
       implicitly by angles THETA, PHI.


ARGUMENTS
       TRANS (input)
                 TRANS is CHARACTER
                 =  'T'     :  X, U1, U2, V1T, and V2T are stored in row-major
                 order;
                 otherwise:  X, U1, U2, V1T, and V2T  are  stored  in  column-
                 major order.


       SIGNS (input)
                 SIGNS is CHARACTER
                 =  'O':       The  lower-left  block is made nonpositive (the
                 "other" convention);
                 otherwise:  The upper-right block is  made  nonpositive  (the
                 "default" convention).


       M (input)
                 M is INTEGER
                 The number of rows and columns in X.


       P (input)
                 P is INTEGER
                 The number of rows in X11 and X12. 0 <= P <= M.


       Q (input)
                 Q is INTEGER
                 The  number of columns in X11 and X21. 0 <= Q <= MIN(P,M-P,M-
                 Q).


       X11 (input/output)
                 X11 is DOUBLE PRECISION array, dimension (LDX11,Q)
                 On entry, the top-left block of the orthogonal matrix  to  be
                 reduced.
                 On exit, the form depends on TRANS:
                 If TRANS = 'N', then the columns of tril(X11) specify reflec-
                 tors for P1, the rows of triu(X11,1) specify  reflectors  for
                 Q1;
                 else  TRANS  = 'T', and the rows of triu(X11) specify reflec-
                 tors for P1, the columns of tril(X11,-1)  specify  reflectors
                 for Q1.


       LDX11 (input)
                 LDX11 is INTEGER
                 The  leading  dimension of X11. If TRANS = 'N', then LDX11 >=
                 P; else LDX11 >= Q.


       X12 (input/output)
                 X12 is DOUBLE PRECISION array, dimension (LDX12,M-Q)
                 On entry, the top-right block of the orthogonal matrix to  be
                 reduced.
                 On exit, the form depends on TRANS:
                 If  TRANS = 'N', then the rows of triu(X12) specify the first
                 P reflectors for Q2;
                 else TRANS = 'T', and the columns of  tril(X12)  specify  the
                 first P reflectors for Q2.


       LDX12 (input)
                 LDX12 is INTEGER
                 The  leading  dimension of X12. If TRANS = 'N', then LDX12 >=
                 P; else LDX11 >= M-Q.


       X21 (input/output)
                 X21 is DOUBLE PRECISION array, dimension (LDX21,Q)
                 On entry, the bottom-left block of the orthogonal  matrix  to
                 be reduced.
                 On exit, the form depends on TRANS:
                 If TRANS = 'N', then the columns of tril(X21) specify reflec-
                 tors for P2;
                 else TRANS = 'T', and the rows of triu(X21)  specify  reflec-
                 tors for P2.


       LDX21 (input)
                 LDX21 is INTEGER
                 The  leading  dimension of X21. If TRANS = 'N', then LDX21 >=
                 M-P; else LDX21 >= Q.


       X22 (input/output)
                 X22 is DOUBLE PRECISION array, dimension (LDX22,M-Q)
                 On entry, the bottom-right block of the orthogonal matrix  to
                 be reduced. On exit, the form depends on TRANS:
                 If  TRANS  = 'N', then the rows of triu(X22(Q+1:M-P,P+1:M-Q))
                 specify the last M-P-Q reflectors for Q2,
                 else TRANS = 'T', and the columns of  tril(X22(P+1:M-Q,Q+1:M-
                 P)) specify the last M-P-Q reflectors for P2.


       LDX22 (input)
                 LDX22 is INTEGER
                 The  leading  dimension of X22. If TRANS = 'N', then LDX22 >=
                 M-P; else LDX22 >= M-Q.


       THETA (output)
                 THETA is DOUBLE PRECISION array, dimension (Q)
                 The entries of the bidiagonal blocks B11, B12, B21,  B22  can
                 be  computed  from  the  angles  THETA  and  PHI. See Further
                 Details.


       PHI (output)
                 PHI is DOUBLE PRECISION array, dimension (Q-1)
                 The entries of the bidiagonal blocks B11, B12, B21,  B22  can
                 be  computed  from  the  angles  THETA  and  PHI. See Further
                 Details.


       TAUP1 (output)
                 TAUP1 is DOUBLE PRECISION array, dimension (P)
                 The scalar factors of the elementary reflectors  that  define
                 P1.


       TAUP2 (output)
                 TAUP2 is DOUBLE PRECISION array, dimension (M-P)
                 The  scalar  factors of the elementary reflectors that define
                 P2.


       TAUQ1 (output)
                 TAUQ1 is DOUBLE PRECISION array, dimension (Q)
                 The scalar factors of the elementary reflectors  that  define
                 Q1.


       TAUQ2 (output)
                 TAUQ2 is DOUBLE PRECISION array, dimension (M-Q)
                 The  scalar  factors of the elementary reflectors that define
                 Q2.


       WORK (output)
                 WORK is DOUBLE PRECISION array, dimension (LWORK)


       LWORK (input)
                 LWORK is INTEGER
                 The dimension of the array WORK. LWORK >= M-Q.
                 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)
                 INFO is INTEGER
                 = 0:  successful exit;
                 < 0:  if INFO = -i, the i-th argument had an illegal value.


FURTHER DETAILS
       The bidiagonal blocks B11, B12, B21, and B22 are represented implicitly
       by angles THETA(1), ..., THETA(Q) and PHI(1), ...,  PHI(Q-1).  B11  and
       B21 are upper bidiagonal, while B21 and B22 are lower bidiagonal. Every
       entry in each bidiagonal band is a product of a sine  or  cosine  of  a
       THETA with a sine or cosine of a PHI. See [1] or DORCSD for details.

       P1,  P2,  Q1,  and Q2 are represented as products of elementary reflec-
       tors. See DORCSD for details on generating P1, P2,  Q1,  and  Q2  using
       DORGQR and DORGLQ.


REFERENCES
       [1] Brian D. Sutton. Computing the complete CS decomposition. Numer.
           Algorithms, 50(1):33-65, 2009.




                                  7 Nov 2015                        dorbdb(3P)