Here’s something I threw together quickly, based upon a resize
routine by @awvwgk provided here: An API for working with allocatable arrays · Issue #598 · fortran-lang/stdlib · GitHub.
Integer list (click to open)
! intlist.f90
!> Provides "list of integers" type which supports appending
module intlist
implicit none
private
!> List operations
public :: append
public :: asarray
public :: size, capacity
public :: shrink_to_fit
public :: reset
type, public :: intlist_type
private
integer :: size = 0
integer :: remaining = -1
integer, allocatable :: data(:)
end type
!> Append a scalar or an array
interface append
module subroutine append_scalar(list,item)
type(intlist_type), intent(inout) :: list
integer, intent(in) :: item
end subroutine
module subroutine append_array(list,array)
type(intlist_type), intent(inout) :: list
integer, intent(in) :: array(:)
end subroutine
end interface
!> Size of the list
interface size
module integer function intlist_type_size(list)
type(intlist_type), intent(in) :: list
end function
end interface
interface
!> Capacity of the list (maximum number of items it can store)
module integer function capacity(list)
type(intlist_type), intent(in) :: list
end function
!> Return allocatable array containing the list data
module function asarray(list) result(arr)
type(intlist_type), intent(in) :: list
integer, allocatable :: arr(:)
end function
!> Shrink list capacity to match size of data
module subroutine shrink_to_fit(list)
type(intlist_type), intent(inout) :: list
end subroutine
!> Reset list to empty state
module subroutine reset(list)
type(intlist_type), intent(out) :: list
end subroutine
end interface
end module
! intlist_implementation.f90
!
submodule (intlist) intlist_implementation
integer, parameter :: INITIAL_SIZE = 1024
contains
!> Reset list to empty state
module subroutine reset(list)
type(intlist_type), intent(out) :: list
associate(sz => list%size)
! do nothing, just to silence spurious warnings
end associate
end subroutine
module integer function intlist_type_size(list) result(sz)
type(intlist_type), intent(in) :: list
sz = list%size
end function
!> Capacity of the list
module integer function capacity(list)
type(intlist_type), intent(in) :: list
intrinsic :: size
if (allocated(list%data)) then
capacity = size(list%data)
else
capacity = 0
end if
end function
!> Append a scalar
module subroutine append_scalar(list,item)
type(intlist_type), intent(inout) :: list
integer, intent(in) :: item
intrinsic :: size
if (list%remaining < 1) then
call resize_int(list%data)
list%remaining = size(list%data) - list%size
end if
list%data(list%size+1) = item
list%size = list%size + 1
list%remaining = list%remaining - 1
end subroutine
!> Append an array of integer
module subroutine append_array(list,array)
type(intlist_type), intent(inout) :: list
integer, intent(in) :: array(:)
integer :: current, new
intrinsic :: size
if (list%remaining < size(array)) then
current = size(list%data)
new = current + max(size(array),current/2) + 1
call resize_int(list%data, new)
list%remaining = size(list%data) - list%size
end if
list%data(list%size+1:list%size+size(array)) = array
list%size = list%size + size(array)
list%remaining = list%remaining - size(array)
end subroutine
! Return allocatable array containing the list data
module function asarray(list) result(arr)
type(intlist_type), intent(in) :: list
integer, allocatable :: arr(:)
arr = list%data(1:list%size)
end function
!> Shrink list capacity to match size
module subroutine shrink_to_fit(list)
type(intlist_type), intent(inout) :: list
call resize_int(list%data,list%size)
end subroutine
!
! --- Private helper functions ---
!
!> Reallocate list of integers
!> (originally taken from https://github.com/fortran-lang/stdlib/issues/598)
pure subroutine resize_int(var, n)
!> Instance of the array to be resized
integer, allocatable, intent(inout) :: var(:)
!> Dimension of the final array size
integer, intent(in), optional :: n
integer, allocatable :: tmp(:)
integer :: this_size, new_size
intrinsic :: size
if (allocated(var)) then
this_size = size(var, 1)
call move_alloc(var, tmp)
else
this_size = initial_size
end if
if (present(n)) then
new_size = n
else
new_size = this_size + this_size/2 + 1
end if
allocate(var(new_size))
if (allocated(tmp)) then
this_size = min(size(tmp, 1), size(var, 1))
var(:this_size) = tmp(:this_size)
deallocate(tmp)
end if
end subroutine resize_int
end submodule
I haven’t done any testing of the list, so use at your own risk.
Here’s an example of the list in action:
! test_intlist.f90
!
program test_intlist
use intlist, only: intlist_type, append, shrink_to_fit, asarray, &
reset, size, capacity
implicit none
type(intlist_type) :: list
integer, allocatable :: array(:)
integer :: i
do i = 1, 1447
call append(list,i)
end do
print *, "list capacity before shrink = ", capacity(list)
call shrink_to_fit(list)
print *, "list capacity after shrink = ", capacity(list)
array = asarray(list)
print *, "first, last = ", array(1), array(1447)
print *, "array size = ", size(array)
call reset(list)
print *, "list size after reset = ", size(list)
end program
$ ifort -warn all intlist.f90 intlist_impl.f90 test_intlist.f90
$ ./a.out
list capacity before shrink = 1537
list capacity after shrink = 1447
first, last = 1 1447
array size = 1447
list size after reset = 0