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

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