mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-19 20:32:12 +00:00
psblas3:
base/modules/psb_c_base_mat_mod.f90 base/modules/psb_c_mat_mod.f90 base/modules/psb_c_vect_mod.F90 base/modules/psb_d_base_mat_mod.f90 base/modules/psb_d_mat_mod.f90 base/modules/psb_d_vect_mod.F90 base/modules/psb_i_vect_mod.F90 base/modules/psb_s_base_mat_mod.f90 base/modules/psb_s_mat_mod.f90 base/modules/psb_s_vect_mod.F90 base/modules/psb_z_base_mat_mod.f90 base/modules/psb_z_mat_mod.f90 base/modules/psb_z_vect_mod.F90 base/serial/impl/psb_c_base_mat_impl.F90 base/serial/impl/psb_c_coo_impl.f90 base/serial/impl/psb_c_csc_impl.f90 base/serial/impl/psb_c_csr_impl.f90 base/serial/impl/psb_d_base_mat_impl.F90 base/serial/impl/psb_d_coo_impl.f90 base/serial/impl/psb_d_csc_impl.f90 base/serial/impl/psb_d_csr_impl.f90 base/serial/impl/psb_s_base_mat_impl.F90 base/serial/impl/psb_s_coo_impl.f90 base/serial/impl/psb_s_csc_impl.f90 base/serial/impl/psb_s_csr_impl.f90 base/serial/impl/psb_z_base_mat_impl.F90 base/serial/impl/psb_z_coo_impl.f90 base/serial/impl/psb_z_csc_impl.f90 base/serial/impl/psb_z_csr_impl.f90 base/tools/psb_cspins.f90 base/tools/psb_dspins.f90 base/tools/psb_sspins.f90 base/tools/psb_zspins.f90 util/Makefile util/psb_i_mmio_impl.f90 util/psb_mmio_mod.F90 Cosmetic fixes to vectors. Add SYNC methods to matrices (they are no-op here, but make for safety).
This commit is contained in:
Salvatore Filippone
@@ -114,6 +114,10 @@ module psb_c_base_mat_mod
|
||||
procedure, pass(a) :: aclsum => psb_c_base_aclsum
|
||||
end type psb_c_base_sparse_mat
|
||||
|
||||
private :: c_base_mat_sync, c_base_mat_is_host, c_base_mat_is_dev, &
|
||||
& c_base_mat_is_sync, c_base_mat_set_host, c_base_mat_set_dev,&
|
||||
& c_base_mat_set_sync
|
||||
|
||||
!> \namespace psb_base_mod \class psb_c_coo_sparse_mat
|
||||
!! \extends psb_c_base_mat_mod::psb_c_base_sparse_mat
|
||||
!!
|
||||
|
||||
@@ -44,7 +44,7 @@
|
||||
! the functionalities to have the encapsulated class change its
|
||||
! type dynamically, and to extract/input an inner object.
|
||||
!
|
||||
! A sparse matric has a state corresponding to its progression
|
||||
! A sparse matrix has a state corresponding to its progression
|
||||
! through the application life.
|
||||
! In particular, computational methods can only be invoked when
|
||||
! the matrix is in the ASSEMBLED state, whereas the other states are
|
||||
@@ -147,6 +147,23 @@ module psb_c_mat_mod
|
||||
procedure, pass(a) :: transc_1mat => psb_c_transc_1mat
|
||||
procedure, pass(a) :: transc_2mat => psb_c_transc_2mat
|
||||
generic, public :: transc => transc_1mat, transc_2mat
|
||||
|
||||
!
|
||||
! Sync: centerpiece of handling of external storage.
|
||||
! Any derived class having extra storage upon sync
|
||||
! will guarantee that both fortran/host side and
|
||||
! external side contain the same data. The base
|
||||
! version is only a placeholder.
|
||||
!
|
||||
procedure, pass(a) :: sync => c_mat_sync
|
||||
procedure, pass(a) :: is_host => c_mat_is_host
|
||||
procedure, pass(a) :: is_dev => c_mat_is_dev
|
||||
procedure, pass(a) :: is_sync => c_mat_is_sync
|
||||
procedure, pass(a) :: set_host => c_mat_set_host
|
||||
procedure, pass(a) :: set_dev => c_mat_set_dev
|
||||
procedure, pass(a) :: set_sync => c_mat_set_sync
|
||||
|
||||
|
||||
! These are specific to this level of encapsulation.
|
||||
procedure, pass(a) :: mv_from_b => psb_c_mv_from
|
||||
generic, public :: mv_from => mv_from_b
|
||||
@@ -188,11 +205,17 @@ module psb_c_mat_mod
|
||||
|
||||
end type psb_cspmat_type
|
||||
|
||||
private :: psb_c_get_nrows, psb_c_get_ncols, psb_c_get_nzeros, psb_c_get_size, &
|
||||
private :: psb_c_get_nrows, psb_c_get_ncols, &
|
||||
& psb_c_get_nzeros, psb_c_get_size, &
|
||||
& psb_c_get_dupl, psb_c_is_null, psb_c_is_bld, &
|
||||
& psb_c_is_upd, psb_c_is_asb, psb_c_is_sorted, &
|
||||
& psb_c_is_by_rows, psb_c_is_by_cols, psb_c_is_upper, &
|
||||
& psb_c_is_lower, psb_c_is_triangle, psb_c_get_nz_row
|
||||
& psb_c_is_lower, psb_c_is_triangle, psb_c_get_nz_row, &
|
||||
& c_mat_sync, c_mat_is_host, c_mat_is_dev, &
|
||||
& c_mat_is_sync, c_mat_set_host, c_mat_set_dev,&
|
||||
& c_mat_set_sync
|
||||
|
||||
|
||||
|
||||
class(psb_c_base_sparse_mat), allocatable, target, &
|
||||
& save, private :: psb_c_base_mat_default
|
||||
@@ -1112,6 +1135,85 @@ contains
|
||||
end function psb_c_is_by_cols
|
||||
|
||||
|
||||
!
|
||||
subroutine c_mat_sync(a)
|
||||
implicit none
|
||||
class(psb_cspmat_type), target, intent(in) :: a
|
||||
|
||||
if (allocated(a%a)) call a%a%sync()
|
||||
|
||||
end subroutine c_mat_sync
|
||||
|
||||
!
|
||||
subroutine c_mat_set_host(a)
|
||||
implicit none
|
||||
class(psb_cspmat_type), intent(inout) :: a
|
||||
|
||||
if (allocated(a%a)) call a%a%set_host()
|
||||
|
||||
end subroutine c_mat_set_host
|
||||
|
||||
|
||||
!
|
||||
subroutine c_mat_set_dev(a)
|
||||
implicit none
|
||||
class(psb_cspmat_type), intent(inout) :: a
|
||||
|
||||
if (allocated(a%a)) call a%a%set_dev()
|
||||
|
||||
end subroutine c_mat_set_dev
|
||||
|
||||
!
|
||||
subroutine c_mat_set_sync(a)
|
||||
implicit none
|
||||
class(psb_cspmat_type), intent(inout) :: a
|
||||
|
||||
if (allocated(a%a)) call a%a%set_sync()
|
||||
|
||||
end subroutine c_mat_set_sync
|
||||
|
||||
!
|
||||
function c_mat_is_dev(a) result(res)
|
||||
implicit none
|
||||
class(psb_cspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_dev()
|
||||
else
|
||||
res = .false.
|
||||
end if
|
||||
end function c_mat_is_dev
|
||||
|
||||
!
|
||||
function c_mat_is_host(a) result(res)
|
||||
implicit none
|
||||
class(psb_cspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_host()
|
||||
else
|
||||
res = .true.
|
||||
end if
|
||||
end function c_mat_is_host
|
||||
|
||||
!
|
||||
function c_mat_is_sync(a) result(res)
|
||||
implicit none
|
||||
class(psb_cspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_sync()
|
||||
else
|
||||
res = .true.
|
||||
end if
|
||||
|
||||
end function c_mat_is_sync
|
||||
|
||||
|
||||
function psb_c_is_repeatable_updates(a) result(res)
|
||||
implicit none
|
||||
@@ -1178,4 +1280,6 @@ contains
|
||||
end function psb_c_get_nz_row
|
||||
|
||||
|
||||
|
||||
|
||||
end module psb_c_mat_mod
|
||||
|
||||
@@ -52,7 +52,6 @@ module psb_c_vect_mod
|
||||
procedure, pass(x) :: reall => c_vect_reall
|
||||
procedure, pass(x) :: zero => c_vect_zero
|
||||
procedure, pass(x) :: asb => c_vect_asb
|
||||
procedure, pass(x) :: sync => c_vect_sync
|
||||
procedure, pass(x) :: gthab => c_vect_gthab
|
||||
procedure, pass(x) :: gthzv => c_vect_gthzv
|
||||
generic, public :: gth => gthab, gthzv
|
||||
@@ -71,6 +70,15 @@ module psb_c_vect_mod
|
||||
procedure, pass(x) :: set_vect => c_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => c_vect_clone
|
||||
|
||||
procedure, pass(x) :: sync => c_vect_sync
|
||||
procedure, pass(x) :: is_host => c_vect_is_host
|
||||
procedure, pass(x) :: is_dev => c_vect_is_dev
|
||||
procedure, pass(x) :: is_sync => c_vect_is_sync
|
||||
procedure, pass(x) :: set_host => c_vect_set_host
|
||||
procedure, pass(x) :: set_dev => c_vect_set_dev
|
||||
procedure, pass(x) :: set_sync => c_vect_set_sync
|
||||
|
||||
procedure, pass(x) :: dot_v => c_vect_dot_v
|
||||
procedure, pass(x) :: dot_a => c_vect_dot_a
|
||||
generic, public :: dot => dot_v, dot_a
|
||||
@@ -91,7 +99,7 @@ module psb_c_vect_mod
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => c_vect_nrm2
|
||||
procedure, pass(x) :: amax => c_vect_amax
|
||||
procedure, pass(x) :: asum => c_vect_asum
|
||||
procedure, pass(x) :: asum => c_vect_asum
|
||||
end type psb_c_vect_type
|
||||
|
||||
public :: psb_c_vect
|
||||
@@ -99,7 +107,23 @@ module psb_c_vect_mod
|
||||
interface psb_c_vect
|
||||
module procedure constructor, size_const
|
||||
end interface psb_c_vect
|
||||
|
||||
|
||||
private :: c_vect_get_nrows, c_vect_sizeof, c_vect_get_fmt, &
|
||||
& c_vect_all, c_vect_reall, c_vect_zero, c_vect_asb, &
|
||||
& c_vect_gthab, c_vect_gthzv, c_vect_sctb, &
|
||||
& c_vect_free, c_vect_ins_a, c_vect_ins_v, c_vect_bld_x, &
|
||||
& c_vect_bld_n, c_vect_get_vect, c_vect_cnv, c_vect_set_scal, &
|
||||
& c_vect_set_vect, c_vect_clone, c_vect_sync, c_vect_is_host, &
|
||||
& c_vect_is_dev, c_vect_is_sync, c_vect_set_host, &
|
||||
& c_vect_set_dev, c_vect_set_sync
|
||||
|
||||
private :: c_vect_dot_v, c_vect_dot_a, c_vect_axpby_v, c_vect_axpby_a, &
|
||||
& c_vect_mlt_v, c_vect_mlt_a, c_vect_mlt_a_2, c_vect_mlt_v_2, &
|
||||
& c_vect_mlt_va, c_vect_mlt_av, c_vect_scal, c_vect_absval1, &
|
||||
& c_vect_absval2, c_vect_nrm2, c_vect_amax, c_vect_asum
|
||||
|
||||
|
||||
|
||||
class(psb_c_base_vect_type), allocatable, target,&
|
||||
& save, private :: psb_c_base_vect_default
|
||||
|
||||
@@ -361,15 +385,6 @@ contains
|
||||
|
||||
end subroutine c_vect_asb
|
||||
|
||||
subroutine c_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine c_vect_sync
|
||||
|
||||
subroutine c_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
@@ -481,6 +496,77 @@ contains
|
||||
call move_alloc(tmp,x%v)
|
||||
end if
|
||||
end subroutine c_vect_cnv
|
||||
|
||||
|
||||
subroutine c_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine c_vect_sync
|
||||
|
||||
subroutine c_vect_set_sync(x)
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%set_sync()
|
||||
|
||||
end subroutine c_vect_set_sync
|
||||
|
||||
subroutine c_vect_set_host(x)
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%set_host()
|
||||
|
||||
end subroutine c_vect_set_host
|
||||
|
||||
subroutine c_vect_set_dev(x)
|
||||
implicit none
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%set_dev()
|
||||
|
||||
end subroutine c_vect_set_dev
|
||||
|
||||
function c_vect_is_sync(x) result(res)
|
||||
implicit none
|
||||
logical :: res
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
|
||||
res = .true.
|
||||
if (allocated(x%v)) &
|
||||
& res = x%v%is_sync()
|
||||
|
||||
end function c_vect_is_sync
|
||||
|
||||
function c_vect_is_host(x) result(res)
|
||||
implicit none
|
||||
logical :: res
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
|
||||
res = .true.
|
||||
if (allocated(x%v)) &
|
||||
& res = x%v%is_host()
|
||||
|
||||
end function c_vect_is_host
|
||||
|
||||
function c_vect_is_dev(x) result(res)
|
||||
implicit none
|
||||
logical :: res
|
||||
class(psb_c_vect_type), intent(inout) :: x
|
||||
|
||||
res = .false.
|
||||
if (allocated(x%v)) &
|
||||
& res = x%v%is_dev()
|
||||
|
||||
end function c_vect_is_dev
|
||||
|
||||
|
||||
function c_vect_dot_v(n,x,y) result(res)
|
||||
implicit none
|
||||
|
||||
@@ -114,6 +114,10 @@ module psb_d_base_mat_mod
|
||||
procedure, pass(a) :: aclsum => psb_d_base_aclsum
|
||||
end type psb_d_base_sparse_mat
|
||||
|
||||
private :: d_base_mat_sync, d_base_mat_is_host, d_base_mat_is_dev, &
|
||||
& d_base_mat_is_sync, d_base_mat_set_host, d_base_mat_set_dev,&
|
||||
& d_base_mat_set_sync
|
||||
|
||||
!> \namespace psb_base_mod \class psb_d_coo_sparse_mat
|
||||
!! \extends psb_d_base_mat_mod::psb_d_base_sparse_mat
|
||||
!!
|
||||
|
||||
@@ -44,7 +44,7 @@
|
||||
! the functionalities to have the encapsulated class change its
|
||||
! type dynamically, and to extract/input an inner object.
|
||||
!
|
||||
! A sparse matric has a state corresponding to its progression
|
||||
! A sparse matrix has a state corresponding to its progression
|
||||
! through the application life.
|
||||
! In particular, computational methods can only be invoked when
|
||||
! the matrix is in the ASSEMBLED state, whereas the other states are
|
||||
@@ -147,6 +147,23 @@ module psb_d_mat_mod
|
||||
procedure, pass(a) :: transc_1mat => psb_d_transc_1mat
|
||||
procedure, pass(a) :: transc_2mat => psb_d_transc_2mat
|
||||
generic, public :: transc => transc_1mat, transc_2mat
|
||||
|
||||
!
|
||||
! Sync: centerpiece of handling of external storage.
|
||||
! Any derived class having extra storage upon sync
|
||||
! will guarantee that both fortran/host side and
|
||||
! external side contain the same data. The base
|
||||
! version is only a placeholder.
|
||||
!
|
||||
procedure, pass(a) :: sync => d_mat_sync
|
||||
procedure, pass(a) :: is_host => d_mat_is_host
|
||||
procedure, pass(a) :: is_dev => d_mat_is_dev
|
||||
procedure, pass(a) :: is_sync => d_mat_is_sync
|
||||
procedure, pass(a) :: set_host => d_mat_set_host
|
||||
procedure, pass(a) :: set_dev => d_mat_set_dev
|
||||
procedure, pass(a) :: set_sync => d_mat_set_sync
|
||||
|
||||
|
||||
! These are specific to this level of encapsulation.
|
||||
procedure, pass(a) :: mv_from_b => psb_d_mv_from
|
||||
generic, public :: mv_from => mv_from_b
|
||||
@@ -188,11 +205,17 @@ module psb_d_mat_mod
|
||||
|
||||
end type psb_dspmat_type
|
||||
|
||||
private :: psb_d_get_nrows, psb_d_get_ncols, psb_d_get_nzeros, psb_d_get_size, &
|
||||
private :: psb_d_get_nrows, psb_d_get_ncols, &
|
||||
& psb_d_get_nzeros, psb_d_get_size, &
|
||||
& psb_d_get_dupl, psb_d_is_null, psb_d_is_bld, &
|
||||
& psb_d_is_upd, psb_d_is_asb, psb_d_is_sorted, &
|
||||
& psb_d_is_by_rows, psb_d_is_by_cols, psb_d_is_upper, &
|
||||
& psb_d_is_lower, psb_d_is_triangle, psb_d_get_nz_row
|
||||
& psb_d_is_lower, psb_d_is_triangle, psb_d_get_nz_row, &
|
||||
& d_mat_sync, d_mat_is_host, d_mat_is_dev, &
|
||||
& d_mat_is_sync, d_mat_set_host, d_mat_set_dev,&
|
||||
& d_mat_set_sync
|
||||
|
||||
|
||||
|
||||
class(psb_d_base_sparse_mat), allocatable, target, &
|
||||
& save, private :: psb_d_base_mat_default
|
||||
@@ -1112,6 +1135,85 @@ contains
|
||||
end function psb_d_is_by_cols
|
||||
|
||||
|
||||
!
|
||||
subroutine d_mat_sync(a)
|
||||
implicit none
|
||||
class(psb_dspmat_type), target, intent(in) :: a
|
||||
|
||||
if (allocated(a%a)) call a%a%sync()
|
||||
|
||||
end subroutine d_mat_sync
|
||||
|
||||
!
|
||||
subroutine d_mat_set_host(a)
|
||||
implicit none
|
||||
class(psb_dspmat_type), intent(inout) :: a
|
||||
|
||||
if (allocated(a%a)) call a%a%set_host()
|
||||
|
||||
end subroutine d_mat_set_host
|
||||
|
||||
|
||||
!
|
||||
subroutine d_mat_set_dev(a)
|
||||
implicit none
|
||||
class(psb_dspmat_type), intent(inout) :: a
|
||||
|
||||
if (allocated(a%a)) call a%a%set_dev()
|
||||
|
||||
end subroutine d_mat_set_dev
|
||||
|
||||
!
|
||||
subroutine d_mat_set_sync(a)
|
||||
implicit none
|
||||
class(psb_dspmat_type), intent(inout) :: a
|
||||
|
||||
if (allocated(a%a)) call a%a%set_sync()
|
||||
|
||||
end subroutine d_mat_set_sync
|
||||
|
||||
!
|
||||
function d_mat_is_dev(a) result(res)
|
||||
implicit none
|
||||
class(psb_dspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_dev()
|
||||
else
|
||||
res = .false.
|
||||
end if
|
||||
end function d_mat_is_dev
|
||||
|
||||
!
|
||||
function d_mat_is_host(a) result(res)
|
||||
implicit none
|
||||
class(psb_dspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_host()
|
||||
else
|
||||
res = .true.
|
||||
end if
|
||||
end function d_mat_is_host
|
||||
|
||||
!
|
||||
function d_mat_is_sync(a) result(res)
|
||||
implicit none
|
||||
class(psb_dspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_sync()
|
||||
else
|
||||
res = .true.
|
||||
end if
|
||||
|
||||
end function d_mat_is_sync
|
||||
|
||||
|
||||
function psb_d_is_repeatable_updates(a) result(res)
|
||||
implicit none
|
||||
@@ -1178,4 +1280,6 @@ contains
|
||||
end function psb_d_get_nz_row
|
||||
|
||||
|
||||
|
||||
|
||||
end module psb_d_mat_mod
|
||||
|
||||
@@ -52,7 +52,6 @@ module psb_d_vect_mod
|
||||
procedure, pass(x) :: reall => d_vect_reall
|
||||
procedure, pass(x) :: zero => d_vect_zero
|
||||
procedure, pass(x) :: asb => d_vect_asb
|
||||
procedure, pass(x) :: sync => d_vect_sync
|
||||
procedure, pass(x) :: gthab => d_vect_gthab
|
||||
procedure, pass(x) :: gthzv => d_vect_gthzv
|
||||
generic, public :: gth => gthab, gthzv
|
||||
@@ -71,6 +70,15 @@ module psb_d_vect_mod
|
||||
procedure, pass(x) :: set_vect => d_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => d_vect_clone
|
||||
|
||||
procedure, pass(x) :: sync => d_vect_sync
|
||||
procedure, pass(x) :: is_host => d_vect_is_host
|
||||
procedure, pass(x) :: is_dev => d_vect_is_dev
|
||||
procedure, pass(x) :: is_sync => d_vect_is_sync
|
||||
procedure, pass(x) :: set_host => d_vect_set_host
|
||||
procedure, pass(x) :: set_dev => d_vect_set_dev
|
||||
procedure, pass(x) :: set_sync => d_vect_set_sync
|
||||
|
||||
procedure, pass(x) :: dot_v => d_vect_dot_v
|
||||
procedure, pass(x) :: dot_a => d_vect_dot_a
|
||||
generic, public :: dot => dot_v, dot_a
|
||||
@@ -91,7 +99,7 @@ module psb_d_vect_mod
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => d_vect_nrm2
|
||||
procedure, pass(x) :: amax => d_vect_amax
|
||||
procedure, pass(x) :: asum => d_vect_asum
|
||||
procedure, pass(x) :: asum => d_vect_asum
|
||||
end type psb_d_vect_type
|
||||
|
||||
public :: psb_d_vect
|
||||
@@ -99,7 +107,23 @@ module psb_d_vect_mod
|
||||
interface psb_d_vect
|
||||
module procedure constructor, size_const
|
||||
end interface psb_d_vect
|
||||
|
||||
|
||||
private :: d_vect_get_nrows, d_vect_sizeof, d_vect_get_fmt, &
|
||||
& d_vect_all, d_vect_reall, d_vect_zero, d_vect_asb, &
|
||||
& d_vect_gthab, d_vect_gthzv, d_vect_sctb, &
|
||||
& d_vect_free, d_vect_ins_a, d_vect_ins_v, d_vect_bld_x, &
|
||||
& d_vect_bld_n, d_vect_get_vect, d_vect_cnv, d_vect_set_scal, &
|
||||
& d_vect_set_vect, d_vect_clone, d_vect_sync, d_vect_is_host, &
|
||||
& d_vect_is_dev, d_vect_is_sync, d_vect_set_host, &
|
||||
& d_vect_set_dev, d_vect_set_sync
|
||||
|
||||
private :: d_vect_dot_v, d_vect_dot_a, d_vect_axpby_v, d_vect_axpby_a, &
|
||||
& d_vect_mlt_v, d_vect_mlt_a, d_vect_mlt_a_2, d_vect_mlt_v_2, &
|
||||
& d_vect_mlt_va, d_vect_mlt_av, d_vect_scal, d_vect_absval1, &
|
||||
& d_vect_absval2, d_vect_nrm2, d_vect_amax, d_vect_asum
|
||||
|
||||
|
||||
|
||||
class(psb_d_base_vect_type), allocatable, target,&
|
||||
& save, private :: psb_d_base_vect_default
|
||||
|
||||
@@ -361,15 +385,6 @@ contains
|
||||
|
||||
end subroutine d_vect_asb
|
||||
|
||||
subroutine d_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine d_vect_sync
|
||||
|
||||
subroutine d_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
@@ -481,6 +496,77 @@ contains
|
||||
call move_alloc(tmp,x%v)
|
||||
end if
|
||||
end subroutine d_vect_cnv
|
||||
|
||||
|
||||
subroutine d_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine d_vect_sync
|
||||
|
||||
subroutine d_vect_set_sync(x)
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%set_sync()
|
||||
|
||||
end subroutine d_vect_set_sync
|
||||
|
||||
subroutine d_vect_set_host(x)
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%set_host()
|
||||
|
||||
end subroutine d_vect_set_host
|
||||
|
||||
subroutine d_vect_set_dev(x)
|
||||
implicit none
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%set_dev()
|
||||
|
||||
end subroutine d_vect_set_dev
|
||||
|
||||
function d_vect_is_sync(x) result(res)
|
||||
implicit none
|
||||
logical :: res
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
|
||||
res = .true.
|
||||
if (allocated(x%v)) &
|
||||
& res = x%v%is_sync()
|
||||
|
||||
end function d_vect_is_sync
|
||||
|
||||
function d_vect_is_host(x) result(res)
|
||||
implicit none
|
||||
logical :: res
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
|
||||
res = .true.
|
||||
if (allocated(x%v)) &
|
||||
& res = x%v%is_host()
|
||||
|
||||
end function d_vect_is_host
|
||||
|
||||
function d_vect_is_dev(x) result(res)
|
||||
implicit none
|
||||
logical :: res
|
||||
class(psb_d_vect_type), intent(inout) :: x
|
||||
|
||||
res = .false.
|
||||
if (allocated(x%v)) &
|
||||
& res = x%v%is_dev()
|
||||
|
||||
end function d_vect_is_dev
|
||||
|
||||
|
||||
function d_vect_dot_v(n,x,y) result(res)
|
||||
implicit none
|
||||
|
||||
@@ -51,7 +51,6 @@ module psb_i_vect_mod
|
||||
procedure, pass(x) :: reall => i_vect_reall
|
||||
procedure, pass(x) :: zero => i_vect_zero
|
||||
procedure, pass(x) :: asb => i_vect_asb
|
||||
procedure, pass(x) :: sync => i_vect_sync
|
||||
procedure, pass(x) :: gthab => i_vect_gthab
|
||||
procedure, pass(x) :: gthzv => i_vect_gthzv
|
||||
generic, public :: gth => gthab, gthzv
|
||||
@@ -70,6 +69,15 @@ module psb_i_vect_mod
|
||||
procedure, pass(x) :: set_vect => i_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => i_vect_clone
|
||||
|
||||
procedure, pass(x) :: sync => i_vect_sync
|
||||
procedure, pass(x) :: is_host => i_vect_is_host
|
||||
procedure, pass(x) :: is_dev => i_vect_is_dev
|
||||
procedure, pass(x) :: is_sync => i_vect_is_sync
|
||||
procedure, pass(x) :: set_host => i_vect_set_host
|
||||
procedure, pass(x) :: set_dev => i_vect_set_dev
|
||||
procedure, pass(x) :: set_sync => i_vect_set_sync
|
||||
|
||||
end type psb_i_vect_type
|
||||
|
||||
public :: psb_i_vect
|
||||
@@ -77,7 +85,18 @@ module psb_i_vect_mod
|
||||
interface psb_i_vect
|
||||
module procedure constructor, size_const
|
||||
end interface psb_i_vect
|
||||
|
||||
|
||||
private :: i_vect_get_nrows, i_vect_sizeof, i_vect_get_fmt, &
|
||||
& i_vect_all, i_vect_reall, i_vect_zero, i_vect_asb, &
|
||||
& i_vect_gthab, i_vect_gthzv, i_vect_sctb, &
|
||||
& i_vect_free, i_vect_ins_a, i_vect_ins_v, i_vect_bld_x, &
|
||||
& i_vect_bld_n, i_vect_get_vect, i_vect_cnv, i_vect_set_scal, &
|
||||
& i_vect_set_vect, i_vect_clone, i_vect_sync, i_vect_is_host, &
|
||||
& i_vect_is_dev, i_vect_is_sync, i_vect_set_host, &
|
||||
& i_vect_set_dev, i_vect_set_sync
|
||||
|
||||
|
||||
|
||||
class(psb_i_base_vect_type), allocatable, target,&
|
||||
& save, private :: psb_i_base_vect_default
|
||||
|
||||
@@ -339,15 +358,6 @@ contains
|
||||
|
||||
end subroutine i_vect_asb
|
||||
|
||||
subroutine i_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine i_vect_sync
|
||||
|
||||
subroutine i_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
@@ -460,6 +470,77 @@ contains
|
||||
end if
|
||||
end subroutine i_vect_cnv
|
||||
|
||||
|
||||
subroutine i_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine i_vect_sync
|
||||
|
||||
subroutine i_vect_set_sync(x)
|
||||
implicit none
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%set_sync()
|
||||
|
||||
end subroutine i_vect_set_sync
|
||||
|
||||
subroutine i_vect_set_host(x)
|
||||
implicit none
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%set_host()
|
||||
|
||||
end subroutine i_vect_set_host
|
||||
|
||||
subroutine i_vect_set_dev(x)
|
||||
implicit none
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%set_dev()
|
||||
|
||||
end subroutine i_vect_set_dev
|
||||
|
||||
function i_vect_is_sync(x) result(res)
|
||||
implicit none
|
||||
logical :: res
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
|
||||
res = .true.
|
||||
if (allocated(x%v)) &
|
||||
& res = x%v%is_sync()
|
||||
|
||||
end function i_vect_is_sync
|
||||
|
||||
function i_vect_is_host(x) result(res)
|
||||
implicit none
|
||||
logical :: res
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
|
||||
res = .true.
|
||||
if (allocated(x%v)) &
|
||||
& res = x%v%is_host()
|
||||
|
||||
end function i_vect_is_host
|
||||
|
||||
function i_vect_is_dev(x) result(res)
|
||||
implicit none
|
||||
logical :: res
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
|
||||
res = .false.
|
||||
if (allocated(x%v)) &
|
||||
& res = x%v%is_dev()
|
||||
|
||||
end function i_vect_is_dev
|
||||
|
||||
|
||||
end module psb_i_vect_mod
|
||||
|
||||
|
||||
|
||||
@@ -114,6 +114,10 @@ module psb_s_base_mat_mod
|
||||
procedure, pass(a) :: aclsum => psb_s_base_aclsum
|
||||
end type psb_s_base_sparse_mat
|
||||
|
||||
private :: s_base_mat_sync, s_base_mat_is_host, s_base_mat_is_dev, &
|
||||
& s_base_mat_is_sync, s_base_mat_set_host, s_base_mat_set_dev,&
|
||||
& s_base_mat_set_sync
|
||||
|
||||
!> \namespace psb_base_mod \class psb_s_coo_sparse_mat
|
||||
!! \extends psb_s_base_mat_mod::psb_s_base_sparse_mat
|
||||
!!
|
||||
|
||||
@@ -44,7 +44,7 @@
|
||||
! the functionalities to have the encapsulated class change its
|
||||
! type dynamically, and to extract/input an inner object.
|
||||
!
|
||||
! A sparse matric has a state corresponding to its progression
|
||||
! A sparse matrix has a state corresponding to its progression
|
||||
! through the application life.
|
||||
! In particular, computational methods can only be invoked when
|
||||
! the matrix is in the ASSEMBLED state, whereas the other states are
|
||||
@@ -147,6 +147,23 @@ module psb_s_mat_mod
|
||||
procedure, pass(a) :: transc_1mat => psb_s_transc_1mat
|
||||
procedure, pass(a) :: transc_2mat => psb_s_transc_2mat
|
||||
generic, public :: transc => transc_1mat, transc_2mat
|
||||
|
||||
!
|
||||
! Sync: centerpiece of handling of external storage.
|
||||
! Any derived class having extra storage upon sync
|
||||
! will guarantee that both fortran/host side and
|
||||
! external side contain the same data. The base
|
||||
! version is only a placeholder.
|
||||
!
|
||||
procedure, pass(a) :: sync => s_mat_sync
|
||||
procedure, pass(a) :: is_host => s_mat_is_host
|
||||
procedure, pass(a) :: is_dev => s_mat_is_dev
|
||||
procedure, pass(a) :: is_sync => s_mat_is_sync
|
||||
procedure, pass(a) :: set_host => s_mat_set_host
|
||||
procedure, pass(a) :: set_dev => s_mat_set_dev
|
||||
procedure, pass(a) :: set_sync => s_mat_set_sync
|
||||
|
||||
|
||||
! These are specific to this level of encapsulation.
|
||||
procedure, pass(a) :: mv_from_b => psb_s_mv_from
|
||||
generic, public :: mv_from => mv_from_b
|
||||
@@ -188,11 +205,17 @@ module psb_s_mat_mod
|
||||
|
||||
end type psb_sspmat_type
|
||||
|
||||
private :: psb_s_get_nrows, psb_s_get_ncols, psb_s_get_nzeros, psb_s_get_size, &
|
||||
private :: psb_s_get_nrows, psb_s_get_ncols, &
|
||||
& psb_s_get_nzeros, psb_s_get_size, &
|
||||
& psb_s_get_dupl, psb_s_is_null, psb_s_is_bld, &
|
||||
& psb_s_is_upd, psb_s_is_asb, psb_s_is_sorted, &
|
||||
& psb_s_is_by_rows, psb_s_is_by_cols, psb_s_is_upper, &
|
||||
& psb_s_is_lower, psb_s_is_triangle, psb_s_get_nz_row
|
||||
& psb_s_is_lower, psb_s_is_triangle, psb_s_get_nz_row, &
|
||||
& s_mat_sync, s_mat_is_host, s_mat_is_dev, &
|
||||
& s_mat_is_sync, s_mat_set_host, s_mat_set_dev,&
|
||||
& s_mat_set_sync
|
||||
|
||||
|
||||
|
||||
class(psb_s_base_sparse_mat), allocatable, target, &
|
||||
& save, private :: psb_s_base_mat_default
|
||||
@@ -1112,6 +1135,85 @@ contains
|
||||
end function psb_s_is_by_cols
|
||||
|
||||
|
||||
!
|
||||
subroutine s_mat_sync(a)
|
||||
implicit none
|
||||
class(psb_sspmat_type), target, intent(in) :: a
|
||||
|
||||
if (allocated(a%a)) call a%a%sync()
|
||||
|
||||
end subroutine s_mat_sync
|
||||
|
||||
!
|
||||
subroutine s_mat_set_host(a)
|
||||
implicit none
|
||||
class(psb_sspmat_type), intent(inout) :: a
|
||||
|
||||
if (allocated(a%a)) call a%a%set_host()
|
||||
|
||||
end subroutine s_mat_set_host
|
||||
|
||||
|
||||
!
|
||||
subroutine s_mat_set_dev(a)
|
||||
implicit none
|
||||
class(psb_sspmat_type), intent(inout) :: a
|
||||
|
||||
if (allocated(a%a)) call a%a%set_dev()
|
||||
|
||||
end subroutine s_mat_set_dev
|
||||
|
||||
!
|
||||
subroutine s_mat_set_sync(a)
|
||||
implicit none
|
||||
class(psb_sspmat_type), intent(inout) :: a
|
||||
|
||||
if (allocated(a%a)) call a%a%set_sync()
|
||||
|
||||
end subroutine s_mat_set_sync
|
||||
|
||||
!
|
||||
function s_mat_is_dev(a) result(res)
|
||||
implicit none
|
||||
class(psb_sspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_dev()
|
||||
else
|
||||
res = .false.
|
||||
end if
|
||||
end function s_mat_is_dev
|
||||
|
||||
!
|
||||
function s_mat_is_host(a) result(res)
|
||||
implicit none
|
||||
class(psb_sspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_host()
|
||||
else
|
||||
res = .true.
|
||||
end if
|
||||
end function s_mat_is_host
|
||||
|
||||
!
|
||||
function s_mat_is_sync(a) result(res)
|
||||
implicit none
|
||||
class(psb_sspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_sync()
|
||||
else
|
||||
res = .true.
|
||||
end if
|
||||
|
||||
end function s_mat_is_sync
|
||||
|
||||
|
||||
function psb_s_is_repeatable_updates(a) result(res)
|
||||
implicit none
|
||||
@@ -1178,4 +1280,6 @@ contains
|
||||
end function psb_s_get_nz_row
|
||||
|
||||
|
||||
|
||||
|
||||
end module psb_s_mat_mod
|
||||
|
||||
@@ -52,7 +52,6 @@ module psb_s_vect_mod
|
||||
procedure, pass(x) :: reall => s_vect_reall
|
||||
procedure, pass(x) :: zero => s_vect_zero
|
||||
procedure, pass(x) :: asb => s_vect_asb
|
||||
procedure, pass(x) :: sync => s_vect_sync
|
||||
procedure, pass(x) :: gthab => s_vect_gthab
|
||||
procedure, pass(x) :: gthzv => s_vect_gthzv
|
||||
generic, public :: gth => gthab, gthzv
|
||||
@@ -71,6 +70,15 @@ module psb_s_vect_mod
|
||||
procedure, pass(x) :: set_vect => s_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => s_vect_clone
|
||||
|
||||
procedure, pass(x) :: sync => s_vect_sync
|
||||
procedure, pass(x) :: is_host => s_vect_is_host
|
||||
procedure, pass(x) :: is_dev => s_vect_is_dev
|
||||
procedure, pass(x) :: is_sync => s_vect_is_sync
|
||||
procedure, pass(x) :: set_host => s_vect_set_host
|
||||
procedure, pass(x) :: set_dev => s_vect_set_dev
|
||||
procedure, pass(x) :: set_sync => s_vect_set_sync
|
||||
|
||||
procedure, pass(x) :: dot_v => s_vect_dot_v
|
||||
procedure, pass(x) :: dot_a => s_vect_dot_a
|
||||
generic, public :: dot => dot_v, dot_a
|
||||
@@ -91,7 +99,7 @@ module psb_s_vect_mod
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => s_vect_nrm2
|
||||
procedure, pass(x) :: amax => s_vect_amax
|
||||
procedure, pass(x) :: asum => s_vect_asum
|
||||
procedure, pass(x) :: asum => s_vect_asum
|
||||
end type psb_s_vect_type
|
||||
|
||||
public :: psb_s_vect
|
||||
@@ -99,7 +107,23 @@ module psb_s_vect_mod
|
||||
interface psb_s_vect
|
||||
module procedure constructor, size_const
|
||||
end interface psb_s_vect
|
||||
|
||||
|
||||
private :: s_vect_get_nrows, s_vect_sizeof, s_vect_get_fmt, &
|
||||
& s_vect_all, s_vect_reall, s_vect_zero, s_vect_asb, &
|
||||
& s_vect_gthab, s_vect_gthzv, s_vect_sctb, &
|
||||
& s_vect_free, s_vect_ins_a, s_vect_ins_v, s_vect_bld_x, &
|
||||
& s_vect_bld_n, s_vect_get_vect, s_vect_cnv, s_vect_set_scal, &
|
||||
& s_vect_set_vect, s_vect_clone, s_vect_sync, s_vect_is_host, &
|
||||
& s_vect_is_dev, s_vect_is_sync, s_vect_set_host, &
|
||||
& s_vect_set_dev, s_vect_set_sync
|
||||
|
||||
private :: s_vect_dot_v, s_vect_dot_a, s_vect_axpby_v, s_vect_axpby_a, &
|
||||
& s_vect_mlt_v, s_vect_mlt_a, s_vect_mlt_a_2, s_vect_mlt_v_2, &
|
||||
& s_vect_mlt_va, s_vect_mlt_av, s_vect_scal, s_vect_absval1, &
|
||||
& s_vect_absval2, s_vect_nrm2, s_vect_amax, s_vect_asum
|
||||
|
||||
|
||||
|
||||
class(psb_s_base_vect_type), allocatable, target,&
|
||||
& save, private :: psb_s_base_vect_default
|
||||
|
||||
@@ -361,15 +385,6 @@ contains
|
||||
|
||||
end subroutine s_vect_asb
|
||||
|
||||
subroutine s_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine s_vect_sync
|
||||
|
||||
subroutine s_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
@@ -481,6 +496,77 @@ contains
|
||||
call move_alloc(tmp,x%v)
|
||||
end if
|
||||
end subroutine s_vect_cnv
|
||||
|
||||
|
||||
subroutine s_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine s_vect_sync
|
||||
|
||||
subroutine s_vect_set_sync(x)
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%set_sync()
|
||||
|
||||
end subroutine s_vect_set_sync
|
||||
|
||||
subroutine s_vect_set_host(x)
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%set_host()
|
||||
|
||||
end subroutine s_vect_set_host
|
||||
|
||||
subroutine s_vect_set_dev(x)
|
||||
implicit none
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%set_dev()
|
||||
|
||||
end subroutine s_vect_set_dev
|
||||
|
||||
function s_vect_is_sync(x) result(res)
|
||||
implicit none
|
||||
logical :: res
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
|
||||
res = .true.
|
||||
if (allocated(x%v)) &
|
||||
& res = x%v%is_sync()
|
||||
|
||||
end function s_vect_is_sync
|
||||
|
||||
function s_vect_is_host(x) result(res)
|
||||
implicit none
|
||||
logical :: res
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
|
||||
res = .true.
|
||||
if (allocated(x%v)) &
|
||||
& res = x%v%is_host()
|
||||
|
||||
end function s_vect_is_host
|
||||
|
||||
function s_vect_is_dev(x) result(res)
|
||||
implicit none
|
||||
logical :: res
|
||||
class(psb_s_vect_type), intent(inout) :: x
|
||||
|
||||
res = .false.
|
||||
if (allocated(x%v)) &
|
||||
& res = x%v%is_dev()
|
||||
|
||||
end function s_vect_is_dev
|
||||
|
||||
|
||||
function s_vect_dot_v(n,x,y) result(res)
|
||||
implicit none
|
||||
|
||||
@@ -114,6 +114,10 @@ module psb_z_base_mat_mod
|
||||
procedure, pass(a) :: aclsum => psb_z_base_aclsum
|
||||
end type psb_z_base_sparse_mat
|
||||
|
||||
private :: z_base_mat_sync, z_base_mat_is_host, z_base_mat_is_dev, &
|
||||
& z_base_mat_is_sync, z_base_mat_set_host, z_base_mat_set_dev,&
|
||||
& z_base_mat_set_sync
|
||||
|
||||
!> \namespace psb_base_mod \class psb_z_coo_sparse_mat
|
||||
!! \extends psb_z_base_mat_mod::psb_z_base_sparse_mat
|
||||
!!
|
||||
|
||||
@@ -44,7 +44,7 @@
|
||||
! the functionalities to have the encapsulated class change its
|
||||
! type dynamically, and to extract/input an inner object.
|
||||
!
|
||||
! A sparse matric has a state corresponding to its progression
|
||||
! A sparse matrix has a state corresponding to its progression
|
||||
! through the application life.
|
||||
! In particular, computational methods can only be invoked when
|
||||
! the matrix is in the ASSEMBLED state, whereas the other states are
|
||||
@@ -147,6 +147,23 @@ module psb_z_mat_mod
|
||||
procedure, pass(a) :: transc_1mat => psb_z_transc_1mat
|
||||
procedure, pass(a) :: transc_2mat => psb_z_transc_2mat
|
||||
generic, public :: transc => transc_1mat, transc_2mat
|
||||
|
||||
!
|
||||
! Sync: centerpiece of handling of external storage.
|
||||
! Any derived class having extra storage upon sync
|
||||
! will guarantee that both fortran/host side and
|
||||
! external side contain the same data. The base
|
||||
! version is only a placeholder.
|
||||
!
|
||||
procedure, pass(a) :: sync => z_mat_sync
|
||||
procedure, pass(a) :: is_host => z_mat_is_host
|
||||
procedure, pass(a) :: is_dev => z_mat_is_dev
|
||||
procedure, pass(a) :: is_sync => z_mat_is_sync
|
||||
procedure, pass(a) :: set_host => z_mat_set_host
|
||||
procedure, pass(a) :: set_dev => z_mat_set_dev
|
||||
procedure, pass(a) :: set_sync => z_mat_set_sync
|
||||
|
||||
|
||||
! These are specific to this level of encapsulation.
|
||||
procedure, pass(a) :: mv_from_b => psb_z_mv_from
|
||||
generic, public :: mv_from => mv_from_b
|
||||
@@ -188,11 +205,17 @@ module psb_z_mat_mod
|
||||
|
||||
end type psb_zspmat_type
|
||||
|
||||
private :: psb_z_get_nrows, psb_z_get_ncols, psb_z_get_nzeros, psb_z_get_size, &
|
||||
private :: psb_z_get_nrows, psb_z_get_ncols, &
|
||||
& psb_z_get_nzeros, psb_z_get_size, &
|
||||
& psb_z_get_dupl, psb_z_is_null, psb_z_is_bld, &
|
||||
& psb_z_is_upd, psb_z_is_asb, psb_z_is_sorted, &
|
||||
& psb_z_is_by_rows, psb_z_is_by_cols, psb_z_is_upper, &
|
||||
& psb_z_is_lower, psb_z_is_triangle, psb_z_get_nz_row
|
||||
& psb_z_is_lower, psb_z_is_triangle, psb_z_get_nz_row, &
|
||||
& z_mat_sync, z_mat_is_host, z_mat_is_dev, &
|
||||
& z_mat_is_sync, z_mat_set_host, z_mat_set_dev,&
|
||||
& z_mat_set_sync
|
||||
|
||||
|
||||
|
||||
class(psb_z_base_sparse_mat), allocatable, target, &
|
||||
& save, private :: psb_z_base_mat_default
|
||||
@@ -1112,6 +1135,85 @@ contains
|
||||
end function psb_z_is_by_cols
|
||||
|
||||
|
||||
!
|
||||
subroutine z_mat_sync(a)
|
||||
implicit none
|
||||
class(psb_zspmat_type), target, intent(in) :: a
|
||||
|
||||
if (allocated(a%a)) call a%a%sync()
|
||||
|
||||
end subroutine z_mat_sync
|
||||
|
||||
!
|
||||
subroutine z_mat_set_host(a)
|
||||
implicit none
|
||||
class(psb_zspmat_type), intent(inout) :: a
|
||||
|
||||
if (allocated(a%a)) call a%a%set_host()
|
||||
|
||||
end subroutine z_mat_set_host
|
||||
|
||||
|
||||
!
|
||||
subroutine z_mat_set_dev(a)
|
||||
implicit none
|
||||
class(psb_zspmat_type), intent(inout) :: a
|
||||
|
||||
if (allocated(a%a)) call a%a%set_dev()
|
||||
|
||||
end subroutine z_mat_set_dev
|
||||
|
||||
!
|
||||
subroutine z_mat_set_sync(a)
|
||||
implicit none
|
||||
class(psb_zspmat_type), intent(inout) :: a
|
||||
|
||||
if (allocated(a%a)) call a%a%set_sync()
|
||||
|
||||
end subroutine z_mat_set_sync
|
||||
|
||||
!
|
||||
function z_mat_is_dev(a) result(res)
|
||||
implicit none
|
||||
class(psb_zspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_dev()
|
||||
else
|
||||
res = .false.
|
||||
end if
|
||||
end function z_mat_is_dev
|
||||
|
||||
!
|
||||
function z_mat_is_host(a) result(res)
|
||||
implicit none
|
||||
class(psb_zspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_host()
|
||||
else
|
||||
res = .true.
|
||||
end if
|
||||
end function z_mat_is_host
|
||||
|
||||
!
|
||||
function z_mat_is_sync(a) result(res)
|
||||
implicit none
|
||||
class(psb_zspmat_type), intent(in) :: a
|
||||
logical :: res
|
||||
|
||||
|
||||
if (allocated(a%a)) then
|
||||
res = a%a%is_sync()
|
||||
else
|
||||
res = .true.
|
||||
end if
|
||||
|
||||
end function z_mat_is_sync
|
||||
|
||||
|
||||
function psb_z_is_repeatable_updates(a) result(res)
|
||||
implicit none
|
||||
@@ -1178,4 +1280,6 @@ contains
|
||||
end function psb_z_get_nz_row
|
||||
|
||||
|
||||
|
||||
|
||||
end module psb_z_mat_mod
|
||||
|
||||
@@ -52,7 +52,6 @@ module psb_z_vect_mod
|
||||
procedure, pass(x) :: reall => z_vect_reall
|
||||
procedure, pass(x) :: zero => z_vect_zero
|
||||
procedure, pass(x) :: asb => z_vect_asb
|
||||
procedure, pass(x) :: sync => z_vect_sync
|
||||
procedure, pass(x) :: gthab => z_vect_gthab
|
||||
procedure, pass(x) :: gthzv => z_vect_gthzv
|
||||
generic, public :: gth => gthab, gthzv
|
||||
@@ -71,6 +70,15 @@ module psb_z_vect_mod
|
||||
procedure, pass(x) :: set_vect => z_vect_set_vect
|
||||
generic, public :: set => set_vect, set_scal
|
||||
procedure, pass(x) :: clone => z_vect_clone
|
||||
|
||||
procedure, pass(x) :: sync => z_vect_sync
|
||||
procedure, pass(x) :: is_host => z_vect_is_host
|
||||
procedure, pass(x) :: is_dev => z_vect_is_dev
|
||||
procedure, pass(x) :: is_sync => z_vect_is_sync
|
||||
procedure, pass(x) :: set_host => z_vect_set_host
|
||||
procedure, pass(x) :: set_dev => z_vect_set_dev
|
||||
procedure, pass(x) :: set_sync => z_vect_set_sync
|
||||
|
||||
procedure, pass(x) :: dot_v => z_vect_dot_v
|
||||
procedure, pass(x) :: dot_a => z_vect_dot_a
|
||||
generic, public :: dot => dot_v, dot_a
|
||||
@@ -91,7 +99,7 @@ module psb_z_vect_mod
|
||||
generic, public :: absval => absval1, absval2
|
||||
procedure, pass(x) :: nrm2 => z_vect_nrm2
|
||||
procedure, pass(x) :: amax => z_vect_amax
|
||||
procedure, pass(x) :: asum => z_vect_asum
|
||||
procedure, pass(x) :: asum => z_vect_asum
|
||||
end type psb_z_vect_type
|
||||
|
||||
public :: psb_z_vect
|
||||
@@ -99,7 +107,23 @@ module psb_z_vect_mod
|
||||
interface psb_z_vect
|
||||
module procedure constructor, size_const
|
||||
end interface psb_z_vect
|
||||
|
||||
|
||||
private :: z_vect_get_nrows, z_vect_sizeof, z_vect_get_fmt, &
|
||||
& z_vect_all, z_vect_reall, z_vect_zero, z_vect_asb, &
|
||||
& z_vect_gthab, z_vect_gthzv, z_vect_sctb, &
|
||||
& z_vect_free, z_vect_ins_a, z_vect_ins_v, z_vect_bld_x, &
|
||||
& z_vect_bld_n, z_vect_get_vect, z_vect_cnv, z_vect_set_scal, &
|
||||
& z_vect_set_vect, z_vect_clone, z_vect_sync, z_vect_is_host, &
|
||||
& z_vect_is_dev, z_vect_is_sync, z_vect_set_host, &
|
||||
& z_vect_set_dev, z_vect_set_sync
|
||||
|
||||
private :: z_vect_dot_v, z_vect_dot_a, z_vect_axpby_v, z_vect_axpby_a, &
|
||||
& z_vect_mlt_v, z_vect_mlt_a, z_vect_mlt_a_2, z_vect_mlt_v_2, &
|
||||
& z_vect_mlt_va, z_vect_mlt_av, z_vect_scal, z_vect_absval1, &
|
||||
& z_vect_absval2, z_vect_nrm2, z_vect_amax, z_vect_asum
|
||||
|
||||
|
||||
|
||||
class(psb_z_base_vect_type), allocatable, target,&
|
||||
& save, private :: psb_z_base_vect_default
|
||||
|
||||
@@ -361,15 +385,6 @@ contains
|
||||
|
||||
end subroutine z_vect_asb
|
||||
|
||||
subroutine z_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine z_vect_sync
|
||||
|
||||
subroutine z_vect_gthab(n,idx,alpha,x,beta,y)
|
||||
use psi_serial_mod
|
||||
integer(psb_ipk_) :: n, idx(:)
|
||||
@@ -481,6 +496,77 @@ contains
|
||||
call move_alloc(tmp,x%v)
|
||||
end if
|
||||
end subroutine z_vect_cnv
|
||||
|
||||
|
||||
subroutine z_vect_sync(x)
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%sync()
|
||||
|
||||
end subroutine z_vect_sync
|
||||
|
||||
subroutine z_vect_set_sync(x)
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%set_sync()
|
||||
|
||||
end subroutine z_vect_set_sync
|
||||
|
||||
subroutine z_vect_set_host(x)
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%set_host()
|
||||
|
||||
end subroutine z_vect_set_host
|
||||
|
||||
subroutine z_vect_set_dev(x)
|
||||
implicit none
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
|
||||
if (allocated(x%v)) &
|
||||
& call x%v%set_dev()
|
||||
|
||||
end subroutine z_vect_set_dev
|
||||
|
||||
function z_vect_is_sync(x) result(res)
|
||||
implicit none
|
||||
logical :: res
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
|
||||
res = .true.
|
||||
if (allocated(x%v)) &
|
||||
& res = x%v%is_sync()
|
||||
|
||||
end function z_vect_is_sync
|
||||
|
||||
function z_vect_is_host(x) result(res)
|
||||
implicit none
|
||||
logical :: res
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
|
||||
res = .true.
|
||||
if (allocated(x%v)) &
|
||||
& res = x%v%is_host()
|
||||
|
||||
end function z_vect_is_host
|
||||
|
||||
function z_vect_is_dev(x) result(res)
|
||||
implicit none
|
||||
logical :: res
|
||||
class(psb_z_vect_type), intent(inout) :: x
|
||||
|
||||
res = .false.
|
||||
if (allocated(x%v)) &
|
||||
& res = x%v%is_dev()
|
||||
|
||||
end function z_vect_is_dev
|
||||
|
||||
|
||||
function z_vect_dot_v(n,x,y) result(res)
|
||||
implicit none
|
||||
|
||||
Reference in New Issue
Block a user