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