From 0bdb1c2d843d8b50838506d774a83fc7b08b4d29 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Fri, 22 May 2026 16:30:33 +0200 Subject: [PATCH] Fix vector MLT and DIV --- base/modules/serial/psb_c_base_vect_mod.F90 | 28 ++++++++++++++++++--- base/modules/serial/psb_c_vect_mod.F90 | 10 ++++---- base/modules/serial/psb_d_base_vect_mod.F90 | 28 ++++++++++++++++++--- base/modules/serial/psb_d_vect_mod.F90 | 10 ++++---- base/modules/serial/psb_s_base_vect_mod.F90 | 28 ++++++++++++++++++--- base/modules/serial/psb_s_vect_mod.F90 | 10 ++++---- base/modules/serial/psb_z_base_vect_mod.F90 | 28 ++++++++++++++++++--- base/modules/serial/psb_z_vect_mod.F90 | 10 ++++---- 8 files changed, 116 insertions(+), 36 deletions(-) diff --git a/base/modules/serial/psb_c_base_vect_mod.F90 b/base/modules/serial/psb_c_base_vect_mod.F90 index be652207f..33dbaaa4d 100644 --- a/base/modules/serial/psb_c_base_vect_mod.F90 +++ b/base/modules/serial/psb_c_base_vect_mod.F90 @@ -174,13 +174,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 @@ -1443,9 +1444,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 diff --git a/base/modules/serial/psb_c_vect_mod.F90 b/base/modules/serial/psb_c_vect_mod.F90 index cdc260b5e..8f4721e59 100644 --- a/base/modules/serial/psb_c_vect_mod.F90 +++ b/base/modules/serial/psb_c_vect_mod.F90 @@ -113,10 +113,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, & @@ -926,7 +926,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 @@ -956,7 +956,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 diff --git a/base/modules/serial/psb_d_base_vect_mod.F90 b/base/modules/serial/psb_d_base_vect_mod.F90 index e98416525..2cfa27285 100644 --- a/base/modules/serial/psb_d_base_vect_mod.F90 +++ b/base/modules/serial/psb_d_base_vect_mod.F90 @@ -174,13 +174,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 @@ -1450,9 +1451,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 diff --git a/base/modules/serial/psb_d_vect_mod.F90 b/base/modules/serial/psb_d_vect_mod.F90 index a192c1610..408831fc9 100644 --- a/base/modules/serial/psb_d_vect_mod.F90 +++ b/base/modules/serial/psb_d_vect_mod.F90 @@ -113,10 +113,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, & @@ -933,7 +933,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 @@ -963,7 +963,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 diff --git a/base/modules/serial/psb_s_base_vect_mod.F90 b/base/modules/serial/psb_s_base_vect_mod.F90 index 571257042..6aafb2f45 100644 --- a/base/modules/serial/psb_s_base_vect_mod.F90 +++ b/base/modules/serial/psb_s_base_vect_mod.F90 @@ -174,13 +174,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 @@ -1450,9 +1451,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 diff --git a/base/modules/serial/psb_s_vect_mod.F90 b/base/modules/serial/psb_s_vect_mod.F90 index ef2c36e31..de63f28e8 100644 --- a/base/modules/serial/psb_s_vect_mod.F90 +++ b/base/modules/serial/psb_s_vect_mod.F90 @@ -113,10 +113,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, & @@ -933,7 +933,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 @@ -963,7 +963,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 diff --git a/base/modules/serial/psb_z_base_vect_mod.F90 b/base/modules/serial/psb_z_base_vect_mod.F90 index 583b9b4f5..f83516f65 100644 --- a/base/modules/serial/psb_z_base_vect_mod.F90 +++ b/base/modules/serial/psb_z_base_vect_mod.F90 @@ -174,13 +174,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 @@ -1443,9 +1444,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 diff --git a/base/modules/serial/psb_z_vect_mod.F90 b/base/modules/serial/psb_z_vect_mod.F90 index 5986873d0..72693d47c 100644 --- a/base/modules/serial/psb_z_vect_mod.F90 +++ b/base/modules/serial/psb_z_vect_mod.F90 @@ -113,10 +113,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, & @@ -926,7 +926,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 @@ -956,7 +956,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