program main
    use psb_spmm_test
    use psb_base_mod
    use psb_util_mod

    implicit none

    ! matrix stats variables
    integer(psb_ipk_)       :: rows, cols

    ! MPI variables
    integer(psb_ipk_)       :: my_rank, np

    ! parameters array
    character(len=64)       :: x(4),y(4)  
    real(psb_spk_)          :: alpha(3), beta(3)  

    ! cycle indexes variables
    integer(psb_ipk_)       :: i,j,k,h,l
    character(len=256)      :: matrix_file
    logical                 :: matrix_exists
    integer(psb_ipk_)       :: info
    integer(psb_ipk_)       :: tests_number, count, last_percent

    ! sparse matrices
    type(psb_sspmat_type)   :: a
    type(psb_lsspmat_type)  :: aux_a

    ! matrix descriptor data structure
    type(psb_desc_type)     :: desc_a

    ! Communicator variable
    type(psb_ctxt_type)     :: ctxt

    ! Initialize parameters
    x(1) = "vectors/x1.mtx"
    x(2) = "vectors/x2.mtx"
    x(3) = "vectors/x3.mtx"
    x(4) = "vectors/x4.mtx"

    y(1) = "vectors/y1.mtx"
    y(2) = "vectors/y2.mtx"
    y(3) = "vectors/y3.mtx"
    y(4) = "vectors/y4.mtx"

    alpha(1) = sone
    alpha(2) = -sone
    alpha(3) = szero

    beta(1) = sone
    beta(2) = -sone
    beta(3) = szero

    tests_number = size(x) * size(y) * size(alpha) * size(beta)
    count = 0
    last_percent = -1

    call psb_init(ctxt)
    call psb_info(ctxt,my_rank,np)

    matrix_file = "matrix/1138_bus.mtx"
    inquire(file=matrix_file, exist=matrix_exists)
    if (.not.matrix_exists) then
        if (my_rank == psb_root_) then
            write(psb_out_unit,*) 'Matrix file not found. Expected matrix/1138_bus.mtx'
        end if
        call psb_abort(ctxt)
    end if

    if(my_rank == psb_root_) then
        write(psb_out_unit,*) 'Welcome to PSBLAS version: ',psb_version_string_
        write(psb_out_unit,*) 'This is the psb_spmm_test sample program'

        call read_matrix_market_size(matrix_file, rows, cols)

        call generate_vectors(rows,cols) 
    end if

    call psb_bcast(ctxt,rows)
    call psb_bcast(ctxt,cols)
    
    call psb_barrier(ctxt)

    !! Read and distribute matrix once
    call mm_mat_read(aux_a,info,filename=matrix_file)
    if(info /= psb_success_) then
        write(psb_out_unit,*) "Error while reading matrix ", matrix_file
        call psb_abort(ctxt)
    end if

    rows = aux_a%get_nrows()
    cols = aux_a%get_ncols()

    call psb_matdist(aux_a, a, ctxt, desc_a, info, fmt="COO", parts=part_block)
    if(info /= psb_success_) then
        write(psb_out_unit,*) "Error while distributing matrix"
        call psb_abort(ctxt)
    end if

    !! bcsstk29 matrix (sparse) - reuse distributed matrix across all parameter combinations
    do i=1,size(x)
        do j=1,size(y)
            do k=1,size(alpha)
                do h=1,size(beta)
                    call psb_spmm_kernel(a=a, desc_a=desc_a, rows=rows, cols=cols, &
                        & x_file=x(i), y_file=y(j), alpha=alpha(k), beta=beta(h), ctxt=ctxt)
                    if (my_rank == psb_root_) then
                        count = count + 1
                        call print_progress(count, tests_number, last_percent, "spmm testcases")
                    end if
                end do
            end do
        end do
    end do

    !! Deallocate matrix structures
    call psb_spfree(a, desc_a, info)
    call psb_cdfree(desc_a, info)


    call psb_exit(ctxt)

    return
contains

    subroutine print_progress(current, total, last_percent, label)
        use iso_fortran_env, only: error_unit
        implicit none
        integer(psb_ipk_), intent(in)    :: current, total
        integer(psb_ipk_), intent(inout) :: last_percent
        character(len=*), intent(in)     :: label
        integer(psb_ipk_)                :: percent, filled, width, i
        character(len=160)               :: line

        if (total <= 0) return
        percent = int(real(current) / real(total) * 100.0)
        if (percent == last_percent) return
        last_percent = percent

        width = 30
        filled = int(real(percent) / 100.0 * width)

        line = "[INFO]    Progress " // trim(label) // ": ["
        do i = 1, filled
            line = trim(line) // "#"
        end do
        do i = filled + 1, width
            line = trim(line) // "-"
        end do
        line = trim(line) // "] "
        write(line(len_trim(line)+1:), '(I3)') percent
        line = trim(line) // "% (" // trim(adjustl(itoa(current))) // "/" // trim(adjustl(itoa(total))) // ")"
        if (percent < 100) then
            write(error_unit,'(A)') char(13) // char(27) // "[2K" // trim(line) // char(27) // "[1A"
        else
            write(error_unit,'(A)') char(13) // char(27) // "[2K" // trim(line)
        end if
        call flush(error_unit)
    end subroutine print_progress

    pure function itoa(i) result(str)
        implicit none
        integer(psb_ipk_), intent(in) :: i
        character(len=32) :: str
        write(str,'(I0)') i
    end function itoa

end program main