LAPACK 3.11.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!
8! Definition:
9! ===========
10!
11! SROTG constructs a plane rotation
12! [ c s ] [ a ] = [ r ]
13! [ -s c ] [ b ] [ 0 ]
14! satisfying c**2 + s**2 = 1.
15!
17! =============
37!
38! Arguments:
39! ==========
40!
66!
67! Authors:
68! ========
69!
71!
73! ==================
76!
78!
80! =====================
90!
91! =====================================================================
92subroutine srotg( a, b, c, s )
93 integer, parameter :: wp = kind(1.e0)
94!
95! -- Reference BLAS level1 routine --
96! -- Reference BLAS is a software package provided by Univ. of Tennessee, --
97! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
98!
99! .. Constants ..
100 real(wp), parameter :: zero = 0.0_wp
101 real(wp), parameter :: one = 1.0_wp
102! ..
103! .. Scaling constants ..
104 real(wp), parameter :: safmin = real(radix(0._wp),wp)**max( &
105 minexponent(0._wp)-1, &
106 1-maxexponent(0._wp) &
107 )
108 real(wp), parameter :: safmax = real(radix(0._wp),wp)**max( &
109 1-minexponent(0._wp), &
110 maxexponent(0._wp)-1 &
111 )
112! ..
113! .. Scalar Arguments ..
114 real(wp) :: a, b, c, s
115! ..
116! .. Local Scalars ..
117 real(wp) :: anorm, bnorm, scl, sigma, r, z
118! ..
119 anorm = abs(a)
120 bnorm = abs(b)
121 if( bnorm == zero ) then
122 c = one
123 s = zero
124 b = zero
125 else if( anorm == zero ) then
126 c = zero
127 s = one
128 a = b
129 b = one
130 else
131 scl = min( safmax, max( safmin, anorm, bnorm ) )
132 if( anorm > bnorm ) then
133 sigma = sign(one,a)
134 else
135 sigma = sign(one,b)
136 end if
137 r = sigma*( scl*sqrt((a/scl)**2 + (b/scl)**2) )
138 c = a/r
139 s = b/r
140 if( anorm > bnorm ) then
141 z = s
142 else if( c /= zero ) then
143 z = one/c
144 else
145 z = one
146 end if
147 a = r
148 b = z
149 end if
150 return
151end subroutine
subroutine srotg(a, b, c, s)
SROTG
Definition: srotg.f90:93