version 1.6, 2010/12/21 13:51:25
|
version 1.13, 2017/06/17 10:53:43
|
Line 1
|
Line 1
|
|
*> \brief \b DSCAL |
|
* |
|
* =========== DOCUMENTATION =========== |
|
* |
|
* Online html documentation available at |
|
* http://www.netlib.org/lapack/explore-html/ |
|
* |
|
* Definition: |
|
* =========== |
|
* |
|
* SUBROUTINE DSCAL(N,DA,DX,INCX) |
|
* |
|
* .. Scalar Arguments .. |
|
* DOUBLE PRECISION DA |
|
* INTEGER INCX,N |
|
* .. |
|
* .. Array Arguments .. |
|
* DOUBLE PRECISION DX(*) |
|
* .. |
|
* |
|
* |
|
*> \par Purpose: |
|
* ============= |
|
*> |
|
*> \verbatim |
|
*> |
|
*> DSCAL scales a vector by a constant. |
|
*> uses unrolled loops for increment equal to one. |
|
*> \endverbatim |
|
* |
|
* Authors: |
|
* ======== |
|
* |
|
*> \author Univ. of Tennessee |
|
*> \author Univ. of California Berkeley |
|
*> \author Univ. of Colorado Denver |
|
*> \author NAG Ltd. |
|
* |
|
*> \date December 2016 |
|
* |
|
*> \ingroup double_blas_level1 |
|
* |
|
*> \par Further Details: |
|
* ===================== |
|
*> |
|
*> \verbatim |
|
*> |
|
*> jack dongarra, linpack, 3/11/78. |
|
*> modified 3/93 to return if incx .le. 0. |
|
*> modified 12/3/93, array(1) declarations changed to array(*) |
|
*> \endverbatim |
|
*> |
|
* ===================================================================== |
SUBROUTINE DSCAL(N,DA,DX,INCX) |
SUBROUTINE DSCAL(N,DA,DX,INCX) |
|
* |
|
* -- Reference BLAS level1 routine (version 3.7.0) -- |
|
* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- |
|
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
|
* December 2016 |
|
* |
* .. Scalar Arguments .. |
* .. Scalar Arguments .. |
DOUBLE PRECISION DA |
DOUBLE PRECISION DA |
INTEGER INCX,N |
INTEGER INCX,N |
Line 7
|
Line 66
|
DOUBLE PRECISION DX(*) |
DOUBLE PRECISION DX(*) |
* .. |
* .. |
* |
* |
* Purpose |
|
* ======= |
|
* |
|
* DSCAL scales a vector by a constant. |
|
* uses unrolled loops for increment equal to one. |
|
* |
|
* Further Details |
|
* =============== |
|
* |
|
* jack dongarra, linpack, 3/11/78. |
|
* modified 3/93 to return if incx .le. 0. |
|
* modified 12/3/93, array(1) declarations changed to array(*) |
|
* |
|
* ===================================================================== |
* ===================================================================== |
* |
* |
* .. Local Scalars .. |
* .. Local Scalars .. |
Line 29
|
Line 75
|
INTRINSIC MOD |
INTRINSIC MOD |
* .. |
* .. |
IF (N.LE.0 .OR. INCX.LE.0) RETURN |
IF (N.LE.0 .OR. INCX.LE.0) RETURN |
IF (INCX.EQ.1) GO TO 20 |
IF (INCX.EQ.1) THEN |
* |
|
* code for increment not equal to 1 |
|
* |
|
NINCX = N*INCX |
|
DO 10 I = 1,NINCX,INCX |
|
DX(I) = DA*DX(I) |
|
10 CONTINUE |
|
RETURN |
|
* |
* |
* code for increment equal to 1 |
* code for increment equal to 1 |
* |
* |
* |
* |
* clean-up loop |
* clean-up loop |
* |
* |
20 M = MOD(N,5) |
M = MOD(N,5) |
IF (M.EQ.0) GO TO 40 |
IF (M.NE.0) THEN |
DO 30 I = 1,M |
DO I = 1,M |
DX(I) = DA*DX(I) |
DX(I) = DA*DX(I) |
30 CONTINUE |
END DO |
IF (N.LT.5) RETURN |
IF (N.LT.5) RETURN |
40 MP1 = M + 1 |
END IF |
DO 50 I = MP1,N,5 |
MP1 = M + 1 |
DX(I) = DA*DX(I) |
DO I = MP1,N,5 |
DX(I+1) = DA*DX(I+1) |
DX(I) = DA*DX(I) |
DX(I+2) = DA*DX(I+2) |
DX(I+1) = DA*DX(I+1) |
DX(I+3) = DA*DX(I+3) |
DX(I+2) = DA*DX(I+2) |
DX(I+4) = DA*DX(I+4) |
DX(I+3) = DA*DX(I+3) |
50 CONTINUE |
DX(I+4) = DA*DX(I+4) |
|
END DO |
|
ELSE |
|
* |
|
* code for increment not equal to 1 |
|
* |
|
NINCX = N*INCX |
|
DO I = 1,NINCX,INCX |
|
DX(I) = DA*DX(I) |
|
END DO |
|
END IF |
RETURN |
RETURN |
END |
END |