! fpp types module growing_buffers use constants, only: int32, int64, dp use fortran_strings, only: Token_t implicit none private public :: buffer_real_1D_t !> @brief !> Re-sizeable array type that can be filled elementwise to build up a contiguous data chunk !> that can then be dumped to an allocatable !> !> @details !> For multidimensional buffers only the last dimension can grow. !> (i.e. it is only possible to add columns.) !> !> The buffer has to be initiliazed before first use. !> After dumping (`dump_reset`) it is automatically resetted. type :: buffer_real_1D_t private real(dp), dimension(:), allocatable :: buf ! Internal position of the buffer integer(int64) :: pos real(dp) :: grow_factor = 1.5_dp integer(int64) :: start_size = 100_int64 contains procedure :: init => init_real_1D procedure :: finalize => finalize_real_1D procedure, private :: reset => reset_real_1D procedure :: size => get_size_real_1D procedure :: capacity => get_capacity_real_1D procedure :: push_back => add_val_real_1D procedure, private :: dump => dump_real_1D procedure :: dump_reset => dump_reset_real_1D end type buffer_real_1D_t public :: buffer_hel_1D_t !> @brief !> Re-sizeable array type that can be filled elementwise to build up a contiguous data chunk !> that can then be dumped to an allocatable !> !> @details !> For multidimensional buffers only the last dimension can grow. !> (i.e. it is only possible to add columns.) !> !> The buffer has to be initiliazed before first use. !> After dumping (`dump_reset`) it is automatically resetted. type :: buffer_hel_1D_t private HElement_t(dp), dimension(:), allocatable :: buf ! Internal position of the buffer integer(int64) :: pos real(dp) :: grow_factor = 1.5_dp integer(int64) :: start_size = 100_int64 contains procedure :: init => init_hel_1D procedure :: finalize => finalize_hel_1D procedure, private :: reset => reset_hel_1D procedure :: size => get_size_hel_1D procedure :: capacity => get_capacity_hel_1D procedure :: push_back => add_val_hel_1D procedure, private :: dump => dump_hel_1D procedure :: dump_reset => dump_reset_hel_1D end type buffer_hel_1D_t public :: buffer_int_1D_t !> @brief !> Re-sizeable array type that can be filled elementwise to build up a contiguous data chunk !> that can then be dumped to an allocatable !> !> @details !> For multidimensional buffers only the last dimension can grow. !> (i.e. it is only possible to add columns.) !> !> The buffer has to be initiliazed before first use. !> After dumping (`dump_reset`) it is automatically resetted. type :: buffer_int_1D_t private integer, dimension(:), allocatable :: buf ! Internal position of the buffer integer(int64) :: pos real(dp) :: grow_factor = 1.5_dp integer(int64) :: start_size = 100_int64 contains procedure :: init => init_int_1D procedure :: finalize => finalize_int_1D procedure, private :: reset => reset_int_1D procedure :: size => get_size_int_1D procedure :: capacity => get_capacity_int_1D procedure :: push_back => add_val_int_1D procedure, private :: dump => dump_int_1D procedure :: dump_reset => dump_reset_int_1D end type buffer_int_1D_t public :: buffer_int32_1D_t !> @brief !> Re-sizeable array type that can be filled elementwise to build up a contiguous data chunk !> that can then be dumped to an allocatable !> !> @details !> For multidimensional buffers only the last dimension can grow. !> (i.e. it is only possible to add columns.) !> !> The buffer has to be initiliazed before first use. !> After dumping (`dump_reset`) it is automatically resetted. type :: buffer_int32_1D_t private integer(int32), dimension(:), allocatable :: buf ! Internal position of the buffer integer(int64) :: pos real(dp) :: grow_factor = 1.5_dp integer(int64) :: start_size = 100_int64 contains procedure :: init => init_int32_1D procedure :: finalize => finalize_int32_1D procedure, private :: reset => reset_int32_1D procedure :: size => get_size_int32_1D procedure :: capacity => get_capacity_int32_1D procedure :: push_back => add_val_int32_1D procedure, private :: dump => dump_int32_1D procedure :: dump_reset => dump_reset_int32_1D end type buffer_int32_1D_t public :: buffer_int64_1D_t !> @brief !> Re-sizeable array type that can be filled elementwise to build up a contiguous data chunk !> that can then be dumped to an allocatable !> !> @details !> For multidimensional buffers only the last dimension can grow. !> (i.e. it is only possible to add columns.) !> !> The buffer has to be initiliazed before first use. !> After dumping (`dump_reset`) it is automatically resetted. type :: buffer_int64_1D_t private integer(int64), dimension(:), allocatable :: buf ! Internal position of the buffer integer(int64) :: pos real(dp) :: grow_factor = 1.5_dp integer(int64) :: start_size = 100_int64 contains procedure :: init => init_int64_1D procedure :: finalize => finalize_int64_1D procedure, private :: reset => reset_int64_1D procedure :: size => get_size_int64_1D procedure :: capacity => get_capacity_int64_1D procedure :: push_back => add_val_int64_1D procedure, private :: dump => dump_int64_1D procedure :: dump_reset => dump_reset_int64_1D end type buffer_int64_1D_t public :: buffer_token_1D_t !> @brief !> Re-sizeable array type that can be filled elementwise to build up a contiguous data chunk !> that can then be dumped to an allocatable !> !> @details !> For multidimensional buffers only the last dimension can grow. !> (i.e. it is only possible to add columns.) !> !> The buffer has to be initiliazed before first use. !> After dumping (`dump_reset`) it is automatically resetted. type :: buffer_token_1D_t private type(Token_t), dimension(:), allocatable :: buf ! Internal position of the buffer integer(int64) :: pos real(dp) :: grow_factor = 1.5_dp integer(int64) :: start_size = 100_int64 contains procedure :: init => init_token_1D procedure :: finalize => finalize_token_1D procedure, private :: reset => reset_token_1D procedure :: size => get_size_token_1D procedure :: capacity => get_capacity_token_1D procedure :: push_back => add_val_token_1D procedure, private :: dump => dump_token_1D procedure :: dump_reset => dump_reset_token_1D end type buffer_token_1D_t public :: buffer_real_2D_t !> @brief !> Re-sizeable array type that can be filled elementwise to build up a contiguous data chunk !> that can then be dumped to an allocatable !> !> @details !> For multidimensional buffers only the last dimension can grow. !> (i.e. it is only possible to add columns.) !> !> The buffer has to be initiliazed before first use. !> After dumping (`dump_reset`) it is automatically resetted. type :: buffer_real_2D_t private real(dp), dimension(:, :), allocatable :: buf ! Internal position of the buffer integer(int64) :: pos real(dp) :: grow_factor = 1.5_dp integer(int64) :: start_size = 100_int64 contains procedure :: init => init_real_2D procedure :: finalize => finalize_real_2D procedure, private :: reset => reset_real_2D procedure :: size => get_size_real_2D procedure :: capacity => get_capacity_real_2D procedure :: push_back => add_val_real_2D procedure, private :: dump => dump_real_2D procedure :: dump_reset => dump_reset_real_2D end type buffer_real_2D_t public :: buffer_hel_2D_t !> @brief !> Re-sizeable array type that can be filled elementwise to build up a contiguous data chunk !> that can then be dumped to an allocatable !> !> @details !> For multidimensional buffers only the last dimension can grow. !> (i.e. it is only possible to add columns.) !> !> The buffer has to be initiliazed before first use. !> After dumping (`dump_reset`) it is automatically resetted. type :: buffer_hel_2D_t private HElement_t(dp), dimension(:, :), allocatable :: buf ! Internal position of the buffer integer(int64) :: pos real(dp) :: grow_factor = 1.5_dp integer(int64) :: start_size = 100_int64 contains procedure :: init => init_hel_2D procedure :: finalize => finalize_hel_2D procedure, private :: reset => reset_hel_2D procedure :: size => get_size_hel_2D procedure :: capacity => get_capacity_hel_2D procedure :: push_back => add_val_hel_2D procedure, private :: dump => dump_hel_2D procedure :: dump_reset => dump_reset_hel_2D end type buffer_hel_2D_t public :: buffer_int_2D_t !> @brief !> Re-sizeable array type that can be filled elementwise to build up a contiguous data chunk !> that can then be dumped to an allocatable !> !> @details !> For multidimensional buffers only the last dimension can grow. !> (i.e. it is only possible to add columns.) !> !> The buffer has to be initiliazed before first use. !> After dumping (`dump_reset`) it is automatically resetted. type :: buffer_int_2D_t private integer, dimension(:, :), allocatable :: buf ! Internal position of the buffer integer(int64) :: pos real(dp) :: grow_factor = 1.5_dp integer(int64) :: start_size = 100_int64 contains procedure :: init => init_int_2D procedure :: finalize => finalize_int_2D procedure, private :: reset => reset_int_2D procedure :: size => get_size_int_2D procedure :: capacity => get_capacity_int_2D procedure :: push_back => add_val_int_2D procedure, private :: dump => dump_int_2D procedure :: dump_reset => dump_reset_int_2D end type buffer_int_2D_t public :: buffer_int32_2D_t !> @brief !> Re-sizeable array type that can be filled elementwise to build up a contiguous data chunk !> that can then be dumped to an allocatable !> !> @details !> For multidimensional buffers only the last dimension can grow. !> (i.e. it is only possible to add columns.) !> !> The buffer has to be initiliazed before first use. !> After dumping (`dump_reset`) it is automatically resetted. type :: buffer_int32_2D_t private integer(int32), dimension(:, :), allocatable :: buf ! Internal position of the buffer integer(int64) :: pos real(dp) :: grow_factor = 1.5_dp integer(int64) :: start_size = 100_int64 contains procedure :: init => init_int32_2D procedure :: finalize => finalize_int32_2D procedure, private :: reset => reset_int32_2D procedure :: size => get_size_int32_2D procedure :: capacity => get_capacity_int32_2D procedure :: push_back => add_val_int32_2D procedure, private :: dump => dump_int32_2D procedure :: dump_reset => dump_reset_int32_2D end type buffer_int32_2D_t public :: buffer_int64_2D_t !> @brief !> Re-sizeable array type that can be filled elementwise to build up a contiguous data chunk !> that can then be dumped to an allocatable !> !> @details !> For multidimensional buffers only the last dimension can grow. !> (i.e. it is only possible to add columns.) !> !> The buffer has to be initiliazed before first use. !> After dumping (`dump_reset`) it is automatically resetted. type :: buffer_int64_2D_t private integer(int64), dimension(:, :), allocatable :: buf ! Internal position of the buffer integer(int64) :: pos real(dp) :: grow_factor = 1.5_dp integer(int64) :: start_size = 100_int64 contains procedure :: init => init_int64_2D procedure :: finalize => finalize_int64_2D procedure, private :: reset => reset_int64_2D procedure :: size => get_size_int64_2D procedure :: capacity => get_capacity_int64_2D procedure :: push_back => add_val_int64_2D procedure, private :: dump => dump_int64_2D procedure :: dump_reset => dump_reset_int64_2D end type buffer_int64_2D_t public :: buffer_token_2D_t !> @brief !> Re-sizeable array type that can be filled elementwise to build up a contiguous data chunk !> that can then be dumped to an allocatable !> !> @details !> For multidimensional buffers only the last dimension can grow. !> (i.e. it is only possible to add columns.) !> !> The buffer has to be initiliazed before first use. !> After dumping (`dump_reset`) it is automatically resetted. type :: buffer_token_2D_t private type(Token_t), dimension(:, :), allocatable :: buf ! Internal position of the buffer integer(int64) :: pos real(dp) :: grow_factor = 1.5_dp integer(int64) :: start_size = 100_int64 contains procedure :: init => init_token_2D procedure :: finalize => finalize_token_2D procedure, private :: reset => reset_token_2D procedure :: size => get_size_token_2D procedure :: capacity => get_capacity_token_2D procedure :: push_back => add_val_token_2D procedure, private :: dump => dump_token_2D procedure :: dump_reset => dump_reset_token_2D end type buffer_token_2D_t contains !> @brief !> Set up the re-sizeable array (buffer) with a given start size and grow_factor. !> !> @details !> Has to be called before first use and can be called any time. !> !> @param[in] start_size Initial size of the buffer. !> @param[in] grow_factor Factor about which to grow the buffer, if the capacity is not sufficient. pure subroutine init_real_1D (this, grow_factor, start_size) class(buffer_real_1D_t), intent(inout) :: this real(dp), optional, intent(in) :: grow_factor integer(int64), optional, intent(in) :: start_size character(*), parameter :: this_routine = 'buffer::init' if (present(grow_factor)) this%grow_factor = grow_factor if (present(start_size)) this%start_size = start_size #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%grow_factor > 1.0_dp)) then call stop_all (this_routine, "Assert fail: this%grow_factor > 1.0_dp") end if end block #endif #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%start_size >= 0_int64)) then call stop_all (this_routine, "Assert fail: this%start_size >= 0_int64") end if end block #endif if (.not. allocated(this%buf)) allocate(this%buf(this%start_size)) this%pos = 0_int64 end subroutine !> @brief !> Reset an already initiliazed buffer. pure subroutine reset_real_1D (this) class(buffer_real_1D_t), intent(inout) :: this deallocate(this%buf) allocate(this%buf(this%start_size)) this%pos = 0_int64 end subroutine !> @brief !> Set up the re-sizeable array (buffer) with a given start size and grow_factor. !> !> @details !> Has to be called before first use and can be called any time. !> !> @param[in] rows Number of rows in the first dimension. !> @param[in] start_size Initial size of the buffer along the last dimension. !> @param[in] grow_factor Factor about which to grow the buffer along the last dimension, !> if the capacity is not sufficient. pure subroutine init_real_2D (this, rows, grow_factor, start_size) class(buffer_real_2D_t), intent(inout) :: this integer, intent(in) :: rows real, optional, intent(in) :: grow_factor integer, optional, intent(in) :: start_size character(*), parameter :: this_routine = 'buffer::init' if (present(grow_factor)) this%grow_factor = grow_factor if (present(start_size)) this%start_size = start_size #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%grow_factor > 1.0_dp)) then call stop_all (this_routine, "Assert fail: this%grow_factor > 1.0_dp") end if end block #endif #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%start_size >= 0_int64)) then call stop_all (this_routine, "Assert fail: this%start_size >= 0_int64") end if end block #endif allocate(this%buf(rows, this%start_size)) this%pos = 0_int64 end subroutine init_real_2D !> @brief !> Reset an already initiliazed buffer. pure subroutine reset_real_2D (this) class(buffer_real_2D_t), intent(inout) :: this integer(int64) :: rows rows = size(this%buf, 1) deallocate(this%buf) allocate(this%buf(rows, this%start_size)) this%pos = 0_int64 end subroutine !------------------------------------------------------------------------------------------! !> @brief !> Deallocate the resource. pure subroutine finalize_real_1D (this) class(buffer_real_1D_t), intent(inout) :: this if (allocated(this%buf)) deallocate(this%buf) end subroutine finalize_real_1D !------------------------------------------------------------------------------------------! !> @brief !> Returns the number of already stored elements in the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_size_real_1D (this) result(n_els) class(buffer_real_1D_t), intent(in) :: this integer(int64) :: n_els n_els = this%pos end function !------------------------------------------------------------------------------------------! !> @brief !> Returns the capacity of the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_capacity_real_1D (this) result(capacity) class(buffer_real_1D_t), intent(in) :: this integer(int64) :: capacity capacity = size(this%buf, 1) end function !------------------------------------------------------------------------------------------! !> @brief !> Append a value to the buffer, expanding the capacity if necessary. !> !> @param[in] val Value to be added pure subroutine add_val_real_1D (this, val) class(buffer_real_1D_t), intent(inout) :: this real(dp), intent(in) :: val ! If the buffer still has room, add the entry if (this%pos < size(this%buf, 1, kind=int64)) then this%pos = this%pos + 1_int64 this%buf(this%pos) = val else ! else, expand the buffer by another block block real(dp), dimension(:), allocatable :: tmp integer(int64) :: new_buf_size ! Fortran 2003 automatic allocation/assignment tmp = this%buf ! We add a constant offset to allow growth if start_size == 0. ! The grow_factor then takes over for larger numbers and prevents the O(n^2) scaling. new_buf_size = ceiling(real(size(this%buf, 1), kind=dp) * this%grow_factor, kind=int64) + 10_int64 deallocate(this%buf) allocate(this%buf(new_buf_size)) this%buf(: size(tmp, 1)) = tmp this%pos = this%pos + 1_int64 this%buf(this%pos) = val end block end if end subroutine add_val_real_1D !------------------------------------------------------------------------------------------! !> @brief !> Dump the buffer to an allocatable array. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer has to be reinitialized if used again. pure subroutine dump_real_1D (this, tgt) class(buffer_real_1D_t), intent(inout) :: this real(dp), dimension(:), allocatable, intent(out) :: tgt tgt = this%buf(: this%size()) end subroutine !> Dump the buffer to an allocatable array and reset the buffer. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer is writable afterwards. pure subroutine dump_reset_real_1D (this, tgt) class(buffer_real_1D_t), intent(inout) :: this real(dp), dimension(:), allocatable, intent(out) :: tgt call this%dump(tgt) call this%reset() end subroutine !> @brief !> Deallocate the resource. pure subroutine finalize_real_2D (this) class(buffer_real_2D_t), intent(inout) :: this if (allocated(this%buf)) deallocate(this%buf) end subroutine finalize_real_2D !------------------------------------------------------------------------------------------! !> @brief !> Returns the number of already stored elements in the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_size_real_2D (this) result(n_els) class(buffer_real_2D_t), intent(in) :: this integer(int64) :: n_els n_els = this%pos end function !------------------------------------------------------------------------------------------! !> @brief !> Returns the capacity of the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_capacity_real_2D (this) result(capacity) class(buffer_real_2D_t), intent(in) :: this integer(int64) :: capacity capacity = size(this%buf, 2) end function !------------------------------------------------------------------------------------------! !> @brief !> Append a value to the buffer, expanding the capacity if necessary. !> !> @param[in] val Value to be added pure subroutine add_val_real_2D (this, val) class(buffer_real_2D_t), intent(inout) :: this real(dp), dimension(:), intent(in) :: val ! If the buffer still has room, add the entry if (this%pos < size(this%buf, 2, kind=int64)) then this%pos = this%pos + 1_int64 this%buf(:, this%pos) = val else ! else, expand the buffer by another block block real(dp), dimension(:, :), allocatable :: tmp integer(int64) :: new_buf_size ! Fortran 2003 automatic allocation/assignment tmp = this%buf ! We add a constant offset to allow growth if start_size == 0. ! The grow_factor then takes over for larger numbers and prevents the O(n^2) scaling. new_buf_size = ceiling(real(size(this%buf, 2), kind=dp) * this%grow_factor, kind=int64) + 10_int64 deallocate(this%buf) allocate(this%buf(size(tmp, 1), new_buf_size)) this%buf(:, : size(tmp, 2)) = tmp this%pos = this%pos + 1_int64 this%buf(:, this%pos) = val end block end if end subroutine add_val_real_2D !------------------------------------------------------------------------------------------! !> @brief !> Dump the buffer to an allocatable array. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer has to be reinitialized if used again. pure subroutine dump_real_2D (this, tgt) class(buffer_real_2D_t), intent(inout) :: this real(dp), dimension(:, :), allocatable, intent(out) :: tgt tgt = this%buf(:, : this%size()) end subroutine !> Dump the buffer to an allocatable array and reset the buffer. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer is writable afterwards. pure subroutine dump_reset_real_2D (this, tgt) class(buffer_real_2D_t), intent(inout) :: this real(dp), dimension(:, :), allocatable, intent(out) :: tgt call this%dump(tgt) call this%reset() end subroutine !> @brief !> Set up the re-sizeable array (buffer) with a given start size and grow_factor. !> !> @details !> Has to be called before first use and can be called any time. !> !> @param[in] start_size Initial size of the buffer. !> @param[in] grow_factor Factor about which to grow the buffer, if the capacity is not sufficient. pure subroutine init_hel_1D (this, grow_factor, start_size) class(buffer_hel_1D_t), intent(inout) :: this real(dp), optional, intent(in) :: grow_factor integer(int64), optional, intent(in) :: start_size character(*), parameter :: this_routine = 'buffer::init' if (present(grow_factor)) this%grow_factor = grow_factor if (present(start_size)) this%start_size = start_size #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%grow_factor > 1.0_dp)) then call stop_all (this_routine, "Assert fail: this%grow_factor > 1.0_dp") end if end block #endif #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%start_size >= 0_int64)) then call stop_all (this_routine, "Assert fail: this%start_size >= 0_int64") end if end block #endif if (.not. allocated(this%buf)) allocate(this%buf(this%start_size)) this%pos = 0_int64 end subroutine !> @brief !> Reset an already initiliazed buffer. pure subroutine reset_hel_1D (this) class(buffer_hel_1D_t), intent(inout) :: this deallocate(this%buf) allocate(this%buf(this%start_size)) this%pos = 0_int64 end subroutine !> @brief !> Set up the re-sizeable array (buffer) with a given start size and grow_factor. !> !> @details !> Has to be called before first use and can be called any time. !> !> @param[in] rows Number of rows in the first dimension. !> @param[in] start_size Initial size of the buffer along the last dimension. !> @param[in] grow_factor Factor about which to grow the buffer along the last dimension, !> if the capacity is not sufficient. pure subroutine init_hel_2D (this, rows, grow_factor, start_size) class(buffer_hel_2D_t), intent(inout) :: this integer, intent(in) :: rows real, optional, intent(in) :: grow_factor integer, optional, intent(in) :: start_size character(*), parameter :: this_routine = 'buffer::init' if (present(grow_factor)) this%grow_factor = grow_factor if (present(start_size)) this%start_size = start_size #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%grow_factor > 1.0_dp)) then call stop_all (this_routine, "Assert fail: this%grow_factor > 1.0_dp") end if end block #endif #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%start_size >= 0_int64)) then call stop_all (this_routine, "Assert fail: this%start_size >= 0_int64") end if end block #endif allocate(this%buf(rows, this%start_size)) this%pos = 0_int64 end subroutine init_hel_2D !> @brief !> Reset an already initiliazed buffer. pure subroutine reset_hel_2D (this) class(buffer_hel_2D_t), intent(inout) :: this integer(int64) :: rows rows = size(this%buf, 1) deallocate(this%buf) allocate(this%buf(rows, this%start_size)) this%pos = 0_int64 end subroutine !------------------------------------------------------------------------------------------! !> @brief !> Deallocate the resource. pure subroutine finalize_hel_1D (this) class(buffer_hel_1D_t), intent(inout) :: this if (allocated(this%buf)) deallocate(this%buf) end subroutine finalize_hel_1D !------------------------------------------------------------------------------------------! !> @brief !> Returns the number of already stored elements in the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_size_hel_1D (this) result(n_els) class(buffer_hel_1D_t), intent(in) :: this integer(int64) :: n_els n_els = this%pos end function !------------------------------------------------------------------------------------------! !> @brief !> Returns the capacity of the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_capacity_hel_1D (this) result(capacity) class(buffer_hel_1D_t), intent(in) :: this integer(int64) :: capacity capacity = size(this%buf, 1) end function !------------------------------------------------------------------------------------------! !> @brief !> Append a value to the buffer, expanding the capacity if necessary. !> !> @param[in] val Value to be added pure subroutine add_val_hel_1D (this, val) class(buffer_hel_1D_t), intent(inout) :: this HElement_t(dp), intent(in) :: val ! If the buffer still has room, add the entry if (this%pos < size(this%buf, 1, kind=int64)) then this%pos = this%pos + 1_int64 this%buf(this%pos) = val else ! else, expand the buffer by another block block HElement_t(dp), dimension(:), allocatable :: tmp integer(int64) :: new_buf_size ! Fortran 2003 automatic allocation/assignment tmp = this%buf ! We add a constant offset to allow growth if start_size == 0. ! The grow_factor then takes over for larger numbers and prevents the O(n^2) scaling. new_buf_size = ceiling(real(size(this%buf, 1), kind=dp) * this%grow_factor, kind=int64) + 10_int64 deallocate(this%buf) allocate(this%buf(new_buf_size)) this%buf(: size(tmp, 1)) = tmp this%pos = this%pos + 1_int64 this%buf(this%pos) = val end block end if end subroutine add_val_hel_1D !------------------------------------------------------------------------------------------! !> @brief !> Dump the buffer to an allocatable array. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer has to be reinitialized if used again. pure subroutine dump_hel_1D (this, tgt) class(buffer_hel_1D_t), intent(inout) :: this HElement_t(dp), dimension(:), allocatable, intent(out) :: tgt tgt = this%buf(: this%size()) end subroutine !> Dump the buffer to an allocatable array and reset the buffer. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer is writable afterwards. pure subroutine dump_reset_hel_1D (this, tgt) class(buffer_hel_1D_t), intent(inout) :: this HElement_t(dp), dimension(:), allocatable, intent(out) :: tgt call this%dump(tgt) call this%reset() end subroutine !> @brief !> Deallocate the resource. pure subroutine finalize_hel_2D (this) class(buffer_hel_2D_t), intent(inout) :: this if (allocated(this%buf)) deallocate(this%buf) end subroutine finalize_hel_2D !------------------------------------------------------------------------------------------! !> @brief !> Returns the number of already stored elements in the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_size_hel_2D (this) result(n_els) class(buffer_hel_2D_t), intent(in) :: this integer(int64) :: n_els n_els = this%pos end function !------------------------------------------------------------------------------------------! !> @brief !> Returns the capacity of the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_capacity_hel_2D (this) result(capacity) class(buffer_hel_2D_t), intent(in) :: this integer(int64) :: capacity capacity = size(this%buf, 2) end function !------------------------------------------------------------------------------------------! !> @brief !> Append a value to the buffer, expanding the capacity if necessary. !> !> @param[in] val Value to be added pure subroutine add_val_hel_2D (this, val) class(buffer_hel_2D_t), intent(inout) :: this HElement_t(dp), dimension(:), intent(in) :: val ! If the buffer still has room, add the entry if (this%pos < size(this%buf, 2, kind=int64)) then this%pos = this%pos + 1_int64 this%buf(:, this%pos) = val else ! else, expand the buffer by another block block HElement_t(dp), dimension(:, :), allocatable :: tmp integer(int64) :: new_buf_size ! Fortran 2003 automatic allocation/assignment tmp = this%buf ! We add a constant offset to allow growth if start_size == 0. ! The grow_factor then takes over for larger numbers and prevents the O(n^2) scaling. new_buf_size = ceiling(real(size(this%buf, 2), kind=dp) * this%grow_factor, kind=int64) + 10_int64 deallocate(this%buf) allocate(this%buf(size(tmp, 1), new_buf_size)) this%buf(:, : size(tmp, 2)) = tmp this%pos = this%pos + 1_int64 this%buf(:, this%pos) = val end block end if end subroutine add_val_hel_2D !------------------------------------------------------------------------------------------! !> @brief !> Dump the buffer to an allocatable array. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer has to be reinitialized if used again. pure subroutine dump_hel_2D (this, tgt) class(buffer_hel_2D_t), intent(inout) :: this HElement_t(dp), dimension(:, :), allocatable, intent(out) :: tgt tgt = this%buf(:, : this%size()) end subroutine !> Dump the buffer to an allocatable array and reset the buffer. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer is writable afterwards. pure subroutine dump_reset_hel_2D (this, tgt) class(buffer_hel_2D_t), intent(inout) :: this HElement_t(dp), dimension(:, :), allocatable, intent(out) :: tgt call this%dump(tgt) call this%reset() end subroutine !> @brief !> Set up the re-sizeable array (buffer) with a given start size and grow_factor. !> !> @details !> Has to be called before first use and can be called any time. !> !> @param[in] start_size Initial size of the buffer. !> @param[in] grow_factor Factor about which to grow the buffer, if the capacity is not sufficient. pure subroutine init_int_1D (this, grow_factor, start_size) class(buffer_int_1D_t), intent(inout) :: this real(dp), optional, intent(in) :: grow_factor integer(int64), optional, intent(in) :: start_size character(*), parameter :: this_routine = 'buffer::init' if (present(grow_factor)) this%grow_factor = grow_factor if (present(start_size)) this%start_size = start_size #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%grow_factor > 1.0_dp)) then call stop_all (this_routine, "Assert fail: this%grow_factor > 1.0_dp") end if end block #endif #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%start_size >= 0_int64)) then call stop_all (this_routine, "Assert fail: this%start_size >= 0_int64") end if end block #endif if (.not. allocated(this%buf)) allocate(this%buf(this%start_size)) this%pos = 0_int64 end subroutine !> @brief !> Reset an already initiliazed buffer. pure subroutine reset_int_1D (this) class(buffer_int_1D_t), intent(inout) :: this deallocate(this%buf) allocate(this%buf(this%start_size)) this%pos = 0_int64 end subroutine !> @brief !> Set up the re-sizeable array (buffer) with a given start size and grow_factor. !> !> @details !> Has to be called before first use and can be called any time. !> !> @param[in] rows Number of rows in the first dimension. !> @param[in] start_size Initial size of the buffer along the last dimension. !> @param[in] grow_factor Factor about which to grow the buffer along the last dimension, !> if the capacity is not sufficient. pure subroutine init_int_2D (this, rows, grow_factor, start_size) class(buffer_int_2D_t), intent(inout) :: this integer, intent(in) :: rows real, optional, intent(in) :: grow_factor integer, optional, intent(in) :: start_size character(*), parameter :: this_routine = 'buffer::init' if (present(grow_factor)) this%grow_factor = grow_factor if (present(start_size)) this%start_size = start_size #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%grow_factor > 1.0_dp)) then call stop_all (this_routine, "Assert fail: this%grow_factor > 1.0_dp") end if end block #endif #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%start_size >= 0_int64)) then call stop_all (this_routine, "Assert fail: this%start_size >= 0_int64") end if end block #endif allocate(this%buf(rows, this%start_size)) this%pos = 0_int64 end subroutine init_int_2D !> @brief !> Reset an already initiliazed buffer. pure subroutine reset_int_2D (this) class(buffer_int_2D_t), intent(inout) :: this integer(int64) :: rows rows = size(this%buf, 1) deallocate(this%buf) allocate(this%buf(rows, this%start_size)) this%pos = 0_int64 end subroutine !------------------------------------------------------------------------------------------! !> @brief !> Deallocate the resource. pure subroutine finalize_int_1D (this) class(buffer_int_1D_t), intent(inout) :: this if (allocated(this%buf)) deallocate(this%buf) end subroutine finalize_int_1D !------------------------------------------------------------------------------------------! !> @brief !> Returns the number of already stored elements in the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_size_int_1D (this) result(n_els) class(buffer_int_1D_t), intent(in) :: this integer(int64) :: n_els n_els = this%pos end function !------------------------------------------------------------------------------------------! !> @brief !> Returns the capacity of the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_capacity_int_1D (this) result(capacity) class(buffer_int_1D_t), intent(in) :: this integer(int64) :: capacity capacity = size(this%buf, 1) end function !------------------------------------------------------------------------------------------! !> @brief !> Append a value to the buffer, expanding the capacity if necessary. !> !> @param[in] val Value to be added pure subroutine add_val_int_1D (this, val) class(buffer_int_1D_t), intent(inout) :: this integer, intent(in) :: val ! If the buffer still has room, add the entry if (this%pos < size(this%buf, 1, kind=int64)) then this%pos = this%pos + 1_int64 this%buf(this%pos) = val else ! else, expand the buffer by another block block integer, dimension(:), allocatable :: tmp integer(int64) :: new_buf_size ! Fortran 2003 automatic allocation/assignment tmp = this%buf ! We add a constant offset to allow growth if start_size == 0. ! The grow_factor then takes over for larger numbers and prevents the O(n^2) scaling. new_buf_size = ceiling(real(size(this%buf, 1), kind=dp) * this%grow_factor, kind=int64) + 10_int64 deallocate(this%buf) allocate(this%buf(new_buf_size)) this%buf(: size(tmp, 1)) = tmp this%pos = this%pos + 1_int64 this%buf(this%pos) = val end block end if end subroutine add_val_int_1D !------------------------------------------------------------------------------------------! !> @brief !> Dump the buffer to an allocatable array. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer has to be reinitialized if used again. pure subroutine dump_int_1D (this, tgt) class(buffer_int_1D_t), intent(inout) :: this integer, dimension(:), allocatable, intent(out) :: tgt tgt = this%buf(: this%size()) end subroutine !> Dump the buffer to an allocatable array and reset the buffer. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer is writable afterwards. pure subroutine dump_reset_int_1D (this, tgt) class(buffer_int_1D_t), intent(inout) :: this integer, dimension(:), allocatable, intent(out) :: tgt call this%dump(tgt) call this%reset() end subroutine !> @brief !> Deallocate the resource. pure subroutine finalize_int_2D (this) class(buffer_int_2D_t), intent(inout) :: this if (allocated(this%buf)) deallocate(this%buf) end subroutine finalize_int_2D !------------------------------------------------------------------------------------------! !> @brief !> Returns the number of already stored elements in the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_size_int_2D (this) result(n_els) class(buffer_int_2D_t), intent(in) :: this integer(int64) :: n_els n_els = this%pos end function !------------------------------------------------------------------------------------------! !> @brief !> Returns the capacity of the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_capacity_int_2D (this) result(capacity) class(buffer_int_2D_t), intent(in) :: this integer(int64) :: capacity capacity = size(this%buf, 2) end function !------------------------------------------------------------------------------------------! !> @brief !> Append a value to the buffer, expanding the capacity if necessary. !> !> @param[in] val Value to be added pure subroutine add_val_int_2D (this, val) class(buffer_int_2D_t), intent(inout) :: this integer, dimension(:), intent(in) :: val ! If the buffer still has room, add the entry if (this%pos < size(this%buf, 2, kind=int64)) then this%pos = this%pos + 1_int64 this%buf(:, this%pos) = val else ! else, expand the buffer by another block block integer, dimension(:, :), allocatable :: tmp integer(int64) :: new_buf_size ! Fortran 2003 automatic allocation/assignment tmp = this%buf ! We add a constant offset to allow growth if start_size == 0. ! The grow_factor then takes over for larger numbers and prevents the O(n^2) scaling. new_buf_size = ceiling(real(size(this%buf, 2), kind=dp) * this%grow_factor, kind=int64) + 10_int64 deallocate(this%buf) allocate(this%buf(size(tmp, 1), new_buf_size)) this%buf(:, : size(tmp, 2)) = tmp this%pos = this%pos + 1_int64 this%buf(:, this%pos) = val end block end if end subroutine add_val_int_2D !------------------------------------------------------------------------------------------! !> @brief !> Dump the buffer to an allocatable array. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer has to be reinitialized if used again. pure subroutine dump_int_2D (this, tgt) class(buffer_int_2D_t), intent(inout) :: this integer, dimension(:, :), allocatable, intent(out) :: tgt tgt = this%buf(:, : this%size()) end subroutine !> Dump the buffer to an allocatable array and reset the buffer. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer is writable afterwards. pure subroutine dump_reset_int_2D (this, tgt) class(buffer_int_2D_t), intent(inout) :: this integer, dimension(:, :), allocatable, intent(out) :: tgt call this%dump(tgt) call this%reset() end subroutine !> @brief !> Set up the re-sizeable array (buffer) with a given start size and grow_factor. !> !> @details !> Has to be called before first use and can be called any time. !> !> @param[in] start_size Initial size of the buffer. !> @param[in] grow_factor Factor about which to grow the buffer, if the capacity is not sufficient. pure subroutine init_int32_1D (this, grow_factor, start_size) class(buffer_int32_1D_t), intent(inout) :: this real(dp), optional, intent(in) :: grow_factor integer(int64), optional, intent(in) :: start_size character(*), parameter :: this_routine = 'buffer::init' if (present(grow_factor)) this%grow_factor = grow_factor if (present(start_size)) this%start_size = start_size #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%grow_factor > 1.0_dp)) then call stop_all (this_routine, "Assert fail: this%grow_factor > 1.0_dp") end if end block #endif #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%start_size >= 0_int64)) then call stop_all (this_routine, "Assert fail: this%start_size >= 0_int64") end if end block #endif if (.not. allocated(this%buf)) allocate(this%buf(this%start_size)) this%pos = 0_int64 end subroutine !> @brief !> Reset an already initiliazed buffer. pure subroutine reset_int32_1D (this) class(buffer_int32_1D_t), intent(inout) :: this deallocate(this%buf) allocate(this%buf(this%start_size)) this%pos = 0_int64 end subroutine !> @brief !> Set up the re-sizeable array (buffer) with a given start size and grow_factor. !> !> @details !> Has to be called before first use and can be called any time. !> !> @param[in] rows Number of rows in the first dimension. !> @param[in] start_size Initial size of the buffer along the last dimension. !> @param[in] grow_factor Factor about which to grow the buffer along the last dimension, !> if the capacity is not sufficient. pure subroutine init_int32_2D (this, rows, grow_factor, start_size) class(buffer_int32_2D_t), intent(inout) :: this integer, intent(in) :: rows real, optional, intent(in) :: grow_factor integer, optional, intent(in) :: start_size character(*), parameter :: this_routine = 'buffer::init' if (present(grow_factor)) this%grow_factor = grow_factor if (present(start_size)) this%start_size = start_size #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%grow_factor > 1.0_dp)) then call stop_all (this_routine, "Assert fail: this%grow_factor > 1.0_dp") end if end block #endif #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%start_size >= 0_int64)) then call stop_all (this_routine, "Assert fail: this%start_size >= 0_int64") end if end block #endif allocate(this%buf(rows, this%start_size)) this%pos = 0_int64 end subroutine init_int32_2D !> @brief !> Reset an already initiliazed buffer. pure subroutine reset_int32_2D (this) class(buffer_int32_2D_t), intent(inout) :: this integer(int64) :: rows rows = size(this%buf, 1) deallocate(this%buf) allocate(this%buf(rows, this%start_size)) this%pos = 0_int64 end subroutine !------------------------------------------------------------------------------------------! !> @brief !> Deallocate the resource. pure subroutine finalize_int32_1D (this) class(buffer_int32_1D_t), intent(inout) :: this if (allocated(this%buf)) deallocate(this%buf) end subroutine finalize_int32_1D !------------------------------------------------------------------------------------------! !> @brief !> Returns the number of already stored elements in the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_size_int32_1D (this) result(n_els) class(buffer_int32_1D_t), intent(in) :: this integer(int64) :: n_els n_els = this%pos end function !------------------------------------------------------------------------------------------! !> @brief !> Returns the capacity of the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_capacity_int32_1D (this) result(capacity) class(buffer_int32_1D_t), intent(in) :: this integer(int64) :: capacity capacity = size(this%buf, 1) end function !------------------------------------------------------------------------------------------! !> @brief !> Append a value to the buffer, expanding the capacity if necessary. !> !> @param[in] val Value to be added pure subroutine add_val_int32_1D (this, val) class(buffer_int32_1D_t), intent(inout) :: this integer(int32), intent(in) :: val ! If the buffer still has room, add the entry if (this%pos < size(this%buf, 1, kind=int64)) then this%pos = this%pos + 1_int64 this%buf(this%pos) = val else ! else, expand the buffer by another block block integer(int32), dimension(:), allocatable :: tmp integer(int64) :: new_buf_size ! Fortran 2003 automatic allocation/assignment tmp = this%buf ! We add a constant offset to allow growth if start_size == 0. ! The grow_factor then takes over for larger numbers and prevents the O(n^2) scaling. new_buf_size = ceiling(real(size(this%buf, 1), kind=dp) * this%grow_factor, kind=int64) + 10_int64 deallocate(this%buf) allocate(this%buf(new_buf_size)) this%buf(: size(tmp, 1)) = tmp this%pos = this%pos + 1_int64 this%buf(this%pos) = val end block end if end subroutine add_val_int32_1D !------------------------------------------------------------------------------------------! !> @brief !> Dump the buffer to an allocatable array. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer has to be reinitialized if used again. pure subroutine dump_int32_1D (this, tgt) class(buffer_int32_1D_t), intent(inout) :: this integer(int32), dimension(:), allocatable, intent(out) :: tgt tgt = this%buf(: this%size()) end subroutine !> Dump the buffer to an allocatable array and reset the buffer. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer is writable afterwards. pure subroutine dump_reset_int32_1D (this, tgt) class(buffer_int32_1D_t), intent(inout) :: this integer(int32), dimension(:), allocatable, intent(out) :: tgt call this%dump(tgt) call this%reset() end subroutine !> @brief !> Deallocate the resource. pure subroutine finalize_int32_2D (this) class(buffer_int32_2D_t), intent(inout) :: this if (allocated(this%buf)) deallocate(this%buf) end subroutine finalize_int32_2D !------------------------------------------------------------------------------------------! !> @brief !> Returns the number of already stored elements in the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_size_int32_2D (this) result(n_els) class(buffer_int32_2D_t), intent(in) :: this integer(int64) :: n_els n_els = this%pos end function !------------------------------------------------------------------------------------------! !> @brief !> Returns the capacity of the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_capacity_int32_2D (this) result(capacity) class(buffer_int32_2D_t), intent(in) :: this integer(int64) :: capacity capacity = size(this%buf, 2) end function !------------------------------------------------------------------------------------------! !> @brief !> Append a value to the buffer, expanding the capacity if necessary. !> !> @param[in] val Value to be added pure subroutine add_val_int32_2D (this, val) class(buffer_int32_2D_t), intent(inout) :: this integer(int32), dimension(:), intent(in) :: val ! If the buffer still has room, add the entry if (this%pos < size(this%buf, 2, kind=int64)) then this%pos = this%pos + 1_int64 this%buf(:, this%pos) = val else ! else, expand the buffer by another block block integer(int32), dimension(:, :), allocatable :: tmp integer(int64) :: new_buf_size ! Fortran 2003 automatic allocation/assignment tmp = this%buf ! We add a constant offset to allow growth if start_size == 0. ! The grow_factor then takes over for larger numbers and prevents the O(n^2) scaling. new_buf_size = ceiling(real(size(this%buf, 2), kind=dp) * this%grow_factor, kind=int64) + 10_int64 deallocate(this%buf) allocate(this%buf(size(tmp, 1), new_buf_size)) this%buf(:, : size(tmp, 2)) = tmp this%pos = this%pos + 1_int64 this%buf(:, this%pos) = val end block end if end subroutine add_val_int32_2D !------------------------------------------------------------------------------------------! !> @brief !> Dump the buffer to an allocatable array. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer has to be reinitialized if used again. pure subroutine dump_int32_2D (this, tgt) class(buffer_int32_2D_t), intent(inout) :: this integer(int32), dimension(:, :), allocatable, intent(out) :: tgt tgt = this%buf(:, : this%size()) end subroutine !> Dump the buffer to an allocatable array and reset the buffer. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer is writable afterwards. pure subroutine dump_reset_int32_2D (this, tgt) class(buffer_int32_2D_t), intent(inout) :: this integer(int32), dimension(:, :), allocatable, intent(out) :: tgt call this%dump(tgt) call this%reset() end subroutine !> @brief !> Set up the re-sizeable array (buffer) with a given start size and grow_factor. !> !> @details !> Has to be called before first use and can be called any time. !> !> @param[in] start_size Initial size of the buffer. !> @param[in] grow_factor Factor about which to grow the buffer, if the capacity is not sufficient. pure subroutine init_int64_1D (this, grow_factor, start_size) class(buffer_int64_1D_t), intent(inout) :: this real(dp), optional, intent(in) :: grow_factor integer(int64), optional, intent(in) :: start_size character(*), parameter :: this_routine = 'buffer::init' if (present(grow_factor)) this%grow_factor = grow_factor if (present(start_size)) this%start_size = start_size #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%grow_factor > 1.0_dp)) then call stop_all (this_routine, "Assert fail: this%grow_factor > 1.0_dp") end if end block #endif #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%start_size >= 0_int64)) then call stop_all (this_routine, "Assert fail: this%start_size >= 0_int64") end if end block #endif if (.not. allocated(this%buf)) allocate(this%buf(this%start_size)) this%pos = 0_int64 end subroutine !> @brief !> Reset an already initiliazed buffer. pure subroutine reset_int64_1D (this) class(buffer_int64_1D_t), intent(inout) :: this deallocate(this%buf) allocate(this%buf(this%start_size)) this%pos = 0_int64 end subroutine !> @brief !> Set up the re-sizeable array (buffer) with a given start size and grow_factor. !> !> @details !> Has to be called before first use and can be called any time. !> !> @param[in] rows Number of rows in the first dimension. !> @param[in] start_size Initial size of the buffer along the last dimension. !> @param[in] grow_factor Factor about which to grow the buffer along the last dimension, !> if the capacity is not sufficient. pure subroutine init_int64_2D (this, rows, grow_factor, start_size) class(buffer_int64_2D_t), intent(inout) :: this integer, intent(in) :: rows real, optional, intent(in) :: grow_factor integer, optional, intent(in) :: start_size character(*), parameter :: this_routine = 'buffer::init' if (present(grow_factor)) this%grow_factor = grow_factor if (present(start_size)) this%start_size = start_size #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%grow_factor > 1.0_dp)) then call stop_all (this_routine, "Assert fail: this%grow_factor > 1.0_dp") end if end block #endif #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%start_size >= 0_int64)) then call stop_all (this_routine, "Assert fail: this%start_size >= 0_int64") end if end block #endif allocate(this%buf(rows, this%start_size)) this%pos = 0_int64 end subroutine init_int64_2D !> @brief !> Reset an already initiliazed buffer. pure subroutine reset_int64_2D (this) class(buffer_int64_2D_t), intent(inout) :: this integer(int64) :: rows rows = size(this%buf, 1) deallocate(this%buf) allocate(this%buf(rows, this%start_size)) this%pos = 0_int64 end subroutine !------------------------------------------------------------------------------------------! !> @brief !> Deallocate the resource. pure subroutine finalize_int64_1D (this) class(buffer_int64_1D_t), intent(inout) :: this if (allocated(this%buf)) deallocate(this%buf) end subroutine finalize_int64_1D !------------------------------------------------------------------------------------------! !> @brief !> Returns the number of already stored elements in the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_size_int64_1D (this) result(n_els) class(buffer_int64_1D_t), intent(in) :: this integer(int64) :: n_els n_els = this%pos end function !------------------------------------------------------------------------------------------! !> @brief !> Returns the capacity of the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_capacity_int64_1D (this) result(capacity) class(buffer_int64_1D_t), intent(in) :: this integer(int64) :: capacity capacity = size(this%buf, 1) end function !------------------------------------------------------------------------------------------! !> @brief !> Append a value to the buffer, expanding the capacity if necessary. !> !> @param[in] val Value to be added pure subroutine add_val_int64_1D (this, val) class(buffer_int64_1D_t), intent(inout) :: this integer(int64), intent(in) :: val ! If the buffer still has room, add the entry if (this%pos < size(this%buf, 1, kind=int64)) then this%pos = this%pos + 1_int64 this%buf(this%pos) = val else ! else, expand the buffer by another block block integer(int64), dimension(:), allocatable :: tmp integer(int64) :: new_buf_size ! Fortran 2003 automatic allocation/assignment tmp = this%buf ! We add a constant offset to allow growth if start_size == 0. ! The grow_factor then takes over for larger numbers and prevents the O(n^2) scaling. new_buf_size = ceiling(real(size(this%buf, 1), kind=dp) * this%grow_factor, kind=int64) + 10_int64 deallocate(this%buf) allocate(this%buf(new_buf_size)) this%buf(: size(tmp, 1)) = tmp this%pos = this%pos + 1_int64 this%buf(this%pos) = val end block end if end subroutine add_val_int64_1D !------------------------------------------------------------------------------------------! !> @brief !> Dump the buffer to an allocatable array. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer has to be reinitialized if used again. pure subroutine dump_int64_1D (this, tgt) class(buffer_int64_1D_t), intent(inout) :: this integer(int64), dimension(:), allocatable, intent(out) :: tgt tgt = this%buf(: this%size()) end subroutine !> Dump the buffer to an allocatable array and reset the buffer. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer is writable afterwards. pure subroutine dump_reset_int64_1D (this, tgt) class(buffer_int64_1D_t), intent(inout) :: this integer(int64), dimension(:), allocatable, intent(out) :: tgt call this%dump(tgt) call this%reset() end subroutine !> @brief !> Deallocate the resource. pure subroutine finalize_int64_2D (this) class(buffer_int64_2D_t), intent(inout) :: this if (allocated(this%buf)) deallocate(this%buf) end subroutine finalize_int64_2D !------------------------------------------------------------------------------------------! !> @brief !> Returns the number of already stored elements in the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_size_int64_2D (this) result(n_els) class(buffer_int64_2D_t), intent(in) :: this integer(int64) :: n_els n_els = this%pos end function !------------------------------------------------------------------------------------------! !> @brief !> Returns the capacity of the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_capacity_int64_2D (this) result(capacity) class(buffer_int64_2D_t), intent(in) :: this integer(int64) :: capacity capacity = size(this%buf, 2) end function !------------------------------------------------------------------------------------------! !> @brief !> Append a value to the buffer, expanding the capacity if necessary. !> !> @param[in] val Value to be added pure subroutine add_val_int64_2D (this, val) class(buffer_int64_2D_t), intent(inout) :: this integer(int64), dimension(:), intent(in) :: val ! If the buffer still has room, add the entry if (this%pos < size(this%buf, 2, kind=int64)) then this%pos = this%pos + 1_int64 this%buf(:, this%pos) = val else ! else, expand the buffer by another block block integer(int64), dimension(:, :), allocatable :: tmp integer(int64) :: new_buf_size ! Fortran 2003 automatic allocation/assignment tmp = this%buf ! We add a constant offset to allow growth if start_size == 0. ! The grow_factor then takes over for larger numbers and prevents the O(n^2) scaling. new_buf_size = ceiling(real(size(this%buf, 2), kind=dp) * this%grow_factor, kind=int64) + 10_int64 deallocate(this%buf) allocate(this%buf(size(tmp, 1), new_buf_size)) this%buf(:, : size(tmp, 2)) = tmp this%pos = this%pos + 1_int64 this%buf(:, this%pos) = val end block end if end subroutine add_val_int64_2D !------------------------------------------------------------------------------------------! !> @brief !> Dump the buffer to an allocatable array. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer has to be reinitialized if used again. pure subroutine dump_int64_2D (this, tgt) class(buffer_int64_2D_t), intent(inout) :: this integer(int64), dimension(:, :), allocatable, intent(out) :: tgt tgt = this%buf(:, : this%size()) end subroutine !> Dump the buffer to an allocatable array and reset the buffer. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer is writable afterwards. pure subroutine dump_reset_int64_2D (this, tgt) class(buffer_int64_2D_t), intent(inout) :: this integer(int64), dimension(:, :), allocatable, intent(out) :: tgt call this%dump(tgt) call this%reset() end subroutine !> @brief !> Set up the re-sizeable array (buffer) with a given start size and grow_factor. !> !> @details !> Has to be called before first use and can be called any time. !> !> @param[in] start_size Initial size of the buffer. !> @param[in] grow_factor Factor about which to grow the buffer, if the capacity is not sufficient. pure subroutine init_token_1D (this, grow_factor, start_size) class(buffer_token_1D_t), intent(inout) :: this real(dp), optional, intent(in) :: grow_factor integer(int64), optional, intent(in) :: start_size character(*), parameter :: this_routine = 'buffer::init' if (present(grow_factor)) this%grow_factor = grow_factor if (present(start_size)) this%start_size = start_size #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%grow_factor > 1.0_dp)) then call stop_all (this_routine, "Assert fail: this%grow_factor > 1.0_dp") end if end block #endif #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%start_size >= 0_int64)) then call stop_all (this_routine, "Assert fail: this%start_size >= 0_int64") end if end block #endif if (.not. allocated(this%buf)) allocate(this%buf(this%start_size)) this%pos = 0_int64 end subroutine !> @brief !> Reset an already initiliazed buffer. pure subroutine reset_token_1D (this) class(buffer_token_1D_t), intent(inout) :: this deallocate(this%buf) allocate(this%buf(this%start_size)) this%pos = 0_int64 end subroutine !> @brief !> Set up the re-sizeable array (buffer) with a given start size and grow_factor. !> !> @details !> Has to be called before first use and can be called any time. !> !> @param[in] rows Number of rows in the first dimension. !> @param[in] start_size Initial size of the buffer along the last dimension. !> @param[in] grow_factor Factor about which to grow the buffer along the last dimension, !> if the capacity is not sufficient. pure subroutine init_token_2D (this, rows, grow_factor, start_size) class(buffer_token_2D_t), intent(inout) :: this integer, intent(in) :: rows real, optional, intent(in) :: grow_factor integer, optional, intent(in) :: start_size character(*), parameter :: this_routine = 'buffer::init' if (present(grow_factor)) this%grow_factor = grow_factor if (present(start_size)) this%start_size = start_size #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%grow_factor > 1.0_dp)) then call stop_all (this_routine, "Assert fail: this%grow_factor > 1.0_dp") end if end block #endif #ifdef DEBUG_ block use util_mod, only: stop_all if (.not. (this%start_size >= 0_int64)) then call stop_all (this_routine, "Assert fail: this%start_size >= 0_int64") end if end block #endif allocate(this%buf(rows, this%start_size)) this%pos = 0_int64 end subroutine init_token_2D !> @brief !> Reset an already initiliazed buffer. pure subroutine reset_token_2D (this) class(buffer_token_2D_t), intent(inout) :: this integer(int64) :: rows rows = size(this%buf, 1) deallocate(this%buf) allocate(this%buf(rows, this%start_size)) this%pos = 0_int64 end subroutine !------------------------------------------------------------------------------------------! !> @brief !> Deallocate the resource. pure subroutine finalize_token_1D (this) class(buffer_token_1D_t), intent(inout) :: this if (allocated(this%buf)) deallocate(this%buf) end subroutine finalize_token_1D !------------------------------------------------------------------------------------------! !> @brief !> Returns the number of already stored elements in the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_size_token_1D (this) result(n_els) class(buffer_token_1D_t), intent(in) :: this integer(int64) :: n_els n_els = this%pos end function !------------------------------------------------------------------------------------------! !> @brief !> Returns the capacity of the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_capacity_token_1D (this) result(capacity) class(buffer_token_1D_t), intent(in) :: this integer(int64) :: capacity capacity = size(this%buf, 1) end function !------------------------------------------------------------------------------------------! !> @brief !> Append a value to the buffer, expanding the capacity if necessary. !> !> @param[in] val Value to be added pure subroutine add_val_token_1D (this, val) class(buffer_token_1D_t), intent(inout) :: this type(Token_t), intent(in) :: val ! If the buffer still has room, add the entry if (this%pos < size(this%buf, 1, kind=int64)) then this%pos = this%pos + 1_int64 this%buf(this%pos) = val else ! else, expand the buffer by another block block type(Token_t), dimension(:), allocatable :: tmp integer(int64) :: new_buf_size ! Fortran 2003 automatic allocation/assignment tmp = this%buf ! We add a constant offset to allow growth if start_size == 0. ! The grow_factor then takes over for larger numbers and prevents the O(n^2) scaling. new_buf_size = ceiling(real(size(this%buf, 1), kind=dp) * this%grow_factor, kind=int64) + 10_int64 deallocate(this%buf) allocate(this%buf(new_buf_size)) this%buf(: size(tmp, 1)) = tmp this%pos = this%pos + 1_int64 this%buf(this%pos) = val end block end if end subroutine add_val_token_1D !------------------------------------------------------------------------------------------! !> @brief !> Dump the buffer to an allocatable array. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer has to be reinitialized if used again. pure subroutine dump_token_1D (this, tgt) class(buffer_token_1D_t), intent(inout) :: this type(Token_t), dimension(:), allocatable, intent(out) :: tgt tgt = this%buf(: this%size()) end subroutine !> Dump the buffer to an allocatable array and reset the buffer. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer is writable afterwards. pure subroutine dump_reset_token_1D (this, tgt) class(buffer_token_1D_t), intent(inout) :: this type(Token_t), dimension(:), allocatable, intent(out) :: tgt call this%dump(tgt) call this%reset() end subroutine !> @brief !> Deallocate the resource. pure subroutine finalize_token_2D (this) class(buffer_token_2D_t), intent(inout) :: this if (allocated(this%buf)) deallocate(this%buf) end subroutine finalize_token_2D !------------------------------------------------------------------------------------------! !> @brief !> Returns the number of already stored elements in the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_size_token_2D (this) result(n_els) class(buffer_token_2D_t), intent(in) :: this integer(int64) :: n_els n_els = this%pos end function !------------------------------------------------------------------------------------------! !> @brief !> Returns the capacity of the buffer along the last dimension. !> !> @return n_els Number of elements already added to the buffer. pure function get_capacity_token_2D (this) result(capacity) class(buffer_token_2D_t), intent(in) :: this integer(int64) :: capacity capacity = size(this%buf, 2) end function !------------------------------------------------------------------------------------------! !> @brief !> Append a value to the buffer, expanding the capacity if necessary. !> !> @param[in] val Value to be added pure subroutine add_val_token_2D (this, val) class(buffer_token_2D_t), intent(inout) :: this type(Token_t), dimension(:), intent(in) :: val ! If the buffer still has room, add the entry if (this%pos < size(this%buf, 2, kind=int64)) then this%pos = this%pos + 1_int64 this%buf(:, this%pos) = val else ! else, expand the buffer by another block block type(Token_t), dimension(:, :), allocatable :: tmp integer(int64) :: new_buf_size ! Fortran 2003 automatic allocation/assignment tmp = this%buf ! We add a constant offset to allow growth if start_size == 0. ! The grow_factor then takes over for larger numbers and prevents the O(n^2) scaling. new_buf_size = ceiling(real(size(this%buf, 2), kind=dp) * this%grow_factor, kind=int64) + 10_int64 deallocate(this%buf) allocate(this%buf(size(tmp, 1), new_buf_size)) this%buf(:, : size(tmp, 2)) = tmp this%pos = this%pos + 1_int64 this%buf(:, this%pos) = val end block end if end subroutine add_val_token_2D !------------------------------------------------------------------------------------------! !> @brief !> Dump the buffer to an allocatable array. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer has to be reinitialized if used again. pure subroutine dump_token_2D (this, tgt) class(buffer_token_2D_t), intent(inout) :: this type(Token_t), dimension(:, :), allocatable, intent(out) :: tgt tgt = this%buf(:, : this%size()) end subroutine !> Dump the buffer to an allocatable array and reset the buffer. !> !> @param[out] tgt Allocatable array (reset upon entry), contains the stored elements of !> the buffer on return. The buffer is writable afterwards. pure subroutine dump_reset_token_2D (this, tgt) class(buffer_token_2D_t), intent(inout) :: this type(Token_t), dimension(:, :), allocatable, intent(out) :: tgt call this%dump(tgt) call this%reset() end subroutine end module growing_buffers