99!> The specification of this module is available [here](../page/specs/stdlib_array.html).
1010module stdlib_array
1111 use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
12+ use stdlib_strings, only: to_string
1213 implicit none
1314 private
1415
15- public :: trueloc, falseloc
16+ public :: add_array, trueloc, falseloc
1617
1718 !> Helper class to allocate t_array as an abstract type.
1819 type, public :: t_array_wrapper
@@ -31,8 +32,87 @@ module stdlib_array
3132#:endfor
3233#:endfor
3334
35+ interface add_array
36+ #:for k1, t1 in KINDS_TYPES
37+ #:for rank in RANKS
38+ module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, stat, msg, name)
39+ !> Array of arrays to which the array is to be added.
40+ type(t_array_wrapper), allocatable, intent(inout) :: arrays(:)
41+ !> Array to be added.
42+ ${t1}$, intent(in) :: array${ranksuffix(rank)}$
43+ !> Status of addition.
44+ integer, intent(out), optional :: stat
45+ !> Error message.
46+ character(len=:), allocatable, intent(out), optional :: msg
47+ !> Name of the array to be added. A default name will be used if not provided.
48+ character(len=*), intent(in), optional :: name
49+ end
50+ #:endfor
51+ #:endfor
52+ end interface
53+
3454contains
3555
56+ #:for k1, t1 in KINDS_TYPES
57+ #:for rank in RANKS
58+ module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, stat, msg, name)
59+ !> Array of arrays to which the array is to be added.
60+ type(t_array_wrapper), allocatable, intent(inout) :: arrays(:)
61+ !> Array to be added.
62+ ${t1}$, intent(in) :: array${ranksuffix(rank)}$
63+ !> Status of addition.
64+ integer, intent(out), optional :: stat
65+ !> Error message.
66+ character(len=:), allocatable, intent(out), optional :: msg
67+ !> Name of the array to be added. A default name will be used if not provided.
68+ character(len=*), intent(in), optional :: name
69+
70+ integer :: i, arr_size
71+ type(t_array_${t1[0]}$${k1}$_${rank}$) :: t_arr
72+ type(t_array_wrapper), allocatable :: tmp_arrays(:)
73+
74+
75+ if (present(stat)) stat = 0
76+
77+ if (present(name)) then
78+ if (trim(name) == '') then
79+ if (present(stat)) stat = 1
80+ if (present(msg)) msg = "Array name cannot be empty."
81+ return
82+ end if
83+ t_arr%name = name
84+ else
85+ if (allocated(arrays)) then
86+ t_arr%name = "arr_"//to_string(size(arrays))//".npy"
87+ else
88+ t_arr%name = "arr_0.npy"
89+ end if
90+ end if
91+
92+ allocate(t_arr%values, source=array)
93+ if (.not. allocated(arrays)) then
94+ allocate(arrays(1))
95+ allocate(arrays(1)%array, source=t_arr)
96+ return
97+ end if
98+
99+ arr_size = size(arrays)
100+ do i = 1, arr_size
101+ if (arrays(i)%array%name == t_arr%name) then
102+ if (present(stat)) stat = 1
103+ if (present(msg)) msg = "Array with the same name '"//t_arr%name//"' already exists."
104+ return
105+ end if
106+ end do
107+
108+ allocate(tmp_arrays(arr_size + 1))
109+ tmp_arrays(:arr_size) = arrays
110+ allocate(tmp_arrays(arr_size + 1)%array, source=t_arr)
111+ call move_alloc(tmp_arrays, arrays)
112+ end
113+ #:endfor
114+ #:endfor
115+
36116 !> Version: experimental
37117 !>
38118 !> Return the positions of the true elements in array.
0 commit comments