PROGRAM Accidents
   IMPLICIT NONE

   INTEGER, PARAMETER :: Low = 1, High = 100
   LOGICAL,PARAMETER  :: Most = .TRUE., Least = .FALSE.
   CHARACTER(3),DIMENSION(Low:High) :: Town
   INTEGER, DIMENSION(Low:High) :: Moto, Mixed, NonMoto, Total
   INTEGER, DIMENSION(Low:High) :: oMoto, oMixed, oNon, oTotal
   INTEGER            :: I, J, K, NumLines
   REAL               :: AveAll, AveMoto, AveMixed, AveNon
   REAL               :: TotAll, TotMoto, TotMixed, TotNon
   LOGICAL            :: Yep

 
   DO
     READ(*,*) NumLines
     IF (NumLines <= High .AND. NumLines >= Low) EXIT
     WRITE(*,*) 'Wrong number try again'
   END DO
   10 FORMAT (A3,X,3I4)
   DO I = 1, NumLines
      READ(*,10) Town(I), Moto(I), Mixed(I), NonMoto(I)
   END DO 
   DO I = 1, NumLines
      Total(I) = Moto(I) + Mixed(I) + NonMoto(I)
   END DO

   Total(NumLines + 1) = -1 
   Moto(NumLines + 1)  = -1
   Mixed(NumLines + 1)  = -1
   NonMoto(NumLines + 1) = -1
   
   oMoto = Rank(Moto, NumLines)
   oMixed = Rank(Mixed, NumLines)
   oNon = Rank(NonMoto, NumLines)
   oTotal = Rank(Total, NumLines)

   TotMoto = 0
   TotMixed = 0
   TotNon = 0 
   TotAll = 0
   DO I = 2, Numlines - 1
     TotMoto = TotMoto + Moto(oMoto(I)) 
     TotMixed = TotMixed + Mixed(oMixed(I))
     TotNon = TotNon + NonMoto(oNon(I))
     TotAll = TotAll + Total(oTotal(I)) 
   END DO

   AveMoto = REAL(TotMoto) / REAL(NumLines - 2) 
   AveMixed = REAL(TotMixed) / REAL(NumLines - 2) 
   AveNon = REAL(TotNon) / REAL(NumLines - 2) 
   AveAll = REAL(TotAll) / REAL(NumLines - 2) 

   20 FORMAT (2X,4(A,X))
   25 FORMAT (4(F8.2,3X))

   WRITE(*,'(A)') 'The average number of accidents are:'
   WRITE(*,'(42("="))')
   WRITE(*,20) ' moto:    ', 'mixed:    ', '  non:    ',&
               'Total:    ' 
   WRITE(*,25) AveMoto, AveMixed, AveNon, AveAll
   WRITE(*,'(42("="))')
 
   40 FORMAT (A15, A9,2(A8, X))


   WRITE(*,*) 
   WRITE(*,'(A)') 'The Three most accidental Cities:'
   WRITE(*,40) 'Category       ', 'Most:     ','Second: ','Third:  '
   WRITE(*,'(40("-"))')


   CALL WThree(Moto, oMoto, Town, NumLines, Most , 'Motorized:     ')
   CALL WThree(Mixed, oMixed, Town, NumLines, Most,'Mixed:         ')
   CALL WThree(NonMoto, oNon, Town, NumLines, Most,'Non-Motorized: ')
   CALL WThree(Total, oTotal, Town, NumLines, Most,'Over All:      ')
   WRITE(*,*)
   WRITE(*,'(A)') 'The Three least accidental Cities:'
   WRITE(*,40) 'Category       ', 'Least:    ','Second: ','Third:  '
   WRITE(*,'(40("-"))')

   CALL WThree(Moto, oMoto, Town, NumLines, Least,  'Motorized:     ')
   CALL WThree(Mixed, oMixed, Town, NumLines, Least,'Mixed:         ')
   CALL WThree(NonMoto, oNon, Town, NumLines, Least,'Non-Motorized: ')
   CALL WThree(Total, oTotal, Town, NumLines, Least,'Over All:      ')

CONTAINS


FUNCTION Rank( Array, NumEle )
   IMPLICIT NONE
   INTEGER, DIMENSION(Low:High)         :: Rank
   INTEGER, INTENT(IN), DIMENSION(Low:High) :: Array
   INTEGER, INTENT(IN)                  :: NumEle
   INTEGER                              :: I, J
   INTEGER                              :: NextMax, CurrMax

   
   CurrMax = 100000

   DO J = 1 , NumEle
      NextMax = NumEle + 1
      DO I = 1, NumEle
         IF( Array(I) > Array(NextMax) .AND. Array(I) < CurrMax) THEN
             NextMax = I
         END IF
      END DO
      Rank(J) = NextMax
      CurrMax = Array(NextMax)
   END DO                                 
END FUNCTION Rank

SUBROUTINE WThree(Array, Order, City, NumEle, Up, Head)
   IMPLICIT NONE 
   INTEGER, DIMENSION(Low:High)         :: Order
   INTEGER, INTENT(IN), DIMENSION(Low:High) :: Array             
   CHARACTER(3), INTENT(IN), DIMENSION(Low:High) :: City             
   INTEGER, INTENT(IN)                  :: NumEle
   CHARACTER(15), INTENT(IN)            :: Head
   LOGICAL, INTENT(IN)                  :: Up
   INTEGER                              :: I, Inc, Start, Aend

   IF (Up) THEN 
      Inc = 1
      Start = 1
      Aend =  3 
   ELSE
      Inc = -1
      Start = NumEle
      Aend = NumEle - 2
   END IF

   WRITE(*,'(A)',ADVANCE="NO") Head 
  
   30 FORMAT ( A, I4, 2X ) 
   
   DO I = Start, Aend, Inc
      WRITE(*,30, ADVANCE="NO") City(Order(i)), Array(Order(i))
   END DO
   WRITE(*,'(/)',ADVANCE="NO")
END SUBROUTINE WThree
 
END PROGRAM Accidents
