LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ zlargv()

subroutine zlargv ( integer  N,
complex*16, dimension( * )  X,
integer  INCX,
complex*16, dimension( * )  Y,
integer  INCY,
double precision, dimension( * )  C,
integer  INCC 
)

ZLARGV generates a vector of plane rotations with real cosines and complex sines.

Download ZLARGV + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 ZLARGV generates a vector of complex plane rotations with real
 cosines, determined by elements of the complex vectors x and y.
 For i = 1,2,...,n

    (        c(i)   s(i) ) ( x(i) ) = ( r(i) )
    ( -conjg(s(i))  c(i) ) ( y(i) ) = (   0  )

    where c(i)**2 + ABS(s(i))**2 = 1

 The following conventions are used (these are the same as in ZLARTG,
 but differ from the BLAS1 routine ZROTG):
    If y(i)=0, then c(i)=1 and s(i)=0.
    If x(i)=0, then c(i)=0 and s(i) is chosen so that r(i) is real.
Parameters
[in]N
          N is INTEGER
          The number of plane rotations to be generated.
[in,out]X
          X is COMPLEX*16 array, dimension (1+(N-1)*INCX)
          On entry, the vector x.
          On exit, x(i) is overwritten by r(i), for i = 1,...,n.
[in]INCX
          INCX is INTEGER
          The increment between elements of X. INCX > 0.
[in,out]Y
          Y is COMPLEX*16 array, dimension (1+(N-1)*INCY)
          On entry, the vector y.
          On exit, the sines of the plane rotations.
[in]INCY
          INCY is INTEGER
          The increment between elements of Y. INCY > 0.
[out]C
          C is DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
          The cosines of the plane rotations.
[in]INCC
          INCC is INTEGER
          The increment between elements of C. INCC > 0.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
  6-6-96 - Modified with a new algorithm by W. Kahan and J. Demmel

  This version has a few statements commented out for thread safety
  (machine parameters are computed on each entry). 10 feb 03, SJH.

Definition at line 121 of file zlargv.f.

122 *
123 * -- LAPACK auxiliary routine --
124 * -- LAPACK is a software package provided by Univ. of Tennessee, --
125 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
126 *
127 * .. Scalar Arguments ..
128  INTEGER INCC, INCX, INCY, N
129 * ..
130 * .. Array Arguments ..
131  DOUBLE PRECISION C( * )
132  COMPLEX*16 X( * ), Y( * )
133 * ..
134 *
135 * =====================================================================
136 *
137 * .. Parameters ..
138  DOUBLE PRECISION TWO, ONE, ZERO
139  parameter( two = 2.0d+0, one = 1.0d+0, zero = 0.0d+0 )
140  COMPLEX*16 CZERO
141  parameter( czero = ( 0.0d+0, 0.0d+0 ) )
142 * ..
143 * .. Local Scalars ..
144 * LOGICAL FIRST
145 
146  INTEGER COUNT, I, IC, IX, IY, J
147  DOUBLE PRECISION CS, D, DI, DR, EPS, F2, F2S, G2, G2S, SAFMIN,
148  $ SAFMN2, SAFMX2, SCALE
149  COMPLEX*16 F, FF, FS, G, GS, R, SN
150 * ..
151 * .. External Functions ..
152  DOUBLE PRECISION DLAMCH, DLAPY2
153  EXTERNAL dlamch, dlapy2
154 * ..
155 * .. Intrinsic Functions ..
156  INTRINSIC abs, dble, dcmplx, dconjg, dimag, int, log,
157  $ max, sqrt
158 * ..
159 * .. Statement Functions ..
160  DOUBLE PRECISION ABS1, ABSSQ
161 * ..
162 * .. Save statement ..
163 * SAVE FIRST, SAFMX2, SAFMIN, SAFMN2
164 * ..
165 * .. Data statements ..
166 * DATA FIRST / .TRUE. /
167 * ..
168 * .. Statement Function definitions ..
169  abs1( ff ) = max( abs( dble( ff ) ), abs( dimag( ff ) ) )
170  abssq( ff ) = dble( ff )**2 + dimag( ff )**2
171 * ..
172 * .. Executable Statements ..
173 *
174 * IF( FIRST ) THEN
175 * FIRST = .FALSE.
176  safmin = dlamch( 'S' )
177  eps = dlamch( 'E' )
178  safmn2 = dlamch( 'B' )**int( log( safmin / eps ) /
179  $ log( dlamch( 'B' ) ) / two )
180  safmx2 = one / safmn2
181 * END IF
182  ix = 1
183  iy = 1
184  ic = 1
185  DO 60 i = 1, n
186  f = x( ix )
187  g = y( iy )
188 *
189 * Use identical algorithm as in ZLARTG
190 *
191  scale = max( abs1( f ), abs1( g ) )
192  fs = f
193  gs = g
194  count = 0
195  IF( scale.GE.safmx2 ) THEN
196  10 CONTINUE
197  count = count + 1
198  fs = fs*safmn2
199  gs = gs*safmn2
200  scale = scale*safmn2
201  IF( scale.GE.safmx2 .AND. count .LT. 20 )
202  $ GO TO 10
203  ELSE IF( scale.LE.safmn2 ) THEN
204  IF( g.EQ.czero ) THEN
205  cs = one
206  sn = czero
207  r = f
208  GO TO 50
209  END IF
210  20 CONTINUE
211  count = count - 1
212  fs = fs*safmx2
213  gs = gs*safmx2
214  scale = scale*safmx2
215  IF( scale.LE.safmn2 )
216  $ GO TO 20
217  END IF
218  f2 = abssq( fs )
219  g2 = abssq( gs )
220  IF( f2.LE.max( g2, one )*safmin ) THEN
221 *
222 * This is a rare case: F is very small.
223 *
224  IF( f.EQ.czero ) THEN
225  cs = zero
226  r = dlapy2( dble( g ), dimag( g ) )
227 * Do complex/real division explicitly with two real
228 * divisions
229  d = dlapy2( dble( gs ), dimag( gs ) )
230  sn = dcmplx( dble( gs ) / d, -dimag( gs ) / d )
231  GO TO 50
232  END IF
233  f2s = dlapy2( dble( fs ), dimag( fs ) )
234 * G2 and G2S are accurate
235 * G2 is at least SAFMIN, and G2S is at least SAFMN2
236  g2s = sqrt( g2 )
237 * Error in CS from underflow in F2S is at most
238 * UNFL / SAFMN2 .lt. sqrt(UNFL*EPS) .lt. EPS
239 * If MAX(G2,ONE)=G2, then F2 .lt. G2*SAFMIN,
240 * and so CS .lt. sqrt(SAFMIN)
241 * If MAX(G2,ONE)=ONE, then F2 .lt. SAFMIN
242 * and so CS .lt. sqrt(SAFMIN)/SAFMN2 = sqrt(EPS)
243 * Therefore, CS = F2S/G2S / sqrt( 1 + (F2S/G2S)**2 ) = F2S/G2S
244  cs = f2s / g2s
245 * Make sure abs(FF) = 1
246 * Do complex/real division explicitly with 2 real divisions
247  IF( abs1( f ).GT.one ) THEN
248  d = dlapy2( dble( f ), dimag( f ) )
249  ff = dcmplx( dble( f ) / d, dimag( f ) / d )
250  ELSE
251  dr = safmx2*dble( f )
252  di = safmx2*dimag( f )
253  d = dlapy2( dr, di )
254  ff = dcmplx( dr / d, di / d )
255  END IF
256  sn = ff*dcmplx( dble( gs ) / g2s, -dimag( gs ) / g2s )
257  r = cs*f + sn*g
258  ELSE
259 *
260 * This is the most common case.
261 * Neither F2 nor F2/G2 are less than SAFMIN
262 * F2S cannot overflow, and it is accurate
263 *
264  f2s = sqrt( one+g2 / f2 )
265 * Do the F2S(real)*FS(complex) multiply with two real
266 * multiplies
267  r = dcmplx( f2s*dble( fs ), f2s*dimag( fs ) )
268  cs = one / f2s
269  d = f2 + g2
270 * Do complex/real division explicitly with two real divisions
271  sn = dcmplx( dble( r ) / d, dimag( r ) / d )
272  sn = sn*dconjg( gs )
273  IF( count.NE.0 ) THEN
274  IF( count.GT.0 ) THEN
275  DO 30 j = 1, count
276  r = r*safmx2
277  30 CONTINUE
278  ELSE
279  DO 40 j = 1, -count
280  r = r*safmn2
281  40 CONTINUE
282  END IF
283  END IF
284  END IF
285  50 CONTINUE
286  c( ic ) = cs
287  y( iy ) = sn
288  x( ix ) = r
289  ic = ic + incc
290  iy = iy + incy
291  ix = ix + incx
292  60 CONTINUE
293  RETURN
294 *
295 * End of ZLARGV
296 *
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:69
double precision function dlapy2(X, Y)
DLAPY2 returns sqrt(x2+y2).
Definition: dlapy2.f:63
Here is the caller graph for this function: