LAPACK 3.3.0
|
00001 SUBROUTINE DSWAP(N,DX,INCX,DY,INCY) 00002 * .. Scalar Arguments .. 00003 INTEGER INCX,INCY,N 00004 * .. 00005 * .. Array Arguments .. 00006 DOUBLE PRECISION DX(*),DY(*) 00007 * .. 00008 * 00009 * Purpose 00010 * ======= 00011 * 00012 * interchanges two vectors. 00013 * uses unrolled loops for increments equal one. 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 DOUBLE PRECISION DTEMP 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) GO TO 20 00032 * 00033 * code for unequal increments or equal increments not equal 00034 * to 1 00035 * 00036 IX = 1 00037 IY = 1 00038 IF (INCX.LT.0) IX = (-N+1)*INCX + 1 00039 IF (INCY.LT.0) IY = (-N+1)*INCY + 1 00040 DO 10 I = 1,N 00041 DTEMP = DX(IX) 00042 DX(IX) = DY(IY) 00043 DY(IY) = DTEMP 00044 IX = IX + INCX 00045 IY = IY + INCY 00046 10 CONTINUE 00047 RETURN 00048 * 00049 * code for both increments equal to 1 00050 * 00051 * 00052 * clean-up loop 00053 * 00054 20 M = MOD(N,3) 00055 IF (M.EQ.0) GO TO 40 00056 DO 30 I = 1,M 00057 DTEMP = DX(I) 00058 DX(I) = DY(I) 00059 DY(I) = DTEMP 00060 30 CONTINUE 00061 IF (N.LT.3) RETURN 00062 40 MP1 = M + 1 00063 DO 50 I = MP1,N,3 00064 DTEMP = DX(I) 00065 DX(I) = DY(I) 00066 DY(I) = DTEMP 00067 DTEMP = DX(I+1) 00068 DX(I+1) = DY(I+1) 00069 DY(I+1) = DTEMP 00070 DTEMP = DX(I+2) 00071 DX(I+2) = DY(I+2) 00072 DY(I+2) = DTEMP 00073 50 CONTINUE 00074 RETURN 00075 END