LAPACK 3.3.0
|
00001 SUBROUTINE STRTTP( UPLO, N, A, LDA, AP, INFO ) 00002 * 00003 * -- LAPACK routine (version 3.3.0) -- 00004 * -- Contributed by Fred Gustavson of the IBM Watson Research Center -- 00005 * -- and Julien Langou of the Univ. of Colorado Denver -- 00006 * November 2010 00007 * 00008 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00009 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00010 * 00011 * .. Scalar Arguments .. 00012 CHARACTER UPLO 00013 INTEGER INFO, N, LDA 00014 * .. 00015 * .. Array Arguments .. 00016 REAL A( LDA, * ), AP( * ) 00017 * .. 00018 * 00019 * Purpose 00020 * ======= 00021 * 00022 * STRTTP copies a triangular matrix A from full format (TR) to standard 00023 * packed format (TP). 00024 * 00025 * Arguments 00026 * ========= 00027 * 00028 * UPLO (input) CHARACTER*1 00029 * = 'U': A is upper triangular. 00030 * = 'L': A is lower triangular. 00031 * 00032 * N (input) INTEGER 00033 * The order of the matrices AP and A. N >= 0. 00034 * 00035 * A (input) REAL array, dimension (LDA,N) 00036 * On exit, the triangular matrix A. If UPLO = 'U', the leading 00037 * N-by-N upper triangular part of A contains the upper 00038 * triangular part of the matrix A, and the strictly lower 00039 * triangular part of A is not referenced. If UPLO = 'L', the 00040 * leading N-by-N lower triangular part of A contains the lower 00041 * triangular part of the matrix A, and the strictly upper 00042 * triangular part of A is not referenced. 00043 * 00044 * LDA (input) INTEGER 00045 * The leading dimension of the array A. LDA >= max(1,N). 00046 * 00047 * AP (output) REAL array, dimension (N*(N+1)/2 00048 * On exit, the upper or lower triangular matrix A, packed 00049 * columnwise in a linear array. The j-th column of A is stored 00050 * in the array AP as follows: 00051 * if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j; 00052 * if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n. 00053 * 00054 * INFO (output) INTEGER 00055 * = 0: successful exit 00056 * < 0: if INFO = -i, the i-th argument had an illegal value 00057 * 00058 * ===================================================================== 00059 * 00060 * .. Parameters .. 00061 * .. 00062 * .. Local Scalars .. 00063 LOGICAL LOWER 00064 INTEGER I, J, K 00065 * .. 00066 * .. External Functions .. 00067 LOGICAL LSAME 00068 EXTERNAL LSAME 00069 * .. 00070 * .. External Subroutines .. 00071 EXTERNAL XERBLA 00072 * .. 00073 * .. Executable Statements .. 00074 * 00075 * Test the input parameters. 00076 * 00077 INFO = 0 00078 LOWER = LSAME( UPLO, 'L' ) 00079 IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN 00080 INFO = -1 00081 ELSE IF( N.LT.0 ) THEN 00082 INFO = -2 00083 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00084 INFO = -4 00085 END IF 00086 IF( INFO.NE.0 ) THEN 00087 CALL XERBLA( 'STRTTP', -INFO ) 00088 RETURN 00089 END IF 00090 * 00091 IF( LOWER ) THEN 00092 K = 0 00093 DO J = 1, N 00094 DO I = J, N 00095 K = K + 1 00096 AP( K ) = A( I, J ) 00097 END DO 00098 END DO 00099 ELSE 00100 K = 0 00101 DO J = 1, N 00102 DO I = 1, J 00103 K = K + 1 00104 AP( K ) = A( I, J ) 00105 END DO 00106 END DO 00107 END IF 00108 * 00109 RETURN 00110 * 00111 * End of STRTTP 00112 * 00113 END