vendor/gonum.org/v1/gonum/lapack/internal/testdata/netlib/dlacpy.f

   1 *> \brief \b DLACPY 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 DLACPY + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlacpy.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlacpy.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlacpy.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE DLACPY( 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 *       DOUBLE PRECISION   A( LDA, * ), B( LDB, * )
  29 *       ..
  30 *
  31 *
  32 *> \par Purpose:
  33 *  =============
  34 *>
  35 *> \verbatim
  36 *>
  37 *> DLACPY 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 *> \date September 2012
 100 *
 101 *> \ingroup auxOTHERauxiliary
 102 *
 103 *  =====================================================================
 104       SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB )
 105 *
 106 *  -- LAPACK auxiliary routine (version 3.4.2) --
 107 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 108 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 109 *     September 2012
 110 *
 111 *     .. Scalar Arguments ..
 112       CHARACTER          UPLO
 113       INTEGER            LDA, LDB, M, N
 114 *     ..
 115 *     .. Array Arguments ..
 116       DOUBLE PRECISION   A( LDA, * ), B( LDB, * )
 117 *     ..
 118 *
 119 *  =====================================================================
 120 *
 121 *     .. Local Scalars ..
 122       INTEGER            I, J
 123 *     ..
 124 *     .. External Functions ..
 125       LOGICAL            LSAME
 126       EXTERNAL           LSAME
 127 *     ..
 128 *     .. Intrinsic Functions ..
 129       INTRINSIC          MIN
 130 *     ..
 131 *     .. Executable Statements ..
 132 *
 133       IF( LSAME( UPLO, 'U' ) ) THEN
 134          DO 20 J = 1, N
 135             DO 10 I = 1, MIN( J, M )
 136                B( I, J ) = A( I, J )
 137    10       CONTINUE
 138    20    CONTINUE
 139       ELSE IF( LSAME( UPLO, 'L' ) ) THEN
 140          DO 40 J = 1, N
 141             DO 30 I = J, M
 142                B( I, J ) = A( I, J )
 143    30       CONTINUE
 144    40    CONTINUE
 145       ELSE
 146          DO 60 J = 1, N
 147             DO 50 I = 1, M
 148                B( I, J ) = A( I, J )
 149    50       CONTINUE
 150    60    CONTINUE
 151       END IF
 152       RETURN
 153 *
 154 *     End of DLACPY
 155 *
 156       END