LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches
zrscl.f
Go to the documentation of this file.
1*> \brief \b ZDRSCL multiplies a vector by the reciprocal of a real scalar.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zdrscl.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zdrscl.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zdrscl.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE ZRSCL( N, A, X, INCX )
22*
23* .. Scalar Arguments ..
24* INTEGER INCX, N
25* COMPLEX*16 A
26* ..
27* .. Array Arguments ..
28* COMPLEX*16 X( * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> ZRSCL multiplies an n-element complex vector x by the complex scalar
38*> 1/a. This is done without overflow or underflow as long as
39*> the final result x/a does not overflow or underflow.
40*> \endverbatim
41*
42* Arguments:
43* ==========
44*
45*> \param[in] N
46*> \verbatim
47*> N is INTEGER
48*> The number of components of the vector x.
49*> \endverbatim
50*>
51*> \param[in] A
52*> \verbatim
53*> A is COMPLEX*16
54*> The scalar a which is used to divide each component of x.
55*> A must not be 0, or the subroutine will divide by zero.
56*> \endverbatim
57*>
58*> \param[in,out] X
59*> \verbatim
60*> X is COMPLEX*16 array, dimension
61*> (1+(N-1)*abs(INCX))
62*> The n-element vector x.
63*> \endverbatim
64*>
65*> \param[in] INCX
66*> \verbatim
67*> INCX is INTEGER
68*> The increment between successive values of the vector SX.
69*> > 0: SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i), 1< i<= n
70*> \endverbatim
71*
72* Authors:
73* ========
74*
75*> \author Univ. of Tennessee
76*> \author Univ. of California Berkeley
77*> \author Univ. of Colorado Denver
78*> \author NAG Ltd.
79*
80*> \ingroup complex16OTHERauxiliary
81*
82* =====================================================================
83 SUBROUTINE zrscl( N, A, X, INCX )
84*
85* -- LAPACK auxiliary routine --
86* -- LAPACK is a software package provided by Univ. of Tennessee, --
87* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
88*
89* .. Scalar Arguments ..
90 INTEGER INCX, N
91 COMPLEX*16 A
92* ..
93* .. Array Arguments ..
94 COMPLEX*16 X( * )
95* ..
96*
97* =====================================================================
98*
99* .. Parameters ..
100 DOUBLE PRECISION ZERO, ONE
101 parameter( zero = 0.0d+0, one = 1.0d+0 )
102* ..
103* .. Local Scalars ..
104 DOUBLE PRECISION SAFMAX, SAFMIN, OV, AR, AI, ABSR, ABSI, UR, UI
105* ..
106* .. External Functions ..
107 DOUBLE PRECISION DLAMCH
110* ..
111* .. External Subroutines ..
112 EXTERNAL dscal, zdscal, zdrscl
113* ..
114* .. Intrinsic Functions ..
115 INTRINSIC abs
116* ..
117* .. Executable Statements ..
118*
119* Quick return if possible
120*
121 IF( n.LE.0 )
122 \$ RETURN
123*
124* Get machine parameters
125*
126 safmin = dlamch( 'S' )
127 safmax = one / safmin
128 ov = dlamch( 'O' )
129*
130* Initialize constants related to A.
131*
132 ar = dble( a )
133 ai = dimag( a )
134 absr = abs( ar )
135 absi = abs( ai )
136*
137 IF( ai.EQ.zero ) THEN
138* If alpha is real, then we can use csrscl
139 CALL zdrscl( n, ar, x, incx )
140*
141 ELSE IF( ar.EQ.zero ) THEN
142* If alpha has a zero real part, then we follow the same rules as if
143* alpha were real.
144 IF( absi.GT.safmax ) THEN
145 CALL zdscal( n, safmin, x, incx )
146 CALL zscal( n, dcmplx( zero, -safmax / ai ), x, incx )
147 ELSE IF( absi.LT.safmin ) THEN
148 CALL zscal( n, dcmplx( zero, -safmin / ai ), x, incx )
149 CALL zdscal( n, safmax, x, incx )
150 ELSE
151 CALL zscal( n, dcmplx( zero, -one / ai ), x, incx )
152 END IF
153*
154 ELSE
155* The following numbers can be computed.
156* They are the inverse of the real and imaginary parts of 1/alpha.
157* Note that a and b are always different from zero.
158* NaNs are only possible if either:
159* 1. alphaR or alphaI is NaN.
160* 2. alphaR and alphaI are both infinite, in which case it makes sense
161* to propagate a NaN.
162 ur = ar + ai * ( ai / ar )
163 ui = ai + ar * ( ar / ai )
164*
165 IF( (abs( ur ).LT.safmin).OR.(abs( ui ).LT.safmin) ) THEN
166* This means that both alphaR and alphaI are very small.
167 CALL zscal( n, dcmplx( safmin / ur, -safmin / ui ), x,
168 \$ incx )
169 CALL zdscal( n, safmax, x, incx )
170 ELSE IF( (abs( ur ).GT.safmax).OR.(abs( ui ).GT.safmax) ) THEN
171 IF( (absr.GT.ov).OR.(absi.GT.ov) ) THEN
172* This means that a and b are both Inf. No need for scaling.
173 CALL zscal( n, dcmplx( one / ur, -one / ui ), x, incx )
174 ELSE
175 CALL zdscal( n, safmin, x, incx )
176 IF( (abs( ur ).GT.ov).OR.(abs( ui ).GT.ov) ) THEN
177* Infs were generated. We do proper scaling to avoid them.
178 IF( absr.GE.absi ) THEN
179* ABS( UR ) <= ABS( UI )
180 ur = (safmin * ar) + safmin * (ai * ( ai / ar ))
181 ui = (safmin * ai) + ar * ( (safmin * ar) / ai )
182 ELSE
183* ABS( UR ) > ABS( UI )
184 ur = (safmin * ar) + ai * ( (safmin * ai) / ar )
185 ui = (safmin * ai) + safmin * (ar * ( ar / ai ))
186 END IF
187 CALL zscal( n, dcmplx( one / ur, -one / ui ), x,
188 \$ incx )
189 ELSE
190 CALL zscal( n, dcmplx( safmax / ur, -safmax / ui ),
191 \$ x, incx )
192 END IF
193 END IF
194 ELSE
195 CALL zscal( n, dcmplx( one / ur, -one / ui ), x, incx )
196 END IF
197 END IF
198*
199 RETURN
200*
201* End of ZRSCL
202*
203 END
subroutine zdrscl(n, sa, sx, incx)
ZDRSCL multiplies a vector by the reciprocal of a real scalar.
Definition zdrscl.f:84
subroutine dscal(n, da, dx, incx)
DSCAL
Definition dscal.f:79
subroutine zdscal(n, da, zx, incx)
ZDSCAL
Definition zdscal.f:78
subroutine zscal(n, za, zx, incx)
ZSCAL
Definition zscal.f:78
subroutine zrscl(n, a, x, incx)
ZDRSCL multiplies a vector by the reciprocal of a real scalar.
Definition zrscl.f:84