unbdb4 Interface

public interface unbdb4

UNBDB4 simultaneously bidiagonalizes the blocks of a tall and skinny matrix X with orthonomal columns: [ B11 ] [ X11 ] [ P1 | ] [ 0 ] [-----] = [---------] [-----] Q1**T . [ X21 ] [ | P2 ] [ B21 ] [ 0 ] X11 is P-by-Q, and X21 is (M-P)-by-Q. M-Q must be no larger than P, M-P, or Q. Routines CUNBDB1, CUNBDB2, and CUNBDB3 handle cases in which M-Q is not the minimum dimension. The unitary matrices P1, P2, and Q1 are P-by-P, (M-P)-by-(M-P), and (M-Q)-by-(M-Q), respectively. They are represented implicitly by Householder vectors. B11 and B12 are (M-Q)-by-(M-Q) bidiagonal matrices represented implicitly by angles THETA, PHI.


Subroutines

public subroutine cunbdb4(m, p, q, x11, ldx11, x21, ldx21, theta, phi, taup1, taup2, tauq1, phantom, work, lwork, info)

Arguments

Type IntentOptional Attributes Name
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) :: x21(ldx21,*)
integer(kind=ilp), intent(in) :: ldx21
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) :: phantom(*)
complex(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

public subroutine zunbdb4(m, p, q, x11, ldx11, x21, ldx21, theta, phi, taup1, taup2, tauq1, phantom, work, lwork, info)

Arguments

Type IntentOptional Attributes Name
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) :: x21(ldx21,*)
integer(kind=ilp), intent(in) :: ldx21
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) :: phantom(*)
complex(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_cunbdb4()

Arguments

None

public interface stdlib_zunbdb4()

Arguments

None