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