mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-20 21:02:26 +00:00
Fix vector MLT and DIV
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
Reference in New Issue
Block a user