diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md
index 46befe2ea..c80719fb8 100644
--- a/doc/specs/stdlib_io.md
+++ b/doc/specs/stdlib_io.md
@@ -305,3 +305,48 @@ Exceptions trigger an `error stop` unless the optional `err` argument is provide
 {!example/io/example_get_file.f90!}
 ```
 
+## `print_array` - Print an array to an output unit
+
+### Status
+
+Experimental
+
+### Description
+
+This subroutine interface prints a 2D array to a specified output unit.
+
+### Syntax
+
+`call [[stdlib_io(module):print_array(subroutine)]] (array[, unit][, fmt][, delimiter][, brief])`
+
+### Class
+
+Subroutine
+
+### Arguments
+
+`array`: Shall be a 2D array of `integer`, `real`, or `complex` type. It is an `intent(in)` argument.
+
+`unit`: Shall be an integer containing the output unit. It is an `intent(in)` argument. The default is the intrinsic `output_unit` provided by `iso_fortran_env`.
+
+`fmt`: Shall be a character string containing the format for printing the array. It is an `intent(in)` argument. The default is based on [the Formatting constants](#formatting-constants).
+
+`delimiter`: Shall be a character string containing the delimiter between array elements. It is an `intent(in)` argument. The default is a `" "` (space).
+
+`brief`: Shall be a logical flag. The default is `.true.`. If `.true.`, the array is printed in a shortened/abridged version
+that shows only the representative portions of large arrays, which is useful for gaining a glimpse of large arrays. Specifically:
+  + For arrays with more than 5 rows or columns, it will display:
+    - First 3 rows and columns;
+    - Last row and column;
+    - Eilipsis (`...`) to indicate omitted elements.
+  + For arrays with 5 rows or columns or less, it will display the entire array.
+
+### Example
+
+```fortran
+{!./example/io/example_print_array_brief.f90}
+```
+
+```fortran
+{!./example/io/example_print_array.f90}
+```
diff --git a/example/io/CMakeLists.txt b/example/io/CMakeLists.txt
index db663f537..9ff90456f 100644
--- a/example/io/CMakeLists.txt
+++ b/example/io/CMakeLists.txt
@@ -6,3 +6,5 @@ ADD_EXAMPLE(loadtxt)
 ADD_EXAMPLE(open)
 ADD_EXAMPLE(savenpy)
 ADD_EXAMPLE(savetxt)
+ADD_EXAMPLE(print_array)
+ADD_EXAMPLE(print_array_brief)
diff --git a/example/io/example_print_array.f90 b/example/io/example_print_array.f90
new file mode 100644
index 000000000..3551e4d82
--- /dev/null
+++ b/example/io/example_print_array.f90
@@ -0,0 +1,16 @@
+program example_io_print_array
+
+    use stdlib_io, only: print_array
+    implicit none
+
+    integer, dimension(6, 3) :: array = reshape([1, 2, 3, 4, 5, 6, &
+                                                 7, 8, 9, 10, 11, 12, &
+                                                 13, 14, 15, 16, 17, 18], [6, 3])
+
+    print "(a)", "=== print_array 1 ==="
+    call print_array(array, unit=6, fmt='(i3)', delimiter='|', brief=.true.)
+
+    print "(a)", "=== print_array 2 ==="
+    call print_array(array(:1, :), delimiter=", ")
+
+end program example_io_print_array
diff --git a/example/io/example_print_array_brief.f90 b/example/io/example_print_array_brief.f90
new file mode 100644
index 000000000..4fbb9b02f
--- /dev/null
+++ b/example/io/example_print_array_brief.f90
@@ -0,0 +1,20 @@
+program example_io_print_array_brief
+
+    use stdlib_io, only: print_array
+    implicit none
+
+    real, dimension(123, 456) :: array
+
+    call random_number(array)
+
+    print "(a)", "=== print_array ==="
+    call print_array(array, delimiter=', ', brief=.true.)
+
+end program example_io_print_array_brief
+
+! === print_array ===
+!  5.44562101E-01,  5.97862303E-01,  1.64548337E-01, ...,  1.18231595E-01
+!  6.42154396E-01,  8.24955523E-01,  2.37900555E-01, ...,  6.27207816E-01
+!  6.64815307E-02,  8.11999142E-01,  2.75685191E-01, ...,  4.20989931E-01
+! ...
+!  8.61099184E-01,  6.91828251E-01,  2.91268706E-01, ...,  3.90086174E-01
diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt
index d82aae118..512ccd18b 100644
--- a/src/CMakeLists.txt
+++ b/src/CMakeLists.txt
@@ -24,6 +24,7 @@ set(fppFiles
     stdlib_io_npy.fypp
     stdlib_io_npy_load.fypp
     stdlib_io_npy_save.fypp
+    stdlib_io_print_array.fypp
     stdlib_kinds.fypp
     stdlib_linalg.fypp
     stdlib_linalg_diag.fypp
diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp
index 6ba82ad12..234f00cb2 100644
--- a/src/stdlib_io.fypp
+++ b/src/stdlib_io.fypp
@@ -16,7 +16,7 @@ module stdlib_io
   implicit none
   private
   ! Public API
-  public :: loadtxt, savetxt, open, get_line, get_file
+  public :: loadtxt, savetxt, open, get_line, get_file, print_array
 
   !! version: experimental 
   !!
@@ -102,6 +102,22 @@ module stdlib_io
     #:endfor
   end interface
 
+  interface print_array
+    !! version: experimental
+    !!
+    !! Prints a 2D array to an output unit
+    !! ([Specification](../page/specs/stdlib_io.html#print_array))
+    #:for k1, t1 in KINDS_TYPES
+      module subroutine print_array_${t1[0]}$${k1}$(array, unit, fmt, delimiter, brief)
+        ${t1}$, intent(in) :: array(:, :)
+        integer, intent(in), optional :: unit
+        character(len=*), intent(in), optional :: fmt
+        character(len=*), intent(in), optional :: delimiter
+        logical, intent(in), optional :: brief
+      end subroutine print_array_${t1[0]}$${k1}$
+    #:endfor
+  end interface
+
 contains
 
   #:for k1, t1 in KINDS_TYPES
diff --git a/src/stdlib_io_print_array.fypp b/src/stdlib_io_print_array.fypp
new file mode 100644
index 000000000..22b51e0cd
--- /dev/null
+++ b/src/stdlib_io_print_array.fypp
@@ -0,0 +1,88 @@
+#:include "common.fypp"
+#:set KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES + INT_KINDS_TYPES
+submodule(stdlib_io) stdlib_io_print_array
+
+    use, intrinsic :: iso_fortran_env, only: output_unit
+    implicit none
+
+contains
+
+    #:for k1, t1 in KINDS_TYPES
+    module subroutine print_array_${t1[0]}$${k1}$(array, unit, fmt, delimiter, brief)
+        ${t1}$, intent(in) :: array(:, :)
+        integer, intent(in), optional :: unit
+        character(len=*), intent(in), optional :: fmt
+        character(len=*), intent(in), optional :: delimiter
+        logical, intent(in), optional :: brief
+
+        integer :: i, j, unit_, shape_(2)
+        character(len=:), allocatable :: fmt_
+        character(len=:), allocatable :: delimiter_
+        character(len=:), allocatable :: delim_str
+        logical :: brief_
+
+        shape_ = shape(array)
+        if (any(shape_ == 0)) return
+        unit_ = optval(unit, output_unit)
+        delimiter_ = optval(delimiter, delimiter_default)
+        delim_str = "'"//delimiter_//"'"
+        brief_ = optval(brief, .true.)
+        if (present(fmt)) then
+            fmt_ = "(*"//fmt(1:len(fmt) - 1)//",:,"//delim_str//"))"
+        else
+            #:if 'real' in t1
+                fmt_ = "(*"//FMT_REAL_${k1}$ (1:len(FMT_REAL_${k1}$) - 1)//",:,"//delim_str//"))"
+            #:elif 'complex' in t1
+                fmt_ = "(*"//FMT_COMPLEX_${k1}$ (1:11)//delim_str//FMT_COMPLEX_${k1}$ (14:23)//",:,"//delim_str//"))"
+            #:elif 'integer' in t1
+                fmt_ = "(*"//FMT_INT(1:len(FMT_INT) - 1)//",:,"//delim_str//"))"
+            #:endif
+        end if
+
+        if (brief_) then
+
+            if (shape_(1) > 5) then
+                if (shape_(2) > 5) then
+                    do i = 1, 3
+                        write (unit_, fmt=fmt_, advance='no') array(i, :3)
+                        write (unit_, fmt='(a)', advance='no') delimiter_//"..."//delimiter_
+                        write (unit_, fmt=fmt_) array(i, shape_(2))
+                    end do
+                    write (unit_, fmt='(a)') "..."
+                    write (unit_, fmt=fmt_, advance='no') array(shape_(1), :3)
+                    write (unit_, fmt='(a)', advance='no') delimiter_//"..."//delimiter_
+                    write (unit_, fmt=fmt_) array(shape_(1), shape_(2))
+                else
+                    do i = 1, 3
+                        write (unit_, fmt=fmt_) array(i, :)
+                    end do
+                    write (unit_, fmt='(a)') "..."
+                    write (unit_, fmt=fmt_) array(shape_(1), :)
+
+                end if
+            else
+                if (shape_(2) > 5) then
+                    do i = 1, shape_(1)
+                        write (unit_, fmt=fmt_, advance='no') array(i, :3)
+                        write (unit_, fmt='(a)', advance='no') delimiter_//"..."//delimiter_
+                        write (unit_, fmt=fmt_) array(i, shape_(2))
+                    end do
+                else
+                    do i = 1, shape_(1)
+                        write (unit_, fmt=fmt_) array(i, :)
+                    end do
+                end if
+            end if
+
+        else
+
+            do i = 1, shape_(1)
+                write (unit_, fmt=fmt_) array(i, :)
+            end do
+
+        end if
+
+    end subroutine print_array_${t1[0]}$${k1}$
+    #:endfor
+
+end submodule stdlib_io_print_array
diff --git a/test/io/CMakeLists.txt b/test/io/CMakeLists.txt
index 4e19b5fbe..ce46f4617 100644
--- a/test/io/CMakeLists.txt
+++ b/test/io/CMakeLists.txt
@@ -17,3 +17,4 @@ ADDTEST(get_line)
 ADDTEST(npy)
 ADDTEST(open)
 ADDTEST(parse_mode)
+ADDTEST(print_array)
diff --git a/test/io/test_print_array.f90 b/test/io/test_print_array.f90
new file mode 100644
index 000000000..fcfb39278
--- /dev/null
+++ b/test/io/test_print_array.f90
@@ -0,0 +1,334 @@
+module test_print_array
+
+    use stdlib_kinds, only: int8, int16, int32, int64, sp, dp
+    use testdrive, only: new_unittest, unittest_type, error_type, check
+    use stdlib_linalg, only: eye
+    use stdlib_io, only: print_array, get_line
+    implicit none
+    private
+
+    public :: collect_print_array
+
+contains
+
+    !> Collect all exported unit tests
+    subroutine collect_print_array(testsuite)
+        !> Collection of tests
+        type(unittest_type), allocatable, intent(out) :: testsuite(:)
+
+        testsuite = [ &
+                    new_unittest("print-rdp", test_print_rdp), &
+                    new_unittest("print-rsp", test_print_rsp), &
+                    new_unittest("print-cdp", test_print_cdp), &
+                    new_unittest("print-csp", test_print_csp), &
+                    new_unittest("print-i1", test_print_i1), &
+                    new_unittest("print-i2", test_print_i2) &
+                    ]
+
+    end subroutine collect_print_array
+
+    subroutine test_print_rdp(error)
+        !> Error handling
+        type(error_type), allocatable, intent(out) :: error
+        real(dp) :: a(10, 10)
+        integer :: fh, i
+        character(256) :: line(10)
+        character(:), allocatable :: buffer
+
+        a = eye(10)
+        open (newunit=fh, status='scratch')
+
+        line(1) = " 1.0000000000000000E+000  0.0000000000000000E+000  0.0000000000000000E+000 ...  0.0000000000000000E+000"
+        line(2) = " 0.0000000000000000E+000  1.0000000000000000E+000  0.0000000000000000E+000 ...  0.0000000000000000E+000"
+        line(3) = " 0.0000000000000000E+000  0.0000000000000000E+000  1.0000000000000000E+000 ...  0.0000000000000000E+000"
+        line(4) = "..."
+        line(5) = " 0.0000000000000000E+000  0.0000000000000000E+000  0.0000000000000000E+000 ...  1.0000000000000000E+000"
+        call print_array(a, fh)
+
+        rewind (fh)
+        do i = 1, 5
+            call get_line(fh, buffer)
+            call check(error, buffer, trim(line(i)))
+            if (allocated(error)) return
+        end do
+
+        rewind (fh)
+        line(1) =  "1.00|0.00|0.00|0.00|0.00"
+        line(2) =  "0.00|1.00|0.00|0.00|0.00"
+        line(3) =  "0.00|0.00|1.00|0.00|0.00"
+        line(4) =  "0.00|0.00|0.00|1.00|0.00"
+        line(5) =  "0.00|0.00|0.00|0.00|1.00"
+        line(6:) = "0.00|0.00|0.00|0.00|0.00"
+        
+        call print_array(a(:, :5), fh, fmt="(f4.2)", brief=.false., delimiter="|")
+
+        rewind (fh)
+        do i = 1, 10
+            call get_line(fh, buffer)
+            call check(error, buffer, trim(line(i)))
+            if (allocated(error)) return
+        end do
+
+        close (fh)
+
+    end subroutine test_print_rdp
+
+    subroutine test_print_rsp(error)
+        !> Error handling
+        type(error_type), allocatable, intent(out) :: error
+        real(sp) :: a(10, 10)
+        integer :: fh, i
+        character(256) :: line(10)
+        character(:), allocatable :: buffer
+
+        a = eye(10)
+        open (newunit=fh, status='scratch')
+
+        line(1) = " 1.00000000E+00  0.00000000E+00  0.00000000E+00 ...  0.00000000E+00"
+        line(2) = " 0.00000000E+00  1.00000000E+00  0.00000000E+00 ...  0.00000000E+00"
+        line(3) = " 0.00000000E+00  0.00000000E+00  1.00000000E+00 ...  0.00000000E+00"
+        line(4) = "..."
+        line(5) = " 0.00000000E+00  0.00000000E+00  0.00000000E+00 ...  1.00000000E+00"
+        call print_array(a, fh)
+
+        rewind (fh)
+        do i = 1, 5
+            call get_line(fh, buffer)
+            call check(error, buffer, trim(line(i)))
+            if (allocated(error)) return
+        end do
+
+        rewind (fh)
+        line(1) =  "1.00|0.00|0.00|0.00|0.00"
+        line(2) =  "0.00|1.00|0.00|0.00|0.00"
+        line(3) =  "0.00|0.00|1.00|0.00|0.00"
+        line(4) =  "0.00|0.00|0.00|1.00|0.00"
+        line(5) =  "0.00|0.00|0.00|0.00|1.00"
+        line(6:) = "0.00|0.00|0.00|0.00|0.00"
+        call print_array(a(:, :5), fh, fmt="(f4.2)", brief=.false., delimiter="|")
+
+        rewind (fh)
+        do i = 1, 10
+            call get_line(fh, buffer)
+            call check(error, buffer, trim(line(i)))
+            if (allocated(error)) return
+        end do
+
+        close (fh)
+
+    end subroutine test_print_rsp
+
+    subroutine test_print_i1(error)
+        !> Error handling
+        type(error_type), allocatable, intent(out) :: error
+        integer(int8) :: a(10, 10)
+        integer :: fh, i
+        character(256) :: line(10)
+        character(:), allocatable :: buffer
+
+        a = eye(10)
+        open (newunit=fh, status='scratch')
+
+        line(1) = "1, 0, 0, ..., 0"
+        line(2) = "0, 1, 0, ..., 0"
+        line(3) = "0, 0, 1, ..., 0"
+        line(4) = "..."
+        line(5) = "0, 0, 0, ..., 1"
+        call print_array(a, fh, delimiter=", ")
+
+        rewind (fh)
+        do i = 1, 5
+            call get_line(fh, buffer)
+            call check(error, buffer, trim(line(i)))
+            if (allocated(error)) return
+        end do
+
+        rewind (fh)
+        line(1)  = "01;00;00;00;00"
+        line(2)  = "00;01;00;00;00"
+        line(3)  = "00;00;01;00;00"
+        line(4)  = "00;00;00;01;00"
+        line(5)  = "00;00;00;00;01"
+        line(6:) = "00;00;00;00;00"
+        call print_array(a(:, :5), fh, fmt="(i0.2)", brief=.false., delimiter=";")
+        rewind (fh)
+        do i = 1, 10
+            call get_line(fh, buffer)
+            call check(error, buffer, trim(line(i)))
+            if (allocated(error)) return
+        end do
+
+        close (fh)
+
+    end subroutine test_print_i1
+
+    subroutine test_print_i2(error)
+        !> Error handling
+        type(error_type), allocatable, intent(out) :: error
+        integer(int32) :: a(10, 10)
+        integer :: fh, i
+        character(256) :: line(10)
+        character(:), allocatable :: buffer
+
+        a = eye(10)
+        open (newunit=fh, status='scratch')
+
+        line(1) = "1 0 0 ... 0"
+        line(2) = "0 1 0 ... 0"
+        line(3) = "0 0 1 ... 0"
+        line(4) = "..."
+        line(5) = "0 0 0 ... 1"
+
+        call print_array(a, fh)
+        rewind (fh)
+        do i = 1, 5
+            call get_line(fh, buffer)
+            call check(error, buffer, trim(line(i)))
+            if (allocated(error)) return
+        end do
+
+        rewind (fh)
+        line(1)  = "01; 00; 00; 00; 00"
+        line(2)  = "00; 01; 00; 00; 00"
+        line(3)  = "00; 00; 01; 00; 00"
+        line(4)  = "00; 00; 00; 01; 00"
+        line(5)  = "00; 00; 00; 00; 01"
+        line(6:) = "00; 00; 00; 00; 00"
+        call print_array(a(:, :5), fh, fmt="(i0.2)", brief=.false., delimiter="; ")
+        rewind (fh)
+        do i = 1, 10
+            call get_line(fh, buffer)
+            call check(error, buffer, trim(line(i)))
+            if (allocated(error)) return
+        end do
+
+        close (fh)
+
+    end subroutine test_print_i2
+
+    subroutine test_print_cdp(error)
+        !> Error handling
+        type(error_type), allocatable, intent(out) :: error
+        complex(dp) :: a(10, 10)
+        integer :: fh, i
+        character(256) :: line(10)
+        character(:), allocatable :: buffer
+
+        a = eye(10)
+        open (newunit=fh, status='scratch')
+
+        line(1) = " 1.0000000000000000E+000  0.0000000000000000E+000  0.0000000000000000E+000  0.0000000000000000E+000  &
+            &0.0000000000000000E+000  0.0000000000000000E+000 ...  0.0000000000000000E+000  0.0000000000000000E+000"
+        line(2) = " 0.0000000000000000E+000  0.0000000000000000E+000  1.0000000000000000E+000  0.0000000000000000E+000  &
+            &0.0000000000000000E+000  0.0000000000000000E+000 ...  0.0000000000000000E+000  0.0000000000000000E+000"
+        line(3) = " 0.0000000000000000E+000  0.0000000000000000E+000  0.0000000000000000E+000  0.0000000000000000E+000  &
+            &1.0000000000000000E+000  0.0000000000000000E+000 ...  0.0000000000000000E+000  0.0000000000000000E+000"
+        line(4) = "..."
+        line(5) = " 0.0000000000000000E+000  0.0000000000000000E+000  0.0000000000000000E+000  0.0000000000000000E+000  &
+            &0.0000000000000000E+000  0.0000000000000000E+000 ...  1.0000000000000000E+000  0.0000000000000000E+000"
+
+        call print_array(a, fh)
+        rewind (fh)
+        do i = 1, 5
+            call get_line(fh, buffer)
+            call check(error, buffer, trim(line(i)))
+            if (allocated(error)) return
+        end do
+
+        rewind (fh)
+        line(1)  = "1.00,0.00|0.00,0.00|0.00,0.00|0.00,0.00|0.00,0.00"
+        line(2)  = "0.00,0.00|1.00,0.00|0.00,0.00|0.00,0.00|0.00,0.00"
+        line(3)  = "0.00,0.00|0.00,0.00|1.00,0.00|0.00,0.00|0.00,0.00"
+        line(4)  = "0.00,0.00|0.00,0.00|0.00,0.00|1.00,0.00|0.00,0.00"
+        line(5)  = "0.00,0.00|0.00,0.00|0.00,0.00|0.00,0.00|1.00,0.00"
+        line(6:) = "0.00,0.00|0.00,0.00|0.00,0.00|0.00,0.00|0.00,0.00"
+        call print_array(a(:, :5), fh, fmt="(f4.2,"","",f4.2)", brief=.false., delimiter="|")
+        rewind (fh)
+        do i = 1, 10
+            call get_line(fh, buffer)
+            call check(error, buffer, trim(line(i)))
+            if (allocated(error)) return
+        end do
+
+        close (fh)
+
+    end subroutine test_print_cdp
+
+    subroutine test_print_csp(error)
+        !> Error handling
+        type(error_type), allocatable, intent(out) :: error
+        complex(sp) :: a(10, 10)
+        integer :: fh, i
+        character(256) :: line(10)
+        character(:), allocatable :: buffer
+
+        a = eye(10)
+        open (newunit=fh, status='scratch')
+
+        line(1) = " 1.00000000E+00  0.00000000E+00  0.00000000E+00  0.00000000E+00  0.00000000E+00  0.00000000E+00 ...  &
+            &0.00000000E+00  0.00000000E+00"
+        line(2) = " 0.00000000E+00  0.00000000E+00  1.00000000E+00  0.00000000E+00  0.00000000E+00  0.00000000E+00 ...  &
+            &0.00000000E+00  0.00000000E+00"
+        line(3) = " 0.00000000E+00  0.00000000E+00  0.00000000E+00  0.00000000E+00  1.00000000E+00  0.00000000E+00 ...  &
+            &0.00000000E+00  0.00000000E+00"
+        line(4) = "..."
+        line(5) = " 0.00000000E+00  0.00000000E+00  0.00000000E+00  0.00000000E+00  0.00000000E+00  0.00000000E+00 ...  &
+            &1.00000000E+00  0.00000000E+00"
+
+        call print_array(a, fh)
+        rewind (fh)
+        do i = 1, 5
+            call get_line(fh, buffer)
+            call check(error, buffer, trim(line(i)))
+            if (allocated(error)) return
+        end do
+
+        rewind (fh)
+        line(1) =  " 1.00, 0.00; 0.00, 0.00; 0.00, 0.00; 0.00, 0.00; 0.00, 0.00"
+        line(2) =  " 0.00, 0.00; 1.00, 0.00; 0.00, 0.00; 0.00, 0.00; 0.00, 0.00"
+        line(3) =  " 0.00, 0.00; 0.00, 0.00; 1.00, 0.00; 0.00, 0.00; 0.00, 0.00"
+        line(4) =  " 0.00, 0.00; 0.00, 0.00; 0.00, 0.00; 1.00, 0.00; 0.00, 0.00"
+        line(5) =  " 0.00, 0.00; 0.00, 0.00; 0.00, 0.00; 0.00, 0.00; 1.00, 0.00"
+        line(6:) = " 0.00, 0.00; 0.00, 0.00; 0.00, 0.00; 0.00, 0.00; 0.00, 0.00"
+        call print_array(a(:, :5), fh, fmt="(1x,f4.2,"","",1x,f4.2)", brief=.false., delimiter=";")
+        rewind (fh)
+        do i = 1, 10
+            call get_line(fh, buffer)
+            call check(error, buffer, trim(line(i)))
+            if (allocated(error)) return
+        end do
+
+        close (fh)
+
+    end subroutine test_print_csp
+
+end module test_print_array
+
+program tester
+
+    use, intrinsic :: iso_fortran_env, only: error_unit
+    use testdrive, only: run_testsuite, new_testsuite, testsuite_type
+    use test_print_array, only: collect_print_array
+    implicit none
+    integer :: stat, is
+    type(testsuite_type), allocatable :: testsuites(:)
+    character(len=*), parameter :: fmt = '("#", *(1x, a))'
+
+    stat = 0
+
+    testsuites = [ &
+                 new_testsuite("print-array", collect_print_array) &
+                 ]
+
+    do is = 1, size(testsuites)
+        write (error_unit, fmt) "Testing:", testsuites(is)%name
+        call run_testsuite(testsuites(is)%collect, error_unit, stat)
+    end do
+
+    if (stat > 0) then
+        write (error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
+        error stop
+    end if
+
+end program tester
+