LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches
crscl.f
Go to the documentation of this file.
1*> \brief \b CRSCL 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/crscl.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/crscl.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/crscl.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE CRSCL( N, A, X, INCX )
22*
23* .. Scalar Arguments ..
24* INTEGER INCX, N
25* COMPLEX A
26* ..
27* .. Array Arguments ..
28* COMPLEX X( * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> CRSCL 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
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 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 X.
69*> > 0: X(1) = X(1) and X(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 complexOTHERauxiliary
81*
82* =====================================================================
83 SUBROUTINE crscl( 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 A
92* ..
93* .. Array Arguments ..
94 COMPLEX X( * )
95* ..
96*
97* =====================================================================
98*
99* .. Parameters ..
100 REAL ZERO, ONE
101 parameter( zero = 0.0e+0, one = 1.0e+0 )
102* ..
103* .. Local Scalars ..
104 REAL SAFMAX, SAFMIN, OV, AR, AI, ABSR, ABSI, UR
105 % , UI
106* ..
107* .. External Functions ..
108 REAL SLAMCH
111* ..
112* .. External Subroutines ..
113 EXTERNAL cscal, csscal, csrscl
114* ..
115* .. Intrinsic Functions ..
116 INTRINSIC abs
117* ..
118* .. Executable Statements ..
119*
120* Quick return if possible
121*
122 IF( n.LE.0 )
123 \$ RETURN
124*
125* Get machine parameters
126*
127 safmin = slamch( 'S' )
128 safmax = one / safmin
129 ov = slamch( 'O' )
130*
131* Initialize constants related to A.
132*
133 ar = real( a )
134 ai = aimag( a )
135 absr = abs( ar )
136 absi = abs( ai )
137*
138 IF( ai.EQ.zero ) THEN
139* If alpha is real, then we can use csrscl
140 CALL csrscl( n, ar, x, incx )
141*
142 ELSE IF( ar.EQ.zero ) THEN
143* If alpha has a zero real part, then we follow the same rules as if
144* alpha were real.
145 IF( absi.GT.safmax ) THEN
146 CALL csscal( n, safmin, x, incx )
147 CALL cscal( n, cmplx( zero, -safmax / ai ), x, incx )
148 ELSE IF( absi.LT.safmin ) THEN
149 CALL cscal( n, cmplx( zero, -safmin / ai ), x, incx )
150 CALL csscal( n, safmax, x, incx )
151 ELSE
152 CALL cscal( n, cmplx( zero, -one / ai ), x, incx )
153 END IF
154*
155 ELSE
156* The following numbers can be computed.
157* They are the inverse of the real and imaginary parts of 1/alpha.
158* Note that a and b are always different from zero.
159* NaNs are only possible if either:
160* 1. alphaR or alphaI is NaN.
161* 2. alphaR and alphaI are both infinite, in which case it makes sense
162* to propagate a NaN.
163 ur = ar + ai * ( ai / ar )
164 ui = ai + ar * ( ar / ai )
165*
166 IF( (abs( ur ).LT.safmin).OR.(abs( ui ).LT.safmin) ) THEN
167* This means that both alphaR and alphaI are very small.
168 CALL cscal( n, cmplx( safmin / ur, -safmin / ui ), x, incx )
169 CALL csscal( 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 cscal( n, cmplx( one / ur, -one / ui ), x, incx )
174 ELSE
175 CALL csscal( 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 cscal( n, cmplx( one / ur, -one / ui ), x, incx )
188 ELSE
189 CALL cscal( n, cmplx( safmax / ur, -safmax / ui ),
190 \$ x, incx )
191 END IF
192 END IF
193 ELSE
194 CALL cscal( n, cmplx( one / ur, -one / ui ), x, incx )
195 END IF
196 END IF
197*
198 RETURN
199*
200* End of CRSCL
201*
202 END
subroutine crscl(n, a, x, incx)
CRSCL multiplies a vector by the reciprocal of a real scalar.
Definition crscl.f:84
subroutine csrscl(n, sa, sx, incx)
CSRSCL multiplies a vector by the reciprocal of a real scalar.
Definition csrscl.f:84
subroutine csscal(n, sa, cx, incx)
CSSCAL
Definition csscal.f:78
subroutine cscal(n, ca, cx, incx)
CSCAL
Definition cscal.f:78