mirror of
https://github.com/VictorEijkhout/TheArtOfHPC_vol3_cppf08programming.git
synced 2026-01-24 22:44:48 +09:00
127 lines
3.3 KiB
Fortran
127 lines
3.3 KiB
Fortran
!****************************************************************
|
|
!***
|
|
!*** This file belongs with the course
|
|
!*** Introduction to Scientific Programming in C++/Fortran2003
|
|
!*** copyright 2017-2021 Victor Eijkhout eijkhout@tacc.utexas.edu
|
|
!***
|
|
!*** listf.F90 : linked list basics in Fortran
|
|
!***
|
|
!****************************************************************
|
|
|
|
Program LinkedList
|
|
|
|
implicit none
|
|
|
|
type node
|
|
integer :: value
|
|
type(node),pointer :: next
|
|
end type node
|
|
|
|
type list
|
|
type(node),pointer :: head
|
|
end type list
|
|
|
|
integer,parameter :: listsize=7
|
|
type(list) :: the_list
|
|
integer,dimension(listsize) :: inputs = &
|
|
[ 62, 75, 51, 12, 14, 15, 16 ]
|
|
integer :: in,in_value
|
|
|
|
nullify(the_list%head)
|
|
!!codesnippet linklistfinsert
|
|
do in=1,listsize
|
|
in_value = inputs(in)
|
|
call insert(the_list,in_value)
|
|
call print(the_list)
|
|
end do
|
|
!!codesnippet end
|
|
|
|
contains
|
|
|
|
subroutine insert( the_list,value )
|
|
implicit none
|
|
! parameters
|
|
type(list),intent(inout) :: the_list
|
|
integer,intent(in) :: value
|
|
! local
|
|
type(node),pointer :: current,new_node
|
|
|
|
if (.not.associated(the_list%head)) then
|
|
! case: empty list
|
|
allocate(new_node); new_node%value = value; nullify(new_node%next);
|
|
the_list%head => new_node
|
|
else if (value<the_list%head%value) then
|
|
! case: before list head
|
|
allocate(new_node)
|
|
new_node%value = value; new_node%next => the_list%head
|
|
the_list%head => new_node
|
|
else
|
|
! case somewhere in the list
|
|
current => the_list%head
|
|
do
|
|
if ( value > current%value ) then
|
|
if ( associated(current%next) ) then
|
|
! case: between current and next
|
|
if ( value<current%next%value ) &
|
|
exit
|
|
else
|
|
! case: current is end of the list
|
|
exit
|
|
end if
|
|
end if
|
|
current => current%next
|
|
end do
|
|
|
|
if (current%value==value) then
|
|
return
|
|
else if (.not.associated(current%next)) then
|
|
allocate(new_node); new_node%value = value
|
|
nullify(new_node%next)
|
|
current%next => new_node
|
|
else if (value<current%next%value) then
|
|
allocate(new_node); new_node%value = value
|
|
new_node%next => current%next
|
|
current%next => new_node
|
|
end if
|
|
end if
|
|
|
|
end subroutine insert
|
|
|
|
integer function length( the_list )
|
|
implicit none
|
|
type(list),intent(in) :: the_list
|
|
! local
|
|
type(node),pointer :: current
|
|
|
|
if (.not.associated(the_list%head)) then
|
|
length = 0
|
|
else
|
|
current => the_list%head
|
|
do
|
|
length = length+1
|
|
if (.not.associated(current%next)) exit
|
|
current => current%next
|
|
end do
|
|
end if
|
|
end function length
|
|
|
|
subroutine print(the_list)
|
|
implicit none
|
|
type(list),intent(in) :: the_list
|
|
type(node),pointer :: current
|
|
|
|
write(*,'("List: [ ")',advance="no")
|
|
if (associated(the_list%head)) then
|
|
current => the_list%head
|
|
do while (associated(current))
|
|
write(*,'(i3,1x)',advance="no") current%value
|
|
if (.not.associated(current%next)) exit
|
|
current => current%next
|
|
end do
|
|
end if
|
|
write(*,'(x"]")')
|
|
|
|
end subroutine print
|
|
|
|
end Program LinkedList
|