 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE SSWAP(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 * interchanges two vectors. 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 REAL STEMP 00025 INTEGER I,IX,IY,M,MP1 00026 * .. 00027 * .. Intrinsic Functions .. 00028 INTRINSIC MOD 00029 * .. 00030 IF (N.LE.0) RETURN 00031 IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN 00032 * 00033 * code for both increments equal to 1 00034 * 00035 * 00036 * clean-up loop 00037 * 00038 M = MOD(N,3) 00039 IF (M.NE.0) THEN 00040 DO I = 1,M 00041 STEMP = SX(I) 00042 SX(I) = SY(I) 00043 SY(I) = STEMP 00044 END DO 00045 IF (N.LT.3) RETURN 00046 END IF 00047 MP1 = M + 1 00048 DO I = MP1,N,3 00049 STEMP = SX(I) 00050 SX(I) = SY(I) 00051 SY(I) = STEMP 00052 STEMP = SX(I+1) 00053 SX(I+1) = SY(I+1) 00054 SY(I+1) = STEMP 00055 STEMP = SX(I+2) 00056 SX(I+2) = SY(I+2) 00057 SY(I+2) = STEMP 00058 END DO 00059 ELSE 00060 * 00061 * code for unequal increments or equal increments not equal 00062 * to 1 00063 * 00064 IX = 1 00065 IY = 1 00066 IF (INCX.LT.0) IX = (-N+1)*INCX + 1 00067 IF (INCY.LT.0) IY = (-N+1)*INCY + 1 00068 DO I = 1,N 00069 STEMP = SX(IX) 00070 SX(IX) = SY(IY) 00071 SY(IY) = STEMP 00072 IX = IX + INCX 00073 IY = IY + INCY 00074 END DO 00075 END IF 00076 RETURN 00077 END
1.7.3 
