Télécharger dtrmv.eso

Retour à la liste

Numérotation des lignes :

dtrmv
  1. C DTRMV SOURCE FANDEUR 22/05/02 21:15:17 11359
  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.
  195. + .NOT.LSAME(TRANS,'T') .AND.
  196. + .NOT.LSAME(TRANS,'C')) THEN
  197. INFO = 2
  198. ELSE IF (.NOT.LSAME(DIAG,'U') .AND.
  199. + .NOT.LSAME(DIAG,'N')) THEN
  200. INFO = 3
  201. ELSE IF (N.LT.0) THEN
  202. INFO = 4
  203. ELSE IF (LDA.LT.MAX(1,N)) THEN
  204. INFO = 6
  205. ELSE IF (INCX.EQ.0) THEN
  206. INFO = 8
  207. END IF
  208. IF (INFO.NE.0) THEN
  209. CALL XERBLA('DTRMV ',INFO)
  210. RETURN
  211. END IF
  212. *
  213. * Quick return if possible.
  214. *
  215. IF (N.EQ.0) RETURN
  216. *
  217. NOUNIT = LSAME(DIAG,'N')
  218. *
  219. * Set up the start point in X if the increment is not unity. This
  220. * will be ( N - 1 )*INCX too small for descending loops.
  221. *
  222. IF (INCX.LE.0) THEN
  223. KX = 1 - (N-1)*INCX
  224. ELSE IF (INCX.NE.1) THEN
  225. KX = 1
  226. END IF
  227. *
  228. * Start the operations. In this version the elements of A are
  229. * accessed sequentially with one pass through A.
  230. *
  231. IF (LSAME(TRANS,'N')) THEN
  232. *
  233. * Form x := A*x.
  234. *
  235. IF (LSAME(UPLO,'U')) THEN
  236. IF (INCX.EQ.1) THEN
  237. DO 20 J = 1,N
  238. IF (X(J).NE.ZERO) THEN
  239. TEMP = X(J)
  240. DO 10 I = 1,J - 1
  241. X(I) = X(I) + TEMP*A(I,J)
  242. 10 CONTINUE
  243. IF (NOUNIT) X(J) = X(J)*A(J,J)
  244. END IF
  245. 20 CONTINUE
  246. ELSE
  247. JX = KX
  248. DO 40 J = 1,N
  249. IF (X(JX).NE.ZERO) THEN
  250. TEMP = X(JX)
  251. IX = KX
  252. DO 30 I = 1,J - 1
  253. X(IX) = X(IX) + TEMP*A(I,J)
  254. IX = IX + INCX
  255. 30 CONTINUE
  256. IF (NOUNIT) X(JX) = X(JX)*A(J,J)
  257. END IF
  258. JX = JX + INCX
  259. 40 CONTINUE
  260. END IF
  261. ELSE
  262. IF (INCX.EQ.1) THEN
  263. DO 60 J = N,1,-1
  264. IF (X(J).NE.ZERO) THEN
  265. TEMP = X(J)
  266. DO 50 I = N,J + 1,-1
  267. X(I) = X(I) + TEMP*A(I,J)
  268. 50 CONTINUE
  269. IF (NOUNIT) X(J) = X(J)*A(J,J)
  270. END IF
  271. 60 CONTINUE
  272. ELSE
  273. KX = KX + (N-1)*INCX
  274. JX = KX
  275. DO 80 J = N,1,-1
  276. IF (X(JX).NE.ZERO) THEN
  277. TEMP = X(JX)
  278. IX = KX
  279. DO 70 I = N,J + 1,-1
  280. X(IX) = X(IX) + TEMP*A(I,J)
  281. IX = IX - INCX
  282. 70 CONTINUE
  283. IF (NOUNIT) X(JX) = X(JX)*A(J,J)
  284. END IF
  285. JX = JX - INCX
  286. 80 CONTINUE
  287. END IF
  288. END IF
  289. ELSE
  290. *
  291. * Form x := A**T*x.
  292. *
  293. IF (LSAME(UPLO,'U')) THEN
  294. IF (INCX.EQ.1) THEN
  295. DO 100 J = N,1,-1
  296. TEMP = X(J)
  297. IF (NOUNIT) TEMP = TEMP*A(J,J)
  298. DO 90 I = J - 1,1,-1
  299. TEMP = TEMP + A(I,J)*X(I)
  300. 90 CONTINUE
  301. X(J) = TEMP
  302. 100 CONTINUE
  303. ELSE
  304. JX = KX + (N-1)*INCX
  305. DO 120 J = N,1,-1
  306. TEMP = X(JX)
  307. IX = JX
  308. IF (NOUNIT) TEMP = TEMP*A(J,J)
  309. DO 110 I = J - 1,1,-1
  310. IX = IX - INCX
  311. TEMP = TEMP + A(I,J)*X(IX)
  312. 110 CONTINUE
  313. X(JX) = TEMP
  314. JX = JX - INCX
  315. 120 CONTINUE
  316. END IF
  317. ELSE
  318. IF (INCX.EQ.1) THEN
  319. DO 140 J = 1,N
  320. TEMP = X(J)
  321. IF (NOUNIT) TEMP = TEMP*A(J,J)
  322. DO 130 I = J + 1,N
  323. TEMP = TEMP + A(I,J)*X(I)
  324. 130 CONTINUE
  325. X(J) = TEMP
  326. 140 CONTINUE
  327. ELSE
  328. JX = KX
  329. DO 160 J = 1,N
  330. TEMP = X(JX)
  331. IX = JX
  332. IF (NOUNIT) TEMP = TEMP*A(J,J)
  333. DO 150 I = J + 1,N
  334. IX = IX + INCX
  335. TEMP = TEMP + A(I,J)*X(IX)
  336. 150 CONTINUE
  337. X(JX) = TEMP
  338. JX = JX + INCX
  339. 160 CONTINUE
  340. END IF
  341. END IF
  342. END IF
  343. *
  344. RETURN
  345. *
  346. * End of DTRMV .
  347. *
  348. END
  349.  
  350.  
  351.  

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