diff options
author | julie <julielangou@users.noreply.github.com> | 2008-12-16 17:06:58 +0000 |
---|---|---|
committer | julie <julielangou@users.noreply.github.com> | 2008-12-16 17:06:58 +0000 |
commit | ff981f106bde4ce6a74aa4f4a572c943f5a395b2 (patch) | |
tree | a386cad907bcaefd6893535c31d67ec9468e693e /SRC/stpttr.f | |
parent | e58b61578b55644f6391f3333262b72c1dc88437 (diff) | |
download | lapack-ff981f106bde4ce6a74aa4f4a572c943f5a395b2.tar.gz lapack-ff981f106bde4ce6a74aa4f4a572c943f5a395b2.tar.bz2 lapack-ff981f106bde4ce6a74aa4f4a572c943f5a395b2.zip |
Diffstat (limited to 'SRC/stpttr.f')
-rw-r--r-- | SRC/stpttr.f | 114 |
1 files changed, 114 insertions, 0 deletions
diff --git a/SRC/stpttr.f b/SRC/stpttr.f new file mode 100644 index 00000000..d500cf48 --- /dev/null +++ b/SRC/stpttr.f @@ -0,0 +1,114 @@ + SUBROUTINE STPTTR( UPLO, N, AP, A, LDA, INFO ) +* +* -- LAPACK routine (version 3.2) -- +* +* -- Contributed by Julien Langou of the Univ. of Colorado Denver -- +* -- November 2008 -- +* +* -- LAPACK is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* +* .. Scalar Arguments .. + CHARACTER UPLO + INTEGER INFO, N, LDA +* .. +* .. Array Arguments .. + REAL A( LDA, * ), AP( * ) +* .. +* +* Purpose +* ======= +* +* STPTTR copies a triangular matrix A from standard packed format (TP) +* to standard full format (TR). +* +* Arguments +* ========= +* +* UPLO (input) CHARACTER +* = 'U': A is upper triangular. +* = 'L': A is lower triangular. +* +* N (input) INTEGER +* The order of the matrix A. N >= 0. +* +* AP (input) REAL array, dimension ( N*(N+1)/2 ), +* On entry, the upper or lower triangular matrix A, packed +* columnwise in a linear array. The j-th column of A is stored +* in the array AP as follows: +* if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j; +* if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n. +* +* A (output) REAL array, dimension ( LDA, N ) +* On exit, the triangular matrix A. If UPLO = 'U', the leading +* N-by-N upper triangular part of A contains the upper +* triangular part of the matrix A, and the strictly lower +* triangular part of A is not referenced. If UPLO = 'L', the +* leading N-by-N lower triangular part of A contains the lower +* triangular part of the matrix A, and the strictly upper +* triangular part of A is not referenced. +* +* LDA (input) INTEGER +* The leading dimension of the array A. LDA >= max(1,N). +* +* INFO (output) INTEGER +* = 0: successful exit +* < 0: if INFO = -i, the i-th argument had an illegal value +* +* ===================================================================== +* +* .. Parameters .. +* .. +* .. Local Scalars .. + LOGICAL LOWER + INTEGER I, J, K +* .. +* .. External Functions .. + LOGICAL LSAME + EXTERNAL LSAME +* .. +* .. External Subroutines .. + EXTERNAL XERBLA +* .. +* .. Executable Statements .. +* +* Test the input parameters. +* + INFO = 0 + LOWER = LSAME( UPLO, 'L' ) + IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN + INFO = -1 + ELSE IF( N.LT.0 ) THEN + INFO = -2 + ELSE IF( LDA.LT.MAX( 1, N ) ) THEN + INFO = -5 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'STPTTR', -INFO ) + RETURN + END IF +* + IF( LOWER ) THEN + K = 0 + DO J = 1, N + DO I = J, N + K = K + 1 + A( I, J ) = AP( K ) + END DO + END DO + ELSE + K = 0 + DO J = 1, N + DO I = 1, J + K = K + 1 + A( I, J ) = AP( K ) + END DO + END DO + END IF +* +* + RETURN +* +* End of STPTTR +* + END |