PROGRAM Sort ! ! Author: Br. David Carlson ! ! Date: March 31, 2012 ! ! This program prompts the user for the number of reals to enter, has ! the user enter those reals, sorts them into ascending order with ! insertion sort, and then prints the sorted numbers. IMPLICIT NONE INTEGER, PARAMETER::max = 100 INTEGER count REAL, DIMENSION(max)::data CALL GetData(data, count, max) CALL InsertionSort(data, count, max) CALL Print(data, count, max) END PROGRAM !----------------------------------------------------------------------------- ! Given: max The maximum number of reals that can be put into array A. ! Task: To get from the user the number of reals num to be entered and to ! have them entered by the user and placed into array A in ! positions 1 through num. ! Return: A The array containing the reals entered by the user. ! num The number of reals that the user entered into array A. !----------------------------------------------------------------------------- SUBROUTINE GetData(A, num, max) IMPLICIT NONE INTEGER, INTENT(OUT)::num INTEGER, INTENT(IN)::max REAL, DIMENSION(max), INTENT(OUT)::A INTEGER::k WRITE (*, *) "How many reals do you want to enter and sort?" READ (*, *) num DO WHILE ((num > max) .OR. (num < 1)) WRITE (*, *) "Re-enter. You must use a number bigger than zero and less than ", max READ (*, *) num END DO DO k = 1, num WRITE (*, *) "Enter real number ", k READ (*, *) A(k) END DO END SUBROUTINE !----------------------------------------------------------------------------- ! Given: A An array of length max, holding data from index 1 to index num. ! max The maximum number of reals that can be put into array A. ! num The number of data items in array A. ! Task: To print out the numbers in array A that are from index 1 to num. ! Return: Nothing. !----------------------------------------------------------------------------- SUBROUTINE Print(A, num, max) IMPLICIT NONE INTEGER, INTENT(IN)::num INTEGER, INTENT(IN)::max REAL, DIMENSION(max), INTENT(IN)::A INTEGER k WRITE (*, 100) (A(k), k = 1, num) 100 FORMAT (1X, 5ES14.5, /) END SUBROUTINE !----------------------------------------------------------------------------- ! Given: A An array of length max, holding data from index 1 to index num. ! max The maximum number of reals that can be put into array A. ! num The number of data items in array A. ! Task: To sort that part of the data in array A that is from index 1 to num. ! This data is put into ascending order using an insertion sort. ! Return: A The sorted array. !----------------------------------------------------------------------------- SUBROUTINE InsertionSort(A, num, max) IMPLICIT NONE INTEGER, INTENT(IN)::num INTEGER, INTENT(IN)::max REAL, DIMENSION(max), INTENT(INOUT)::A INTEGER i, k, IndexOfMin REAL MinValue DO k = 1, num - 1 ! Find the smallest value in A(k) through A(num). IndexOfMin = k MinValue = A(k) DO i = k + 1, num IF (A(i) < MinValue) THEN IndexOfMin = i MinValue = A(i) END IF END DO ! Swap data items in array A at indices k and IndexOfMin, if IndexOfMin /= k. IF (IndexOfMin /= k) THEN A(IndexOfMin) = A(k) A(k) = MinValue END IF END DO END SUBROUTINE