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.

chetri_3.f 7.8 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251
  1. *> \brief \b CHETRI_3
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download CHETRI_3 + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetri_3.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetri_3.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetri_3.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE CHETRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
  22. * INFO )
  23. *
  24. * .. Scalar Arguments ..
  25. * CHARACTER UPLO
  26. * INTEGER INFO, LDA, LWORK, N
  27. * ..
  28. * .. Array Arguments ..
  29. * INTEGER IPIV( * )
  30. * COMPLEX A( LDA, * ), E( * ), WORK( * )
  31. * ..
  32. *
  33. *
  34. *> \par Purpose:
  35. * =============
  36. *>
  37. *> \verbatim
  38. *> CHETRI_3 computes the inverse of a complex Hermitian indefinite
  39. *> matrix A using the factorization computed by CHETRF_RK or CHETRF_BK:
  40. *>
  41. *> A = P*U*D*(U**H)*(P**T) or A = P*L*D*(L**H)*(P**T),
  42. *>
  43. *> where U (or L) is unit upper (or lower) triangular matrix,
  44. *> U**H (or L**H) is the conjugate of U (or L), P is a permutation
  45. *> matrix, P**T is the transpose of P, and D is Hermitian and block
  46. *> diagonal with 1-by-1 and 2-by-2 diagonal blocks.
  47. *>
  48. *> CHETRI_3 sets the leading dimension of the workspace before calling
  49. *> CHETRI_3X that actually computes the inverse. This is the blocked
  50. *> version of the algorithm, calling Level 3 BLAS.
  51. *> \endverbatim
  52. *
  53. * Arguments:
  54. * ==========
  55. *
  56. *> \param[in] UPLO
  57. *> \verbatim
  58. *> UPLO is CHARACTER*1
  59. *> Specifies whether the details of the factorization are
  60. *> stored as an upper or lower triangular matrix.
  61. *> = 'U': Upper triangle of A is stored;
  62. *> = 'L': Lower triangle of A is stored.
  63. *> \endverbatim
  64. *>
  65. *> \param[in] N
  66. *> \verbatim
  67. *> N is INTEGER
  68. *> The order of the matrix A. N >= 0.
  69. *> \endverbatim
  70. *>
  71. *> \param[in,out] A
  72. *> \verbatim
  73. *> A is COMPLEX array, dimension (LDA,N)
  74. *> On entry, diagonal of the block diagonal matrix D and
  75. *> factors U or L as computed by CHETRF_RK and CHETRF_BK:
  76. *> a) ONLY diagonal elements of the Hermitian block diagonal
  77. *> matrix D on the diagonal of A, i.e. D(k,k) = A(k,k);
  78. *> (superdiagonal (or subdiagonal) elements of D
  79. *> should be provided on entry in array E), and
  80. *> b) If UPLO = 'U': factor U in the superdiagonal part of A.
  81. *> If UPLO = 'L': factor L in the subdiagonal part of A.
  82. *>
  83. *> On exit, if INFO = 0, the Hermitian inverse of the original
  84. *> matrix.
  85. *> If UPLO = 'U': the upper triangular part of the inverse
  86. *> is formed and the part of A below the diagonal is not
  87. *> referenced;
  88. *> If UPLO = 'L': the lower triangular part of the inverse
  89. *> is formed and the part of A above the diagonal is not
  90. *> referenced.
  91. *> \endverbatim
  92. *>
  93. *> \param[in] LDA
  94. *> \verbatim
  95. *> LDA is INTEGER
  96. *> The leading dimension of the array A. LDA >= max(1,N).
  97. *> \endverbatim
  98. *>
  99. *> \param[in] E
  100. *> \verbatim
  101. *> E is COMPLEX array, dimension (N)
  102. *> On entry, contains the superdiagonal (or subdiagonal)
  103. *> elements of the Hermitian block diagonal matrix D
  104. *> with 1-by-1 or 2-by-2 diagonal blocks, where
  105. *> If UPLO = 'U': E(i) = D(i-1,i),i=2:N, E(1) not referenced;
  106. *> If UPLO = 'L': E(i) = D(i+1,i),i=1:N-1, E(N) not referenced.
  107. *>
  108. *> NOTE: For 1-by-1 diagonal block D(k), where
  109. *> 1 <= k <= N, the element E(k) is not referenced in both
  110. *> UPLO = 'U' or UPLO = 'L' cases.
  111. *> \endverbatim
  112. *>
  113. *> \param[in] IPIV
  114. *> \verbatim
  115. *> IPIV is INTEGER array, dimension (N)
  116. *> Details of the interchanges and the block structure of D
  117. *> as determined by CHETRF_RK or CHETRF_BK.
  118. *> \endverbatim
  119. *>
  120. *> \param[out] WORK
  121. *> \verbatim
  122. *> WORK is COMPLEX array, dimension (MAX(1,LWORK)).
  123. *> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
  124. *> \endverbatim
  125. *>
  126. *> \param[in] LWORK
  127. *> \verbatim
  128. *> LWORK is INTEGER
  129. *> The length of WORK.
  130. *> If N = 0, LWORK >= 1, else LWORK >= (N+NB+1)*(NB+3).
  131. *>
  132. *> If LWORK = -1, then a workspace query is assumed;
  133. *> the routine only calculates the optimal size of the optimal
  134. *> size of the WORK array, returns this value as the first
  135. *> entry of the WORK array, and no error message related to
  136. *> LWORK is issued by XERBLA.
  137. *> \endverbatim
  138. *>
  139. *> \param[out] INFO
  140. *> \verbatim
  141. *> INFO is INTEGER
  142. *> = 0: successful exit
  143. *> < 0: if INFO = -i, the i-th argument had an illegal value
  144. *> > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its
  145. *> inverse could not be computed.
  146. *> \endverbatim
  147. *
  148. * Authors:
  149. * ========
  150. *
  151. *> \author Univ. of Tennessee
  152. *> \author Univ. of California Berkeley
  153. *> \author Univ. of Colorado Denver
  154. *> \author NAG Ltd.
  155. *
  156. *> \ingroup hetri_3
  157. *
  158. *> \par Contributors:
  159. * ==================
  160. *> \verbatim
  161. *>
  162. *> November 2017, Igor Kozachenko,
  163. *> Computer Science Division,
  164. *> University of California, Berkeley
  165. *>
  166. *> \endverbatim
  167. *
  168. * =====================================================================
  169. SUBROUTINE CHETRI_3( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
  170. $ INFO )
  171. *
  172. * -- LAPACK computational routine --
  173. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  174. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  175. *
  176. * .. Scalar Arguments ..
  177. CHARACTER UPLO
  178. INTEGER INFO, LDA, LWORK, N
  179. * ..
  180. * .. Array Arguments ..
  181. INTEGER IPIV( * )
  182. COMPLEX A( LDA, * ), E( * ), WORK( * )
  183. * ..
  184. *
  185. * =====================================================================
  186. *
  187. * .. Local Scalars ..
  188. LOGICAL UPPER, LQUERY
  189. INTEGER LWKOPT, NB
  190. * ..
  191. * .. External Functions ..
  192. LOGICAL LSAME
  193. INTEGER ILAENV
  194. REAL SROUNDUP_LWORK
  195. EXTERNAL LSAME, ILAENV, SROUNDUP_LWORK
  196. * ..
  197. * .. External Subroutines ..
  198. EXTERNAL CHETRI_3X, XERBLA
  199. * ..
  200. * .. Intrinsic Functions ..
  201. INTRINSIC MAX
  202. * ..
  203. * .. Executable Statements ..
  204. *
  205. * Test the input parameters.
  206. *
  207. INFO = 0
  208. UPPER = LSAME( UPLO, 'U' )
  209. LQUERY = ( LWORK.EQ.-1 )
  210. *
  211. * Determine the block size
  212. *
  213. IF( N.EQ.0 ) THEN
  214. LWKOPT = 1
  215. ELSE
  216. NB = MAX( 1, ILAENV( 1, 'CHETRI_3', UPLO, N, -1, -1, -1 ) )
  217. LWKOPT = ( N+NB+1 ) * ( NB+3 )
  218. END IF
  219. WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
  220. *
  221. IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
  222. INFO = -1
  223. ELSE IF( N.LT.0 ) THEN
  224. INFO = -2
  225. ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  226. INFO = -4
  227. ELSE IF( LWORK.LT.LWKOPT .AND. .NOT.LQUERY ) THEN
  228. INFO = -8
  229. END IF
  230. *
  231. IF( INFO.NE.0 ) THEN
  232. CALL XERBLA( 'CHETRI_3', -INFO )
  233. RETURN
  234. ELSE IF( LQUERY ) THEN
  235. RETURN
  236. END IF
  237. *
  238. * Quick return if possible
  239. *
  240. IF( N.EQ.0 )
  241. $ RETURN
  242. *
  243. CALL CHETRI_3X( UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO )
  244. *
  245. WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
  246. *
  247. RETURN
  248. *
  249. * End of CHETRI_3
  250. *
  251. END