orbdb Interface

public interface orbdb

ORBDB simultaneously bidiagonalizes the blocks of an M-by-M partitioned 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 implicitly by Householder vectors. B11, B12, B21, and B22 are Q-by-Q bidiagonal matrices represented implicitly by angles THETA, PHI.


Subroutines

public subroutine dorbdb(trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, phi, taup1, taup2, tauq1, tauq2, work, lwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: trans
character(len=1), intent(in) :: signs
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: p
integer(kind=ilp), intent(in) :: q
real(kind=dp), intent(inout) :: x11(ldx11,*)
integer(kind=ilp), intent(in) :: ldx11
real(kind=dp), intent(inout) :: x12(ldx12,*)
integer(kind=ilp), intent(in) :: ldx12
real(kind=dp), intent(inout) :: x21(ldx21,*)
integer(kind=ilp), intent(in) :: ldx21
real(kind=dp), intent(inout) :: x22(ldx22,*)
integer(kind=ilp), intent(in) :: ldx22
real(kind=dp), intent(out) :: theta(*)
real(kind=dp), intent(out) :: phi(*)
real(kind=dp), intent(out) :: taup1(*)
real(kind=dp), intent(out) :: taup2(*)
real(kind=dp), intent(out) :: tauq1(*)
real(kind=dp), intent(out) :: tauq2(*)
real(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

public subroutine sorbdb(trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, phi, taup1, taup2, tauq1, tauq2, work, lwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: trans
character(len=1), intent(in) :: signs
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: p
integer(kind=ilp), intent(in) :: q
real(kind=sp), intent(inout) :: x11(ldx11,*)
integer(kind=ilp), intent(in) :: ldx11
real(kind=sp), intent(inout) :: x12(ldx12,*)
integer(kind=ilp), intent(in) :: ldx12
real(kind=sp), intent(inout) :: x21(ldx21,*)
integer(kind=ilp), intent(in) :: ldx21
real(kind=sp), intent(inout) :: x22(ldx22,*)
integer(kind=ilp), intent(in) :: ldx22
real(kind=sp), intent(out) :: theta(*)
real(kind=sp), intent(out) :: phi(*)
real(kind=sp), intent(out) :: taup1(*)
real(kind=sp), intent(out) :: taup2(*)
real(kind=sp), intent(out) :: tauq1(*)
real(kind=sp), intent(out) :: tauq2(*)
real(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_dorbdb()

Arguments

None

public interface stdlib_sorbdb()

Arguments

None