From 42a2c674829c0ab4ed20fa522596f2791ee0f0f5 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Tue, 16 Jun 2026 16:41:19 +0200 Subject: [PATCH] Fix MLT-DIV in serial vectors --- base/modules/serial/psb_c_base_vect_mod.F90 | 41 +++++++++++++++------ base/modules/serial/psb_c_vect_mod.F90 | 11 +++--- base/modules/serial/psb_d_base_vect_mod.F90 | 41 +++++++++++++++------ base/modules/serial/psb_d_vect_mod.F90 | 11 +++--- base/modules/serial/psb_i2_vect_mod.F90 | 1 - base/modules/serial/psb_i_vect_mod.F90 | 1 - base/modules/serial/psb_l_vect_mod.F90 | 1 - base/modules/serial/psb_s_base_vect_mod.F90 | 41 +++++++++++++++------ base/modules/serial/psb_s_vect_mod.F90 | 11 +++--- base/modules/serial/psb_z_base_vect_mod.F90 | 41 +++++++++++++++------ base/modules/serial/psb_z_vect_mod.F90 | 11 +++--- 11 files changed, 140 insertions(+), 71 deletions(-) diff --git a/base/modules/serial/psb_c_base_vect_mod.F90 b/base/modules/serial/psb_c_base_vect_mod.F90 index e1058c1f7..6ca78a379 100644 --- a/base/modules/serial/psb_c_base_vect_mod.F90 +++ b/base/modules/serial/psb_c_base_vect_mod.F90 @@ -205,13 +205,14 @@ module psb_c_base_vect_mod ! ! Vector-Vector operations ! - procedure, pass(x) :: div_v => c_base_div_v - procedure, pass(x) :: div_v_check => c_base_div_v_check + procedure, pass(y) :: div_v => c_base_div_v + procedure, pass(y) :: div_a => c_base_div_a + procedure, pass(y) :: div_v_check => c_base_div_v_check procedure, pass(z) :: div_v2 => c_base_div_v2 procedure, pass(z) :: div_v2_check => c_base_div_v2_check procedure, pass(z) :: div_a2 => c_base_div_a2 procedure, pass(z) :: div_a2_check => c_base_div_a2_check - generic, public :: div => div_v, div_v2, div_v_check, & + generic, public :: div => div_v, div_v2, div_v_check, div_a, & div_v2_check, div_a2, div_a2_check procedure, pass(y) :: inv_v => c_base_inv_v procedure, pass(y) :: inv_v_check => c_base_inv_v_check @@ -1280,7 +1281,7 @@ contains integer(psb_ipk_), intent(in) :: index complex(psb_spk_) :: res - res = 0 + res = czero if (allocated(x%v)) then if (x%is_dev()) call x%sync() res = x%v(index) @@ -1293,14 +1294,12 @@ contains class(psb_c_base_vect_type), intent(inout) :: x integer(psb_ipk_), intent(in) :: index complex(psb_spk_) :: val - - + if (allocated(x%v)) then if (x%is_dev()) call x%sync() x%v(index) =val call x%set_host() end if - end subroutine c_base_set_entry ! @@ -1817,9 +1816,28 @@ contains info = 0 if (x%is_dev()) call x%sync() - call x%div(x%v,y%v,info) + call y%div(x%v,info) end subroutine c_base_div_v + + subroutine c_base_div_a(x, y, info) + use psi_serial_mod + implicit none + complex(psb_spk_), intent(in) :: x(:) + class(psb_c_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: i, n + + info = 0 + if (y%is_dev()) call y%sync() + n = min(size(y%v), size(x)) + !$omp parallel do private(i) + do i=1, n + y%v(i) = y%v(i)/x(i) + end do + call y%set_host() + + end subroutine c_base_div_a ! !> Function base_div_v2 !! \memberof psb_c_base_vect_type @@ -1837,10 +1855,10 @@ contains integer(psb_ipk_) :: i, n info = 0 - if (z%is_dev()) call z%sync() + if (x%is_dev()) call x%sync() + if (y%is_dev()) call y%sync() call z%div(x%v,y%v,info) - - + call z%set_host() end subroutine c_base_div_v2 ! !> Function base_div_v_check @@ -1860,6 +1878,7 @@ contains info = 0 if (x%is_dev()) call x%sync() + if (y%is_dev()) call y%sync() call x%div(x%v,y%v,info,flag) end subroutine c_base_div_v_check diff --git a/base/modules/serial/psb_c_vect_mod.F90 b/base/modules/serial/psb_c_vect_mod.F90 index 5e628ff97..7f6c1c6cf 100644 --- a/base/modules/serial/psb_c_vect_mod.F90 +++ b/base/modules/serial/psb_c_vect_mod.F90 @@ -128,10 +128,10 @@ module psb_c_vect_mod procedure, pass(z) :: mlt_av => c_vect_mlt_av generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,& & mlt_v_2, mlt_av, mlt_va - procedure, pass(x) :: div_v => c_vect_div_v + procedure, pass(y) :: div_v => c_vect_div_v procedure, pass(z) :: div_v2 => c_vect_div_v2 - procedure, pass(x) :: div_v_check => c_vect_div_v_check - procedure, pass(x) :: div_v2_check => c_vect_div_v2_check + procedure, pass(y) :: div_v_check => c_vect_div_v_check + procedure, pass(y) :: div_v2_check => c_vect_div_v2_check procedure, pass(z) :: div_a2 => c_vect_div_a2 procedure, pass(z) :: div_a2_check => c_vect_div_a2_check generic, public :: div => div_v, div_v2, div_v_check, & @@ -1100,7 +1100,7 @@ contains info = 0 if (allocated(x%v).and.allocated(y%v)) & - & call x%v%div(y%v,info) + & call y%v%div(x%v,info) end subroutine c_vect_div_v @@ -1130,7 +1130,7 @@ contains info = 0 if (allocated(x%v).and.allocated(y%v)) & - & call x%v%div(y%v,info,flag) + & call y%v%div(x%v,info,flag) end subroutine c_vect_div_v_check @@ -2163,4 +2163,3 @@ contains !!$ end function c_mvect_asum end module psb_c_multivect_mod - diff --git a/base/modules/serial/psb_d_base_vect_mod.F90 b/base/modules/serial/psb_d_base_vect_mod.F90 index cfdbcee54..ad77c62a4 100644 --- a/base/modules/serial/psb_d_base_vect_mod.F90 +++ b/base/modules/serial/psb_d_base_vect_mod.F90 @@ -205,13 +205,14 @@ module psb_d_base_vect_mod ! ! Vector-Vector operations ! - procedure, pass(x) :: div_v => d_base_div_v - procedure, pass(x) :: div_v_check => d_base_div_v_check + procedure, pass(y) :: div_v => d_base_div_v + procedure, pass(y) :: div_a => d_base_div_a + procedure, pass(y) :: div_v_check => d_base_div_v_check procedure, pass(z) :: div_v2 => d_base_div_v2 procedure, pass(z) :: div_v2_check => d_base_div_v2_check procedure, pass(z) :: div_a2 => d_base_div_a2 procedure, pass(z) :: div_a2_check => d_base_div_a2_check - generic, public :: div => div_v, div_v2, div_v_check, & + generic, public :: div => div_v, div_v2, div_v_check, div_a, & div_v2_check, div_a2, div_a2_check procedure, pass(y) :: inv_v => d_base_inv_v procedure, pass(y) :: inv_v_check => d_base_inv_v_check @@ -1287,7 +1288,7 @@ contains integer(psb_ipk_), intent(in) :: index real(psb_dpk_) :: res - res = 0 + res = dzero if (allocated(x%v)) then if (x%is_dev()) call x%sync() res = x%v(index) @@ -1300,14 +1301,12 @@ contains class(psb_d_base_vect_type), intent(inout) :: x integer(psb_ipk_), intent(in) :: index real(psb_dpk_) :: val - - + if (allocated(x%v)) then if (x%is_dev()) call x%sync() x%v(index) =val call x%set_host() end if - end subroutine d_base_set_entry ! @@ -1824,9 +1823,28 @@ contains info = 0 if (x%is_dev()) call x%sync() - call x%div(x%v,y%v,info) + call y%div(x%v,info) end subroutine d_base_div_v + + subroutine d_base_div_a(x, y, info) + use psi_serial_mod + implicit none + real(psb_dpk_), intent(in) :: x(:) + class(psb_d_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: i, n + + info = 0 + if (y%is_dev()) call y%sync() + n = min(size(y%v), size(x)) + !$omp parallel do private(i) + do i=1, n + y%v(i) = y%v(i)/x(i) + end do + call y%set_host() + + end subroutine d_base_div_a ! !> Function base_div_v2 !! \memberof psb_d_base_vect_type @@ -1844,10 +1862,10 @@ contains integer(psb_ipk_) :: i, n info = 0 - if (z%is_dev()) call z%sync() + if (x%is_dev()) call x%sync() + if (y%is_dev()) call y%sync() call z%div(x%v,y%v,info) - - + call z%set_host() end subroutine d_base_div_v2 ! !> Function base_div_v_check @@ -1867,6 +1885,7 @@ contains info = 0 if (x%is_dev()) call x%sync() + if (y%is_dev()) call y%sync() call x%div(x%v,y%v,info,flag) end subroutine d_base_div_v_check diff --git a/base/modules/serial/psb_d_vect_mod.F90 b/base/modules/serial/psb_d_vect_mod.F90 index cfa3fe6fb..c816e835f 100644 --- a/base/modules/serial/psb_d_vect_mod.F90 +++ b/base/modules/serial/psb_d_vect_mod.F90 @@ -128,10 +128,10 @@ module psb_d_vect_mod procedure, pass(z) :: mlt_av => d_vect_mlt_av generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,& & mlt_v_2, mlt_av, mlt_va - procedure, pass(x) :: div_v => d_vect_div_v + procedure, pass(y) :: div_v => d_vect_div_v procedure, pass(z) :: div_v2 => d_vect_div_v2 - procedure, pass(x) :: div_v_check => d_vect_div_v_check - procedure, pass(x) :: div_v2_check => d_vect_div_v2_check + procedure, pass(y) :: div_v_check => d_vect_div_v_check + procedure, pass(y) :: div_v2_check => d_vect_div_v2_check procedure, pass(z) :: div_a2 => d_vect_div_a2 procedure, pass(z) :: div_a2_check => d_vect_div_a2_check generic, public :: div => div_v, div_v2, div_v_check, & @@ -1107,7 +1107,7 @@ contains info = 0 if (allocated(x%v).and.allocated(y%v)) & - & call x%v%div(y%v,info) + & call y%v%div(x%v,info) end subroutine d_vect_div_v @@ -1137,7 +1137,7 @@ contains info = 0 if (allocated(x%v).and.allocated(y%v)) & - & call x%v%div(y%v,info,flag) + & call y%v%div(x%v,info,flag) end subroutine d_vect_div_v_check @@ -2242,4 +2242,3 @@ contains !!$ end function d_mvect_asum end module psb_d_multivect_mod - diff --git a/base/modules/serial/psb_i2_vect_mod.F90 b/base/modules/serial/psb_i2_vect_mod.F90 index 136d9329f..b05c2ffba 100644 --- a/base/modules/serial/psb_i2_vect_mod.F90 +++ b/base/modules/serial/psb_i2_vect_mod.F90 @@ -1270,4 +1270,3 @@ contains end module psb_i2_multivect_mod - diff --git a/base/modules/serial/psb_i_vect_mod.F90 b/base/modules/serial/psb_i_vect_mod.F90 index aa8646ee8..c2b51668d 100644 --- a/base/modules/serial/psb_i_vect_mod.F90 +++ b/base/modules/serial/psb_i_vect_mod.F90 @@ -1269,4 +1269,3 @@ contains end module psb_i_multivect_mod - diff --git a/base/modules/serial/psb_l_vect_mod.F90 b/base/modules/serial/psb_l_vect_mod.F90 index d876d21ee..838251294 100644 --- a/base/modules/serial/psb_l_vect_mod.F90 +++ b/base/modules/serial/psb_l_vect_mod.F90 @@ -1270,4 +1270,3 @@ contains end module psb_l_multivect_mod - diff --git a/base/modules/serial/psb_s_base_vect_mod.F90 b/base/modules/serial/psb_s_base_vect_mod.F90 index 814b11a57..d8e88adab 100644 --- a/base/modules/serial/psb_s_base_vect_mod.F90 +++ b/base/modules/serial/psb_s_base_vect_mod.F90 @@ -205,13 +205,14 @@ module psb_s_base_vect_mod ! ! Vector-Vector operations ! - procedure, pass(x) :: div_v => s_base_div_v - procedure, pass(x) :: div_v_check => s_base_div_v_check + procedure, pass(y) :: div_v => s_base_div_v + procedure, pass(y) :: div_a => s_base_div_a + procedure, pass(y) :: div_v_check => s_base_div_v_check procedure, pass(z) :: div_v2 => s_base_div_v2 procedure, pass(z) :: div_v2_check => s_base_div_v2_check procedure, pass(z) :: div_a2 => s_base_div_a2 procedure, pass(z) :: div_a2_check => s_base_div_a2_check - generic, public :: div => div_v, div_v2, div_v_check, & + generic, public :: div => div_v, div_v2, div_v_check, div_a, & div_v2_check, div_a2, div_a2_check procedure, pass(y) :: inv_v => s_base_inv_v procedure, pass(y) :: inv_v_check => s_base_inv_v_check @@ -1287,7 +1288,7 @@ contains integer(psb_ipk_), intent(in) :: index real(psb_spk_) :: res - res = 0 + res = szero if (allocated(x%v)) then if (x%is_dev()) call x%sync() res = x%v(index) @@ -1300,14 +1301,12 @@ contains class(psb_s_base_vect_type), intent(inout) :: x integer(psb_ipk_), intent(in) :: index real(psb_spk_) :: val - - + if (allocated(x%v)) then if (x%is_dev()) call x%sync() x%v(index) =val call x%set_host() end if - end subroutine s_base_set_entry ! @@ -1824,9 +1823,28 @@ contains info = 0 if (x%is_dev()) call x%sync() - call x%div(x%v,y%v,info) + call y%div(x%v,info) end subroutine s_base_div_v + + subroutine s_base_div_a(x, y, info) + use psi_serial_mod + implicit none + real(psb_spk_), intent(in) :: x(:) + class(psb_s_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: i, n + + info = 0 + if (y%is_dev()) call y%sync() + n = min(size(y%v), size(x)) + !$omp parallel do private(i) + do i=1, n + y%v(i) = y%v(i)/x(i) + end do + call y%set_host() + + end subroutine s_base_div_a ! !> Function base_div_v2 !! \memberof psb_s_base_vect_type @@ -1844,10 +1862,10 @@ contains integer(psb_ipk_) :: i, n info = 0 - if (z%is_dev()) call z%sync() + if (x%is_dev()) call x%sync() + if (y%is_dev()) call y%sync() call z%div(x%v,y%v,info) - - + call z%set_host() end subroutine s_base_div_v2 ! !> Function base_div_v_check @@ -1867,6 +1885,7 @@ contains info = 0 if (x%is_dev()) call x%sync() + if (y%is_dev()) call y%sync() call x%div(x%v,y%v,info,flag) end subroutine s_base_div_v_check diff --git a/base/modules/serial/psb_s_vect_mod.F90 b/base/modules/serial/psb_s_vect_mod.F90 index 3128866a5..c85ea3b63 100644 --- a/base/modules/serial/psb_s_vect_mod.F90 +++ b/base/modules/serial/psb_s_vect_mod.F90 @@ -128,10 +128,10 @@ module psb_s_vect_mod procedure, pass(z) :: mlt_av => s_vect_mlt_av generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,& & mlt_v_2, mlt_av, mlt_va - procedure, pass(x) :: div_v => s_vect_div_v + procedure, pass(y) :: div_v => s_vect_div_v procedure, pass(z) :: div_v2 => s_vect_div_v2 - procedure, pass(x) :: div_v_check => s_vect_div_v_check - procedure, pass(x) :: div_v2_check => s_vect_div_v2_check + procedure, pass(y) :: div_v_check => s_vect_div_v_check + procedure, pass(y) :: div_v2_check => s_vect_div_v2_check procedure, pass(z) :: div_a2 => s_vect_div_a2 procedure, pass(z) :: div_a2_check => s_vect_div_a2_check generic, public :: div => div_v, div_v2, div_v_check, & @@ -1107,7 +1107,7 @@ contains info = 0 if (allocated(x%v).and.allocated(y%v)) & - & call x%v%div(y%v,info) + & call y%v%div(x%v,info) end subroutine s_vect_div_v @@ -1137,7 +1137,7 @@ contains info = 0 if (allocated(x%v).and.allocated(y%v)) & - & call x%v%div(y%v,info,flag) + & call y%v%div(x%v,info,flag) end subroutine s_vect_div_v_check @@ -2242,4 +2242,3 @@ contains !!$ end function s_mvect_asum end module psb_s_multivect_mod - diff --git a/base/modules/serial/psb_z_base_vect_mod.F90 b/base/modules/serial/psb_z_base_vect_mod.F90 index b236beb7d..6f7167ee2 100644 --- a/base/modules/serial/psb_z_base_vect_mod.F90 +++ b/base/modules/serial/psb_z_base_vect_mod.F90 @@ -205,13 +205,14 @@ module psb_z_base_vect_mod ! ! Vector-Vector operations ! - procedure, pass(x) :: div_v => z_base_div_v - procedure, pass(x) :: div_v_check => z_base_div_v_check + procedure, pass(y) :: div_v => z_base_div_v + procedure, pass(y) :: div_a => z_base_div_a + procedure, pass(y) :: div_v_check => z_base_div_v_check procedure, pass(z) :: div_v2 => z_base_div_v2 procedure, pass(z) :: div_v2_check => z_base_div_v2_check procedure, pass(z) :: div_a2 => z_base_div_a2 procedure, pass(z) :: div_a2_check => z_base_div_a2_check - generic, public :: div => div_v, div_v2, div_v_check, & + generic, public :: div => div_v, div_v2, div_v_check, div_a, & div_v2_check, div_a2, div_a2_check procedure, pass(y) :: inv_v => z_base_inv_v procedure, pass(y) :: inv_v_check => z_base_inv_v_check @@ -1280,7 +1281,7 @@ contains integer(psb_ipk_), intent(in) :: index complex(psb_dpk_) :: res - res = 0 + res = zzero if (allocated(x%v)) then if (x%is_dev()) call x%sync() res = x%v(index) @@ -1293,14 +1294,12 @@ contains class(psb_z_base_vect_type), intent(inout) :: x integer(psb_ipk_), intent(in) :: index complex(psb_dpk_) :: val - - + if (allocated(x%v)) then if (x%is_dev()) call x%sync() x%v(index) =val call x%set_host() end if - end subroutine z_base_set_entry ! @@ -1817,9 +1816,28 @@ contains info = 0 if (x%is_dev()) call x%sync() - call x%div(x%v,y%v,info) + call y%div(x%v,info) end subroutine z_base_div_v + + subroutine z_base_div_a(x, y, info) + use psi_serial_mod + implicit none + complex(psb_dpk_), intent(in) :: x(:) + class(psb_z_base_vect_type), intent(inout) :: y + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: i, n + + info = 0 + if (y%is_dev()) call y%sync() + n = min(size(y%v), size(x)) + !$omp parallel do private(i) + do i=1, n + y%v(i) = y%v(i)/x(i) + end do + call y%set_host() + + end subroutine z_base_div_a ! !> Function base_div_v2 !! \memberof psb_z_base_vect_type @@ -1837,10 +1855,10 @@ contains integer(psb_ipk_) :: i, n info = 0 - if (z%is_dev()) call z%sync() + if (x%is_dev()) call x%sync() + if (y%is_dev()) call y%sync() call z%div(x%v,y%v,info) - - + call z%set_host() end subroutine z_base_div_v2 ! !> Function base_div_v_check @@ -1860,6 +1878,7 @@ contains info = 0 if (x%is_dev()) call x%sync() + if (y%is_dev()) call y%sync() call x%div(x%v,y%v,info,flag) end subroutine z_base_div_v_check diff --git a/base/modules/serial/psb_z_vect_mod.F90 b/base/modules/serial/psb_z_vect_mod.F90 index f7cf3584a..062c914bb 100644 --- a/base/modules/serial/psb_z_vect_mod.F90 +++ b/base/modules/serial/psb_z_vect_mod.F90 @@ -128,10 +128,10 @@ module psb_z_vect_mod procedure, pass(z) :: mlt_av => z_vect_mlt_av generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,& & mlt_v_2, mlt_av, mlt_va - procedure, pass(x) :: div_v => z_vect_div_v + procedure, pass(y) :: div_v => z_vect_div_v procedure, pass(z) :: div_v2 => z_vect_div_v2 - procedure, pass(x) :: div_v_check => z_vect_div_v_check - procedure, pass(x) :: div_v2_check => z_vect_div_v2_check + procedure, pass(y) :: div_v_check => z_vect_div_v_check + procedure, pass(y) :: div_v2_check => z_vect_div_v2_check procedure, pass(z) :: div_a2 => z_vect_div_a2 procedure, pass(z) :: div_a2_check => z_vect_div_a2_check generic, public :: div => div_v, div_v2, div_v_check, & @@ -1100,7 +1100,7 @@ contains info = 0 if (allocated(x%v).and.allocated(y%v)) & - & call x%v%div(y%v,info) + & call y%v%div(x%v,info) end subroutine z_vect_div_v @@ -1130,7 +1130,7 @@ contains info = 0 if (allocated(x%v).and.allocated(y%v)) & - & call x%v%div(y%v,info,flag) + & call y%v%div(x%v,info,flag) end subroutine z_vect_div_v_check @@ -2163,4 +2163,3 @@ contains !!$ end function z_mvect_asum end module psb_z_multivect_mod -