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 OTHERauxiliary
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
154