1*> \brief \b CTPTTR 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 CTPTTR + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ctpttr.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ctpttr.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ctpttr.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE CTPTTR( UPLO, N, AP, A, LDA, INFO )
22*
23*       .. Scalar Arguments ..
24*       CHARACTER          UPLO
25*       INTEGER            INFO, N, LDA
26*       ..
27*       .. Array Arguments ..
28*       COMPLEX            A( LDA, * ), AP( * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> CTPTTR 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 COMPLEX 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 COMPLEX 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 complexOTHERcomputational
103*
104*  =====================================================================
105      SUBROUTINE CTPTTR( 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      COMPLEX            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( 'CTPTTR', -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 CTPTTR
175*
176      END
177