![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SSCAL 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE SSCAL(N,SA,SX,INCX) 00012 * 00013 * .. Scalar Arguments .. 00014 * REAL SA 00015 * INTEGER INCX,N 00016 * .. 00017 * .. Array Arguments .. 00018 * REAL SX(*) 00019 * .. 00020 * 00021 * 00022 *> \par Purpose: 00023 * ============= 00024 *> 00025 *> \verbatim 00026 *> 00027 *> scales a vector by a constant. 00028 *> uses unrolled loops for increment equal to 1. 00029 *> \endverbatim 00030 * 00031 * Authors: 00032 * ======== 00033 * 00034 *> \author Univ. of Tennessee 00035 *> \author Univ. of California Berkeley 00036 *> \author Univ. of Colorado Denver 00037 *> \author NAG Ltd. 00038 * 00039 *> \date November 2011 00040 * 00041 *> \ingroup single_blas_level1 00042 * 00043 *> \par Further Details: 00044 * ===================== 00045 *> 00046 *> \verbatim 00047 *> 00048 *> jack dongarra, linpack, 3/11/78. 00049 *> modified 3/93 to return if incx .le. 0. 00050 *> modified 12/3/93, array(1) declarations changed to array(*) 00051 *> \endverbatim 00052 *> 00053 * ===================================================================== 00054 SUBROUTINE SSCAL(N,SA,SX,INCX) 00055 * 00056 * -- Reference BLAS level1 routine (version 3.4.0) -- 00057 * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 00058 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00059 * November 2011 00060 * 00061 * .. Scalar Arguments .. 00062 REAL SA 00063 INTEGER INCX,N 00064 * .. 00065 * .. Array Arguments .. 00066 REAL SX(*) 00067 * .. 00068 * 00069 * ===================================================================== 00070 * 00071 * .. Local Scalars .. 00072 INTEGER I,M,MP1,NINCX 00073 * .. 00074 * .. Intrinsic Functions .. 00075 INTRINSIC MOD 00076 * .. 00077 IF (N.LE.0 .OR. INCX.LE.0) RETURN 00078 IF (INCX.EQ.1) THEN 00079 * 00080 * code for increment equal to 1 00081 * 00082 * 00083 * clean-up loop 00084 * 00085 M = MOD(N,5) 00086 IF (M.NE.0) THEN 00087 DO I = 1,M 00088 SX(I) = SA*SX(I) 00089 END DO 00090 IF (N.LT.5) RETURN 00091 END IF 00092 MP1 = M + 1 00093 DO I = MP1,N,5 00094 SX(I) = SA*SX(I) 00095 SX(I+1) = SA*SX(I+1) 00096 SX(I+2) = SA*SX(I+2) 00097 SX(I+3) = SA*SX(I+3) 00098 SX(I+4) = SA*SX(I+4) 00099 END DO 00100 ELSE 00101 * 00102 * code for increment not equal to 1 00103 * 00104 NINCX = N*INCX 00105 DO I = 1,NINCX,INCX 00106 SX(I) = SA*SX(I) 00107 END DO 00108 END IF 00109 RETURN 00110 END