mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-07 07:04:57 +00:00
New version with ND product
This commit is contained in:
@@ -180,12 +180,23 @@ subroutine psb_cspmv_vect(alpha,a,x,beta,y,desc_a,info,&
|
||||
! Matrix is not transposed
|
||||
|
||||
if (allocated(a%ad)) then
|
||||
if (doswap_) call psi_swapdata(psb_swap_send_,&
|
||||
& czero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
|
||||
call a%ad%spmm(alpha,x%v,beta,y%v,info)
|
||||
if (doswap_) call psi_swapdata(psb_swap_recv_,&
|
||||
& czero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
|
||||
call a%and%spmm(alpha,x%v,cone,y%v,info)
|
||||
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_,&
|
||||
& 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)
|
||||
if (do_timings) t3= psb_wtime()
|
||||
if (doswap_) call psi_swapdata(psb_swap_recv_,&
|
||||
& 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)
|
||||
if (do_timings) t5= psb_wtime()
|
||||
if (do_timings) write(0,*) me,' SPMM:',t2-t1,t3-t2,t4-t3,t5-t4
|
||||
end block
|
||||
|
||||
else
|
||||
if (doswap_) then
|
||||
|
||||
+31
-13
@@ -180,22 +180,40 @@ subroutine psb_dspmv_vect(alpha,a,x,beta,y,desc_a,info,&
|
||||
! Matrix is not transposed
|
||||
|
||||
if (allocated(a%ad)) then
|
||||
if (doswap_) call psi_swapdata(psb_swap_send_,&
|
||||
& dzero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
|
||||
call a%ad%spmm(alpha,x%v,beta,y%v,info)
|
||||
if (doswap_) call psi_swapdata(psb_swap_recv_,&
|
||||
& dzero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
|
||||
call a%and%spmm(alpha,x%v,done,y%v,info)
|
||||
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_,&
|
||||
& 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)
|
||||
if (do_timings) t3= psb_wtime()
|
||||
if (doswap_) call psi_swapdata(psb_swap_recv_,&
|
||||
& 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)
|
||||
if (do_timings) t5= psb_wtime()
|
||||
if (do_timings) write(0,*) me,' SPMM:',t2-t1,t3-t2,t4-t3,t5-t4
|
||||
end block
|
||||
|
||||
else
|
||||
if (doswap_) then
|
||||
call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
|
||||
& dzero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
|
||||
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
|
||||
call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
|
||||
& dzero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
|
||||
end if
|
||||
if (do_timings) t2= psb_wtime()
|
||||
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
|
||||
|
||||
call psb_csmm(alpha,a,x,beta,y,info)
|
||||
|
||||
end if
|
||||
|
||||
if(info /= psb_success_) then
|
||||
info = psb_err_from_subroutine_non_
|
||||
|
||||
@@ -180,12 +180,23 @@ subroutine psb_sspmv_vect(alpha,a,x,beta,y,desc_a,info,&
|
||||
! Matrix is not transposed
|
||||
|
||||
if (allocated(a%ad)) then
|
||||
if (doswap_) call psi_swapdata(psb_swap_send_,&
|
||||
& szero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
|
||||
call a%ad%spmm(alpha,x%v,beta,y%v,info)
|
||||
if (doswap_) call psi_swapdata(psb_swap_recv_,&
|
||||
& szero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
|
||||
call a%and%spmm(alpha,x%v,sone,y%v,info)
|
||||
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_,&
|
||||
& 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)
|
||||
if (do_timings) t3= psb_wtime()
|
||||
if (doswap_) call psi_swapdata(psb_swap_recv_,&
|
||||
& 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)
|
||||
if (do_timings) t5= psb_wtime()
|
||||
if (do_timings) write(0,*) me,' SPMM:',t2-t1,t3-t2,t4-t3,t5-t4
|
||||
end block
|
||||
|
||||
else
|
||||
if (doswap_) then
|
||||
|
||||
@@ -180,12 +180,23 @@ subroutine psb_zspmv_vect(alpha,a,x,beta,y,desc_a,info,&
|
||||
! Matrix is not transposed
|
||||
|
||||
if (allocated(a%ad)) then
|
||||
if (doswap_) call psi_swapdata(psb_swap_send_,&
|
||||
& zzero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
|
||||
call a%ad%spmm(alpha,x%v,beta,y%v,info)
|
||||
if (doswap_) call psi_swapdata(psb_swap_recv_,&
|
||||
& zzero,x%v,desc_a,iwork,info,data=psb_comm_halo_)
|
||||
call a%and%spmm(alpha,x%v,zone,y%v,info)
|
||||
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_,&
|
||||
& 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)
|
||||
if (do_timings) t3= psb_wtime()
|
||||
if (doswap_) call psi_swapdata(psb_swap_recv_,&
|
||||
& 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)
|
||||
if (do_timings) t5= psb_wtime()
|
||||
if (do_timings) write(0,*) me,' SPMM:',t2-t1,t3-t2,t4-t3,t5-t4
|
||||
end block
|
||||
|
||||
else
|
||||
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_csr_sparse_mat), allocatable :: aclip
|
||||
type(psb_c_ecsr_sparse_mat), allocatable :: andclip
|
||||
logical, parameter :: use_ecsr=.false.
|
||||
logical, parameter :: use_ecsr=.true.
|
||||
allocate(aclip)
|
||||
call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.)
|
||||
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_csr_sparse_mat), allocatable :: aclip
|
||||
type(psb_s_ecsr_sparse_mat), allocatable :: andclip
|
||||
logical, parameter :: use_ecsr=.false.
|
||||
logical, parameter :: use_ecsr=.true.
|
||||
allocate(aclip)
|
||||
call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.)
|
||||
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_csr_sparse_mat), allocatable :: aclip
|
||||
type(psb_z_ecsr_sparse_mat), allocatable :: andclip
|
||||
logical, parameter :: use_ecsr=.false.
|
||||
logical, parameter :: use_ecsr=.true.
|
||||
allocate(aclip)
|
||||
call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.)
|
||||
allocate(a%ad,mold=a%a)
|
||||
|
||||
@@ -680,9 +680,9 @@ contains
|
||||
t1 = psb_wtime()
|
||||
if (info == psb_success_) 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
|
||||
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
|
||||
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) )
|
||||
3 Partition: 1 BLOCK 3 3D
|
||||
2 Stopping criterion 1 2
|
||||
0300 MAXIT
|
||||
0008 MAXIT
|
||||
10 ITRACE
|
||||
002 IRST restart for RGMRES and BiCGSTABL
|
||||
ILU Block Solver ILU,ILUT,INVK,AINVT,AORTH
|
||||
|
||||
Reference in New Issue
Block a user