You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

csrscl.f 4.3 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171
  1. *> \brief \b CSRSCL 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 CSRSCL + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csrscl.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csrscl.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csrscl.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE CSRSCL( N, SA, SX, INCX )
  22. *
  23. * .. Scalar Arguments ..
  24. * INTEGER INCX, N
  25. * REAL SA
  26. * ..
  27. * .. Array Arguments ..
  28. * COMPLEX SX( * )
  29. * ..
  30. *
  31. *
  32. *> \par Purpose:
  33. * =============
  34. *>
  35. *> \verbatim
  36. *>
  37. *> CSRSCL 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 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 COMPLEX 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 complexOTHERauxiliary
  81. *
  82. * =====================================================================
  83. SUBROUTINE CSRSCL( 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. REAL SA
  92. * ..
  93. * .. Array Arguments ..
  94. COMPLEX SX( * )
  95. * ..
  96. *
  97. * =====================================================================
  98. *
  99. * .. Parameters ..
  100. REAL ZERO, ONE
  101. PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
  102. * ..
  103. * .. Local Scalars ..
  104. LOGICAL DONE
  105. REAL BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM
  106. * ..
  107. * .. External Functions ..
  108. REAL SLAMCH
  109. EXTERNAL SLAMCH
  110. * ..
  111. * .. External Subroutines ..
  112. EXTERNAL CSSCAL, SLABAD
  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 = SLAMCH( 'S' )
  127. BIGNUM = ONE / SMLNUM
  128. CALL SLABAD( 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 CSSCAL( N, MUL, SX, INCX )
  163. *
  164. IF( .NOT.DONE )
  165. $ GO TO 10
  166. *
  167. RETURN
  168. *
  169. * End of CSRSCL
  170. *
  171. END