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.

cgttrf.f 6.7 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240
  1. *> \brief \b CGTTRF
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download CGTTRF + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgttrf.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgttrf.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgttrf.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE CGTTRF( N, DL, D, DU, DU2, IPIV, INFO )
  22. *
  23. * .. Scalar Arguments ..
  24. * INTEGER INFO, N
  25. * ..
  26. * .. Array Arguments ..
  27. * INTEGER IPIV( * )
  28. * COMPLEX D( * ), DL( * ), DU( * ), DU2( * )
  29. * ..
  30. *
  31. *
  32. *> \par Purpose:
  33. * =============
  34. *>
  35. *> \verbatim
  36. *>
  37. *> CGTTRF computes an LU factorization of a complex tridiagonal matrix A
  38. *> using elimination with partial pivoting and row interchanges.
  39. *>
  40. *> The factorization has the form
  41. *> A = L * U
  42. *> where L is a product of permutation and unit lower bidiagonal
  43. *> matrices and U is upper triangular with nonzeros in only the main
  44. *> diagonal and first two superdiagonals.
  45. *> \endverbatim
  46. *
  47. * Arguments:
  48. * ==========
  49. *
  50. *> \param[in] N
  51. *> \verbatim
  52. *> N is INTEGER
  53. *> The order of the matrix A.
  54. *> \endverbatim
  55. *>
  56. *> \param[in,out] DL
  57. *> \verbatim
  58. *> DL is COMPLEX array, dimension (N-1)
  59. *> On entry, DL must contain the (n-1) sub-diagonal elements of
  60. *> A.
  61. *>
  62. *> On exit, DL is overwritten by the (n-1) multipliers that
  63. *> define the matrix L from the LU factorization of A.
  64. *> \endverbatim
  65. *>
  66. *> \param[in,out] D
  67. *> \verbatim
  68. *> D is COMPLEX array, dimension (N)
  69. *> On entry, D must contain the diagonal elements of A.
  70. *>
  71. *> On exit, D is overwritten by the n diagonal elements of the
  72. *> upper triangular matrix U from the LU factorization of A.
  73. *> \endverbatim
  74. *>
  75. *> \param[in,out] DU
  76. *> \verbatim
  77. *> DU is COMPLEX array, dimension (N-1)
  78. *> On entry, DU must contain the (n-1) super-diagonal elements
  79. *> of A.
  80. *>
  81. *> On exit, DU is overwritten by the (n-1) elements of the first
  82. *> super-diagonal of U.
  83. *> \endverbatim
  84. *>
  85. *> \param[out] DU2
  86. *> \verbatim
  87. *> DU2 is COMPLEX array, dimension (N-2)
  88. *> On exit, DU2 is overwritten by the (n-2) elements of the
  89. *> second super-diagonal of U.
  90. *> \endverbatim
  91. *>
  92. *> \param[out] IPIV
  93. *> \verbatim
  94. *> IPIV is INTEGER array, dimension (N)
  95. *> The pivot indices; for 1 <= i <= n, row i of the matrix was
  96. *> interchanged with row IPIV(i). IPIV(i) will always be either
  97. *> i or i+1; IPIV(i) = i indicates a row interchange was not
  98. *> required.
  99. *> \endverbatim
  100. *>
  101. *> \param[out] INFO
  102. *> \verbatim
  103. *> INFO is INTEGER
  104. *> = 0: successful exit
  105. *> < 0: if INFO = -k, the k-th argument had an illegal value
  106. *> > 0: if INFO = k, U(k,k) is exactly zero. The factorization
  107. *> has been completed, but the factor U is exactly
  108. *> singular, and division by zero will occur if it is used
  109. *> to solve a system of equations.
  110. *> \endverbatim
  111. *
  112. * Authors:
  113. * ========
  114. *
  115. *> \author Univ. of Tennessee
  116. *> \author Univ. of California Berkeley
  117. *> \author Univ. of Colorado Denver
  118. *> \author NAG Ltd.
  119. *
  120. *> \ingroup complexGTcomputational
  121. *
  122. * =====================================================================
  123. SUBROUTINE CGTTRF( N, DL, D, DU, DU2, IPIV, INFO )
  124. *
  125. * -- LAPACK computational routine --
  126. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  127. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  128. *
  129. * .. Scalar Arguments ..
  130. INTEGER INFO, N
  131. * ..
  132. * .. Array Arguments ..
  133. INTEGER IPIV( * )
  134. COMPLEX D( * ), DL( * ), DU( * ), DU2( * )
  135. * ..
  136. *
  137. * =====================================================================
  138. *
  139. * .. Parameters ..
  140. REAL ZERO
  141. PARAMETER ( ZERO = 0.0E+0 )
  142. * ..
  143. * .. Local Scalars ..
  144. INTEGER I
  145. COMPLEX FACT, TEMP, ZDUM
  146. * ..
  147. * .. External Subroutines ..
  148. EXTERNAL XERBLA
  149. * ..
  150. * .. Intrinsic Functions ..
  151. INTRINSIC ABS, AIMAG, REAL
  152. * ..
  153. * .. Statement Functions ..
  154. REAL CABS1
  155. * ..
  156. * .. Statement Function definitions ..
  157. CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) )
  158. * ..
  159. * .. Executable Statements ..
  160. *
  161. INFO = 0
  162. IF( N.LT.0 ) THEN
  163. INFO = -1
  164. CALL XERBLA( 'CGTTRF', -INFO )
  165. RETURN
  166. END IF
  167. *
  168. * Quick return if possible
  169. *
  170. IF( N.EQ.0 )
  171. $ RETURN
  172. *
  173. * Initialize IPIV(i) = i and DU2(i) = 0
  174. *
  175. DO 10 I = 1, N
  176. IPIV( I ) = I
  177. 10 CONTINUE
  178. DO 20 I = 1, N - 2
  179. DU2( I ) = ZERO
  180. 20 CONTINUE
  181. *
  182. DO 30 I = 1, N - 2
  183. IF( CABS1( D( I ) ).GE.CABS1( DL( I ) ) ) THEN
  184. *
  185. * No row interchange required, eliminate DL(I)
  186. *
  187. IF( CABS1( D( I ) ).NE.ZERO ) THEN
  188. FACT = DL( I ) / D( I )
  189. DL( I ) = FACT
  190. D( I+1 ) = D( I+1 ) - FACT*DU( I )
  191. END IF
  192. ELSE
  193. *
  194. * Interchange rows I and I+1, eliminate DL(I)
  195. *
  196. FACT = D( I ) / DL( I )
  197. D( I ) = DL( I )
  198. DL( I ) = FACT
  199. TEMP = DU( I )
  200. DU( I ) = D( I+1 )
  201. D( I+1 ) = TEMP - FACT*D( I+1 )
  202. DU2( I ) = DU( I+1 )
  203. DU( I+1 ) = -FACT*DU( I+1 )
  204. IPIV( I ) = I + 1
  205. END IF
  206. 30 CONTINUE
  207. IF( N.GT.1 ) THEN
  208. I = N - 1
  209. IF( CABS1( D( I ) ).GE.CABS1( DL( I ) ) ) THEN
  210. IF( CABS1( D( I ) ).NE.ZERO ) THEN
  211. FACT = DL( I ) / D( I )
  212. DL( I ) = FACT
  213. D( I+1 ) = D( I+1 ) - FACT*DU( I )
  214. END IF
  215. ELSE
  216. FACT = D( I ) / DL( I )
  217. D( I ) = DL( I )
  218. DL( I ) = FACT
  219. TEMP = DU( I )
  220. DU( I ) = D( I+1 )
  221. D( I+1 ) = TEMP - FACT*D( I+1 )
  222. IPIV( I ) = I + 1
  223. END IF
  224. END IF
  225. *
  226. * Check for a zero on the diagonal of U.
  227. *
  228. DO 40 I = 1, N
  229. IF( CABS1( D( I ) ).EQ.ZERO ) THEN
  230. INFO = I
  231. GO TO 50
  232. END IF
  233. 40 CONTINUE
  234. 50 CONTINUE
  235. *
  236. RETURN
  237. *
  238. * End of CGTTRF
  239. *
  240. END