[stdlib_io] disp(display your data)

doc/specs/stdlib_io.md

@@ -131,3 +131,98 @@ program demo_savetxt
     call savetxt('example.dat', x) 
 end program demo_savetxt
 ```
+
+## `disp` - quickly display your data to the screen (or the default output location)
+
+### Status
+
+Experimental
+
+### Description
+Quickly display strings, scalars and low-dimensional arrays to the screen (or the default output location).
+
+### Syntax
+
+For 3D arrays:
+`call [[stdlib_io(module):disp(interface)]](value, dim [, string])`  
+For null:
+`call [[stdlib_io(module):disp(interface)]]()`  
+For others:
+`call [[stdlib_io(module):disp(interface)]](value [, string])`
+
+### Arguments
+
+`value`: Shall be any type of scalar or (<= 3)D `array`.
+
+`dim`: Shall be a scalar of type `integer` with a value: 1, 2 or 3.
+
+`string`: Shall be a scalar of type `character` with any length(Usually used to mark data information).
+
+### Output
+
+The result is to print your data `value` and comments `string` on the screen (or the default output location).
+
+### Example
+
+```fortran
+program demo_io_disp
+    use, non_intrinsic :: stdlib_io, only: disp
+    implicit none
+    real :: r(2, 3)
+    complex :: c(2, 3), c_3d(2, 3, 2)
+    integer :: i(2, 3)
+    logical :: l(2, 3)
+
+    r = 1.; c = 1.; c_3d = 2.; i = 1; l = .true.
+    r(1, 1) = (1.e-11, 1.0e-4)
+    c(2, 2) = 10.e5
+    c_3d(1,3,1) = (1000, 0.001)
+        call disp('string', 'disp(string):')
+        call disp('It is a note.')
+        call disp()
+
+        call disp(r, 'disp(r):')
+        call disp(c, 'disp(c):')
+        call disp(i, 'disp(i):')
+        call disp(l, 'disp(l):')
+
+        call disp(c_3d, 3, 'disp(c_3d, 3):')
+        call disp(c_3d, 2, 'disp(c_3d, 2):')
+end program demo_io_disp
+```
+**Result:**
+```fortran
+ disp(string):
+ string
+ It is a note.
+
+ disp(r):
+ 0.1000E-10   1.000       1.000
+  1.000       1.000       1.000
+ disp(c):
+          (1.000,0.000)           (1.000,0.000)           (1.000,0.000)
+          (1.000,0.000)      (0.1000E+07,0.000)           (1.000,0.000)
+ disp(i):
+          1           1           1
+          1           1           1
+ disp(l):
+          T           T           T
+          T           T           T
+ disp(c_3d, 3):
+ Slice (:,:,1):
+          (2.000,0.000)           (2.000,0.000)      (1000.,0.1000E-02)
+          (2.000,0.000)           (2.000,0.000)           (2.000,0.000)
+ Slice (:,:,2):
+          (2.000,0.000)           (2.000,0.000)           (2.000,0.000)
+          (2.000,0.000)           (2.000,0.000)           (2.000,0.000)
+ disp(c_3d, 2):
+ Slice (:,1,:):
+          (2.000,0.000)           (2.000,0.000)
+          (2.000,0.000)           (2.000,0.000)
+ Slice (:,2,:):
+          (2.000,0.000)           (2.000,0.000)
+          (2.000,0.000)           (2.000,0.000)
+ Slice (:,3,:):
+     (1000.,0.1000E-02)           (2.000,0.000)
+          (2.000,0.000)           (2.000,0.000)
+```

src/CMakeLists.txt

@@ -7,6 +7,7 @@ set(fppFiles
     stdlib_bitsets_64.fypp
     stdlib_bitsets_large.fypp
     stdlib_io.fypp
+    stdlib_io_disp.fypp
     stdlib_linalg.fypp
     stdlib_linalg_diag.fypp
     stdlib_optval.fypp

src/Makefile.manual

@@ -27,7 +27,8 @@ SRCFYPP =\
         stdlib_stats_distribution_PRNG.fypp \
         stdlib_string_type.fypp \
         stdlib_strings.fypp \
-        stdlib_strings_format_string.fypp
+        stdlib_strings_format_string.fypp \
+        stdlib_io_disp.fypp
 
 SRC = f18estop.f90 \
       stdlib_error.f90 \
@@ -69,7 +70,8 @@ stdlib_error.o: stdlib_optval.o
 stdlib_io.o: \
 	stdlib_error.o \
 	stdlib_optval.o \
-	stdlib_kinds.o
+	stdlib_kinds.o \
+    stdlib_ascii.o
 stdlib_linalg.o: \
 	stdlib_kinds.o
 stdlib_linalg_diag.o: \
@@ -134,3 +136,6 @@ stdlib_strings.o: stdlib_ascii.o \
     stdlib_kinds.o
 stdlib_math.o: stdlib_kinds.o
 stdlib_strings_format_string.o: stdlib_strings.o
+stdlib_io_disp.o: stdlib_error.o \
+    stdlib_strings.o \
+    stdlib_io.o

src/stdlib_io.fypp

@@ -7,18 +7,45 @@ module stdlib_io
   !! ([Specification](../page/specs/stdlib_io.html))
 
   use stdlib_kinds, only: sp, dp, qp, &
-      int8, int16, int32, int64
+      int8, int16, int32, int64, lk, c_bool
   use stdlib_error, only: error_stop
   use stdlib_optval, only: optval
   use stdlib_ascii, only: is_blank
   implicit none
   private
   ! Public API
-  public :: loadtxt, savetxt, open
+  public :: loadtxt, savetxt, open, disp
 
   ! Private API that is exposed so that we can test it in tests
   public :: parse_mode
 
+  interface disp
+    !!
+    #:set DISP_KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES &
+        & + CMPLX_KINDS_TYPES + LOG_KINDS_TYPES
+    #:set DISP_RANKS = range(0, 4)
+    #:for kind, type in DISP_KINDS_TYPES
+    #:for rank in DISP_RANKS
+    #:if rank != 3
+    impure module subroutine disp_${rank}$_${type[0]}$${kind}$(val, string)
+        ${type}$, intent(in) :: val${ranksuffix(rank)}$
+        character(len=*), intent(in), optional :: string
+    end subroutine disp_${rank}$_${type[0]}$${kind}$
+    #:else
+    impure module subroutine disp_${rank}$_${type[0]}$${kind}$(val, dim, string)
+        ${type}$, intent(in) :: val${ranksuffix(rank)}$
+        integer, intent(in) :: dim
+        character(len=*), intent(in), optional :: string
+    end subroutine disp_${rank}$_${type[0]}$${kind}$
+    #:endif
+    #:endfor
+    #:endfor
+    impure module subroutine disp_str(val, string)
+        character(len=*), intent(in), optional :: val
+        character(len=*), intent(in), optional :: string
+    end subroutine disp_str
+  end interface disp
+
   interface loadtxt
     !! version: experimental
     !!

src/stdlib_io_disp.fypp

@@ -0,0 +1,125 @@
+#:include "common.fypp"
+#:set RIL_KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + LOG_KINDS_TYPES
+
+submodule (stdlib_io) stdlib_io_disp
+
+    use, non_intrinsic :: stdlib_strings, only: format_string
+    implicit none
+    character(len=*), parameter :: fmt_r = '(*(g11.4, 1x))'
+    character(len=*), parameter :: fmt_c = '(*(g23.4, 1x))'
+
+contains
+
+    #:for kind, type in RIL_KINDS_TYPES
+    module procedure disp_0_${type[0]}$${kind}$
+        if(present(string)) print *, trim(string)
+        print fmt_r, val
+    end procedure disp_0_${type[0]}$${kind}$
+
+    module procedure disp_1_${type[0]}$${kind}$
+        integer :: i, m
+        m = size(val)
+        if(present(string)) print *, trim(string)
+        print fmt_r, (val(i), i=1,m)
+    end procedure disp_1_${type[0]}$${kind}$
+
+    module procedure disp_2_${type[0]}$${kind}$
+        integer :: i, j, m, n
+        m = size(val, 1)
+        n = size(val, 2)
+        if(present(string)) print *, trim(string)
+        do i = 1, m
+            print fmt_r, (val(i,j), j=1, n)
+        end do
+    end procedure disp_2_${type[0]}$${kind}$
+
+    module procedure disp_3_${type[0]}$${kind}$
+        integer :: i, dim1, dim2, dim3
+        dim1 = size(val, 1)
+        dim2 = size(val, 2)
+        dim3 = size(val, 3)
+        if(present(string)) print *, trim(string)
+        if(dim == 1) then
+            do i = 1, dim1
+                print *, 'Slice ('//format_string(i)//',:,:):'
+                call disp_2_${type[0]}$${kind}$(val(i, :, :))
+            end do
+        elseif(dim == 2) then
+            do i = 1, dim2
+                print *, 'Slice (:,'//format_string(i)//',:):'
+                call disp_2_${type[0]}$${kind}$(val(:, i, :))
+            end do
+        elseif (dim == 3) then
+            do i = 1, dim3
+                print *, 'Slice (:,:,'//format_string(i)//'):'
+                call disp_2_${type[0]}$${kind}$(val(:, :, i))
+            end do
+        else
+            call error_stop('Error(disp): wrong dimension')
+        end if
+    end procedure disp_3_${type[0]}$${kind}$
+    #:endfor
+
+    #:for kind, type in CMPLX_KINDS_TYPES
+    module procedure disp_0_${type[0]}$${kind}$
+        if(present(string)) print *, trim(string)
+        print fmt_c, format_string(cmplx(real(val), &
+                                         aimag(val)), '(g11,4)')
+    end procedure disp_0_${type[0]}$${kind}$
+
+    module procedure disp_1_${type[0]}$${kind}$
+        integer :: i, m
+        m = size(val)
+        if(present(string)) print *, trim(string)
+        print fmt_c, (format_string(cmplx(real(val(i)), &
+                        aimag(val(i))), '(g11.4)'), i=1, m)
+    end procedure disp_1_${type[0]}$${kind}$
+
+    module procedure disp_2_${type[0]}$${kind}$
+        integer :: i, j, m, n
+        m = size(val, 1)
+        n = size(val, 2)
+        if(present(string)) print *, trim(string)
+        do i = 1, m
+            print fmt_c, (format_string(cmplx(real(val(i, j)), &
+                            aimag(val(i, j))), '(g11.4)'), j=1, n)
+        end do
+    end procedure disp_2_${type[0]}$${kind}$
+
+    module procedure disp_3_${type[0]}$${kind}$
+        integer :: i, dim1, dim2, dim3
+        dim1 = size(val, 1)
+        dim2 = size(val, 2)
+        dim3 = size(val, 3)
+        if(present(string)) print *, trim(string)
+        if(dim == 1) then
+            do i = 1, dim1
+                print *, 'Slice ('//format_string(i)//',:,:):'
+                call disp_2_${type[0]}$${kind}$(val(i, :, :))
+            end do
+        elseif(dim == 2) then
+            do i = 1, dim2
+                print *, 'Slice (:,'//format_string(i)//',:):'
+                call disp_2_${type[0]}$${kind}$(val(:, i, :))
+            end do
+        elseif (dim == 3) then
+            do i = 1, dim3
+                print *, 'Slice (:,:,'//format_string(i)//'):'
+                call disp_2_${type[0]}$${kind}$(val(:, :, i))
+            end do
+        else
+            call error_stop('Error(disp): wrong dimension')
+        end if
+    end procedure disp_3_${type[0]}$${kind}$
+    #:endfor
+
+    module procedure disp_str
+        if(present(string)) print *, trim(string)
+        if(present(val)) then
+            print *, trim(val)
+        else
+            print *, ''
+        end if
+    end procedure disp_str
+
+end submodule stdlib_io_disp

src/tests/io/CMakeLists.txt

@@ -8,3 +8,4 @@ set_tests_properties(savetxt_qp PROPERTIES LABELS quadruple_precision)
 
 ADDTEST(open)
 ADDTEST(parse_mode)
+ADDTEST(io_disp)

src/tests/io/Makefile.manual

@@ -3,7 +3,8 @@ PROGS_SRC = test_loadtxt.f90 \
 			test_loadtxt_qp.f90 \
 			test_savetxt_qp.f90 \
 			test_parse_mode.f90 \
-			test_open.f90
+			test_open.f90 \
+            test_io_disp.f90
 
 CLEAN_FILES = tmp.dat tmp_qp.dat io_open.dat io_open.stream
 

src/tests/io/test_io_disp.f90

@@ -0,0 +1,24 @@
+program test_io_disp
+    use, non_intrinsic :: stdlib_io, only: disp
+    implicit none
+    real :: r(2, 3)
+    complex :: c(2, 3), c_3d(2, 3, 2)
+    integer :: i(2, 3)
+    logical :: l(2, 3)
+
+    r = 1.; c = 1.; c_3d = 2.; i = 1; l = .true.
+    r(1, 1) = (1.e-11, 1.0e-4)
+    c(2, 2) = 10.e5
+    c_3d(1,3,1) = (1000, 0.001)
+        call disp('string', 'disp(string):')
+        call disp('It is a note.')
+        call disp()
+
+        call disp(r, 'disp(r):')
+        call disp(c, 'disp(c):')
+        call disp(i, 'disp(i):')
+        call disp(l, 'disp(l):')
+
+        call disp(c_3d, 3, 'disp(c_3d, 3):')
+        call disp(c_3d, 2, 'disp(c_3d, 2):')
+end program test_io_disp