LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
slacpy.f
Go to the documentation of this file.
1*> \brief \b SLACPY copies all or part of one two-dimensional array to another.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download SLACPY + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slacpy.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slacpy.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slacpy.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE SLACPY( UPLO, M, N, A, LDA, B, LDB )
22*
23* .. Scalar Arguments ..
24* CHARACTER UPLO
25* INTEGER LDA, LDB, M, N
26* ..
27* .. Array Arguments ..
28* REAL A( LDA, * ), B( LDB, * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> SLACPY copies all or part of a two-dimensional matrix A to another
38*> matrix B.
39*> \endverbatim
40*
41* Arguments:
42* ==========
43*
44*> \param[in] UPLO
45*> \verbatim
46*> UPLO is CHARACTER*1
47*> Specifies the part of the matrix A to be copied to B.
48*> = 'U': Upper triangular part
49*> = 'L': Lower triangular part
50*> Otherwise: All of the matrix A
51*> \endverbatim
52*>
53*> \param[in] M
54*> \verbatim
55*> M is INTEGER
56*> The number of rows of the matrix A. M >= 0.
57*> \endverbatim
58*>
59*> \param[in] N
60*> \verbatim
61*> N is INTEGER
62*> The number of columns of the matrix A. N >= 0.
63*> \endverbatim
64*>
65*> \param[in] A
66*> \verbatim
67*> A is REAL array, dimension (LDA,N)
68*> The m by n matrix A. If UPLO = 'U', only the upper triangle
69*> or trapezoid is accessed; if UPLO = 'L', only the lower
70*> triangle or trapezoid is accessed.
71*> \endverbatim
72*>
73*> \param[in] LDA
74*> \verbatim
75*> LDA is INTEGER
76*> The leading dimension of the array A. LDA >= max(1,M).
77*> \endverbatim
78*>
79*> \param[out] B
80*> \verbatim
81*> B is REAL array, dimension (LDB,N)
82*> On exit, B = A in the locations specified by UPLO.
83*> \endverbatim
84*>
85*> \param[in] LDB
86*> \verbatim
87*> LDB is INTEGER
88*> The leading dimension of the array B. LDB >= max(1,M).
89*> \endverbatim
90*
91* Authors:
92* ========
93*
94*> \author Univ. of Tennessee
95*> \author Univ. of California Berkeley
96*> \author Univ. of Colorado Denver
97*> \author NAG Ltd.
98*
99*> \ingroup lacpy
100*
101* =====================================================================
102 SUBROUTINE slacpy( UPLO, M, N, A, LDA, B, LDB )
103*
104* -- LAPACK auxiliary routine --
105* -- LAPACK is a software package provided by Univ. of Tennessee, --
106* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
107*
108* .. Scalar Arguments ..
109 CHARACTER UPLO
110 INTEGER LDA, LDB, M, N
111* ..
112* .. Array Arguments ..
113 REAL A( LDA, * ), B( LDB, * )
114* ..
115*
116* =====================================================================
117*
118* .. Local Scalars ..
119 INTEGER I, J
120* ..
121* .. External Functions ..
122 LOGICAL LSAME
123 EXTERNAL lsame
124* ..
125* .. Intrinsic Functions ..
126 INTRINSIC min
127* ..
128* .. Executable Statements ..
129*
130 IF( lsame( uplo, 'U' ) ) THEN
131 DO 20 j = 1, n
132 DO 10 i = 1, min( j, m )
133 b( i, j ) = a( i, j )
134 10 CONTINUE
135 20 CONTINUE
136 ELSE IF( lsame( uplo, 'L' ) ) THEN
137 DO 40 j = 1, n
138 DO 30 i = j, m
139 b( i, j ) = a( i, j )
140 30 CONTINUE
141 40 CONTINUE
142 ELSE
143 DO 60 j = 1, n
144 DO 50 i = 1, m
145 b( i, j ) = a( i, j )
146 50 CONTINUE
147 60 CONTINUE
148 END IF
149 RETURN
150*
151* End of SLACPY
152*
153 END
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.
Definition slacpy.f:103