Here is a module to pretty print a 2D arrays on the console. It also supports 1D arrays.
module mod_show_matrix
use mod_common
implicit none
interface show
procedure show_vector_i, show_vector_r, show_vector_d
procedure show_matrix_i, show_matrix_r, show_matrix_d
end interface
contains
subroutine show_vector_i(v, w)
! Display the vector 'v' in a single column
! v : the array of real numbers
! w : the column width. default = 5
! s : sig. figures w-5 (calculated)
integer, intent(in) :: v(:)
integer, intent(in), optional :: w
integer :: i,n,wt
character(len=16) :: fmt
if(present(w)) then
wt = w
else
wt = 5
end if
n = size(v)
write( fmt, "(a,g0,a)") "(*(1x,g",wt,".0))"
write( * , fmt ) ( v(i), new_line("A"), i=1,n )
end subroutine
subroutine show_vector_r(v, w)
! Display the vector 'v' in a single column
! v : the array of real numbers
! w : the column width. default = 12
! s : sig. figures w-5 (calculated)
real(real32), intent(in) :: v(:)
integer, intent(in), optional :: w
integer :: i,n,dg,wt
character(len=16) :: fmt
if(present(w)) then
wt = w
else
wt = 12
end if
dg = wt - 6
n = size(v)
write( fmt, "(a,g0,a,g0,a)") "(*(1x,g",wt,".",dg,"))"
write( * , fmt ) ( v(i), new_line("A"), i=1,n )
end subroutine
subroutine show_vector_d(v, w)
! Display the vector 'v' in a single column
! v : the array of real numbers
! w : the column width. default = 12
! s : sig. figures w-5 (calculated)
real(real64), intent(in) :: v(:)
real(real32), allocatable :: u(:)
integer, intent(in), optional :: w
u =real(v)
where( abs(u)<1e-11 )
u = 0.0
end where
call show_vector_r(u,w)
end subroutine
subroutine show_matrix_i(A, w)
! Display the matrix 'A' in columns
! A : the array of integers
! w : the column width. default = 5
integer, intent(in) :: A(:,:)
integer, intent(in), optional :: w
integer :: i,j,n,m, wt
character(len=16) :: fmt
if(present(w)) then
wt = w
else
wt = 5
end if
n = size(A,1)
m = size(A,2)
write( fmt, "(a,g0,a)") "(*(1x,g",wt,".0))"
write( * , fmt ) ( (A(i,j),j=1,m), new_line("A"), i=1,n )
end subroutine
subroutine show_matrix_r(A, w)
! Display the matrix 'A' in columns
! A : the array of real numbers
! w : the column width. default = 12
! s : sig. figures w-5 (calculated)
real(real32), intent(in) :: A(:,:)
integer, intent(in), optional :: w
integer :: i,j,n,m,dg,wt
character(len=16) :: fmt
if(present(w)) then
wt = w
else
wt = 12
end if
dg = wt - 6
n = size(A,1)
m = size(A,2)
write( fmt, "(a,g0,a,g0,a)") "(*(1x,g",wt,".",dg,"))"
write( * , fmt ) ( (A(i,j),j=1,m), new_line("A"), i=1,n )
end subroutine
subroutine show_matrix_d(A,w)
! Display the matrix 'A' in columns
! A : the array of dble numbers
! w : the column width. default = 12
! Converts 'A' into single precision and calls `show_matrix_r`
real(real64), intent(in) :: A(:,:)
real(real32), allocatable :: B(:,:)
integer, intent(in), optional :: w
B = real(A)
where( abs(B)<1e-11 )
B = 0.0
end where
call show_matrix_r(B,w)
end subroutine
end module
example code for testing, with integer, real and double vectors and matrices
subroutine test_mod_show()
use mod_show_matrix
integer, parameter :: n = 12, m = 6
integer :: iA(n,m), iV(n)
real :: rA(n,m), rV(n)
real(real64) :: dA(n,m), dV(n)
call RANDOM_NUMBER(dV)
call RANDOM_NUMBER(dA)
dV = -1000.0d0 + 2000.0d0 * dV
dA = -1000.0d0 + 2000.0d0 * dA
rV = REAL(dV)
iV = NINT(dV)
rA = REAL(dA)
iA = NINT(dA)
print *, "Vectors"
call show(iV)
call show(rV)
call show(dV)
print *, "Matrices"
call show(iA)
call show(rA)
call show(dA)
end subroutine
with output
Vectors
-812
-300
-725
147
439
982
92
185
420
815
-457
186
-811.931
-300.402
-724.711
147.355
439.164
981.604
91.8634
184.538
420.419
815.408
-456.781
185.557
-811.931
-300.402
-724.711
147.355
439.164
981.604
91.8634
184.538
420.419
815.408
-456.781
185.557
Matrices
-63 667 699 -127 -706 -993
771 -26 -703 395 815 -193
417 347 648 618 -980 282
418 -996 -201 -958 382 133
863 546 -105 -85 -732 1000
258 -19 71 54 -659 929
733 763 -131 -150 -211 740
-416 490 -259 458 -35 -244
230 -285 773 999 481 797
498 -204 67 -495 -629 -209
7 -896 226 619 260 -364
-451 886 -399 574 -569 130
-62.7683 667.230 698.727 -127.294 -706.111 -992.679
771.382 -26.1508 -703.281 394.592 815.305 -193.117
416.630 346.530 647.946 618.252 -979.542 281.533
418.474 -995.676 -200.940 -957.687 382.064 132.730
862.885 546.431 -105.299 -85.1874 -732.206 999.754
258.189 -18.6606 71.2264 54.2078 -658.914 928.694
733.123 762.584 -130.860 -150.476 -211.242 739.778
-415.526 490.129 -259.413 458.103 -35.1639 -244.046
229.853 -284.816 772.724 998.592 481.294 796.775
497.563 -203.624 66.5493 -495.422 -628.974 -209.398
6.86585 -896.292 226.299 619.395 259.609 -364.034
-450.501 885.879 -399.171 574.497 -569.222 129.725
-62.7683 667.230 698.727 -127.294 -706.111 -992.679
771.382 -26.1508 -703.281 394.592 815.305 -193.117
416.630 346.530 647.946 618.252 -979.542 281.533
418.474 -995.676 -200.940 -957.687 382.064 132.730
862.885 546.431 -105.299 -85.1874 -732.206 999.754
258.189 -18.6606 71.2264 54.2078 -658.914 928.694
733.123 762.584 -130.860 -150.476 -211.242 739.778
-415.526 490.129 -259.413 458.103 -35.1639 -244.046
229.853 -284.816 772.724 998.592 481.294 796.775
497.563 -203.624 66.5493 -495.422 -628.974 -209.398
6.86585 -896.292 226.299 619.395 259.609 -364.034
-450.501 885.879 -399.171 574.497 -569.222 129.725