1*> \brief \b SRSCL 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 SRSCL + dependencies 10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/srscl.f"> 11*> [TGZ]</a> 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/srscl.f"> 13*> [ZIP]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/srscl.f"> 15*> [TXT]</a> 16*> \endhtmlonly 17* 18* Definition: 19* =========== 20* 21* SUBROUTINE SRSCL( N, SA, SX, INCX ) 22* 23* .. Scalar Arguments .. 24* INTEGER INCX, N 25* REAL SA 26* .. 27* .. Array Arguments .. 28* REAL SX( * ) 29* .. 30* 31* 32*> \par Purpose: 33* ============= 34*> 35*> \verbatim 36*> 37*> SRSCL 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 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 REAL 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 realOTHERauxiliary 81* 82* ===================================================================== 83 SUBROUTINE SRSCL( 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 REAL SX( * ) 95* .. 96* 97* ===================================================================== 98* 99* .. Parameters .. 100 REAL ONE, ZERO 101 PARAMETER ( ONE = 1.0E+0, ZERO = 0.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 SLABAD, SSCAL 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 CALL SLABAD( 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 SSCAL( N, MUL, SX, INCX ) 163* 164 IF( .NOT.DONE ) 165 $ GO TO 10 166* 167 RETURN 168* 169* End of SRSCL 170* 171 END 172