Skip to content

Commit

Permalink
testing csr block expansion
Browse files Browse the repository at this point in the history
  • Loading branch information
@jalvesz
jalvesz committed May 18, 2024
1 parent 8ef4387 commit 6c36f8f
Show file tree
Hide file tree
Showing 4 changed files with 72 additions and 27 deletions.
24 changes: 12 additions & 12 deletions src/conversion/fsparse_conversions.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1015,17 +1015,17 @@ subroutine csr_block_expansion_sp(CSR,num_dof)
& + num_dof*(CSR%rowptr(i+1)-CSR%rowptr(i)) - num_dof + p
end do
do p = 1, num_dof
adr1 = rowptr_expn(num_dof*(i-1)+p) - num_dof + 1
adr1 = rowptr_expn(num_dof*(i-1)+p)
do j = CSR%rowptr(i), CSR%rowptr(i+1)-2
adr2 = adr1 + num_dof*(j-CSR%rowptr(i))
do q = 1, num_dof
col_expn(adr2+q) = num_dof*(CSR%col(j)-1)+q
col_expn(adr2+q-1) = num_dof*(CSR%col(j)-1)+q
end do
end do
j = CSR%rowptr(i+1)-1
adr2 = adr1 + num_dof*(j-CSR%rowptr(i))
do q = 1, p
col_expn(adr2+q) = num_dof*(CSR%col(j)-1)+q
col_expn(adr2+q-1) = num_dof*(CSR%col(j)-1)+q
end do
end do
end do
Expand Down Expand Up @@ -1106,17 +1106,17 @@ subroutine csr_block_expansion_dp(CSR,num_dof)
& + num_dof*(CSR%rowptr(i+1)-CSR%rowptr(i)) - num_dof + p
end do
do p = 1, num_dof
adr1 = rowptr_expn(num_dof*(i-1)+p) - num_dof + 1
adr1 = rowptr_expn(num_dof*(i-1)+p)
do j = CSR%rowptr(i), CSR%rowptr(i+1)-2
adr2 = adr1 + num_dof*(j-CSR%rowptr(i))
do q = 1, num_dof
col_expn(adr2+q) = num_dof*(CSR%col(j)-1)+q
col_expn(adr2+q-1) = num_dof*(CSR%col(j)-1)+q
end do
end do
j = CSR%rowptr(i+1)-1
adr2 = adr1 + num_dof*(j-CSR%rowptr(i))
do q = 1, p
col_expn(adr2+q) = num_dof*(CSR%col(j)-1)+q
col_expn(adr2+q-1) = num_dof*(CSR%col(j)-1)+q
end do
end do
end do
Expand Down Expand Up @@ -1197,17 +1197,17 @@ subroutine csr_block_expansion_csp(CSR,num_dof)
& + num_dof*(CSR%rowptr(i+1)-CSR%rowptr(i)) - num_dof + p
end do
do p = 1, num_dof
adr1 = rowptr_expn(num_dof*(i-1)+p) - num_dof + 1
adr1 = rowptr_expn(num_dof*(i-1)+p)
do j = CSR%rowptr(i), CSR%rowptr(i+1)-2
adr2 = adr1 + num_dof*(j-CSR%rowptr(i))
do q = 1, num_dof
col_expn(adr2+q) = num_dof*(CSR%col(j)-1)+q
col_expn(adr2+q-1) = num_dof*(CSR%col(j)-1)+q
end do
end do
j = CSR%rowptr(i+1)-1
adr2 = adr1 + num_dof*(j-CSR%rowptr(i))
do q = 1, p
col_expn(adr2+q) = num_dof*(CSR%col(j)-1)+q
col_expn(adr2+q-1) = num_dof*(CSR%col(j)-1)+q
end do
end do
end do
Expand Down Expand Up @@ -1288,17 +1288,17 @@ subroutine csr_block_expansion_cdp(CSR,num_dof)
& + num_dof*(CSR%rowptr(i+1)-CSR%rowptr(i)) - num_dof + p
end do
do p = 1, num_dof
adr1 = rowptr_expn(num_dof*(i-1)+p) - num_dof + 1
adr1 = rowptr_expn(num_dof*(i-1)+p)
do j = CSR%rowptr(i), CSR%rowptr(i+1)-2
adr2 = adr1 + num_dof*(j-CSR%rowptr(i))
do q = 1, num_dof
col_expn(adr2+q) = num_dof*(CSR%col(j)-1)+q
col_expn(adr2+q-1) = num_dof*(CSR%col(j)-1)+q
end do
end do
j = CSR%rowptr(i+1)-1
adr2 = adr1 + num_dof*(j-CSR%rowptr(i))
do q = 1, p
col_expn(adr2+q) = num_dof*(CSR%col(j)-1)+q
col_expn(adr2+q-1) = num_dof*(CSR%col(j)-1)+q
end do
end do
end do
Expand Down
15 changes: 8 additions & 7 deletions src/conversion/fsparse_conversions.fypp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -356,8 +356,7 @@ contains

select case(CSR%sym)
case(k_NOSYMMETRY)
block_nnz = num_dof ** 2
CSR%NNZ = CSR%NNZ * block_nnz
CSR%NNZ = CSR%NNZ * num_dof ** 2
case(k_SYMTRISUP,k_SYMTRIINF)
block_nnz = num_dof + num_dof * (num_dof-1) / 2
CSR%NNZ = CSR%nrows * block_nnz + (CSR%NNZ-CSR%nrows) * num_dof ** 2
Expand All @@ -371,7 +370,8 @@ contains
case(k_NOSYMMETRY)
do i = 1, CSR%nrows
do p = 1, num_dof
rowptr_expn(num_dof*(i-1)+p+1) = rowptr_expn(num_dof*(i-1)+p) + num_dof*(CSR%rowptr(i+1)-CSR%rowptr(i))
rowptr_expn(num_dof*(i-1)+p+1) = rowptr_expn(num_dof*(i-1)+p) &
& + num_dof*(CSR%rowptr(i+1)-CSR%rowptr(i))
end do
do p = 1, num_dof
adr1 = rowptr_expn(num_dof*(i-1)+p)
Expand All @@ -386,7 +386,8 @@ contains
case(k_SYMTRISUP)
do i = 1, CSR%nrows
do p = 1, num_dof
rowptr_expn(num_dof*(i-1)+p+1) = rowptr_expn(num_dof*(i-1)+p) + num_dof*(CSR%rowptr(i+1)-CSR%rowptr(i)) - p + 1
rowptr_expn(num_dof*(i-1)+p+1) = rowptr_expn(num_dof*(i-1)+p) &
& + num_dof*(CSR%rowptr(i+1)-CSR%rowptr(i)) - p + 1
end do
do p = 1, num_dof
adr1 = rowptr_expn(num_dof*(i-1)+p)
Expand All @@ -410,17 +411,17 @@ contains
& + num_dof*(CSR%rowptr(i+1)-CSR%rowptr(i)) - num_dof + p
end do
do p = 1, num_dof
adr1 = rowptr_expn(num_dof*(i-1)+p) - num_dof + 1
adr1 = rowptr_expn(num_dof*(i-1)+p)
do j = CSR%rowptr(i), CSR%rowptr(i+1)-2
adr2 = adr1 + num_dof*(j-CSR%rowptr(i))
do q = 1, num_dof
col_expn(adr2+q) = num_dof*(CSR%col(j)-1)+q
col_expn(adr2+q-1) = num_dof*(CSR%col(j)-1)+q
end do
end do
j = CSR%rowptr(i+1)-1
adr2 = adr1 + num_dof*(j-CSR%rowptr(i))
do q = 1, p
col_expn(adr2+q) = num_dof*(CSR%col(j)-1)+q
col_expn(adr2+q-1) = num_dof*(CSR%col(j)-1)+q
end do
end do
end do
Expand Down
30 changes: 26 additions & 4 deletions test/test_matrices.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -406,16 +406,38 @@ subroutine test_symmetries(error)
subroutine test_cells2sparse(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
type(COO_dp) :: COO
integer :: cells(4,2)
type(COO_dp) :: COO, COO_n
type(CSR_dp) :: CSR, CSR_n1
real(8), allocatable :: dense(:,:), dense_n(:,:)
integer :: i, k, dof
integer, allocatable :: cells(:,:), cells_n(:,:)

allocate(cells(4,2))
cells(1:4,1) = [2,5,3,4]
cells(1:4,2) = [4,1,3,2]
call coo_from_cells(COO,cells,num_points=5,num_cells=2,selfloop=.true.,symtype=k_SYMTRISUP)

call coo_from_cells(COO,cells,num_points=5,num_cells=2,selfloop=.true.,symtype=k_SYMTRIINF)
call coo2csr(COO,CSR)

call check(error, size(COO%data) == 14 .and. size( COO%index , dim=2 ) == 14 )
if (allocated(error)) return

dof = 4
allocate(cells_n(4*dof,2))
do i =1 , 4
do k = 1, dof
cells_n(dof*(i-1)+k,1) = dof*(cells(i,1)-1)+k
cells_n(dof*(i-1)+k,2) = dof*(cells(i,2)-1)+k
end do
end do

call coo_from_cells(COO_n,cells_n,num_points=5*dof,num_cells=2,selfloop=.true.,symtype=k_SYMTRIINF)
call coo2csr(COO_n,CSR_n1)

call csr_block_expansion(CSR,dof)

call check(error, all(CSR%rowptr==CSR_n1%rowptr) .and. all(CSR%col==CSR_n1%col) )
if (allocated(error)) return

end subroutine

end module test_fsparse
30 changes: 26 additions & 4 deletions test/test_matrices.fypp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -266,16 +266,38 @@ module test_fsparse
subroutine test_cells2sparse(error)
!> Error handling
type(error_type), allocatable, intent(out) :: error
type(COO_dp) :: COO
integer :: cells(4,2)
type(COO_dp) :: COO, COO_n
type(CSR_dp) :: CSR, CSR_n1
real(8), allocatable :: dense(:,:), dense_n(:,:)
integer :: i, k, dof
integer, allocatable :: cells(:,:), cells_n(:,:)

allocate(cells(4,2))
cells(1:4,1) = [2,5,3,4]
cells(1:4,2) = [4,1,3,2]
call coo_from_cells(COO,cells,num_points=5,num_cells=2,selfloop=.true.,symtype=k_SYMTRISUP)

call coo_from_cells(COO,cells,num_points=5,num_cells=2,selfloop=.true.,symtype=k_SYMTRIINF)
call coo2csr(COO,CSR)

call check(error, size(COO%data) == 14 .and. size( COO%index , dim=2 ) == 14 )
if (allocated(error)) return

dof = 4
allocate(cells_n(4*dof,2))
do i =1 , 4
do k = 1, dof
cells_n(dof*(i-1)+k,1) = dof*(cells(i,1)-1)+k
cells_n(dof*(i-1)+k,2) = dof*(cells(i,2)-1)+k
end do
end do

call coo_from_cells(COO_n,cells_n,num_points=5*dof,num_cells=2,selfloop=.true.,symtype=k_SYMTRIINF)
call coo2csr(COO_n,CSR_n1)

call csr_block_expansion(CSR,dof)

call check(error, all(CSR%rowptr==CSR_n1%rowptr) .and. all(CSR%col==CSR_n1%col) )
if (allocated(error)) return

end subroutine

end module test_fsparse

0 comments on commit 6c36f8f

Please sign in to comment.