New version with ND product

non-diag
sfilippone 1 year ago
parent 86b8a261ef
commit a2788bdf0b

@ -180,12 +180,23 @@ subroutine psb_cspmv_vect(alpha,a,x,beta,y,desc_a,info,&
! Matrix is not transposed ! Matrix is not transposed
if (allocated(a%ad)) then if (allocated(a%ad)) then
block
logical, parameter :: do_timings=.true.
real(psb_dpk_) :: t1, t2, t3, t4, t5
if (do_timings) call psb_barrier(ctxt)
if (do_timings) t1= psb_wtime()
if (doswap_) call psi_swapdata(psb_swap_send_,& if (doswap_) call psi_swapdata(psb_swap_send_,&
& czero,x%v,desc_a,iwork,info,data=psb_comm_halo_) & czero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
if (do_timings) t2= psb_wtime()
call a%ad%spmm(alpha,x%v,beta,y%v,info) call a%ad%spmm(alpha,x%v,beta,y%v,info)
if (do_timings) t3= psb_wtime()
if (doswap_) call psi_swapdata(psb_swap_recv_,& if (doswap_) call psi_swapdata(psb_swap_recv_,&
& czero,x%v,desc_a,iwork,info,data=psb_comm_halo_) & czero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
if (do_timings) t4= psb_wtime()
call a%and%spmm(alpha,x%v,cone,y%v,info) call a%and%spmm(alpha,x%v,cone,y%v,info)
if (do_timings) t5= psb_wtime()
if (do_timings) write(0,*) me,' SPMM:',t2-t1,t3-t2,t4-t3,t5-t4
end block
else else
if (doswap_) then if (doswap_) then

@ -180,21 +180,39 @@ subroutine psb_dspmv_vect(alpha,a,x,beta,y,desc_a,info,&
! Matrix is not transposed ! Matrix is not transposed
if (allocated(a%ad)) then if (allocated(a%ad)) then
block
logical, parameter :: do_timings=.true.
real(psb_dpk_) :: t1, t2, t3, t4, t5
if (do_timings) call psb_barrier(ctxt)
if (do_timings) t1= psb_wtime()
if (doswap_) call psi_swapdata(psb_swap_send_,& if (doswap_) call psi_swapdata(psb_swap_send_,&
& dzero,x%v,desc_a,iwork,info,data=psb_comm_halo_) & dzero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
if (do_timings) t2= psb_wtime()
call a%ad%spmm(alpha,x%v,beta,y%v,info) call a%ad%spmm(alpha,x%v,beta,y%v,info)
if (do_timings) t3= psb_wtime()
if (doswap_) call psi_swapdata(psb_swap_recv_,& if (doswap_) call psi_swapdata(psb_swap_recv_,&
& dzero,x%v,desc_a,iwork,info,data=psb_comm_halo_) & dzero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
if (do_timings) t4= psb_wtime()
call a%and%spmm(alpha,x%v,done,y%v,info) call a%and%spmm(alpha,x%v,done,y%v,info)
if (do_timings) t5= psb_wtime()
if (do_timings) write(0,*) me,' SPMM:',t2-t1,t3-t2,t4-t3,t5-t4
end block
else else
block
logical, parameter :: do_timings=.true.
real(psb_dpk_) :: t1, t2, t3, t4, t5
if (do_timings) call psb_barrier(ctxt)
if (do_timings) t1= psb_wtime()
if (doswap_) then if (doswap_) then
call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& dzero,x%v,desc_a,iwork,info,data=psb_comm_halo_) & dzero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
end if end if
if (do_timings) t2= psb_wtime()
call psb_csmm(alpha,a,x,beta,y,info) call psb_csmm(alpha,a,x,beta,y,info)
if (do_timings) t3= psb_wtime()
if (do_timings) write(0,*) me,' SPMM:',t2-t1,t3-t2
end block
end if end if
if(info /= psb_success_) then if(info /= psb_success_) then

@ -180,12 +180,23 @@ subroutine psb_sspmv_vect(alpha,a,x,beta,y,desc_a,info,&
! Matrix is not transposed ! Matrix is not transposed
if (allocated(a%ad)) then if (allocated(a%ad)) then
block
logical, parameter :: do_timings=.true.
real(psb_dpk_) :: t1, t2, t3, t4, t5
if (do_timings) call psb_barrier(ctxt)
if (do_timings) t1= psb_wtime()
if (doswap_) call psi_swapdata(psb_swap_send_,& if (doswap_) call psi_swapdata(psb_swap_send_,&
& szero,x%v,desc_a,iwork,info,data=psb_comm_halo_) & szero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
if (do_timings) t2= psb_wtime()
call a%ad%spmm(alpha,x%v,beta,y%v,info) call a%ad%spmm(alpha,x%v,beta,y%v,info)
if (do_timings) t3= psb_wtime()
if (doswap_) call psi_swapdata(psb_swap_recv_,& if (doswap_) call psi_swapdata(psb_swap_recv_,&
& szero,x%v,desc_a,iwork,info,data=psb_comm_halo_) & szero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
if (do_timings) t4= psb_wtime()
call a%and%spmm(alpha,x%v,sone,y%v,info) call a%and%spmm(alpha,x%v,sone,y%v,info)
if (do_timings) t5= psb_wtime()
if (do_timings) write(0,*) me,' SPMM:',t2-t1,t3-t2,t4-t3,t5-t4
end block
else else
if (doswap_) then if (doswap_) then

@ -180,12 +180,23 @@ subroutine psb_zspmv_vect(alpha,a,x,beta,y,desc_a,info,&
! Matrix is not transposed ! Matrix is not transposed
if (allocated(a%ad)) then if (allocated(a%ad)) then
block
logical, parameter :: do_timings=.true.
real(psb_dpk_) :: t1, t2, t3, t4, t5
if (do_timings) call psb_barrier(ctxt)
if (do_timings) t1= psb_wtime()
if (doswap_) call psi_swapdata(psb_swap_send_,& if (doswap_) call psi_swapdata(psb_swap_send_,&
& zzero,x%v,desc_a,iwork,info,data=psb_comm_halo_) & zzero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
if (do_timings) t2= psb_wtime()
call a%ad%spmm(alpha,x%v,beta,y%v,info) call a%ad%spmm(alpha,x%v,beta,y%v,info)
if (do_timings) t3= psb_wtime()
if (doswap_) call psi_swapdata(psb_swap_recv_,& if (doswap_) call psi_swapdata(psb_swap_recv_,&
& zzero,x%v,desc_a,iwork,info,data=psb_comm_halo_) & zzero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
if (do_timings) t4= psb_wtime()
call a%and%spmm(alpha,x%v,zone,y%v,info) call a%and%spmm(alpha,x%v,zone,y%v,info)
if (do_timings) t5= psb_wtime()
if (do_timings) write(0,*) me,' SPMM:',t2-t1,t3-t2,t4-t3,t5-t4
end block
else else
if (doswap_) then if (doswap_) then

@ -183,7 +183,7 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, mold, bld_and)
type(psb_c_coo_sparse_mat) :: acoo type(psb_c_coo_sparse_mat) :: acoo
type(psb_c_csr_sparse_mat), allocatable :: aclip type(psb_c_csr_sparse_mat), allocatable :: aclip
type(psb_c_ecsr_sparse_mat), allocatable :: andclip type(psb_c_ecsr_sparse_mat), allocatable :: andclip
logical, parameter :: use_ecsr=.false. logical, parameter :: use_ecsr=.true.
allocate(aclip) allocate(aclip)
call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.) call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.)
allocate(a%ad,mold=a%a) allocate(a%ad,mold=a%a)

@ -183,7 +183,7 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, mold, bld_and)
type(psb_s_coo_sparse_mat) :: acoo type(psb_s_coo_sparse_mat) :: acoo
type(psb_s_csr_sparse_mat), allocatable :: aclip type(psb_s_csr_sparse_mat), allocatable :: aclip
type(psb_s_ecsr_sparse_mat), allocatable :: andclip type(psb_s_ecsr_sparse_mat), allocatable :: andclip
logical, parameter :: use_ecsr=.false. logical, parameter :: use_ecsr=.true.
allocate(aclip) allocate(aclip)
call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.) call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.)
allocate(a%ad,mold=a%a) allocate(a%ad,mold=a%a)

@ -183,7 +183,7 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, mold, bld_and)
type(psb_z_coo_sparse_mat) :: acoo type(psb_z_coo_sparse_mat) :: acoo
type(psb_z_csr_sparse_mat), allocatable :: aclip type(psb_z_csr_sparse_mat), allocatable :: aclip
type(psb_z_ecsr_sparse_mat), allocatable :: andclip type(psb_z_ecsr_sparse_mat), allocatable :: andclip
logical, parameter :: use_ecsr=.false. logical, parameter :: use_ecsr=.true.
allocate(aclip) allocate(aclip)
call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.) call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.)
allocate(a%ad,mold=a%a) allocate(a%ad,mold=a%a)

@ -680,9 +680,9 @@ contains
t1 = psb_wtime() t1 = psb_wtime()
if (info == psb_success_) then if (info == psb_success_) then
if (present(amold)) then if (present(amold)) then
call psb_spasb(a,desc_a,info,mold=amold,bld_and=.true.) call psb_spasb(a,desc_a,info,mold=amold,bld_and=.false.)
else else
call psb_spasb(a,desc_a,info,afmt=afmt,bld_and=.true.) call psb_spasb(a,desc_a,info,afmt=afmt,bld_and=.false.)
end if end if
end if end if
call psb_barrier(ctxt) call psb_barrier(ctxt)

@ -5,7 +5,7 @@ CSR Storage format for matrix A: CSR COO
200 Domain size (acutal system is this**3 (pde3d) or **2 (pde2d) ) 200 Domain size (acutal system is this**3 (pde3d) or **2 (pde2d) )
3 Partition: 1 BLOCK 3 3D 3 Partition: 1 BLOCK 3 3D
2 Stopping criterion 1 2 2 Stopping criterion 1 2
0300 MAXIT 0008 MAXIT
10 ITRACE 10 ITRACE
002 IRST restart for RGMRES and BiCGSTABL 002 IRST restart for RGMRES and BiCGSTABL
ILU Block Solver ILU,ILUT,INVK,AINVT,AORTH ILU Block Solver ILU,ILUT,INVK,AINVT,AORTH

Loading…
Cancel
Save