larz Interface

public interface larz

LARZ applies a complex elementary reflector H to a complex M-by-N matrix C, from either the left or the right. H is represented in the form H = I - tau * v * vH where tau is a complex scalar and v is a complex vector. If tau = 0, then H is taken to be the unit matrix. To apply HH (the conjugate transpose of H), supply conjg(tau) instead tau. H is a product of k elementary reflectors as returned by CTZRZF.


Subroutines

public pure subroutine clarz(side, m, n, l, v, incv, tau, c, ldc, work)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: side
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: l
complex(kind=sp), intent(in) :: v(*)
integer(kind=ilp), intent(in) :: incv
complex(kind=sp), intent(in) :: tau
complex(kind=sp), intent(inout) :: c(ldc,*)
integer(kind=ilp), intent(in) :: ldc
complex(kind=sp), intent(out) :: work(*)

public pure subroutine dlarz(side, m, n, l, v, incv, tau, c, ldc, work)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: side
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: l
real(kind=dp), intent(in) :: v(*)
integer(kind=ilp), intent(in) :: incv
real(kind=dp), intent(in) :: tau
real(kind=dp), intent(inout) :: c(ldc,*)
integer(kind=ilp), intent(in) :: ldc
real(kind=dp), intent(out) :: work(*)

public pure subroutine slarz(side, m, n, l, v, incv, tau, c, ldc, work)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: side
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: l
real(kind=sp), intent(in) :: v(*)
integer(kind=ilp), intent(in) :: incv
real(kind=sp), intent(in) :: tau
real(kind=sp), intent(inout) :: c(ldc,*)
integer(kind=ilp), intent(in) :: ldc
real(kind=sp), intent(out) :: work(*)

public pure subroutine zlarz(side, m, n, l, v, incv, tau, c, ldc, work)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: side
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
integer(kind=ilp), intent(in) :: l
complex(kind=dp), intent(in) :: v(*)
integer(kind=ilp), intent(in) :: incv
complex(kind=dp), intent(in) :: tau
complex(kind=dp), intent(inout) :: c(ldc,*)
integer(kind=ilp), intent(in) :: ldc
complex(kind=dp), intent(out) :: work(*)

Module Procedures

public interface stdlib_clarz()

Arguments

None

public interface stdlib_dlarz()

Arguments

None

public interface stdlib_slarz()

Arguments

None

public interface stdlib_zlarz()

Arguments

None