MODULE Sort_Routines CONTAINS !-SelectionSort---------------------------------------------- ! Subroutine to sort an array Item into ascending order using ! the simple selection sort algorithm. For descending order ! change MINVAL to MAXVAL and MINLOC to MAXLOC. Local ! variables used are: ! NumItems : number of elements in array Item ! LargestItem : largest item in current sublist ! MAXLOC_array : one-element array returned by MINLOC ! LocationLmallest : location of LargestItem ! I : subscript ! ! Accepts: Array Item ! Returns: Array Item (modified) with elements in ascending ! order ! ! Note: Item is an assumed-shape array so a program unit that ! calls this subroutine must: ! 1. contain this subroutine as an internal subprogram, ! 2. import this subroutine from a module, or ! 3. contain an interface block for this subroutine. !-------------------------------------------------------------- SUBROUTINE SelectionSort(Item) REAL, DIMENSION(:), INTENT(INOUT) :: Item REAL :: LargestItem INTEGER :: NumItems, I, LocationLargest INTEGER, DIMENSION(1) :: MAXLOC_array NumItems = SIZE(Item) DO I = 1, NumItems - 1 ! Find smallest item in the sublist ! Item(I), ..., Item(NumItems) LargestItem = MAXVAL(Item(I:NumItems)) MAXLOC_array = MAXLOC(Item(I:NumItems)) LocationLargest = (I - 1) + MAXLOC_array(1) ! Interchange largest item with Item(I) at ! beginning of sublist Item(LocationLargest) = Item(I) Item(I) = LargestItem END DO END SUBROUTINE SelectionSort !-BubbleSort-------------------------------------------------- ! Subroutine to sort array Item into ascending order using the ! bubble sort algorithm. For descending order change > to < ! in the logical expression Item(I) > Item(I + 1). Local ! variables used are: ! NumPairs : number of pairs in the current sublist ! LastSwap : position at which the last interchange occurs ! I : subscript ! Temp : used to interchange two items in the list ! ! Accepts: Array Item and integer N ! Returns: Array Item (modified) with elements in ascending ! order ! ! Note: Item is an assumed-shape array so a program unit that ! calls this subroutine must: ! 1. contain this subroutine as an internal subprogram, ! 2. import this subroutine from a module, or ! 3. contain an interface block for this subroutine. !------------------------------------------------------------- SUBROUTINE BubbleSort(Item) REAL, DIMENSION(:), INTENT(INOUT) :: Item INTEGER :: NumPairs, LastSwap, I REAL :: Temp NumPairs = SIZE(Item) - 1 DO IF (NumPairs == 0) EXIT ! If no more pairs to check, terminate repetition ! Otherwise scan the sublist of the first NumPairs pairs in ! the list, interchanging items that are out of order LastSwap = 1 DO I = 1, NumPairs IF (Item(I) < Item(I+1)) THEN ! Items out of order -- interchange them Temp = Item(I) Item(I) = Item(I+1) Item(I+1) = Temp ! Record position of last swap LastSwap = I END IF END DO NumPairs = LastSwap - 1 END DO END SUBROUTINE BubbleSort END MODULE Sort_Routines