t-nissieの日記: singly linked list in Fortran 95 (改訂第3版)
日記 by
t-nissie
他人の書いた新しくて古いFortranのプログラム(COMMON文のかわりにMODULEを使っている
だけ。結局、大域変数の誤用。さらにsubroutineの引数が30個くらいある。はぁ。)を
デバグしていてイヤになったので、以前に書いたsingly linked listを改訂してみました。
以前のは消します。(さらに第2版に誤りがあったので、第3版に書き換えました。)
= Fortran 95 による1方向リンクト・リスト (singly linked list)
Fortran 95 で1方向リンクト・リスト (singly linked list) を書く場合、
データを持たないルートノードを用いて、それを「list」とするのが便利。
== 凡例
□□□ … データフィールド
■ … ポインタ (リンク)
□□□■ … ノード
空空空■ … データフィールドに意味のあるものが入っていないノード
□□□N … ポインタがnullifyされているノード
== 初期状態
空空空N … ルートノード「list」
== リスト
空空空■ … ルートノード「list」
┌──┘
↓
□□□■ … ノードその1
┌──┘
↓
□□□■ … ノードその2
┌──┘
↓
□□□N … ノードその3
== Makefile
# Makefile for list
# Time-stamp: <2007-01-03 17:21:12 t-nissie>
##
FC = g95
FFLAGS = -Wall -ffree-form -g -O1
#FC = ifort
#FFLAGS = -FR
all: linkedlist
linkedlist: linkedlist.o node_module.o
$(FC) $(FFLAGS) -o $@ $^
linkedlist.o bar_module.o: node_module.o
# Additional rules for the pretty printing:
%.pdf: %.ps
ps2pdf -sPAPERSIZE=letter $< $@
%.ps: %.f
LANG=C a2ps --prologue=color --portrait --columns=1 \
--margin=3 --borders=off --medium=Letter\
-f 10.5 --pretty-print=for90-free -o - $< | PsDuplex > $@
clean:
rm -f *.ps *.pdf core *.o *.mod linkedlist
== node_module.f
! node_module.f -*-f90-*-
! Time-stamp: <2007-01-03 17:22:04 t-nissie>
! Disadvantage: Copy in list_unshift() and list_push().
!!
module Node_module
implicit none
type Node_type
character(len=100) :: str100 = ''
type(Node_type), pointer :: next => null()
end type Node_type
!!! Fortran 2003 feature
! type extends(Node_type) :: List_type
! contains
! final :: list_destruct
! end type List_type
contains
subroutine list_destruct(list)
implicit none
type(Node_type), intent(in) :: list
type(Node_type), pointer :: current_node, next_node
next_node => list%next
do while (associated(next_node))
current_node => next_node
next_node => next_node%next
deallocate(current_node)
end do
end subroutine list_destruct
subroutine list_unshift(list, unshift)
implicit none
type(Node_type), intent(inout) :: list
type(Node_type), intent(in) :: unshift
type(Node_type), pointer :: tmp
allocate(tmp)
tmp = unshift ! Copy.
tmp%next => list%next
list%next => tmp
end subroutine list_unshift
subroutine list_push(list, push)
implicit none
type(Node_type), target, intent(inout) :: list
type(Node_type), intent(in) :: push
type(Node_type), pointer :: p_node
p_node => list
do while (associated(p_node%next))
p_node => p_node%next
end do
allocate(p_node%next) ! Insert a new node.
p_node%next = push ! Copy.
nullify(p_node%next%next)
end subroutine list_push
subroutine list_shift(list, shift)
implicit none
type(Node_type), intent(inout) :: list
type(Node_type), pointer, intent(out) :: shift
if (.not.associated(list%next)) then
nullify(shift)
else
shift => list%next
list%next => list%next%next
end if
end subroutine list_shift
subroutine list_pop(list, pop)
implicit none
type(Node_type), target, intent(in) :: list
type(Node_type), pointer, intent(out) :: pop
type(Node_type), pointer :: p_node
if (.not.associated(list%next)) then
nullify(pop)
else
p_node => list
do while (associated(p_node%next%next))
p_node => p_node%next
end do
pop => p_node%next
nullify(p_node%next)
end if
end subroutine list_pop
integer function list_count(list)
implicit none
type(Node_type), intent(in) :: list
type(Node_type), pointer :: p_node
list_count = 0
p_node => list%next
do while (associated(p_node))
list_count = list_count + 1
p_node => p_node%next
end do
end function list_count
logical function list_each(p_node)
implicit none
type(Node_type), pointer, intent(inout) :: p_node
p_node => p_node%next
list_each = associated(p_node)
end function list_each
logical function list_each_with_index(i_node,i)
implicit none
type(Node_type), pointer, intent(inout) :: i_node
integer, intent(inout) :: i
i_node => i_node%next
i = i + 1
list_each_with_index = associated(i_node)
end function list_each_with_index
end module Node_module
== linkedlist.f
! linkedlist.f -*-f90-*-
! Time-stamp: <2007-01-03 17:24:24 t-nissie>
!!
program linkedlist
use Node_module
implicit none
type(Node_type), target :: list
type(Node_type), pointer :: p_node, i_node, j_node
integer i,j
write(6,'(a,i1)') 'list_count = ', list_count(list)
call list_pop(list, p_node)
if (associated(p_node)) stop 'There is something wrong in list_pop.'
call list_shift(list, p_node)
if (associated(p_node)) stop 'There is something wrong in list_shift.'
call list_push(list, Node_type('abcdefg'))
call list_push(list, Node_type('hijklmn'))
call list_push(list, Node_type('opqrstu'))
write(6,'(a,i1)') 'list_count = ', list_count(list)
p_node => list
do while(list_each(p_node))
write(6,'(a)') trim(p_node%str100)
end do
call list_pop(list, p_node)
write(6,'(2a)') 'popped node = ', trim(p_node%str100)
deallocate(p_node)
j_node => list
j=0
do while(list_each_with_index(j_node,j))
i_node => list
i=0
do while(list_each_with_index(i_node,i))
write(6,'(i1i2,4a)') i, j, &
' ', trim(i_node%str100), &
' ', trim(j_node%str100)
end do
end do
call list_unshift(list, Node_type('ABCDEFG'))
i_node => list
i=0
do while(list_each_with_index(i_node,i))
write(6,'(i1,2a)') i, ' ', trim(i_node%str100)
end do
call list_shift(list, p_node)
write(6,'(2a)') 'shifted node = ', trim(p_node%str100)
deallocate(p_node)
call list_destruct(list)
end program linkedlist
だけ。結局、大域変数の誤用。さらにsubroutineの引数が30個くらいある。はぁ。)を
デバグしていてイヤになったので、以前に書いたsingly linked listを改訂してみました。
以前のは消します。(さらに第2版に誤りがあったので、第3版に書き換えました。)
= Fortran 95 による1方向リンクト・リスト (singly linked list)
Fortran 95 で1方向リンクト・リスト (singly linked list) を書く場合、
データを持たないルートノードを用いて、それを「list」とするのが便利。
== 凡例
□□□ … データフィールド
■ … ポインタ (リンク)
□□□■ … ノード
空空空■ … データフィールドに意味のあるものが入っていないノード
□□□N … ポインタがnullifyされているノード
== 初期状態
空空空N … ルートノード「list」
== リスト
空空空■ … ルートノード「list」
┌──┘
↓
□□□■ … ノードその1
┌──┘
↓
□□□■ … ノードその2
┌──┘
↓
□□□N … ノードその3
== Makefile
# Makefile for list
# Time-stamp: <2007-01-03 17:21:12 t-nissie>
##
FC = g95
FFLAGS = -Wall -ffree-form -g -O1
#FC = ifort
#FFLAGS = -FR
all: linkedlist
linkedlist: linkedlist.o node_module.o
$(FC) $(FFLAGS) -o $@ $^
linkedlist.o bar_module.o: node_module.o
# Additional rules for the pretty printing:
%.pdf: %.ps
ps2pdf -sPAPERSIZE=letter $< $@
%.ps: %.f
LANG=C a2ps --prologue=color --portrait --columns=1 \
--margin=3 --borders=off --medium=Letter\
-f 10.5 --pretty-print=for90-free -o - $< | PsDuplex > $@
clean:
rm -f *.ps *.pdf core *.o *.mod linkedlist
== node_module.f
! node_module.f -*-f90-*-
! Time-stamp: <2007-01-03 17:22:04 t-nissie>
! Disadvantage: Copy in list_unshift() and list_push().
!!
module Node_module
implicit none
type Node_type
character(len=100) :: str100 = ''
type(Node_type), pointer :: next => null()
end type Node_type
!!! Fortran 2003 feature
! type extends(Node_type) :: List_type
! contains
! final :: list_destruct
! end type List_type
contains
subroutine list_destruct(list)
implicit none
type(Node_type), intent(in) :: list
type(Node_type), pointer :: current_node, next_node
next_node => list%next
do while (associated(next_node))
current_node => next_node
next_node => next_node%next
deallocate(current_node)
end do
end subroutine list_destruct
subroutine list_unshift(list, unshift)
implicit none
type(Node_type), intent(inout) :: list
type(Node_type), intent(in) :: unshift
type(Node_type), pointer :: tmp
allocate(tmp)
tmp = unshift ! Copy.
tmp%next => list%next
list%next => tmp
end subroutine list_unshift
subroutine list_push(list, push)
implicit none
type(Node_type), target, intent(inout) :: list
type(Node_type), intent(in) :: push
type(Node_type), pointer :: p_node
p_node => list
do while (associated(p_node%next))
p_node => p_node%next
end do
allocate(p_node%next) ! Insert a new node.
p_node%next = push ! Copy.
nullify(p_node%next%next)
end subroutine list_push
subroutine list_shift(list, shift)
implicit none
type(Node_type), intent(inout) :: list
type(Node_type), pointer, intent(out) :: shift
if (.not.associated(list%next)) then
nullify(shift)
else
shift => list%next
list%next => list%next%next
end if
end subroutine list_shift
subroutine list_pop(list, pop)
implicit none
type(Node_type), target, intent(in) :: list
type(Node_type), pointer, intent(out) :: pop
type(Node_type), pointer :: p_node
if (.not.associated(list%next)) then
nullify(pop)
else
p_node => list
do while (associated(p_node%next%next))
p_node => p_node%next
end do
pop => p_node%next
nullify(p_node%next)
end if
end subroutine list_pop
integer function list_count(list)
implicit none
type(Node_type), intent(in) :: list
type(Node_type), pointer :: p_node
list_count = 0
p_node => list%next
do while (associated(p_node))
list_count = list_count + 1
p_node => p_node%next
end do
end function list_count
logical function list_each(p_node)
implicit none
type(Node_type), pointer, intent(inout) :: p_node
p_node => p_node%next
list_each = associated(p_node)
end function list_each
logical function list_each_with_index(i_node,i)
implicit none
type(Node_type), pointer, intent(inout) :: i_node
integer, intent(inout) :: i
i_node => i_node%next
i = i + 1
list_each_with_index = associated(i_node)
end function list_each_with_index
end module Node_module
== linkedlist.f
! linkedlist.f -*-f90-*-
! Time-stamp: <2007-01-03 17:24:24 t-nissie>
!!
program linkedlist
use Node_module
implicit none
type(Node_type), target :: list
type(Node_type), pointer :: p_node, i_node, j_node
integer i,j
write(6,'(a,i1)') 'list_count = ', list_count(list)
call list_pop(list, p_node)
if (associated(p_node)) stop 'There is something wrong in list_pop.'
call list_shift(list, p_node)
if (associated(p_node)) stop 'There is something wrong in list_shift.'
call list_push(list, Node_type('abcdefg'))
call list_push(list, Node_type('hijklmn'))
call list_push(list, Node_type('opqrstu'))
write(6,'(a,i1)') 'list_count = ', list_count(list)
p_node => list
do while(list_each(p_node))
write(6,'(a)') trim(p_node%str100)
end do
call list_pop(list, p_node)
write(6,'(2a)') 'popped node = ', trim(p_node%str100)
deallocate(p_node)
j_node => list
j=0
do while(list_each_with_index(j_node,j))
i_node => list
i=0
do while(list_each_with_index(i_node,i))
write(6,'(i1i2,4a)') i, j, &
' ', trim(i_node%str100), &
' ', trim(j_node%str100)
end do
end do
call list_unshift(list, Node_type('ABCDEFG'))
i_node => list
i=0
do while(list_each_with_index(i_node,i))
write(6,'(i1,2a)') i, ' ', trim(i_node%str100)
end do
call list_shift(list, p_node)
write(6,'(2a)') 'shifted node = ', trim(p_node%str100)
deallocate(p_node)
call list_destruct(list)
end program linkedlist
singly linked list in Fortran 95 (改訂第3版) More ログイン