Télécharger dtrmv.eso

Retour à la liste

Numérotation des lignes :

  1. C DTRMV SOURCE BP208322 20/09/18 21:16:14 10718
  2. *> \brief \b DTRMV
  3. *
  4. * =========== DOCUMENTATION ===========
  5. *
  6. * Online html documentation available at
  7. * http://www.netlib.org/lapack/explore-html/
  8. *
  9. * Definition:
  10. * ===========
  11. *
  12. * SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
  13. *
  14. * .. Scalar Arguments ..
  15. * INTEGER INCX,LDA,N
  16. * CHARACTER DIAG,TRANS,UPLO
  17. * ..
  18. * .. Array Arguments ..
  19. * REAL*8 A(LDA,*),X(*)
  20. * ..
  21. *
  22. *
  23. *> \par Purpose:
  24. * =============
  25. *>
  26. *> \verbatim
  27. *>
  28. *> DTRMV performs one of the matrix-vector operations
  29. *>
  30. *> x := A*x, or x := A**T*x,
  31. *>
  32. *> where x is an n element vector and A is an n by n unit, or non-unit,
  33. *> upper or lower triangular matrix.
  34. *> \endverbatim
  35. *
  36. * Arguments:
  37. * ==========
  38. *
  39. *> \param[in] UPLO
  40. *> \verbatim
  41. *> UPLO is CHARACTER*1
  42. *> On entry, UPLO specifies whether the matrix is an upper or
  43. *> lower triangular matrix as follows:
  44. *>
  45. *> UPLO = 'U' or 'u' A is an upper triangular matrix.
  46. *>
  47. *> UPLO = 'L' or 'l' A is a lower triangular matrix.
  48. *> \endverbatim
  49. *>
  50. *> \param[in] TRANS
  51. *> \verbatim
  52. *> TRANS is CHARACTER*1
  53. *> On entry, TRANS specifies the operation to be performed as
  54. *> follows:
  55. *>
  56. *> TRANS = 'N' or 'n' x := A*x.
  57. *>
  58. *> TRANS = 'T' or 't' x := A**T*x.
  59. *>
  60. *> TRANS = 'C' or 'c' x := A**T*x.
  61. *> \endverbatim
  62. *>
  63. *> \param[in] DIAG
  64. *> \verbatim
  65. *> DIAG is CHARACTER*1
  66. *> On entry, DIAG specifies whether or not A is unit
  67. *> triangular as follows:
  68. *>
  69. *> DIAG = 'U' or 'u' A is assumed to be unit triangular.
  70. *>
  71. *> DIAG = 'N' or 'n' A is not assumed to be unit
  72. *> triangular.
  73. *> \endverbatim
  74. *>
  75. *> \param[in] N
  76. *> \verbatim
  77. *> N is INTEGER
  78. *> On entry, N specifies the order of the matrix A.
  79. *> N must be at least zero.
  80. *> \endverbatim
  81. *>
  82. *> \param[in] A
  83. *> \verbatim
  84. *> A is REAL*8 array, dimension ( LDA, N )
  85. *> Before entry with UPLO = 'U' or 'u', the leading n by n
  86. *> upper triangular part of the array A must contain the upper
  87. *> triangular matrix and the strictly lower triangular part of
  88. *> A is not referenced.
  89. *> Before entry with UPLO = 'L' or 'l', the leading n by n
  90. *> lower triangular part of the array A must contain the lower
  91. *> triangular matrix and the strictly upper triangular part of
  92. *> A is not referenced.
  93. *> Note that when DIAG = 'U' or 'u', the diagonal elements of
  94. *> A are not referenced either, but are assumed to be unity.
  95. *> \endverbatim
  96. *>
  97. *> \param[in] LDA
  98. *> \verbatim
  99. *> LDA is INTEGER
  100. *> On entry, LDA specifies the first dimension of A as declared
  101. *> in the calling (sub) program. LDA must be at least
  102. *> max( 1, n ).
  103. *> \endverbatim
  104. *>
  105. *> \param[in,out] X
  106. *> \verbatim
  107. *> X is REAL*8 array, dimension at least
  108. *> ( 1 + ( n - 1 )*abs( INCX ) ).
  109. *> Before entry, the incremented array X must contain the n
  110. *> element vector x. On exit, X is overwritten with the
  111. *> transformed vector x.
  112. *> \endverbatim
  113. *>
  114. *> \param[in] INCX
  115. *> \verbatim
  116. *> INCX is INTEGER
  117. *> On entry, INCX specifies the increment for the elements of
  118. *> X. INCX must not be zero.
  119. *> \endverbatim
  120. *
  121. * Authors:
  122. * ========
  123. *
  124. *> \author Univ. of Tennessee
  125. *> \author Univ. of California Berkeley
  126. *> \author Univ. of Colorado Denver
  127. *> \author NAG Ltd.
  128. *
  129. *> \date December 2016
  130. *
  131. *> \ingroup double_blas_level2
  132. *
  133. *> \par Further Details:
  134. * =====================
  135. *>
  136. *> \verbatim
  137. *>
  138. *> Level 2 Blas routine.
  139. *> The vector and matrix arguments are not referenced when N = 0, or M = 0
  140. *>
  141. *> -- Written on 22-October-1986.
  142. *> Jack Dongarra, Argonne National Lab.
  143. *> Jeremy Du Croz, Nag Central Office.
  144. *> Sven Hammarling, Nag Central Office.
  145. *> Richard Hanson, Sandia National Labs.
  146. *> \endverbatim
  147. *>
  148. * =====================================================================
  149. SUBROUTINE DTRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
  150. *
  151. * -- Reference BLAS level2 routine (version 3.7.0) --
  152. * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
  153. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  154. * December 2016
  155.  
  156. IMPLICIT INTEGER(I-N)
  157. IMPLICIT REAL*8(A-H,O-Z)
  158. *
  159. * .. Scalar Arguments ..
  160. INTEGER INCX,LDA,N
  161. CHARACTER DIAG,TRANS,UPLO
  162. * ..
  163. * .. Array Arguments ..
  164. REAL*8 A(LDA,*),X(*)
  165. * ..
  166. *
  167. * =====================================================================
  168. *
  169. * .. Parameters ..
  170. REAL*8 ZERO
  171. PARAMETER (ZERO=0.0D+0)
  172. * ..
  173. * .. Local Scalars ..
  174. REAL*8 TEMP
  175. INTEGER I,INFO,IX,J,JX,KX
  176. LOGICAL NOUNIT
  177. * ..
  178. * .. External Functions ..
  179. LOGICAL LSAME
  180. * EXTERNAL LSAME
  181. * ..
  182. * .. External Subroutines ..
  183. * EXTERNAL XERBLA
  184. * ..
  185. * .. Intrinsic Functions ..
  186. * INTRINSIC MAX
  187. * ..
  188. *
  189. * Test the input parameters.
  190. *
  191. INFO = 0
  192. IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
  193. INFO = 1
  194. ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
  195. + .NOT.LSAME(TRANS,'C')) THEN
  196. INFO = 2
  197. ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
  198. INFO = 3
  199. ELSE IF (N.LT.0) THEN
  200. INFO = 4
  201. ELSE IF (LDA.LT.MAX(1,N)) THEN
  202. INFO = 6
  203. ELSE IF (INCX.EQ.0) THEN
  204. INFO = 8
  205. END IF
  206. IF (INFO.NE.0) THEN
  207. CALL XERBLA('DTRMV ',INFO)
  208. RETURN
  209. END IF
  210. *
  211. * Quick return if possible.
  212. *
  213. IF (N.EQ.0) RETURN
  214. *
  215. NOUNIT = LSAME(DIAG,'N')
  216. *
  217. * Set up the start point in X if the increment is not unity. This
  218. * will be ( N - 1 )*INCX too small for descending loops.
  219. *
  220. IF (INCX.LE.0) THEN
  221. KX = 1 - (N-1)*INCX
  222. ELSE IF (INCX.NE.1) THEN
  223. KX = 1
  224. END IF
  225. *
  226. * Start the operations. In this version the elements of A are
  227. * accessed sequentially with one pass through A.
  228. *
  229. IF (LSAME(TRANS,'N')) THEN
  230. *
  231. * Form x := A*x.
  232. *
  233. IF (LSAME(UPLO,'U')) THEN
  234. IF (INCX.EQ.1) THEN
  235. DO 20 J = 1,N
  236. IF (X(J).NE.ZERO) THEN
  237. TEMP = X(J)
  238. DO 10 I = 1,J - 1
  239. X(I) = X(I) + TEMP*A(I,J)
  240. 10 CONTINUE
  241. IF (NOUNIT) X(J) = X(J)*A(J,J)
  242. END IF
  243. 20 CONTINUE
  244. ELSE
  245. JX = KX
  246. DO 40 J = 1,N
  247. IF (X(JX).NE.ZERO) THEN
  248. TEMP = X(JX)
  249. IX = KX
  250. DO 30 I = 1,J - 1
  251. X(IX) = X(IX) + TEMP*A(I,J)
  252. IX = IX + INCX
  253. 30 CONTINUE
  254. IF (NOUNIT) X(JX) = X(JX)*A(J,J)
  255. END IF
  256. JX = JX + INCX
  257. 40 CONTINUE
  258. END IF
  259. ELSE
  260. IF (INCX.EQ.1) THEN
  261. DO 60 J = N,1,-1
  262. IF (X(J).NE.ZERO) THEN
  263. TEMP = X(J)
  264. DO 50 I = N,J + 1,-1
  265. X(I) = X(I) + TEMP*A(I,J)
  266. 50 CONTINUE
  267. IF (NOUNIT) X(J) = X(J)*A(J,J)
  268. END IF
  269. 60 CONTINUE
  270. ELSE
  271. KX = KX + (N-1)*INCX
  272. JX = KX
  273. DO 80 J = N,1,-1
  274. IF (X(JX).NE.ZERO) THEN
  275. TEMP = X(JX)
  276. IX = KX
  277. DO 70 I = N,J + 1,-1
  278. X(IX) = X(IX) + TEMP*A(I,J)
  279. IX = IX - INCX
  280. 70 CONTINUE
  281. IF (NOUNIT) X(JX) = X(JX)*A(J,J)
  282. END IF
  283. JX = JX - INCX
  284. 80 CONTINUE
  285. END IF
  286. END IF
  287. ELSE
  288. *
  289. * Form x := A**T*x.
  290. *
  291. IF (LSAME(UPLO,'U')) THEN
  292. IF (INCX.EQ.1) THEN
  293. DO 100 J = N,1,-1
  294. TEMP = X(J)
  295. IF (NOUNIT) TEMP = TEMP*A(J,J)
  296. DO 90 I = J - 1,1,-1
  297. TEMP = TEMP + A(I,J)*X(I)
  298. 90 CONTINUE
  299. X(J) = TEMP
  300. 100 CONTINUE
  301. ELSE
  302. JX = KX + (N-1)*INCX
  303. DO 120 J = N,1,-1
  304. TEMP = X(JX)
  305. IX = JX
  306. IF (NOUNIT) TEMP = TEMP*A(J,J)
  307. DO 110 I = J - 1,1,-1
  308. IX = IX - INCX
  309. TEMP = TEMP + A(I,J)*X(IX)
  310. 110 CONTINUE
  311. X(JX) = TEMP
  312. JX = JX - INCX
  313. 120 CONTINUE
  314. END IF
  315. ELSE
  316. IF (INCX.EQ.1) THEN
  317. DO 140 J = 1,N
  318. TEMP = X(J)
  319. IF (NOUNIT) TEMP = TEMP*A(J,J)
  320. DO 130 I = J + 1,N
  321. TEMP = TEMP + A(I,J)*X(I)
  322. 130 CONTINUE
  323. X(J) = TEMP
  324. 140 CONTINUE
  325. ELSE
  326. JX = KX
  327. DO 160 J = 1,N
  328. TEMP = X(JX)
  329. IX = JX
  330. IF (NOUNIT) TEMP = TEMP*A(J,J)
  331. DO 150 I = J + 1,N
  332. IX = IX + INCX
  333. TEMP = TEMP + A(I,J)*X(IX)
  334. 150 CONTINUE
  335. X(JX) = TEMP
  336. JX = JX + INCX
  337. 160 CONTINUE
  338. END IF
  339. END IF
  340. END IF
  341. *
  342. RETURN
  343. *
  344. * End of DTRMV .
  345. *
  346. END
  347.  
  348.  
  349.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales