home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / libcruft / lapack / zdrscl.f < prev    next >
Text File  |  1996-09-28  |  3KB  |  116 lines
  1.       SUBROUTINE ZDRSCL( N, SA, SX, INCX )
  2. *
  3. *  -- LAPACK auxiliary routine (version 2.0) --
  4. *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
  5. *     Courant Institute, Argonne National Lab, and Rice University
  6. *     September 30, 1994
  7. *
  8. *     .. Scalar Arguments ..
  9.       INTEGER            INCX, N
  10.       DOUBLE PRECISION   SA
  11. *     ..
  12. *     .. Array Arguments ..
  13.       COMPLEX*16         SX( * )
  14. *     ..
  15. *
  16. *  Purpose
  17. *  =======
  18. *
  19. *  ZDRSCL multiplies an n-element complex vector x by the real scalar
  20. *  1/a.  This is done without overflow or underflow as long as
  21. *  the final result x/a does not overflow or underflow.
  22. *
  23. *  Arguments
  24. *  =========
  25. *
  26. *  N       (input) INTEGER
  27. *          The number of components of the vector x.
  28. *
  29. *  SA      (input) DOUBLE PRECISION
  30. *          The scalar a which is used to divide each component of x.
  31. *          SA must be >= 0, or the subroutine will divide by zero.
  32. *
  33. *  SX      (input/output) COMPLEX*16 array, dimension
  34. *                         (1+(N-1)*abs(INCX))
  35. *          The n-element vector x.
  36. *
  37. *  INCX    (input) INTEGER
  38. *          The increment between successive values of the vector SX.
  39. *          > 0:  SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i),     1< i<= n
  40. *
  41. * =====================================================================
  42. *
  43. *     .. Parameters ..
  44.       DOUBLE PRECISION   ZERO, ONE
  45.       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
  46. *     ..
  47. *     .. Local Scalars ..
  48.       LOGICAL            DONE
  49.       DOUBLE PRECISION   BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM
  50. *     ..
  51. *     .. External Functions ..
  52.       DOUBLE PRECISION   DLAMCH
  53.       EXTERNAL           DLAMCH
  54. *     ..
  55. *     .. External Subroutines ..
  56.       EXTERNAL           DLABAD, ZDSCAL
  57. *     ..
  58. *     .. Intrinsic Functions ..
  59.       INTRINSIC          ABS
  60. *     ..
  61. *     .. Executable Statements ..
  62. *
  63. *     Quick return if possible
  64. *
  65.       IF( N.LE.0 )
  66.      $   RETURN
  67. *
  68. *     Get machine parameters
  69. *
  70.       SMLNUM = DLAMCH( 'S' )
  71.       BIGNUM = ONE / SMLNUM
  72.       CALL DLABAD( SMLNUM, BIGNUM )
  73. *
  74. *     Initialize the denominator to SA and the numerator to 1.
  75. *
  76.       CDEN = SA
  77.       CNUM = ONE
  78. *
  79.    10 CONTINUE
  80.       CDEN1 = CDEN*SMLNUM
  81.       CNUM1 = CNUM / BIGNUM
  82.       IF( ABS( CDEN1 ).GT.ABS( CNUM ) .AND. CNUM.NE.ZERO ) THEN
  83. *
  84. *        Pre-multiply X by SMLNUM if CDEN is large compared to CNUM.
  85. *
  86.          MUL = SMLNUM
  87.          DONE = .FALSE.
  88.          CDEN = CDEN1
  89.       ELSE IF( ABS( CNUM1 ).GT.ABS( CDEN ) ) THEN
  90. *
  91. *        Pre-multiply X by BIGNUM if CDEN is small compared to CNUM.
  92. *
  93.          MUL = BIGNUM
  94.          DONE = .FALSE.
  95.          CNUM = CNUM1
  96.       ELSE
  97. *
  98. *        Multiply X by CNUM / CDEN and return.
  99. *
  100.          MUL = CNUM / CDEN
  101.          DONE = .TRUE.
  102.       END IF
  103. *
  104. *     Scale the vector X by MUL
  105. *
  106.       CALL ZDSCAL( N, MUL, SX, INCX )
  107. *
  108.       IF( .NOT.DONE )
  109.      $   GO TO 10
  110. *
  111.       RETURN
  112. *
  113. *     End of ZDRSCL
  114. *
  115.       END
  116.