display_matrices.F90 Source File

#include "macros.h"

module display_matrices
    use constants, only: dp, stdout, n_int, bits_n_int
    use util_mod, only: get_free_unit, operator(.div.), stop_all
    use fortran_strings, only: str
    implicit none
    private
    public :: write_matrix, write_bitmask

    interface write_matrix
        module procedure write_matrix_1D, write_matrix_2D, write_matrix_1D_int, write_matrix_2D_int
    end interface

contains

    subroutine write_matrix_2D(M, dec_places, unit_id, advance)
        real(dp), intent(in) :: M(:, :)
        integer, intent(in), optional :: dec_places, unit_id
        logical, intent(in), optional :: advance
        integer :: unit_id_, i
        logical :: advance_

        def_default(unit_id_, unit_id, stdout)
        def_default(advance_, advance, .true.)

        write(unit_id_, '(A)') '['
        do i = 1, size(M, 1) - 1
            write(unit_id_, '(A)', advance='no') ' '
            call write_matrix(M(i, :), dec_places, unit_id_, advance=.false.)
            write(unit_id_, '(A)') ','
        end do
        write(unit_id_, '(A)', advance='no') ' '
        call write_matrix(M(i, :), dec_places, unit_id_, advance=.true.)

        write(unit_id_, '(A)', advance=merge('yes', 'no ', advance_)) ']'
    end subroutine

    subroutine write_matrix_1D(M, dec_places, unit_id, advance)
        real(dp), intent(in) :: M(:)
        integer, intent(in), optional :: dec_places, unit_id
        logical, intent(in), optional :: advance
        integer :: dec_places_, unit_id_
        logical :: advance_

        character(:), allocatable :: fmter, fmter_no_comma
        integer :: i

        def_default(dec_places_, dec_places, 5)
        def_default(unit_id_, unit_id, stdout)
        def_default(advance_, advance, .true.)

        fmter = '(E'//str(dec_places_ + 6)//'.'//str(dec_places_)//', A2)'
        fmter_no_comma = '(E'//str(dec_places_ + 6)//'.'//str(dec_places_)//')'

        write(unit_id_, '(A)', advance='no') '['
        do i = 1, size(M) - 1
            write(unit_id_, fmter, advance='no') M(i), ', '
        end do
        write(unit_id_, fmter_no_comma, advance='no') M(size(M))
        write(unit_id_, '(A)', advance=merge('yes', 'no ', advance_)) ']'
    end subroutine

    subroutine write_matrix_2D_int(M, unit_id, advance)
        integer, intent(in) :: M(:, :)
        integer, intent(in), optional :: unit_id
        logical, intent(in), optional :: advance
        integer :: unit_id_, i
        logical :: advance_

        def_default(unit_id_, unit_id, stdout)
        def_default(advance_, advance, .true.)

        write(unit_id_, '(A)') '['
        do i = 1, size(M, 1) - 1
            write(unit_id_, '(A)', advance='no') ' '
            call write_matrix(M(i, :), unit_id_, advance=.false.)
            write(unit_id_, '(A)') ','
        end do
        write(unit_id_, '(A)', advance='no') ' '
        call write_matrix(M(i, :), unit_id_, advance=.true.)

        write(unit_id_, '(A)', advance=merge('yes', 'no ', advance_)) ']'
    end subroutine

    subroutine write_matrix_1D_int(M, unit_id, advance)
        integer, intent(in) :: M(:)
        integer, intent(in), optional :: unit_id
        logical, intent(in), optional :: advance
        integer :: unit_id_
        logical :: advance_

        character(:), allocatable :: fmter, fmter_no_comma
        integer :: i

        def_default(unit_id_, unit_id, stdout)
        def_default(advance_, advance, .true.)

        fmter = '(I0, A2)'
        fmter_no_comma = '(I0)'

        write(unit_id_, '(A)', advance='no') '['
        do i = 1, size(M) - 1
            write(unit_id_, fmter, advance='no') M(i), ', '
        end do
        write(unit_id_, fmter_no_comma, advance='no') M(size(M))
        write(unit_id_, '(A)', advance=merge('yes', 'no ', advance_)) ']'
    end subroutine

    subroutine write_bitmask(vec, L, unit_id, advance)
        integer(n_int), intent(in) :: vec(0:)
        integer, intent(in) :: L
        debug_function_name("write_bitmask")
        integer, intent(in), optional :: unit_id
        logical, intent(in), optional :: advance

        integer :: unit_id_
        logical :: advance_
        integer :: i

        def_default(unit_id_, unit_id, stdout)
        def_default(advance_, advance, .true.)

        ASSERT(L <= size(vec) * bits_n_int)
        write(unit_id_, '(A)', advance='no') '['
        do i = 1, L
            if (IsOcc(vec, i)) then
                write(unit_id_, '(A)', advance='no') '1'
            else
                write(unit_id_, '(A)', advance='no') '0'
            end if
        end do
        write(unit_id_, '(A)', advance=merge('yes', 'no ', advance_)) ']'
    end subroutine

end module