stdlib_sparse_spmv_ell.fypp Source File


Source Code

#:include "common.fypp"
#:set RANKS = range(1, 2+1)
#:set R_KINDS_TYPES = list(zip(REAL_KINDS, REAL_TYPES, REAL_SUFFIX))
#:set C_KINDS_TYPES = list(zip(CMPLX_KINDS, CMPLX_TYPES, CMPLX_SUFFIX))
#:set KINDS_TYPES = R_KINDS_TYPES+C_KINDS_TYPES
#! define ranks without parentheses
#:def rksfx2(rank)
#{if rank > 0}#${":," + ":," * (rank - 1)}$#{endif}#
#:enddef
submodule (stdlib_sparse_spmv) stdlib_sparse_spmv_ell
contains

    !! spmv_ell
    #:for k1, t1, s1 in (KINDS_TYPES)
    #:for rank in RANKS
    module subroutine spmv_ell_${rank}$d_${s1}$(matrix,vec_x,vec_y,alpha,beta,op)
        type(ELL_${s1}$_type), intent(in) :: matrix
        ${t1}$, intent(in)    :: vec_x${ranksuffix(rank)}$
        ${t1}$, intent(inout) :: vec_y${ranksuffix(rank)}$
        ${t1}$, intent(in), optional :: alpha
        ${t1}$, intent(in), optional :: beta
        character(1), intent(in), optional :: op
        ${t1}$ :: alpha_, beta_
        character(1) :: op_

        op_ = sparse_op_none; if(present(op)) op_ = op
        alpha_ = one_${k1}$
        if(present(alpha)) alpha_ = alpha

        beta_ = zero_${k1}$
        if(present(beta)) beta_ = beta

        call spmv_kernel_ell_${rank}$d_${s1}$(op_,alpha_, &
            matrix%data,matrix%index,matrix%storage, &
            vec_x,beta_,vec_y)

    end subroutine
    
    module subroutine spmv_kernel_ell_${rank}$d_${s1}$(op,alpha,data,index,storage,vec_x,beta,vec_y)
        ${t1}$, intent(in), contiguous :: data(:,:)
        integer(ilp), intent(in), contiguous :: index(:,:)
        integer, intent(in) :: storage
        ${t1}$, intent(in), contiguous    :: vec_x${ranksuffix(rank)}$
        ${t1}$, intent(inout), contiguous :: vec_y${ranksuffix(rank)}$
        ${t1}$, intent(in) :: alpha
        ${t1}$, intent(in) :: beta
        character(1), intent(in) :: op
        integer(ilp) :: i, j, k
        integer(ilp) :: nrows
        integer :: mnz_p_row
        
        nrows = size(index, 1)
        mnz_p_row = size(index, 2)

        vec_y = beta * vec_y

            if( storage == sparse_full .and. op==sparse_op_none ) then
                do i = 1, nrows
                    do k = 1, MNZ_P_ROW
                        j = index(i,k)
                        if(j>0) vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + alpha*data(i,k) * vec_x(${rksfx2(rank-1)}$j)
                    end do
                end do
            else if( storage == sparse_full .and. op==sparse_op_transpose ) then
                do i = 1, nrows
                    do k = 1, MNZ_P_ROW
                        j = index(i,k)
                        if(j>0) vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha*data(i,k) * vec_x(${rksfx2(rank-1)}$i)
                    end do
                end do
            else if( storage /= sparse_full .and. op/=sparse_op_hermitian ) then
                do i = 1, nrows
                    do k = 1, MNZ_P_ROW
                        j = index(i,k)
                        if(j<=0) cycle
                        vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + alpha*data(i,k) * vec_x(${rksfx2(rank-1)}$j)
                        if(i==j) cycle 
                        vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha*data(i,k) * vec_x(${rksfx2(rank-1)}$i)
                    end do
                end do
            #:if t1.startswith('complex')
            else if( storage == sparse_full .and. op==sparse_op_hermitian ) then
                do i = 1, nrows
                    do k = 1, MNZ_P_ROW
                        j = index(i,k)
                        if(j>0) vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha*conjg(data(i,k)) * vec_x(${rksfx2(rank-1)}$i)
                    end do
                end do
            else if( storage /= sparse_full .and. op==sparse_op_hermitian ) then
                do i = 1, nrows
                    do k = 1, MNZ_P_ROW
                        j = index(i,k)
                        if(j<=0) cycle
                        vec_y(${rksfx2(rank-1)}$i) = vec_y(${rksfx2(rank-1)}$i) + alpha*conjg(data(i,k)) * vec_x(${rksfx2(rank-1)}$j)
                        if(i==j) cycle 
                        vec_y(${rksfx2(rank-1)}$j) = vec_y(${rksfx2(rank-1)}$j) + alpha*conjg(data(i,k)) * vec_x(${rksfx2(rank-1)}$i)
                    end do
                end do
            #:endif
            end if
    end subroutine

    #:endfor
    #:endfor

end submodule stdlib_sparse_spmv_ell