1*> \brief \b STPTTR 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 STPTTR + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stpttr.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stpttr.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stpttr.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE STPTTR( UPLO, N, AP, A, LDA, INFO )
22*
23*       .. Scalar Arguments ..
24*       CHARACTER          UPLO
25*       INTEGER            INFO, N, LDA
26*       ..
27*       .. Array Arguments ..
28*       REAL               A( LDA, * ), AP( * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> STPTTR 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 REAL 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 REAL 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*> \ingroup realOTHERcomputational
101*
102*  =====================================================================
103      SUBROUTINE STPTTR( UPLO, N, AP, A, LDA, 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      REAL               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 = -5
144      END IF
145      IF( INFO.NE.0 ) THEN
146         CALL XERBLA( 'STPTTR', -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               A( I, J ) = AP( K )
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               A( I, J ) = AP( K )
164            END DO
165         END DO
166      END IF
167*
168*
169      RETURN
170*
171*     End of STPTTR
172*
173      END
174