Annotation of rpl/lapack/lapack/zdrscl.f, revision 1.8
1.8 ! bertrand 1: *> \brief \b ZDRSCL
! 2: *
! 3: * =========== DOCUMENTATION ===========
! 4: *
! 5: * Online html documentation available at
! 6: * http://www.netlib.org/lapack/explore-html/
! 7: *
! 8: *> \htmlonly
! 9: *> Download ZDRSCL + dependencies
! 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zdrscl.f">
! 11: *> [TGZ]</a>
! 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zdrscl.f">
! 13: *> [ZIP]</a>
! 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zdrscl.f">
! 15: *> [TXT]</a>
! 16: *> \endhtmlonly
! 17: *
! 18: * Definition:
! 19: * ===========
! 20: *
! 21: * SUBROUTINE ZDRSCL( N, SA, SX, INCX )
! 22: *
! 23: * .. Scalar Arguments ..
! 24: * INTEGER INCX, N
! 25: * DOUBLE PRECISION SA
! 26: * ..
! 27: * .. Array Arguments ..
! 28: * COMPLEX*16 SX( * )
! 29: * ..
! 30: *
! 31: *
! 32: *> \par Purpose:
! 33: * =============
! 34: *>
! 35: *> \verbatim
! 36: *>
! 37: *> ZDRSCL 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 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 COMPLEX*16 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 complex16OTHERauxiliary
! 83: *
! 84: * =====================================================================
1.1 bertrand 85: SUBROUTINE ZDRSCL( N, SA, SX, INCX )
86: *
1.8 ! bertrand 87: * -- LAPACK auxiliary routine (version 3.4.0) --
1.1 bertrand 88: * -- LAPACK is a software package provided by Univ. of Tennessee, --
89: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.8 ! bertrand 90: * November 2011
1.1 bertrand 91: *
92: * .. Scalar Arguments ..
93: INTEGER INCX, N
94: DOUBLE PRECISION SA
95: * ..
96: * .. Array Arguments ..
97: COMPLEX*16 SX( * )
98: * ..
99: *
100: * =====================================================================
101: *
102: * .. Parameters ..
103: DOUBLE PRECISION ZERO, ONE
104: PARAMETER ( ZERO = 0.0D+0, ONE = 1.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 DLABAD, ZDSCAL
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 ZDSCAL( N, MUL, SX, INCX )
166: *
167: IF( .NOT.DONE )
168: $ GO TO 10
169: *
170: RETURN
171: *
172: * End of ZDRSCL
173: *
174: END
CVSweb interface <joel.bertrand@systella.fr>