fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-18 20:02:27 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
test/kernel/d_file_spmv.f90
 test/kernel/s_file_spmv.f90

Fix matrix distribution
This commit is contained in:
Salvatore Filippone
2017-03-08 17:10:39 +00:00
parent 240efbc338
commit f2cf78e520
2 changed files with 16 additions and 29 deletions
Download Patch File Download Diff File Expand all files Collapse all files
test/kernel/d_file_spmv.f90
+8 -14
View File
@@ -157,18 +157,11 @@ program d_file_spmv
b_col_glob(i) = 1.d0
enddo
endif
call psb_bcast(ictxt,b_col_glob(1:m_problem))
else
call psb_bcast(ictxt,m_problem)
call psb_realloc(m_problem,1,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
endif
b_col_glob =>aux_b(:,1)
call psb_bcast(ictxt,b_col_glob(1:m_problem))
end if
@@ -181,8 +174,7 @@ program d_file_spmv
call part_block(i,m_problem,np,ipv,nv)
ivg(i) = ipv(1)
enddo
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
else if (ipart == 2) then
if (iam==psb_root_) then
@@ -195,18 +187,20 @@ program d_file_spmv
call psb_barrier(ictxt)
call distr_mtpart(psb_root_,ictxt)
call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,v=ivg)
else
if (iam==psb_root_) write(psb_out_unit,'("Partition type: default block")')
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,parts=part_block)
call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,parts=part_block)
end if
call psb_geall(x_col,desc_a,info)
call x_col%set(done)
call psb_geasb(x_col,desc_a,info)
call psb_geall(b_col,desc_a,info)
call x_col%zero()
call psb_geasb(b_col,desc_a,info)
t2 = psb_wtime() - t1
@@ -218,7 +212,7 @@ program d_file_spmv
write(psb_out_unit,'(" ")')
end if
call psb_barrier(ictxt)
t1 = psb_wtime()
do i=1,times
test/kernel/s_file_spmv.f90
+8 -15
View File
@@ -62,7 +62,7 @@ program s_file_spmv
character(len=20) :: name
character(len=2) :: filefmt
integer(psb_ipk_), parameter :: iunit=12
integer(psb_ipk_), parameter :: times=10
integer(psb_ipk_), parameter :: times=20
integer(psb_ipk_) :: iparm(20)
! other variables
@@ -157,18 +157,11 @@ program s_file_spmv
b_col_glob(i) = 1.d0
enddo
endif
call psb_bcast(ictxt,b_col_glob(1:m_problem))
else
call psb_bcast(ictxt,m_problem)
call psb_realloc(m_problem,1,aux_b,ircode)
if (ircode /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
endif
b_col_glob =>aux_b(:,1)
call psb_bcast(ictxt,b_col_glob(1:m_problem))
end if
@@ -181,8 +174,7 @@ program s_file_spmv
call part_block(i,m_problem,np,ipv,nv)
ivg(i) = ipv(1)
enddo
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
call psb_matdist(aux_a, a, ictxt,desc_a,info,fmt=afmt,v=ivg)
else if (ipart == 2) then
if (iam==psb_root_) then
@@ -195,18 +187,19 @@ program s_file_spmv
call psb_barrier(ictxt)
call distr_mtpart(psb_root_,ictxt)
call getv_mtpart(ivg)
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,v=ivg)
call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,v=ivg)
else
if (iam==psb_root_) write(psb_out_unit,'("Partition type: block")')
call psb_matdist(aux_a, a, ictxt, &
& desc_a,info,b_glob=b_col_glob,b=b_col,fmt=afmt,parts=part_block)
if (iam==psb_root_) write(psb_out_unit,'("Partition type: default block")')
call psb_matdist(aux_a, a, ictxt, desc_a,info,fmt=afmt,parts=part_block)
end if
call psb_geall(x_col,desc_a,info)
call x_col%set(sone)
call psb_geasb(x_col,desc_a,info)
call psb_geall(b_col,desc_a,info)
call x_col%zero()
call psb_geasb(b_col,desc_a,info)
t2 = psb_wtime() - t1