!
      PROGRAM P93
!
      IMPLICIT NONE
      INTEGER :: LIST(1000)
      INTEGER :: N,I
      INTEGER :: NCOMP,NSWAP
!
      INTERFACE
      SUBROUTINE BSORT2(LIST,N,NCOMP,NSWAP)
       IMPLICIT NONE
       INTEGER, INTENT(IN OUT) :: LIST(:)
       INTEGER, INTENT(IN OUT) :: NSWAP
       INTEGER, INTENT(IN OUT) :: NCOMP
       INTEGER, INTENT(IN OUT) :: N
      END SUBROUTINE BSORT2
      END INTERFACE
!
!
      PRINT *, 'This is Program >> P93  - Better Bubble sort'
!
!
      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 BSORT2(LIST,N,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 P93
!
      SUBROUTINE BSORT2(LIST,N,NCOMP,NSWAP)
      IMPLICIT NONE
      INTEGER :: K,I,LAST,KK,TEMP1
      INTEGER, INTENT(IN OUT) :: LIST(:)
      INTEGER, INTENT(IN OUT) :: NSWAP
      INTEGER, INTENT(IN OUT) :: NCOMP
      INTEGER, INTENT(IN OUT) :: N

      PRINT 23
  23  FORMAT(/' SORTING'/)
      NCOMP=0
      NSWAP=0
      LAST=N-1
L1:   DO
         K=0
L2:      DO I=1,LAST
            NCOMP=NCOMP+1
            IF(LIST(I) > LIST(I+1))THEN
               TEMP1=LIST(I)
               LIST(I)=LIST(I+1)
               LIST(I+1)=TEMP1
               NSWAP=NSWAP+1
               K=I  ! Remember swap location
            END IF
         END DO L2
         PRINT 16,(LIST(KK),KK=1,N)
  16     FORMAT(20I5)
         LAST=K
         IF(K == 0) EXIT  ! No more swaps
      END DO L1
      RETURN
      END SUBROUTINE BSORT2