ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
zlatcpy.f
Go to the documentation of this file.
1  SUBROUTINE zlatcpy( UPLO, M, N, A, LDA, B, LDB )
2 *
3 *
4 * .. Scalar Arguments ..
5  CHARACTER UPLO
6  INTEGER LDA, LDB, M, N
7 * ..
8 * .. Array Arguments ..
9  COMPLEX*16 A( LDA, * ), B( LDB, * )
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * ZLATCPY copies all or part of a two-dimensional matrix A to another
16 * matrix B in transpose form.
17 *
18 * Arguments
19 * =========
20 *
21 * UPLO (input) CHARACTER*1
22 * Specifies the part of the matrix A to be copied to B.
23 * = 'U': Upper triangular part
24 * = 'L': Lower triangular part
25 * Otherwise: All of the matrix A
26 *
27 * M (input) INTEGER
28 * The number of rows of the matrix A. M >= 0.
29 *
30 * N (input) INTEGER
31 * The number of columns of the matrix A. N >= 0.
32 *
33 * A (input) DOUBLE PRECISION array, dimension (LDA,N)
34 * The m by n matrix A. If UPLO = 'U', only the upper triangle
35 * or trapezoid is accessed; if UPLO = 'L', only the lower
36 * triangle or trapezoid is accessed.
37 *
38 * LDA (input) INTEGER
39 * The leading dimension of the array A. LDA >= max(1,M).
40 *
41 * B (output) DOUBLE PRECISION array, dimension (LDB,M)
42 * On exit, B = A^T in the locations specified by UPLO.
43 *
44 * LDB (input) INTEGER
45 * The leading dimension of the array B. LDB >= max(1,N).
46 *
47 * =====================================================================
48 *
49 * .. Local Scalars ..
50  INTEGER I, J
51 * ..
52 * .. External Functions ..
53  LOGICAL LSAME
54  EXTERNAL lsame
55 * ..
56 * .. Intrinsic Functions ..
57  INTRINSIC min
58  INTRINSIC dconjg
59 *
60 * ..
61 * .. Executable Statements ..
62 *
63  IF( lsame( uplo, 'U' ) ) THEN
64  DO 20 j = 1, n
65  DO 10 i = 1, min( j, m )
66  b( j, i ) = dconjg( a( i, j ) )
67  10 CONTINUE
68  20 CONTINUE
69  ELSE IF( lsame( uplo, 'L' ) ) THEN
70  DO 40 j = 1, n
71  DO 30 i = j, m
72  b( j, i ) = dconjg( a( i, j ) )
73  30 CONTINUE
74  40 CONTINUE
75  ELSE
76  DO 60 j = 1, n
77  DO 50 i = 1, m
78  b( j, i ) = dconjg( a( i, j ) )
79  50 CONTINUE
80  60 CONTINUE
81  END IF
82  RETURN
83 *
84 * End of ZLATCPY
85 *
86  END
min
#define min(A, B)
Definition: pcgemr.c:181
zlatcpy
subroutine zlatcpy(UPLO, M, N, A, LDA, B, LDB)
Definition: zlatcpy.f:2