diff --git a/base/modules/serial/psb_c_mat_mod.F90 b/base/modules/serial/psb_c_mat_mod.F90 index ee819535..e7c84b00 100644 --- a/base/modules/serial/psb_c_mat_mod.F90 +++ b/base/modules/serial/psb_c_mat_mod.F90 @@ -205,6 +205,7 @@ module psb_c_mat_mod procedure, pass(a) :: cscnv_base => psb_c_cscnv_base generic, public :: cscnv => cscnv_np, cscnv_ip, cscnv_base procedure, pass(a) :: split_nd => psb_c_split_nd + procedure, pass(a) :: merge_nd => psb_c_merge_nd procedure, pass(a) :: clone => psb_cspmat_clone procedure, pass(a) :: move_alloc => psb_cspmat_type_move ! @@ -849,11 +850,17 @@ module psb_c_mat_mod class(psb_cspmat_type), intent(inout) :: a integer(psb_ipk_), intent(in) :: n_rows, n_cols integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_),optional, intent(in) :: dupl -!!$ character(len=*), optional, intent(in) :: type -!!$ class(psb_c_base_sparse_mat), intent(in), optional :: mold end subroutine psb_c_split_nd end interface + + interface + subroutine psb_c_merge_nd(a,n_rows,n_cols,info) + import :: psb_ipk_, psb_lpk_, psb_cspmat_type, psb_spk_, psb_c_base_sparse_mat + class(psb_cspmat_type), intent(inout) :: a + integer(psb_ipk_), intent(in) :: n_rows, n_cols + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_merge_nd + end interface ! ! CSCNV: switches to a different internal derived type. diff --git a/base/modules/serial/psb_d_mat_mod.F90 b/base/modules/serial/psb_d_mat_mod.F90 index 82d2e822..fe09d83a 100644 --- a/base/modules/serial/psb_d_mat_mod.F90 +++ b/base/modules/serial/psb_d_mat_mod.F90 @@ -205,6 +205,7 @@ module psb_d_mat_mod procedure, pass(a) :: cscnv_base => psb_d_cscnv_base generic, public :: cscnv => cscnv_np, cscnv_ip, cscnv_base procedure, pass(a) :: split_nd => psb_d_split_nd + procedure, pass(a) :: merge_nd => psb_d_merge_nd procedure, pass(a) :: clone => psb_dspmat_clone procedure, pass(a) :: move_alloc => psb_dspmat_type_move ! @@ -849,11 +850,17 @@ module psb_d_mat_mod class(psb_dspmat_type), intent(inout) :: a integer(psb_ipk_), intent(in) :: n_rows, n_cols integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_),optional, intent(in) :: dupl -!!$ character(len=*), optional, intent(in) :: type -!!$ class(psb_d_base_sparse_mat), intent(in), optional :: mold end subroutine psb_d_split_nd end interface + + interface + subroutine psb_d_merge_nd(a,n_rows,n_cols,info) + import :: psb_ipk_, psb_lpk_, psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat + class(psb_dspmat_type), intent(inout) :: a + integer(psb_ipk_), intent(in) :: n_rows, n_cols + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_merge_nd + end interface ! ! CSCNV: switches to a different internal derived type. diff --git a/base/modules/serial/psb_s_mat_mod.F90 b/base/modules/serial/psb_s_mat_mod.F90 index d8a2e6ae..868583b2 100644 --- a/base/modules/serial/psb_s_mat_mod.F90 +++ b/base/modules/serial/psb_s_mat_mod.F90 @@ -205,6 +205,7 @@ module psb_s_mat_mod procedure, pass(a) :: cscnv_base => psb_s_cscnv_base generic, public :: cscnv => cscnv_np, cscnv_ip, cscnv_base procedure, pass(a) :: split_nd => psb_s_split_nd + procedure, pass(a) :: merge_nd => psb_s_merge_nd procedure, pass(a) :: clone => psb_sspmat_clone procedure, pass(a) :: move_alloc => psb_sspmat_type_move ! @@ -849,11 +850,17 @@ module psb_s_mat_mod class(psb_sspmat_type), intent(inout) :: a integer(psb_ipk_), intent(in) :: n_rows, n_cols integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_),optional, intent(in) :: dupl -!!$ character(len=*), optional, intent(in) :: type -!!$ class(psb_s_base_sparse_mat), intent(in), optional :: mold end subroutine psb_s_split_nd end interface + + interface + subroutine psb_s_merge_nd(a,n_rows,n_cols,info) + import :: psb_ipk_, psb_lpk_, psb_sspmat_type, psb_spk_, psb_s_base_sparse_mat + class(psb_sspmat_type), intent(inout) :: a + integer(psb_ipk_), intent(in) :: n_rows, n_cols + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_merge_nd + end interface ! ! CSCNV: switches to a different internal derived type. diff --git a/base/modules/serial/psb_z_mat_mod.F90 b/base/modules/serial/psb_z_mat_mod.F90 index 694d4efc..48b670de 100644 --- a/base/modules/serial/psb_z_mat_mod.F90 +++ b/base/modules/serial/psb_z_mat_mod.F90 @@ -205,6 +205,7 @@ module psb_z_mat_mod procedure, pass(a) :: cscnv_base => psb_z_cscnv_base generic, public :: cscnv => cscnv_np, cscnv_ip, cscnv_base procedure, pass(a) :: split_nd => psb_z_split_nd + procedure, pass(a) :: merge_nd => psb_z_merge_nd procedure, pass(a) :: clone => psb_zspmat_clone procedure, pass(a) :: move_alloc => psb_zspmat_type_move ! @@ -849,11 +850,17 @@ module psb_z_mat_mod class(psb_zspmat_type), intent(inout) :: a integer(psb_ipk_), intent(in) :: n_rows, n_cols integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_),optional, intent(in) :: dupl -!!$ character(len=*), optional, intent(in) :: type -!!$ class(psb_z_base_sparse_mat), intent(in), optional :: mold end subroutine psb_z_split_nd end interface + + interface + subroutine psb_z_merge_nd(a,n_rows,n_cols,info) + import :: psb_ipk_, psb_lpk_, psb_zspmat_type, psb_dpk_, psb_z_base_sparse_mat + class(psb_zspmat_type), intent(inout) :: a + integer(psb_ipk_), intent(in) :: n_rows, n_cols + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_merge_nd + end interface ! ! CSCNV: switches to a different internal derived type. diff --git a/base/serial/impl/psb_c_mat_impl.F90 b/base/serial/impl/psb_c_mat_impl.F90 index bbac0406..532cb9b8 100644 --- a/base/serial/impl/psb_c_mat_impl.F90 +++ b/base/serial/impl/psb_c_mat_impl.F90 @@ -1263,6 +1263,56 @@ subroutine psb_c_split_nd(a,n_rows,n_cols,info) end subroutine psb_c_split_nd +subroutine psb_c_merge_nd(a,n_rows,n_cols,info) + use psb_error_mod + use psb_string_mod + use psb_c_mat_mod, psb_protect_name => psb_c_merge_nd + implicit none + class(psb_cspmat_type), intent(inout) :: a + integer(psb_ipk_), intent(in) :: n_rows, n_cols + integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_),optional, intent(in) :: dupl +!!$ character(len=*), optional, intent(in) :: type +!!$ class(psb_c_base_sparse_mat), intent(in), optional :: mold + type(psb_c_coo_sparse_mat) :: acoo1,acoo2 + integer(psb_ipk_) :: nz + logical, parameter :: use_ecsr=.true. + character(len=20) :: name, ch_err + integer(psb_ipk_) :: err_act + + info = psb_success_ + name = 'psb_split' + call psb_erractionsave(err_act) + + call a%ad%mv_to_coo(acoo1,info) + call acoo1%set_bld() + call acoo1%set_nrows(n_rows) + call acoo1%set_ncols(n_cols) + call a%and%mv_to_coo(acoo2,info) + nz=acoo2%get_nzeros() + call acoo1%csput(nz,acoo2%ia,acoo2%ja,acoo2%val,ione,n_rows,ione,n_cols,info) + if (allocated(a%a)) then + call a%a%free() + deallocate(a%a) + end if + allocate(a%a,mold=a%ad) + call a%a%mv_from_coo(acoo1,info) + + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='cscnv') + goto 9999 + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_c_merge_nd + subroutine psb_c_cscnv(a,b,info,type,mold,upd,dupl) use psb_error_mod use psb_string_mod diff --git a/base/serial/impl/psb_d_mat_impl.F90 b/base/serial/impl/psb_d_mat_impl.F90 index 9af64b3f..e48654ce 100644 --- a/base/serial/impl/psb_d_mat_impl.F90 +++ b/base/serial/impl/psb_d_mat_impl.F90 @@ -1263,6 +1263,56 @@ subroutine psb_d_split_nd(a,n_rows,n_cols,info) end subroutine psb_d_split_nd +subroutine psb_d_merge_nd(a,n_rows,n_cols,info) + use psb_error_mod + use psb_string_mod + use psb_d_mat_mod, psb_protect_name => psb_d_merge_nd + implicit none + class(psb_dspmat_type), intent(inout) :: a + integer(psb_ipk_), intent(in) :: n_rows, n_cols + integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_),optional, intent(in) :: dupl +!!$ character(len=*), optional, intent(in) :: type +!!$ class(psb_d_base_sparse_mat), intent(in), optional :: mold + type(psb_d_coo_sparse_mat) :: acoo1,acoo2 + integer(psb_ipk_) :: nz + logical, parameter :: use_ecsr=.true. + character(len=20) :: name, ch_err + integer(psb_ipk_) :: err_act + + info = psb_success_ + name = 'psb_split' + call psb_erractionsave(err_act) + + call a%ad%mv_to_coo(acoo1,info) + call acoo1%set_bld() + call acoo1%set_nrows(n_rows) + call acoo1%set_ncols(n_cols) + call a%and%mv_to_coo(acoo2,info) + nz=acoo2%get_nzeros() + call acoo1%csput(nz,acoo2%ia,acoo2%ja,acoo2%val,ione,n_rows,ione,n_cols,info) + if (allocated(a%a)) then + call a%a%free() + deallocate(a%a) + end if + allocate(a%a,mold=a%ad) + call a%a%mv_from_coo(acoo1,info) + + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='cscnv') + goto 9999 + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_d_merge_nd + subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl) use psb_error_mod use psb_string_mod diff --git a/base/serial/impl/psb_s_mat_impl.F90 b/base/serial/impl/psb_s_mat_impl.F90 index c0370774..77ac81e6 100644 --- a/base/serial/impl/psb_s_mat_impl.F90 +++ b/base/serial/impl/psb_s_mat_impl.F90 @@ -1263,6 +1263,56 @@ subroutine psb_s_split_nd(a,n_rows,n_cols,info) end subroutine psb_s_split_nd +subroutine psb_s_merge_nd(a,n_rows,n_cols,info) + use psb_error_mod + use psb_string_mod + use psb_s_mat_mod, psb_protect_name => psb_s_merge_nd + implicit none + class(psb_sspmat_type), intent(inout) :: a + integer(psb_ipk_), intent(in) :: n_rows, n_cols + integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_),optional, intent(in) :: dupl +!!$ character(len=*), optional, intent(in) :: type +!!$ class(psb_s_base_sparse_mat), intent(in), optional :: mold + type(psb_s_coo_sparse_mat) :: acoo1,acoo2 + integer(psb_ipk_) :: nz + logical, parameter :: use_ecsr=.true. + character(len=20) :: name, ch_err + integer(psb_ipk_) :: err_act + + info = psb_success_ + name = 'psb_split' + call psb_erractionsave(err_act) + + call a%ad%mv_to_coo(acoo1,info) + call acoo1%set_bld() + call acoo1%set_nrows(n_rows) + call acoo1%set_ncols(n_cols) + call a%and%mv_to_coo(acoo2,info) + nz=acoo2%get_nzeros() + call acoo1%csput(nz,acoo2%ia,acoo2%ja,acoo2%val,ione,n_rows,ione,n_cols,info) + if (allocated(a%a)) then + call a%a%free() + deallocate(a%a) + end if + allocate(a%a,mold=a%ad) + call a%a%mv_from_coo(acoo1,info) + + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='cscnv') + goto 9999 + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_s_merge_nd + subroutine psb_s_cscnv(a,b,info,type,mold,upd,dupl) use psb_error_mod use psb_string_mod diff --git a/base/serial/impl/psb_z_mat_impl.F90 b/base/serial/impl/psb_z_mat_impl.F90 index 20815cb0..18d6c03d 100644 --- a/base/serial/impl/psb_z_mat_impl.F90 +++ b/base/serial/impl/psb_z_mat_impl.F90 @@ -1263,6 +1263,56 @@ subroutine psb_z_split_nd(a,n_rows,n_cols,info) end subroutine psb_z_split_nd +subroutine psb_z_merge_nd(a,n_rows,n_cols,info) + use psb_error_mod + use psb_string_mod + use psb_z_mat_mod, psb_protect_name => psb_z_merge_nd + implicit none + class(psb_zspmat_type), intent(inout) :: a + integer(psb_ipk_), intent(in) :: n_rows, n_cols + integer(psb_ipk_), intent(out) :: info +!!$ integer(psb_ipk_),optional, intent(in) :: dupl +!!$ character(len=*), optional, intent(in) :: type +!!$ class(psb_z_base_sparse_mat), intent(in), optional :: mold + type(psb_z_coo_sparse_mat) :: acoo1,acoo2 + integer(psb_ipk_) :: nz + logical, parameter :: use_ecsr=.true. + character(len=20) :: name, ch_err + integer(psb_ipk_) :: err_act + + info = psb_success_ + name = 'psb_split' + call psb_erractionsave(err_act) + + call a%ad%mv_to_coo(acoo1,info) + call acoo1%set_bld() + call acoo1%set_nrows(n_rows) + call acoo1%set_ncols(n_cols) + call a%and%mv_to_coo(acoo2,info) + nz=acoo2%get_nzeros() + call acoo1%csput(nz,acoo2%ia,acoo2%ja,acoo2%val,ione,n_rows,ione,n_cols,info) + if (allocated(a%a)) then + call a%a%free() + deallocate(a%a) + end if + allocate(a%a,mold=a%ad) + call a%a%mv_from_coo(acoo1,info) + + if (psb_errstatus_fatal()) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='cscnv') + goto 9999 + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + + return + +end subroutine psb_z_merge_nd + subroutine psb_z_cscnv(a,b,info,type,mold,upd,dupl) use psb_error_mod use psb_string_mod