Return to zdrscl.f CVS log

Up to [local] / rpl / lapack / lapack

Mise à jour de Lapack.

    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: *  =====================================================================
   85:       SUBROUTINE ZDRSCL( N, SA, SX, INCX )
   86: *
   87: *  -- LAPACK auxiliary routine (version 3.4.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: *     November 2011
   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