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*> \date December 2016 81* 82*> \ingroup realOTHERauxiliary 83* 84* ===================================================================== 85 SUBROUTINE SRSCL( N, SA, SX, INCX ) 86* 87* -- LAPACK auxiliary routine (version 3.7.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* December 2016 91* 92* .. Scalar Arguments .. 93 INTEGER INCX, N 94 REAL SA 95* .. 96* .. Array Arguments .. 97 REAL SX( * ) 98* .. 99* 100* ===================================================================== 101* 102* .. Parameters .. 103 REAL ONE, ZERO 104 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 105* .. 106* .. Local Scalars .. 107 LOGICAL DONE 108 REAL BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM 109* .. 110* .. External Functions .. 111 REAL SLAMCH 112 EXTERNAL SLAMCH 113* .. 114* .. External Subroutines .. 115 EXTERNAL SLABAD, SSCAL 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 = SLAMCH( 'S' ) 130 BIGNUM = ONE / SMLNUM 131 CALL SLABAD( 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 SSCAL( N, MUL, SX, INCX ) 166* 167 IF( .NOT.DONE ) 168 $ GO TO 10 169* 170 RETURN 171* 172* End of SRSCL 173* 174 END 175