unbdb Interface

public interface unbdb

UNBDB simultaneously bidiagonalizes the blocks of an M-by-M partitioned unitary matrix X: [ B11 | B12 0 0 ] [ X11 | X12 ] [ P1 | ] [ 0 | 0 -I 0 ] [ Q1 | ]**H 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 CUNCSD for details.) The unitary 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 cunbdb(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
complex(kind=sp), intent(inout) :: x11(ldx11,*)
integer(kind=ilp), intent(in) :: ldx11
complex(kind=sp), intent(inout) :: x12(ldx12,*)
integer(kind=ilp), intent(in) :: ldx12
complex(kind=sp), intent(inout) :: x21(ldx21,*)
integer(kind=ilp), intent(in) :: ldx21
complex(kind=sp), intent(inout) :: x22(ldx22,*)
integer(kind=ilp), intent(in) :: ldx22
real(kind=sp), intent(out) :: theta(*)
real(kind=sp), intent(out) :: phi(*)
complex(kind=sp), intent(out) :: taup1(*)
complex(kind=sp), intent(out) :: taup2(*)
complex(kind=sp), intent(out) :: tauq1(*)
complex(kind=sp), intent(out) :: tauq2(*)
complex(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

public subroutine zunbdb(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
complex(kind=dp), intent(inout) :: x11(ldx11,*)
integer(kind=ilp), intent(in) :: ldx11
complex(kind=dp), intent(inout) :: x12(ldx12,*)
integer(kind=ilp), intent(in) :: ldx12
complex(kind=dp), intent(inout) :: x21(ldx21,*)
integer(kind=ilp), intent(in) :: ldx21
complex(kind=dp), intent(inout) :: x22(ldx22,*)
integer(kind=ilp), intent(in) :: ldx22
real(kind=dp), intent(out) :: theta(*)
real(kind=dp), intent(out) :: phi(*)
complex(kind=dp), intent(out) :: taup1(*)
complex(kind=dp), intent(out) :: taup2(*)
complex(kind=dp), intent(out) :: tauq1(*)
complex(kind=dp), intent(out) :: tauq2(*)
complex(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_cunbdb()

Arguments

None

public interface stdlib_zunbdb()

Arguments

None