Return to zdrscl.f CVS log

Up to [local] / rpl / lapack / lapack

Première mise à jour de lapack et blas.

    1: *> \brief \b ZDRSCL 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 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: *> \ingroup complex16OTHERauxiliary
   81: *
   82: *  =====================================================================
   83:       SUBROUTINE ZDRSCL( 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:       DOUBLE PRECISION   SA
   92: *     ..
   93: *     .. Array Arguments ..
   94:       COMPLEX*16         SX( * )
   95: *     ..
   96: *
   97: * =====================================================================
   98: *
   99: *     .. Parameters ..
  100:       DOUBLE PRECISION   ZERO, ONE
  101:       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.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 ..
  112:       EXTERNAL           DLABAD, ZDSCAL
  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 ZDSCAL( N, MUL, SX, INCX )
  163: *
  164:       IF( .NOT.DONE )
  165:      $   GO TO 10
  166: *
  167:       RETURN
  168: *
  169: *     End of ZDRSCL
  170: *
  171:       END