home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / libcruft / blas / dswap.f < prev    next >
Text File  |  1996-09-28  |  1KB  |  56 lines
  1.       SUBROUTINE  DSWAP (N,DX,INCX,DY,INCY)
  2. C
  3. C     INTERCHANGES TWO VECTORS.
  4. C     USES UNROLLED LOOPS FOR INCREMENTS EQUAL ONE.
  5. C     JACK DONGARRA, LINPACK, 3/11/78.
  6. C
  7.       DOUBLE PRECISION DX(1),DY(1),DTEMP
  8.       INTEGER I,INCX,INCY,IX,IY,M,MP1,N
  9. C
  10.       IF(N.LE.0)RETURN
  11.       IF(INCX.EQ.1.AND.INCY.EQ.1)GO TO 20
  12. C
  13. C       CODE FOR UNEQUAL INCREMENTS OR EQUAL INCREMENTS NOT EQUAL
  14. C         TO 1
  15. C
  16.       IX = 1
  17.       IY = 1
  18.       IF(INCX.LT.0)IX = (-N+1)*INCX + 1
  19.       IF(INCY.LT.0)IY = (-N+1)*INCY + 1
  20.       DO 10 I = 1,N
  21.         DTEMP = DX(IX)
  22.         DX(IX) = DY(IY)
  23.         DY(IY) = DTEMP
  24.         IX = IX + INCX
  25.         IY = IY + INCY
  26.    10 CONTINUE
  27.       RETURN
  28. C
  29. C       CODE FOR BOTH INCREMENTS EQUAL TO 1
  30. C
  31. C
  32. C       CLEAN-UP LOOP
  33. C
  34.    20 M = MOD(N,3)
  35.       IF( M .EQ. 0 ) GO TO 40
  36.       DO 30 I = 1,M
  37.         DTEMP = DX(I)
  38.         DX(I) = DY(I)
  39.         DY(I) = DTEMP
  40.    30 CONTINUE
  41.       IF( N .LT. 3 ) RETURN
  42.    40 MP1 = M + 1
  43.       DO 50 I = MP1,N,3
  44.         DTEMP = DX(I)
  45.         DX(I) = DY(I)
  46.         DY(I) = DTEMP
  47.         DTEMP = DX(I + 1)
  48.         DX(I + 1) = DY(I + 1)
  49.         DY(I + 1) = DTEMP
  50.         DTEMP = DX(I + 2)
  51.         DX(I + 2) = DY(I + 2)
  52.         DY(I + 2) = DTEMP
  53.    50 CONTINUE
  54.       RETURN
  55.       END
  56.