 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE SSCAL(N,SA,SX,INCX) 00002 * .. Scalar Arguments .. 00003 REAL SA 00004 INTEGER INCX,N 00005 * .. 00006 * .. Array Arguments .. 00007 REAL SX(*) 00008 * .. 00009 * 00010 * Purpose 00011 * ======= 00012 * 00013 * scales a vector by a constant. 00014 * uses unrolled loops for increment equal to 1. 00015 * 00016 * Further Details 00017 * =============== 00018 * 00019 * jack dongarra, linpack, 3/11/78. 00020 * modified 3/93 to return if incx .le. 0. 00021 * modified 12/3/93, array(1) declarations changed to array(*) 00022 * 00023 * ===================================================================== 00024 * 00025 * .. Local Scalars .. 00026 INTEGER I,M,MP1,NINCX 00027 * .. 00028 * .. Intrinsic Functions .. 00029 INTRINSIC MOD 00030 * .. 00031 IF (N.LE.0 .OR. INCX.LE.0) RETURN 00032 IF (INCX.EQ.1) THEN 00033 * 00034 * code for increment equal to 1 00035 * 00036 * 00037 * clean-up loop 00038 * 00039 M = MOD(N,5) 00040 IF (M.NE.0) THEN 00041 DO I = 1,M 00042 SX(I) = SA*SX(I) 00043 END DO 00044 IF (N.LT.5) RETURN 00045 END IF 00046 MP1 = M + 1 00047 DO I = MP1,N,5 00048 SX(I) = SA*SX(I) 00049 SX(I+1) = SA*SX(I+1) 00050 SX(I+2) = SA*SX(I+2) 00051 SX(I+3) = SA*SX(I+3) 00052 SX(I+4) = SA*SX(I+4) 00053 END DO 00054 ELSE 00055 * 00056 * code for increment not equal to 1 00057 * 00058 NINCX = N*INCX 00059 DO I = 1,NINCX,INCX 00060 SX(I) = SA*SX(I) 00061 END DO 00062 END IF 00063 RETURN 00064 END
1.7.3 
