fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Fix conversion and product to enable overlap with GPU

Browse Source
non-diag
sfilippone 1 year ago
parent 74cf138a6c
commit 49e99a3e82
2 changed files with 231 additions and 83 deletions
Show Stats Download Patch File Download Diff File

1
base/psblas/psb_dspmm.f90
Unescape Escape View File

@ -199,6 +199,7 @@ subroutine psb_dspmv_vect(alpha,a,x,beta,y,desc_a,info,&
block
logical, parameter :: do_timings=.true.
real(psb_dpk_) :: t1, t2, t3, t4, t5
!write(0,*) 'Going for overlap ',a%ad%get_fmt(),' ',a%and%get_fmt()
if (do_timings) call psb_barrier(ctxt)
if (do_timings) call psb_tic(mv_phase1)
if (doswap_) call psi_swapdata(psb_swap_send_,&

313
base/serial/impl/psb_d_mat_impl.F90
Unescape Escape View File

@ -1246,54 +1246,66 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
goto 9999
end if
if (present(mold)) then
allocate(altmp, mold=mold,stat=info)
else if (present(type)) then
select case (psb_toupper(type))
case ('CSR')
allocate(psb_d_csr_sparse_mat :: altmp, stat=info)
case ('COO')
allocate(psb_d_coo_sparse_mat :: altmp, stat=info)
case ('CSC')
allocate(psb_d_csc_sparse_mat :: altmp, stat=info)
case default
info = psb_err_format_unknown_
call psb_errpush(info,name,a_err=type)
goto 9999
end select
else
allocate(altmp, mold=psb_get_mat_default(a),stat=info)
!!$ if (present(mold)) then
!!$
!!$ allocate(altmp, mold=mold,stat=info)
!!$
!!$ else if (present(type)) then
!!$
!!$ select case (psb_toupper(type))
!!$ case ('CSR')
!!$ allocate(psb_d_csr_sparse_mat :: altmp, stat=info)
!!$ case ('COO')
!!$ allocate(psb_d_coo_sparse_mat :: altmp, stat=info)
!!$ case ('CSC')
!!$ allocate(psb_d_csc_sparse_mat :: altmp, stat=info)
!!$ case default
!!$ info = psb_err_format_unknown_
!!$ call psb_errpush(info,name,a_err=type)
!!$ goto 9999
!!$ end select
!!$ else
!!$ allocate(altmp, mold=psb_get_mat_default(a),stat=info)
!!$ end if
!!$
!!$ if (info /= psb_success_) then
!!$ info = psb_err_alloc_dealloc_
!!$ call psb_errpush(info,name)
!!$ goto 9999
!!$ end if
!!$
!!$
!!$ if (present(dupl)) then
!!$ call altmp%set_dupl(dupl)
!!$ else if (a%is_bld()) then
!!$ ! Does this make sense at all?? Who knows..
!!$ call altmp%set_dupl(psb_dupl_def_)
!!$ end if
!!$
!!$ if (debug) write(psb_err_unit,*) 'Converting from ',&
!!$ & a%get_fmt(),' to ',altmp%get_fmt()
!!$
!!$ call altmp%cp_from_fmt(a%a, info)
!!$
!!$ if (info /= psb_success_) then
!!$ info = psb_err_from_subroutine_
!!$ call psb_errpush(info,name,a_err="mv_from")
!!$ goto 9999
!!$ end if
!!$
!!$ call move_alloc(altmp,b%a)
call inner_cp_alloc(a%a,b%a,info,type,mold)
if (info /= 0) goto 9999
if (allocated(a%ad)) then
call inner_cp_alloc(a%ad,b%ad,info,type,mold)
if (info /= 0) goto 9999
end if
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
if (present(dupl)) then
call altmp%set_dupl(dupl)
else if (a%is_bld()) then
! Does this make sense at all?? Who knows..
call altmp%set_dupl(psb_dupl_def_)
if (allocated(a%and)) then
call inner_cp_alloc(a%and,b%and,info,type,mold)
if (info /= 0) goto 9999
end if
if (debug) write(psb_err_unit,*) 'Converting from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
call altmp%cp_from_fmt(a%a, info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name,a_err="mv_from")
goto 9999
end if
call move_alloc(altmp,b%a)
call b%trim()
call b%set_asb()
call psb_erractionrestore(err_act)
@ -1303,6 +1315,69 @@ subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
9999 call psb_error_handler(err_act)
return
contains
subroutine inner_cp_alloc(a,b,info,type,mold)
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: type
class(psb_d_base_sparse_mat), intent(in), optional :: mold
class(psb_d_base_sparse_mat), allocatable :: altmp
info = psb_success_
call psb_erractionsave(err_act)
if (present(mold)) then
allocate(altmp, mold=mold,stat=info)
else if (present(type)) then
select case (psb_toupper(type))
case ('CSR')
allocate(psb_d_csr_sparse_mat :: altmp, stat=info)
case ('COO')
allocate(psb_d_coo_sparse_mat :: altmp, stat=info)
case ('CSC')
allocate(psb_d_csc_sparse_mat :: altmp, stat=info)
case default
info = psb_err_format_unknown_
call psb_errpush(info,name,a_err=type)
goto 9999
end select
else
!!$ allocate(altmp, mold=psb_get_mat_default(a),stat=info)
allocate(psb_d_csr_sparse_mat :: altmp, stat=info)
end if
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
if (debug) write(psb_err_unit,*) 'Converting in-place from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
call altmp%cp_from_fmt(a, info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name,a_err="mv_from")
goto 9999
end if
call move_alloc(altmp,b)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine inner_cp_alloc
end subroutine psb_d_cscnv
@ -1345,46 +1420,57 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl)
goto 9999
end if
if (present(mold)) then
allocate(altmp, mold=mold,stat=info)
else if (present(type)) then
select case (psb_toupper(type))
case ('CSR')
allocate(psb_d_csr_sparse_mat :: altmp, stat=info)
case ('COO')
allocate(psb_d_coo_sparse_mat :: altmp, stat=info)
case ('CSC')
allocate(psb_d_csc_sparse_mat :: altmp, stat=info)
case default
info = psb_err_format_unknown_
call psb_errpush(info,name,a_err=type)
goto 9999
end select
else
allocate(altmp, mold=psb_get_mat_default(a),stat=info)
!!$ if (present(mold)) then
!!$
!!$ allocate(altmp, mold=mold,stat=info)
!!$
!!$ else if (present(type)) then
!!$
!!$ select case (psb_toupper(type))
!!$ case ('CSR')
!!$ allocate(psb_d_csr_sparse_mat :: altmp, stat=info)
!!$ case ('COO')
!!$ allocate(psb_d_coo_sparse_mat :: altmp, stat=info)
!!$ case ('CSC')
!!$ allocate(psb_d_csc_sparse_mat :: altmp, stat=info)
!!$ case default
!!$ info = psb_err_format_unknown_
!!$ call psb_errpush(info,name,a_err=type)
!!$ goto 9999
!!$ end select
!!$ else
!!$ allocate(altmp, mold=psb_get_mat_default(a),stat=info)
!!$ end if
!!$
!!$ if (info /= psb_success_) then
!!$ info = psb_err_alloc_dealloc_
!!$ call psb_errpush(info,name)
!!$ goto 9999
!!$ end if
!!$
!!$ if (debug) write(psb_err_unit,*) 'Converting in-place from ',&
!!$ & a%get_fmt(),' to ',altmp%get_fmt()
!!$
!!$ call altmp%mv_from_fmt(a%a, info)
!!$
!!$ if (info /= psb_success_) then
!!$ info = psb_err_from_subroutine_
!!$ call psb_errpush(info,name,a_err="mv_from")
!!$ goto 9999
!!$ end if
!!$
!!$ call move_alloc(altmp,a%a)
call inner_mv_alloc(a%a,info,type,mold)
if (info /= 0) goto 9999
if (allocated(a%ad)) then
call inner_mv_alloc(a%ad,info,type,mold)
if (info /= 0) goto 9999
end if
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
if (allocated(a%and)) then
call inner_mv_alloc(a%and,info,type,mold)
if (info /= 0) goto 9999
end if
if (debug) write(psb_err_unit,*) 'Converting in-place from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
call altmp%mv_from_fmt(a%a, info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name,a_err="mv_from")
goto 9999
end if
call move_alloc(altmp,a%a)
call a%trim()
call a%set_asb()
call psb_erractionrestore(err_act)
@ -1394,7 +1480,68 @@ subroutine psb_d_cscnv_ip(a,info,type,mold,dupl)
9999 call psb_error_handler(err_act)
return
contains
subroutine inner_mv_alloc(a,info,type,mold)
class(psb_d_base_sparse_mat), intent(inout), allocatable :: a
integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: type
class(psb_d_base_sparse_mat), intent(in), optional :: mold
class(psb_d_base_sparse_mat), allocatable :: altmp
info = psb_success_
call psb_erractionsave(err_act)
if (present(mold)) then
allocate(altmp, mold=mold,stat=info)
else if (present(type)) then
select case (psb_toupper(type))
case ('CSR')
allocate(psb_d_csr_sparse_mat :: altmp, stat=info)
case ('COO')
allocate(psb_d_coo_sparse_mat :: altmp, stat=info)
case ('CSC')
allocate(psb_d_csc_sparse_mat :: altmp, stat=info)
case default
info = psb_err_format_unknown_
call psb_errpush(info,name,a_err=type)
goto 9999
end select
else
!!$ allocate(altmp, mold=psb_get_mat_default(a),stat=info)
allocate(psb_d_csr_sparse_mat :: altmp, stat=info)
end if
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
if (debug) write(psb_err_unit,*) 'Converting in-place from ',&
& a%get_fmt(),' to ',altmp%get_fmt()
call altmp%mv_from_fmt(a, info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name,a_err="mv_from")
goto 9999
end if
call move_alloc(altmp,a)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine inner_mv_alloc
end subroutine psb_d_cscnv_ip

Write Preview
Loading…
Cancel
Save