Annotation of rpl/lapack/lapack/drscl.f, revision 1.19
1.11 bertrand 1: *> \brief \b DRSCL multiplies a vector by the reciprocal of a real scalar.
1.8 bertrand 2: *
3: * =========== DOCUMENTATION ===========
4: *
1.15 bertrand 5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
1.8 bertrand 7: *
8: *> \htmlonly
1.15 bertrand 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">
1.8 bertrand 15: *> [TXT]</a>
1.15 bertrand 16: *> \endhtmlonly
1.8 bertrand 17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE DRSCL( N, SA, SX, INCX )
1.15 bertrand 22: *
1.8 bertrand 23: * .. Scalar Arguments ..
24: * INTEGER INCX, N
25: * DOUBLE PRECISION SA
26: * ..
27: * .. Array Arguments ..
28: * DOUBLE PRECISION SX( * )
29: * ..
1.15 bertrand 30: *
1.8 bertrand 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: *
1.15 bertrand 75: *> \author Univ. of Tennessee
76: *> \author Univ. of California Berkeley
77: *> \author Univ. of Colorado Denver
78: *> \author NAG Ltd.
1.8 bertrand 79: *
80: *> \ingroup doubleOTHERauxiliary
81: *
82: * =====================================================================
1.1 bertrand 83: SUBROUTINE DRSCL( N, SA, SX, INCX )
84: *
1.19 ! bertrand 85: * -- LAPACK auxiliary routine --
1.1 bertrand 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: DOUBLE PRECISION SA
92: * ..
93: * .. Array Arguments ..
94: DOUBLE PRECISION SX( * )
95: * ..
96: *
97: * =====================================================================
98: *
99: * .. Parameters ..
100: DOUBLE PRECISION ONE, ZERO
101: PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
102: * ..
103: * .. Local Scalars ..
104: LOGICAL DONE
105: DOUBLE PRECISION BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM
106: * ..
107: * .. External Functions ..
108: DOUBLE PRECISION DLAMCH
109: EXTERNAL DLAMCH
110: * ..
111: * .. External Subroutines ..
1.17 bertrand 112: EXTERNAL DSCAL, DLABAD
1.1 bertrand 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 = DLAMCH( 'S' )
127: BIGNUM = ONE / SMLNUM
128: CALL DLABAD( SMLNUM, BIGNUM )
129: *
130: * Initialize the denominator to SA and the numerator to 1.
131: *
132: CDEN = SA
133: CNUM = ONE
134: *
135: 10 CONTINUE
136: CDEN1 = CDEN*SMLNUM
137: CNUM1 = CNUM / BIGNUM
138: IF( ABS( CDEN1 ).GT.ABS( CNUM ) .AND. CNUM.NE.ZERO ) THEN
139: *
140: * Pre-multiply X by SMLNUM if CDEN is large compared to CNUM.
141: *
142: MUL = SMLNUM
143: DONE = .FALSE.
144: CDEN = CDEN1
145: ELSE IF( ABS( CNUM1 ).GT.ABS( CDEN ) ) THEN
146: *
147: * Pre-multiply X by BIGNUM if CDEN is small compared to CNUM.
148: *
149: MUL = BIGNUM
150: DONE = .FALSE.
151: CNUM = CNUM1
152: ELSE
153: *
154: * Multiply X by CNUM / CDEN and return.
155: *
156: MUL = CNUM / CDEN
157: DONE = .TRUE.
158: END IF
159: *
160: * Scale the vector X by MUL
161: *
162: CALL DSCAL( N, MUL, SX, INCX )
163: *
164: IF( .NOT.DONE )
165: $ GO TO 10
166: *
167: RETURN
168: *
169: * End of DRSCL
170: *
171: END
CVSweb interface <joel.bertrand@systella.fr>