uncsd Interface

public interface uncsd

UNCSD computes the CS decomposition of an M-by-M partitioned unitary matrix X: [ I 0 0 | 0 0 0 ] [ 0 C 0 | 0 -S 0 ] [ X11 | X12 ] [ U1 | ] [ 0 0 0 | 0 0 -I ] [ V1 | ]**H X = [-----------] = [---------] [---------------------] [---------] . [ X21 | X22 ] [ | U2 ] [ 0 0 0 | I 0 0 ] [ | V2 ] [ 0 S 0 | 0 C 0 ] [ 0 0 I | 0 0 0 ] X11 is P-by-Q. The unitary matrices U1, U2, V1, and V2 are P-by-P, (M-P)-by-(M-P), Q-by-Q, and (M-Q)-by-(M-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).


Subroutines

public recursive subroutine cuncsd(jobu1, jobu2, jobv1t, jobv2t, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, 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
character(len=1), intent(in) :: jobv2t
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(*)
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) :: v2t(ldv2t,*)
integer(kind=ilp), intent(in) :: ldv2t
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 recursive subroutine zuncsd(jobu1, jobu2, jobv1t, jobv2t, trans, signs, m, p, q, x11, ldx11, x12, ldx12, x21, ldx21, x22, ldx22, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, v2t, ldv2t, 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
character(len=1), intent(in) :: jobv2t
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(*)
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) :: v2t(ldv2t,*)
integer(kind=ilp), intent(in) :: ldv2t
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_cuncsd()

Arguments

None

public interface stdlib_zuncsd()

Arguments

None