largv Interface

public interface largv

LARGV generates a vector of complex plane rotations with real cosines, determined by elements of the complex vectors x and y. For i = 1,2,...,n ( c(i) s(i) ) ( x(i) ) = ( r(i) ) ( -conjg(s(i)) c(i) ) ( y(i) ) = ( 0 ) where c(i)2 + ABS(s(i))2 = 1 The following conventions are used (these are the same as in CLARTG, but differ from the BLAS1 routine CROTG): If y(i)=0, then c(i)=1 and s(i)=0. If x(i)=0, then c(i)=0 and s(i) is chosen so that r(i) is real.


Subroutines

public pure subroutine clargv(n, x, incx, y, incy, c, incc)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: n
complex(kind=sp), intent(inout) :: x(*)
integer(kind=ilp), intent(in) :: incx
complex(kind=sp), intent(inout) :: y(*)
integer(kind=ilp), intent(in) :: incy
real(kind=sp), intent(out) :: c(*)
integer(kind=ilp), intent(in) :: incc

public pure subroutine dlargv(n, x, incx, y, incy, c, incc)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: n
real(kind=dp), intent(inout) :: x(*)
integer(kind=ilp), intent(in) :: incx
real(kind=dp), intent(inout) :: y(*)
integer(kind=ilp), intent(in) :: incy
real(kind=dp), intent(out) :: c(*)
integer(kind=ilp), intent(in) :: incc

public pure subroutine slargv(n, x, incx, y, incy, c, incc)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: n
real(kind=sp), intent(inout) :: x(*)
integer(kind=ilp), intent(in) :: incx
real(kind=sp), intent(inout) :: y(*)
integer(kind=ilp), intent(in) :: incy
real(kind=sp), intent(out) :: c(*)
integer(kind=ilp), intent(in) :: incc

public pure subroutine zlargv(n, x, incx, y, incy, c, incc)

Arguments

Type IntentOptional Attributes Name
integer(kind=ilp), intent(in) :: n
complex(kind=dp), intent(inout) :: x(*)
integer(kind=ilp), intent(in) :: incx
complex(kind=dp), intent(inout) :: y(*)
integer(kind=ilp), intent(in) :: incy
real(kind=dp), intent(out) :: c(*)
integer(kind=ilp), intent(in) :: incc

Module Procedures

public interface stdlib_clargv()

Arguments

None

public interface stdlib_dlargv()

Arguments

None

public interface stdlib_slargv()

Arguments

None

public interface stdlib_zlargv()

Arguments

None