!

PROGRAM P96

!

IMPLICIT NONE

INTEGER :: LIST(1000),COUNTS,NCOMP,NSWAP

INTEGER :: I,N

INTERFACE

SUBROUTINE SHELL(LIST,N,COUNTS,NCOMP,NSWAP)

IMPLICIT NONE

INTEGER ,INTENT(IN OUT) :: LIST(:),COUNTS,NCOMP,NSWAP,N

SUBROUTINE SWAP(LIST,K,L)

IMPLICIT NONE

INTEGER ,INTENT(IN OUT) :: LIST(:),K,L

END SUBROUTINE SWAP

END SUBROUTINE SHELL

END INTERFACE

!

!

PRINT *, 'This is Program >> P96 - Shell sort'

!

! Tell program where data for READ * is coming from

OPEN(UNIT=5, FILE='P96.DAT') ! UNIT=5 is the default input

!

READ * ,N

READ * ,(LIST(I),I=1,N)

PRINT 17

17 FORMAT(/'BEFORE SORTING'/)

PRINT 16,(LIST(I),I=1,N)

PRINT * ,' '

!

! SORT WITH SUBROUTINES

!

CALL SHELL(LIST,N)

!

PRINT 14

14 FORMAT(/'AFTER SORTING'/)

PRINT 16,(LIST(I),I=1,N)

16 FORMAT(20I5)

PRINT 27,NCOMP,NSWAP

27 FORMAT('NUMBER OF COMPARISONS=',I3/ &

'NUMBER OF EXCHANGES=' ,I3//)

STOP

END PROGRAM P96

!

SUBROUTINE SHELL(LIST,N,COUNTS,NCOMP,NSWAP)

IMPLICIT NONE

INTEGER ,INTENT(IN OUT) :: LIST(:),COUNTS,NCOMP,NSWAP,N

INTEGER :: M,I,J

NCOMP=0

NSWAP=0

M=N

L1: DO WHILE (M > 1)

M=(M+2)/3

L2: DO I=M+1,N

L3: DO J=I,M+1,-M

NCOMP=NCOMP+1

IF(LIST(J-M) < LIST(J)) EXIT

CALL SWAP(LIST,J,J-M)

NSWAP=NSWAP+1

END DO L3

END DO L2

END DO L1

RETURN

END SUBROUTINE SHELL

!

SUBROUTINE SWAP(LIST,K,L)

IMPLICIT NONE

INTEGER ,INTENT(IN OUT) :: LIST(:),K,L

INTEGER :: M

M=LIST(K)

LIST(K)=LIST(L)

LIST(L)=M

END SUROUTINE SWAP