1: *> \brief \b DRSCL
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 November 2011
81: *
82: *> \ingroup doubleOTHERauxiliary
83: *
84: * =====================================================================
85: SUBROUTINE DRSCL( N, SA, SX, INCX )
86: *
87: * -- LAPACK auxiliary routine (version 3.4.0) --
88: * -- LAPACK is a software package provided by Univ. of Tennessee, --
89: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
90: * November 2011
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
CVSweb interface <joel.bertrand@systella.fr>