diff --git a/base/modules/psb_base_mat_mod.f90 b/base/modules/psb_base_mat_mod.f90 index 24802140..ab887c00 100644 --- a/base/modules/psb_base_mat_mod.f90 +++ b/base/modules/psb_base_mat_mod.f90 @@ -177,7 +177,6 @@ module psb_base_mat_mod ! == = ================================= procedure, pass(a) :: get_neigh => psb_base_get_neigh procedure, pass(a) :: free => psb_base_free - procedure, pass(a) :: copy => psb_base_copy procedure, pass(a) :: trim => psb_base_trim procedure, pass(a) :: reinit => psb_base_reinit procedure, pass(a) :: allocate_mnnz => psb_base_allocate_mnnz @@ -188,10 +187,6 @@ module psb_base_mat_mod generic, public :: csget => csgetptn procedure, pass(a) :: print => psb_base_sparse_print procedure, pass(a) :: sizeof => psb_base_sizeof -!!$ procedure, pass(a) :: psb_base_cp_from -!!$ generic, public :: cp_from => psb_base_cp_from -!!$ procedure, pass(a) :: psb_base_mv_from -!!$ generic, public :: mv_from => psb_base_mv_from procedure, pass(a) :: transp_1mat => psb_base_transp_1mat procedure, pass(a) :: transp_2mat => psb_base_transp_2mat generic, public :: transp => transp_1mat, transp_2mat @@ -653,73 +648,12 @@ contains res = a%sorted end function psb_base_is_sorted - -!!$ ! -!!$ ! MV|CP_FROM: at base level they are the same. -!!$ ! -!!$ ! -!!$ -!!$ subroutine psb_base_mv_from(a,b) -!!$ implicit none -!!$ -!!$ class(psb_base_sparse_mat), intent(out) :: a -!!$ type(psb_base_sparse_mat), intent(inout) :: b -!!$ -!!$ a%m = b%m -!!$ a%n = b%n -!!$ a%state = b%state -!!$ a%duplicate = b%duplicate -!!$ a%triangle = b%triangle -!!$ a%unitd = b%unitd -!!$ a%upper = b%upper -!!$ a%sorted = b%sorted -!!$ -!!$ end subroutine psb_base_mv_from - - subroutine psb_base_copy(a,b,info) - implicit none - - class(psb_base_sparse_mat), intent(in) :: a - class(psb_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - - info = 0 - b%m = a%m - b%n = a%n - b%state = a%state - b%duplicate = a%duplicate - b%triangle = a%triangle - b%unitd = a%unitd - b%upper = a%upper - b%sorted = a%sorted - - end subroutine psb_base_copy - -!!$ subroutine psb_base_cp_from(a,b) -!!$ implicit none -!!$ -!!$ class(psb_base_sparse_mat), intent(out) :: a -!!$ type(psb_base_sparse_mat), intent(in) :: b -!!$ -!!$ a%m = b%m -!!$ a%n = b%n -!!$ a%state = b%state -!!$ a%duplicate = b%duplicate -!!$ a%triangle = b%triangle -!!$ a%unitd = b%unitd -!!$ a%upper = b%upper -!!$ a%sorted = b%sorted -!!$ -!!$ end subroutine psb_base_cp_from -!!$ ! ! TRANSP: note sorted=.false. ! better invoke a fix() too many than ! regret it later... ! - - subroutine psb_base_transp_2mat(a,b) implicit none diff --git a/base/modules/psb_c_base_mat_mod.f90 b/base/modules/psb_c_base_mat_mod.f90 index 9924fb0c..87e20826 100644 --- a/base/modules/psb_c_base_mat_mod.f90 +++ b/base/modules/psb_c_base_mat_mod.f90 @@ -72,7 +72,6 @@ module psb_c_base_mat_mod procedure, pass(a) :: mv_to_fmt => psb_c_base_mv_to_fmt procedure, pass(a) :: mv_from_fmt => psb_c_base_mv_from_fmt procedure, pass(a) :: mold => psb_c_base_mold - procedure, pass(a) :: copy => psb_c_base_copy procedure, pass(a) :: clone => psb_c_base_clone ! @@ -158,8 +157,6 @@ module psb_c_base_mat_mod procedure, pass(a) :: print => psb_c_coo_print procedure, pass(a) :: free => c_coo_free procedure, pass(a) :: mold => psb_c_coo_mold - procedure, pass(a) :: copy => psb_c_coo_copy -!!$ procedure, pass(a) :: clone => psb_c_coo_clone ! ! This is COO specific ! @@ -411,24 +408,6 @@ module psb_c_base_mat_mod end interface ! - !> Function copy: - !! \memberof psb_c_base_sparse_mat - !! \brief Copy a class(psb_c_base_sparse_mat) - !! but only if it is the same dynamic type as the input. - !! \param b The output variable - !! \param info return code - ! - interface - subroutine psb_c_base_copy(a,b, info) - import :: psb_ipk_, psb_c_base_sparse_mat, psb_long_int_k_ - implicit none - class(psb_c_base_sparse_mat), intent(in) :: a - class(psb_c_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_c_base_copy - end interface - - ! !> Function clone: !! \memberof psb_c_base_sparse_mat @@ -1156,29 +1135,6 @@ module psb_c_base_mat_mod end subroutine psb_c_coo_mold end interface - !> \memberof psb_c_coo_sparse_mat - !| \see psb_base_mat_mod::psb_base_copy - interface - subroutine psb_c_coo_copy(a,b,info) - import :: psb_ipk_, psb_c_coo_sparse_mat, psb_c_base_sparse_mat, psb_long_int_k_ - class(psb_c_coo_sparse_mat), intent(in) :: a - class(psb_c_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_c_coo_copy - end interface - -!!$ !> \memberof psb_c_coo_sparse_mat -!!$ !| \see psb_base_mat_mod::psb_base_copy -!!$ interface -!!$ subroutine psb_c_coo_clone(a,b,info) -!!$ import :: psb_ipk_, psb_c_coo_sparse_mat, psb_c_base_sparse_mat, psb_long_int_k_ -!!$ class(psb_c_coo_sparse_mat), intent(inout) :: a -!!$ class(psb_c_base_sparse_mat), intent(inout), allocatable :: b -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psb_c_coo_clone -!!$ end interface - - ! !> Function print. diff --git a/base/modules/psb_c_csc_mat_mod.f90 b/base/modules/psb_c_csc_mat_mod.f90 index 9821a181..768a4208 100644 --- a/base/modules/psb_c_csc_mat_mod.f90 +++ b/base/modules/psb_c_csc_mat_mod.f90 @@ -97,7 +97,6 @@ module psb_c_csc_mat_mod procedure, pass(a) :: print => psb_c_csc_print procedure, pass(a) :: free => c_csc_free procedure, pass(a) :: mold => psb_c_csc_mold - procedure, pass(a) :: copy => psb_c_csc_copy end type psb_c_csc_sparse_mat @@ -144,18 +143,6 @@ module psb_c_csc_mat_mod end subroutine psb_c_csc_mold end interface - !> \memberof psb_c_csc_sparse_mat - !| \see psb_base_mat_mod::psb_base_copy - interface - subroutine psb_c_csc_copy(a,b,info) - import :: psb_ipk_, psb_c_csc_sparse_mat, psb_c_base_sparse_mat, psb_long_int_k_ - class(psb_c_csc_sparse_mat), intent(in) :: a - class(psb_c_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_c_csc_copy - end interface - - !> \memberof psb_c_csc_sparse_mat !| \see psb_base_mat_mod::psb_base_allocate_mnnz interface diff --git a/base/modules/psb_c_csr_mat_mod.f90 b/base/modules/psb_c_csr_mat_mod.f90 index 2fe1e2b0..18e39e15 100644 --- a/base/modules/psb_c_csr_mat_mod.f90 +++ b/base/modules/psb_c_csr_mat_mod.f90 @@ -98,7 +98,6 @@ module psb_c_csr_mat_mod procedure, pass(a) :: print => psb_c_csr_print procedure, pass(a) :: free => c_csr_free procedure, pass(a) :: mold => psb_c_csr_mold - procedure, pass(a) :: copy => psb_c_csr_copy end type psb_c_csr_sparse_mat @@ -146,17 +145,6 @@ module psb_c_csr_mat_mod end subroutine psb_c_csr_mold end interface - !> \memberof psb_c_csr_sparse_mat - !| \see psb_base_mat_mod::psb_base_copy - interface - subroutine psb_c_csr_copy(a,b,info) - import :: psb_ipk_, psb_c_csr_sparse_mat, psb_c_base_sparse_mat, psb_long_int_k_ - class(psb_c_csr_sparse_mat), intent(in) :: a - class(psb_c_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_c_csr_copy - end interface - !> \memberof psb_c_csr_sparse_mat !| \see psb_base_mat_mod::psb_base_allocate_mnnz interface diff --git a/base/modules/psb_c_mat_mod.f90 b/base/modules/psb_c_mat_mod.f90 index 19c0d322..aa623bef 100644 --- a/base/modules/psb_c_mat_mod.f90 +++ b/base/modules/psb_c_mat_mod.f90 @@ -154,7 +154,6 @@ module psb_c_mat_mod procedure, pass(a) :: cscnv_ip => psb_c_cscnv_ip procedure, pass(a) :: cscnv_base => psb_c_cscnv_base generic, public :: cscnv => cscnv_np, cscnv_ip, cscnv_base - procedure, pass(a) :: copy => psb_cspmat_copy procedure, pass(a) :: clone => psb_cspmat_clone ! Computational routines @@ -610,15 +609,6 @@ module psb_c_mat_mod end subroutine psb_cspmat_type_move end interface - interface - subroutine psb_cspmat_copy(a,b,info) - import :: psb_ipk_, psb_cspmat_type - class(psb_cspmat_type), intent(inout) :: a - class(psb_cspmat_type), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_cspmat_copy - end interface - interface subroutine psb_cspmat_clone(a,b,info) import :: psb_ipk_, psb_cspmat_type diff --git a/base/modules/psb_d_base_mat_mod.f90 b/base/modules/psb_d_base_mat_mod.f90 index 80ccc4e3..a54617c2 100644 --- a/base/modules/psb_d_base_mat_mod.f90 +++ b/base/modules/psb_d_base_mat_mod.f90 @@ -72,7 +72,6 @@ module psb_d_base_mat_mod procedure, pass(a) :: mv_to_fmt => psb_d_base_mv_to_fmt procedure, pass(a) :: mv_from_fmt => psb_d_base_mv_from_fmt procedure, pass(a) :: mold => psb_d_base_mold - procedure, pass(a) :: copy => psb_d_base_copy procedure, pass(a) :: clone => psb_d_base_clone ! @@ -158,8 +157,6 @@ module psb_d_base_mat_mod procedure, pass(a) :: print => psb_d_coo_print procedure, pass(a) :: free => d_coo_free procedure, pass(a) :: mold => psb_d_coo_mold - procedure, pass(a) :: copy => psb_d_coo_copy -!!$ procedure, pass(a) :: clone => psb_d_coo_clone ! ! This is COO specific ! @@ -411,24 +408,6 @@ module psb_d_base_mat_mod end interface ! - !> Function copy: - !! \memberof psb_d_base_sparse_mat - !! \brief Copy a class(psb_d_base_sparse_mat) - !! but only if it is the same dynamic type as the input. - !! \param b The output variable - !! \param info return code - ! - interface - subroutine psb_d_base_copy(a,b, info) - import :: psb_ipk_, psb_d_base_sparse_mat, psb_long_int_k_ - implicit none - class(psb_d_base_sparse_mat), intent(in) :: a - class(psb_d_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_d_base_copy - end interface - - ! !> Function clone: !! \memberof psb_d_base_sparse_mat @@ -1156,29 +1135,6 @@ module psb_d_base_mat_mod end subroutine psb_d_coo_mold end interface - !> \memberof psb_d_coo_sparse_mat - !| \see psb_base_mat_mod::psb_base_copy - interface - subroutine psb_d_coo_copy(a,b,info) - import :: psb_ipk_, psb_d_coo_sparse_mat, psb_d_base_sparse_mat, psb_long_int_k_ - class(psb_d_coo_sparse_mat), intent(in) :: a - class(psb_d_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_d_coo_copy - end interface - -!!$ !> \memberof psb_d_coo_sparse_mat -!!$ !| \see psb_base_mat_mod::psb_base_copy -!!$ interface -!!$ subroutine psb_d_coo_clone(a,b,info) -!!$ import :: psb_ipk_, psb_d_coo_sparse_mat, psb_d_base_sparse_mat, psb_long_int_k_ -!!$ class(psb_d_coo_sparse_mat), intent(inout) :: a -!!$ class(psb_d_base_sparse_mat), intent(inout), allocatable :: b -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psb_d_coo_clone -!!$ end interface - - ! !> Function print. diff --git a/base/modules/psb_d_csc_mat_mod.f90 b/base/modules/psb_d_csc_mat_mod.f90 index 0d7ceb6c..3975292e 100644 --- a/base/modules/psb_d_csc_mat_mod.f90 +++ b/base/modules/psb_d_csc_mat_mod.f90 @@ -97,7 +97,6 @@ module psb_d_csc_mat_mod procedure, pass(a) :: print => psb_d_csc_print procedure, pass(a) :: free => d_csc_free procedure, pass(a) :: mold => psb_d_csc_mold - procedure, pass(a) :: copy => psb_d_csc_copy end type psb_d_csc_sparse_mat @@ -144,18 +143,6 @@ module psb_d_csc_mat_mod end subroutine psb_d_csc_mold end interface - !> \memberof psb_d_csc_sparse_mat - !| \see psb_base_mat_mod::psb_base_copy - interface - subroutine psb_d_csc_copy(a,b,info) - import :: psb_ipk_, psb_d_csc_sparse_mat, psb_d_base_sparse_mat, psb_long_int_k_ - class(psb_d_csc_sparse_mat), intent(in) :: a - class(psb_d_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_d_csc_copy - end interface - - !> \memberof psb_d_csc_sparse_mat !| \see psb_base_mat_mod::psb_base_allocate_mnnz interface diff --git a/base/modules/psb_d_csr_mat_mod.f90 b/base/modules/psb_d_csr_mat_mod.f90 index 893ab9ad..3d475f94 100644 --- a/base/modules/psb_d_csr_mat_mod.f90 +++ b/base/modules/psb_d_csr_mat_mod.f90 @@ -98,7 +98,6 @@ module psb_d_csr_mat_mod procedure, pass(a) :: print => psb_d_csr_print procedure, pass(a) :: free => d_csr_free procedure, pass(a) :: mold => psb_d_csr_mold - procedure, pass(a) :: copy => psb_d_csr_copy end type psb_d_csr_sparse_mat @@ -146,17 +145,6 @@ module psb_d_csr_mat_mod end subroutine psb_d_csr_mold end interface - !> \memberof psb_d_csr_sparse_mat - !| \see psb_base_mat_mod::psb_base_copy - interface - subroutine psb_d_csr_copy(a,b,info) - import :: psb_ipk_, psb_d_csr_sparse_mat, psb_d_base_sparse_mat, psb_long_int_k_ - class(psb_d_csr_sparse_mat), intent(in) :: a - class(psb_d_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_d_csr_copy - end interface - !> \memberof psb_d_csr_sparse_mat !| \see psb_base_mat_mod::psb_base_allocate_mnnz interface diff --git a/base/modules/psb_d_mat_mod.f90 b/base/modules/psb_d_mat_mod.f90 index f0b16844..6b141744 100644 --- a/base/modules/psb_d_mat_mod.f90 +++ b/base/modules/psb_d_mat_mod.f90 @@ -154,7 +154,6 @@ module psb_d_mat_mod procedure, pass(a) :: cscnv_ip => psb_d_cscnv_ip procedure, pass(a) :: cscnv_base => psb_d_cscnv_base generic, public :: cscnv => cscnv_np, cscnv_ip, cscnv_base - procedure, pass(a) :: copy => psb_dspmat_copy procedure, pass(a) :: clone => psb_dspmat_clone ! Computational routines @@ -610,15 +609,6 @@ module psb_d_mat_mod end subroutine psb_dspmat_type_move end interface - interface - subroutine psb_dspmat_copy(a,b,info) - import :: psb_ipk_, psb_dspmat_type - class(psb_dspmat_type), intent(inout) :: a - class(psb_dspmat_type), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_dspmat_copy - end interface - interface subroutine psb_dspmat_clone(a,b,info) import :: psb_ipk_, psb_dspmat_type diff --git a/base/modules/psb_s_base_mat_mod.f90 b/base/modules/psb_s_base_mat_mod.f90 index 1eebdf84..eac93184 100644 --- a/base/modules/psb_s_base_mat_mod.f90 +++ b/base/modules/psb_s_base_mat_mod.f90 @@ -72,7 +72,6 @@ module psb_s_base_mat_mod procedure, pass(a) :: mv_to_fmt => psb_s_base_mv_to_fmt procedure, pass(a) :: mv_from_fmt => psb_s_base_mv_from_fmt procedure, pass(a) :: mold => psb_s_base_mold - procedure, pass(a) :: copy => psb_s_base_copy procedure, pass(a) :: clone => psb_s_base_clone ! @@ -158,8 +157,6 @@ module psb_s_base_mat_mod procedure, pass(a) :: print => psb_s_coo_print procedure, pass(a) :: free => s_coo_free procedure, pass(a) :: mold => psb_s_coo_mold - procedure, pass(a) :: copy => psb_s_coo_copy -!!$ procedure, pass(a) :: clone => psb_s_coo_clone ! ! This is COO specific ! @@ -411,24 +408,6 @@ module psb_s_base_mat_mod end interface ! - !> Function copy: - !! \memberof psb_s_base_sparse_mat - !! \brief Copy a class(psb_s_base_sparse_mat) - !! but only if it is the same dynamic type as the input. - !! \param b The output variable - !! \param info return code - ! - interface - subroutine psb_s_base_copy(a,b, info) - import :: psb_ipk_, psb_s_base_sparse_mat, psb_long_int_k_ - implicit none - class(psb_s_base_sparse_mat), intent(in) :: a - class(psb_s_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_s_base_copy - end interface - - ! !> Function clone: !! \memberof psb_s_base_sparse_mat @@ -1156,29 +1135,6 @@ module psb_s_base_mat_mod end subroutine psb_s_coo_mold end interface - !> \memberof psb_s_coo_sparse_mat - !| \see psb_base_mat_mod::psb_base_copy - interface - subroutine psb_s_coo_copy(a,b,info) - import :: psb_ipk_, psb_s_coo_sparse_mat, psb_s_base_sparse_mat, psb_long_int_k_ - class(psb_s_coo_sparse_mat), intent(in) :: a - class(psb_s_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_s_coo_copy - end interface - -!!$ !> \memberof psb_s_coo_sparse_mat -!!$ !| \see psb_base_mat_mod::psb_base_copy -!!$ interface -!!$ subroutine psb_s_coo_clone(a,b,info) -!!$ import :: psb_ipk_, psb_s_coo_sparse_mat, psb_s_base_sparse_mat, psb_long_int_k_ -!!$ class(psb_s_coo_sparse_mat), intent(inout) :: a -!!$ class(psb_s_base_sparse_mat), intent(inout), allocatable :: b -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psb_s_coo_clone -!!$ end interface - - ! !> Function print. diff --git a/base/modules/psb_s_csc_mat_mod.f90 b/base/modules/psb_s_csc_mat_mod.f90 index 57be449f..2d1a4b47 100644 --- a/base/modules/psb_s_csc_mat_mod.f90 +++ b/base/modules/psb_s_csc_mat_mod.f90 @@ -97,7 +97,6 @@ module psb_s_csc_mat_mod procedure, pass(a) :: print => psb_s_csc_print procedure, pass(a) :: free => s_csc_free procedure, pass(a) :: mold => psb_s_csc_mold - procedure, pass(a) :: copy => psb_s_csc_copy end type psb_s_csc_sparse_mat @@ -144,18 +143,6 @@ module psb_s_csc_mat_mod end subroutine psb_s_csc_mold end interface - !> \memberof psb_s_csc_sparse_mat - !| \see psb_base_mat_mod::psb_base_copy - interface - subroutine psb_s_csc_copy(a,b,info) - import :: psb_ipk_, psb_s_csc_sparse_mat, psb_s_base_sparse_mat, psb_long_int_k_ - class(psb_s_csc_sparse_mat), intent(in) :: a - class(psb_s_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_s_csc_copy - end interface - - !> \memberof psb_s_csc_sparse_mat !| \see psb_base_mat_mod::psb_base_allocate_mnnz interface diff --git a/base/modules/psb_s_csr_mat_mod.f90 b/base/modules/psb_s_csr_mat_mod.f90 index 3deb6bb9..e196c269 100644 --- a/base/modules/psb_s_csr_mat_mod.f90 +++ b/base/modules/psb_s_csr_mat_mod.f90 @@ -98,7 +98,6 @@ module psb_s_csr_mat_mod procedure, pass(a) :: print => psb_s_csr_print procedure, pass(a) :: free => s_csr_free procedure, pass(a) :: mold => psb_s_csr_mold - procedure, pass(a) :: copy => psb_s_csr_copy end type psb_s_csr_sparse_mat @@ -146,17 +145,6 @@ module psb_s_csr_mat_mod end subroutine psb_s_csr_mold end interface - !> \memberof psb_s_csr_sparse_mat - !| \see psb_base_mat_mod::psb_base_copy - interface - subroutine psb_s_csr_copy(a,b,info) - import :: psb_ipk_, psb_s_csr_sparse_mat, psb_s_base_sparse_mat, psb_long_int_k_ - class(psb_s_csr_sparse_mat), intent(in) :: a - class(psb_s_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_s_csr_copy - end interface - !> \memberof psb_s_csr_sparse_mat !| \see psb_base_mat_mod::psb_base_allocate_mnnz interface diff --git a/base/modules/psb_s_mat_mod.f90 b/base/modules/psb_s_mat_mod.f90 index 10a9464c..420ec535 100644 --- a/base/modules/psb_s_mat_mod.f90 +++ b/base/modules/psb_s_mat_mod.f90 @@ -154,7 +154,6 @@ module psb_s_mat_mod procedure, pass(a) :: cscnv_ip => psb_s_cscnv_ip procedure, pass(a) :: cscnv_base => psb_s_cscnv_base generic, public :: cscnv => cscnv_np, cscnv_ip, cscnv_base - procedure, pass(a) :: copy => psb_sspmat_copy procedure, pass(a) :: clone => psb_sspmat_clone ! Computational routines @@ -610,15 +609,6 @@ module psb_s_mat_mod end subroutine psb_sspmat_type_move end interface - interface - subroutine psb_sspmat_copy(a,b,info) - import :: psb_ipk_, psb_sspmat_type - class(psb_sspmat_type), intent(inout) :: a - class(psb_sspmat_type), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_sspmat_copy - end interface - interface subroutine psb_sspmat_clone(a,b,info) import :: psb_ipk_, psb_sspmat_type diff --git a/base/modules/psb_z_base_mat_mod.f90 b/base/modules/psb_z_base_mat_mod.f90 index 144b3e27..e22ac14d 100644 --- a/base/modules/psb_z_base_mat_mod.f90 +++ b/base/modules/psb_z_base_mat_mod.f90 @@ -72,7 +72,6 @@ module psb_z_base_mat_mod procedure, pass(a) :: mv_to_fmt => psb_z_base_mv_to_fmt procedure, pass(a) :: mv_from_fmt => psb_z_base_mv_from_fmt procedure, pass(a) :: mold => psb_z_base_mold - procedure, pass(a) :: copy => psb_z_base_copy procedure, pass(a) :: clone => psb_z_base_clone ! @@ -158,8 +157,6 @@ module psb_z_base_mat_mod procedure, pass(a) :: print => psb_z_coo_print procedure, pass(a) :: free => z_coo_free procedure, pass(a) :: mold => psb_z_coo_mold - procedure, pass(a) :: copy => psb_z_coo_copy -!!$ procedure, pass(a) :: clone => psb_z_coo_clone ! ! This is COO specific ! @@ -411,24 +408,6 @@ module psb_z_base_mat_mod end interface ! - !> Function copy: - !! \memberof psb_z_base_sparse_mat - !! \brief Copy a class(psb_z_base_sparse_mat) - !! but only if it is the same dynamic type as the input. - !! \param b The output variable - !! \param info return code - ! - interface - subroutine psb_z_base_copy(a,b, info) - import :: psb_ipk_, psb_z_base_sparse_mat, psb_long_int_k_ - implicit none - class(psb_z_base_sparse_mat), intent(in) :: a - class(psb_z_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_z_base_copy - end interface - - ! !> Function clone: !! \memberof psb_z_base_sparse_mat @@ -1156,29 +1135,6 @@ module psb_z_base_mat_mod end subroutine psb_z_coo_mold end interface - !> \memberof psb_z_coo_sparse_mat - !| \see psb_base_mat_mod::psb_base_copy - interface - subroutine psb_z_coo_copy(a,b,info) - import :: psb_ipk_, psb_z_coo_sparse_mat, psb_z_base_sparse_mat, psb_long_int_k_ - class(psb_z_coo_sparse_mat), intent(in) :: a - class(psb_z_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_z_coo_copy - end interface - -!!$ !> \memberof psb_z_coo_sparse_mat -!!$ !| \see psb_base_mat_mod::psb_base_copy -!!$ interface -!!$ subroutine psb_z_coo_clone(a,b,info) -!!$ import :: psb_ipk_, psb_z_coo_sparse_mat, psb_z_base_sparse_mat, psb_long_int_k_ -!!$ class(psb_z_coo_sparse_mat), intent(inout) :: a -!!$ class(psb_z_base_sparse_mat), intent(inout), allocatable :: b -!!$ integer(psb_ipk_), intent(out) :: info -!!$ end subroutine psb_z_coo_clone -!!$ end interface - - ! !> Function print. diff --git a/base/modules/psb_z_csc_mat_mod.f90 b/base/modules/psb_z_csc_mat_mod.f90 index 598312ac..be35a2c3 100644 --- a/base/modules/psb_z_csc_mat_mod.f90 +++ b/base/modules/psb_z_csc_mat_mod.f90 @@ -97,7 +97,6 @@ module psb_z_csc_mat_mod procedure, pass(a) :: print => psb_z_csc_print procedure, pass(a) :: free => z_csc_free procedure, pass(a) :: mold => psb_z_csc_mold - procedure, pass(a) :: copy => psb_z_csc_copy end type psb_z_csc_sparse_mat @@ -144,18 +143,6 @@ module psb_z_csc_mat_mod end subroutine psb_z_csc_mold end interface - !> \memberof psb_z_csc_sparse_mat - !| \see psb_base_mat_mod::psb_base_copy - interface - subroutine psb_z_csc_copy(a,b,info) - import :: psb_ipk_, psb_z_csc_sparse_mat, psb_z_base_sparse_mat, psb_long_int_k_ - class(psb_z_csc_sparse_mat), intent(in) :: a - class(psb_z_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_z_csc_copy - end interface - - !> \memberof psb_z_csc_sparse_mat !| \see psb_base_mat_mod::psb_base_allocate_mnnz interface diff --git a/base/modules/psb_z_csr_mat_mod.f90 b/base/modules/psb_z_csr_mat_mod.f90 index 090b73dd..184484da 100644 --- a/base/modules/psb_z_csr_mat_mod.f90 +++ b/base/modules/psb_z_csr_mat_mod.f90 @@ -98,7 +98,6 @@ module psb_z_csr_mat_mod procedure, pass(a) :: print => psb_z_csr_print procedure, pass(a) :: free => z_csr_free procedure, pass(a) :: mold => psb_z_csr_mold - procedure, pass(a) :: copy => psb_z_csr_copy end type psb_z_csr_sparse_mat @@ -146,17 +145,6 @@ module psb_z_csr_mat_mod end subroutine psb_z_csr_mold end interface - !> \memberof psb_z_csr_sparse_mat - !| \see psb_base_mat_mod::psb_base_copy - interface - subroutine psb_z_csr_copy(a,b,info) - import :: psb_ipk_, psb_z_csr_sparse_mat, psb_z_base_sparse_mat, psb_long_int_k_ - class(psb_z_csr_sparse_mat), intent(in) :: a - class(psb_z_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_z_csr_copy - end interface - !> \memberof psb_z_csr_sparse_mat !| \see psb_base_mat_mod::psb_base_allocate_mnnz interface diff --git a/base/modules/psb_z_mat_mod.f90 b/base/modules/psb_z_mat_mod.f90 index f2b36c5b..f53d2143 100644 --- a/base/modules/psb_z_mat_mod.f90 +++ b/base/modules/psb_z_mat_mod.f90 @@ -154,7 +154,6 @@ module psb_z_mat_mod procedure, pass(a) :: cscnv_ip => psb_z_cscnv_ip procedure, pass(a) :: cscnv_base => psb_z_cscnv_base generic, public :: cscnv => cscnv_np, cscnv_ip, cscnv_base - procedure, pass(a) :: copy => psb_zspmat_copy procedure, pass(a) :: clone => psb_zspmat_clone ! Computational routines @@ -610,15 +609,6 @@ module psb_z_mat_mod end subroutine psb_zspmat_type_move end interface - interface - subroutine psb_zspmat_copy(a,b,info) - import :: psb_ipk_, psb_zspmat_type - class(psb_zspmat_type), intent(inout) :: a - class(psb_zspmat_type), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - end subroutine psb_zspmat_copy - end interface - interface subroutine psb_zspmat_clone(a,b,info) import :: psb_ipk_, psb_zspmat_type diff --git a/base/serial/impl/psb_c_base_mat_impl.F90 b/base/serial/impl/psb_c_base_mat_impl.F90 index 57ebd0b3..81e479fd 100644 --- a/base/serial/impl/psb_c_base_mat_impl.F90 +++ b/base/serial/impl/psb_c_base_mat_impl.F90 @@ -606,43 +606,6 @@ subroutine psb_c_base_mold(a,b,info) end subroutine psb_c_base_mold -subroutine psb_c_base_copy(a,b,info) - use psb_c_base_mat_mod, psb_protect_name => psb_c_base_copy - use psb_error_mod - implicit none - class(psb_c_base_sparse_mat), intent(in) :: a - class(psb_c_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='base_copy' - logical, parameter :: debug=.false. - - call psb_get_erraction(err_act) - ! This is the base version. If we get here - ! it means the derived class is incomplete, - ! so we throw an error. - info = 0 - - call a%psb_base_sparse_mat%copy(b%psb_base_sparse_mat,info) - - if (info /= 0) then - info = psb_err_internal_error_ - call psb_errpush(info,name) - goto 9999 - end if - call psb_erractionrestore(err_act) - - return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if - - return - -end subroutine psb_c_base_copy - subroutine psb_c_base_transp_2mat(a,b) use psb_c_base_mat_mod, psb_protect_name => psb_c_base_transp_2mat use psb_error_mod diff --git a/base/serial/impl/psb_c_coo_impl.f90 b/base/serial/impl/psb_c_coo_impl.f90 index 1ac957b3..d675785b 100644 --- a/base/serial/impl/psb_c_coo_impl.f90 +++ b/base/serial/impl/psb_c_coo_impl.f90 @@ -256,46 +256,6 @@ subroutine psb_c_coo_mold(a,b,info) end subroutine psb_c_coo_mold -subroutine psb_c_coo_copy(a,b,info) - use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_copy - use psb_error_mod - use psb_realloc_mod - implicit none - class(psb_c_coo_sparse_mat), intent(in) :: a - class(psb_c_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='coo_copy' - logical, parameter :: debug=.false. - - call psb_get_erraction(err_act) - - info = 0 - - select type(b) - type is (psb_c_coo_sparse_mat) - call a%psb_c_base_sparse_mat%copy(b%psb_c_base_sparse_mat,info) - if (info == 0) call psb_safe_cpy( a%ia, b%ia, info) - if (info == 0) call psb_safe_cpy( a%ja, b%ja, info) - if (info == 0) call psb_safe_cpy( a%val, b%val, info) - if (info == 0) call b%fix(info) - - if (info /= psb_success_) goto 9999 - class default - info = psb_err_internal_error_ - goto 9999 - end select - - return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - -end subroutine psb_c_coo_copy - subroutine psb_c_coo_reinit(a,clear) use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_reinit use psb_error_mod @@ -2964,7 +2924,7 @@ subroutine psb_c_cp_coo_to_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - call a%psb_c_base_sparse_mat%copy(b%psb_c_base_sparse_mat,info) + b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat nz = a%get_nzeros() call b%set_nzeros(nz) @@ -3010,7 +2970,7 @@ subroutine psb_c_cp_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - call b%psb_c_base_sparse_mat%copy(a%psb_c_base_sparse_mat,info) + a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat nz = b%get_nzeros() call a%set_nzeros(nz) @@ -3130,7 +3090,7 @@ subroutine psb_c_mv_coo_to_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - call a%psb_c_base_sparse_mat%copy(b%psb_c_base_sparse_mat, info) + b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat call b%set_nzeros(a%get_nzeros()) call b%reallocate(a%get_nzeros()) @@ -3175,7 +3135,7 @@ subroutine psb_c_mv_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - call b%psb_c_base_sparse_mat%copy(a%psb_c_base_sparse_mat, info) + a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat call a%set_nzeros(b%get_nzeros()) call a%reallocate(b%get_nzeros()) diff --git a/base/serial/impl/psb_c_csc_impl.f90 b/base/serial/impl/psb_c_csc_impl.f90 index 567830a0..dd9dbf96 100644 --- a/base/serial/impl/psb_c_csc_impl.f90 +++ b/base/serial/impl/psb_c_csc_impl.f90 @@ -2263,7 +2263,7 @@ subroutine psb_c_cp_csc_to_coo(a,b,info) nza = a%get_nzeros() call b%allocate(nr,nc,nza) - call a%psb_c_base_sparse_mat%copy(b%psb_c_base_sparse_mat, info) + b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat do i=1, nc do j=a%icp(i),a%icp(i+1)-1 @@ -2305,7 +2305,7 @@ subroutine psb_c_mv_csc_to_coo(a,b,info) nc = a%get_ncols() nza = a%get_nzeros() - call a%psb_c_base_sparse_mat%copy(b%psb_c_base_sparse_mat, info) + b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat call b%set_nzeros(a%get_nzeros()) call move_alloc(a%ia,b%ia) call move_alloc(a%val,b%val) @@ -2355,7 +2355,7 @@ subroutine psb_c_mv_csc_from_coo(a,b,info) nc = b%get_ncols() nza = b%get_nzeros() - call b%psb_c_base_sparse_mat%copy(a%psb_c_base_sparse_mat, info) + a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat ! Dirty trick: call move_alloc to have the new data allocated just once. call move_alloc(b%ja,itemp) @@ -2443,7 +2443,7 @@ subroutine psb_c_mv_csc_to_fmt(a,b,info) call a%mv_to_coo(b,info) ! Need to fix trivial copies! type is (psb_c_csc_sparse_mat) - call a%psb_c_base_sparse_mat%copy(b%psb_c_base_sparse_mat, info) + b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat call move_alloc(a%icp, b%icp) call move_alloc(a%ia, b%ia) call move_alloc(a%val, b%val) @@ -2484,7 +2484,7 @@ subroutine psb_c_cp_csc_to_fmt(a,b,info) call a%cp_to_coo(b,info) type is (psb_c_csc_sparse_mat) - call a%psb_c_base_sparse_mat%copy(b%psb_c_base_sparse_mat,info) + b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat if (info == 0) call psb_safe_cpy( a%icp, b%icp , info) if (info == 0) call psb_safe_cpy( a%ia , b%ia , info) if (info == 0) call psb_safe_cpy( a%val, b%val , info) @@ -2523,7 +2523,7 @@ subroutine psb_c_mv_csc_from_fmt(a,b,info) call a%mv_from_coo(b,info) type is (psb_c_csc_sparse_mat) - call b%psb_c_base_sparse_mat%copy(a%psb_c_base_sparse_mat, info) + a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat call move_alloc(b%icp, a%icp) call move_alloc(b%ia, a%ia) call move_alloc(b%val, a%val) @@ -2564,7 +2564,7 @@ subroutine psb_c_cp_csc_from_fmt(a,b,info) call a%cp_from_coo(b,info) type is (psb_c_csc_sparse_mat) - call b%psb_c_base_sparse_mat%copy(a%psb_c_base_sparse_mat, info) + a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat if (info == 0) call psb_safe_cpy( b%icp, a%icp , info) if (info == 0) call psb_safe_cpy( b%ia , a%ia , info) if (info == 0) call psb_safe_cpy( b%val, a%val , info) @@ -2612,45 +2612,6 @@ subroutine psb_c_csc_mold(a,b,info) end subroutine psb_c_csc_mold -subroutine psb_c_csc_copy(a,b,info) - use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_copy - use psb_error_mod - use psb_realloc_mod - implicit none - class(psb_c_csc_sparse_mat), intent(in) :: a - class(psb_c_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='csc_copy' - logical, parameter :: debug=.false. - - call psb_get_erraction(err_act) - - info = 0 - - select type(b) - type is (psb_c_csc_sparse_mat) - call a%psb_c_base_sparse_mat%copy(b%psb_c_base_sparse_mat, info) - if (info == 0) call psb_safe_cpy( a%icp, b%icp , info) - if (info == 0) call psb_safe_cpy( a%ia , b%ia , info) - if (info == 0) call psb_safe_cpy( a%val, b%val , info) - if (info /= psb_success_) goto 9999 - - class default - info = psb_err_internal_error_ - goto 9999 - end select - - return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - -end subroutine psb_c_csc_copy - subroutine psb_c_csc_reallocate_nz(nz,a) use psb_error_mod use psb_realloc_mod @@ -2974,83 +2935,3 @@ subroutine psb_c_csc_print(iout,a,iv,head,ivr,ivc) end subroutine psb_c_csc_print -!!$subroutine psb_c_csc_cp_from(a,b) -!!$ use psb_error_mod -!!$ use psb_realloc_mod -!!$ use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_cp_from -!!$ implicit none -!!$ -!!$ class(psb_c_csc_sparse_mat), intent(inout) :: a -!!$ type(psb_c_csc_sparse_mat), intent(in) :: b -!!$ -!!$ -!!$ integer(psb_ipk_) :: err_act, info -!!$ integer(psb_ipk_) :: ierr(5) -!!$ character(len=20) :: name='cp_from' -!!$ logical, parameter :: debug=.false. -!!$ -!!$ call psb_erractionsave(err_act) -!!$ -!!$ info = psb_success_ -!!$ -!!$ call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros()) -!!$ call b%psb_c_base_sparse_mat%copy(a%psb_c_base_sparse_mat, info) -!!$ if (info == 0) call psb_safe_cpy( b%icp, a%icp , info) -!!$ if (info == 0) call psb_safe_cpy( b%ia , a%ia , info) -!!$ if (info == 0) call psb_safe_cpy( b%val, a%val , info) -!!$ -!!$ if (info /= psb_success_) goto 9999 -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 continue -!!$ call psb_erractionrestore(err_act) -!!$ -!!$ call psb_errpush(info,name) -!!$ -!!$ if (err_act /= psb_act_ret_) then -!!$ call psb_error() -!!$ end if -!!$ return -!!$ -!!$end subroutine psb_c_csc_cp_from -!!$ -!!$subroutine psb_c_csc_mv_from(a,b) -!!$ use psb_error_mod -!!$ use psb_c_csc_mat_mod, psb_protect_name => psb_c_csc_mv_from -!!$ implicit none -!!$ -!!$ class(psb_c_csc_sparse_mat), intent(inout) :: a -!!$ type(psb_c_csc_sparse_mat), intent(inout) :: b -!!$ -!!$ -!!$ integer(psb_ipk_) :: err_act, info -!!$ integer(psb_ipk_) :: ierr(5) -!!$ character(len=20) :: name='mv_from' -!!$ logical, parameter :: debug=.false. -!!$ -!!$ call psb_erractionsave(err_act) -!!$ info = psb_success_ -!!$ call b%psb_c_base_sparse_mat%copy(a%psb_c_base_sparse_mat, info) -!!$ if (info == 0) call move_alloc(b%icp, a%icp) -!!$ if (info == 0) call move_alloc(b%ia, a%ia) -!!$ if (info == 0) call move_alloc(b%val, a%val) -!!$ call b%free() -!!$ -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 continue -!!$ call psb_erractionrestore(err_act) -!!$ -!!$ call psb_errpush(info,name) -!!$ -!!$ if (err_act /= psb_act_ret_) then -!!$ call psb_error() -!!$ end if -!!$ return -!!$ -!!$end subroutine psb_c_csc_mv_from -!!$ - - diff --git a/base/serial/impl/psb_c_csr_impl.f90 b/base/serial/impl/psb_c_csr_impl.f90 index 3c64e22f..f7edbf54 100644 --- a/base/serial/impl/psb_c_csr_impl.f90 +++ b/base/serial/impl/psb_c_csr_impl.f90 @@ -1816,45 +1816,6 @@ subroutine psb_c_csr_mold(a,b,info) end subroutine psb_c_csr_mold -subroutine psb_c_csr_copy(a,b,info) - use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_copy - use psb_error_mod - use psb_realloc_mod - implicit none - class(psb_c_csr_sparse_mat), intent(in) :: a - class(psb_c_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='csr_copy' - logical, parameter :: debug=.false. - - call psb_get_erraction(err_act) - - info = 0 - - select type(b) - type is (psb_c_csr_sparse_mat) - call a%psb_c_base_sparse_mat%copy(b%psb_c_base_sparse_mat, info) - if (info == 0) call psb_safe_cpy( a%irp, b%irp , info) - if (info == 0) call psb_safe_cpy( a%ja , b%ja , info) - if (info == 0) call psb_safe_cpy( a%val, b%val , info) - if (info /= psb_success_) goto 9999 - - class default - info = psb_err_internal_error_ - goto 9999 - end select - - return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - -end subroutine psb_c_csr_copy - subroutine psb_c_csr_allocate_mnnz(m,n,a,nz) use psb_error_mod use psb_realloc_mod @@ -2843,7 +2804,7 @@ subroutine psb_c_cp_csr_to_coo(a,b,info) nza = a%get_nzeros() call b%allocate(nr,nc,nza) - call a%psb_c_base_sparse_mat%copy(b%psb_c_base_sparse_mat, info) + b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat do i=1, nr do j=a%irp(i),a%irp(i+1)-1 @@ -2884,7 +2845,7 @@ subroutine psb_c_mv_csr_to_coo(a,b,info) nc = a%get_ncols() nza = a%get_nzeros() - call a%psb_c_base_sparse_mat%copy(b%psb_c_base_sparse_mat, info) + b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat call b%set_nzeros(a%get_nzeros()) call move_alloc(a%ja,b%ja) call move_alloc(a%val,b%val) @@ -2935,7 +2896,7 @@ subroutine psb_c_mv_csr_from_coo(a,b,info) nc = b%get_ncols() nza = b%get_nzeros() - call b%psb_c_base_sparse_mat%copy(a%psb_c_base_sparse_mat, info) + a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat ! Dirty trick: call move_alloc to have the new data allocated just once. call move_alloc(b%ia,itemp) @@ -3022,7 +2983,7 @@ subroutine psb_c_mv_csr_to_fmt(a,b,info) call a%mv_to_coo(b,info) ! Need to fix trivial copies! type is (psb_c_csr_sparse_mat) - call a%psb_c_base_sparse_mat%copy(b%psb_c_base_sparse_mat, info) + b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat call move_alloc(a%irp, b%irp) call move_alloc(a%ja, b%ja) call move_alloc(a%val, b%val) @@ -3063,7 +3024,7 @@ subroutine psb_c_cp_csr_to_fmt(a,b,info) call a%cp_to_coo(b,info) type is (psb_c_csr_sparse_mat) - call a%psb_c_base_sparse_mat%copy(b%psb_c_base_sparse_mat, info) + b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat if (info == 0) call psb_safe_cpy( a%irp, b%irp , info) if (info == 0) call psb_safe_cpy( a%ja , b%ja , info) if (info == 0) call psb_safe_cpy( a%val, b%val , info) @@ -3101,7 +3062,7 @@ subroutine psb_c_mv_csr_from_fmt(a,b,info) call a%mv_from_coo(b,info) type is (psb_c_csr_sparse_mat) - call b%psb_c_base_sparse_mat%copy(a%psb_c_base_sparse_mat, info) + a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat call move_alloc(b%irp, a%irp) call move_alloc(b%ja, a%ja) call move_alloc(b%val, a%val) @@ -3142,7 +3103,7 @@ subroutine psb_c_cp_csr_from_fmt(a,b,info) call a%cp_from_coo(b,info) type is (psb_c_csr_sparse_mat) - call b%psb_c_base_sparse_mat%copy(a%psb_c_base_sparse_mat, info) + a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat if (info == 0) call psb_safe_cpy( b%irp, a%irp , info) if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) if (info == 0) call psb_safe_cpy( b%val, a%val , info) @@ -3152,84 +3113,3 @@ subroutine psb_c_cp_csr_from_fmt(a,b,info) if (info == psb_success_) call a%mv_from_coo(tmp,info) end select end subroutine psb_c_cp_csr_from_fmt - -!!$ -!!$subroutine psb_c_csr_cp_from(a,b) -!!$ use psb_error_mod -!!$ use psb_realloc_mod -!!$ use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_cp_from -!!$ implicit none -!!$ -!!$ class(psb_c_csr_sparse_mat), intent(inout) :: a -!!$ type(psb_c_csr_sparse_mat), intent(in) :: b -!!$ -!!$ -!!$ integer(psb_ipk_) :: err_act, info -!!$ integer(psb_ipk_) :: ierr(5) -!!$ character(len=20) :: name='cp_from' -!!$ logical, parameter :: debug=.false. -!!$ -!!$ call psb_erractionsave(err_act) -!!$ -!!$ info = psb_success_ -!!$ -!!$ call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros()) -!!$ call b%psb_c_base_sparse_mat%copy(a%psb_c_base_sparse_mat, info) -!!$ if (info == 0) call psb_safe_cpy( b%irp, a%irp , info) -!!$ if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) -!!$ if (info == 0) call psb_safe_cpy( b%val, a%val , info) -!!$ -!!$ if (info /= psb_success_) goto 9999 -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 continue -!!$ call psb_erractionrestore(err_act) -!!$ -!!$ call psb_errpush(info,name) -!!$ -!!$ if (err_act /= psb_act_ret_) then -!!$ call psb_error() -!!$ end if -!!$ return -!!$ -!!$end subroutine psb_c_csr_cp_from -!!$ -!!$subroutine psb_c_csr_mv_from(a,b) -!!$ use psb_error_mod -!!$ use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_mv_from -!!$ implicit none -!!$ -!!$ class(psb_c_csr_sparse_mat), intent(inout) :: a -!!$ type(psb_c_csr_sparse_mat), intent(inout) :: b -!!$ -!!$ -!!$ integer(psb_ipk_) :: err_act, info -!!$ integer(psb_ipk_) :: ierr(5) -!!$ character(len=20) :: name='mv_from' -!!$ logical, parameter :: debug=.false. -!!$ -!!$ call psb_erractionsave(err_act) -!!$ info = psb_success_ -!!$ call a%psb_c_base_sparse_mat%mv_from(b%psb_c_base_sparse_mat) -!!$ call move_alloc(b%irp, a%irp) -!!$ call move_alloc(b%ja, a%ja) -!!$ call move_alloc(b%val, a%val) -!!$ call b%free() -!!$ -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 continue -!!$ call psb_erractionrestore(err_act) -!!$ -!!$ call psb_errpush(info,name) -!!$ -!!$ if (err_act /= psb_act_ret_) then -!!$ call psb_error() -!!$ end if -!!$ return -!!$ -!!$end subroutine psb_c_csr_mv_from -!!$ -!!$ diff --git a/base/serial/impl/psb_c_mat_impl.F90 b/base/serial/impl/psb_c_mat_impl.F90 index 63ef37c0..657fa671 100644 --- a/base/serial/impl/psb_c_mat_impl.F90 +++ b/base/serial/impl/psb_c_mat_impl.F90 @@ -1574,42 +1574,6 @@ subroutine psb_cspmat_clone(a,b,info) end subroutine psb_cspmat_clone -subroutine psb_cspmat_copy(a,b,info) - use psb_error_mod - use psb_string_mod - use psb_c_mat_mod, psb_protect_name => psb_cspmat_copy - implicit none - class(psb_cspmat_type), intent(inout) :: a - class(psb_cspmat_type), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - - integer(psb_ipk_) :: err_act - character(len=20) :: name='copy' - logical, parameter :: debug=.false. - - call psb_erractionsave(err_act) - info = psb_success_ - call b%free() - if (allocated(a%a)) then - call a%a%clone(b%a,info) - end if - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - -end subroutine psb_cspmat_copy - - - subroutine psb_c_transp_1mat(a) use psb_error_mod use psb_string_mod diff --git a/base/serial/impl/psb_d_base_mat_impl.F90 b/base/serial/impl/psb_d_base_mat_impl.F90 index dfebb308..5f67c547 100644 --- a/base/serial/impl/psb_d_base_mat_impl.F90 +++ b/base/serial/impl/psb_d_base_mat_impl.F90 @@ -606,43 +606,6 @@ subroutine psb_d_base_mold(a,b,info) end subroutine psb_d_base_mold -subroutine psb_d_base_copy(a,b,info) - use psb_d_base_mat_mod, psb_protect_name => psb_d_base_copy - use psb_error_mod - implicit none - class(psb_d_base_sparse_mat), intent(in) :: a - class(psb_d_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='base_copy' - logical, parameter :: debug=.false. - - call psb_get_erraction(err_act) - ! This is the base version. If we get here - ! it means the derived class is incomplete, - ! so we throw an error. - info = 0 - - call a%psb_base_sparse_mat%copy(b%psb_base_sparse_mat,info) - - if (info /= 0) then - info = psb_err_internal_error_ - call psb_errpush(info,name) - goto 9999 - end if - call psb_erractionrestore(err_act) - - return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if - - return - -end subroutine psb_d_base_copy - subroutine psb_d_base_transp_2mat(a,b) use psb_d_base_mat_mod, psb_protect_name => psb_d_base_transp_2mat use psb_error_mod diff --git a/base/serial/impl/psb_d_coo_impl.f90 b/base/serial/impl/psb_d_coo_impl.f90 index 25b61d63..ddf322d6 100644 --- a/base/serial/impl/psb_d_coo_impl.f90 +++ b/base/serial/impl/psb_d_coo_impl.f90 @@ -256,46 +256,6 @@ subroutine psb_d_coo_mold(a,b,info) end subroutine psb_d_coo_mold -subroutine psb_d_coo_copy(a,b,info) - use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_copy - use psb_error_mod - use psb_realloc_mod - implicit none - class(psb_d_coo_sparse_mat), intent(in) :: a - class(psb_d_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='coo_copy' - logical, parameter :: debug=.false. - - call psb_get_erraction(err_act) - - info = 0 - - select type(b) - type is (psb_d_coo_sparse_mat) - call a%psb_d_base_sparse_mat%copy(b%psb_d_base_sparse_mat,info) - if (info == 0) call psb_safe_cpy( a%ia, b%ia, info) - if (info == 0) call psb_safe_cpy( a%ja, b%ja, info) - if (info == 0) call psb_safe_cpy( a%val, b%val, info) - if (info == 0) call b%fix(info) - - if (info /= psb_success_) goto 9999 - class default - info = psb_err_internal_error_ - goto 9999 - end select - - return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - -end subroutine psb_d_coo_copy - subroutine psb_d_coo_reinit(a,clear) use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_reinit use psb_error_mod @@ -2964,7 +2924,7 @@ subroutine psb_d_cp_coo_to_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - call a%psb_d_base_sparse_mat%copy(b%psb_d_base_sparse_mat,info) + b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat nz = a%get_nzeros() call b%set_nzeros(nz) @@ -3010,7 +2970,7 @@ subroutine psb_d_cp_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - call b%psb_d_base_sparse_mat%copy(a%psb_d_base_sparse_mat,info) + a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat nz = b%get_nzeros() call a%set_nzeros(nz) @@ -3130,7 +3090,7 @@ subroutine psb_d_mv_coo_to_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - call a%psb_d_base_sparse_mat%copy(b%psb_d_base_sparse_mat, info) + b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat call b%set_nzeros(a%get_nzeros()) call b%reallocate(a%get_nzeros()) @@ -3175,7 +3135,7 @@ subroutine psb_d_mv_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - call b%psb_d_base_sparse_mat%copy(a%psb_d_base_sparse_mat, info) + a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat call a%set_nzeros(b%get_nzeros()) call a%reallocate(b%get_nzeros()) diff --git a/base/serial/impl/psb_d_csc_impl.f90 b/base/serial/impl/psb_d_csc_impl.f90 index a4ec6d16..b6aedd49 100644 --- a/base/serial/impl/psb_d_csc_impl.f90 +++ b/base/serial/impl/psb_d_csc_impl.f90 @@ -2263,7 +2263,7 @@ subroutine psb_d_cp_csc_to_coo(a,b,info) nza = a%get_nzeros() call b%allocate(nr,nc,nza) - call a%psb_d_base_sparse_mat%copy(b%psb_d_base_sparse_mat, info) + b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat do i=1, nc do j=a%icp(i),a%icp(i+1)-1 @@ -2305,7 +2305,7 @@ subroutine psb_d_mv_csc_to_coo(a,b,info) nc = a%get_ncols() nza = a%get_nzeros() - call a%psb_d_base_sparse_mat%copy(b%psb_d_base_sparse_mat, info) + b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat call b%set_nzeros(a%get_nzeros()) call move_alloc(a%ia,b%ia) call move_alloc(a%val,b%val) @@ -2355,7 +2355,7 @@ subroutine psb_d_mv_csc_from_coo(a,b,info) nc = b%get_ncols() nza = b%get_nzeros() - call b%psb_d_base_sparse_mat%copy(a%psb_d_base_sparse_mat, info) + a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat ! Dirty trick: call move_alloc to have the new data allocated just once. call move_alloc(b%ja,itemp) @@ -2443,7 +2443,7 @@ subroutine psb_d_mv_csc_to_fmt(a,b,info) call a%mv_to_coo(b,info) ! Need to fix trivial copies! type is (psb_d_csc_sparse_mat) - call a%psb_d_base_sparse_mat%copy(b%psb_d_base_sparse_mat, info) + b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat call move_alloc(a%icp, b%icp) call move_alloc(a%ia, b%ia) call move_alloc(a%val, b%val) @@ -2484,7 +2484,7 @@ subroutine psb_d_cp_csc_to_fmt(a,b,info) call a%cp_to_coo(b,info) type is (psb_d_csc_sparse_mat) - call a%psb_d_base_sparse_mat%copy(b%psb_d_base_sparse_mat,info) + b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat if (info == 0) call psb_safe_cpy( a%icp, b%icp , info) if (info == 0) call psb_safe_cpy( a%ia , b%ia , info) if (info == 0) call psb_safe_cpy( a%val, b%val , info) @@ -2523,7 +2523,7 @@ subroutine psb_d_mv_csc_from_fmt(a,b,info) call a%mv_from_coo(b,info) type is (psb_d_csc_sparse_mat) - call b%psb_d_base_sparse_mat%copy(a%psb_d_base_sparse_mat, info) + a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat call move_alloc(b%icp, a%icp) call move_alloc(b%ia, a%ia) call move_alloc(b%val, a%val) @@ -2564,7 +2564,7 @@ subroutine psb_d_cp_csc_from_fmt(a,b,info) call a%cp_from_coo(b,info) type is (psb_d_csc_sparse_mat) - call b%psb_d_base_sparse_mat%copy(a%psb_d_base_sparse_mat, info) + a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat if (info == 0) call psb_safe_cpy( b%icp, a%icp , info) if (info == 0) call psb_safe_cpy( b%ia , a%ia , info) if (info == 0) call psb_safe_cpy( b%val, a%val , info) @@ -2612,45 +2612,6 @@ subroutine psb_d_csc_mold(a,b,info) end subroutine psb_d_csc_mold -subroutine psb_d_csc_copy(a,b,info) - use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_copy - use psb_error_mod - use psb_realloc_mod - implicit none - class(psb_d_csc_sparse_mat), intent(in) :: a - class(psb_d_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='csc_copy' - logical, parameter :: debug=.false. - - call psb_get_erraction(err_act) - - info = 0 - - select type(b) - type is (psb_d_csc_sparse_mat) - call a%psb_d_base_sparse_mat%copy(b%psb_d_base_sparse_mat, info) - if (info == 0) call psb_safe_cpy( a%icp, b%icp , info) - if (info == 0) call psb_safe_cpy( a%ia , b%ia , info) - if (info == 0) call psb_safe_cpy( a%val, b%val , info) - if (info /= psb_success_) goto 9999 - - class default - info = psb_err_internal_error_ - goto 9999 - end select - - return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - -end subroutine psb_d_csc_copy - subroutine psb_d_csc_reallocate_nz(nz,a) use psb_error_mod use psb_realloc_mod @@ -2974,83 +2935,3 @@ subroutine psb_d_csc_print(iout,a,iv,head,ivr,ivc) end subroutine psb_d_csc_print -!!$subroutine psb_d_csc_cp_from(a,b) -!!$ use psb_error_mod -!!$ use psb_realloc_mod -!!$ use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_cp_from -!!$ implicit none -!!$ -!!$ class(psb_d_csc_sparse_mat), intent(inout) :: a -!!$ type(psb_d_csc_sparse_mat), intent(in) :: b -!!$ -!!$ -!!$ integer(psb_ipk_) :: err_act, info -!!$ integer(psb_ipk_) :: ierr(5) -!!$ character(len=20) :: name='cp_from' -!!$ logical, parameter :: debug=.false. -!!$ -!!$ call psb_erractionsave(err_act) -!!$ -!!$ info = psb_success_ -!!$ -!!$ call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros()) -!!$ call b%psb_d_base_sparse_mat%copy(a%psb_d_base_sparse_mat, info) -!!$ if (info == 0) call psb_safe_cpy( b%icp, a%icp , info) -!!$ if (info == 0) call psb_safe_cpy( b%ia , a%ia , info) -!!$ if (info == 0) call psb_safe_cpy( b%val, a%val , info) -!!$ -!!$ if (info /= psb_success_) goto 9999 -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 continue -!!$ call psb_erractionrestore(err_act) -!!$ -!!$ call psb_errpush(info,name) -!!$ -!!$ if (err_act /= psb_act_ret_) then -!!$ call psb_error() -!!$ end if -!!$ return -!!$ -!!$end subroutine psb_d_csc_cp_from -!!$ -!!$subroutine psb_d_csc_mv_from(a,b) -!!$ use psb_error_mod -!!$ use psb_d_csc_mat_mod, psb_protect_name => psb_d_csc_mv_from -!!$ implicit none -!!$ -!!$ class(psb_d_csc_sparse_mat), intent(inout) :: a -!!$ type(psb_d_csc_sparse_mat), intent(inout) :: b -!!$ -!!$ -!!$ integer(psb_ipk_) :: err_act, info -!!$ integer(psb_ipk_) :: ierr(5) -!!$ character(len=20) :: name='mv_from' -!!$ logical, parameter :: debug=.false. -!!$ -!!$ call psb_erractionsave(err_act) -!!$ info = psb_success_ -!!$ call b%psb_d_base_sparse_mat%copy(a%psb_d_base_sparse_mat, info) -!!$ if (info == 0) call move_alloc(b%icp, a%icp) -!!$ if (info == 0) call move_alloc(b%ia, a%ia) -!!$ if (info == 0) call move_alloc(b%val, a%val) -!!$ call b%free() -!!$ -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 continue -!!$ call psb_erractionrestore(err_act) -!!$ -!!$ call psb_errpush(info,name) -!!$ -!!$ if (err_act /= psb_act_ret_) then -!!$ call psb_error() -!!$ end if -!!$ return -!!$ -!!$end subroutine psb_d_csc_mv_from -!!$ - - diff --git a/base/serial/impl/psb_d_csr_impl.f90 b/base/serial/impl/psb_d_csr_impl.f90 index 5d177e7e..6d20a8f2 100644 --- a/base/serial/impl/psb_d_csr_impl.f90 +++ b/base/serial/impl/psb_d_csr_impl.f90 @@ -1816,45 +1816,6 @@ subroutine psb_d_csr_mold(a,b,info) end subroutine psb_d_csr_mold -subroutine psb_d_csr_copy(a,b,info) - use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_copy - use psb_error_mod - use psb_realloc_mod - implicit none - class(psb_d_csr_sparse_mat), intent(in) :: a - class(psb_d_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='csr_copy' - logical, parameter :: debug=.false. - - call psb_get_erraction(err_act) - - info = 0 - - select type(b) - type is (psb_d_csr_sparse_mat) - call a%psb_d_base_sparse_mat%copy(b%psb_d_base_sparse_mat, info) - if (info == 0) call psb_safe_cpy( a%irp, b%irp , info) - if (info == 0) call psb_safe_cpy( a%ja , b%ja , info) - if (info == 0) call psb_safe_cpy( a%val, b%val , info) - if (info /= psb_success_) goto 9999 - - class default - info = psb_err_internal_error_ - goto 9999 - end select - - return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - -end subroutine psb_d_csr_copy - subroutine psb_d_csr_allocate_mnnz(m,n,a,nz) use psb_error_mod use psb_realloc_mod @@ -2843,7 +2804,7 @@ subroutine psb_d_cp_csr_to_coo(a,b,info) nza = a%get_nzeros() call b%allocate(nr,nc,nza) - call a%psb_d_base_sparse_mat%copy(b%psb_d_base_sparse_mat, info) + b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat do i=1, nr do j=a%irp(i),a%irp(i+1)-1 @@ -2884,7 +2845,7 @@ subroutine psb_d_mv_csr_to_coo(a,b,info) nc = a%get_ncols() nza = a%get_nzeros() - call a%psb_d_base_sparse_mat%copy(b%psb_d_base_sparse_mat, info) + b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat call b%set_nzeros(a%get_nzeros()) call move_alloc(a%ja,b%ja) call move_alloc(a%val,b%val) @@ -2935,7 +2896,7 @@ subroutine psb_d_mv_csr_from_coo(a,b,info) nc = b%get_ncols() nza = b%get_nzeros() - call b%psb_d_base_sparse_mat%copy(a%psb_d_base_sparse_mat, info) + a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat ! Dirty trick: call move_alloc to have the new data allocated just once. call move_alloc(b%ia,itemp) @@ -3022,7 +2983,7 @@ subroutine psb_d_mv_csr_to_fmt(a,b,info) call a%mv_to_coo(b,info) ! Need to fix trivial copies! type is (psb_d_csr_sparse_mat) - call a%psb_d_base_sparse_mat%copy(b%psb_d_base_sparse_mat, info) + b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat call move_alloc(a%irp, b%irp) call move_alloc(a%ja, b%ja) call move_alloc(a%val, b%val) @@ -3063,7 +3024,7 @@ subroutine psb_d_cp_csr_to_fmt(a,b,info) call a%cp_to_coo(b,info) type is (psb_d_csr_sparse_mat) - call a%psb_d_base_sparse_mat%copy(b%psb_d_base_sparse_mat, info) + b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat if (info == 0) call psb_safe_cpy( a%irp, b%irp , info) if (info == 0) call psb_safe_cpy( a%ja , b%ja , info) if (info == 0) call psb_safe_cpy( a%val, b%val , info) @@ -3101,7 +3062,7 @@ subroutine psb_d_mv_csr_from_fmt(a,b,info) call a%mv_from_coo(b,info) type is (psb_d_csr_sparse_mat) - call b%psb_d_base_sparse_mat%copy(a%psb_d_base_sparse_mat, info) + a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat call move_alloc(b%irp, a%irp) call move_alloc(b%ja, a%ja) call move_alloc(b%val, a%val) @@ -3142,7 +3103,7 @@ subroutine psb_d_cp_csr_from_fmt(a,b,info) call a%cp_from_coo(b,info) type is (psb_d_csr_sparse_mat) - call b%psb_d_base_sparse_mat%copy(a%psb_d_base_sparse_mat, info) + a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat if (info == 0) call psb_safe_cpy( b%irp, a%irp , info) if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) if (info == 0) call psb_safe_cpy( b%val, a%val , info) @@ -3152,84 +3113,3 @@ subroutine psb_d_cp_csr_from_fmt(a,b,info) if (info == psb_success_) call a%mv_from_coo(tmp,info) end select end subroutine psb_d_cp_csr_from_fmt - -!!$ -!!$subroutine psb_d_csr_cp_from(a,b) -!!$ use psb_error_mod -!!$ use psb_realloc_mod -!!$ use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_cp_from -!!$ implicit none -!!$ -!!$ class(psb_d_csr_sparse_mat), intent(inout) :: a -!!$ type(psb_d_csr_sparse_mat), intent(in) :: b -!!$ -!!$ -!!$ integer(psb_ipk_) :: err_act, info -!!$ integer(psb_ipk_) :: ierr(5) -!!$ character(len=20) :: name='cp_from' -!!$ logical, parameter :: debug=.false. -!!$ -!!$ call psb_erractionsave(err_act) -!!$ -!!$ info = psb_success_ -!!$ -!!$ call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros()) -!!$ call b%psb_d_base_sparse_mat%copy(a%psb_d_base_sparse_mat, info) -!!$ if (info == 0) call psb_safe_cpy( b%irp, a%irp , info) -!!$ if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) -!!$ if (info == 0) call psb_safe_cpy( b%val, a%val , info) -!!$ -!!$ if (info /= psb_success_) goto 9999 -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 continue -!!$ call psb_erractionrestore(err_act) -!!$ -!!$ call psb_errpush(info,name) -!!$ -!!$ if (err_act /= psb_act_ret_) then -!!$ call psb_error() -!!$ end if -!!$ return -!!$ -!!$end subroutine psb_d_csr_cp_from -!!$ -!!$subroutine psb_d_csr_mv_from(a,b) -!!$ use psb_error_mod -!!$ use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_mv_from -!!$ implicit none -!!$ -!!$ class(psb_d_csr_sparse_mat), intent(inout) :: a -!!$ type(psb_d_csr_sparse_mat), intent(inout) :: b -!!$ -!!$ -!!$ integer(psb_ipk_) :: err_act, info -!!$ integer(psb_ipk_) :: ierr(5) -!!$ character(len=20) :: name='mv_from' -!!$ logical, parameter :: debug=.false. -!!$ -!!$ call psb_erractionsave(err_act) -!!$ info = psb_success_ -!!$ call a%psb_d_base_sparse_mat%mv_from(b%psb_d_base_sparse_mat) -!!$ call move_alloc(b%irp, a%irp) -!!$ call move_alloc(b%ja, a%ja) -!!$ call move_alloc(b%val, a%val) -!!$ call b%free() -!!$ -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 continue -!!$ call psb_erractionrestore(err_act) -!!$ -!!$ call psb_errpush(info,name) -!!$ -!!$ if (err_act /= psb_act_ret_) then -!!$ call psb_error() -!!$ end if -!!$ return -!!$ -!!$end subroutine psb_d_csr_mv_from -!!$ -!!$ diff --git a/base/serial/impl/psb_d_mat_impl.F90 b/base/serial/impl/psb_d_mat_impl.F90 index 6d90c18d..5c372645 100644 --- a/base/serial/impl/psb_d_mat_impl.F90 +++ b/base/serial/impl/psb_d_mat_impl.F90 @@ -1574,42 +1574,6 @@ subroutine psb_dspmat_clone(a,b,info) end subroutine psb_dspmat_clone -subroutine psb_dspmat_copy(a,b,info) - use psb_error_mod - use psb_string_mod - use psb_d_mat_mod, psb_protect_name => psb_dspmat_copy - implicit none - class(psb_dspmat_type), intent(inout) :: a - class(psb_dspmat_type), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - - integer(psb_ipk_) :: err_act - character(len=20) :: name='copy' - logical, parameter :: debug=.false. - - call psb_erractionsave(err_act) - info = psb_success_ - call b%free() - if (allocated(a%a)) then - call a%a%clone(b%a,info) - end if - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - -end subroutine psb_dspmat_copy - - - subroutine psb_d_transp_1mat(a) use psb_error_mod use psb_string_mod diff --git a/base/serial/impl/psb_s_base_mat_impl.F90 b/base/serial/impl/psb_s_base_mat_impl.F90 index 41901447..1483d9b9 100644 --- a/base/serial/impl/psb_s_base_mat_impl.F90 +++ b/base/serial/impl/psb_s_base_mat_impl.F90 @@ -606,43 +606,6 @@ subroutine psb_s_base_mold(a,b,info) end subroutine psb_s_base_mold -subroutine psb_s_base_copy(a,b,info) - use psb_s_base_mat_mod, psb_protect_name => psb_s_base_copy - use psb_error_mod - implicit none - class(psb_s_base_sparse_mat), intent(in) :: a - class(psb_s_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='base_copy' - logical, parameter :: debug=.false. - - call psb_get_erraction(err_act) - ! This is the base version. If we get here - ! it means the derived class is incomplete, - ! so we throw an error. - info = 0 - - call a%psb_base_sparse_mat%copy(b%psb_base_sparse_mat,info) - - if (info /= 0) then - info = psb_err_internal_error_ - call psb_errpush(info,name) - goto 9999 - end if - call psb_erractionrestore(err_act) - - return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if - - return - -end subroutine psb_s_base_copy - subroutine psb_s_base_transp_2mat(a,b) use psb_s_base_mat_mod, psb_protect_name => psb_s_base_transp_2mat use psb_error_mod diff --git a/base/serial/impl/psb_s_coo_impl.f90 b/base/serial/impl/psb_s_coo_impl.f90 index 6548b08c..c26eb9ab 100644 --- a/base/serial/impl/psb_s_coo_impl.f90 +++ b/base/serial/impl/psb_s_coo_impl.f90 @@ -256,46 +256,6 @@ subroutine psb_s_coo_mold(a,b,info) end subroutine psb_s_coo_mold -subroutine psb_s_coo_copy(a,b,info) - use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_copy - use psb_error_mod - use psb_realloc_mod - implicit none - class(psb_s_coo_sparse_mat), intent(in) :: a - class(psb_s_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='coo_copy' - logical, parameter :: debug=.false. - - call psb_get_erraction(err_act) - - info = 0 - - select type(b) - type is (psb_s_coo_sparse_mat) - call a%psb_s_base_sparse_mat%copy(b%psb_s_base_sparse_mat,info) - if (info == 0) call psb_safe_cpy( a%ia, b%ia, info) - if (info == 0) call psb_safe_cpy( a%ja, b%ja, info) - if (info == 0) call psb_safe_cpy( a%val, b%val, info) - if (info == 0) call b%fix(info) - - if (info /= psb_success_) goto 9999 - class default - info = psb_err_internal_error_ - goto 9999 - end select - - return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - -end subroutine psb_s_coo_copy - subroutine psb_s_coo_reinit(a,clear) use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_reinit use psb_error_mod @@ -2964,7 +2924,7 @@ subroutine psb_s_cp_coo_to_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - call a%psb_s_base_sparse_mat%copy(b%psb_s_base_sparse_mat,info) + b%psb_s_base_sparse_mat = a%psb_s_base_sparse_mat nz = a%get_nzeros() call b%set_nzeros(nz) @@ -3010,7 +2970,7 @@ subroutine psb_s_cp_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - call b%psb_s_base_sparse_mat%copy(a%psb_s_base_sparse_mat,info) + a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat nz = b%get_nzeros() call a%set_nzeros(nz) @@ -3130,7 +3090,7 @@ subroutine psb_s_mv_coo_to_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - call a%psb_s_base_sparse_mat%copy(b%psb_s_base_sparse_mat, info) + b%psb_s_base_sparse_mat = a%psb_s_base_sparse_mat call b%set_nzeros(a%get_nzeros()) call b%reallocate(a%get_nzeros()) @@ -3175,7 +3135,7 @@ subroutine psb_s_mv_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - call b%psb_s_base_sparse_mat%copy(a%psb_s_base_sparse_mat, info) + a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat call a%set_nzeros(b%get_nzeros()) call a%reallocate(b%get_nzeros()) diff --git a/base/serial/impl/psb_s_csc_impl.f90 b/base/serial/impl/psb_s_csc_impl.f90 index eecf1739..5c9e977e 100644 --- a/base/serial/impl/psb_s_csc_impl.f90 +++ b/base/serial/impl/psb_s_csc_impl.f90 @@ -2263,7 +2263,7 @@ subroutine psb_s_cp_csc_to_coo(a,b,info) nza = a%get_nzeros() call b%allocate(nr,nc,nza) - call a%psb_s_base_sparse_mat%copy(b%psb_s_base_sparse_mat, info) + b%psb_s_base_sparse_mat = a%psb_s_base_sparse_mat do i=1, nc do j=a%icp(i),a%icp(i+1)-1 @@ -2305,7 +2305,7 @@ subroutine psb_s_mv_csc_to_coo(a,b,info) nc = a%get_ncols() nza = a%get_nzeros() - call a%psb_s_base_sparse_mat%copy(b%psb_s_base_sparse_mat, info) + b%psb_s_base_sparse_mat = a%psb_s_base_sparse_mat call b%set_nzeros(a%get_nzeros()) call move_alloc(a%ia,b%ia) call move_alloc(a%val,b%val) @@ -2355,7 +2355,7 @@ subroutine psb_s_mv_csc_from_coo(a,b,info) nc = b%get_ncols() nza = b%get_nzeros() - call b%psb_s_base_sparse_mat%copy(a%psb_s_base_sparse_mat, info) + a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat ! Dirty trick: call move_alloc to have the new data allocated just once. call move_alloc(b%ja,itemp) @@ -2443,7 +2443,7 @@ subroutine psb_s_mv_csc_to_fmt(a,b,info) call a%mv_to_coo(b,info) ! Need to fix trivial copies! type is (psb_s_csc_sparse_mat) - call a%psb_s_base_sparse_mat%copy(b%psb_s_base_sparse_mat, info) + b%psb_s_base_sparse_mat = a%psb_s_base_sparse_mat call move_alloc(a%icp, b%icp) call move_alloc(a%ia, b%ia) call move_alloc(a%val, b%val) @@ -2484,7 +2484,7 @@ subroutine psb_s_cp_csc_to_fmt(a,b,info) call a%cp_to_coo(b,info) type is (psb_s_csc_sparse_mat) - call a%psb_s_base_sparse_mat%copy(b%psb_s_base_sparse_mat,info) + b%psb_s_base_sparse_mat = a%psb_s_base_sparse_mat if (info == 0) call psb_safe_cpy( a%icp, b%icp , info) if (info == 0) call psb_safe_cpy( a%ia , b%ia , info) if (info == 0) call psb_safe_cpy( a%val, b%val , info) @@ -2523,7 +2523,7 @@ subroutine psb_s_mv_csc_from_fmt(a,b,info) call a%mv_from_coo(b,info) type is (psb_s_csc_sparse_mat) - call b%psb_s_base_sparse_mat%copy(a%psb_s_base_sparse_mat, info) + a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat call move_alloc(b%icp, a%icp) call move_alloc(b%ia, a%ia) call move_alloc(b%val, a%val) @@ -2564,7 +2564,7 @@ subroutine psb_s_cp_csc_from_fmt(a,b,info) call a%cp_from_coo(b,info) type is (psb_s_csc_sparse_mat) - call b%psb_s_base_sparse_mat%copy(a%psb_s_base_sparse_mat, info) + a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat if (info == 0) call psb_safe_cpy( b%icp, a%icp , info) if (info == 0) call psb_safe_cpy( b%ia , a%ia , info) if (info == 0) call psb_safe_cpy( b%val, a%val , info) @@ -2612,45 +2612,6 @@ subroutine psb_s_csc_mold(a,b,info) end subroutine psb_s_csc_mold -subroutine psb_s_csc_copy(a,b,info) - use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_copy - use psb_error_mod - use psb_realloc_mod - implicit none - class(psb_s_csc_sparse_mat), intent(in) :: a - class(psb_s_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='csc_copy' - logical, parameter :: debug=.false. - - call psb_get_erraction(err_act) - - info = 0 - - select type(b) - type is (psb_s_csc_sparse_mat) - call a%psb_s_base_sparse_mat%copy(b%psb_s_base_sparse_mat, info) - if (info == 0) call psb_safe_cpy( a%icp, b%icp , info) - if (info == 0) call psb_safe_cpy( a%ia , b%ia , info) - if (info == 0) call psb_safe_cpy( a%val, b%val , info) - if (info /= psb_success_) goto 9999 - - class default - info = psb_err_internal_error_ - goto 9999 - end select - - return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - -end subroutine psb_s_csc_copy - subroutine psb_s_csc_reallocate_nz(nz,a) use psb_error_mod use psb_realloc_mod @@ -2974,83 +2935,3 @@ subroutine psb_s_csc_print(iout,a,iv,head,ivr,ivc) end subroutine psb_s_csc_print -!!$subroutine psb_s_csc_cp_from(a,b) -!!$ use psb_error_mod -!!$ use psb_realloc_mod -!!$ use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_cp_from -!!$ implicit none -!!$ -!!$ class(psb_s_csc_sparse_mat), intent(inout) :: a -!!$ type(psb_s_csc_sparse_mat), intent(in) :: b -!!$ -!!$ -!!$ integer(psb_ipk_) :: err_act, info -!!$ integer(psb_ipk_) :: ierr(5) -!!$ character(len=20) :: name='cp_from' -!!$ logical, parameter :: debug=.false. -!!$ -!!$ call psb_erractionsave(err_act) -!!$ -!!$ info = psb_success_ -!!$ -!!$ call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros()) -!!$ call b%psb_s_base_sparse_mat%copy(a%psb_s_base_sparse_mat, info) -!!$ if (info == 0) call psb_safe_cpy( b%icp, a%icp , info) -!!$ if (info == 0) call psb_safe_cpy( b%ia , a%ia , info) -!!$ if (info == 0) call psb_safe_cpy( b%val, a%val , info) -!!$ -!!$ if (info /= psb_success_) goto 9999 -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 continue -!!$ call psb_erractionrestore(err_act) -!!$ -!!$ call psb_errpush(info,name) -!!$ -!!$ if (err_act /= psb_act_ret_) then -!!$ call psb_error() -!!$ end if -!!$ return -!!$ -!!$end subroutine psb_s_csc_cp_from -!!$ -!!$subroutine psb_s_csc_mv_from(a,b) -!!$ use psb_error_mod -!!$ use psb_s_csc_mat_mod, psb_protect_name => psb_s_csc_mv_from -!!$ implicit none -!!$ -!!$ class(psb_s_csc_sparse_mat), intent(inout) :: a -!!$ type(psb_s_csc_sparse_mat), intent(inout) :: b -!!$ -!!$ -!!$ integer(psb_ipk_) :: err_act, info -!!$ integer(psb_ipk_) :: ierr(5) -!!$ character(len=20) :: name='mv_from' -!!$ logical, parameter :: debug=.false. -!!$ -!!$ call psb_erractionsave(err_act) -!!$ info = psb_success_ -!!$ call b%psb_s_base_sparse_mat%copy(a%psb_s_base_sparse_mat, info) -!!$ if (info == 0) call move_alloc(b%icp, a%icp) -!!$ if (info == 0) call move_alloc(b%ia, a%ia) -!!$ if (info == 0) call move_alloc(b%val, a%val) -!!$ call b%free() -!!$ -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 continue -!!$ call psb_erractionrestore(err_act) -!!$ -!!$ call psb_errpush(info,name) -!!$ -!!$ if (err_act /= psb_act_ret_) then -!!$ call psb_error() -!!$ end if -!!$ return -!!$ -!!$end subroutine psb_s_csc_mv_from -!!$ - - diff --git a/base/serial/impl/psb_s_csr_impl.f90 b/base/serial/impl/psb_s_csr_impl.f90 index 70f38297..0088fead 100644 --- a/base/serial/impl/psb_s_csr_impl.f90 +++ b/base/serial/impl/psb_s_csr_impl.f90 @@ -1816,45 +1816,6 @@ subroutine psb_s_csr_mold(a,b,info) end subroutine psb_s_csr_mold -subroutine psb_s_csr_copy(a,b,info) - use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_copy - use psb_error_mod - use psb_realloc_mod - implicit none - class(psb_s_csr_sparse_mat), intent(in) :: a - class(psb_s_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='csr_copy' - logical, parameter :: debug=.false. - - call psb_get_erraction(err_act) - - info = 0 - - select type(b) - type is (psb_s_csr_sparse_mat) - call a%psb_s_base_sparse_mat%copy(b%psb_s_base_sparse_mat, info) - if (info == 0) call psb_safe_cpy( a%irp, b%irp , info) - if (info == 0) call psb_safe_cpy( a%ja , b%ja , info) - if (info == 0) call psb_safe_cpy( a%val, b%val , info) - if (info /= psb_success_) goto 9999 - - class default - info = psb_err_internal_error_ - goto 9999 - end select - - return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - -end subroutine psb_s_csr_copy - subroutine psb_s_csr_allocate_mnnz(m,n,a,nz) use psb_error_mod use psb_realloc_mod @@ -2843,7 +2804,7 @@ subroutine psb_s_cp_csr_to_coo(a,b,info) nza = a%get_nzeros() call b%allocate(nr,nc,nza) - call a%psb_s_base_sparse_mat%copy(b%psb_s_base_sparse_mat, info) + b%psb_s_base_sparse_mat = a%psb_s_base_sparse_mat do i=1, nr do j=a%irp(i),a%irp(i+1)-1 @@ -2884,7 +2845,7 @@ subroutine psb_s_mv_csr_to_coo(a,b,info) nc = a%get_ncols() nza = a%get_nzeros() - call a%psb_s_base_sparse_mat%copy(b%psb_s_base_sparse_mat, info) + b%psb_s_base_sparse_mat = a%psb_s_base_sparse_mat call b%set_nzeros(a%get_nzeros()) call move_alloc(a%ja,b%ja) call move_alloc(a%val,b%val) @@ -2935,7 +2896,7 @@ subroutine psb_s_mv_csr_from_coo(a,b,info) nc = b%get_ncols() nza = b%get_nzeros() - call b%psb_s_base_sparse_mat%copy(a%psb_s_base_sparse_mat, info) + a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat ! Dirty trick: call move_alloc to have the new data allocated just once. call move_alloc(b%ia,itemp) @@ -3022,7 +2983,7 @@ subroutine psb_s_mv_csr_to_fmt(a,b,info) call a%mv_to_coo(b,info) ! Need to fix trivial copies! type is (psb_s_csr_sparse_mat) - call a%psb_s_base_sparse_mat%copy(b%psb_s_base_sparse_mat, info) + b%psb_s_base_sparse_mat = a%psb_s_base_sparse_mat call move_alloc(a%irp, b%irp) call move_alloc(a%ja, b%ja) call move_alloc(a%val, b%val) @@ -3063,7 +3024,7 @@ subroutine psb_s_cp_csr_to_fmt(a,b,info) call a%cp_to_coo(b,info) type is (psb_s_csr_sparse_mat) - call a%psb_s_base_sparse_mat%copy(b%psb_s_base_sparse_mat, info) + b%psb_s_base_sparse_mat = a%psb_s_base_sparse_mat if (info == 0) call psb_safe_cpy( a%irp, b%irp , info) if (info == 0) call psb_safe_cpy( a%ja , b%ja , info) if (info == 0) call psb_safe_cpy( a%val, b%val , info) @@ -3101,7 +3062,7 @@ subroutine psb_s_mv_csr_from_fmt(a,b,info) call a%mv_from_coo(b,info) type is (psb_s_csr_sparse_mat) - call b%psb_s_base_sparse_mat%copy(a%psb_s_base_sparse_mat, info) + a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat call move_alloc(b%irp, a%irp) call move_alloc(b%ja, a%ja) call move_alloc(b%val, a%val) @@ -3142,7 +3103,7 @@ subroutine psb_s_cp_csr_from_fmt(a,b,info) call a%cp_from_coo(b,info) type is (psb_s_csr_sparse_mat) - call b%psb_s_base_sparse_mat%copy(a%psb_s_base_sparse_mat, info) + a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat if (info == 0) call psb_safe_cpy( b%irp, a%irp , info) if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) if (info == 0) call psb_safe_cpy( b%val, a%val , info) @@ -3152,84 +3113,3 @@ subroutine psb_s_cp_csr_from_fmt(a,b,info) if (info == psb_success_) call a%mv_from_coo(tmp,info) end select end subroutine psb_s_cp_csr_from_fmt - -!!$ -!!$subroutine psb_s_csr_cp_from(a,b) -!!$ use psb_error_mod -!!$ use psb_realloc_mod -!!$ use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_cp_from -!!$ implicit none -!!$ -!!$ class(psb_s_csr_sparse_mat), intent(inout) :: a -!!$ type(psb_s_csr_sparse_mat), intent(in) :: b -!!$ -!!$ -!!$ integer(psb_ipk_) :: err_act, info -!!$ integer(psb_ipk_) :: ierr(5) -!!$ character(len=20) :: name='cp_from' -!!$ logical, parameter :: debug=.false. -!!$ -!!$ call psb_erractionsave(err_act) -!!$ -!!$ info = psb_success_ -!!$ -!!$ call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros()) -!!$ call b%psb_s_base_sparse_mat%copy(a%psb_s_base_sparse_mat, info) -!!$ if (info == 0) call psb_safe_cpy( b%irp, a%irp , info) -!!$ if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) -!!$ if (info == 0) call psb_safe_cpy( b%val, a%val , info) -!!$ -!!$ if (info /= psb_success_) goto 9999 -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 continue -!!$ call psb_erractionrestore(err_act) -!!$ -!!$ call psb_errpush(info,name) -!!$ -!!$ if (err_act /= psb_act_ret_) then -!!$ call psb_error() -!!$ end if -!!$ return -!!$ -!!$end subroutine psb_s_csr_cp_from -!!$ -!!$subroutine psb_s_csr_mv_from(a,b) -!!$ use psb_error_mod -!!$ use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_mv_from -!!$ implicit none -!!$ -!!$ class(psb_s_csr_sparse_mat), intent(inout) :: a -!!$ type(psb_s_csr_sparse_mat), intent(inout) :: b -!!$ -!!$ -!!$ integer(psb_ipk_) :: err_act, info -!!$ integer(psb_ipk_) :: ierr(5) -!!$ character(len=20) :: name='mv_from' -!!$ logical, parameter :: debug=.false. -!!$ -!!$ call psb_erractionsave(err_act) -!!$ info = psb_success_ -!!$ call a%psb_s_base_sparse_mat%mv_from(b%psb_s_base_sparse_mat) -!!$ call move_alloc(b%irp, a%irp) -!!$ call move_alloc(b%ja, a%ja) -!!$ call move_alloc(b%val, a%val) -!!$ call b%free() -!!$ -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 continue -!!$ call psb_erractionrestore(err_act) -!!$ -!!$ call psb_errpush(info,name) -!!$ -!!$ if (err_act /= psb_act_ret_) then -!!$ call psb_error() -!!$ end if -!!$ return -!!$ -!!$end subroutine psb_s_csr_mv_from -!!$ -!!$ diff --git a/base/serial/impl/psb_s_mat_impl.F90 b/base/serial/impl/psb_s_mat_impl.F90 index f93747aa..f0b4a955 100644 --- a/base/serial/impl/psb_s_mat_impl.F90 +++ b/base/serial/impl/psb_s_mat_impl.F90 @@ -1574,42 +1574,6 @@ subroutine psb_sspmat_clone(a,b,info) end subroutine psb_sspmat_clone -subroutine psb_sspmat_copy(a,b,info) - use psb_error_mod - use psb_string_mod - use psb_s_mat_mod, psb_protect_name => psb_sspmat_copy - implicit none - class(psb_sspmat_type), intent(inout) :: a - class(psb_sspmat_type), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - - integer(psb_ipk_) :: err_act - character(len=20) :: name='copy' - logical, parameter :: debug=.false. - - call psb_erractionsave(err_act) - info = psb_success_ - call b%free() - if (allocated(a%a)) then - call a%a%clone(b%a,info) - end if - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - -end subroutine psb_sspmat_copy - - - subroutine psb_s_transp_1mat(a) use psb_error_mod use psb_string_mod diff --git a/base/serial/impl/psb_z_base_mat_impl.F90 b/base/serial/impl/psb_z_base_mat_impl.F90 index 8169c9d8..cb615459 100644 --- a/base/serial/impl/psb_z_base_mat_impl.F90 +++ b/base/serial/impl/psb_z_base_mat_impl.F90 @@ -606,43 +606,6 @@ subroutine psb_z_base_mold(a,b,info) end subroutine psb_z_base_mold -subroutine psb_z_base_copy(a,b,info) - use psb_z_base_mat_mod, psb_protect_name => psb_z_base_copy - use psb_error_mod - implicit none - class(psb_z_base_sparse_mat), intent(in) :: a - class(psb_z_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='base_copy' - logical, parameter :: debug=.false. - - call psb_get_erraction(err_act) - ! This is the base version. If we get here - ! it means the derived class is incomplete, - ! so we throw an error. - info = 0 - - call a%psb_base_sparse_mat%copy(b%psb_base_sparse_mat,info) - - if (info /= 0) then - info = psb_err_internal_error_ - call psb_errpush(info,name) - goto 9999 - end if - call psb_erractionrestore(err_act) - - return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if - - return - -end subroutine psb_z_base_copy - subroutine psb_z_base_transp_2mat(a,b) use psb_z_base_mat_mod, psb_protect_name => psb_z_base_transp_2mat use psb_error_mod diff --git a/base/serial/impl/psb_z_coo_impl.f90 b/base/serial/impl/psb_z_coo_impl.f90 index 305203de..e43f52dd 100644 --- a/base/serial/impl/psb_z_coo_impl.f90 +++ b/base/serial/impl/psb_z_coo_impl.f90 @@ -256,46 +256,6 @@ subroutine psb_z_coo_mold(a,b,info) end subroutine psb_z_coo_mold -subroutine psb_z_coo_copy(a,b,info) - use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_copy - use psb_error_mod - use psb_realloc_mod - implicit none - class(psb_z_coo_sparse_mat), intent(in) :: a - class(psb_z_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='coo_copy' - logical, parameter :: debug=.false. - - call psb_get_erraction(err_act) - - info = 0 - - select type(b) - type is (psb_z_coo_sparse_mat) - call a%psb_z_base_sparse_mat%copy(b%psb_z_base_sparse_mat,info) - if (info == 0) call psb_safe_cpy( a%ia, b%ia, info) - if (info == 0) call psb_safe_cpy( a%ja, b%ja, info) - if (info == 0) call psb_safe_cpy( a%val, b%val, info) - if (info == 0) call b%fix(info) - - if (info /= psb_success_) goto 9999 - class default - info = psb_err_internal_error_ - goto 9999 - end select - - return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - -end subroutine psb_z_coo_copy - subroutine psb_z_coo_reinit(a,clear) use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_reinit use psb_error_mod @@ -2964,7 +2924,7 @@ subroutine psb_z_cp_coo_to_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - call a%psb_z_base_sparse_mat%copy(b%psb_z_base_sparse_mat,info) + b%psb_z_base_sparse_mat = a%psb_z_base_sparse_mat nz = a%get_nzeros() call b%set_nzeros(nz) @@ -3010,7 +2970,7 @@ subroutine psb_z_cp_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - call b%psb_z_base_sparse_mat%copy(a%psb_z_base_sparse_mat,info) + a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat nz = b%get_nzeros() call a%set_nzeros(nz) @@ -3130,7 +3090,7 @@ subroutine psb_z_mv_coo_to_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - call a%psb_z_base_sparse_mat%copy(b%psb_z_base_sparse_mat, info) + b%psb_z_base_sparse_mat = a%psb_z_base_sparse_mat call b%set_nzeros(a%get_nzeros()) call b%reallocate(a%get_nzeros()) @@ -3175,7 +3135,7 @@ subroutine psb_z_mv_coo_from_coo(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - call b%psb_z_base_sparse_mat%copy(a%psb_z_base_sparse_mat, info) + a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat call a%set_nzeros(b%get_nzeros()) call a%reallocate(b%get_nzeros()) diff --git a/base/serial/impl/psb_z_csc_impl.f90 b/base/serial/impl/psb_z_csc_impl.f90 index 2b45e23d..40a267fe 100644 --- a/base/serial/impl/psb_z_csc_impl.f90 +++ b/base/serial/impl/psb_z_csc_impl.f90 @@ -2263,7 +2263,7 @@ subroutine psb_z_cp_csc_to_coo(a,b,info) nza = a%get_nzeros() call b%allocate(nr,nc,nza) - call a%psb_z_base_sparse_mat%copy(b%psb_z_base_sparse_mat, info) + b%psb_z_base_sparse_mat = a%psb_z_base_sparse_mat do i=1, nc do j=a%icp(i),a%icp(i+1)-1 @@ -2305,7 +2305,7 @@ subroutine psb_z_mv_csc_to_coo(a,b,info) nc = a%get_ncols() nza = a%get_nzeros() - call a%psb_z_base_sparse_mat%copy(b%psb_z_base_sparse_mat, info) + b%psb_z_base_sparse_mat = a%psb_z_base_sparse_mat call b%set_nzeros(a%get_nzeros()) call move_alloc(a%ia,b%ia) call move_alloc(a%val,b%val) @@ -2355,7 +2355,7 @@ subroutine psb_z_mv_csc_from_coo(a,b,info) nc = b%get_ncols() nza = b%get_nzeros() - call b%psb_z_base_sparse_mat%copy(a%psb_z_base_sparse_mat, info) + a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat ! Dirty trick: call move_alloc to have the new data allocated just once. call move_alloc(b%ja,itemp) @@ -2443,7 +2443,7 @@ subroutine psb_z_mv_csc_to_fmt(a,b,info) call a%mv_to_coo(b,info) ! Need to fix trivial copies! type is (psb_z_csc_sparse_mat) - call a%psb_z_base_sparse_mat%copy(b%psb_z_base_sparse_mat, info) + b%psb_z_base_sparse_mat = a%psb_z_base_sparse_mat call move_alloc(a%icp, b%icp) call move_alloc(a%ia, b%ia) call move_alloc(a%val, b%val) @@ -2484,7 +2484,7 @@ subroutine psb_z_cp_csc_to_fmt(a,b,info) call a%cp_to_coo(b,info) type is (psb_z_csc_sparse_mat) - call a%psb_z_base_sparse_mat%copy(b%psb_z_base_sparse_mat,info) + b%psb_z_base_sparse_mat = a%psb_z_base_sparse_mat if (info == 0) call psb_safe_cpy( a%icp, b%icp , info) if (info == 0) call psb_safe_cpy( a%ia , b%ia , info) if (info == 0) call psb_safe_cpy( a%val, b%val , info) @@ -2523,7 +2523,7 @@ subroutine psb_z_mv_csc_from_fmt(a,b,info) call a%mv_from_coo(b,info) type is (psb_z_csc_sparse_mat) - call b%psb_z_base_sparse_mat%copy(a%psb_z_base_sparse_mat, info) + a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat call move_alloc(b%icp, a%icp) call move_alloc(b%ia, a%ia) call move_alloc(b%val, a%val) @@ -2564,7 +2564,7 @@ subroutine psb_z_cp_csc_from_fmt(a,b,info) call a%cp_from_coo(b,info) type is (psb_z_csc_sparse_mat) - call b%psb_z_base_sparse_mat%copy(a%psb_z_base_sparse_mat, info) + a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat if (info == 0) call psb_safe_cpy( b%icp, a%icp , info) if (info == 0) call psb_safe_cpy( b%ia , a%ia , info) if (info == 0) call psb_safe_cpy( b%val, a%val , info) @@ -2612,45 +2612,6 @@ subroutine psb_z_csc_mold(a,b,info) end subroutine psb_z_csc_mold -subroutine psb_z_csc_copy(a,b,info) - use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_copy - use psb_error_mod - use psb_realloc_mod - implicit none - class(psb_z_csc_sparse_mat), intent(in) :: a - class(psb_z_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='csc_copy' - logical, parameter :: debug=.false. - - call psb_get_erraction(err_act) - - info = 0 - - select type(b) - type is (psb_z_csc_sparse_mat) - call a%psb_z_base_sparse_mat%copy(b%psb_z_base_sparse_mat, info) - if (info == 0) call psb_safe_cpy( a%icp, b%icp , info) - if (info == 0) call psb_safe_cpy( a%ia , b%ia , info) - if (info == 0) call psb_safe_cpy( a%val, b%val , info) - if (info /= psb_success_) goto 9999 - - class default - info = psb_err_internal_error_ - goto 9999 - end select - - return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - -end subroutine psb_z_csc_copy - subroutine psb_z_csc_reallocate_nz(nz,a) use psb_error_mod use psb_realloc_mod @@ -2974,83 +2935,3 @@ subroutine psb_z_csc_print(iout,a,iv,head,ivr,ivc) end subroutine psb_z_csc_print -!!$subroutine psb_z_csc_cp_from(a,b) -!!$ use psb_error_mod -!!$ use psb_realloc_mod -!!$ use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_cp_from -!!$ implicit none -!!$ -!!$ class(psb_z_csc_sparse_mat), intent(inout) :: a -!!$ type(psb_z_csc_sparse_mat), intent(in) :: b -!!$ -!!$ -!!$ integer(psb_ipk_) :: err_act, info -!!$ integer(psb_ipk_) :: ierr(5) -!!$ character(len=20) :: name='cp_from' -!!$ logical, parameter :: debug=.false. -!!$ -!!$ call psb_erractionsave(err_act) -!!$ -!!$ info = psb_success_ -!!$ -!!$ call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros()) -!!$ call b%psb_z_base_sparse_mat%copy(a%psb_z_base_sparse_mat, info) -!!$ if (info == 0) call psb_safe_cpy( b%icp, a%icp , info) -!!$ if (info == 0) call psb_safe_cpy( b%ia , a%ia , info) -!!$ if (info == 0) call psb_safe_cpy( b%val, a%val , info) -!!$ -!!$ if (info /= psb_success_) goto 9999 -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 continue -!!$ call psb_erractionrestore(err_act) -!!$ -!!$ call psb_errpush(info,name) -!!$ -!!$ if (err_act /= psb_act_ret_) then -!!$ call psb_error() -!!$ end if -!!$ return -!!$ -!!$end subroutine psb_z_csc_cp_from -!!$ -!!$subroutine psb_z_csc_mv_from(a,b) -!!$ use psb_error_mod -!!$ use psb_z_csc_mat_mod, psb_protect_name => psb_z_csc_mv_from -!!$ implicit none -!!$ -!!$ class(psb_z_csc_sparse_mat), intent(inout) :: a -!!$ type(psb_z_csc_sparse_mat), intent(inout) :: b -!!$ -!!$ -!!$ integer(psb_ipk_) :: err_act, info -!!$ integer(psb_ipk_) :: ierr(5) -!!$ character(len=20) :: name='mv_from' -!!$ logical, parameter :: debug=.false. -!!$ -!!$ call psb_erractionsave(err_act) -!!$ info = psb_success_ -!!$ call b%psb_z_base_sparse_mat%copy(a%psb_z_base_sparse_mat, info) -!!$ if (info == 0) call move_alloc(b%icp, a%icp) -!!$ if (info == 0) call move_alloc(b%ia, a%ia) -!!$ if (info == 0) call move_alloc(b%val, a%val) -!!$ call b%free() -!!$ -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 continue -!!$ call psb_erractionrestore(err_act) -!!$ -!!$ call psb_errpush(info,name) -!!$ -!!$ if (err_act /= psb_act_ret_) then -!!$ call psb_error() -!!$ end if -!!$ return -!!$ -!!$end subroutine psb_z_csc_mv_from -!!$ - - diff --git a/base/serial/impl/psb_z_csr_impl.f90 b/base/serial/impl/psb_z_csr_impl.f90 index 46f3b5dc..65d5fcac 100644 --- a/base/serial/impl/psb_z_csr_impl.f90 +++ b/base/serial/impl/psb_z_csr_impl.f90 @@ -1816,45 +1816,6 @@ subroutine psb_z_csr_mold(a,b,info) end subroutine psb_z_csr_mold -subroutine psb_z_csr_copy(a,b,info) - use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_copy - use psb_error_mod - use psb_realloc_mod - implicit none - class(psb_z_csr_sparse_mat), intent(in) :: a - class(psb_z_base_sparse_mat), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) - character(len=20) :: name='csr_copy' - logical, parameter :: debug=.false. - - call psb_get_erraction(err_act) - - info = 0 - - select type(b) - type is (psb_z_csr_sparse_mat) - call a%psb_z_base_sparse_mat%copy(b%psb_z_base_sparse_mat, info) - if (info == 0) call psb_safe_cpy( a%irp, b%irp , info) - if (info == 0) call psb_safe_cpy( a%ja , b%ja , info) - if (info == 0) call psb_safe_cpy( a%val, b%val , info) - if (info /= psb_success_) goto 9999 - - class default - info = psb_err_internal_error_ - goto 9999 - end select - - return -9999 continue - if (err_act /= psb_act_ret_) then - call psb_error() - end if - return - -end subroutine psb_z_csr_copy - subroutine psb_z_csr_allocate_mnnz(m,n,a,nz) use psb_error_mod use psb_realloc_mod @@ -2843,7 +2804,7 @@ subroutine psb_z_cp_csr_to_coo(a,b,info) nza = a%get_nzeros() call b%allocate(nr,nc,nza) - call a%psb_z_base_sparse_mat%copy(b%psb_z_base_sparse_mat, info) + b%psb_z_base_sparse_mat = a%psb_z_base_sparse_mat do i=1, nr do j=a%irp(i),a%irp(i+1)-1 @@ -2884,7 +2845,7 @@ subroutine psb_z_mv_csr_to_coo(a,b,info) nc = a%get_ncols() nza = a%get_nzeros() - call a%psb_z_base_sparse_mat%copy(b%psb_z_base_sparse_mat, info) + b%psb_z_base_sparse_mat = a%psb_z_base_sparse_mat call b%set_nzeros(a%get_nzeros()) call move_alloc(a%ja,b%ja) call move_alloc(a%val,b%val) @@ -2935,7 +2896,7 @@ subroutine psb_z_mv_csr_from_coo(a,b,info) nc = b%get_ncols() nza = b%get_nzeros() - call b%psb_z_base_sparse_mat%copy(a%psb_z_base_sparse_mat, info) + a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat ! Dirty trick: call move_alloc to have the new data allocated just once. call move_alloc(b%ia,itemp) @@ -3022,7 +2983,7 @@ subroutine psb_z_mv_csr_to_fmt(a,b,info) call a%mv_to_coo(b,info) ! Need to fix trivial copies! type is (psb_z_csr_sparse_mat) - call a%psb_z_base_sparse_mat%copy(b%psb_z_base_sparse_mat, info) + b%psb_z_base_sparse_mat = a%psb_z_base_sparse_mat call move_alloc(a%irp, b%irp) call move_alloc(a%ja, b%ja) call move_alloc(a%val, b%val) @@ -3063,7 +3024,7 @@ subroutine psb_z_cp_csr_to_fmt(a,b,info) call a%cp_to_coo(b,info) type is (psb_z_csr_sparse_mat) - call a%psb_z_base_sparse_mat%copy(b%psb_z_base_sparse_mat, info) + b%psb_z_base_sparse_mat = a%psb_z_base_sparse_mat if (info == 0) call psb_safe_cpy( a%irp, b%irp , info) if (info == 0) call psb_safe_cpy( a%ja , b%ja , info) if (info == 0) call psb_safe_cpy( a%val, b%val , info) @@ -3101,7 +3062,7 @@ subroutine psb_z_mv_csr_from_fmt(a,b,info) call a%mv_from_coo(b,info) type is (psb_z_csr_sparse_mat) - call b%psb_z_base_sparse_mat%copy(a%psb_z_base_sparse_mat, info) + a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat call move_alloc(b%irp, a%irp) call move_alloc(b%ja, a%ja) call move_alloc(b%val, a%val) @@ -3142,7 +3103,7 @@ subroutine psb_z_cp_csr_from_fmt(a,b,info) call a%cp_from_coo(b,info) type is (psb_z_csr_sparse_mat) - call b%psb_z_base_sparse_mat%copy(a%psb_z_base_sparse_mat, info) + a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat if (info == 0) call psb_safe_cpy( b%irp, a%irp , info) if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) if (info == 0) call psb_safe_cpy( b%val, a%val , info) @@ -3152,84 +3113,3 @@ subroutine psb_z_cp_csr_from_fmt(a,b,info) if (info == psb_success_) call a%mv_from_coo(tmp,info) end select end subroutine psb_z_cp_csr_from_fmt - -!!$ -!!$subroutine psb_z_csr_cp_from(a,b) -!!$ use psb_error_mod -!!$ use psb_realloc_mod -!!$ use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_cp_from -!!$ implicit none -!!$ -!!$ class(psb_z_csr_sparse_mat), intent(inout) :: a -!!$ type(psb_z_csr_sparse_mat), intent(in) :: b -!!$ -!!$ -!!$ integer(psb_ipk_) :: err_act, info -!!$ integer(psb_ipk_) :: ierr(5) -!!$ character(len=20) :: name='cp_from' -!!$ logical, parameter :: debug=.false. -!!$ -!!$ call psb_erractionsave(err_act) -!!$ -!!$ info = psb_success_ -!!$ -!!$ call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros()) -!!$ call b%psb_z_base_sparse_mat%copy(a%psb_z_base_sparse_mat, info) -!!$ if (info == 0) call psb_safe_cpy( b%irp, a%irp , info) -!!$ if (info == 0) call psb_safe_cpy( b%ja , a%ja , info) -!!$ if (info == 0) call psb_safe_cpy( b%val, a%val , info) -!!$ -!!$ if (info /= psb_success_) goto 9999 -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 continue -!!$ call psb_erractionrestore(err_act) -!!$ -!!$ call psb_errpush(info,name) -!!$ -!!$ if (err_act /= psb_act_ret_) then -!!$ call psb_error() -!!$ end if -!!$ return -!!$ -!!$end subroutine psb_z_csr_cp_from -!!$ -!!$subroutine psb_z_csr_mv_from(a,b) -!!$ use psb_error_mod -!!$ use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_mv_from -!!$ implicit none -!!$ -!!$ class(psb_z_csr_sparse_mat), intent(inout) :: a -!!$ type(psb_z_csr_sparse_mat), intent(inout) :: b -!!$ -!!$ -!!$ integer(psb_ipk_) :: err_act, info -!!$ integer(psb_ipk_) :: ierr(5) -!!$ character(len=20) :: name='mv_from' -!!$ logical, parameter :: debug=.false. -!!$ -!!$ call psb_erractionsave(err_act) -!!$ info = psb_success_ -!!$ call a%psb_z_base_sparse_mat%mv_from(b%psb_z_base_sparse_mat) -!!$ call move_alloc(b%irp, a%irp) -!!$ call move_alloc(b%ja, a%ja) -!!$ call move_alloc(b%val, a%val) -!!$ call b%free() -!!$ -!!$ call psb_erractionrestore(err_act) -!!$ return -!!$ -!!$9999 continue -!!$ call psb_erractionrestore(err_act) -!!$ -!!$ call psb_errpush(info,name) -!!$ -!!$ if (err_act /= psb_act_ret_) then -!!$ call psb_error() -!!$ end if -!!$ return -!!$ -!!$end subroutine psb_z_csr_mv_from -!!$ -!!$ diff --git a/base/serial/impl/psb_z_mat_impl.F90 b/base/serial/impl/psb_z_mat_impl.F90 index f308e468..f5938450 100644 --- a/base/serial/impl/psb_z_mat_impl.F90 +++ b/base/serial/impl/psb_z_mat_impl.F90 @@ -1574,42 +1574,6 @@ subroutine psb_zspmat_clone(a,b,info) end subroutine psb_zspmat_clone -subroutine psb_zspmat_copy(a,b,info) - use psb_error_mod - use psb_string_mod - use psb_z_mat_mod, psb_protect_name => psb_zspmat_copy - implicit none - class(psb_zspmat_type), intent(inout) :: a - class(psb_zspmat_type), intent(inout) :: b - integer(psb_ipk_), intent(out) :: info - - integer(psb_ipk_) :: err_act - character(len=20) :: name='copy' - logical, parameter :: debug=.false. - - call psb_erractionsave(err_act) - info = psb_success_ - call b%free() - if (allocated(a%a)) then - call a%a%clone(b%a,info) - end if - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - -end subroutine psb_zspmat_copy - - - subroutine psb_z_transp_1mat(a) use psb_error_mod use psb_string_mod