LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
srotg.f90
Go to the documentation of this file.
1
2!
3! =========== DOCUMENTATION ===========
4!
5! Online html documentation available at
6! http://www.netlib.org/lapack/explore-html/
7!
9! =============
36!
37! Arguments:
38! ==========
39!
65!
66! Authors:
67! ========
68!
70!
72! ==================
75!
77!
79! =====================
89!
90! =====================================================================
91subroutine srotg( a, b, c, s )
92 integer, parameter :: wp = kind(1.e0)
93!
94! -- Reference BLAS level1 routine --
95! -- Reference BLAS is a software package provided by Univ. of Tennessee, --
96! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
97!
98! .. Constants ..
99 real(wp), parameter :: zero = 0.0_wp
100 real(wp), parameter :: one = 1.0_wp
101! ..
102! .. Scaling constants ..
103 real(wp), parameter :: safmin = real(radix(0._wp),wp)**max( &
104 minexponent(0._wp)-1, &
105 1-maxexponent(0._wp) &
106 )
107 real(wp), parameter :: safmax = real(radix(0._wp),wp)**max( &
108 1-minexponent(0._wp), &
109 maxexponent(0._wp)-1 &
110 )
111! ..
112! .. Scalar Arguments ..
113 real(wp) :: a, b, c, s
114! ..
115! .. Local Scalars ..
116 real(wp) :: anorm, bnorm, scl, sigma, r, z
117! ..
118 anorm = abs(a)
119 bnorm = abs(b)
120 if( bnorm == zero ) then
121 c = one
122 s = zero
123 b = zero
124 else if( anorm == zero ) then
125 c = zero
126 s = one
127 a = b
128 b = one
129 else
130 scl = min( safmax, max( safmin, anorm, bnorm ) )
131 if( anorm > bnorm ) then
132 sigma = sign(one,a)
133 else
134 sigma = sign(one,b)
135 end if
136 r = sigma*( scl*sqrt((a/scl)**2 + (b/scl)**2) )
137 c = a/r
138 s = b/r
139 if( anorm > bnorm ) then
140 z = s
141 else if( c /= zero ) then
142 z = one/c
143 else
144 z = one
145 end if
146 a = r
147 b = z
148 end if
149 return
150end subroutine
subroutine srotg(a, b, c, s)
SROTG
Definition srotg.f90:92