LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
csrscl.f
Go to the documentation of this file.
1*> \brief \b CSRSCL 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
9*> Download CSRSCL + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csrscl.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csrscl.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csrscl.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE CSRSCL( N, SA, SX, INCX )
22*
23* .. Scalar Arguments ..
24* INTEGER INCX, N
25* REAL SA
26* ..
27* .. Array Arguments ..
28* COMPLEX SX( * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> CSRSCL multiplies an n-element complex vector x by the real 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] SA
52*> \verbatim
53*> SA is REAL
54*> The scalar a which is used to divide each component of x.
55*> SA must be >= 0, or the subroutine will divide by zero.
56*> \endverbatim
57*>
58*> \param[in,out] SX
59*> \verbatim
60*> SX 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 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 rscl
81*
82* =====================================================================
83 SUBROUTINE csrscl( N, SA, SX, 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 REAL SA
92* ..
93* .. Array Arguments ..
94 COMPLEX SX( * )
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 LOGICAL DONE
105 REAL BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM
106* ..
107* .. External Functions ..
108 REAL SLAMCH
109 EXTERNAL slamch
110* ..
111* .. External Subroutines ..
112 EXTERNAL csscal
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 smlnum = slamch( 'S' )
127 bignum = one / smlnum
128*
129* Initialize the denominator to SA and the numerator to 1.
130*
131 cden = sa
132 cnum = one
133*
134 10 CONTINUE
135 cden1 = cden*smlnum
136 cnum1 = cnum / bignum
137 IF( abs( cden1 ).GT.abs( cnum ) .AND. cnum.NE.zero ) THEN
138*
139* Pre-multiply X by SMLNUM if CDEN is large compared to CNUM.
140*
141 mul = smlnum
142 done = .false.
143 cden = cden1
144 ELSE IF( abs( cnum1 ).GT.abs( cden ) ) THEN
145*
146* Pre-multiply X by BIGNUM if CDEN is small compared to CNUM.
147*
148 mul = bignum
149 done = .false.
150 cnum = cnum1
151 ELSE
152*
153* Multiply X by CNUM / CDEN and return.
154*
155 mul = cnum / cden
156 done = .true.
157 END IF
158*
159* Scale the vector X by MUL
160*
161 CALL csscal( n, mul, sx, incx )
162*
163 IF( .NOT.done )
164 $ GO TO 10
165*
166 RETURN
167*
168* End of CSRSCL
169*
170 END
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