001:       SUBROUTINE STRTTP( UPLO, N, A, LDA, AP, INFO )
002: *
003: *  -- LAPACK routine (version 3.2) --
004: *  -- Contributed by Fred Gustavson of the IBM Watson Research Center --
005: *  --            and Julien Langou of the Univ. of Colorado Denver    --
006: *  -- November 2008 --
007: *
008: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
009: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
010: *
011: *     .. Scalar Arguments ..
012:       CHARACTER          UPLO
013:       INTEGER            INFO, N, LDA
014: *     ..
015: *     .. Array Arguments ..
016:       REAL               A( LDA, * ), AP( * )
017: *     ..
018: *
019: *  Purpose
020: *  =======
021: *
022: *  STRTTP copies a triangular matrix A from full format (TR) to standard
023: *  packed format (TP).
024: *
025: *  Arguments
026: *  =========
027: *
028: *  UPLO    (input) CHARACTER
029: *          = 'U':  A is upper triangular.
030: *          = 'L':  A is lower triangular.
031: *
032: *  N       (input) INTEGER
033: *          The order of the matrices AP and A.  N >= 0.
034: *
035: *  A       (input) REAL array, dimension (LDA,N)
036: *          On exit, the triangular matrix A.  If UPLO = 'U', the leading
037: *          N-by-N upper triangular part of A contains the upper
038: *          triangular part of the matrix A, and the strictly lower
039: *          triangular part of A is not referenced.  If UPLO = 'L', the
040: *          leading N-by-N lower triangular part of A contains the lower
041: *          triangular part of the matrix A, and the strictly upper
042: *          triangular part of A is not referenced.
043: *
044: *  LDA     (input) INTEGER
045: *          The leading dimension of the array A.  LDA >= max(1,N).
046: *
047: *  AP      (output) REAL array, dimension (N*(N+1)/2
048: *          On exit, the upper or lower triangular matrix A, packed
049: *          columnwise in a linear array. The j-th column of A is stored
050: *          in the array AP as follows:
051: *          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
052: *          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
053: *
054: *  INFO    (output) INTEGER
055: *          = 0:  successful exit
056: *          < 0:  if INFO = -i, the i-th argument had an illegal value
057: *
058: *  =====================================================================
059: *
060: *     .. Parameters ..
061: *     ..
062: *     .. Local Scalars ..
063:       LOGICAL            LOWER
064:       INTEGER            I, J, K
065: *     ..
066: *     .. External Functions ..
067:       LOGICAL            LSAME
068:       EXTERNAL           LSAME
069: *     ..
070: *     .. External Subroutines ..
071:       EXTERNAL           XERBLA
072: *     ..
073: *     .. Executable Statements ..
074: *
075: *     Test the input parameters.
076: *
077:       INFO = 0
078:       LOWER = LSAME( UPLO, 'L' )
079:       IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
080:          INFO = -1
081:       ELSE IF( N.LT.0 ) THEN
082:          INFO = -2
083:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
084:          INFO = -4
085:       END IF
086:       IF( INFO.NE.0 ) THEN
087:          CALL XERBLA( 'STRTTP', -INFO )
088:          RETURN
089:       END IF
090: *
091:       IF( LOWER ) THEN
092:          K = 0
093:          DO J = 1, N
094:             DO I = J, N
095:                K = K + 1
096:                AP( K ) = A( I, J )
097:             END DO
098:          END DO
099:       ELSE
100:          K = 0
101:          DO J = 1, N
102:             DO I = 1, J
103:                K = K + 1
104:                AP( K ) = A( I, J )
105:             END DO
106:          END DO
107:       END IF
108: *
109:       RETURN
110: *
111: *     End of STRTTP
112: *
113:       END
114: