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