orcsd2by1 Interface

public interface orcsd2by1

ORCSD2BY1 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 orthogonal 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 dorcsd2by1(jobu1, jobu2, jobv1t, m, p, q, x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, work, lwork, 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
real(kind=dp), intent(inout) :: x11(ldx11,*)
integer(kind=ilp), intent(in) :: ldx11
real(kind=dp), intent(inout) :: x21(ldx21,*)
integer(kind=ilp), intent(in) :: ldx21
real(kind=dp), intent(out) :: theta(*)
real(kind=dp), intent(out) :: u1(ldu1,*)
integer(kind=ilp), intent(in) :: ldu1
real(kind=dp), intent(out) :: u2(ldu2,*)
integer(kind=ilp), intent(in) :: ldu2
real(kind=dp), intent(out) :: v1t(ldv1t,*)
integer(kind=ilp), intent(in) :: ldv1t
real(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

public subroutine sorcsd2by1(jobu1, jobu2, jobv1t, m, p, q, x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, ldu2, v1t, ldv1t, work, lwork, 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
real(kind=sp), intent(inout) :: x11(ldx11,*)
integer(kind=ilp), intent(in) :: ldx11
real(kind=sp), intent(inout) :: x21(ldx21,*)
integer(kind=ilp), intent(in) :: ldx21
real(kind=sp), intent(out) :: theta(*)
real(kind=sp), intent(out) :: u1(ldu1,*)
integer(kind=ilp), intent(in) :: ldu1
real(kind=sp), intent(out) :: u2(ldu2,*)
integer(kind=ilp), intent(in) :: ldu2
real(kind=sp), intent(out) :: v1t(ldv1t,*)
integer(kind=ilp), intent(in) :: ldv1t
real(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_dorcsd2by1()

Arguments

None

public interface stdlib_sorcsd2by1()

Arguments

None