代码如下:
Module InsertionSortbyChainTableMod
implicit none
type :: values
real :: val
type( values ), pointer :: next
end type
type( values ), pointer :: head, tail
type( values ), pointer :: ptr, ptr1, ptr2
integer :: istat, fileid, i, n
real :: temp
real, allocatable :: mat(:)
character(len=20) :: fname
contains
subroutine InsertionSortbyChainTable
implicit none
write( *,'(1x,a)' ) 'please input the filename: '
read( *,'(a)' ) fname
open( newunit = fileid, file = trim(fname), iostat = istat )
if ( istat == 0 ) then !.. open file successfully
do
read( fileid, *, iostat = istat ) temp
if ( istat /= 0 ) exit
allocate( ptr, stat = istat )
ptr%val = temp
if ( .not.associated(head) ) then !.. 判断链表表头是否关联
head => ptr
tail => ptr
nullify( ptr%next )
else
if ( ptr%val < head%val ) then !.. 新数据与表头数据比较
!.. add at front of list
ptr%next => head
head => ptr
else if ( ptr%val >= tail%val ) then !.. 新数据与链尾进行比较
!.. add at end of list
tail%next => ptr
tail => ptr
nullify( tail%next )
else !.. 新数据与中间数据比较
!.. find place to add value
ptr1 => head
ptr2 => ptr1%next
search: do
if ( (ptr%val >= ptr1%val) .and. (ptr%val < ptr2%val) ) then
ptr%next => ptr2
ptr1%next => ptr
exit search
end if
ptr1 => ptr2
ptr2 => ptr2%next
end do search
end if
end if
end do
!.. 将链表转化为静态数组
n = 0
ptr => head
do
if ( .not.associated(ptr) ) exit
ptr => ptr%next
n = n + 1
end do
allocate( mat(n) )
!.. write out data
ptr => head
do i = 1, n
if ( .not.associated(ptr) ) exit
mat(i) = ptr%val
ptr => ptr%next
end do
print*, mat
else !.. open file failed
write( *,'(1x,a,g0)' ) 'file open failed--status = ', istat
end if
deallocate( mat )
end subroutine InsertionSortbyChainTable
End module InsertionSortbyChainTableMod
Program main
use InsertionSortbyChainTableMod
implicit none
call InsertionSortbyChainTable
End program main
所需的数据文件名为input.dat
文件数据内容为:
1.1
2.34
0.0
4.6
7.2
5.6
8.2
1.9
4.2
3.3
4.1
执行排序程序,结果如下:
0.0000000E+00
1.100000
1.900000
2.340000
3.300000
4.100000
4.200000
4.600000
5.600000
7.200000
8.200000