FORTRAN Radix Sort

I’m taking a course at Centre College called “Programming languages” and usually after we’ve learned a new language, we write radix sort in it. Here is the radix sort I wrote in FORTRAN 90.

!  RadixSort.f90 
!****************************************************************************
!
!  PROGRAM: RadixSort
!
!  AUTHOR: David Fritz
!
!  DATE: 2/20/09
!
!  PURPOSE:  to take an array of numbers and sort them using the LSD radix sort
!            algorithm. also needs to provide queue functionality using arrays
!
!  STATEMENT: I completed all this work on my own. I did reference
!             a few websites and the addresses are stated in the 
!             comments in the appropriate sections
!
!****************************************************************************

    !create a queue module
    module Queues

    implicit none

    ! type for data to be stored in a queue object
    type queue_object_data
        integer :: qvalue
    end type queue_object_data

    ! actual item for where queue data is stored
    ! this is the actual thing that is going
    ! inside the queue itself
    type queue_object
        type(queue_object_data) :: qdata
        type(queue_object),pointer :: next
    end type queue_object

    ! and now for the queue itself
    type queue
        type(queue_object), pointer :: front, back
        integer :: length
    end type queue

    !now for the subroutines for preforming
    !actions upon the queue
    contains

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !initialize_queue(q)
    !
    !this will initialize the queue and 
    !preform all necessary initilization
    !operations
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    subroutine initialize_queue(x)
        implicit none

        ! parameters
        !
        ! intent(inout) means that the parameter
        ! has an initial value that will be
        ! changed by this subroutine
        type(queue), intent(inout) :: x

        ! always intialize pointers with nullify
        ! reference:
        ! http://tinyurl.com/cuhb7v
        nullify(x%front)
        nullify(x%back)
        x%length = 0

    end subroutine initialize_queue

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! insert(x, queue_object)
    !
    ! this will insert a queue object
    ! in the end of the queue
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    subroutine insert(x, q_object)
        implicit none

        ! parameters
        !
        ! x = the queue to insert into
        ! q_object = the object that 
        !                will be inserted
        !                into x

        type(queue), intent(inout) :: x
        type(queue_object_data), intent(in) :: q_object

        ! we are going to need a new queue object
        type(queue_object), pointer :: newobject

        ! allocate() allows us to dynamically
        ! allocate storage for our new object
        ! reference:
        ! http://en.wikipedia.org/wiki/Fortran_language_features#ALLOCATABLE_and_ALLOCATE
        !
        ! associated() allows us to determine
        ! if a pointer is associated
        ! with a target
        ! reference: http://tinyurl.com/cr4sod
        ! 
        allocate(newobject)
        newobject%qdata = q_object
        nullify(newobject%next)

        ! if the back pointer for the queue
        ! isn't associtated, we need
        ! to associate the head and the back
        ! to the newobject 
        !
        ! but if it is associated, then set the
        ! next pointer of the back queue_object
        ! to the newobject and the back pointer
        ! of the queue to the newobject
        ! 
        if(.not.associated(x%back)) then
            x%front => newobject
            x%back => newobject
        else
            x%back%next => newobject
            x%back => newobject
        end if

        !now we increaes the size of the queue
        x%length = x%length + 1

    end subroutine insert

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! queue_length(x)
    !
    ! will return the length/size of the queue
    ! (i would use length, but its already in use
    ! by the queue type)
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    function queue_length(x)
        implicit none

        ! parameters
        !
        ! x is queue to check
        !
        ! intent set to IN because we
        ! aren't changing anything
        type(queue), intent(in) :: x

        integer :: queue_length
        queue_length = x%length
    end function queue_length

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! isEmpty()
    !
    ! this will return true if the queue is empty
    ! or return false if it is not empty
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    function isEmpty(x)
        implicit none

        ! parameters
        !
        ! x is the queue to check
        !
        ! intent is set to IN because we
        ! are not going to change it
        type(queue), intent(in) :: x

        ! we aren't really returning a true
        ! or false, we are simply setting
        ! making this function a boolean
        ! function by declaring it logical
        logical :: isEmpty

        ! just set it true initially
        isEmpty = .true.

        ! we can determine if the queue is empty
        ! by checking to see if the head object
        ! pointer is associated and if the length
        ! is at least 1
        if(associated(x%front) .and. (x%length .GE. 1)) then
            isEmpty = .false.
        end if
    end function isEmpty

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! top(x)
    !
    ! this will return the front of the queue
    ! but WILL NOT remove it
    ! 
    ! to return AND remove the front of the queue
    ! use the pop(x) function
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    function top(x)
        implicit none

        ! parameters
        !
        ! x = queue to top()
        !
        ! intent is set to IN because we
        ! are not changing anything
        type(queue), intent(in) :: x

        ! we need a queue_object_data to
        ! store the data retrieved from
        ! the front of the queue.
        !
        ! we set it = to the function name
        ! as to return the data
        type(queue_object_data) :: top

        ! make sure to check if queue is empty
        logical :: empty
        empty = isEmpty(x)

        ! return top or print error on empty queue
        if(.not.empty) then
            top = x%front%qdata
        else
            write(*,*) "top(): Can not top on empty queue!"
        end if

    end function top

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! pop(x)
    !
    ! this will return the front of the queue
    ! but AND remove it
    ! 
    ! to return NOT remove the front of the queue
    ! use the top(x) function
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  
    function pop(x)
        implicit none

        ! parameters
        !
        ! x = queue to top()
        !
        ! intent is set to INOUT because we
        ! are changing x eventually
        type(queue), intent(inout) :: x

        ! need a queue_object_data to store
        ! what is being taken off the front
        ! and a pointer to we can make sure
        ! the queue stays properly linked
        ! after we remove the item
        type(queue_object_data) :: pop
        type(queue_object), pointer :: newpointer
        logical :: empty
        empty = isEmpty(x)

        ! make sure to check if the queue is empty
        if(.not.empty) then
            ! if the next pointer is associated to 
            ! an object than you can set the newpointer
            ! to the next object in the queue
            ! return the front object data and then
            ! deallocate and resign the front object
            ! to the next object
            if(associated(x%front%next)) then
                newpointer => x%front%next
                pop = x%front%qdata
                deallocate(x%front) 
                x%front => newpointer
            else
            ! if the next object is unassociated
            ! we can just return the data in the
            ! front object and then deallocate the
            ! head and nullify the front and back
                pop = x%front%qdata
                deallocate(x%front)
                nullify(x%front)
                nullify(x%back)
            end if

            ! dont forget to update the length to
            ! the new queue length
            x%length = x%length - 1
        else
            write(*,*) "pop(): Can not pop on an empty queue!"
        end if

    end function pop

    ! YAAAAAY!!!!! we are finished with the queue module
    end module Queues           

    ! create a Radix module    
    module MyRadix

    use Queues
    implicit none
    ! first we need to declare everything
    integer i,small,large,ios, numOfInts
    integer numDigits
    type(queue) :: queueSets(0:10) ! we need a queue for every digit 0-9
    type(queue) :: queue0,queue1,queue2,queue3,queue4,queue5,queue6,queue7,queue8,queue9

    contains

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! sort(a)
    !
    ! this is the sorting function. you simply
    ! pass it an array of numbers and it will 
    ! return a sorted list using the radix
    ! sorting algorithm
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    function sort(a)

        implicit none
        integer :: arrayPos
        integer :: j
        integer :: x
        integer :: test
        integer :: radixNum
        type(queue_object_data) :: queuedata
        type(queue_object_data) :: popobjectdata
        integer :: sort(0:1000)
        integer :: a(0:1000)
        logical :: isitempty
        isitempty = .false.
        queueSets(0) = queue0
        queueSets(1) = queue1
        queueSets(2) = queue2
        queueSets(3) = queue3
        queueSets(4) = queue4
        queueSets(5) = queue5
        queueSets(6) = queue6
        queueSets(7) = queue7
        queueSets(8) = queue8
        queueSets(9) = queue9

        numOfInts = 600
        test = pre_sort(a)
        ! i will be the radix in the loop
        do 12 i=1,numDigits
            arrayPos = 0
            ! put ints into queues by radix
            ! LSD sort
            do 13 j=0,numOfInts
                radixNum = getRadix(a(j),i)
                queuedata%qvalue = a(j)
                call insert(queueSets(radixNum),queuedata)
            13 continue

            !now to take the queues and put them 
            !back into arrays containing partially
            !sorted lists
            do 15 j=0,9
                do 16 x=0,numOfInts
                    isitempty = isEmpty(queueSets(j))
                    if(isitempty) then
                        goto 15
                    else
                        popobjectdata = pop(queueSets(j))
                        a(arrayPos) = popobjectdata%qvalue
                        arrayPos = arrayPos + 1
                    end if
                16 continue
            15 continue
        12 continue
        i = 0 
        sort(0:1000) = a(0:1000)           
    end function sort

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! pre_sort(q)
    !
    ! there are a few calculations that must be done
    ! before we can actually sort the array and this
    ! function handels that part
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    function pre_sort(q)
        implicit none
        integer :: q(0:1000)
        ! first we need to find the largest integer
        ! and then find the largest number of digits
        integer :: temp
        integer :: largeLoc 
        integer :: pre_sort
        small = q(0)
        large = q(0)   
        do 11 i=0,numOfInts
            if(q(i).LT.small)then
                small = q(i)
            elseif(q(i).GT.large) then
                large = q(i)
                largeLoc = i
            endif
        11 continue

        temp = 10
        numDigits = 1
        ! this will give us the most digits
        do 20 i=0,numOfInts
            if(large.GE.temp) then
                numDigits = numDigits + 1
                temp = temp * 10
            else
                goto 27
            end if
        20 continue
        27 temp = temp+1
        pre_sort = 0
    end function pre_sort

    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! getRadix(num,radix)
    !
    ! this function will return the digit 
    ! we are trying to sort on
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    function getRadix(num,radix)
        implicit none
        integer :: num
        integer :: radix
        !parameters
        !
        ! number = number to get radix
        ! radix = which radix (digit place)
        integer :: getRadix
        getRadix = MOD((num / (10**(radix-1))),10)       

    end function getRadix

    end module MyRadix

    program RadixSort
    ! this is the main program that actually
    ! reads the numbers from the file
    ! and uses the MyRadix module to sort them
    ! and them display them
    !
    ! in the future i plan to output to a file
    use MyRadix
    implicit none
    integer :: sortData(0:1000)
    integer :: sortedArray(0:1000)
    integer :: myi,myios
    integer :: numInts
	numInts = 600
    ! now read all the numbers to be sorted from
    ! a file (max of 1000 integers)
    open(unit=2, file="radixFile.txt", iostat=myios)    
    do 10 myi=1,numInts
        if(myios.EQ.(-1)) then
            exit
        else
            read(2,*) sortData(myi)
        end if
    10 continue  

    !open a file for write
    open(unit=3, file="sortedOutput.txt", iostat=myios)
    sortedArray = sort(sortData)
    do 17 myi=0,numInts
        write(3,*) sortedArray(myi)
    17 continue

    end program RadixSort