!
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