fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
base/modules/psb_base_mat_mod.f90
 base/modules/psb_c_base_mat_mod.f90
 base/modules/psb_c_csc_mat_mod.f90
 base/modules/psb_c_csr_mat_mod.f90
 base/modules/psb_c_mat_mod.f90
 base/modules/psb_d_base_mat_mod.f90
 base/modules/psb_d_csc_mat_mod.f90
 base/modules/psb_d_csr_mat_mod.f90
 base/modules/psb_d_mat_mod.f90
 base/modules/psb_s_base_mat_mod.f90
 base/modules/psb_s_csc_mat_mod.f90
 base/modules/psb_s_csr_mat_mod.f90
 base/modules/psb_s_mat_mod.f90
 base/modules/psb_z_base_mat_mod.f90
 base/modules/psb_z_csc_mat_mod.f90
 base/modules/psb_z_csr_mat_mod.f90
 base/modules/psb_z_mat_mod.f90
 base/serial/impl/psb_c_base_mat_impl.F90
 base/serial/impl/psb_c_coo_impl.f90
 base/serial/impl/psb_c_csc_impl.f90
 base/serial/impl/psb_c_csr_impl.f90
 base/serial/impl/psb_c_mat_impl.F90
 base/serial/impl/psb_d_base_mat_impl.F90
 base/serial/impl/psb_d_coo_impl.f90
 base/serial/impl/psb_d_csc_impl.f90
 base/serial/impl/psb_d_csr_impl.f90
 base/serial/impl/psb_d_mat_impl.F90
 base/serial/impl/psb_s_base_mat_impl.F90
 base/serial/impl/psb_s_coo_impl.f90
 base/serial/impl/psb_s_csc_impl.f90
 base/serial/impl/psb_s_csr_impl.f90
 base/serial/impl/psb_s_mat_impl.F90
 base/serial/impl/psb_z_base_mat_impl.F90
 base/serial/impl/psb_z_coo_impl.f90
 base/serial/impl/psb_z_csc_impl.f90
 base/serial/impl/psb_z_csr_impl.f90
 base/serial/impl/psb_z_mat_impl.F90

Fix interface and behaviour of _clone and friends.
psblas3-final
Salvatore Filippone 12 years ago
parent 0c06188538
commit 0dd65668b9
37 changed files with 72 additions and 1862 deletions
Show Stats Download Patch File Download Diff File

66
base/modules/psb_base_mat_mod.f90
Unescape Escape View File

@ -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

44
base/modules/psb_c_base_mat_mod.f90
Unescape Escape View File

@ -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.

13
base/modules/psb_c_csc_mat_mod.f90
Unescape Escape View File

@ -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

12
base/modules/psb_c_csr_mat_mod.f90
Unescape Escape View File

@ -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

10
base/modules/psb_c_mat_mod.f90
Unescape Escape View File

@ -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

44
base/modules/psb_d_base_mat_mod.f90
Unescape Escape View File

@ -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.

13
base/modules/psb_d_csc_mat_mod.f90
Unescape Escape View File

@ -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

12
base/modules/psb_d_csr_mat_mod.f90
Unescape Escape View File

@ -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

10
base/modules/psb_d_mat_mod.f90
Unescape Escape View File

@ -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

44
base/modules/psb_s_base_mat_mod.f90
Unescape Escape View File

@ -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.

13
base/modules/psb_s_csc_mat_mod.f90
Unescape Escape View File

@ -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

12
base/modules/psb_s_csr_mat_mod.f90
Unescape Escape View File

@ -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

10
base/modules/psb_s_mat_mod.f90
Unescape Escape View File

@ -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

44
base/modules/psb_z_base_mat_mod.f90
Unescape Escape View File

@ -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.

13
base/modules/psb_z_csc_mat_mod.f90
Unescape Escape View File

@ -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

12
base/modules/psb_z_csr_mat_mod.f90
Unescape Escape View File

@ -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

10
base/modules/psb_z_mat_mod.f90
Unescape Escape View File

@ -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

37
base/serial/impl/psb_c_base_mat_impl.F90
Unescape Escape View File

@ -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

48
base/serial/impl/psb_c_coo_impl.f90
Unescape Escape View File

@ -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())

133
base/serial/impl/psb_c_csc_impl.f90
Unescape Escape View File

@ -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
!!$

134
base/serial/impl/psb_c_csr_impl.f90
Unescape Escape View File

@ -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
!!$
!!$

36
base/serial/impl/psb_c_mat_impl.F90
Unescape Escape View File

@ -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

37
base/serial/impl/psb_d_base_mat_impl.F90
Unescape Escape View File

@ -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

48
base/serial/impl/psb_d_coo_impl.f90
Unescape Escape View File

@ -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())

133
base/serial/impl/psb_d_csc_impl.f90
Unescape Escape View File

@ -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
!!$

134
base/serial/impl/psb_d_csr_impl.f90
Unescape Escape View File

@ -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
!!$
!!$

36
base/serial/impl/psb_d_mat_impl.F90
Unescape Escape View File

@ -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

37
base/serial/impl/psb_s_base_mat_impl.F90
Unescape Escape View File

@ -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

48
base/serial/impl/psb_s_coo_impl.f90
Unescape Escape View File

@ -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())

133
base/serial/impl/psb_s_csc_impl.f90
Unescape Escape View File

@ -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
!!$

134
base/serial/impl/psb_s_csr_impl.f90
Unescape Escape View File

@ -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
!!$
!!$

36
base/serial/impl/psb_s_mat_impl.F90
Unescape Escape View File

@ -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

37
base/serial/impl/psb_z_base_mat_impl.F90
Unescape Escape View File

@ -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

48
base/serial/impl/psb_z_coo_impl.f90
Unescape Escape View File

@ -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())

133
base/serial/impl/psb_z_csc_impl.f90
Unescape Escape View File

@ -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
!!$

134
base/serial/impl/psb_z_csr_impl.f90
Unescape Escape View File

@ -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
!!$
!!$

36
base/serial/impl/psb_z_mat_impl.F90
Unescape Escape View File

@ -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

Write Preview
Loading…
Cancel
Save