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

Fix vector allocation etc.

Browse Source
gpucinterfaces
sfilippone 4 months ago
parent 3337a12e59
commit ac5512974b
17 changed files with 74 additions and 90 deletions
Show Stats Download Patch File Download Diff File

10
base/modules/serial/psb_c_base_vect_mod.F90
Unescape Escape View File

@ -2657,16 +2657,8 @@ contains
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
logical :: scratch_
if (present(scratch)) then
scratch_ = scratch
else
scratch_ = .false.
end if
call psb_realloc(m,n,x%v,info)
call x%asb(m,n,info)
call x%asb(m,n,info,scratch)
end subroutine c_base_mlv_bld_n

10
base/modules/serial/psb_d_base_vect_mod.F90
Unescape Escape View File

@ -2836,16 +2836,8 @@ contains
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
logical :: scratch_
if (present(scratch)) then
scratch_ = scratch
else
scratch_ = .false.
end if
call psb_realloc(m,n,x%v,info)
call x%asb(m,n,info)
call x%asb(m,n,info,scratch)
end subroutine d_base_mlv_bld_n

10
base/modules/serial/psb_i_base_vect_mod.F90
Unescape Escape View File

@ -1582,16 +1582,8 @@ contains
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
logical :: scratch_
if (present(scratch)) then
scratch_ = scratch
else
scratch_ = .false.
end if
call psb_realloc(m,n,x%v,info)
call x%asb(m,n,info)
call x%asb(m,n,info,scratch)
end subroutine i_base_mlv_bld_n

10
base/modules/serial/psb_l_base_vect_mod.F90
Unescape Escape View File

@ -1583,16 +1583,8 @@ contains
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
logical :: scratch_
if (present(scratch)) then
scratch_ = scratch
else
scratch_ = .false.
end if
call psb_realloc(m,n,x%v,info)
call x%asb(m,n,info)
call x%asb(m,n,info,scratch)
end subroutine l_base_mlv_bld_n

10
base/modules/serial/psb_s_base_vect_mod.F90
Unescape Escape View File

@ -2836,16 +2836,8 @@ contains
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
logical :: scratch_
if (present(scratch)) then
scratch_ = scratch
else
scratch_ = .false.
end if
call psb_realloc(m,n,x%v,info)
call x%asb(m,n,info)
call x%asb(m,n,info,scratch)
end subroutine s_base_mlv_bld_n

10
base/modules/serial/psb_z_base_vect_mod.F90
Unescape Escape View File

@ -2657,16 +2657,8 @@ contains
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
logical :: scratch_
if (present(scratch)) then
scratch_ = scratch
else
scratch_ = .false.
end if
call psb_realloc(m,n,x%v,info)
call x%asb(m,n,info)
call x%asb(m,n,info,scratch)
end subroutine z_base_mlv_bld_n

4
base/tools/psb_callc.f90
Unescape Escape View File

@ -53,7 +53,7 @@ subroutine psb_calloc_vect(x, desc_a,info, dupl, bldmode)
!locals
integer(psb_ipk_) :: np,me,nr,i,err_act
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: bldmode_, nrmt_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -111,6 +111,8 @@ subroutine psb_calloc_vect(x, desc_a,info, dupl, bldmode)
call x%set_bld()
if (present(dupl)) then
call x%set_dupl(dupl)
else
call x%set_dupl(psb_dupl_def_)
end if
call x%set_remote_build(bldmode_)
call x%set_nrmv(izero)

4
base/tools/psb_dallc.f90
Unescape Escape View File

@ -53,7 +53,7 @@ subroutine psb_dalloc_vect(x, desc_a,info, dupl, bldmode)
!locals
integer(psb_ipk_) :: np,me,nr,i,err_act
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: bldmode_, nrmt_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -111,6 +111,8 @@ subroutine psb_dalloc_vect(x, desc_a,info, dupl, bldmode)
call x%set_bld()
if (present(dupl)) then
call x%set_dupl(dupl)
else
call x%set_dupl(psb_dupl_def_)
end if
call x%set_remote_build(bldmode_)
call x%set_nrmv(izero)

4
base/tools/psb_iallc.f90
Unescape Escape View File

@ -53,7 +53,7 @@ subroutine psb_ialloc_vect(x, desc_a,info, dupl, bldmode)
!locals
integer(psb_ipk_) :: np,me,nr,i,err_act
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: bldmode_, nrmt_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -111,6 +111,8 @@ subroutine psb_ialloc_vect(x, desc_a,info, dupl, bldmode)
call x%set_bld()
if (present(dupl)) then
call x%set_dupl(dupl)
else
call x%set_dupl(psb_dupl_def_)
end if
call x%set_remote_build(bldmode_)
call x%set_nrmv(izero)

4
base/tools/psb_lallc.f90
Unescape Escape View File

@ -53,7 +53,7 @@ subroutine psb_lalloc_vect(x, desc_a,info, dupl, bldmode)
!locals
integer(psb_ipk_) :: np,me,nr,i,err_act
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: bldmode_, nrmt_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -111,6 +111,8 @@ subroutine psb_lalloc_vect(x, desc_a,info, dupl, bldmode)
call x%set_bld()
if (present(dupl)) then
call x%set_dupl(dupl)
else
call x%set_dupl(psb_dupl_def_)
end if
call x%set_remote_build(bldmode_)
call x%set_nrmv(izero)

4
base/tools/psb_sallc.f90
Unescape Escape View File

@ -53,7 +53,7 @@ subroutine psb_salloc_vect(x, desc_a,info, dupl, bldmode)
!locals
integer(psb_ipk_) :: np,me,nr,i,err_act
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: bldmode_, nrmt_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -111,6 +111,8 @@ subroutine psb_salloc_vect(x, desc_a,info, dupl, bldmode)
call x%set_bld()
if (present(dupl)) then
call x%set_dupl(dupl)
else
call x%set_dupl(psb_dupl_def_)
end if
call x%set_remote_build(bldmode_)
call x%set_nrmv(izero)

4
base/tools/psb_zallc.f90
Unescape Escape View File

@ -53,7 +53,7 @@ subroutine psb_zalloc_vect(x, desc_a,info, dupl, bldmode)
!locals
integer(psb_ipk_) :: np,me,nr,i,err_act
integer(psb_ipk_) :: dupl_, bldmode_, nrmt_
integer(psb_ipk_) :: bldmode_, nrmt_
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
@ -111,6 +111,8 @@ subroutine psb_zalloc_vect(x, desc_a,info, dupl, bldmode)
call x%set_bld()
if (present(dupl)) then
call x%set_dupl(dupl)
else
call x%set_dupl(psb_dupl_def_)
end if
call x%set_remote_build(bldmode_)
call x%set_nrmv(izero)

16
cuda/psb_c_cuda_vect_mod.F90
Unescape Escape View File

@ -1537,12 +1537,14 @@ contains
end subroutine c_cuda_multi_bld_x
subroutine c_cuda_multi_bld_n(x,m,n)
subroutine c_cuda_multi_bld_n(x,m,n,scratch)
integer(psb_ipk_), intent(in) :: m,n
class(psb_c_multivect_cuda), intent(inout) :: x
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
call x%all(m,n,info)
call x%asb(m,n,info,scratch=scratch)
if (info /= 0) then
call psb_errpush(info,'c_cuda_multi_bld_n',i_err=(/m,n,n,n,n/))
end if
@ -1938,7 +1940,7 @@ contains
call x%set_host()
end subroutine c_cuda_multi_zero
subroutine c_cuda_multi_asb(m,n, x, info)
subroutine c_cuda_multi_asb(m,n, x, info, scratch)
use psi_serial_mod
use psb_realloc_mod
implicit none
@ -1946,12 +1948,14 @@ contains
class(psb_c_multivect_cuda), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: nd, nc
logical, intent(in), optional :: scratch
info = 0
x%m_nrows = m
x%m_ncols = n
if (x%is_host()) then
call x%psb_c_base_multivect_type%asb(m,n,info)
call x%psb_c_base_multivect_type%asb(m,n,info,scratch)
if (info == psb_success_) call x%sync_space(info)
else if (x%is_dev()) then
nd = getMultiVecDevicePitch(x%deviceVect)
@ -2088,11 +2092,11 @@ contains
call x%set_sync()
end subroutine c_cuda_multi_vect_finalize
subroutine c_cuda_multi_ins(n,irl,val,dupl,x,info)
subroutine c_cuda_multi_ins(n,irl,val,dupl,x,maxr,info)
use psi_serial_mod
implicit none
class(psb_c_multivect_cuda), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n, dupl
integer(psb_ipk_), intent(in) :: n, dupl,maxr
integer(psb_ipk_), intent(in) :: irl(:)
complex(psb_spk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info
@ -2101,7 +2105,7 @@ contains
info = 0
if (x%is_dev()) call x%sync()
call x%psb_c_base_multivect_type%ins(n,irl,val,dupl,info)
call x%psb_c_base_multivect_type%ins(n,irl,val,dupl,maxr,info)
call x%set_host()
end subroutine c_cuda_multi_ins

16
cuda/psb_d_cuda_vect_mod.F90
Unescape Escape View File

@ -1537,12 +1537,14 @@ contains
end subroutine d_cuda_multi_bld_x
subroutine d_cuda_multi_bld_n(x,m,n)
subroutine d_cuda_multi_bld_n(x,m,n,scratch)
integer(psb_ipk_), intent(in) :: m,n
class(psb_d_multivect_cuda), intent(inout) :: x
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
call x%all(m,n,info)
call x%asb(m,n,info,scratch=scratch)
if (info /= 0) then
call psb_errpush(info,'d_cuda_multi_bld_n',i_err=(/m,n,n,n,n/))
end if
@ -1938,7 +1940,7 @@ contains
call x%set_host()
end subroutine d_cuda_multi_zero
subroutine d_cuda_multi_asb(m,n, x, info)
subroutine d_cuda_multi_asb(m,n, x, info, scratch)
use psi_serial_mod
use psb_realloc_mod
implicit none
@ -1946,12 +1948,14 @@ contains
class(psb_d_multivect_cuda), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: nd, nc
logical, intent(in), optional :: scratch
info = 0
x%m_nrows = m
x%m_ncols = n
if (x%is_host()) then
call x%psb_d_base_multivect_type%asb(m,n,info)
call x%psb_d_base_multivect_type%asb(m,n,info,scratch)
if (info == psb_success_) call x%sync_space(info)
else if (x%is_dev()) then
nd = getMultiVecDevicePitch(x%deviceVect)
@ -2088,11 +2092,11 @@ contains
call x%set_sync()
end subroutine d_cuda_multi_vect_finalize
subroutine d_cuda_multi_ins(n,irl,val,dupl,x,info)
subroutine d_cuda_multi_ins(n,irl,val,dupl,x,maxr,info)
use psi_serial_mod
implicit none
class(psb_d_multivect_cuda), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n, dupl
integer(psb_ipk_), intent(in) :: n, dupl,maxr
integer(psb_ipk_), intent(in) :: irl(:)
real(psb_dpk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info
@ -2101,7 +2105,7 @@ contains
info = 0
if (x%is_dev()) call x%sync()
call x%psb_d_base_multivect_type%ins(n,irl,val,dupl,info)
call x%psb_d_base_multivect_type%ins(n,irl,val,dupl,maxr,info)
call x%set_host()
end subroutine d_cuda_multi_ins

16
cuda/psb_i_cuda_vect_mod.F90
Unescape Escape View File

@ -1097,12 +1097,14 @@ contains
end subroutine i_cuda_multi_bld_x
subroutine i_cuda_multi_bld_n(x,m,n)
subroutine i_cuda_multi_bld_n(x,m,n,scratch)
integer(psb_ipk_), intent(in) :: m,n
class(psb_i_multivect_cuda), intent(inout) :: x
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
call x%all(m,n,info)
call x%asb(m,n,info,scratch=scratch)
if (info /= 0) then
call psb_errpush(info,'i_cuda_multi_bld_n',i_err=(/m,n,n,n,n/))
end if
@ -1498,7 +1500,7 @@ contains
call x%set_host()
end subroutine i_cuda_multi_zero
subroutine i_cuda_multi_asb(m,n, x, info)
subroutine i_cuda_multi_asb(m,n, x, info, scratch)
use psi_serial_mod
use psb_realloc_mod
implicit none
@ -1506,12 +1508,14 @@ contains
class(psb_i_multivect_cuda), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: nd, nc
logical, intent(in), optional :: scratch
info = 0
x%m_nrows = m
x%m_ncols = n
if (x%is_host()) then
call x%psb_i_base_multivect_type%asb(m,n,info)
call x%psb_i_base_multivect_type%asb(m,n,info,scratch)
if (info == psb_success_) call x%sync_space(info)
else if (x%is_dev()) then
nd = getMultiVecDevicePitch(x%deviceVect)
@ -1648,11 +1652,11 @@ contains
call x%set_sync()
end subroutine i_cuda_multi_vect_finalize
subroutine i_cuda_multi_ins(n,irl,val,dupl,x,info)
subroutine i_cuda_multi_ins(n,irl,val,dupl,x,maxr,info)
use psi_serial_mod
implicit none
class(psb_i_multivect_cuda), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n, dupl
integer(psb_ipk_), intent(in) :: n, dupl,maxr
integer(psb_ipk_), intent(in) :: irl(:)
integer(psb_ipk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info
@ -1661,7 +1665,7 @@ contains
info = 0
if (x%is_dev()) call x%sync()
call x%psb_i_base_multivect_type%ins(n,irl,val,dupl,info)
call x%psb_i_base_multivect_type%ins(n,irl,val,dupl,maxr,info)
call x%set_host()
end subroutine i_cuda_multi_ins

16
cuda/psb_s_cuda_vect_mod.F90
Unescape Escape View File

@ -1537,12 +1537,14 @@ contains
end subroutine s_cuda_multi_bld_x
subroutine s_cuda_multi_bld_n(x,m,n)
subroutine s_cuda_multi_bld_n(x,m,n,scratch)
integer(psb_ipk_), intent(in) :: m,n
class(psb_s_multivect_cuda), intent(inout) :: x
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
call x%all(m,n,info)
call x%asb(m,n,info,scratch=scratch)
if (info /= 0) then
call psb_errpush(info,'s_cuda_multi_bld_n',i_err=(/m,n,n,n,n/))
end if
@ -1938,7 +1940,7 @@ contains
call x%set_host()
end subroutine s_cuda_multi_zero
subroutine s_cuda_multi_asb(m,n, x, info)
subroutine s_cuda_multi_asb(m,n, x, info, scratch)
use psi_serial_mod
use psb_realloc_mod
implicit none
@ -1946,12 +1948,14 @@ contains
class(psb_s_multivect_cuda), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: nd, nc
logical, intent(in), optional :: scratch
info = 0
x%m_nrows = m
x%m_ncols = n
if (x%is_host()) then
call x%psb_s_base_multivect_type%asb(m,n,info)
call x%psb_s_base_multivect_type%asb(m,n,info,scratch)
if (info == psb_success_) call x%sync_space(info)
else if (x%is_dev()) then
nd = getMultiVecDevicePitch(x%deviceVect)
@ -2088,11 +2092,11 @@ contains
call x%set_sync()
end subroutine s_cuda_multi_vect_finalize
subroutine s_cuda_multi_ins(n,irl,val,dupl,x,info)
subroutine s_cuda_multi_ins(n,irl,val,dupl,x,maxr,info)
use psi_serial_mod
implicit none
class(psb_s_multivect_cuda), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n, dupl
integer(psb_ipk_), intent(in) :: n, dupl,maxr
integer(psb_ipk_), intent(in) :: irl(:)
real(psb_spk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info
@ -2101,7 +2105,7 @@ contains
info = 0
if (x%is_dev()) call x%sync()
call x%psb_s_base_multivect_type%ins(n,irl,val,dupl,info)
call x%psb_s_base_multivect_type%ins(n,irl,val,dupl,maxr,info)
call x%set_host()
end subroutine s_cuda_multi_ins

16
cuda/psb_z_cuda_vect_mod.F90
Unescape Escape View File

@ -1537,12 +1537,14 @@ contains
end subroutine z_cuda_multi_bld_x
subroutine z_cuda_multi_bld_n(x,m,n)
subroutine z_cuda_multi_bld_n(x,m,n,scratch)
integer(psb_ipk_), intent(in) :: m,n
class(psb_z_multivect_cuda), intent(inout) :: x
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
call x%all(m,n,info)
call x%asb(m,n,info,scratch=scratch)
if (info /= 0) then
call psb_errpush(info,'z_cuda_multi_bld_n',i_err=(/m,n,n,n,n/))
end if
@ -1938,7 +1940,7 @@ contains
call x%set_host()
end subroutine z_cuda_multi_zero
subroutine z_cuda_multi_asb(m,n, x, info)
subroutine z_cuda_multi_asb(m,n, x, info, scratch)
use psi_serial_mod
use psb_realloc_mod
implicit none
@ -1946,12 +1948,14 @@ contains
class(psb_z_multivect_cuda), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: nd, nc
logical, intent(in), optional :: scratch
info = 0
x%m_nrows = m
x%m_ncols = n
if (x%is_host()) then
call x%psb_z_base_multivect_type%asb(m,n,info)
call x%psb_z_base_multivect_type%asb(m,n,info,scratch)
if (info == psb_success_) call x%sync_space(info)
else if (x%is_dev()) then
nd = getMultiVecDevicePitch(x%deviceVect)
@ -2088,11 +2092,11 @@ contains
call x%set_sync()
end subroutine z_cuda_multi_vect_finalize
subroutine z_cuda_multi_ins(n,irl,val,dupl,x,info)
subroutine z_cuda_multi_ins(n,irl,val,dupl,x,maxr,info)
use psi_serial_mod
implicit none
class(psb_z_multivect_cuda), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n, dupl
integer(psb_ipk_), intent(in) :: n, dupl,maxr
integer(psb_ipk_), intent(in) :: irl(:)
complex(psb_dpk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info
@ -2101,7 +2105,7 @@ contains
info = 0
if (x%is_dev()) call x%sync()
call x%psb_z_base_multivect_type%ins(n,irl,val,dupl,info)
call x%psb_z_base_multivect_type%ins(n,irl,val,dupl,maxr,info)
call x%set_host()
end subroutine z_cuda_multi_ins

Write Preview
Loading…
Cancel
Save