comparison libcruft/blas/sswap.f @ 7789:82be108cc558

First attempt at single precision tyeps * * * corrections to qrupdate single precision routines * * * prefer demotion to single over promotion to double * * * Add single precision support to log2 function * * * Trivial PROJECT file update * * * Cache optimized hermitian/transpose methods * * * Add tests for tranpose/hermitian and ChangeLog entry for new transpose code
author David Bateman <dbateman@free.fr>
date Sun, 27 Apr 2008 22:34:17 +0200
parents
children
comparison
equal deleted inserted replaced
7788:45f5faba05a2 7789:82be108cc558
1 SUBROUTINE SSWAP(N,SX,INCX,SY,INCY)
2 * .. Scalar Arguments ..
3 INTEGER INCX,INCY,N
4 * ..
5 * .. Array Arguments ..
6 REAL SX(*),SY(*)
7 * ..
8 *
9 * Purpose
10 * =======
11 *
12 * interchanges two vectors.
13 * uses unrolled loops for increments equal to 1.
14 * jack dongarra, linpack, 3/11/78.
15 * modified 12/3/93, array(1) declarations changed to array(*)
16 *
17 *
18 * .. Local Scalars ..
19 REAL STEMP
20 INTEGER I,IX,IY,M,MP1
21 * ..
22 * .. Intrinsic Functions ..
23 INTRINSIC MOD
24 * ..
25 IF (N.LE.0) RETURN
26 IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20
27 *
28 * code for unequal increments or equal increments not equal
29 * to 1
30 *
31 IX = 1
32 IY = 1
33 IF (INCX.LT.0) IX = (-N+1)*INCX + 1
34 IF (INCY.LT.0) IY = (-N+1)*INCY + 1
35 DO 10 I = 1,N
36 STEMP = SX(IX)
37 SX(IX) = SY(IY)
38 SY(IY) = STEMP
39 IX = IX + INCX
40 IY = IY + INCY
41 10 CONTINUE
42 RETURN
43 *
44 * code for both increments equal to 1
45 *
46 *
47 * clean-up loop
48 *
49 20 M = MOD(N,3)
50 IF (M.EQ.0) GO TO 40
51 DO 30 I = 1,M
52 STEMP = SX(I)
53 SX(I) = SY(I)
54 SY(I) = STEMP
55 30 CONTINUE
56 IF (N.LT.3) RETURN
57 40 MP1 = M + 1
58 DO 50 I = MP1,N,3
59 STEMP = SX(I)
60 SX(I) = SY(I)
61 SY(I) = STEMP
62 STEMP = SX(I+1)
63 SX(I+1) = SY(I+1)
64 SY(I+1) = STEMP
65 STEMP = SX(I+2)
66 SX(I+2) = SY(I+2)
67 SY(I+2) = STEMP
68 50 CONTINUE
69 RETURN
70 END