uncsd2by1 Interface

public interface uncsd2by1

UNCSD2BY1 computes the CS decomposition of an M-by-Q matrix X with orthonormal columns that has been partitioned into a 2-by-1 block structure: [ I1 0 0 ] [ 0 C 0 ] [ X11 ] [ U1 | ] [ 0 0 0 ] X = [-----] = [---------] [----------] V1**T . [ X21 ] [ | U2 ] [ 0 0 0 ] [ 0 S 0 ] [ 0 0 I2] X11 is P-by-Q. The unitary matrices U1, U2, and V1 are P-by-P, (M-P)-by-(M-P), and Q-by-Q, respectively. C and S are R-by-R nonnegative diagonal matrices satisfying C^2 + S^2 = I, in which R = MIN(P,M-P,Q,M-Q). I1 is a K1-by-K1 identity matrix and I2 is a K2-by-K2 identity matrix, where K1 = MAX(Q+P-M,0), K2 = MAX(Q-P,0).


Subroutines

public subroutine cuncsd2by1(jobu1, jobu2, jobv1t, m, p, q, x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, work, lwork, rwork, lrwork, iwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: jobu1
character(len=1), intent(in) :: jobu2
character(len=1), intent(in) :: jobv1t
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(*)
complex(kind=sp), intent(out) :: u1(ldu1,*)
integer(kind=ilp), intent(in) :: ldu1
complex(kind=sp), intent(out) :: u2(ldu2,*)
integer(kind=ilp), intent(in) :: ldu2
complex(kind=sp), intent(out) :: v1t(ldv1t,*)
integer(kind=ilp), intent(in) :: ldv1t
complex(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
real(kind=sp), intent(out) :: rwork(*)
integer(kind=ilp), intent(in) :: lrwork
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

public subroutine zuncsd2by1(jobu1, jobu2, jobv1t, m, p, q, x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, work, lwork, rwork, lrwork, iwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: jobu1
character(len=1), intent(in) :: jobu2
character(len=1), intent(in) :: jobv1t
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(*)
complex(kind=dp), intent(out) :: u1(ldu1,*)
integer(kind=ilp), intent(in) :: ldu1
complex(kind=dp), intent(out) :: u2(ldu2,*)
integer(kind=ilp), intent(in) :: ldu2
complex(kind=dp), intent(out) :: v1t(ldv1t,*)
integer(kind=ilp), intent(in) :: ldv1t
complex(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
real(kind=dp), intent(out) :: rwork(*)
integer(kind=ilp), intent(in) :: lrwork
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_cuncsd2by1()

Arguments

None

public interface stdlib_zuncsd2by1()

Arguments

None