LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ zrotg()

subroutine zrotg ( complex(wp)  a,
complex(wp)  b,
real(wp)  c,
complex(wp)  s 
)

ZROTG generates a Givens rotation with real cosine and complex sine.

Purpose:
 ZROTG constructs a plane rotation
    [  c         s ] [ a ] = [ r ]
    [ -conjg(s)  c ] [ b ]   [ 0 ]
 where c is real, s is complex, and c**2 + conjg(s)*s = 1.

 The computation uses the formulas
    |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)
    r = sgn(a)*sqrt(|a|**2 + |b|**2)
 When a and b are real and r /= 0, the formulas simplify to
    c = a / r
    s = b / r
 the same as in DROTG when |a| > |b|.  When |b| >= |a|, the
 sign of c and s will be different from those computed by DROTG
 if the signs of a and b are not the same.
See also
lartg: generate plane rotation, more accurate than BLAS rot,
lartgp: generate plane rotation, more accurate than BLAS rot
Parameters
[in,out]A
          A is DOUBLE COMPLEX
          On entry, the scalar a.
          On exit, the scalar r.
[in]B
          B is DOUBLE COMPLEX
          The scalar b.
[out]C
          C is DOUBLE PRECISION
          The scalar c.
[out]S
          S is DOUBLE COMPLEX
          The scalar s.
Author
Weslley Pereira, University of Colorado Denver, USA
Date
December 2021
Further Details:
 Based on the algorithm from

  Anderson E. (2017)
  Algorithm 978: Safe Scaling in the Level 1 BLAS
  ACM Trans Math Softw 44:1--28
  https://doi.org/10.1145/3061665

Definition at line 88 of file zrotg.f90.

89 integer, parameter :: wp = kind(1.d0)
90!
91! -- Reference BLAS level1 routine --
92! -- Reference BLAS is a software package provided by Univ. of Tennessee, --
93! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
94!
95! .. Constants ..
96 real(wp), parameter :: zero = 0.0_wp
97 real(wp), parameter :: one = 1.0_wp
98 complex(wp), parameter :: czero = 0.0_wp
99! ..
100! .. Scaling constants ..
101 real(wp), parameter :: safmin = real(radix(0._wp),wp)**max( &
102 minexponent(0._wp)-1, &
103 1-maxexponent(0._wp) &
104 )
105 real(wp), parameter :: safmax = real(radix(0._wp),wp)**max( &
106 1-minexponent(0._wp), &
107 maxexponent(0._wp)-1 &
108 )
109 real(wp), parameter :: rtmin = sqrt( safmin )
110! ..
111! .. Scalar Arguments ..
112 real(wp) :: c
113 complex(wp) :: a, b, s
114! ..
115! .. Local Scalars ..
116 real(wp) :: d, f1, f2, g1, g2, h2, u, v, w, rtmax
117 complex(wp) :: f, fs, g, gs, r, t
118! ..
119! .. Intrinsic Functions ..
120 intrinsic :: abs, aimag, conjg, max, min, real, sqrt
121! ..
122! .. Statement Functions ..
123 real(wp) :: ABSSQ
124! ..
125! .. Statement Function definitions ..
126 abssq( t ) = real( t )**2 + aimag( t )**2
127! ..
128! .. Executable Statements ..
129!
130 f = a
131 g = b
132 if( g == czero ) then
133 c = one
134 s = czero
135 r = f
136 else if( f == czero ) then
137 c = zero
138 if( real(g) == zero ) then
139 r = abs(aimag(g))
140 s = conjg( g ) / r
141 elseif( aimag(g) == zero ) then
142 r = abs(real(g))
143 s = conjg( g ) / r
144 else
145 g1 = max( abs(real(g)), abs(aimag(g)) )
146 rtmax = sqrt( safmax/2 )
147 if( g1 > rtmin .and. g1 < rtmax ) then
148!
149! Use unscaled algorithm
150!
151! The following two lines can be replaced by `d = abs( g )`.
152! This algorithm do not use the intrinsic complex abs.
153 g2 = abssq( g )
154 d = sqrt( g2 )
155 s = conjg( g ) / d
156 r = d
157 else
158!
159! Use scaled algorithm
160!
161 u = min( safmax, max( safmin, g1 ) )
162 gs = g / u
163! The following two lines can be replaced by `d = abs( gs )`.
164! This algorithm do not use the intrinsic complex abs.
165 g2 = abssq( gs )
166 d = sqrt( g2 )
167 s = conjg( gs ) / d
168 r = d*u
169 end if
170 end if
171 else
172 f1 = max( abs(real(f)), abs(aimag(f)) )
173 g1 = max( abs(real(g)), abs(aimag(g)) )
174 rtmax = sqrt( safmax/4 )
175 if( f1 > rtmin .and. f1 < rtmax .and. &
176 g1 > rtmin .and. g1 < rtmax ) then
177!
178! Use unscaled algorithm
179!
180 f2 = abssq( f )
181 g2 = abssq( g )
182 h2 = f2 + g2
183 ! safmin <= f2 <= h2 <= safmax
184 if( f2 >= h2 * safmin ) then
185 ! safmin <= f2/h2 <= 1, and h2/f2 is finite
186 c = sqrt( f2 / h2 )
187 r = f / c
188 rtmax = rtmax * 2
189 if( f2 > rtmin .and. h2 < rtmax ) then
190 ! safmin <= sqrt( f2*h2 ) <= safmax
191 s = conjg( g ) * ( f / sqrt( f2*h2 ) )
192 else
193 s = conjg( g ) * ( r / h2 )
194 end if
195 else
196 ! f2/h2 <= safmin may be subnormal, and h2/f2 may overflow.
197 ! Moreover,
198 ! safmin <= f2*f2 * safmax < f2 * h2 < h2*h2 * safmin <= safmax,
199 ! sqrt(safmin) <= sqrt(f2 * h2) <= sqrt(safmax).
200 ! Also,
201 ! g2 >> f2, which means that h2 = g2.
202 d = sqrt( f2 * h2 )
203 c = f2 / d
204 if( c >= safmin ) then
205 r = f / c
206 else
207 ! f2 / sqrt(f2 * h2) < safmin, then
208 ! sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
209 r = f * ( h2 / d )
210 end if
211 s = conjg( g ) * ( f / d )
212 end if
213 else
214!
215! Use scaled algorithm
216!
217 u = min( safmax, max( safmin, f1, g1 ) )
218 gs = g / u
219 g2 = abssq( gs )
220 if( f1 / u < rtmin ) then
221!
222! f is not well-scaled when scaled by g1.
223! Use a different scaling for f.
224!
225 v = min( safmax, max( safmin, f1 ) )
226 w = v / u
227 fs = f / v
228 f2 = abssq( fs )
229 h2 = f2*w**2 + g2
230 else
231!
232! Otherwise use the same scaling for f and g.
233!
234 w = one
235 fs = f / u
236 f2 = abssq( fs )
237 h2 = f2 + g2
238 end if
239 ! safmin <= f2 <= h2 <= safmax
240 if( f2 >= h2 * safmin ) then
241 ! safmin <= f2/h2 <= 1, and h2/f2 is finite
242 c = sqrt( f2 / h2 )
243 r = fs / c
244 rtmax = rtmax * 2
245 if( f2 > rtmin .and. h2 < rtmax ) then
246 ! safmin <= sqrt( f2*h2 ) <= safmax
247 s = conjg( gs ) * ( fs / sqrt( f2*h2 ) )
248 else
249 s = conjg( gs ) * ( r / h2 )
250 end if
251 else
252 ! f2/h2 <= safmin may be subnormal, and h2/f2 may overflow.
253 ! Moreover,
254 ! safmin <= f2*f2 * safmax < f2 * h2 < h2*h2 * safmin <= safmax,
255 ! sqrt(safmin) <= sqrt(f2 * h2) <= sqrt(safmax).
256 ! Also,
257 ! g2 >> f2, which means that h2 = g2.
258 d = sqrt( f2 * h2 )
259 c = f2 / d
260 if( c >= safmin ) then
261 r = fs / c
262 else
263 ! f2 / sqrt(f2 * h2) < safmin, then
264 ! sqrt(safmin) <= f2 * sqrt(safmax) <= h2 / sqrt(f2 * h2) <= h2 * (safmin / f2) <= h2 <= safmax
265 r = fs * ( h2 / d )
266 end if
267 s = conjg( gs ) * ( fs / d )
268 end if
269 ! Rescale c and r
270 c = c * w
271 r = r * u
272 end if
273 end if
274 a = r
275 return
Here is the caller graph for this function: