1!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
2!                                                             c
3!     Subroutine Flash1                                       c
4!     SORTS ARRAY A WITH N ELEMENTS BY USE OF INDEX VECTOR L  c
5!     OF DIMENSION M WITH M ABOUT 0.1 N.                      c
6!     Karl-Dietrich Neubert, FlashSort1 Algorithm             c
7!     in  Dr. Dobb's Journal Feb.1998,p.123                   c
8!                                                             c
9!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
10
11      subroutine flash1 (A, N, L, M, ind)
12
13      implicit none
14      double precision :: a(*), anmin, c1, hold, flash
15      integer :: L(*), ind(*), i, n, nmax, m, k, ihold, nmove, j, iflash
16!     ============================ CLASS FORMATION =====
17
18
19      do i = 1, n
20      ind(i) = i
21      end do
22
23      ANMIN=A(1)
24      NMAX=1
25      DO I=1,N
26         IF( A(I).LT.ANMIN) ANMIN=A(I)
27         IF( A(I).GT.A(NMAX)) NMAX=I
28      END DO
29
30      IF (ANMIN.EQ.A(NMAX)) RETURN
31      C1=(M - 1) / (A(NMAX) - ANMIN)
32      DO K=1,M
33         L(K)=0
34      END DO
35      DO I=1,N
36         K=1 + INT(C1 * (A(I) - ANMIN))
37         L(K)=L(K) + 1
38      END DO
39      DO K=2,M
40         L(K)=L(K) + L(K - 1)
41      END DO
42      HOLD=A(NMAX)
43      A(NMAX)=A(1)
44      A(1)=HOLD
45
46      ihold = ind(nmax)
47      ind(nmax) = ind(1)
48      ind(1) = ihold
49
50
51!     =============================== PERMUTATION =====
52      NMOVE=0
53      J=1
54      K=M
55      DO WHILE (NMOVE.LT.N - 1)
56         DO WHILE (J.GT.L(K))
57            J=J + 1
58            K=1 + INT(C1 * (A(J) - ANMIN))
59         END DO
60         FLASH=A(J)
61         iflash=ind(j)
62
63         DO WHILE (.NOT.(J.EQ.L(K) + 1))
64            K=1 + INT(C1 * (FLASH - ANMIN))
65            HOLD=A(L(K))
66            ihold = ind(L(k))
67            A(L(K))=FLASH
68            ind(L(k)) = iflash
69            iflash = ihold
70            FLASH=HOLD
71            L(K)=L(K) - 1
72            NMOVE=NMOVE + 1
73         END DO
74      END DO
75
76!     ========================= STRAIGHT INSERTION =====
77      DO I=N-2,1,-1
78         IF  (A(I + 1).LT.A(I)) THEN
79            HOLD=A(I)
80            ihold = ind(i)
81            J=I
82            DO WHILE  (A(J + 1).LT.HOLD)
83               A(J)=A(J + 1)
84               ind(j) = ind(j+1)
85               J=J + 1
86            END DO
87            A(J)=HOLD
88            ind(j) = ihold
89         ENDIF
90      END DO
91
92!     =========================== RETURN,END FLASH1 =====
93      RETURN
94      END
95
96