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.

ztrttp.f 4.7 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173
  1. *> \brief \b ZTRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (TP).
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download ZTRTTP + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztrttp.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztrttp.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztrttp.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE ZTRTTP( UPLO, N, A, LDA, AP, INFO )
  22. *
  23. * .. Scalar Arguments ..
  24. * CHARACTER UPLO
  25. * INTEGER INFO, N, LDA
  26. * ..
  27. * .. Array Arguments ..
  28. * COMPLEX*16 A( LDA, * ), AP( * )
  29. * ..
  30. *
  31. *
  32. *> \par Purpose:
  33. * =============
  34. *>
  35. *> \verbatim
  36. *>
  37. *> ZTRTTP copies a triangular matrix A from full format (TR) to standard
  38. *> packed format (TP).
  39. *> \endverbatim
  40. *
  41. * Arguments:
  42. * ==========
  43. *
  44. *> \param[in] UPLO
  45. *> \verbatim
  46. *> UPLO is CHARACTER*1
  47. *> = 'U': A is upper triangular;
  48. *> = 'L': A is lower triangular.
  49. *> \endverbatim
  50. *>
  51. *> \param[in] N
  52. *> \verbatim
  53. *> N is INTEGER
  54. *> The order of the matrices AP and A. N >= 0.
  55. *> \endverbatim
  56. *>
  57. *> \param[in] A
  58. *> \verbatim
  59. *> A is COMPLEX*16 array, dimension (LDA,N)
  60. *> On entry, the triangular matrix A. If UPLO = 'U', the leading
  61. *> N-by-N upper triangular part of A contains the upper
  62. *> triangular part of the matrix A, and the strictly lower
  63. *> triangular part of A is not referenced. If UPLO = 'L', the
  64. *> leading N-by-N lower triangular part of A contains the lower
  65. *> triangular part of the matrix A, and the strictly upper
  66. *> triangular part of A is not referenced.
  67. *> \endverbatim
  68. *>
  69. *> \param[in] LDA
  70. *> \verbatim
  71. *> LDA is INTEGER
  72. *> The leading dimension of the array A. LDA >= max(1,N).
  73. *> \endverbatim
  74. *>
  75. *> \param[out] AP
  76. *> \verbatim
  77. *> AP is COMPLEX*16 array, dimension ( N*(N+1)/2 ),
  78. *> On exit, the upper or lower triangular matrix A, packed
  79. *> columnwise in a linear array. The j-th column of A is stored
  80. *> in the array AP as follows:
  81. *> if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
  82. *> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
  83. *> \endverbatim
  84. *>
  85. *> \param[out] INFO
  86. *> \verbatim
  87. *> INFO is INTEGER
  88. *> = 0: successful exit
  89. *> < 0: if INFO = -i, the i-th argument had an illegal value
  90. *> \endverbatim
  91. *
  92. * Authors:
  93. * ========
  94. *
  95. *> \author Univ. of Tennessee
  96. *> \author Univ. of California Berkeley
  97. *> \author Univ. of Colorado Denver
  98. *> \author NAG Ltd.
  99. *
  100. *> \ingroup complex16OTHERcomputational
  101. *
  102. * =====================================================================
  103. SUBROUTINE ZTRTTP( UPLO, N, A, LDA, AP, INFO )
  104. *
  105. * -- LAPACK computational routine --
  106. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  107. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  108. *
  109. * .. Scalar Arguments ..
  110. CHARACTER UPLO
  111. INTEGER INFO, N, LDA
  112. * ..
  113. * .. Array Arguments ..
  114. COMPLEX*16 A( LDA, * ), AP( * )
  115. * ..
  116. *
  117. * =====================================================================
  118. *
  119. * .. Parameters ..
  120. * ..
  121. * .. Local Scalars ..
  122. LOGICAL LOWER
  123. INTEGER I, J, K
  124. * ..
  125. * .. External Functions ..
  126. LOGICAL LSAME
  127. EXTERNAL LSAME
  128. * ..
  129. * .. External Subroutines ..
  130. EXTERNAL XERBLA
  131. * ..
  132. * .. Executable Statements ..
  133. *
  134. * Test the input parameters.
  135. *
  136. INFO = 0
  137. LOWER = LSAME( UPLO, 'L' )
  138. IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
  139. INFO = -1
  140. ELSE IF( N.LT.0 ) THEN
  141. INFO = -2
  142. ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  143. INFO = -4
  144. END IF
  145. IF( INFO.NE.0 ) THEN
  146. CALL XERBLA( 'ZTRTTP', -INFO )
  147. RETURN
  148. END IF
  149. *
  150. IF( LOWER ) THEN
  151. K = 0
  152. DO J = 1, N
  153. DO I = J, N
  154. K = K + 1
  155. AP( K ) = A( I, J )
  156. END DO
  157. END DO
  158. ELSE
  159. K = 0
  160. DO J = 1, N
  161. DO I = 1, J
  162. K = K + 1
  163. AP( K ) = A( I, J )
  164. END DO
  165. END DO
  166. END IF
  167. *
  168. *
  169. RETURN
  170. *
  171. * End of ZTRTTP
  172. *
  173. END