vendor/gonum.org/v1/gonum/lapack/internal/testdata/dlasqtest/dcopy.f

   1 *> \brief \b DCOPY
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       SUBROUTINE DCOPY(N,DX,INCX,DY,INCY)
  12 *
  13 *       .. Scalar Arguments ..
  14 *       INTEGER INCX,INCY,N
  15 *       ..
  16 *       .. Array Arguments ..
  17 *       DOUBLE PRECISION DX(*),DY(*)
  18 *       ..
  19 *
  20 *
  21 *> \par Purpose:
  22 *  =============
  23 *>
  24 *> \verbatim
  25 *>
  26 *>    DCOPY copies a vector, x, to a vector, y.
  27 *>    uses unrolled loops for increments equal to one.
  28 *> \endverbatim
  29 *
  30 *  Authors:
  31 *  ========
  32 *
  33 *> \author Univ. of Tennessee
  34 *> \author Univ. of California Berkeley
  35 *> \author Univ. of Colorado Denver
  36 *> \author NAG Ltd.
  37 *
  38 *> \date November 2011
  39 *
  40 *> \ingroup double_blas_level1
  41 *
  42 *> \par Further Details:
  43 *  =====================
  44 *>
  45 *> \verbatim
  46 *>
  47 *>     jack dongarra, linpack, 3/11/78.
  48 *>     modified 12/3/93, array(1) declarations changed to array(*)
  49 *> \endverbatim
  50 *>
  51 *  =====================================================================
  52       SUBROUTINE DCOPY(N,DX,INCX,DY,INCY)
  53 *
  54 *  -- Reference BLAS level1 routine (version 3.4.0) --
  55 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
  56 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  57 *     November 2011
  58 *
  59 *     .. Scalar Arguments ..
  60       INTEGER INCX,INCY,N
  61 *     ..
  62 *     .. Array Arguments ..
  63       DOUBLE PRECISION DX(*),DY(*)
  64 *     ..
  65 *
  66 *  =====================================================================
  67 *
  68 *     .. Local Scalars ..
  69       INTEGER I,IX,IY,M,MP1
  70 *     ..
  71 *     .. Intrinsic Functions ..
  72       INTRINSIC MOD
  73 *     ..
  74       IF (N.LE.0) RETURN
  75       IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
  76 *
  77 *        code for both increments equal to 1
  78 *
  79 *
  80 *        clean-up loop
  81 *
  82          M = MOD(N,7)
  83          IF (M.NE.0) THEN
  84             DO I = 1,M
  85                DY(I) = DX(I)
  86             END DO
  87             IF (N.LT.7) RETURN
  88          END IF
  89          MP1 = M + 1
  90          DO I = MP1,N,7
  91             DY(I) = DX(I)
  92             DY(I+1) = DX(I+1)
  93             DY(I+2) = DX(I+2)
  94             DY(I+3) = DX(I+3)
  95             DY(I+4) = DX(I+4)
  96             DY(I+5) = DX(I+5)
  97             DY(I+6) = DX(I+6)
  98          END DO
  99       ELSE
 100 *
 101 *        code for unequal increments or equal increments
 102 *          not equal to 1
 103 *
 104          IX = 1
 105          IY = 1
 106          IF (INCX.LT.0) IX = (-N+1)*INCX + 1
 107          IF (INCY.LT.0) IY = (-N+1)*INCY + 1
 108          DO I = 1,N
 109             DY(IY) = DX(IX)
 110             IX = IX + INCX
 111             IY = IY + INCY
 112          END DO
 113       END IF
 114       RETURN
 115       END