orgbr Interface

public interface orgbr

ORGBR generates one of the real orthogonal matrices Q or PT determined by DGEBRD when reducing a real matrix A to bidiagonal form: A = Q * B * PT. Q and PT are defined as products of elementary reflectors H(i) or G(i) respectively. If VECT = 'Q', A is assumed to have been an M-by-K matrix, and Q is of order M: if m >= k, Q = H(1) H(2) . . . H(k) and ORGBR returns the first n columns of Q, where m >= n >= k; if m < k, Q = H(1) H(2) . . . H(m-1) and ORGBR returns Q as an M-by-M matrix. If VECT = 'P', A is assumed to have been a K-by-N matrix, and PT is of order N: if k < n, PT = G(k) . . . G(2) G(1) and ORGBR returns the first m rows of PT, where n >= m >= k; if k >= n, PT = G(n-1) . . . G(2) G(1) and ORGBR returns PT as an N-by-N matrix.


Subroutines

public pure subroutine dorgbr(vect, m, n, k, a, lda, tau, work, lwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: vect
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: k
real(kind=dp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
real(kind=dp), intent(in) :: tau(*)
real(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

public pure subroutine sorgbr(vect, m, n, k, a, lda, tau, work, lwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: vect
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: k
real(kind=sp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
real(kind=sp), intent(in) :: tau(*)
real(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_dorgbr()

Arguments

None

public interface stdlib_sorgbr()

Arguments

None