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

Fix multivect assembly and comments in base_vect

Browse Source
This commit is contained in:
sfilippone
2026-04-29 14:06:35 +02:00
parent 1cb7634d1f
commit 19ce4a0942
20 changed files with 140 additions and 83 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/serial/psb_c_base_vect_mod.F90
+13 -8
View File
@@ -2677,7 +2677,7 @@ contains
logical, intent(in), optional :: scratch
call psb_realloc(m,n,x%v,info)
call x%asb(m,n,info,scratch)
call x%asb(m,n,info,scratch=scratch)
end subroutine c_base_mlv_bld_n
@@ -2958,23 +2958,26 @@ contains
case(psb_dupl_err_)
do i=1,ncfs
if (any(vv(x%iv(i),:).ne.czero)) then
call psb_errpush(psb_err_duplicate_coo,'vect-asb')
info = psb_err_duplicate_coo
call psb_errpush(info,'mvect-asb')
return
else
vv(x%iv(i),:) = x%v(i,:)
end if
end do
case default
write(psb_err_unit,*) 'Error in vect_asb: unsafe dupl',x%get_dupl()
write(psb_err_unit,*) 'Error in mvect_asb: unsafe dupl',x%get_dupl()
info =-7
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < m) &
if ((x%get_nrows() < m).or.(x%get_ncols()<n)) &
& call psb_realloc(m,n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(psb_err_alloc_dealloc_,'mvect_asb')
end if
else
info = psb_err_invalid_vect_state_
call psb_errpush(info,'vect_asb')
@@ -2982,8 +2985,10 @@ contains
else
if ((x%get_nrows() < m).or.(x%get_ncols()<n)) &
& call psb_realloc(m,n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(psb_err_alloc_dealloc_,'mvect_asb')
end if
end if
call x%set_host()
call x%set_asb()
base/modules/serial/psb_c_vect_mod.F90
+5 -3
View File
@@ -1660,19 +1660,20 @@ contains
end subroutine c_mvect_bld_x
subroutine c_mvect_bld_n(x,m,n,mold)
subroutine c_mvect_bld_n(x,m,n,mold,scratch)
integer(psb_ipk_), intent(in) :: m,n
class(psb_c_multivect_type), intent(out) :: x
class(psb_c_base_multivect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
info = psb_success_
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(x%v,stat=info, mold=psb_c_get_base_multivect_default())
endif
if (info == psb_success_) call x%v%bld(m,n)
if (info == psb_success_) call x%v%bld(m,n,scratch=scratch)
end subroutine c_mvect_bld_n
@@ -2153,3 +2154,4 @@ contains
!!$ end function c_mvect_asum
end module psb_c_multivect_mod
base/modules/serial/psb_d_base_vect_mod.F90
+17 -8
View File
@@ -2189,6 +2189,10 @@ contains
res = min(res,abs(x%v(i)))
end do
#else
!
! From M&R: if the array is of size zero, MINVAL
! returns the largest positive value
!
res = minval(x%v(1:n))
#endif
end function d_base_min
@@ -2856,7 +2860,7 @@ contains
logical, intent(in), optional :: scratch
call psb_realloc(m,n,x%v,info)
call x%asb(m,n,info,scratch)
call x%asb(m,n,info,scratch=scratch)
end subroutine d_base_mlv_bld_n
@@ -3137,23 +3141,26 @@ contains
case(psb_dupl_err_)
do i=1,ncfs
if (any(vv(x%iv(i),:).ne.dzero)) then
call psb_errpush(psb_err_duplicate_coo,'vect-asb')
info = psb_err_duplicate_coo
call psb_errpush(info,'mvect-asb')
return
else
vv(x%iv(i),:) = x%v(i,:)
end if
end do
case default
write(psb_err_unit,*) 'Error in vect_asb: unsafe dupl',x%get_dupl()
write(psb_err_unit,*) 'Error in mvect_asb: unsafe dupl',x%get_dupl()
info =-7
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < m) &
if ((x%get_nrows() < m).or.(x%get_ncols()<n)) &
& call psb_realloc(m,n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(psb_err_alloc_dealloc_,'mvect_asb')
end if
else
info = psb_err_invalid_vect_state_
call psb_errpush(info,'vect_asb')
@@ -3161,8 +3168,10 @@ contains
else
if ((x%get_nrows() < m).or.(x%get_ncols()<n)) &
& call psb_realloc(m,n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(psb_err_alloc_dealloc_,'mvect_asb')
end if
end if
call x%set_host()
call x%set_asb()
base/modules/serial/psb_d_vect_mod.F90
+5 -3
View File
@@ -1739,19 +1739,20 @@ contains
end subroutine d_mvect_bld_x
subroutine d_mvect_bld_n(x,m,n,mold)
subroutine d_mvect_bld_n(x,m,n,mold,scratch)
integer(psb_ipk_), intent(in) :: m,n
class(psb_d_multivect_type), intent(out) :: x
class(psb_d_base_multivect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
info = psb_success_
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(x%v,stat=info, mold=psb_d_get_base_multivect_default())
endif
if (info == psb_success_) call x%v%bld(m,n)
if (info == psb_success_) call x%v%bld(m,n,scratch=scratch)
end subroutine d_mvect_bld_n
@@ -2232,3 +2233,4 @@ contains
!!$ end function d_mvect_asum
end module psb_d_multivect_mod
base/modules/serial/psb_i2_base_vect_mod.F90
+13 -8
View File
@@ -1603,7 +1603,7 @@ contains
logical, intent(in), optional :: scratch
call psb_realloc(m,n,x%v,info)
call x%asb(m,n,info,scratch)
call x%asb(m,n,info,scratch=scratch)
end subroutine i2_base_mlv_bld_n
@@ -1884,23 +1884,26 @@ contains
case(psb_dupl_err_)
do i=1,ncfs
if (any(vv(x%iv(i),:).ne.i2zero)) then
call psb_errpush(psb_err_duplicate_coo,'vect-asb')
info = psb_err_duplicate_coo
call psb_errpush(info,'mvect-asb')
return
else
vv(x%iv(i),:) = x%v(i,:)
end if
end do
case default
write(psb_err_unit,*) 'Error in vect_asb: unsafe dupl',x%get_dupl()
write(psb_err_unit,*) 'Error in mvect_asb: unsafe dupl',x%get_dupl()
info =-7
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < m) &
if ((x%get_nrows() < m).or.(x%get_ncols()<n)) &
& call psb_realloc(m,n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(psb_err_alloc_dealloc_,'mvect_asb')
end if
else
info = psb_err_invalid_vect_state_
call psb_errpush(info,'vect_asb')
@@ -1908,8 +1911,10 @@ contains
else
if ((x%get_nrows() < m).or.(x%get_ncols()<n)) &
& call psb_realloc(m,n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(psb_err_alloc_dealloc_,'mvect_asb')
end if
end if
call x%set_host()
call x%set_asb()
base/modules/serial/psb_i2_vect_mod.F90
+5 -3
View File
@@ -984,19 +984,20 @@ contains
end subroutine i2_mvect_bld_x
subroutine i2_mvect_bld_n(x,m,n,mold)
subroutine i2_mvect_bld_n(x,m,n,mold,scratch)
integer(psb_ipk_), intent(in) :: m,n
class(psb_i2_multivect_type), intent(out) :: x
class(psb_i2_base_multivect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
info = psb_success_
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(x%v,stat=info, mold=psb_i2_get_base_multivect_default())
endif
if (info == psb_success_) call x%v%bld(m,n)
if (info == psb_success_) call x%v%bld(m,n,scratch=scratch)
end subroutine i2_mvect_bld_n
@@ -1269,3 +1270,4 @@ contains
end module psb_i2_multivect_mod
base/modules/serial/psb_i_base_vect_mod.F90
+13 -8
View File
@@ -1602,7 +1602,7 @@ contains
logical, intent(in), optional :: scratch
call psb_realloc(m,n,x%v,info)
call x%asb(m,n,info,scratch)
call x%asb(m,n,info,scratch=scratch)
end subroutine i_base_mlv_bld_n
@@ -1883,23 +1883,26 @@ contains
case(psb_dupl_err_)
do i=1,ncfs
if (any(vv(x%iv(i),:).ne.izero)) then
call psb_errpush(psb_err_duplicate_coo,'vect-asb')
info = psb_err_duplicate_coo
call psb_errpush(info,'mvect-asb')
return
else
vv(x%iv(i),:) = x%v(i,:)
end if
end do
case default
write(psb_err_unit,*) 'Error in vect_asb: unsafe dupl',x%get_dupl()
write(psb_err_unit,*) 'Error in mvect_asb: unsafe dupl',x%get_dupl()
info =-7
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < m) &
if ((x%get_nrows() < m).or.(x%get_ncols()<n)) &
& call psb_realloc(m,n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(psb_err_alloc_dealloc_,'mvect_asb')
end if
else
info = psb_err_invalid_vect_state_
call psb_errpush(info,'vect_asb')
@@ -1907,8 +1910,10 @@ contains
else
if ((x%get_nrows() < m).or.(x%get_ncols()<n)) &
& call psb_realloc(m,n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(psb_err_alloc_dealloc_,'mvect_asb')
end if
end if
call x%set_host()
call x%set_asb()
base/modules/serial/psb_i_vect_mod.F90
+5 -3
View File
@@ -983,19 +983,20 @@ contains
end subroutine i_mvect_bld_x
subroutine i_mvect_bld_n(x,m,n,mold)
subroutine i_mvect_bld_n(x,m,n,mold,scratch)
integer(psb_ipk_), intent(in) :: m,n
class(psb_i_multivect_type), intent(out) :: x
class(psb_i_base_multivect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
info = psb_success_
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(x%v,stat=info, mold=psb_i_get_base_multivect_default())
endif
if (info == psb_success_) call x%v%bld(m,n)
if (info == psb_success_) call x%v%bld(m,n,scratch=scratch)
end subroutine i_mvect_bld_n
@@ -1268,3 +1269,4 @@ contains
end module psb_i_multivect_mod
base/modules/serial/psb_l_base_vect_mod.F90
+13 -8
View File
@@ -1603,7 +1603,7 @@ contains
logical, intent(in), optional :: scratch
call psb_realloc(m,n,x%v,info)
call x%asb(m,n,info,scratch)
call x%asb(m,n,info,scratch=scratch)
end subroutine l_base_mlv_bld_n
@@ -1884,23 +1884,26 @@ contains
case(psb_dupl_err_)
do i=1,ncfs
if (any(vv(x%iv(i),:).ne.lzero)) then
call psb_errpush(psb_err_duplicate_coo,'vect-asb')
info = psb_err_duplicate_coo
call psb_errpush(info,'mvect-asb')
return
else
vv(x%iv(i),:) = x%v(i,:)
end if
end do
case default
write(psb_err_unit,*) 'Error in vect_asb: unsafe dupl',x%get_dupl()
write(psb_err_unit,*) 'Error in mvect_asb: unsafe dupl',x%get_dupl()
info =-7
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < m) &
if ((x%get_nrows() < m).or.(x%get_ncols()<n)) &
& call psb_realloc(m,n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(psb_err_alloc_dealloc_,'mvect_asb')
end if
else
info = psb_err_invalid_vect_state_
call psb_errpush(info,'vect_asb')
@@ -1908,8 +1911,10 @@ contains
else
if ((x%get_nrows() < m).or.(x%get_ncols()<n)) &
& call psb_realloc(m,n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(psb_err_alloc_dealloc_,'mvect_asb')
end if
end if
call x%set_host()
call x%set_asb()
base/modules/serial/psb_l_vect_mod.F90
+5 -3
View File
@@ -984,19 +984,20 @@ contains
end subroutine l_mvect_bld_x
subroutine l_mvect_bld_n(x,m,n,mold)
subroutine l_mvect_bld_n(x,m,n,mold,scratch)
integer(psb_ipk_), intent(in) :: m,n
class(psb_l_multivect_type), intent(out) :: x
class(psb_l_base_multivect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
info = psb_success_
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(x%v,stat=info, mold=psb_l_get_base_multivect_default())
endif
if (info == psb_success_) call x%v%bld(m,n)
if (info == psb_success_) call x%v%bld(m,n,scratch=scratch)
end subroutine l_mvect_bld_n
@@ -1269,3 +1270,4 @@ contains
end module psb_l_multivect_mod
base/modules/serial/psb_s_base_vect_mod.F90
+17 -8
View File
@@ -2189,6 +2189,10 @@ contains
res = min(res,abs(x%v(i)))
end do
#else
!
! From M&R: if the array is of size zero, MINVAL
! returns the largest positive value
!
res = minval(x%v(1:n))
#endif
end function s_base_min
@@ -2856,7 +2860,7 @@ contains
logical, intent(in), optional :: scratch
call psb_realloc(m,n,x%v,info)
call x%asb(m,n,info,scratch)
call x%asb(m,n,info,scratch=scratch)
end subroutine s_base_mlv_bld_n
@@ -3137,23 +3141,26 @@ contains
case(psb_dupl_err_)
do i=1,ncfs
if (any(vv(x%iv(i),:).ne.szero)) then
call psb_errpush(psb_err_duplicate_coo,'vect-asb')
info = psb_err_duplicate_coo
call psb_errpush(info,'mvect-asb')
return
else
vv(x%iv(i),:) = x%v(i,:)
end if
end do
case default
write(psb_err_unit,*) 'Error in vect_asb: unsafe dupl',x%get_dupl()
write(psb_err_unit,*) 'Error in mvect_asb: unsafe dupl',x%get_dupl()
info =-7
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < m) &
if ((x%get_nrows() < m).or.(x%get_ncols()<n)) &
& call psb_realloc(m,n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(psb_err_alloc_dealloc_,'mvect_asb')
end if
else
info = psb_err_invalid_vect_state_
call psb_errpush(info,'vect_asb')
@@ -3161,8 +3168,10 @@ contains
else
if ((x%get_nrows() < m).or.(x%get_ncols()<n)) &
& call psb_realloc(m,n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(psb_err_alloc_dealloc_,'mvect_asb')
end if
end if
call x%set_host()
call x%set_asb()
base/modules/serial/psb_s_vect_mod.F90
+5 -3
View File
@@ -1739,19 +1739,20 @@ contains
end subroutine s_mvect_bld_x
subroutine s_mvect_bld_n(x,m,n,mold)
subroutine s_mvect_bld_n(x,m,n,mold,scratch)
integer(psb_ipk_), intent(in) :: m,n
class(psb_s_multivect_type), intent(out) :: x
class(psb_s_base_multivect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
info = psb_success_
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(x%v,stat=info, mold=psb_s_get_base_multivect_default())
endif
if (info == psb_success_) call x%v%bld(m,n)
if (info == psb_success_) call x%v%bld(m,n,scratch=scratch)
end subroutine s_mvect_bld_n
@@ -2232,3 +2233,4 @@ contains
!!$ end function s_mvect_asum
end module psb_s_multivect_mod
base/modules/serial/psb_z_base_vect_mod.F90
+13 -8
View File
@@ -2677,7 +2677,7 @@ contains
logical, intent(in), optional :: scratch
call psb_realloc(m,n,x%v,info)
call x%asb(m,n,info,scratch)
call x%asb(m,n,info,scratch=scratch)
end subroutine z_base_mlv_bld_n
@@ -2958,23 +2958,26 @@ contains
case(psb_dupl_err_)
do i=1,ncfs
if (any(vv(x%iv(i),:).ne.zzero)) then
call psb_errpush(psb_err_duplicate_coo,'vect-asb')
info = psb_err_duplicate_coo
call psb_errpush(info,'mvect-asb')
return
else
vv(x%iv(i),:) = x%v(i,:)
end if
end do
case default
write(psb_err_unit,*) 'Error in vect_asb: unsafe dupl',x%get_dupl()
write(psb_err_unit,*) 'Error in mvect_asb: unsafe dupl',x%get_dupl()
info =-7
end select
call psb_move_alloc(vv,x%v,info)
if (allocated(x%iv)) deallocate(x%iv,stat=info)
else if (x%is_upd().or.x%is_asb().or.scratch_) then
if (x%get_nrows() < m) &
if ((x%get_nrows() < m).or.(x%get_ncols()<n)) &
& call psb_realloc(m,n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(psb_err_alloc_dealloc_,'mvect_asb')
end if
else
info = psb_err_invalid_vect_state_
call psb_errpush(info,'vect_asb')
@@ -2982,8 +2985,10 @@ contains
else
if ((x%get_nrows() < m).or.(x%get_ncols()<n)) &
& call psb_realloc(m,n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(psb_err_alloc_dealloc_,'mvect_asb')
end if
end if
call x%set_host()
call x%set_asb()
base/modules/serial/psb_z_vect_mod.F90
+5 -3
View File
@@ -1660,19 +1660,20 @@ contains
end subroutine z_mvect_bld_x
subroutine z_mvect_bld_n(x,m,n,mold)
subroutine z_mvect_bld_n(x,m,n,mold,scratch)
integer(psb_ipk_), intent(in) :: m,n
class(psb_z_multivect_type), intent(out) :: x
class(psb_z_base_multivect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
logical, intent(in), optional :: scratch
info = psb_success_
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(x%v,stat=info, mold=psb_z_get_base_multivect_default())
endif
if (info == psb_success_) call x%v%bld(m,n)
if (info == psb_success_) call x%v%bld(m,n,scratch=scratch)
end subroutine z_mvect_bld_n
@@ -2153,3 +2154,4 @@ contains
!!$ end function z_mvect_asum
end module psb_z_multivect_mod
base/tools/psb_casb.f90
+1 -1
View File
@@ -309,7 +309,7 @@ subroutine psb_casb_multivect(x, desc_a, info, mold, scratch,n)
dupl_ = x%get_dupl()
if (scratch_) then
call x%free(info)
call x%bld(ncol,n_,mold=mold)
call x%bld(ncol,n_,mold=mold,scratch=.true.)
else
call x%asb(ncol,n_,info)
! ..update halo elements..
base/tools/psb_dasb.f90
+1 -1
View File
@@ -309,7 +309,7 @@ subroutine psb_dasb_multivect(x, desc_a, info, mold, scratch,n)
dupl_ = x%get_dupl()
if (scratch_) then
call x%free(info)
call x%bld(ncol,n_,mold=mold)
call x%bld(ncol,n_,mold=mold,scratch=.true.)
else
call x%asb(ncol,n_,info)
! ..update halo elements..
base/tools/psb_iasb.f90
+1 -1
View File
@@ -309,7 +309,7 @@ subroutine psb_iasb_multivect(x, desc_a, info, mold, scratch,n)
dupl_ = x%get_dupl()
if (scratch_) then
call x%free(info)
call x%bld(ncol,n_,mold=mold)
call x%bld(ncol,n_,mold=mold,scratch=.true.)
else
call x%asb(ncol,n_,info)
! ..update halo elements..
base/tools/psb_lasb.f90
+1 -1
View File
@@ -309,7 +309,7 @@ subroutine psb_lasb_multivect(x, desc_a, info, mold, scratch,n)
dupl_ = x%get_dupl()
if (scratch_) then
call x%free(info)
call x%bld(ncol,n_,mold=mold)
call x%bld(ncol,n_,mold=mold,scratch=.true.)
else
call x%asb(ncol,n_,info)
! ..update halo elements..
base/tools/psb_sasb.f90
+1 -1
View File
@@ -309,7 +309,7 @@ subroutine psb_sasb_multivect(x, desc_a, info, mold, scratch,n)
dupl_ = x%get_dupl()
if (scratch_) then
call x%free(info)
call x%bld(ncol,n_,mold=mold)
call x%bld(ncol,n_,mold=mold,scratch=.true.)
else
call x%asb(ncol,n_,info)
! ..update halo elements..
base/tools/psb_zasb.f90
+1 -1
View File
@@ -309,7 +309,7 @@ subroutine psb_zasb_multivect(x, desc_a, info, mold, scratch,n)
dupl_ = x%get_dupl()
if (scratch_) then
call x%free(info)
call x%bld(ncol,n_,mold=mold)
call x%bld(ncol,n_,mold=mold,scratch=.true.)
else
call x%asb(ncol,n_,info)
! ..update halo elements..