PROGRAM Sort_and_Find_Median_Cost
!-----------------------------------------------------------------------
! This program reads and counts a list of labor costs, uses a module
! subroutine to sort them in ascending order, and finds the median cost.
! Variables used are:
!   Cost        : list of labor costs (in millions)
!   MaxNumCosts : maximum number of costs
!   NumCosts    : number of costs
!
! Input:  Elements of Cost -- using internal subroutine ReadCosts
! Output: Sorted elements of Cost -- using internal subroutine Output
!-----------------------------------------------------------------------

  USE Sort_Routines, ONLY : SelectionSort

  IMPLICIT NONE
  INTEGER, DIMENSION(:), ALLOCATABLE :: Cost
  INTEGER :: MaxNumCosts, NumCosts

  ! Allocate the array Cost
  WRITE (*, '(1X, A)', ADVANCE = "NO") &
        "Enter the maximum number of costs to be processed: "
  READ *, MaxNumCosts
  ALLOCATE(Cost(MaxNumCosts))

  CALL ReadCosts(Cost, NumCosts)
  CALL SelectionSort(Cost(1:NumCosts))
  CALL Output(Cost(1:NumCosts))

  DEALLOCATE(Cost)

CONTAINS

  !-ReadCosts----------------------------------------------------------
  ! Subroutine to read a list of up to MaxNumCosts costs, store them in
  ! array Cost, and return this list and a count NumCosts of the number
  ! of values read.  Local variables:
  !   MaxNumCosts : maximum number of costs
  !   InputData   : data value read (an actual cost or end-of-data
  !                 signal)
  !
  ! Input:    Elements of Cost
  ! Returns:  NumCosts and the array Cost
  !--------------------------------------------------------------------
  
  SUBROUTINE ReadCosts(Cost, NumCosts)
  
    INTEGER, DIMENSION(:), INTENT(OUT) :: Cost
    INTEGER, INTENT(OUT) :: NumCosts
    INTEGER :: MaxNumCosts, InputData
  
    MaxNumCosts = SIZE(Cost)
  
    PRINT *, "Enter labor costs in millions (0 or negative to stop)."
    NumCosts = 0
    DO
       ! Check if there is still room in the array Costs.  If not,
       ! terminate input and process the costs that have been entered
       IF (NumCosts == MaxNumCosts) THEN
          PRINT *, "No more costs can be entered.  Processing the first"
          PRINT *, MaxNumCosts, " costs."
          RETURN
       END IF
  
       ! Otherwise read and store more costs
       READ *, InputData
       IF (InputData <= 0) EXIT  ! End of data -- terminate repetition
  
       ! Otherwise, count and store the data value
       ! in the next location of array Cost
       NumCosts = NumCosts + 1
       Cost(NumCosts) = InputData
    END DO
  
  END SUBROUTINE ReadCosts
  
  
  !-Output-------------------------------------------------------------
  ! Subroutine to display the sorted list of costs and the median cost.
  ! Local variables:
  !   I         : subscript
  !   NumCosts  : number of costs
  !
  ! Accepts:  Array Cost and integer NumCosts
  ! Output:   First NumCosts elements of Cost and the median cost
  !--------------------------------------------------------------------
  
  SUBROUTINE Output(Cost)
  
    INTEGER, DIMENSION(:), INTENT(IN) :: Cost
    INTEGER :: NumCosts, I
  
    NumCosts = SIZE(Cost)
  
    PRINT '(2(/, 1X, A))', "Sorted List", "====== ===="
    DO I = 1, NumCosts
       PRINT '(1X, I6)', Cost(I)
    END DO
  
    IF (MOD(NumCosts, 2) /= 0) THEN
       PRINT 10, REAL(Cost((NumCosts + 1)/2))
    ELSE
       PRINT 10, REAL(Cost(NumCosts/2) + Cost(NumCosts/2 + 1)) / 2.0
    END IF
    10 FORMAT(/1X, "Median =", F7.1, " million dollars")
  
  END SUBROUTINE Output

END PROGRAM Sort_and_Find_Median_Cost