319 lines
14 KiB
Fortran
319 lines
14 KiB
Fortran
program example
|
|
implicit none
|
|
call test
|
|
call test2
|
|
end program example
|
|
module ModDoLinkList
|
|
implicit none
|
|
integer, parameter :: sgl=selected_real_kind(p=1)
|
|
type :: doNode
|
|
real(sgl) :: var1
|
|
type(doNode), pointer :: before
|
|
type(doNode), pointer :: next
|
|
end type
|
|
contains
|
|
recursive subroutine DoNodeAdd(newNode, ptr)
|
|
type(doNode), intent(inout), pointer :: newNode
|
|
type(doNode), intent(inout), pointer :: ptr
|
|
if ( .not. associated(newNode) ) stop ""
|
|
if ( associated(ptr) ) then
|
|
if ( associated(ptr%next) ) then
|
|
call DoNodeAdd(newNode, ptr%next)
|
|
else
|
|
ptr%next => newNode
|
|
newNode%before => ptr
|
|
end if
|
|
else
|
|
ptr => newNode
|
|
end if
|
|
end subroutine DoNodeAdd
|
|
subroutine test1(value, ptr)
|
|
type(doNode), intent(inout), target :: value
|
|
type(doNode), intent(inout), pointer :: ptr
|
|
type(doNode), pointer :: temp => null()
|
|
type(doNode), target :: a
|
|
type(doNode), pointer :: newNode => null()
|
|
allocate(newNode)
|
|
newNode%var1 = 200.
|
|
newNode%before => null()
|
|
newNode%next => null()
|
|
a%var1 = 100.
|
|
a%before => null()
|
|
a%next => null()
|
|
temp => value%before
|
|
temp%next => a
|
|
write(*, *)
|
|
write(*, *) '如果传递的是值, 则 ', value%var1
|
|
temp => ptr%before
|
|
ptr%before%next => a
|
|
write(*, *) '如果传递的是指针, 则 ', ptr%var1
|
|
newNode%before => ptr ! 插入结点前指针 => 操作结点
|
|
temp => ptr%next
|
|
temp%before => newNode ! 操作结点后指针指向的结点的前指针 => 插入结点
|
|
newNode%next => temp ! 插入结点的后指针 => 操作结点后指针指向的结点
|
|
ptr%next => newNode
|
|
end subroutine
|
|
recursive subroutine DoNodeSortForword(newNode, ptr) ! 向前排序
|
|
implicit none
|
|
type(doNode), intent(inout), target :: newNode ! 插入结点
|
|
type(doNode), intent(inout), target :: ptr ! 操作结点
|
|
type(doNode), pointer :: temp
|
|
write(*, *) '当前操作结点为: ', ptr%var1, '; 当前插入结点为:', newNode%var1
|
|
! if ( .not. associated(newNode) ) then ! 如果插入结点未关联
|
|
! stop "" ! 报错退出
|
|
! else ! 如果插入结点已关联
|
|
write(*, *) ' 插入结点存在'
|
|
if ( newNode%var1 < ptr%var1 ) then ! 如果插入结点值比操作结点值小
|
|
write(*, *) ' 插入结点值小于操作结点值'
|
|
if ( associated(ptr%before) ) then ! 如果操作结点前指针已关联
|
|
write(*, *) ' 由于操作结点值前指针已关联, 检测前一结点'
|
|
call DoNodeSortForword(newNode, ptr%before) ! 递归调用
|
|
else ! 如果操作结点前指针为空
|
|
write(*, *) ' 由于操作结点值前指针未关联, 则在最前端插入插入节点'
|
|
ptr%before => newNode ! 操作结点前指针 => 插入结点
|
|
newNode%next => ptr ! 插入结点后指针 => 操作节点
|
|
end if
|
|
else ! 如果插入结点值比操作结点值大
|
|
write(*, *) ' 插入结点值大于操作结点值, 将结点插入操作结点之后'
|
|
newNode%before => ptr ! 插入结点前指针 => 操作结点
|
|
write(*, *) ' 插入结点前指针指向: ', newNode%before%var1
|
|
temp => ptr%next
|
|
! ptr%next => newNode ! 操作结点的后指针 => 插入结点
|
|
temp%before => newNode ! 操作结点后指针指向的结点的前指针 => 插入结点
|
|
write(*, *) ' 操作结点后结点前指针指向:', temp%before%var1
|
|
newNode%next => temp ! 插入结点的后指针 => 操作结点后指针指向的结点
|
|
write(*, *) ' 插入结点后指针指向: ', newNode%next%var1
|
|
ptr%next => newNode
|
|
write(*, *) ' 操作结点后指针指向: ', ptr%next%var1
|
|
end if
|
|
! if ( .not. associated(ptr) ) then ! 如果操作结点前指针为空
|
|
! write(*, '(A)', advance='no') '10'
|
|
! ptr%before => newNode !
|
|
! newNode%next => ptr
|
|
! else
|
|
! write(*, '(A)', advance='no') '11'
|
|
! if ( newNode%var1 < ptr%var1 ) then
|
|
! call DoNodeSortForword(newNode, ptr%before)
|
|
! else
|
|
! newNode%before => ptr
|
|
! ptr%next%before => newNode
|
|
! newNode%next => ptr%next
|
|
! ptr%next => newNode
|
|
! end if
|
|
! end if
|
|
! newNode => null()
|
|
call DoNodePrint1(ptr)
|
|
write(*, *)
|
|
! ptr => null()
|
|
! end if
|
|
end subroutine DoNodeSortForword
|
|
recursive subroutine DoNodeSortForword1(newNode, ptr) ! 向前排序
|
|
implicit none
|
|
type(doNode), intent(in), pointer :: newNode ! 插入结点
|
|
type(doNode), intent(in), pointer :: ptr ! 操作结点
|
|
type(doNode), pointer :: temp
|
|
write(*, *) '当前操作结点为: ', ptr%var1, '; 当前插入结点为:', newNode%var1
|
|
if ( .not. associated(newNode) ) then ! 如果插入结点未关联
|
|
stop "" ! 报错退出
|
|
else ! 如果插入结点已关联
|
|
write(*, *) ' 插入结点存在'
|
|
if ( newNode%var1 < ptr%var1 ) then ! 如果插入结点值比操作结点值小
|
|
write(*, *) ' 插入结点值小于操作结点值'
|
|
if ( associated(ptr%before) ) then ! 如果操作结点前指针已关联
|
|
write(*, *) ' 由于操作结点值前指针已关联, 检测前一结点'
|
|
call DoNodeSortForword1(newNode, ptr%before) ! 递归调用
|
|
else ! 如果操作结点前指针为空
|
|
write(*, *) ' 由于操作结点值前指针未关联, 则在最前端插入插入节点'
|
|
ptr%before => newNode ! 操作结点前指针 => 插入结点
|
|
newNode%next => ptr ! 插入结点后指针 => 操作节点
|
|
end if
|
|
else ! 如果插入结点值比操作结点值大
|
|
! write(*, *) ' 插入结点值大于操作结点值, 将结点插入操作结点之后'
|
|
! newNode%before => ptr ! 插入结点前指针 => 操作结点
|
|
! write(*, *) ' 插入结点前指针指向: ', newNode%before%var1
|
|
! temp => ptr%next
|
|
! ptr%next => newNode ! 操作结点的后指针 => 插入结点
|
|
! ptr%next%before => newNode ! 操作结点后指针指向的结点的前指针 => 插入结点
|
|
! write(*, *) ' 操作结点后结点前指针指向:', temp%before%var1
|
|
! newNode%next => ptr%next ! 插入结点的后指针 => 操作结点后指针指向的结点
|
|
! write(*, *) ' 插入结点后指针指向: ', newNode%next%var1
|
|
! ptr%next => newNode
|
|
! write(*, *) ' 操作结点后指针指向: ', ptr%next%var1
|
|
!
|
|
! newNode%before => ptr
|
|
! newNode%next => ptr%next
|
|
! ptr%next => newNode
|
|
! newNode%next%before => newNode
|
|
!
|
|
write(*, *) ptr%next%var1
|
|
newNode%before => ptr
|
|
write(*, *) ptr%next%var1
|
|
temp => ptr%next
|
|
write(*, *) ptr%next%var1
|
|
! temp%before => newNode
|
|
write(*, *) ptr%next%var1
|
|
newNode%next => ptr%next
|
|
write(*, *) ptr%next%var1
|
|
! ptr%next => newNode
|
|
newNode%next%before => newNode
|
|
! ptr%next%before => newNode
|
|
write(*, *) ptr%next%var1
|
|
ptr%next => newNode
|
|
write(*, *) ptr%next%var1, newNode%next%var1
|
|
end if
|
|
call DoNodePrint1(ptr)
|
|
write(*, *)
|
|
end if
|
|
end subroutine DoNodeSortForword1
|
|
recursive subroutine DoNodePrint(ptr)
|
|
type(doNode), intent(in), pointer :: ptr
|
|
if ( associated(ptr) ) then
|
|
write(*, '(F6.2)', advance='no') ptr%var1
|
|
call DoNodePrint(ptr%next)
|
|
end if
|
|
end subroutine DoNodePrint
|
|
recursive subroutine DoNodePrint1(ptr)
|
|
type(doNode), intent(in), pointer :: ptr
|
|
if ( associated(ptr) ) then
|
|
write(*, '(F6.2)', advance='no') ptr%var1
|
|
call DoNodePrint1(ptr%before)
|
|
end if
|
|
end subroutine DoNodePrint1
|
|
end module ModDoLinkList
|
|
subroutine Test
|
|
use ModDoLinkList
|
|
implicit none
|
|
type(doNode), pointer :: newNode => null()
|
|
type(doNode), pointer :: head => null()
|
|
type(doNode), pointer :: tail => null()
|
|
type(doNode), pointer :: ptr => null()
|
|
real(sgl) :: temp
|
|
integer :: i
|
|
integer :: errorLevel
|
|
do i = 1, 21
|
|
allocate(newNode)
|
|
newNode%var1 = real(i)
|
|
newNode%before => null()
|
|
newNode%next => null()
|
|
if ( .not. associated(head) ) head => newNode
|
|
! if ( .not. associated(head) ) then
|
|
! head => newNode
|
|
! write(*, *) '已插入首结点 ', newNode%var1
|
|
! else
|
|
! call DoNodeAdd(newNode, head)
|
|
! write(*, *) '已插入结点 ', newNode%var1
|
|
! end if
|
|
call DoNodeAdd(newNode, tail)
|
|
tail => newNode
|
|
end do
|
|
allocate(newNode)
|
|
newNode%var1 = 17.5
|
|
newNode%before => null()
|
|
newNode%next => null()
|
|
ptr => head
|
|
do
|
|
if ( associated(ptr) ) then
|
|
write(*, '(F6.2)', advance='no') ptr%var1
|
|
ptr => ptr%next
|
|
else
|
|
exit
|
|
end if
|
|
end do
|
|
write(*, *)
|
|
ptr => tail
|
|
call DoNodeSortForword1(newNode, ptr)
|
|
call DoNodePrint(head)
|
|
write(*, *)
|
|
call DoNodePrint1(tail)
|
|
write(*, *)
|
|
do
|
|
if ( associated(head%before) ) then
|
|
head => head%before
|
|
else
|
|
exit
|
|
end if
|
|
end do
|
|
ptr => tail
|
|
ptr => head
|
|
write(*, *)
|
|
do
|
|
if ( associated(ptr) ) then
|
|
write(*, '(F6.2)', advance='no') ptr%var1
|
|
! write(*, *) '当前结点值为:', ptr%var1, '; 下一结点值为:', ptr%before%var1
|
|
! ptr => ptr%before
|
|
ptr => ptr%next
|
|
else
|
|
exit
|
|
end if
|
|
end do
|
|
ptr => tail%before
|
|
call test1(ptr, ptr)
|
|
write(*, *) ptr%before%var1, ptr%var1, ptr%next%var1, ptr%next%next%var1
|
|
end subroutine Test
|
|
subroutine test2
|
|
use ModDoLinkList
|
|
integer :: i
|
|
type(doNode), pointer :: newNode
|
|
type(doNode), pointer :: head
|
|
type(doNode), pointer :: middle
|
|
type(doNode), pointer :: tail
|
|
type(doNode), pointer :: ptr
|
|
allocate(newNode)
|
|
newNode%var1 = 1.
|
|
newNode%before => null()
|
|
newNode%next => null()
|
|
head => newNode
|
|
allocate(newNode)
|
|
newNode%var1 = 2.
|
|
newNode%before => null()
|
|
newNode%next => null()
|
|
head%next => newNode
|
|
newNode%before => head
|
|
middle => newNode
|
|
allocate(newNode)
|
|
newNode%var1 = 3.
|
|
newNode%before => null()
|
|
newNode%next => null()
|
|
middle%next => newNode
|
|
newNode%before => middle
|
|
tail => newNode
|
|
write(*, *) head%var1, middle%var1, tail%var1
|
|
! head%next => tail
|
|
! write(*, *) head%next%var1, middle%var1
|
|
! head%next%next => head
|
|
! write(*, *) head%next%next%var1, middle%next%var1, tail%var1
|
|
! ptr => head%next
|
|
! head%next => tail
|
|
! middle%var1 = 4.
|
|
! write(*, *) ptr%var1, head%next%var1
|
|
allocate(newNode)
|
|
newNode%var1 = 4.
|
|
newNode%before => null()
|
|
newNode%next => null()
|
|
newNode%before => middle
|
|
newNode%next => middle%next
|
|
! middle%next => newNode
|
|
! newNode%next%before => newNode
|
|
middle%next%before => newNode
|
|
middle%next => newNode
|
|
ptr => head
|
|
do
|
|
if ( associated(ptr) ) then
|
|
write(*, '(F10.2)', advance='no') ptr%var1
|
|
ptr => ptr%next
|
|
else
|
|
exit
|
|
end if
|
|
end do
|
|
write(*, *)
|
|
ptr => tail
|
|
do
|
|
if ( associated(ptr) ) then
|
|
write(*, '(F10.2)', advance='no') ptr%var1
|
|
ptr => ptr%before
|
|
else
|
|
exit
|
|
end if
|
|
end do
|
|
write(*, *)
|
|
end subroutine |