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.

daxpy.f 2.7 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115
  1. *> \brief \b DAXPY
  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 DAXPY(N,DA,DX,INCX,DY,INCY)
  12. *
  13. * .. Scalar Arguments ..
  14. * DOUBLE PRECISION DA
  15. * INTEGER INCX,INCY,N
  16. * ..
  17. * .. Array Arguments ..
  18. * DOUBLE PRECISION DX(*),DY(*)
  19. * ..
  20. *
  21. *
  22. *> \par Purpose:
  23. * =============
  24. *>
  25. *> \verbatim
  26. *>
  27. *> DAXPY constant times a vector plus a vector.
  28. *> uses unrolled loops for increments 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 12/3/93, array(1) declarations changed to array(*)
  50. *> \endverbatim
  51. *>
  52. * =====================================================================
  53. SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY)
  54. *
  55. * -- Reference BLAS level1 routine (version 3.4.0) --
  56. * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
  57. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  58. * November 2011
  59. *
  60. * .. Scalar Arguments ..
  61. DOUBLE PRECISION DA
  62. INTEGER INCX,INCY,N
  63. * ..
  64. * .. Array Arguments ..
  65. DOUBLE PRECISION DX(*),DY(*)
  66. * ..
  67. *
  68. * =====================================================================
  69. *
  70. * .. Local Scalars ..
  71. INTEGER I,IX,IY,M,MP1
  72. * ..
  73. * .. Intrinsic Functions ..
  74. INTRINSIC MOD
  75. * ..
  76. IF (N.LE.0) RETURN
  77. IF (DA.EQ.0.0d0) RETURN
  78. IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
  79. *
  80. * code for both increments equal to 1
  81. *
  82. *
  83. * clean-up loop
  84. *
  85. M = MOD(N,4)
  86. IF (M.NE.0) THEN
  87. DO I = 1,M
  88. DY(I) = DY(I) + DA*DX(I)
  89. END DO
  90. END IF
  91. IF (N.LT.4) RETURN
  92. MP1 = M + 1
  93. DO I = MP1,N,4
  94. DY(I) = DY(I) + DA*DX(I)
  95. DY(I+1) = DY(I+1) + DA*DX(I+1)
  96. DY(I+2) = DY(I+2) + DA*DX(I+2)
  97. DY(I+3) = DY(I+3) + DA*DX(I+3)
  98. END DO
  99. ELSE
  100. *
  101. * code for unequal increments or equal increments
  102. * not equal to 1
  103. *
  104. IX = 1
  105. IY = 1
  106. IF (INCX.LT.0) IX = (-N+1)*INCX + 1
  107. IF (INCY.LT.0) IY = (-N+1)*INCY + 1
  108. DO I = 1,N
  109. DY(IY) = DY(IY) + DA*DX(IX)
  110. IX = IX + INCX
  111. IY = IY + INCY
  112. END DO
  113. END IF
  114. RETURN
  115. END