Implement add_array

Author: minhqdao

src/stdlib_io_np.fypp

@@ -160,8 +160,22 @@ module stdlib_io_np
 #:endfor
     end interface
 
-contains
-
-    subroutine add_array()
-    end
+    interface add_array
+#:for k1, t1 in KINDS_TYPES
+#:for rank in RANKS
+        module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, name, stat, msg)
+            !> Array of arrays to which the array is to be added.
+            type(t_array_wrapper), allocatable, intent(inout) :: arrays(:)
+            !> Array to be added.
+            ${t1}$, intent(in) :: array${ranksuffix(rank)}$
+            !> Name of the array to be added.
+            character(len=*), intent(in) :: name
+            !> Status of addition.
+            integer, intent(out), optional :: stat
+            !> Error message.
+            character(len=:), allocatable, intent(out), optional :: msg
+        end
+#:endfor
+#:endfor
+    end interface
 end

src/stdlib_io_np_save.fypp

@@ -133,6 +133,54 @@ contains
         end if
     end
 #:endfor
+#:endfor
+
+#:for k1, t1 in KINDS_TYPES
+#:for rank in RANKS
+    module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, name, stat, msg)
+        !> Array of arrays to which the array is to be added.
+        type(t_array_wrapper), allocatable, intent(inout) :: arrays(:)
+        !> Array to be added.
+        ${t1}$, intent(in) :: array${ranksuffix(rank)}$
+        !> Name of the array to be added.
+        character(len=*), intent(in) :: name
+        !> Status of addition.
+        integer, intent(out), optional :: stat
+        !> Error message.
+        character(len=:), allocatable, intent(out), optional :: msg
+
+        integer :: i
+        type(t_array_${t1[0]}$${k1}$_${rank}$) :: t_arr
+
+        if (present(stat)) stat = 0
+
+        if (trim(name) == '') then
+            if (present(stat)) stat = 1
+            if (present(msg)) msg = "Array name cannot be empty."
+            return
+        end if
+
+        t_arr%name = name
+        t_arr%values = array
+
+        if (.not. allocated(arrays)) then
+            allocate(arrays(1))
+            allocate(arrays(1)%array, source=t_arr)
+            return
+        end if
+
+        do i = 1, size(arrays)
+            if (arrays(i)%array%name == name) then
+                if (present(stat)) stat = 1
+                if (present(msg)) msg = "Array with the same name '"//name//"' already exists."
+                return
+            end if
+        end do
+
+        allocate(arrays(size(arrays) + 1))
+        arrays(size(arrays))%array = t_arr
+    end
+#:endfor
 #:endfor
 
     !> Version: experimental

test/io/test_np.f90

@@ -2,7 +2,7 @@ module test_np
     use stdlib_array
     use stdlib_filesystem, only : temp_dir
     use stdlib_kinds, only : int8, int16, int32, int64, sp, dp
-    use stdlib_io_np, only : save_npy, load_npy, load_npz, save_npz
+    use stdlib_io_np, only : save_npy, load_npy, load_npz, add_array, save_npz
     use testdrive, only : new_unittest, unittest_type, error_type, check, test_failed
     implicit none
     private
@@ -953,11 +953,17 @@ subroutine npz_save_rdp_2(error)
         integer :: stat
         character(*), parameter :: filename = "npz_save_rdp_2.npz"
         character(*), parameter :: arr_name = "arr_0.npy"
-        real(dp), allocatable :: input(:,:), output(:,:)
+        real(dp), allocatable :: input_array(:,:), output(:,:)
 
-        allocate(input(10, 4))
-        call random_number(input)
-        ! call add_array(arrays, input)
+        allocate(input_array(10, 4))
+        call random_number(input_array)
+        call add_array(arrays, input_array, arr_name, stat)
+        call check(error, stat, "Error adding an array to the list of arrays.")
+        if (allocated(error)) return
+        call check(error, size(arrays) == 1, "Array was not added to the list of arrays.")
+        if (allocated(error)) return
+        call check(error, arrays(1)%array%name == arr_name, "Wrong array name.")
+        if (allocated(error)) return
 
         ! call save_npz(filename, arrays, stat)
         ! call check(error, stat, "Writing of npz file failed")