!
        PROGRAM P94
!
     IMPLICIT NONE
     INTEGER :: LIST(1000),COUNTS,NCOMP,NSWAP
     INTEGER :: I,N
     INTERFACE
       SUBROUTINE SHAKE(LIST,N,COUNTS,NCOMP,NSWAP)
         IMPLICIT NONE
         INTEGER ,INTENT(IN OUT):: LIST(:),N,COUNTS,NCOMP,NSWAP
         SUBROUTINE BSORTR(LIST,L,M,K,COUNTS,NCOMP,NSWAP)
           IMPLICIT NONE
           INTEGER ,INTENT(IN OUT) :: LIST(:),L,M,K,COUNTS,NCOMP,NSWAP
           SUBROUTINE SWAP(LIST,K,L)
             IMPLICIT NONE
             INTEGER ,INTENT(IN OUT):: LIST(:),K,L
           END SUBROUTINE SWAP 
         END SUBROUTINE BSORTR
         SUBROUTINE BSORTL(LIST,L,M,K,COUNTS,NCOMP,NSWAP)
           IMPLICIT NONE
           INTEGER ,INTENT(IN OUT):: LIST(:),L,M,K,COUNTS,NCOMP,NSWAP COMMON /COUNTS/NCOMP,NSWAP
           SUBROUTINE SWAP(LIST,K,L)
             IMPLICIT NONE
             INTEGER ,INTENT(IN OUT):: LIST(:),K,L
           END SUBROUTINE SWAP 
         END SUBROUTINE BSORTL
       END SUBROUTINE SHAKE
     END INTERFACE
!
!
     PRINT *, 'This is Program>> P94 - Cocktail shaker sort'
!
! Tell program where data for READ * is coming from
     OPEN(UNIT=5, FILE='P94.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 SHAKE(LIST,N,COUNTS,NCOMP,NSWAP)
!
     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 P94
!
     SUBROUTINE SHAKE(LIST,N,COUNTS,NCOMP,NSWAP)
     IMPLICIT NONE
     INTEGER ,INTENT(IN OUT):: LIST(:),N,COUNTS,NCOMP,NSWAP
     INTERGER :: LEFT,RIGHT,K
     NCOMP=0
     NSWAP=0
     LEFT=1
     RIGHT=N
 L1: DO I=1,N
       CALL BSORTR(LIST,LEFT,RIGHT,K,COUNTS,NCOMP,NSWAP)
       IF(K == 0) RETURN
       CALL BSORTL(LIST,LEFT,RIGHT,K)
       IF(K == 0) RETURN
     END DO L1
     RETURN
     END SUBROUTINE SHAKE
!
     SUBROUTINE BSORTR(LIST,L,M,K,COUNTS,NCOMP,NSWAP)
     IMPLICIT NONE
     INTEGER ,INTENT(IN OUT):: LIST(:),L,M,K,COUNTS,NCOMP,NSWAP
     INTEGER :: I
!
! RIGHT BUBBLE SORT
!
     M=M-1
     K=0
 L1: DO I=L,M
       NCOMP=NCOMP+1
       IF(LIST(I) > LIST(I+1))THEN
         CALL SWAP(LIST,I,I+1)
         NSWAP=NSWAP+1
         K=I
       ENDIF
     END DO L1
     M=K
     RETURN
     END SUBROUTINE BSORTR
!
     SUBROUTINE BSORTL(LIST,L,M,K,COUNTS,NCOMP,NSWAP)
     IMPLICIT NONE
     INTEGER ,INTENT(IN OUT):: LIST(:),L,M,K,COUNTS,NCOMP,NSWAP 
     INTEGER :: I
!
! LEFT BUBBLE SORT
!
     L=L+1
     K=0
 L1: DO I=M,L,-1
       NCOMP=NCOMP+1
       IF(LIST(I) < LIST(I-1))THEN
         CALL SWAP(LIST,I,I-1)
         NSWAP=NSWAP+1
         K=I
       ENDIF
     END DO L1
     L=K
     RETURN
     END SUBROUTINE BSORTL
!
     SUBROUTINE SWAP(LIST,K,L)
     IMPLICIT NONE
     INTEGER ,INTENT(IN OUT):: LIST(:),K,L
     INTEGER :: K 
     M=LIST(K)
     LIST(K)=LIST(L)
     LIST(L)=M
     RETURN
     END SUBROUTINE SWAP