latrz Interface

public interface latrz

LATRZ factors the M-by-(M+L) complex upper trapezoidal matrix [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R 0 ) * Z by means of unitary transformations, where Z is an (M+L)-by-(M+L) unitary matrix and, R and A1 are M-by-M upper triangular matrices.


Subroutines

public pure subroutine clatrz(m, n, l, a, lda, tau, work)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: l
complex(kind=sp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
complex(kind=sp), intent(out) :: tau(*)
complex(kind=sp), intent(out) :: work(*)

public pure subroutine dlatrz(m, n, l, a, lda, tau, work)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: l
real(kind=dp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
real(kind=dp), intent(out) :: tau(*)
real(kind=dp), intent(out) :: work(*)

public pure subroutine slatrz(m, n, l, a, lda, tau, work)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: l
real(kind=sp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
real(kind=sp), intent(out) :: tau(*)
real(kind=sp), intent(out) :: work(*)

public pure subroutine zlatrz(m, n, l, a, lda, tau, work)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: l
complex(kind=dp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
complex(kind=dp), intent(out) :: tau(*)
complex(kind=dp), intent(out) :: work(*)

Module Procedures

public interface stdlib_clatrz()

Arguments

None

public interface stdlib_dlatrz()

Arguments

None

public interface stdlib_slatrz()

Arguments

None

public interface stdlib_zlatrz()

Arguments

None