SRC/srscl.f

   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 September 2012
  81 *
  82 *> \ingroup realOTHERauxiliary
  83 *
  84 *  =====================================================================
  85       SUBROUTINE SRSCL( N, SA, SX, INCX )
  86 *
  87 *  -- LAPACK auxiliary routine (version 3.4.2) --
  88 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  89 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  90 *     September 2012
  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