Program msort
 Use linked_list
 Implicit None
 Character (Len = 20) :: filename
 Integer :: i, j, k, status, numvals
 Type (int_list), Pointer :: head, tail, ans

 nullify(head)
 numvals = 0
 Write (*,'(A)',Advance='no') 'Enter file name: '
 Read (*,*) filename
 open(unit=9,file=filename,status='old')
 write (*,*) 'file opened ok.'  
 do
    read (9,*,iostat=status) I  
    if (status /= 0) EXIT ! file is over
    write(*,*) 'read: ', i
    numvals = numvals + 1
    if (numvals == 1) then   ! create first element yourself
      allocate(head, stat=status)
      tail => head
      tail%value = i
      nullify(tail%next)
   else
     call tailappend_list(tail, i)
   end if
 end do
! now we have read in  numvals  integers into list pointed to by head.
! proceed to sort them.
  write (*,*) 'Initial list is as follows:'
  call show_list(head)
  call merge_sort(head,ans)
  write (*,*) 'Sorted list is as follows:'
  call show_list(ans)  ! print the sorted list

contains

Recursive Subroutine merge_sort(l1,ans)
! Use linked_list
 Implicit None
 Type (int_list), Pointer ::  l1, ans
 Type (int_list), Pointer ::  p1, p2, ans1, ans2
 write (*,*) 'msort called with: '
 call show_list(l1)
 if (list_length(l1) == 1) then
     ans => l1
 else
  call   split(l1, p1, p2)
  call   merge_sort(p1,ans1)
  call   merge_sort(p2,ans2)
  call   lmerge(ans1,ans2,ans)
end if
end Subroutine merge_sort

Subroutine split(l, p1, p2)
! Use linked_list
 Implicit None
 Type (int_list), Pointer :: l, p1, p2, tmp
 Integer :: n, mid, ctr
 n = list_length(l)
 mid = (n + 1) / 2 !this many elements in first part
 p1 => l
 tmp => l
 ctr = 1
 do
    if (ctr == mid) then
       p2 => tmp%next
       nullify(tmp%next)
       exit
    else
       tmp => tmp%next
       ctr = ctr + 1
    end if
 end do
end Subroutine split

Subroutine lmerge(l1, l2, ans)
! Use linked_list
 Implicit None
 Type (int_list), Pointer :: ans, l1, l2, p1, p2, tmp
 write(*,*) 'Merging the lists: '
 call show_list(l1)
 call show_list(l2)
 if (l1%value < l2%value) then
    p1 => l1
    p2 => l2
 else
    p1 => l2
    p2 => l1
 end if
 ans => p1
 do
   if (.not. associated(p1%next)) then
      p1%next => p2
      exit
   end if
   if (p1%next%value < p2%value) then
      p1 => p1%next
   else
      tmp => p2      !   p1 -> 3 4 5 22 ....
      p2 => p1%next  !   p2 -> 7 11 ....
      p1%next => tmp
      p1 => tmp
!!!!!
!  alternative way to swap
!      tmp => p1%next        !  3 4 5 7 11 ...
!                                    p1 points to 7
!                            ! p2 -> 22 .......
!      p1%next => p2
!      p1 => p2
!      p2 => tmp
!!!!
   end if
end do
 write(*,*) 'Merged ans is: '
 call show_list(ans)
end Subroutine lmerge

End Program msort





