LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ zlartg()

subroutine zlartg ( complex(wp)  f,
complex(wp)  g,
real(wp)  c,
complex(wp)  s,
complex(wp)  r 
)

ZLARTG generates a plane rotation with real cosine and complex sine.

Purpose:
 ZLARTG generates a plane rotation so that

    [  C         S  ] . [ F ]  =  [ R ]
    [ -conjg(S)  C  ]   [ G ]     [ 0 ]

 where C is real and C**2 + |S|**2 = 1.

 The mathematical formulas used for C and S are

    sgn(x) = {  x / |x|,   x != 0
             {  1,         x = 0

    R = sgn(F) * sqrt(|F|**2 + |G|**2)

    C = |F| / sqrt(|F|**2 + |G|**2)

    S = sgn(F) * conjg(G) / sqrt(|F|**2 + |G|**2)

 When F and G are real, the formulas simplify to C = F/R and
 S = G/R, and the returned values of C, S, and R should be
 identical to those returned by DLARTG.

 The algorithm used to compute these quantities incorporates scaling
 to avoid overflow or underflow in computing the square root of the
 sum of squares.

 This is a faster version of the BLAS1 routine ZROTG, except for
 the following differences:
    F and G are unchanged on return.
    If G=0, then C=1 and S=0.
    If F=0, then C=0 and S is chosen so that R is real.

 Below, wp=>dp stands for double precision from LA_CONSTANTS module.
Parameters
[in]F
          F is COMPLEX(wp)
          The first component of vector to be rotated.
[in]G
          G is COMPLEX(wp)
          The second component of vector to be rotated.
[out]C
          C is REAL(wp)
          The cosine of the rotation.
[out]S
          S is COMPLEX(wp)
          The sine of the rotation.
[out]R
          R is COMPLEX(wp)
          The nonzero component of the rotated vector.
Author
Edward Anderson, Lockheed Martin
Date
August 2016
Contributors:
Weslley Pereira, University of Colorado Denver, USA
Further Details:
  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 117 of file zlartg.f90.

118  use la_constants, &
119  only: wp=>dp, zero=>dzero, one=>done, two=>dtwo, czero=>zzero, &
120  rtmin=>drtmin, rtmax=>drtmax, safmin=>dsafmin, safmax=>dsafmax
121 !
122 ! -- LAPACK auxiliary routine (version 3.10.0) --
123 ! -- LAPACK is a software package provided by Univ. of Tennessee, --
124 ! -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
125 ! February 2021
126 !
127 ! .. Scalar Arguments ..
128  real(wp) c
129  complex(wp) f, g, r, s
130 ! ..
131 ! .. Local Scalars ..
132  real(wp) :: d, f1, f2, g1, g2, h2, p, u, uu, v, vv, w
133  complex(wp) :: fs, gs, t
134 ! ..
135 ! .. Intrinsic Functions ..
136  intrinsic :: abs, aimag, conjg, max, min, real, sqrt
137 ! ..
138 ! .. Statement Functions ..
139  real(wp) :: ABSSQ
140 ! ..
141 ! .. Statement Function definitions ..
142  abssq( t ) = real( t )**2 + aimag( t )**2
143 ! ..
144 ! .. Executable Statements ..
145 !
146  if( g == czero ) then
147  c = one
148  s = czero
149  r = f
150  else if( f == czero ) then
151  c = zero
152  g1 = max( abs(real(g)), abs(aimag(g)) )
153  if( g1 > rtmin .and. g1 < rtmax ) then
154 !
155 ! Use unscaled algorithm
156 !
157  g2 = abssq( g )
158  d = sqrt( g2 )
159  s = conjg( g ) / d
160  r = d
161  else
162 !
163 ! Use scaled algorithm
164 !
165  u = min( safmax, max( safmin, g1 ) )
166  uu = one / u
167  gs = g*uu
168  g2 = abssq( gs )
169  d = sqrt( g2 )
170  s = conjg( gs ) / d
171  r = d*u
172  end if
173  else
174  f1 = max( abs(real(f)), abs(aimag(f)) )
175  g1 = max( abs(real(g)), abs(aimag(g)) )
176  if( f1 > rtmin .and. f1 < rtmax .and. &
177  g1 > rtmin .and. g1 < rtmax ) then
178 !
179 ! Use unscaled algorithm
180 !
181  f2 = abssq( f )
182  g2 = abssq( g )
183  h2 = f2 + g2
184  if( f2 > rtmin .and. h2 < rtmax ) then
185  d = sqrt( f2*h2 )
186  else
187  d = sqrt( f2 )*sqrt( h2 )
188  end if
189  p = 1 / d
190  c = f2*p
191  s = conjg( g )*( f*p )
192  r = f*( h2*p )
193  else
194 !
195 ! Use scaled algorithm
196 !
197  u = min( safmax, max( safmin, f1, g1 ) )
198  uu = one / u
199  gs = g*uu
200  g2 = abssq( gs )
201  if( f1*uu < rtmin ) then
202 !
203 ! f is not well-scaled when scaled by g1.
204 ! Use a different scaling for f.
205 !
206  v = min( safmax, max( safmin, f1 ) )
207  vv = one / v
208  w = v * uu
209  fs = f*vv
210  f2 = abssq( fs )
211  h2 = f2*w**2 + g2
212  else
213 !
214 ! Otherwise use the same scaling for f and g.
215 !
216  w = one
217  fs = f*uu
218  f2 = abssq( fs )
219  h2 = f2 + g2
220  end if
221  if( f2 > rtmin .and. h2 < rtmax ) then
222  d = sqrt( f2*h2 )
223  else
224  d = sqrt( f2 )*sqrt( h2 )
225  end if
226  p = 1 / d
227  c = ( f2*p )*w
228  s = conjg( gs )*( fs*p )
229  r = ( fs*( h2*p ) )*u
230  end if
231  end if
232  return
real(dp), parameter dtwo
real(dp), parameter dzero
real(dp), parameter drtmax
real(dp), parameter dsafmin
integer, parameter dp
real(dp), parameter drtmin
real(dp), parameter done
complex(sp), parameter czero
complex(dp), parameter zzero
real(dp), parameter dsafmax
LA_CONSTANTS is a module for the scaling constants for the compiled Fortran single and double precisi...
Here is the caller graph for this function: