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.

drotm.f 5.3 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202
  1. *> \brief \b DROTM
  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 DROTM(N,DX,INCX,DY,INCY,DPARAM)
  12. *
  13. * .. Scalar Arguments ..
  14. * INTEGER INCX,INCY,N
  15. * ..
  16. * .. Array Arguments ..
  17. * DOUBLE PRECISION DPARAM(5),DX(*),DY(*)
  18. * ..
  19. *
  20. *
  21. *> \par Purpose:
  22. * =============
  23. *>
  24. *> \verbatim
  25. *>
  26. *> APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
  27. *>
  28. *> (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN
  29. *> (DY**T)
  30. *>
  31. *> DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
  32. *> LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY.
  33. *> WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
  34. *>
  35. *> DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0
  36. *>
  37. *> (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0)
  38. *> H=( ) ( ) ( ) ( )
  39. *> (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0).
  40. *> SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM.
  41. *> \endverbatim
  42. *
  43. * Arguments:
  44. * ==========
  45. *
  46. *> \param[in] N
  47. *> \verbatim
  48. *> N is INTEGER
  49. *> number of elements in input vector(s)
  50. *> \endverbatim
  51. *>
  52. *> \param[in,out] DX
  53. *> \verbatim
  54. *> DX is DOUBLE PRECISION array, dimension N
  55. *> double precision vector with N elements
  56. *> \endverbatim
  57. *>
  58. *> \param[in] INCX
  59. *> \verbatim
  60. *> INCX is INTEGER
  61. *> storage spacing between elements of DX
  62. *> \endverbatim
  63. *>
  64. *> \param[in,out] DY
  65. *> \verbatim
  66. *> DY is DOUBLE PRECISION array, dimension N
  67. *> double precision vector with N elements
  68. *> \endverbatim
  69. *>
  70. *> \param[in] INCY
  71. *> \verbatim
  72. *> INCY is INTEGER
  73. *> storage spacing between elements of DY
  74. *> \endverbatim
  75. *>
  76. *> \param[in,out] DPARAM
  77. *> \verbatim
  78. *> DPARAM is DOUBLE PRECISION array, dimension 5
  79. *> DPARAM(1)=DFLAG
  80. *> DPARAM(2)=DH11
  81. *> DPARAM(3)=DH21
  82. *> DPARAM(4)=DH12
  83. *> DPARAM(5)=DH22
  84. *> \endverbatim
  85. *
  86. * Authors:
  87. * ========
  88. *
  89. *> \author Univ. of Tennessee
  90. *> \author Univ. of California Berkeley
  91. *> \author Univ. of Colorado Denver
  92. *> \author NAG Ltd.
  93. *
  94. *> \date November 2011
  95. *
  96. *> \ingroup double_blas_level1
  97. *
  98. * =====================================================================
  99. SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM)
  100. *
  101. * -- Reference BLAS level1 routine (version 3.4.0) --
  102. * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
  103. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  104. * November 2011
  105. *
  106. * .. Scalar Arguments ..
  107. INTEGER INCX,INCY,N
  108. * ..
  109. * .. Array Arguments ..
  110. DOUBLE PRECISION DPARAM(5),DX(*),DY(*)
  111. * ..
  112. *
  113. * =====================================================================
  114. *
  115. * .. Local Scalars ..
  116. DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,TWO,W,Z,ZERO
  117. INTEGER I,KX,KY,NSTEPS
  118. * ..
  119. * .. Data statements ..
  120. DATA ZERO,TWO/0.D0,2.D0/
  121. * ..
  122. *
  123. DFLAG = DPARAM(1)
  124. IF (N.LE.0 .OR. (DFLAG+TWO.EQ.ZERO)) RETURN
  125. IF (INCX.EQ.INCY.AND.INCX.GT.0) THEN
  126. *
  127. NSTEPS = N*INCX
  128. IF (DFLAG.LT.ZERO) THEN
  129. DH11 = DPARAM(2)
  130. DH12 = DPARAM(4)
  131. DH21 = DPARAM(3)
  132. DH22 = DPARAM(5)
  133. DO I = 1,NSTEPS,INCX
  134. W = DX(I)
  135. Z = DY(I)
  136. DX(I) = W*DH11 + Z*DH12
  137. DY(I) = W*DH21 + Z*DH22
  138. END DO
  139. ELSE IF (DFLAG.EQ.ZERO) THEN
  140. DH12 = DPARAM(4)
  141. DH21 = DPARAM(3)
  142. DO I = 1,NSTEPS,INCX
  143. W = DX(I)
  144. Z = DY(I)
  145. DX(I) = W + Z*DH12
  146. DY(I) = W*DH21 + Z
  147. END DO
  148. ELSE
  149. DH11 = DPARAM(2)
  150. DH22 = DPARAM(5)
  151. DO I = 1,NSTEPS,INCX
  152. W = DX(I)
  153. Z = DY(I)
  154. DX(I) = W*DH11 + Z
  155. DY(I) = -W + DH22*Z
  156. END DO
  157. END IF
  158. ELSE
  159. KX = 1
  160. KY = 1
  161. IF (INCX.LT.0) KX = 1 + (1-N)*INCX
  162. IF (INCY.LT.0) KY = 1 + (1-N)*INCY
  163. *
  164. IF (DFLAG.LT.ZERO) THEN
  165. DH11 = DPARAM(2)
  166. DH12 = DPARAM(4)
  167. DH21 = DPARAM(3)
  168. DH22 = DPARAM(5)
  169. DO I = 1,N
  170. W = DX(KX)
  171. Z = DY(KY)
  172. DX(KX) = W*DH11 + Z*DH12
  173. DY(KY) = W*DH21 + Z*DH22
  174. KX = KX + INCX
  175. KY = KY + INCY
  176. END DO
  177. ELSE IF (DFLAG.EQ.ZERO) THEN
  178. DH12 = DPARAM(4)
  179. DH21 = DPARAM(3)
  180. DO I = 1,N
  181. W = DX(KX)
  182. Z = DY(KY)
  183. DX(KX) = W + Z*DH12
  184. DY(KY) = W*DH21 + Z
  185. KX = KX + INCX
  186. KY = KY + INCY
  187. END DO
  188. ELSE
  189. DH11 = DPARAM(2)
  190. DH22 = DPARAM(5)
  191. DO I = 1,N
  192. W = DX(KX)
  193. Z = DY(KY)
  194. DX(KX) = W*DH11 + Z
  195. DY(KY) = -W + DH22*Z
  196. KX = KX + INCX
  197. KY = KY + INCY
  198. END DO
  199. END IF
  200. END IF
  201. RETURN
  202. END