1 SUBROUTINE ZTRTTP( UPLO, N, A, LDA, AP, INFO )
2 *
3 * -- LAPACK routine (version 3.3.0) --
4 *
5 * -- Contributed by Fred Gustavson of the IBM Watson Research Center --
6 * -- and Julien Langou of the Univ. of Colorado Denver --
7 * November 2010 --
8 *
9 * -- LAPACK is a software package provided by Univ. of Tennessee, --
10 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
11 *
12 * .. Scalar Arguments ..
13 CHARACTER UPLO
14 INTEGER INFO, N, LDA
15 * ..
16 * .. Array Arguments ..
17 COMPLEX*16 A( LDA, * ), AP( * )
18 * ..
19 *
20 * Purpose
21 * =======
22 *
23 * ZTRTTP copies a triangular matrix A from full format (TR) to standard
24 * packed format (TP).
25 *
26 * Arguments
27 * =========
28 *
29 * UPLO (input) CHARACTER*1
30 * = 'U': A is upper triangular;
31 * = 'L': A is lower triangular.
32 *
33 * N (input) INTEGER
34 * The order of the matrices AP and A. N >= 0.
35 *
36 * A (input) COMPLEX*16 array, dimension (LDA,N)
37 * On entry, the triangular matrix A. If UPLO = 'U', the leading
38 * N-by-N upper triangular part of A contains the upper
39 * triangular part of the matrix A, and the strictly lower
40 * triangular part of A is not referenced. If UPLO = 'L', the
41 * leading N-by-N lower triangular part of A contains the lower
42 * triangular part of the matrix A, and the strictly upper
43 * triangular part of A is not referenced.
44 *
45 * LDA (input) INTEGER
46 * The leading dimension of the array A. LDA >= max(1,N).
47 *
48 * AP (output) COMPLEX*16 array, dimension ( N*(N+1)/2 ),
49 * On exit, the upper or lower triangular matrix A, packed
50 * columnwise in a linear array. The j-th column of A is stored
51 * in the array AP as follows:
52 * if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
53 * if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
54 *
55 * INFO (output) INTEGER
56 * = 0: successful exit
57 * < 0: if INFO = -i, the i-th argument had an illegal value
58 *
59 * =====================================================================
60 *
61 * .. Parameters ..
62 * ..
63 * .. Local Scalars ..
64 LOGICAL LOWER
65 INTEGER I, J, K
66 * ..
67 * .. External Functions ..
68 LOGICAL LSAME
69 EXTERNAL LSAME
70 * ..
71 * .. External Subroutines ..
72 EXTERNAL XERBLA
73 * ..
74 * .. Executable Statements ..
75 *
76 * Test the input parameters.
77 *
78 INFO = 0
79 LOWER = LSAME( UPLO, 'L' )
80 IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
81 INFO = -1
82 ELSE IF( N.LT.0 ) THEN
83 INFO = -2
84 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
85 INFO = -4
86 END IF
87 IF( INFO.NE.0 ) THEN
88 CALL XERBLA( 'ZTRTTP', -INFO )
89 RETURN
90 END IF
91 *
92 IF( LOWER ) THEN
93 K = 0
94 DO J = 1, N
95 DO I = J, N
96 K = K + 1
97 AP( K ) = A( I, J )
98 END DO
99 END DO
100 ELSE
101 K = 0
102 DO J = 1, N
103 DO I = 1, J
104 K = K + 1
105 AP( K ) = A( I, J )
106 END DO
107 END DO
108 END IF
109 *
110 *
111 RETURN
112 *
113 * End of ZTRTTP
114 *
115 END
2 *
3 * -- LAPACK routine (version 3.3.0) --
4 *
5 * -- Contributed by Fred Gustavson of the IBM Watson Research Center --
6 * -- and Julien Langou of the Univ. of Colorado Denver --
7 * November 2010 --
8 *
9 * -- LAPACK is a software package provided by Univ. of Tennessee, --
10 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
11 *
12 * .. Scalar Arguments ..
13 CHARACTER UPLO
14 INTEGER INFO, N, LDA
15 * ..
16 * .. Array Arguments ..
17 COMPLEX*16 A( LDA, * ), AP( * )
18 * ..
19 *
20 * Purpose
21 * =======
22 *
23 * ZTRTTP copies a triangular matrix A from full format (TR) to standard
24 * packed format (TP).
25 *
26 * Arguments
27 * =========
28 *
29 * UPLO (input) CHARACTER*1
30 * = 'U': A is upper triangular;
31 * = 'L': A is lower triangular.
32 *
33 * N (input) INTEGER
34 * The order of the matrices AP and A. N >= 0.
35 *
36 * A (input) COMPLEX*16 array, dimension (LDA,N)
37 * On entry, the triangular matrix A. If UPLO = 'U', the leading
38 * N-by-N upper triangular part of A contains the upper
39 * triangular part of the matrix A, and the strictly lower
40 * triangular part of A is not referenced. If UPLO = 'L', the
41 * leading N-by-N lower triangular part of A contains the lower
42 * triangular part of the matrix A, and the strictly upper
43 * triangular part of A is not referenced.
44 *
45 * LDA (input) INTEGER
46 * The leading dimension of the array A. LDA >= max(1,N).
47 *
48 * AP (output) COMPLEX*16 array, dimension ( N*(N+1)/2 ),
49 * On exit, the upper or lower triangular matrix A, packed
50 * columnwise in a linear array. The j-th column of A is stored
51 * in the array AP as follows:
52 * if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
53 * if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
54 *
55 * INFO (output) INTEGER
56 * = 0: successful exit
57 * < 0: if INFO = -i, the i-th argument had an illegal value
58 *
59 * =====================================================================
60 *
61 * .. Parameters ..
62 * ..
63 * .. Local Scalars ..
64 LOGICAL LOWER
65 INTEGER I, J, K
66 * ..
67 * .. External Functions ..
68 LOGICAL LSAME
69 EXTERNAL LSAME
70 * ..
71 * .. External Subroutines ..
72 EXTERNAL XERBLA
73 * ..
74 * .. Executable Statements ..
75 *
76 * Test the input parameters.
77 *
78 INFO = 0
79 LOWER = LSAME( UPLO, 'L' )
80 IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
81 INFO = -1
82 ELSE IF( N.LT.0 ) THEN
83 INFO = -2
84 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
85 INFO = -4
86 END IF
87 IF( INFO.NE.0 ) THEN
88 CALL XERBLA( 'ZTRTTP', -INFO )
89 RETURN
90 END IF
91 *
92 IF( LOWER ) THEN
93 K = 0
94 DO J = 1, N
95 DO I = J, N
96 K = K + 1
97 AP( K ) = A( I, J )
98 END DO
99 END DO
100 ELSE
101 K = 0
102 DO J = 1, N
103 DO I = 1, J
104 K = K + 1
105 AP( K ) = A( I, J )
106 END DO
107 END DO
108 END IF
109 *
110 *
111 RETURN
112 *
113 * End of ZTRTTP
114 *
115 END