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.

cpttrs.f 5.7 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208
  1. *> \brief \b CPTTRS
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download CPTTRS + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cpttrs.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cpttrs.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cpttrs.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE CPTTRS( UPLO, N, NRHS, D, E, B, LDB, INFO )
  22. *
  23. * .. Scalar Arguments ..
  24. * CHARACTER UPLO
  25. * INTEGER INFO, LDB, N, NRHS
  26. * ..
  27. * .. Array Arguments ..
  28. * REAL D( * )
  29. * COMPLEX B( LDB, * ), E( * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> CPTTRS solves a tridiagonal system of the form
  39. *> A * X = B
  40. *> using the factorization A = U**H*D*U or A = L*D*L**H computed by CPTTRF.
  41. *> D is a diagonal matrix specified in the vector D, U (or L) is a unit
  42. *> bidiagonal matrix whose superdiagonal (subdiagonal) is specified in
  43. *> the vector E, and X and B are N by NRHS matrices.
  44. *> \endverbatim
  45. *
  46. * Arguments:
  47. * ==========
  48. *
  49. *> \param[in] UPLO
  50. *> \verbatim
  51. *> UPLO is CHARACTER*1
  52. *> Specifies the form of the factorization and whether the
  53. *> vector E is the superdiagonal of the upper bidiagonal factor
  54. *> U or the subdiagonal of the lower bidiagonal factor L.
  55. *> = 'U': A = U**H*D*U, E is the superdiagonal of U
  56. *> = 'L': A = L*D*L**H, E is the subdiagonal of L
  57. *> \endverbatim
  58. *>
  59. *> \param[in] N
  60. *> \verbatim
  61. *> N is INTEGER
  62. *> The order of the tridiagonal matrix A. N >= 0.
  63. *> \endverbatim
  64. *>
  65. *> \param[in] NRHS
  66. *> \verbatim
  67. *> NRHS is INTEGER
  68. *> The number of right hand sides, i.e., the number of columns
  69. *> of the matrix B. NRHS >= 0.
  70. *> \endverbatim
  71. *>
  72. *> \param[in] D
  73. *> \verbatim
  74. *> D is REAL array, dimension (N)
  75. *> The n diagonal elements of the diagonal matrix D from the
  76. *> factorization A = U**H*D*U or A = L*D*L**H.
  77. *> \endverbatim
  78. *>
  79. *> \param[in] E
  80. *> \verbatim
  81. *> E is COMPLEX array, dimension (N-1)
  82. *> If UPLO = 'U', the (n-1) superdiagonal elements of the unit
  83. *> bidiagonal factor U from the factorization A = U**H*D*U.
  84. *> If UPLO = 'L', the (n-1) subdiagonal elements of the unit
  85. *> bidiagonal factor L from the factorization A = L*D*L**H.
  86. *> \endverbatim
  87. *>
  88. *> \param[in,out] B
  89. *> \verbatim
  90. *> B is COMPLEX array, dimension (LDB,NRHS)
  91. *> On entry, the right hand side vectors B for the system of
  92. *> linear equations.
  93. *> On exit, the solution vectors, X.
  94. *> \endverbatim
  95. *>
  96. *> \param[in] LDB
  97. *> \verbatim
  98. *> LDB is INTEGER
  99. *> The leading dimension of the array B. LDB >= max(1,N).
  100. *> \endverbatim
  101. *>
  102. *> \param[out] INFO
  103. *> \verbatim
  104. *> INFO is INTEGER
  105. *> = 0: successful exit
  106. *> < 0: if INFO = -k, the k-th argument had an illegal value
  107. *> \endverbatim
  108. *
  109. * Authors:
  110. * ========
  111. *
  112. *> \author Univ. of Tennessee
  113. *> \author Univ. of California Berkeley
  114. *> \author Univ. of Colorado Denver
  115. *> \author NAG Ltd.
  116. *
  117. *> \date June 2016
  118. *
  119. *> \ingroup complexPTcomputational
  120. *
  121. * =====================================================================
  122. SUBROUTINE CPTTRS( UPLO, N, NRHS, D, E, B, LDB, INFO )
  123. *
  124. * -- LAPACK computational routine (version 3.7.0) --
  125. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  126. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  127. * June 2016
  128. *
  129. * .. Scalar Arguments ..
  130. CHARACTER UPLO
  131. INTEGER INFO, LDB, N, NRHS
  132. * ..
  133. * .. Array Arguments ..
  134. REAL D( * )
  135. COMPLEX B( LDB, * ), E( * )
  136. * ..
  137. *
  138. * =====================================================================
  139. *
  140. * .. Local Scalars ..
  141. LOGICAL UPPER
  142. INTEGER IUPLO, J, JB, NB
  143. * ..
  144. * .. External Functions ..
  145. INTEGER ILAENV
  146. EXTERNAL ILAENV
  147. * ..
  148. * .. External Subroutines ..
  149. EXTERNAL CPTTS2, XERBLA
  150. * ..
  151. * .. Intrinsic Functions ..
  152. INTRINSIC MAX, MIN
  153. * ..
  154. * .. Executable Statements ..
  155. *
  156. * Test the input arguments.
  157. *
  158. INFO = 0
  159. UPPER = ( UPLO.EQ.'U' .OR. UPLO.EQ.'u' )
  160. IF( .NOT.UPPER .AND. .NOT.( UPLO.EQ.'L' .OR. UPLO.EQ.'l' ) ) THEN
  161. INFO = -1
  162. ELSE IF( N.LT.0 ) THEN
  163. INFO = -2
  164. ELSE IF( NRHS.LT.0 ) THEN
  165. INFO = -3
  166. ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
  167. INFO = -7
  168. END IF
  169. IF( INFO.NE.0 ) THEN
  170. CALL XERBLA( 'CPTTRS', -INFO )
  171. RETURN
  172. END IF
  173. *
  174. * Quick return if possible
  175. *
  176. IF( N.EQ.0 .OR. NRHS.EQ.0 )
  177. $ RETURN
  178. *
  179. * Determine the number of right-hand sides to solve at a time.
  180. *
  181. IF( NRHS.EQ.1 ) THEN
  182. NB = 1
  183. ELSE
  184. NB = MAX( 1, ILAENV( 1, 'CPTTRS', UPLO, N, NRHS, -1, -1 ) )
  185. END IF
  186. *
  187. * Decode UPLO
  188. *
  189. IF( UPPER ) THEN
  190. IUPLO = 1
  191. ELSE
  192. IUPLO = 0
  193. END IF
  194. *
  195. IF( NB.GE.NRHS ) THEN
  196. CALL CPTTS2( IUPLO, N, NRHS, D, E, B, LDB )
  197. ELSE
  198. DO 10 J = 1, NRHS, NB
  199. JB = MIN( NRHS-J+1, NB )
  200. CALL CPTTS2( IUPLO, N, JB, D, E, B( 1, J ), LDB )
  201. 10 CONTINUE
  202. END IF
  203. *
  204. RETURN
  205. *
  206. * End of CPTTRS
  207. *
  208. END