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