LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
•All Files Functions Groups
drscl.f
Go to the documentation of this file.
1 *> \brief \b DRSCL 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 DRSCL + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/drscl.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/drscl.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/drscl.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE DRSCL( N, SA, SX, INCX )
22 *
23 * .. Scalar Arguments ..
24 * INTEGER INCX, N
25 * DOUBLE PRECISION SA
26 * ..
27 * .. Array Arguments ..
28 * DOUBLE PRECISION SX( * )
29 * ..
30 *
31 *
32 *> \par Purpose:
33 * =============
34 *>
35 *> \verbatim
36 *>
37 *> DRSCL multiplies an n-element real vector x by the real scalar 1/a.
38 *> 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 DOUBLE PRECISION
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 DOUBLE PRECISION 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 *> \date September 2012
81 *
82 *> \ingroup doubleOTHERauxiliary
83 *
84 * =====================================================================
85  SUBROUTINE drscl( N, SA, SX, INCX )
86 *
87 * -- LAPACK auxiliary routine (version 3.4.2) --
88 * -- LAPACK is a software package provided by Univ. of Tennessee, --
89 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
90 * September 2012
91 *
92 * .. Scalar Arguments ..
93  INTEGER incx, n
94  DOUBLE PRECISION sa
95 * ..
96 * .. Array Arguments ..
97  DOUBLE PRECISION sx( * )
98 * ..
99 *
100 * =====================================================================
101 *
102 * .. Parameters ..
103  DOUBLE PRECISION one, zero
104  parameter( one = 1.0d+0, zero = 0.0d+0 )
105 * ..
106 * .. Local Scalars ..
107  LOGICAL done
108  DOUBLE PRECISION bignum, cden, cden1, cnum, cnum1, mul, smlnum
109 * ..
110 * .. External Functions ..
111  DOUBLE PRECISION dlamch
112  EXTERNAL dlamch
113 * ..
114 * .. External Subroutines ..
115  EXTERNAL dscal
116 * ..
117 * .. Intrinsic Functions ..
118  INTRINSIC abs
119 * ..
120 * .. Executable Statements ..
121 *
122 * Quick return if possible
123 *
124  IF( n.LE.0 )
125  $ return
126 *
127 * Get machine parameters
128 *
129  smlnum = dlamch( 'S' )
130  bignum = one / smlnum
131  CALL dlabad( smlnum, bignum )
132 *
133 * Initialize the denominator to SA and the numerator to 1.
134 *
135  cden = sa
136  cnum = one
137 *
138  10 continue
139  cden1 = cden*smlnum
140  cnum1 = cnum / bignum
141  IF( abs( cden1 ).GT.abs( cnum ) .AND. cnum.NE.zero ) THEN
142 *
143 * Pre-multiply X by SMLNUM if CDEN is large compared to CNUM.
144 *
145  mul = smlnum
146  done = .false.
147  cden = cden1
148  ELSE IF( abs( cnum1 ).GT.abs( cden ) ) THEN
149 *
150 * Pre-multiply X by BIGNUM if CDEN is small compared to CNUM.
151 *
152  mul = bignum
153  done = .false.
154  cnum = cnum1
155  ELSE
156 *
157 * Multiply X by CNUM / CDEN and return.
158 *
159  mul = cnum / cden
160  done = .true.
161  END IF
162 *
163 * Scale the vector X by MUL
164 *
165  CALL dscal( n, mul, sx, incx )
166 *
167  IF( .NOT.done )
168  $ go to 10
169 *
170  return
171 *
172 * End of DRSCL
173 *
174  END