1 SUBROUTINE ZLACP2( UPLO, M, N, A, LDA, B, LDB )
2 *
3 * -- LAPACK auxiliary routine (version 3.2) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 CHARACTER UPLO
10 INTEGER LDA, LDB, M, N
11 * ..
12 * .. Array Arguments ..
13 DOUBLE PRECISION A( LDA, * )
14 COMPLEX*16 B( LDB, * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * ZLACP2 copies all or part of a real two-dimensional matrix A to a
21 * complex matrix B.
22 *
23 * Arguments
24 * =========
25 *
26 * UPLO (input) CHARACTER*1
27 * Specifies the part of the matrix A to be copied to B.
28 * = 'U': Upper triangular part
29 * = 'L': Lower triangular part
30 * Otherwise: All of the matrix A
31 *
32 * M (input) INTEGER
33 * The number of rows of the matrix A. M >= 0.
34 *
35 * N (input) INTEGER
36 * The number of columns of the matrix A. N >= 0.
37 *
38 * A (input) DOUBLE PRECISION array, dimension (LDA,N)
39 * The m by n matrix A. If UPLO = 'U', only the upper trapezium
40 * is accessed; if UPLO = 'L', only the lower trapezium is
41 * accessed.
42 *
43 * LDA (input) INTEGER
44 * The leading dimension of the array A. LDA >= max(1,M).
45 *
46 * B (output) COMPLEX*16 array, dimension (LDB,N)
47 * On exit, B = A in the locations specified by UPLO.
48 *
49 * LDB (input) INTEGER
50 * The leading dimension of the array B. LDB >= max(1,M).
51 *
52 * =====================================================================
53 *
54 * .. Local Scalars ..
55 INTEGER I, J
56 * ..
57 * .. External Functions ..
58 LOGICAL LSAME
59 EXTERNAL LSAME
60 * ..
61 * .. Intrinsic Functions ..
62 INTRINSIC MIN
63 * ..
64 * .. Executable Statements ..
65 *
66 IF( LSAME( UPLO, 'U' ) ) THEN
67 DO 20 J = 1, N
68 DO 10 I = 1, MIN( J, M )
69 B( I, J ) = A( I, J )
70 10 CONTINUE
71 20 CONTINUE
72 *
73 ELSE IF( LSAME( UPLO, 'L' ) ) THEN
74 DO 40 J = 1, N
75 DO 30 I = J, M
76 B( I, J ) = A( I, J )
77 30 CONTINUE
78 40 CONTINUE
79 *
80 ELSE
81 DO 60 J = 1, N
82 DO 50 I = 1, M
83 B( I, J ) = A( I, J )
84 50 CONTINUE
85 60 CONTINUE
86 END IF
87 *
88 RETURN
89 *
90 * End of ZLACP2
91 *
92 END
2 *
3 * -- LAPACK auxiliary routine (version 3.2) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 CHARACTER UPLO
10 INTEGER LDA, LDB, M, N
11 * ..
12 * .. Array Arguments ..
13 DOUBLE PRECISION A( LDA, * )
14 COMPLEX*16 B( LDB, * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * ZLACP2 copies all or part of a real two-dimensional matrix A to a
21 * complex matrix B.
22 *
23 * Arguments
24 * =========
25 *
26 * UPLO (input) CHARACTER*1
27 * Specifies the part of the matrix A to be copied to B.
28 * = 'U': Upper triangular part
29 * = 'L': Lower triangular part
30 * Otherwise: All of the matrix A
31 *
32 * M (input) INTEGER
33 * The number of rows of the matrix A. M >= 0.
34 *
35 * N (input) INTEGER
36 * The number of columns of the matrix A. N >= 0.
37 *
38 * A (input) DOUBLE PRECISION array, dimension (LDA,N)
39 * The m by n matrix A. If UPLO = 'U', only the upper trapezium
40 * is accessed; if UPLO = 'L', only the lower trapezium is
41 * accessed.
42 *
43 * LDA (input) INTEGER
44 * The leading dimension of the array A. LDA >= max(1,M).
45 *
46 * B (output) COMPLEX*16 array, dimension (LDB,N)
47 * On exit, B = A in the locations specified by UPLO.
48 *
49 * LDB (input) INTEGER
50 * The leading dimension of the array B. LDB >= max(1,M).
51 *
52 * =====================================================================
53 *
54 * .. Local Scalars ..
55 INTEGER I, J
56 * ..
57 * .. External Functions ..
58 LOGICAL LSAME
59 EXTERNAL LSAME
60 * ..
61 * .. Intrinsic Functions ..
62 INTRINSIC MIN
63 * ..
64 * .. Executable Statements ..
65 *
66 IF( LSAME( UPLO, 'U' ) ) THEN
67 DO 20 J = 1, N
68 DO 10 I = 1, MIN( J, M )
69 B( I, J ) = A( I, J )
70 10 CONTINUE
71 20 CONTINUE
72 *
73 ELSE IF( LSAME( UPLO, 'L' ) ) THEN
74 DO 40 J = 1, N
75 DO 30 I = J, M
76 B( I, J ) = A( I, J )
77 30 CONTINUE
78 40 CONTINUE
79 *
80 ELSE
81 DO 60 J = 1, N
82 DO 50 I = 1, M
83 B( I, J ) = A( I, J )
84 50 CONTINUE
85 60 CONTINUE
86 END IF
87 *
88 RETURN
89 *
90 * End of ZLACP2
91 *
92 END