! This was my final Project for my Fortran 90 course
! Because I had such a hard time finding examples of various sorting algorithms on the internet
! I have decided to make my program available to anyone who is interested.  
! I make no promises or warranties other than it seems to work pretty well.  If for some reason 
! you need to get a hold of me contact information can be found on my website at http://www.andrewduey.com
!
! This program will read from the file called datain.dat and save data to dataout.dat
! This program will load and sort the information in datain.dat, then prompt the user
! to select which type of sort they would like to perform.  After the program has sorted 
! the list it will display the output on the screen as well as to the data file (without the 
! headers) and then exit.
! Programs is designed to work with lists up to 10,000 records long
! Written By Andrew Duey for CS252d
! Program last modified 5-7-04
MODULE types
	!Defines the person variable type
	IMPLICIT NONE
	TYPE :: person !Defines the person type
		CHARACTER (LEN=12) :: first !a place to store the first name
		CHARACTER (LEN=12) :: last !a place to store the last name
		CHARACTER (LEN=11) :: ssn !a place to store the social security number
		INTEGER :: account_Num !a place to store the account number 
		REAL :: amount_owed  !a place to store the amount owed on the account
		TYPE (person), POINTER :: next_value  !the pointer which we use for the linked list as part of the insertion sort
	END TYPE person
END MODULE types
PROGRAM final_project
	USE types !Use the custom variable type we defined above
	IMPLICIT NONE
	!Declare the variables we will be using here
	
	INTEGER, PARAMETER :: MAX_SIZE = 10000 !delcare the max number of records for eash changing
	TYPE(person), DIMENSION(MAX_SIZE) :: customer_list !Declare the customer list where all customer data will be stored
	INTEGER :: option ! Delecare the variable to read the user response into
	INTEGER :: nvals = 0 ! The number of values from records we're going to sort
	INTEGER :: status !Used to check the status of read and write operations
	INTEGER :: i = 0 !delcare our counter
	! Write out the main menu to the screen
	WRITE(*,*) ' Welcome to the Duey List Sorter'
	WRITE(*,*) ''
	WRITE(*,*) 'Please select from the following options'
	WRITE(*,*) ''
	WRITE(*,*) '1) Sort using Bubble Sort'
	WRITE(*,*) '2) Sort using Shell Sort'
	WRITE(*,*) '3) Sort using Selection Sort'
	WRITE(*,*) '4) Sort using Quick Sort'
	WRITE(*,*) '5) Sort using Insertion Sort'
	WRITE(*,*) ''
	WRITE(*,*) 'Please type the number of the sort you wish to perform and press enter'
	READ(*,*) option !read the desired action from the user
	OPEN (UNIT=3, FILE='datain.dat', STATUS='OLD', ACTION='READ', IOSTAT=status) !opens the data file
	openif: IF (status == 0 ) THEN
		!Open worked
		readloop: DO	!loop through the records and read them into the array
			READ (3, 1001, IOSTAT=status) customer_list(nvals)%first, customer_list(nvals)%last,customer_list(nvals)%ssn,&
			customer_list(nvals)%account_Num, customer_list(nvals)%account_Num, customer_list(nvals)%amount_owed
			1001 FORMAT (1X, A12, 1X, A12, 1X, A11, 1X, I10, 1X, F10.2)
			IF ( status /=0 ) EXIT
			nvals = nvals + 1
		END DO readloop
		readif: IF ( status > 0 ) THEN ! if there was a problem reading the file tell the user
			WRITE (*,*) 'An error occured while reading line ', nvals + 1, ' ' , status
		ELSE
			!WRITE (*,*) nvals, ' was read sucessfully'
	END IF readif
	
	
	!now that we have the data loaded into the array we need to sort it how the user wants
	SelectOption: SELECT CASE (option)
	CASE (1) SelectOption
		WRITE (*,*) 'Bubble Sort selected'
		CALL sort_bubble (customer_list, nvals)
	CASE (2) SelectOption
		WRITE (*,*) 'Shell Sort selected'
		CALL sort_shell (customer_list, nvals)
	CASE (3) SelectOption
		WRITE (*,*) 'Selection Sort selected'
		CALL sort_selection (customer_list, nvals)
	CASE (4) SelectOption
		WRITE (*,*) 'Quick Sort selected'
		CALL sort_quick (customer_list, nvals)
	CASE (5) SelectOption
		WRITE (*,*) 'Insertion Sort selected'
		CALL sort_insertion (customer_list, nvals)
	CASE DEFAULT
		WRITE (*,*) 'Sort option not recogonized, original data written to output file'
	END SELECT SelectOption
	!when we are done sorting the array we will dump it to the screen and to a file
		OPEN (UNIT=4, FILE='dataout.dat', STATUS='REPLACE', ACTION='WRITE', IOSTAT=status) !Opens the data file for writing
		WRITE (*,*) '' !puts a couple of blank lines at the top of the screen for estetics
		WRITE (*,*) ''
		WRITE (*,*) 'First Name   Last Name    SSN              Acct#    Balance'
		WRITE (*,*) '-----------------------------------------------------------'
		outputloop: DO i=0, nvals - 1, 1
			WRITE (4, 1000) customer_list(i)%first, customer_list(i)%last, customer_list(i)%ssn, customer_list(i)%account_Num, & 
			customer_list(i)%amount_owed !writes to the file
			WRITE (*,1000) customer_list(i)%first, customer_list(i)%last, customer_list(i)%ssn, customer_list(i)%account_Num, & 
			customer_list(i)%amount_owed !writes to the screen
			1000 FORMAT (1X, A12, 1X, A12, 1X, A11, 1X, I10, 1X, F10.2)
		END DO outputloop
		CLOSE (UNIT=4) !closes output files
	ELSE openif
		WRITE (*,*) 'error reading input file with error code=', status !reports file errors if any
	END IF openif
	!close the file here
	CLOSE (UNIT=3)
	STOP !ends program
END PROGRAM final_project
SUBROUTINE sort_selection (customer_list, nvals) 
!implements selection sort
	USE types
	LOGICAL, EXTERNAL :: gt_person !funtion to tell which person goes first
	INTEGER :: i = 0
	INTEGER :: j = 0
	TYPE(person):: temp_person2 !temp variable
	TYPE(person), INTENT(INOUT), DIMENSION(*) :: customer_list !Define the customer list to handle whatever size is sent
	INTEGER, INTENT(IN) :: nvals !grab the number of values from the calling code
	! Here is where we will do the selection sort
	WRITE (*,*) 'Now doing selection sort'
	sortloop1: DO i = 0, nvals - 2, 1
		!this loop increments i which is our starting point for the comparison
		sortloop2:DO j = i+1, nvals -1, 1
			!this loop increments j which is the ending point for the comparison		
			swapposition: IF ( gt_person(customer_list(i),customer_list(j)) )  THEN
				!WRITE (*,*) 'WE SWAPED ', customer_list(i)%last , ' and ', customer_list(j)%last
				!swap the name here
				temp_person2 = customer_list(i)
				customer_list(i) = customer_list(j)
				customer_list(j) = temp_person2
			END IF swapposition
		END DO sortloop2
	END DO sortloop1	
	
END SUBROUTINE sort_selection
SUBROUTINE sort_quick (customer_list, nvals) 
!Sets up for the quick sort recursive method
	USE types
	LOGICAL, EXTERNAL :: gt_person !funtion to tell which person goes first
	INTEGER :: i = 0
	INTEGER :: j = 0
	TYPE(person):: temp_person2
	TYPE(person), INTENT(INOUT), DIMENSION(*) :: customer_list !Define the customer list to handle whatever size is sent
	INTEGER, INTENT(IN) :: nvals !grab the number of values from the calling code
	! Here is where we will do the selection sort
	WRITE (*,*) 'Now doing Quick sort'
	CALL qsRecursive(0, nvals-1, customer_list) !kicks off the recursive process
	
END SUBROUTINE sort_quick
RECURSIVE SUBROUTINE qsRecursive (lo, hi, customer_list)
!This is the actualy recursive portion of the quicksort
	USE types
	INTEGER :: pivotPoint
	INTEGER, INTENT(IN) :: lo
	INTEGER, INTENT(IN) :: hi
	TYPE(person), INTENT(INOUT), DIMENSION(*) :: customer_list
	pivotPoint = qsPartition(lo, hi, customer_list); !basically all we do is find the pivot point, adjust elements, then call it again
	IF (lo < pivotPoint) CALL qsRecursive(lo, pivotPoint -1, customer_list)
	IF (pivotPoint < hi) CALL qsRecursive(pivotPoint + 1, hi, customer_list)
END SUBROUTINE qsRecursive
FUNCTION qsPartition (loin, hiin, customer_list)
	!The partition portios of the Quick Sort is the must involved part
	USE types
	LOGICAL, EXTERNAL :: gt_person !funtion to tell which person goes first
	TYPE(person), INTENT(INOUT), DIMENSION(*) :: customer_list
	INTEGER, INTENT(IN) :: loin
	INTEGER:: lo !variable so we can manipulate the hi and lo values without changing things elsewhere in the program by reference
	INTEGER, INTENT(IN) :: hiin
	INTEGER:: hi !variable so we can manipulate the hi and lo values without changing things elsewhere in the program by reference
	TYPE(person)::pivot !the temp location for the pivitoal element to which everything will be compaired
	hi = hiin
	lo = loin
	pivot = customer_list(lo)
	DO
		IF (lo >= hi) EXIT !exit the loop when done
		DO !move in from the right
			IF ((gt_person(pivot, customer_list(hi))) .OR. (lo >= hi)) EXIT
			hi = hi - 1
		END DO	
		IF (hi /= lo) then !move the entry indexed by hi to left side of partition
				customer_list(lo) = customer_list(hi) 
				lo = lo + 1
		END IF
		DO !move in from the left
			IF ((gt_person(customer_list(lo),pivot)) .OR. (lo >= hi)) EXIT
			lo = lo + 1
		END DO	
		IF (hi /= lo) then !move the entry indexed by hi to left side of partition
			customer_list(hi) = customer_list(lo) 
			hi = hi - 1
		END IF
	END DO
	customer_list(hi) = pivot !put the pivot element back when we're done
	qsPartition = hi !return the correct position of the pivot element
END FUNCTION qsPartition
SUBROUTINE sort_insertion (customer_list, nvals) 
!the sub that handles the insertion sort
	USE types
	LOGICAL, EXTERNAL :: gt_person !funtion to tell which person goes first
	LOGICAL, EXTERNAL:: sp !Function call to tell if the it's the same person
	TYPE(person):: temp_person2
	TYPE(person), INTENT(INOUT), DIMENSION(*) :: customer_list !Define the customer list to handle whatever size is sent
	INTEGER, INTENT(IN) :: nvals !grab the number of values from the calling code
	TYPE (person), POINTER :: ptr !declare the pointers we use to build and maintain the linked list
	TYPE (person), POINTER :: ptr1
	TYPE (person), POINTER :: ptr2
	TYPE (person), POINTER :: tail
	TYPE (person), POINTER :: head
	INTEGER :: istat !a variable to hold status flags in
	INTEGER :: counter !Used to count the number of records we've read
	INTEGER :: i = 0 !ah, gold ole i
	! Here is where we will do the selection sort
	WRITE (*,*) 'Now doing Inerstion sort using pointers'
	input: DO !Input the values from the existing customer array
		if (counter==nvals+1) EXIT
		temp_person2 = customer_list(counter)
		counter = counter + 1
		ALLOCATE (ptr, STAT=istat)
		ptr = temp_person2
		!Now we find where to put it in the list
		
		new: IF (.NOT. ASSOCIATED(head)) THEN !check to see if we need to start the list
			!ADD to front of list
			head => ptr	!place at front
			tail => head	!tail points to new value
			NULLIFY (ptr%next_value) !Nullify next ptr
		ELSE !if the list already exists
			!Values already in list. Check for location.
			front: IF (gt_person(head,ptr )) THEN !if it belongs at the start of the list
				!Add to front of list
				ptr%next_value => head
				head => ptr
			ELSE IF ( gt_person(ptr, tail) .OR. (sp(ptr,tail)) ) THEN !if it belongs at the end of the list do that
				!Add at end of list
				tail%next_value => ptr
				tail => ptr
				NULLIFY ( tail%next_value)
			ELSE !otherwise figure out where in the list it belongs
				!Find Place to add value
				ptr1 => head
				ptr2 => ptr1%next_value
				search: DO
					IF ( (gt_person(ptr,ptr1) .OR. (sp(ptr,ptr1))) .AND. (gt_person(ptr2,ptr))) THEN
					!Insert Value Here
					ptr%next_value => ptr2
					ptr1%next_value => ptr
					EXIT search
				END IF
				ptr1 => ptr2
				ptr2 => ptr2%next_value
			END DO search	
		End IF front
	END IF new
END DO input
!Now write out the data
ptr => head
i = -1
output: DO !this writes the data back to the same customer_list array for output by common functions
	IF ( .NOT. ASSOCIATED(ptr)) EXIT
	customer_list(i)=ptr	
	ptr => ptr%next_value
	i = i + 1
END DO output	
		
END SUBROUTINE sort_insertion
SUBROUTINE sort_shell (customer_list, nvals) !-----needs numvals and custlist
!This is where we do the shell sort
	USE types
	LOGICAL, EXTERNAL :: gt_person !funtion to tell which person goes first
	INTEGER :: i = 0
	INTEGER :: j = 0
	INTEGER :: increment = 3 !this is the increment which can be adjusted up or down depending on condition and size of dataset
	TYPE(person):: temp_person2
	TYPE(person), INTENT(INOUT), DIMENSION(*) :: customer_list !Define the customer list to handle whatever size is sent
	INTEGER, INTENT(IN) :: nvals !grab the number of values from the calling code
	! Here is where we will do the selection sort
	WRITE (*,*) 'Now doing Shell sort'
	
	outloop: DO
	IF (increment==0) EXIT !check to make sure it's not time to end
		sortloop1: DO i = 0, nvals - 1, 1
			!this loop increments i which is our starting point for the comparison
			j=i
			temp_person2 = customer_list(i)
			sortloop2:DO !here in the inner loop is where the comparisons happen
				IF ((j<increment) .OR. (gt_person(temp_person2,customer_list(j-increment)))) EXIT
				!this loop increments j which is the ending point for the comparison		
				customer_list(j) = customer_list(j - increment)
				j=j-increment
			END DO sortloop2
			customer_list(j)=temp_person2
		END DO sortloop1
		IF ((increment/2) /= 0) THEN !make adjustments up and down to the increment
			increment = increment/2
		ELSE IF	(increment==1) then
			increment = 0
		ELSE
			increment=1;
		END IF
	END DO outloop
END SUBROUTINE sort_shell
SUBROUTINE sort_bubble (customer_list, nvals) !-----needs numvals and custlist
!this is where teh bubble sort is done
	USE types
	LOGICAL, EXTERNAL :: gt_person !funtion to tell which person goes first
	INTEGER :: i = 0
	INTEGER :: j = 0
	TYPE(person):: temp_person2
	TYPE(person), INTENT(INOUT), DIMENSION(*) :: customer_list !Define the customer list to handle whatever size is sent
	INTEGER, INTENT(IN) :: nvals !grab the number of values from the calling code
	! Here is where we will do the selection sort
	WRITE (*,*) 'Now doing a bubble sort'
	sortloop1: DO i = nvals -1, 0, -1 !basically we just loop through every element to compare it against every other element
		!this loop increments i which is our starting point for the comparison
		sortloop2:DO j = 1, i, 1
			!this loop increments j which is the ending point for the comparison		
			swapposition: IF ( gt_person(customer_list(j-1),customer_list(j)) )  THEN
				!swap the name here
				temp_person2 = customer_list(j-1)
				customer_list(j-1) = customer_list(j)
				customer_list(j) = temp_person2
			END IF swapposition
		END DO sortloop2
	END DO sortloop1	
	
END SUBROUTINE sort_bubble
LOGICAL FUNCTION gt_person (a, b) !Greater Than Person is what it stands for
	! This function takes a person as the argument and figurs out which sorts out first
	!this is used as part of every sorting method we use
	USE types
	IMPLICIT NONE
	TYPE(person), INTENT(IN)::a,b !grab the arguments and format them to make Fortran happy
	gt_person = .FALSE.!if no other conditions are met then the second person comes first
	!WRITE (*,*) a%last, ' ', b%last
	last: IF (a%last==b%last) THEN !check the last name
		first: IF (a%first==b%first) then !check first name if last is same
			ssn: IF (a%ssn>b%ssn) then  !check SSN if both first and last are same
				gt_person = .TRUE.
				!WRITE (*,*) 'swapped because of ssn'
			END IF ssn
		else
			first2: IF (LLT ( b%first , a%first)) then !checking first if last matches
				gt_person = .TRUE.
				!WRITE (*,*) 'swapped because of first'
			END IF first2
		END IF first
	ELSE
		last2: IF (LLT ( b%last , a%last)) THEN !if nothing else we just check last (LLT adjusts for case sensitivy)
			gt_person = .TRUE.
			!WRITE (*,*) 'swapped because of last'
		END IF last2
	END IF last	
END FUNCTION gt_person
LOGICAL FUNCTION sp (a, b)
	! This function takes a person as the argument and figurs out if they are the same person
	! This function is only used by insertion sort where points make the == operator not work
	USE types
	IMPLICIT NONE
	TYPE(person), INTENT(IN)::a,b !grab the arguments and format them
	IF ((a%first==b%first) .AND. (a%last==b%last) .AND. (a%ssn==b%ssn)) THEN !check to see if the first, last, and ssn are the same
		sp = .TRUE.
	ELSE
		sp = .FALSE.
	END IF
END FUNCTION sp