rotg 接口

public interface rotg

计算使用以下公式: |x| = sqrt( Re(x)2 + Im(x)2 ) sgn(x) = x / |x| if x /= 0 = 1 if x = 0 c = |a| / sqrt(|a|2 + |b|2) s = sgn(a) * conjg(b) / sqrt(|a|2 + |b|2) 当 a 和 b 为实数且 r /= 0 时,公式简化为: r = sgn(a)sqrt(|a|2 + |b|*2) c = a / r s = b / r 与 SROTG 中 |a| > |b| 时相同。当 |b| >= |a| 时,如果 a 和 b 的符号不同,则 c 和 s 的符号将与 SROTG 计算的符号不同。


子例程

public pure subroutine crotg(a, b, c, s)

参数

类型 意图可选 属性 名称
complex(kind=sp), intent(inout) :: a
complex(kind=sp), intent(in) :: b
real(kind=sp), intent(out) :: c
complex(kind=sp), intent(out) :: s

public pure subroutine drotg(a, b, c, s)

参数

类型 意图可选 属性 名称
real(kind=dp), intent(inout) :: a
real(kind=dp), intent(inout) :: b
real(kind=dp), intent(out) :: c
real(kind=dp), intent(out) :: s

public pure subroutine srotg(a, b, c, s)

参数

类型 意图可选 属性 名称
real(kind=sp), intent(inout) :: a
real(kind=sp), intent(inout) :: b
real(kind=sp), intent(out) :: c
real(kind=sp), intent(out) :: s

public pure subroutine zrotg(a, b, c, s)

参数

类型 意图可选 属性 名称
complex(kind=dp), intent(inout) :: a
complex(kind=dp), intent(in) :: b
real(kind=dp), intent(out) :: c
complex(kind=dp), intent(out) :: s

模块过程

public pure subroutine stdlib_crotg(a, b, c, s)

计算使用以下公式: |x| = sqrt( Re(x)2 + Im(x)2 ) sgn(x) = x / |x| if x /= 0 = 1 if x = 0 c = |a| / sqrt(|a|2 + |b|2) s = sgn(a) * conjg(b) / sqrt(|a|2 + |b|2) 当 a 和 b 为实数且 r /= 0 时,公式简化为: r = sgn(a)sqrt(|a|2 + |b|*2) c = a / r s = b / r 与 SROTG 中 |a| > |b| 时相同。当 |b| >= |a| 时,如果 a 和 b 的符号不同,则 c 和 s 的符号将与 SROTG 计算的符号不同。

参数

类型 意图可选 属性 名称
complex(kind=sp), intent(inout) :: a
complex(kind=sp), intent(in) :: b
real(kind=sp), intent(out) :: c
complex(kind=sp), intent(out) :: s

public pure subroutine stdlib_drotg(a, b, c, s)

计算使用以下公式: sigma = sgn(a) if |a| > |b| = sgn(b) if |b| >= |a| r = sigmasqrt( a2 + b2 ) c = 1; s = 0 if r = 0 c = a/r; s = b/r if r != 0 子例程还计算 z = s if |a| > |b|, = 1/c if |b| >= |a| and c != 0 = 1 if c = 0 这允许通过以下方式从 z 重构 c 和 s: 如果 z = 1,则设置 c = 0,s = 1。如果 |z| < 1,则设置 c = sqrt(1 - z2) 和 s = z。如果 |z| > 1,则设置 c = 1/z 和 s = sqrt( 1 - c*2).

参数

类型 意图可选 属性 名称
real(kind=dp), intent(inout) :: a
real(kind=dp), intent(inout) :: b
real(kind=dp), intent(out) :: c
real(kind=dp), intent(out) :: s

public pure subroutine stdlib_srotg(a, b, c, s)

计算使用以下公式: sigma = sgn(a) if |a| > |b| = sgn(b) if |b| >= |a| r = sigmasqrt( a2 + b2 ) c = 1; s = 0 if r = 0 c = a/r; s = b/r if r != 0 子例程还计算 z = s if |a| > |b|, = 1/c if |b| >= |a| and c != 0 = 1 if c = 0 这允许通过以下方式从 z 重构 c 和 s: 如果 z = 1,则设置 c = 0,s = 1。如果 |z| < 1,则设置 c = sqrt(1 - z2) 和 s = z。如果 |z| > 1,则设置 c = 1/z 和 s = sqrt( 1 - c*2).

参数

类型 意图可选 属性 名称
real(kind=sp), intent(inout) :: a
real(kind=sp), intent(inout) :: b
real(kind=sp), intent(out) :: c
real(kind=sp), intent(out) :: s

public pure subroutine stdlib_zrotg(a, b, c, s)

计算使用以下公式: |x| = sqrt( Re(x)2 + Im(x)2 ) sgn(x) = x / |x| if x /= 0 = 1 if x = 0 c = |a| / sqrt(|a|2 + |b|2) s = sgn(a) * conjg(b) / sqrt(|a|2 + |b|2) 当 a 和 b 为实数且 r /= 0 时,公式简化为: r = sgn(a)sqrt(|a|2 + |b|*2) c = a / r s = b / r 与 DROTG 中 |a| > |b| 时相同。当 |b| >= |a| 时,如果 a 和 b 的符号不同,则 c 和 s 的符号将与 DROTG 计算的符号不同。

参数

类型 意图可选 属性 名称
complex(kind=dp), intent(inout) :: a
complex(kind=dp), intent(in) :: b
real(kind=dp), intent(out) :: c
complex(kind=dp), intent(out) :: s