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.

dscal.f 2.5 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110
  1. *> \brief \b DSCAL
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. * Definition:
  9. * ===========
  10. *
  11. * SUBROUTINE DSCAL(N,DA,DX,INCX)
  12. *
  13. * .. Scalar Arguments ..
  14. * DOUBLE PRECISION DA
  15. * INTEGER INCX,N
  16. * ..
  17. * .. Array Arguments ..
  18. * DOUBLE PRECISION DX(*)
  19. * ..
  20. *
  21. *
  22. *> \par Purpose:
  23. * =============
  24. *>
  25. *> \verbatim
  26. *>
  27. *> DSCAL scales a vector by a constant.
  28. *> uses unrolled loops for increment equal to one.
  29. *> \endverbatim
  30. *
  31. * Authors:
  32. * ========
  33. *
  34. *> \author Univ. of Tennessee
  35. *> \author Univ. of California Berkeley
  36. *> \author Univ. of Colorado Denver
  37. *> \author NAG Ltd.
  38. *
  39. *> \date November 2011
  40. *
  41. *> \ingroup double_blas_level1
  42. *
  43. *> \par Further Details:
  44. * =====================
  45. *>
  46. *> \verbatim
  47. *>
  48. *> jack dongarra, linpack, 3/11/78.
  49. *> modified 3/93 to return if incx .le. 0.
  50. *> modified 12/3/93, array(1) declarations changed to array(*)
  51. *> \endverbatim
  52. *>
  53. * =====================================================================
  54. SUBROUTINE DSCAL(N,DA,DX,INCX)
  55. *
  56. * -- Reference BLAS level1 routine (version 3.4.0) --
  57. * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
  58. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  59. * November 2011
  60. *
  61. * .. Scalar Arguments ..
  62. DOUBLE PRECISION DA
  63. INTEGER INCX,N
  64. * ..
  65. * .. Array Arguments ..
  66. DOUBLE PRECISION DX(*)
  67. * ..
  68. *
  69. * =====================================================================
  70. *
  71. * .. Local Scalars ..
  72. INTEGER I,M,MP1,NINCX
  73. * ..
  74. * .. Intrinsic Functions ..
  75. INTRINSIC MOD
  76. * ..
  77. IF (N.LE.0 .OR. INCX.LE.0) RETURN
  78. IF (INCX.EQ.1) THEN
  79. *
  80. * code for increment equal to 1
  81. *
  82. *
  83. * clean-up loop
  84. *
  85. M = MOD(N,5)
  86. IF (M.NE.0) THEN
  87. DO I = 1,M
  88. DX(I) = DA*DX(I)
  89. END DO
  90. IF (N.LT.5) RETURN
  91. END IF
  92. MP1 = M + 1
  93. DO I = MP1,N,5
  94. DX(I) = DA*DX(I)
  95. DX(I+1) = DA*DX(I+1)
  96. DX(I+2) = DA*DX(I+2)
  97. DX(I+3) = DA*DX(I+3)
  98. DX(I+4) = DA*DX(I+4)
  99. END DO
  100. ELSE
  101. *
  102. * code for increment not equal to 1
  103. *
  104. NINCX = N*INCX
  105. DO I = 1,NINCX,INCX
  106. DX(I) = DA*DX(I)
  107. END DO
  108. END IF
  109. RETURN
  110. END