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.

zsyconv.f 9.2 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362
  1. *> \brief \b ZSYCONV
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download ZSYCONV + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zsyconv.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zsyconv.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zsyconv.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE ZSYCONV( UPLO, WAY, N, A, LDA, IPIV, WORK, INFO )
  22. *
  23. * .. Scalar Arguments ..
  24. * CHARACTER UPLO, WAY
  25. * INTEGER INFO, LDA, N
  26. * ..
  27. * .. Array Arguments ..
  28. * INTEGER IPIV( * )
  29. * COMPLEX*16 A( LDA, * ), WORK( * )
  30. * ..
  31. *
  32. *
  33. *> \par Purpose:
  34. * =============
  35. *>
  36. *> \verbatim
  37. *>
  38. *> ZSYCONV converts A given by ZHETRF into L and D or vice-versa.
  39. *> Get nondiagonal elements of D (returned in workspace) and
  40. *> apply or reverse permutation done in TRF.
  41. *> \endverbatim
  42. *
  43. * Arguments:
  44. * ==========
  45. *
  46. *> \param[in] UPLO
  47. *> \verbatim
  48. *> UPLO is CHARACTER*1
  49. *> Specifies whether the details of the factorization are stored
  50. *> as an upper or lower triangular matrix.
  51. *> = 'U': Upper triangular, form is A = U*D*U**T;
  52. *> = 'L': Lower triangular, form is A = L*D*L**T.
  53. *> \endverbatim
  54. *>
  55. *> \param[in] WAY
  56. *> \verbatim
  57. *> WAY is CHARACTER*1
  58. *> = 'C': Convert
  59. *> = 'R': Revert
  60. *> \endverbatim
  61. *>
  62. *> \param[in] N
  63. *> \verbatim
  64. *> N is INTEGER
  65. *> The order of the matrix A. N >= 0.
  66. *> \endverbatim
  67. *>
  68. *> \param[in] A
  69. *> \verbatim
  70. *> A is COMPLEX*16 array, dimension (LDA,N)
  71. *> The block diagonal matrix D and the multipliers used to
  72. *> obtain the factor U or L as computed by ZSYTRF.
  73. *> \endverbatim
  74. *>
  75. *> \param[in] LDA
  76. *> \verbatim
  77. *> LDA is INTEGER
  78. *> The leading dimension of the array A. LDA >= max(1,N).
  79. *> \endverbatim
  80. *>
  81. *> \param[in] IPIV
  82. *> \verbatim
  83. *> IPIV is INTEGER array, dimension (N)
  84. *> Details of the interchanges and the block structure of D
  85. *> as determined by ZSYTRF.
  86. *> \endverbatim
  87. *>
  88. *> \param[out] WORK
  89. *> \verbatim
  90. *> WORK is COMPLEX*16 array, dimension (N)
  91. *> \endverbatim
  92. *>
  93. *> \param[out] INFO
  94. *> \verbatim
  95. *> INFO is INTEGER
  96. *> = 0: successful exit
  97. *> < 0: if INFO = -i, the i-th argument had an illegal value
  98. *> \endverbatim
  99. *
  100. * Authors:
  101. * ========
  102. *
  103. *> \author Univ. of Tennessee
  104. *> \author Univ. of California Berkeley
  105. *> \author Univ. of Colorado Denver
  106. *> \author NAG Ltd.
  107. *
  108. *> \date November 2011
  109. *
  110. *> \ingroup complex16SYcomputational
  111. *
  112. * =====================================================================
  113. SUBROUTINE ZSYCONV( UPLO, WAY, N, A, LDA, IPIV, WORK, INFO )
  114. *
  115. * -- LAPACK computational routine (version 3.4.0) --
  116. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  117. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  118. * November 2011
  119. *
  120. * .. Scalar Arguments ..
  121. CHARACTER UPLO, WAY
  122. INTEGER INFO, LDA, N
  123. * ..
  124. * .. Array Arguments ..
  125. INTEGER IPIV( * )
  126. COMPLEX*16 A( LDA, * ), WORK( * )
  127. * ..
  128. *
  129. * =====================================================================
  130. *
  131. * .. Parameters ..
  132. COMPLEX*16 ZERO
  133. PARAMETER ( ZERO = (0.0D+0,0.0D+0) )
  134. * ..
  135. * .. External Functions ..
  136. LOGICAL LSAME
  137. EXTERNAL LSAME
  138. *
  139. * .. External Subroutines ..
  140. EXTERNAL XERBLA
  141. * .. Local Scalars ..
  142. LOGICAL UPPER, CONVERT
  143. INTEGER I, IP, J
  144. COMPLEX*16 TEMP
  145. * ..
  146. * .. Executable Statements ..
  147. *
  148. INFO = 0
  149. UPPER = LSAME( UPLO, 'U' )
  150. CONVERT = LSAME( WAY, 'C' )
  151. IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
  152. INFO = -1
  153. ELSE IF( .NOT.CONVERT .AND. .NOT.LSAME( WAY, 'R' ) ) THEN
  154. INFO = -2
  155. ELSE IF( N.LT.0 ) THEN
  156. INFO = -3
  157. ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  158. INFO = -5
  159. END IF
  160. IF( INFO.NE.0 ) THEN
  161. CALL XERBLA( 'ZSYCONV', -INFO )
  162. RETURN
  163. END IF
  164. *
  165. * Quick return if possible
  166. *
  167. IF( N.EQ.0 )
  168. $ RETURN
  169. *
  170. IF( UPPER ) THEN
  171. *
  172. * A is UPPER
  173. *
  174. IF ( CONVERT ) THEN
  175. *
  176. * Convert A (A is upper)
  177. *
  178. * Convert VALUE
  179. *
  180. I=N
  181. WORK(1)=ZERO
  182. DO WHILE ( I .GT. 1 )
  183. IF( IPIV(I) .LT. 0 ) THEN
  184. WORK(I)=A(I-1,I)
  185. A(I-1,I)=ZERO
  186. I=I-1
  187. ELSE
  188. WORK(I)=ZERO
  189. ENDIF
  190. I=I-1
  191. END DO
  192. *
  193. * Convert PERMUTATIONS
  194. *
  195. I=N
  196. DO WHILE ( I .GE. 1 )
  197. IF( IPIV(I) .GT. 0) THEN
  198. IP=IPIV(I)
  199. IF( I .LT. N) THEN
  200. DO 12 J= I+1,N
  201. TEMP=A(IP,J)
  202. A(IP,J)=A(I,J)
  203. A(I,J)=TEMP
  204. 12 CONTINUE
  205. ENDIF
  206. ELSE
  207. IP=-IPIV(I)
  208. IF( I .LT. N) THEN
  209. DO 13 J= I+1,N
  210. TEMP=A(IP,J)
  211. A(IP,J)=A(I-1,J)
  212. A(I-1,J)=TEMP
  213. 13 CONTINUE
  214. ENDIF
  215. I=I-1
  216. ENDIF
  217. I=I-1
  218. END DO
  219. *
  220. ELSE
  221. *
  222. * Revert A (A is upper)
  223. *
  224. * Revert PERMUTATIONS
  225. *
  226. I=1
  227. DO WHILE ( I .LE. N )
  228. IF( IPIV(I) .GT. 0 ) THEN
  229. IP=IPIV(I)
  230. IF( I .LT. N) THEN
  231. DO J= I+1,N
  232. TEMP=A(IP,J)
  233. A(IP,J)=A(I,J)
  234. A(I,J)=TEMP
  235. END DO
  236. ENDIF
  237. ELSE
  238. IP=-IPIV(I)
  239. I=I+1
  240. IF( I .LT. N) THEN
  241. DO J= I+1,N
  242. TEMP=A(IP,J)
  243. A(IP,J)=A(I-1,J)
  244. A(I-1,J)=TEMP
  245. END DO
  246. ENDIF
  247. ENDIF
  248. I=I+1
  249. END DO
  250. *
  251. * Revert VALUE
  252. *
  253. I=N
  254. DO WHILE ( I .GT. 1 )
  255. IF( IPIV(I) .LT. 0 ) THEN
  256. A(I-1,I)=WORK(I)
  257. I=I-1
  258. ENDIF
  259. I=I-1
  260. END DO
  261. END IF
  262. *
  263. ELSE
  264. *
  265. * A is LOWER
  266. *
  267. IF ( CONVERT ) THEN
  268. *
  269. * Convert A (A is lower)
  270. *
  271. * Convert VALUE
  272. *
  273. I=1
  274. WORK(N)=ZERO
  275. DO WHILE ( I .LE. N )
  276. IF( I.LT.N .AND. IPIV(I) .LT. 0 ) THEN
  277. WORK(I)=A(I+1,I)
  278. A(I+1,I)=ZERO
  279. I=I+1
  280. ELSE
  281. WORK(I)=ZERO
  282. ENDIF
  283. I=I+1
  284. END DO
  285. *
  286. * Convert PERMUTATIONS
  287. *
  288. I=1
  289. DO WHILE ( I .LE. N )
  290. IF( IPIV(I) .GT. 0 ) THEN
  291. IP=IPIV(I)
  292. IF (I .GT. 1) THEN
  293. DO 22 J= 1,I-1
  294. TEMP=A(IP,J)
  295. A(IP,J)=A(I,J)
  296. A(I,J)=TEMP
  297. 22 CONTINUE
  298. ENDIF
  299. ELSE
  300. IP=-IPIV(I)
  301. IF (I .GT. 1) THEN
  302. DO 23 J= 1,I-1
  303. TEMP=A(IP,J)
  304. A(IP,J)=A(I+1,J)
  305. A(I+1,J)=TEMP
  306. 23 CONTINUE
  307. ENDIF
  308. I=I+1
  309. ENDIF
  310. I=I+1
  311. END DO
  312. *
  313. ELSE
  314. *
  315. * Revert A (A is lower)
  316. *
  317. * Revert PERMUTATIONS
  318. *
  319. I=N
  320. DO WHILE ( I .GE. 1 )
  321. IF( IPIV(I) .GT. 0 ) THEN
  322. IP=IPIV(I)
  323. IF (I .GT. 1) THEN
  324. DO J= 1,I-1
  325. TEMP=A(I,J)
  326. A(I,J)=A(IP,J)
  327. A(IP,J)=TEMP
  328. END DO
  329. ENDIF
  330. ELSE
  331. IP=-IPIV(I)
  332. I=I-1
  333. IF (I .GT. 1) THEN
  334. DO J= 1,I-1
  335. TEMP=A(I+1,J)
  336. A(I+1,J)=A(IP,J)
  337. A(IP,J)=TEMP
  338. END DO
  339. ENDIF
  340. ENDIF
  341. I=I-1
  342. END DO
  343. *
  344. * Revert VALUE
  345. *
  346. I=1
  347. DO WHILE ( I .LE. N-1 )
  348. IF( IPIV(I) .LT. 0 ) THEN
  349. A(I+1,I)=WORK(I)
  350. I=I+1
  351. ENDIF
  352. I=I+1
  353. END DO
  354. END IF
  355. END IF
  356. *
  357. RETURN
  358. *
  359. * End of ZSYCONV
  360. *
  361. END