Add clear argument to reinit method in vectors.

fixmpic
sfilippone 2 months ago
parent e2ddc08aea
commit e8c5c0b8b0

@ -418,16 +418,24 @@ contains
end subroutine c_base_mold
subroutine c_base_reinit(x, info)
subroutine c_base_reinit(x, info,clear)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_c_base_vect_type), intent(out) :: x
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: clear
logical :: clear_
if (present(clear)) then
clear_ = clear
else
clear_ = .true.
end if
if (allocated(x%v)) then
call x%sync()
x%v(:) = czero
if (x%is_dev()) call x%sync()
if (clear_) x%v(:) = czero
call x%set_host()
call x%set_upd()
end if

@ -613,12 +613,13 @@ contains
call x%set_bld()
end subroutine c_vect_all
subroutine c_vect_reinit(x, info)
subroutine c_vect_reinit(x, info, clear)
implicit none
class(psb_c_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: clear
if (allocated(x%v)) call x%v%reinit(info)
if (allocated(x%v)) call x%v%reinit(info,clear)
call x%set_upd()
end subroutine c_vect_reinit

@ -425,16 +425,24 @@ contains
end subroutine d_base_mold
subroutine d_base_reinit(x, info)
subroutine d_base_reinit(x, info,clear)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_d_base_vect_type), intent(out) :: x
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: clear
logical :: clear_
if (present(clear)) then
clear_ = clear
else
clear_ = .true.
end if
if (allocated(x%v)) then
call x%sync()
x%v(:) = dzero
if (x%is_dev()) call x%sync()
if (clear_) x%v(:) = dzero
call x%set_host()
call x%set_upd()
end if

@ -620,12 +620,13 @@ contains
call x%set_bld()
end subroutine d_vect_all
subroutine d_vect_reinit(x, info)
subroutine d_vect_reinit(x, info, clear)
implicit none
class(psb_d_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: clear
if (allocated(x%v)) call x%v%reinit(info)
if (allocated(x%v)) call x%v%reinit(info,clear)
call x%set_upd()
end subroutine d_vect_reinit

@ -351,16 +351,24 @@ contains
end subroutine i_base_mold
subroutine i_base_reinit(x, info)
subroutine i_base_reinit(x, info,clear)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_i_base_vect_type), intent(out) :: x
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: clear
logical :: clear_
if (present(clear)) then
clear_ = clear
else
clear_ = .true.
end if
if (allocated(x%v)) then
call x%sync()
x%v(:) = izero
if (x%is_dev()) call x%sync()
if (clear_) x%v(:) = izero
call x%set_host()
call x%set_upd()
end if

@ -558,12 +558,13 @@ contains
call x%set_bld()
end subroutine i_vect_all
subroutine i_vect_reinit(x, info)
subroutine i_vect_reinit(x, info, clear)
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: clear
if (allocated(x%v)) call x%v%reinit(info)
if (allocated(x%v)) call x%v%reinit(info,clear)
call x%set_upd()
end subroutine i_vect_reinit

@ -352,16 +352,24 @@ contains
end subroutine l_base_mold
subroutine l_base_reinit(x, info)
subroutine l_base_reinit(x, info,clear)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_l_base_vect_type), intent(out) :: x
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: clear
logical :: clear_
if (present(clear)) then
clear_ = clear
else
clear_ = .true.
end if
if (allocated(x%v)) then
call x%sync()
x%v(:) = lzero
if (x%is_dev()) call x%sync()
if (clear_) x%v(:) = lzero
call x%set_host()
call x%set_upd()
end if

@ -559,12 +559,13 @@ contains
call x%set_bld()
end subroutine l_vect_all
subroutine l_vect_reinit(x, info)
subroutine l_vect_reinit(x, info, clear)
implicit none
class(psb_l_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: clear
if (allocated(x%v)) call x%v%reinit(info)
if (allocated(x%v)) call x%v%reinit(info,clear)
call x%set_upd()
end subroutine l_vect_reinit

@ -425,16 +425,24 @@ contains
end subroutine s_base_mold
subroutine s_base_reinit(x, info)
subroutine s_base_reinit(x, info,clear)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_s_base_vect_type), intent(out) :: x
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: clear
logical :: clear_
if (present(clear)) then
clear_ = clear
else
clear_ = .true.
end if
if (allocated(x%v)) then
call x%sync()
x%v(:) = szero
if (x%is_dev()) call x%sync()
if (clear_) x%v(:) = szero
call x%set_host()
call x%set_upd()
end if

@ -620,12 +620,13 @@ contains
call x%set_bld()
end subroutine s_vect_all
subroutine s_vect_reinit(x, info)
subroutine s_vect_reinit(x, info, clear)
implicit none
class(psb_s_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: clear
if (allocated(x%v)) call x%v%reinit(info)
if (allocated(x%v)) call x%v%reinit(info,clear)
call x%set_upd()
end subroutine s_vect_reinit

@ -418,16 +418,24 @@ contains
end subroutine z_base_mold
subroutine z_base_reinit(x, info)
subroutine z_base_reinit(x, info,clear)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_z_base_vect_type), intent(out) :: x
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: clear
logical :: clear_
if (present(clear)) then
clear_ = clear
else
clear_ = .true.
end if
if (allocated(x%v)) then
call x%sync()
x%v(:) = zzero
if (x%is_dev()) call x%sync()
if (clear_) x%v(:) = zzero
call x%set_host()
call x%set_upd()
end if

@ -613,12 +613,13 @@ contains
call x%set_bld()
end subroutine z_vect_all
subroutine z_vect_reinit(x, info)
subroutine z_vect_reinit(x, info, clear)
implicit none
class(psb_z_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: clear
if (allocated(x%v)) call x%v%reinit(info)
if (allocated(x%v)) call x%v%reinit(info,clear)
call x%set_upd()
end subroutine z_vect_reinit

Loading…
Cancel
Save