!
      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