!
      PROGRAM P92
!
      IMPLICIT NONE
      INTEGER :: LIST(1000)
      INTEGER :: COUNTS,NCOMP,NSWAP
!
      INTERFACE
      SUBROUTINE BSORT1(LIST,N,COUNTS,NCOMP,NSWAP)
      IMPLICIT NONE
      INTEGER ,INTENT(IN OUT) :: LIST(:),NCOMP,NSWAP,COUNTS
      INTEGER ,INTENT(IN) :: N
      END SUBROUTINE BSORT1
      END INTERFACE
      INTERFACE
      SUBROUTINE SWAP(LIST,K,L)
      IMPLICIT NONE
      INTEGER ,INTENT(IN OUT) :: LIST(:),K,L
      END SUBROUTINE SWAP
      END INTERFACE
!
      PRINT *, 'This is Program >> P92  - Bubble sort'
!
!     Tell program where data for  READ *  is coming from
      OPEN(UNIT=5, FILE='P92.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 BSORT1(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 P92
!
      SUBROUTINE BSORT1(LIST,N,COUNTS,NCOMP,NSWAP)
      IMPLICIT NONE
      INTEGER ,INTENT(IN OUT) :: LIST(:),NCOMP,NSWAP,COUNTS
      INTEGER ,INTENT(IN) :: N
      INTEGER :: I,K,KK
      PRINT 23
  23  FORMAT(' SORTING'/)
      NCOMP=0
      NSWAP=0
L1:   DO
         K=0
L2:      DO I=1,N-1
            NCOMP=NCOMP+1
            IF(LIST(I) > LIST(I+1))THEN
               CALL SWAP(LIST,I,I+1)
               NSWAP=NSWAP+1
               K=1        ! A swap done
            ENDIF
         END DO L2
         PRINT 16,(LIST(KK),KK=1,N)
     16  FORMAT(20I5)
         IF(K == 0) EXIT  ! No swaps done
      END DO L1
      RETURN
      END SUBROUTINE BSORT1
!
      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