First attempt at a vs ad/and in spmat

repack-ovrlp
sfilippone 10 months ago
parent ed0da1aef5
commit b74339d2d5

@ -854,11 +854,13 @@ module psb_c_mat_mod
end interface end interface
interface interface
subroutine psb_c_merge_nd(a,n_rows,n_cols,info) subroutine psb_c_merge_nd(a,n_rows,n_cols,info,acoo)
import :: psb_ipk_, psb_lpk_, psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat import :: psb_ipk_, psb_lpk_, psb_cspmat_type, psb_spk_, &
& psb_c_base_sparse_mat, psb_c_coo_sparse_mat
class(psb_cspmat_type), intent(inout) :: a class(psb_cspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: n_rows, n_cols integer(psb_ipk_), intent(in) :: n_rows, n_cols
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_c_coo_sparse_mat), intent(out), optional :: acoo
end subroutine psb_c_merge_nd end subroutine psb_c_merge_nd
end interface end interface
@ -988,7 +990,7 @@ module psb_c_mat_mod
interface interface
subroutine psb_c_cp_to_lb(a,b) subroutine psb_c_cp_to_lb(a,b)
import :: psb_ipk_, psb_lpk_, psb_cspmat_type, psb_spk_, psb_lc_base_sparse_mat import :: psb_ipk_, psb_lpk_, psb_cspmat_type, psb_spk_, psb_lc_base_sparse_mat
class(psb_cspmat_type), intent(in) :: a class(psb_cspmat_type), intent(inout) :: a
class(psb_lc_base_sparse_mat), intent(inout) :: b class(psb_lc_base_sparse_mat), intent(inout) :: b
end subroutine psb_c_cp_to_lb end subroutine psb_c_cp_to_lb
end interface end interface
@ -2024,6 +2026,8 @@ contains
res = 0 res = 0
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%sizeof() res = a%a%sizeof()
else if (allocated(a%ad).and.allocated(a%and)) then
res = a%ad%sizeof()+a%and%sizeof()
end if end if
end function psb_c_sizeof end function psb_c_sizeof
@ -2036,6 +2040,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_fmt() res = a%a%get_fmt()
elseif (allocated(a%ad)) then
res = a%ad%get_fmt()
else else
res = 'NULL' res = 'NULL'
end if end if
@ -2050,6 +2056,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_dupl() res = a%a%get_dupl()
else if (allocated(a%ad)) then
res = a%ad%get_dupl()
else else
res = psb_invalid_ res = psb_invalid_
end if end if
@ -2062,6 +2070,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_nrows() res = a%a%get_nrows()
else if (allocated(a%ad)) then
res = a%ad%get_nrows()
else else
res = 0 res = 0
end if end if
@ -2075,7 +2085,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_ncols() res = a%a%get_ncols()
else else if (allocated(a%ad)) then
res = a%ad%get_ncols() + a%and%get_ncols()
else
res = 0 res = 0
end if end if
@ -2088,7 +2100,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_triangle() res = a%a%is_triangle()
else else if (allocated(a%ad)) then
res = a%ad%is_triangle()
else
res = .false. res = .false.
end if end if
@ -2101,6 +2115,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_symmetric() res = a%a%is_symmetric()
else if (allocated(a%ad)) then
res = a%ad%is_symmetric()
else else
res = .false. res = .false.
end if end if
@ -2114,6 +2130,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_unit() res = a%a%is_unit()
else if (allocated(a%ad)) then
res = a%ad%is_unit()
else else
res = .false. res = .false.
end if end if
@ -2127,7 +2145,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_upper() res = a%a%is_upper()
else else if (allocated(a%ad)) then
res = a%ad%is_upper()
else
res = .false. res = .false.
end if end if
@ -2140,7 +2160,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = .not. a%a%is_upper() res = .not. a%a%is_upper()
else else if (allocated(a%ad)) then
res = .not. a%ad%is_upper()
else
res = .false. res = .false.
end if end if
@ -2153,12 +2175,15 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_null() res = a%a%is_null()
else else if (allocated(a%ad)) then
res = a%ad%is_null()
else
res = .true. res = .true.
end if end if
end function psb_c_is_null end function psb_c_is_null
! Note: in the build state we should always have A%A
function psb_c_is_bld(a) result(res) function psb_c_is_bld(a) result(res)
implicit none implicit none
class(psb_cspmat_type), intent(in) :: a class(psb_cspmat_type), intent(in) :: a
@ -2179,7 +2204,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_upd() res = a%a%is_upd()
else else if (allocated(a%ad)) then
res = a%ad%is_upd()
else
res = .false. res = .false.
end if end if
@ -2192,7 +2219,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_asb() res = a%a%is_asb()
else else if (allocated(a%ad)) then
res = a%ad%is_asb()
else
res = .false. res = .false.
end if end if
@ -2205,6 +2234,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_sorted() res = a%a%is_sorted()
else if (allocated(a%ad)) then
res = a%ad%is_sorted()
else else
res = .false. res = .false.
end if end if
@ -2218,6 +2249,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_by_rows() res = a%a%is_by_rows()
else if (allocated(a%ad)) then
res = a%ad%is_by_rows()
else else
res = .false. res = .false.
end if end if
@ -2231,6 +2264,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_by_cols() res = a%a%is_by_cols()
else if (allocated(a%ad)) then
res = a%ad%is_by_cols()
else else
res = .false. res = .false.
end if end if
@ -2243,7 +2278,9 @@ contains
implicit none implicit none
class(psb_cspmat_type), target, intent(in) :: a class(psb_cspmat_type), target, intent(in) :: a
if (allocated(a%a)) call a%a%sync() if (allocated(a%a)) call a%a%sync()
if (allocated(a%ad)) call a%ad%sync()
if (allocated(a%and)) call a%and%sync()
end subroutine c_mat_sync end subroutine c_mat_sync
@ -2252,7 +2289,9 @@ contains
implicit none implicit none
class(psb_cspmat_type), intent(inout) :: a class(psb_cspmat_type), intent(inout) :: a
if (allocated(a%a)) call a%a%set_host() if (allocated(a%a)) call a%a%set_host()
if (allocated(a%ad)) call a%ad%set_host()
if (allocated(a%and)) call a%and%set_host()
end subroutine c_mat_set_host end subroutine c_mat_set_host
@ -2262,7 +2301,9 @@ contains
implicit none implicit none
class(psb_cspmat_type), intent(inout) :: a class(psb_cspmat_type), intent(inout) :: a
if (allocated(a%a)) call a%a%set_dev() if (allocated(a%a)) call a%a%set_dev()
if (allocated(a%ad)) call a%ad%set_dev()
if (allocated(a%and)) call a%and%set_dev()
end subroutine c_mat_set_dev end subroutine c_mat_set_dev
@ -2271,7 +2312,9 @@ contains
implicit none implicit none
class(psb_cspmat_type), intent(inout) :: a class(psb_cspmat_type), intent(inout) :: a
if (allocated(a%a)) call a%a%set_sync() if (allocated(a%a)) call a%a%set_sync()
if (allocated(a%ad)) call a%ad%set_sync()
if (allocated(a%and)) call a%and%set_sync()
end subroutine c_mat_set_sync end subroutine c_mat_set_sync
@ -2283,6 +2326,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_dev() res = a%a%is_dev()
else if (allocated(a%ad)) then
res = a%ad%is_dev()
else else
res = .false. res = .false.
end if end if
@ -2297,6 +2342,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_host() res = a%a%is_host()
else if (allocated(a%ad)) then
res = a%ad%is_host()
else else
res = .true. res = .true.
end if end if
@ -2311,6 +2358,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_sync() res = a%a%is_sync()
else if (allocated(a%ad)) then
res = a%ad%is_sync()
else else
res = .true. res = .true.
end if end if
@ -2343,6 +2392,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_repeatable_updates() res = a%a%is_repeatable_updates()
else if (allocated(a%ad)) then
res = a%ad%is_repeatable_updates()
else else
res = .false. res = .false.
end if end if
@ -2356,6 +2407,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
call a%a%set_repeatable_updates(val) call a%a%set_repeatable_updates(val)
else if (allocated(a%ad)) then
call a%ad%set_repeatable_updates(val)
call a%and%set_repeatable_updates(val)
end if end if
end subroutine psb_c_set_repeatable_updates end subroutine psb_c_set_repeatable_updates
@ -2369,6 +2423,8 @@ contains
res = 0 res = 0
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_nzeros() res = a%a%get_nzeros()
else if (allocated(a%ad)) then
res = a%ad%get_nzeros() + a%and%get_nzeros()
end if end if
end function psb_c_get_nzeros end function psb_c_get_nzeros
@ -2383,6 +2439,8 @@ contains
res = 0 res = 0
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_size() res = a%a%get_size()
else if (allocated(a%ad)) then
res = a%ad%get_size() + a%and%get_size()
end if end if
end function psb_c_get_size end function psb_c_get_size
@ -2396,8 +2454,12 @@ contains
res = 0 res = 0
if (allocated(a%a)) res = a%a%get_nz_row(idx) if (allocated(a%a)) then
res = res + a%a%get_nz_row(idx)
else
if (allocated(a%ad)) res = res + a%ad%get_nz_row(idx)
if (allocated(a%and)) res = res + a%and%get_nz_row(idx)
end if
end function psb_c_get_nz_row end function psb_c_get_nz_row
subroutine psb_c_clean_zeros(a,info) subroutine psb_c_clean_zeros(a,info)
@ -2406,7 +2468,9 @@ contains
class(psb_cspmat_type), intent(inout) :: a class(psb_cspmat_type), intent(inout) :: a
info = 0 info = 0
if (allocated(a%a)) call a%a%clean_zeros(info) if (allocated(a%a)) call a%a%clean_zeros(info)
if (allocated(a%ad)) call a%ad%clean_zeros(info)
if (allocated(a%and)) call a%and%clean_zeros(info)
end subroutine psb_c_clean_zeros end subroutine psb_c_clean_zeros

@ -854,11 +854,13 @@ module psb_d_mat_mod
end interface end interface
interface interface
subroutine psb_d_merge_nd(a,n_rows,n_cols,info) subroutine psb_d_merge_nd(a,n_rows,n_cols,info,acoo)
import :: psb_ipk_, psb_lpk_, psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat import :: psb_ipk_, psb_lpk_, psb_dspmat_type, psb_dpk_, &
& psb_d_base_sparse_mat, psb_d_coo_sparse_mat
class(psb_dspmat_type), intent(inout) :: a class(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: n_rows, n_cols integer(psb_ipk_), intent(in) :: n_rows, n_cols
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_d_coo_sparse_mat), intent(out), optional :: acoo
end subroutine psb_d_merge_nd end subroutine psb_d_merge_nd
end interface end interface
@ -988,7 +990,7 @@ module psb_d_mat_mod
interface interface
subroutine psb_d_cp_to_lb(a,b) subroutine psb_d_cp_to_lb(a,b)
import :: psb_ipk_, psb_lpk_, psb_dspmat_type, psb_dpk_, psb_ld_base_sparse_mat import :: psb_ipk_, psb_lpk_, psb_dspmat_type, psb_dpk_, psb_ld_base_sparse_mat
class(psb_dspmat_type), intent(in) :: a class(psb_dspmat_type), intent(inout) :: a
class(psb_ld_base_sparse_mat), intent(inout) :: b class(psb_ld_base_sparse_mat), intent(inout) :: b
end subroutine psb_d_cp_to_lb end subroutine psb_d_cp_to_lb
end interface end interface
@ -2024,6 +2026,8 @@ contains
res = 0 res = 0
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%sizeof() res = a%a%sizeof()
else if (allocated(a%ad).and.allocated(a%and)) then
res = a%ad%sizeof()+a%and%sizeof()
end if end if
end function psb_d_sizeof end function psb_d_sizeof
@ -2036,6 +2040,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_fmt() res = a%a%get_fmt()
elseif (allocated(a%ad)) then
res = a%ad%get_fmt()
else else
res = 'NULL' res = 'NULL'
end if end if
@ -2050,6 +2056,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_dupl() res = a%a%get_dupl()
else if (allocated(a%ad)) then
res = a%ad%get_dupl()
else else
res = psb_invalid_ res = psb_invalid_
end if end if
@ -2062,6 +2070,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_nrows() res = a%a%get_nrows()
else if (allocated(a%ad)) then
res = a%ad%get_nrows()
else else
res = 0 res = 0
end if end if
@ -2075,7 +2085,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_ncols() res = a%a%get_ncols()
else else if (allocated(a%ad)) then
res = a%ad%get_ncols() + a%and%get_ncols()
else
res = 0 res = 0
end if end if
@ -2088,7 +2100,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_triangle() res = a%a%is_triangle()
else else if (allocated(a%ad)) then
res = a%ad%is_triangle()
else
res = .false. res = .false.
end if end if
@ -2101,6 +2115,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_symmetric() res = a%a%is_symmetric()
else if (allocated(a%ad)) then
res = a%ad%is_symmetric()
else else
res = .false. res = .false.
end if end if
@ -2114,6 +2130,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_unit() res = a%a%is_unit()
else if (allocated(a%ad)) then
res = a%ad%is_unit()
else else
res = .false. res = .false.
end if end if
@ -2127,7 +2145,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_upper() res = a%a%is_upper()
else else if (allocated(a%ad)) then
res = a%ad%is_upper()
else
res = .false. res = .false.
end if end if
@ -2140,7 +2160,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = .not. a%a%is_upper() res = .not. a%a%is_upper()
else else if (allocated(a%ad)) then
res = .not. a%ad%is_upper()
else
res = .false. res = .false.
end if end if
@ -2153,12 +2175,15 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_null() res = a%a%is_null()
else else if (allocated(a%ad)) then
res = a%ad%is_null()
else
res = .true. res = .true.
end if end if
end function psb_d_is_null end function psb_d_is_null
! Note: in the build state we should always have A%A
function psb_d_is_bld(a) result(res) function psb_d_is_bld(a) result(res)
implicit none implicit none
class(psb_dspmat_type), intent(in) :: a class(psb_dspmat_type), intent(in) :: a
@ -2179,7 +2204,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_upd() res = a%a%is_upd()
else else if (allocated(a%ad)) then
res = a%ad%is_upd()
else
res = .false. res = .false.
end if end if
@ -2192,7 +2219,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_asb() res = a%a%is_asb()
else else if (allocated(a%ad)) then
res = a%ad%is_asb()
else
res = .false. res = .false.
end if end if
@ -2205,6 +2234,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_sorted() res = a%a%is_sorted()
else if (allocated(a%ad)) then
res = a%ad%is_sorted()
else else
res = .false. res = .false.
end if end if
@ -2218,6 +2249,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_by_rows() res = a%a%is_by_rows()
else if (allocated(a%ad)) then
res = a%ad%is_by_rows()
else else
res = .false. res = .false.
end if end if
@ -2231,6 +2264,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_by_cols() res = a%a%is_by_cols()
else if (allocated(a%ad)) then
res = a%ad%is_by_cols()
else else
res = .false. res = .false.
end if end if
@ -2243,7 +2278,9 @@ contains
implicit none implicit none
class(psb_dspmat_type), target, intent(in) :: a class(psb_dspmat_type), target, intent(in) :: a
if (allocated(a%a)) call a%a%sync() if (allocated(a%a)) call a%a%sync()
if (allocated(a%ad)) call a%ad%sync()
if (allocated(a%and)) call a%and%sync()
end subroutine d_mat_sync end subroutine d_mat_sync
@ -2252,7 +2289,9 @@ contains
implicit none implicit none
class(psb_dspmat_type), intent(inout) :: a class(psb_dspmat_type), intent(inout) :: a
if (allocated(a%a)) call a%a%set_host() if (allocated(a%a)) call a%a%set_host()
if (allocated(a%ad)) call a%ad%set_host()
if (allocated(a%and)) call a%and%set_host()
end subroutine d_mat_set_host end subroutine d_mat_set_host
@ -2262,7 +2301,9 @@ contains
implicit none implicit none
class(psb_dspmat_type), intent(inout) :: a class(psb_dspmat_type), intent(inout) :: a
if (allocated(a%a)) call a%a%set_dev() if (allocated(a%a)) call a%a%set_dev()
if (allocated(a%ad)) call a%ad%set_dev()
if (allocated(a%and)) call a%and%set_dev()
end subroutine d_mat_set_dev end subroutine d_mat_set_dev
@ -2271,7 +2312,9 @@ contains
implicit none implicit none
class(psb_dspmat_type), intent(inout) :: a class(psb_dspmat_type), intent(inout) :: a
if (allocated(a%a)) call a%a%set_sync() if (allocated(a%a)) call a%a%set_sync()
if (allocated(a%ad)) call a%ad%set_sync()
if (allocated(a%and)) call a%and%set_sync()
end subroutine d_mat_set_sync end subroutine d_mat_set_sync
@ -2283,6 +2326,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_dev() res = a%a%is_dev()
else if (allocated(a%ad)) then
res = a%ad%is_dev()
else else
res = .false. res = .false.
end if end if
@ -2297,6 +2342,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_host() res = a%a%is_host()
else if (allocated(a%ad)) then
res = a%ad%is_host()
else else
res = .true. res = .true.
end if end if
@ -2311,6 +2358,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_sync() res = a%a%is_sync()
else if (allocated(a%ad)) then
res = a%ad%is_sync()
else else
res = .true. res = .true.
end if end if
@ -2343,6 +2392,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_repeatable_updates() res = a%a%is_repeatable_updates()
else if (allocated(a%ad)) then
res = a%ad%is_repeatable_updates()
else else
res = .false. res = .false.
end if end if
@ -2356,6 +2407,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
call a%a%set_repeatable_updates(val) call a%a%set_repeatable_updates(val)
else if (allocated(a%ad)) then
call a%ad%set_repeatable_updates(val)
call a%and%set_repeatable_updates(val)
end if end if
end subroutine psb_d_set_repeatable_updates end subroutine psb_d_set_repeatable_updates
@ -2369,6 +2423,8 @@ contains
res = 0 res = 0
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_nzeros() res = a%a%get_nzeros()
else if (allocated(a%ad)) then
res = a%ad%get_nzeros() + a%and%get_nzeros()
end if end if
end function psb_d_get_nzeros end function psb_d_get_nzeros
@ -2383,6 +2439,8 @@ contains
res = 0 res = 0
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_size() res = a%a%get_size()
else if (allocated(a%ad)) then
res = a%ad%get_size() + a%and%get_size()
end if end if
end function psb_d_get_size end function psb_d_get_size
@ -2396,8 +2454,12 @@ contains
res = 0 res = 0
if (allocated(a%a)) res = a%a%get_nz_row(idx) if (allocated(a%a)) then
res = res + a%a%get_nz_row(idx)
else
if (allocated(a%ad)) res = res + a%ad%get_nz_row(idx)
if (allocated(a%and)) res = res + a%and%get_nz_row(idx)
end if
end function psb_d_get_nz_row end function psb_d_get_nz_row
subroutine psb_d_clean_zeros(a,info) subroutine psb_d_clean_zeros(a,info)
@ -2406,7 +2468,9 @@ contains
class(psb_dspmat_type), intent(inout) :: a class(psb_dspmat_type), intent(inout) :: a
info = 0 info = 0
if (allocated(a%a)) call a%a%clean_zeros(info) if (allocated(a%a)) call a%a%clean_zeros(info)
if (allocated(a%ad)) call a%ad%clean_zeros(info)
if (allocated(a%and)) call a%and%clean_zeros(info)
end subroutine psb_d_clean_zeros end subroutine psb_d_clean_zeros

@ -854,11 +854,13 @@ module psb_s_mat_mod
end interface end interface
interface interface
subroutine psb_s_merge_nd(a,n_rows,n_cols,info) subroutine psb_s_merge_nd(a,n_rows,n_cols,info,acoo)
import :: psb_ipk_, psb_lpk_, psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat import :: psb_ipk_, psb_lpk_, psb_sspmat_type, psb_spk_, &
& psb_s_base_sparse_mat, psb_s_coo_sparse_mat
class(psb_sspmat_type), intent(inout) :: a class(psb_sspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: n_rows, n_cols integer(psb_ipk_), intent(in) :: n_rows, n_cols
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_s_coo_sparse_mat), intent(out), optional :: acoo
end subroutine psb_s_merge_nd end subroutine psb_s_merge_nd
end interface end interface
@ -988,7 +990,7 @@ module psb_s_mat_mod
interface interface
subroutine psb_s_cp_to_lb(a,b) subroutine psb_s_cp_to_lb(a,b)
import :: psb_ipk_, psb_lpk_, psb_sspmat_type, psb_spk_, psb_ls_base_sparse_mat import :: psb_ipk_, psb_lpk_, psb_sspmat_type, psb_spk_, psb_ls_base_sparse_mat
class(psb_sspmat_type), intent(in) :: a class(psb_sspmat_type), intent(inout) :: a
class(psb_ls_base_sparse_mat), intent(inout) :: b class(psb_ls_base_sparse_mat), intent(inout) :: b
end subroutine psb_s_cp_to_lb end subroutine psb_s_cp_to_lb
end interface end interface
@ -2024,6 +2026,8 @@ contains
res = 0 res = 0
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%sizeof() res = a%a%sizeof()
else if (allocated(a%ad).and.allocated(a%and)) then
res = a%ad%sizeof()+a%and%sizeof()
end if end if
end function psb_s_sizeof end function psb_s_sizeof
@ -2036,6 +2040,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_fmt() res = a%a%get_fmt()
elseif (allocated(a%ad)) then
res = a%ad%get_fmt()
else else
res = 'NULL' res = 'NULL'
end if end if
@ -2050,6 +2056,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_dupl() res = a%a%get_dupl()
else if (allocated(a%ad)) then
res = a%ad%get_dupl()
else else
res = psb_invalid_ res = psb_invalid_
end if end if
@ -2062,6 +2070,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_nrows() res = a%a%get_nrows()
else if (allocated(a%ad)) then
res = a%ad%get_nrows()
else else
res = 0 res = 0
end if end if
@ -2075,7 +2085,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_ncols() res = a%a%get_ncols()
else else if (allocated(a%ad)) then
res = a%ad%get_ncols() + a%and%get_ncols()
else
res = 0 res = 0
end if end if
@ -2088,7 +2100,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_triangle() res = a%a%is_triangle()
else else if (allocated(a%ad)) then
res = a%ad%is_triangle()
else
res = .false. res = .false.
end if end if
@ -2101,6 +2115,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_symmetric() res = a%a%is_symmetric()
else if (allocated(a%ad)) then
res = a%ad%is_symmetric()
else else
res = .false. res = .false.
end if end if
@ -2114,6 +2130,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_unit() res = a%a%is_unit()
else if (allocated(a%ad)) then
res = a%ad%is_unit()
else else
res = .false. res = .false.
end if end if
@ -2127,7 +2145,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_upper() res = a%a%is_upper()
else else if (allocated(a%ad)) then
res = a%ad%is_upper()
else
res = .false. res = .false.
end if end if
@ -2140,7 +2160,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = .not. a%a%is_upper() res = .not. a%a%is_upper()
else else if (allocated(a%ad)) then
res = .not. a%ad%is_upper()
else
res = .false. res = .false.
end if end if
@ -2153,12 +2175,15 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_null() res = a%a%is_null()
else else if (allocated(a%ad)) then
res = a%ad%is_null()
else
res = .true. res = .true.
end if end if
end function psb_s_is_null end function psb_s_is_null
! Note: in the build state we should always have A%A
function psb_s_is_bld(a) result(res) function psb_s_is_bld(a) result(res)
implicit none implicit none
class(psb_sspmat_type), intent(in) :: a class(psb_sspmat_type), intent(in) :: a
@ -2179,7 +2204,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_upd() res = a%a%is_upd()
else else if (allocated(a%ad)) then
res = a%ad%is_upd()
else
res = .false. res = .false.
end if end if
@ -2192,7 +2219,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_asb() res = a%a%is_asb()
else else if (allocated(a%ad)) then
res = a%ad%is_asb()
else
res = .false. res = .false.
end if end if
@ -2205,6 +2234,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_sorted() res = a%a%is_sorted()
else if (allocated(a%ad)) then
res = a%ad%is_sorted()
else else
res = .false. res = .false.
end if end if
@ -2218,6 +2249,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_by_rows() res = a%a%is_by_rows()
else if (allocated(a%ad)) then
res = a%ad%is_by_rows()
else else
res = .false. res = .false.
end if end if
@ -2231,6 +2264,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_by_cols() res = a%a%is_by_cols()
else if (allocated(a%ad)) then
res = a%ad%is_by_cols()
else else
res = .false. res = .false.
end if end if
@ -2243,7 +2278,9 @@ contains
implicit none implicit none
class(psb_sspmat_type), target, intent(in) :: a class(psb_sspmat_type), target, intent(in) :: a
if (allocated(a%a)) call a%a%sync() if (allocated(a%a)) call a%a%sync()
if (allocated(a%ad)) call a%ad%sync()
if (allocated(a%and)) call a%and%sync()
end subroutine s_mat_sync end subroutine s_mat_sync
@ -2252,7 +2289,9 @@ contains
implicit none implicit none
class(psb_sspmat_type), intent(inout) :: a class(psb_sspmat_type), intent(inout) :: a
if (allocated(a%a)) call a%a%set_host() if (allocated(a%a)) call a%a%set_host()
if (allocated(a%ad)) call a%ad%set_host()
if (allocated(a%and)) call a%and%set_host()
end subroutine s_mat_set_host end subroutine s_mat_set_host
@ -2262,7 +2301,9 @@ contains
implicit none implicit none
class(psb_sspmat_type), intent(inout) :: a class(psb_sspmat_type), intent(inout) :: a
if (allocated(a%a)) call a%a%set_dev() if (allocated(a%a)) call a%a%set_dev()
if (allocated(a%ad)) call a%ad%set_dev()
if (allocated(a%and)) call a%and%set_dev()
end subroutine s_mat_set_dev end subroutine s_mat_set_dev
@ -2271,7 +2312,9 @@ contains
implicit none implicit none
class(psb_sspmat_type), intent(inout) :: a class(psb_sspmat_type), intent(inout) :: a
if (allocated(a%a)) call a%a%set_sync() if (allocated(a%a)) call a%a%set_sync()
if (allocated(a%ad)) call a%ad%set_sync()
if (allocated(a%and)) call a%and%set_sync()
end subroutine s_mat_set_sync end subroutine s_mat_set_sync
@ -2283,6 +2326,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_dev() res = a%a%is_dev()
else if (allocated(a%ad)) then
res = a%ad%is_dev()
else else
res = .false. res = .false.
end if end if
@ -2297,6 +2342,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_host() res = a%a%is_host()
else if (allocated(a%ad)) then
res = a%ad%is_host()
else else
res = .true. res = .true.
end if end if
@ -2311,6 +2358,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_sync() res = a%a%is_sync()
else if (allocated(a%ad)) then
res = a%ad%is_sync()
else else
res = .true. res = .true.
end if end if
@ -2343,6 +2392,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_repeatable_updates() res = a%a%is_repeatable_updates()
else if (allocated(a%ad)) then
res = a%ad%is_repeatable_updates()
else else
res = .false. res = .false.
end if end if
@ -2356,6 +2407,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
call a%a%set_repeatable_updates(val) call a%a%set_repeatable_updates(val)
else if (allocated(a%ad)) then
call a%ad%set_repeatable_updates(val)
call a%and%set_repeatable_updates(val)
end if end if
end subroutine psb_s_set_repeatable_updates end subroutine psb_s_set_repeatable_updates
@ -2369,6 +2423,8 @@ contains
res = 0 res = 0
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_nzeros() res = a%a%get_nzeros()
else if (allocated(a%ad)) then
res = a%ad%get_nzeros() + a%and%get_nzeros()
end if end if
end function psb_s_get_nzeros end function psb_s_get_nzeros
@ -2383,6 +2439,8 @@ contains
res = 0 res = 0
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_size() res = a%a%get_size()
else if (allocated(a%ad)) then
res = a%ad%get_size() + a%and%get_size()
end if end if
end function psb_s_get_size end function psb_s_get_size
@ -2396,8 +2454,12 @@ contains
res = 0 res = 0
if (allocated(a%a)) res = a%a%get_nz_row(idx) if (allocated(a%a)) then
res = res + a%a%get_nz_row(idx)
else
if (allocated(a%ad)) res = res + a%ad%get_nz_row(idx)
if (allocated(a%and)) res = res + a%and%get_nz_row(idx)
end if
end function psb_s_get_nz_row end function psb_s_get_nz_row
subroutine psb_s_clean_zeros(a,info) subroutine psb_s_clean_zeros(a,info)
@ -2406,7 +2468,9 @@ contains
class(psb_sspmat_type), intent(inout) :: a class(psb_sspmat_type), intent(inout) :: a
info = 0 info = 0
if (allocated(a%a)) call a%a%clean_zeros(info) if (allocated(a%a)) call a%a%clean_zeros(info)
if (allocated(a%ad)) call a%ad%clean_zeros(info)
if (allocated(a%and)) call a%and%clean_zeros(info)
end subroutine psb_s_clean_zeros end subroutine psb_s_clean_zeros

@ -854,11 +854,13 @@ module psb_z_mat_mod
end interface end interface
interface interface
subroutine psb_z_merge_nd(a,n_rows,n_cols,info) subroutine psb_z_merge_nd(a,n_rows,n_cols,info,acoo)
import :: psb_ipk_, psb_lpk_, psb_zspmat_type, psb_dpk_, psb_z_base_sparse_mat import :: psb_ipk_, psb_lpk_, psb_zspmat_type, psb_dpk_, &
& psb_z_base_sparse_mat, psb_z_coo_sparse_mat
class(psb_zspmat_type), intent(inout) :: a class(psb_zspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: n_rows, n_cols integer(psb_ipk_), intent(in) :: n_rows, n_cols
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
class(psb_z_coo_sparse_mat), intent(out), optional :: acoo
end subroutine psb_z_merge_nd end subroutine psb_z_merge_nd
end interface end interface
@ -988,7 +990,7 @@ module psb_z_mat_mod
interface interface
subroutine psb_z_cp_to_lb(a,b) subroutine psb_z_cp_to_lb(a,b)
import :: psb_ipk_, psb_lpk_, psb_zspmat_type, psb_dpk_, psb_lz_base_sparse_mat import :: psb_ipk_, psb_lpk_, psb_zspmat_type, psb_dpk_, psb_lz_base_sparse_mat
class(psb_zspmat_type), intent(in) :: a class(psb_zspmat_type), intent(inout) :: a
class(psb_lz_base_sparse_mat), intent(inout) :: b class(psb_lz_base_sparse_mat), intent(inout) :: b
end subroutine psb_z_cp_to_lb end subroutine psb_z_cp_to_lb
end interface end interface
@ -2024,6 +2026,8 @@ contains
res = 0 res = 0
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%sizeof() res = a%a%sizeof()
else if (allocated(a%ad).and.allocated(a%and)) then
res = a%ad%sizeof()+a%and%sizeof()
end if end if
end function psb_z_sizeof end function psb_z_sizeof
@ -2036,6 +2040,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_fmt() res = a%a%get_fmt()
elseif (allocated(a%ad)) then
res = a%ad%get_fmt()
else else
res = 'NULL' res = 'NULL'
end if end if
@ -2050,6 +2056,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_dupl() res = a%a%get_dupl()
else if (allocated(a%ad)) then
res = a%ad%get_dupl()
else else
res = psb_invalid_ res = psb_invalid_
end if end if
@ -2062,6 +2070,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_nrows() res = a%a%get_nrows()
else if (allocated(a%ad)) then
res = a%ad%get_nrows()
else else
res = 0 res = 0
end if end if
@ -2075,7 +2085,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_ncols() res = a%a%get_ncols()
else else if (allocated(a%ad)) then
res = a%ad%get_ncols() + a%and%get_ncols()
else
res = 0 res = 0
end if end if
@ -2088,7 +2100,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_triangle() res = a%a%is_triangle()
else else if (allocated(a%ad)) then
res = a%ad%is_triangle()
else
res = .false. res = .false.
end if end if
@ -2101,6 +2115,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_symmetric() res = a%a%is_symmetric()
else if (allocated(a%ad)) then
res = a%ad%is_symmetric()
else else
res = .false. res = .false.
end if end if
@ -2114,6 +2130,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_unit() res = a%a%is_unit()
else if (allocated(a%ad)) then
res = a%ad%is_unit()
else else
res = .false. res = .false.
end if end if
@ -2127,7 +2145,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_upper() res = a%a%is_upper()
else else if (allocated(a%ad)) then
res = a%ad%is_upper()
else
res = .false. res = .false.
end if end if
@ -2140,7 +2160,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = .not. a%a%is_upper() res = .not. a%a%is_upper()
else else if (allocated(a%ad)) then
res = .not. a%ad%is_upper()
else
res = .false. res = .false.
end if end if
@ -2153,12 +2175,15 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_null() res = a%a%is_null()
else else if (allocated(a%ad)) then
res = a%ad%is_null()
else
res = .true. res = .true.
end if end if
end function psb_z_is_null end function psb_z_is_null
! Note: in the build state we should always have A%A
function psb_z_is_bld(a) result(res) function psb_z_is_bld(a) result(res)
implicit none implicit none
class(psb_zspmat_type), intent(in) :: a class(psb_zspmat_type), intent(in) :: a
@ -2179,7 +2204,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_upd() res = a%a%is_upd()
else else if (allocated(a%ad)) then
res = a%ad%is_upd()
else
res = .false. res = .false.
end if end if
@ -2192,7 +2219,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_asb() res = a%a%is_asb()
else else if (allocated(a%ad)) then
res = a%ad%is_asb()
else
res = .false. res = .false.
end if end if
@ -2205,6 +2234,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_sorted() res = a%a%is_sorted()
else if (allocated(a%ad)) then
res = a%ad%is_sorted()
else else
res = .false. res = .false.
end if end if
@ -2218,6 +2249,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_by_rows() res = a%a%is_by_rows()
else if (allocated(a%ad)) then
res = a%ad%is_by_rows()
else else
res = .false. res = .false.
end if end if
@ -2231,6 +2264,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_by_cols() res = a%a%is_by_cols()
else if (allocated(a%ad)) then
res = a%ad%is_by_cols()
else else
res = .false. res = .false.
end if end if
@ -2243,7 +2278,9 @@ contains
implicit none implicit none
class(psb_zspmat_type), target, intent(in) :: a class(psb_zspmat_type), target, intent(in) :: a
if (allocated(a%a)) call a%a%sync() if (allocated(a%a)) call a%a%sync()
if (allocated(a%ad)) call a%ad%sync()
if (allocated(a%and)) call a%and%sync()
end subroutine z_mat_sync end subroutine z_mat_sync
@ -2252,7 +2289,9 @@ contains
implicit none implicit none
class(psb_zspmat_type), intent(inout) :: a class(psb_zspmat_type), intent(inout) :: a
if (allocated(a%a)) call a%a%set_host() if (allocated(a%a)) call a%a%set_host()
if (allocated(a%ad)) call a%ad%set_host()
if (allocated(a%and)) call a%and%set_host()
end subroutine z_mat_set_host end subroutine z_mat_set_host
@ -2262,7 +2301,9 @@ contains
implicit none implicit none
class(psb_zspmat_type), intent(inout) :: a class(psb_zspmat_type), intent(inout) :: a
if (allocated(a%a)) call a%a%set_dev() if (allocated(a%a)) call a%a%set_dev()
if (allocated(a%ad)) call a%ad%set_dev()
if (allocated(a%and)) call a%and%set_dev()
end subroutine z_mat_set_dev end subroutine z_mat_set_dev
@ -2271,7 +2312,9 @@ contains
implicit none implicit none
class(psb_zspmat_type), intent(inout) :: a class(psb_zspmat_type), intent(inout) :: a
if (allocated(a%a)) call a%a%set_sync() if (allocated(a%a)) call a%a%set_sync()
if (allocated(a%ad)) call a%ad%set_sync()
if (allocated(a%and)) call a%and%set_sync()
end subroutine z_mat_set_sync end subroutine z_mat_set_sync
@ -2283,6 +2326,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_dev() res = a%a%is_dev()
else if (allocated(a%ad)) then
res = a%ad%is_dev()
else else
res = .false. res = .false.
end if end if
@ -2297,6 +2342,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_host() res = a%a%is_host()
else if (allocated(a%ad)) then
res = a%ad%is_host()
else else
res = .true. res = .true.
end if end if
@ -2311,6 +2358,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_sync() res = a%a%is_sync()
else if (allocated(a%ad)) then
res = a%ad%is_sync()
else else
res = .true. res = .true.
end if end if
@ -2343,6 +2392,8 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%is_repeatable_updates() res = a%a%is_repeatable_updates()
else if (allocated(a%ad)) then
res = a%ad%is_repeatable_updates()
else else
res = .false. res = .false.
end if end if
@ -2356,6 +2407,9 @@ contains
if (allocated(a%a)) then if (allocated(a%a)) then
call a%a%set_repeatable_updates(val) call a%a%set_repeatable_updates(val)
else if (allocated(a%ad)) then
call a%ad%set_repeatable_updates(val)
call a%and%set_repeatable_updates(val)
end if end if
end subroutine psb_z_set_repeatable_updates end subroutine psb_z_set_repeatable_updates
@ -2369,6 +2423,8 @@ contains
res = 0 res = 0
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_nzeros() res = a%a%get_nzeros()
else if (allocated(a%ad)) then
res = a%ad%get_nzeros() + a%and%get_nzeros()
end if end if
end function psb_z_get_nzeros end function psb_z_get_nzeros
@ -2383,6 +2439,8 @@ contains
res = 0 res = 0
if (allocated(a%a)) then if (allocated(a%a)) then
res = a%a%get_size() res = a%a%get_size()
else if (allocated(a%ad)) then
res = a%ad%get_size() + a%and%get_size()
end if end if
end function psb_z_get_size end function psb_z_get_size
@ -2396,8 +2454,12 @@ contains
res = 0 res = 0
if (allocated(a%a)) res = a%a%get_nz_row(idx) if (allocated(a%a)) then
res = res + a%a%get_nz_row(idx)
else
if (allocated(a%ad)) res = res + a%ad%get_nz_row(idx)
if (allocated(a%and)) res = res + a%and%get_nz_row(idx)
end if
end function psb_z_get_nz_row end function psb_z_get_nz_row
subroutine psb_z_clean_zeros(a,info) subroutine psb_z_clean_zeros(a,info)
@ -2406,7 +2468,9 @@ contains
class(psb_zspmat_type), intent(inout) :: a class(psb_zspmat_type), intent(inout) :: a
info = 0 info = 0
if (allocated(a%a)) call a%a%clean_zeros(info) if (allocated(a%a)) call a%a%clean_zeros(info)
if (allocated(a%ad)) call a%ad%clean_zeros(info)
if (allocated(a%and)) call a%and%clean_zeros(info)
end subroutine psb_z_clean_zeros end subroutine psb_z_clean_zeros

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff
Loading…
Cancel
Save