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.

dtpttr.f 4.8 kB

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