mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-06 22:55:08 +00:00
Create ECSR format and use it for A%AND
This commit is contained in:
Salvatore Filippone
@@ -579,7 +579,111 @@ module psb_c_csr_mat_mod
|
||||
end subroutine psb_c_csr_scals
|
||||
end interface
|
||||
|
||||
!> \namespace psb_base_mod \class psb_lc_csr_sparse_mat
|
||||
|
||||
type, extends(psb_c_csr_sparse_mat) :: psb_c_ecsr_sparse_mat
|
||||
|
||||
!> Number of non-empty rows
|
||||
integer(psb_ipk_) :: nnerws
|
||||
!> Indices of non-empty rows
|
||||
integer(psb_ipk_), allocatable :: nerwp(:)
|
||||
|
||||
contains
|
||||
procedure, nopass :: get_fmt => c_ecsr_get_fmt
|
||||
|
||||
! procedure, pass(a) :: csmm => psb_c_ecsr_csmm
|
||||
procedure, pass(a) :: csmv => psb_c_ecsr_csmv
|
||||
|
||||
procedure, pass(a) :: cp_from_coo => psb_c_cp_ecsr_from_coo
|
||||
procedure, pass(a) :: cp_from_fmt => psb_c_cp_ecsr_from_fmt
|
||||
procedure, pass(a) :: mv_from_coo => psb_c_mv_ecsr_from_coo
|
||||
procedure, pass(a) :: mv_from_fmt => psb_c_mv_ecsr_from_fmt
|
||||
|
||||
procedure, pass(a) :: cmp_nerwp => psb_c_ecsr_cmp_nerwp
|
||||
procedure, pass(a) :: free => c_ecsr_free
|
||||
procedure, pass(a) :: mold => psb_c_ecsr_mold
|
||||
|
||||
end type psb_c_ecsr_sparse_mat
|
||||
!> \memberof psb_c_ecsr_sparse_mat
|
||||
!! \see psb_c_base_mat_mod::psb_c_base_csmv
|
||||
interface
|
||||
subroutine psb_c_ecsr_csmv(alpha,a,x,beta,y,info,trans)
|
||||
import
|
||||
class(psb_c_ecsr_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
|
||||
complex(psb_spk_), intent(inout) :: y(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
end subroutine psb_c_ecsr_csmv
|
||||
end interface
|
||||
|
||||
!> \memberof psb_c_ecsr_sparse_mat
|
||||
!! \see psb_c_base_mat_mod::psb_c_base_cp_from_coo
|
||||
interface
|
||||
subroutine psb_c_ecsr_cmp_nerwp(a,info)
|
||||
import
|
||||
class(psb_c_ecsr_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_c_ecsr_cmp_nerwp
|
||||
end interface
|
||||
|
||||
!> \memberof psb_c_ecsr_sparse_mat
|
||||
!! \see psb_c_base_mat_mod::psb_c_base_cp_from_coo
|
||||
interface
|
||||
subroutine psb_c_cp_ecsr_from_coo(a,b,info)
|
||||
import
|
||||
class(psb_c_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_c_cp_ecsr_from_coo
|
||||
end interface
|
||||
|
||||
!> \memberof psb_c_ecsr_sparse_mat
|
||||
!! \see psb_c_base_mat_mod::psb_c_base_cp_from_fmt
|
||||
interface
|
||||
subroutine psb_c_cp_ecsr_from_fmt(a,b,info)
|
||||
import
|
||||
class(psb_c_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_base_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_c_cp_ecsr_from_fmt
|
||||
end interface
|
||||
|
||||
!> \memberof psb_c_ecsr_sparse_mat
|
||||
!! \see psb_c_base_mat_mod::psb_c_base_mv_from_coo
|
||||
interface
|
||||
subroutine psb_c_mv_ecsr_from_coo(a,b,info)
|
||||
import
|
||||
class(psb_c_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_c_mv_ecsr_from_coo
|
||||
end interface
|
||||
|
||||
!> \memberof psb_c_ecsr_sparse_mat
|
||||
!! \see psb_c_base_mat_mod::psb_c_base_mv_from_fmt
|
||||
interface
|
||||
subroutine psb_c_mv_ecsr_from_fmt(a,b,info)
|
||||
import
|
||||
class(psb_c_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_c_mv_ecsr_from_fmt
|
||||
end interface
|
||||
|
||||
!> \memberof psb_c_ecsr_sparse_mat
|
||||
!| \see psb_base_mat_mod::psb_base_mold
|
||||
interface
|
||||
subroutine psb_c_ecsr_mold(a,b,info)
|
||||
import
|
||||
class(psb_c_ecsr_sparse_mat), intent(in) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout), allocatable :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_c_ecsr_mold
|
||||
end interface
|
||||
|
||||
|
||||
|
||||
!> \namespace psb_base_mod \class psb_lc_csr_sparse_mat
|
||||
!! \extends psb_lc_base_mat_mod::psb_lc_base_sparse_mat
|
||||
!!
|
||||
!! psb_lc_csr_sparse_mat type and the related methods.
|
||||
@@ -1178,6 +1282,26 @@ contains
|
||||
|
||||
|
||||
|
||||
function c_ecsr_get_fmt() result(res)
|
||||
implicit none
|
||||
character(len=5) :: res
|
||||
res = 'ECSR'
|
||||
end function c_ecsr_get_fmt
|
||||
|
||||
subroutine c_ecsr_free(a)
|
||||
implicit none
|
||||
|
||||
class(psb_c_ecsr_sparse_mat), intent(inout) :: a
|
||||
|
||||
|
||||
if (allocated(a%nerwp)) deallocate(a%nerwp)
|
||||
a%nnerws = 0
|
||||
call a%psb_c_csr_sparse_mat%free()
|
||||
|
||||
return
|
||||
end subroutine c_ecsr_free
|
||||
|
||||
|
||||
! == ===================================
|
||||
!
|
||||
!
|
||||
|
||||
@@ -79,7 +79,8 @@
|
||||
module psb_c_mat_mod
|
||||
|
||||
use psb_c_base_mat_mod
|
||||
use psb_c_csr_mat_mod, only : psb_c_csr_sparse_mat, psb_lc_csr_sparse_mat
|
||||
use psb_c_csr_mat_mod, only : psb_c_csr_sparse_mat, psb_lc_csr_sparse_mat,&
|
||||
& psb_c_ecsr_sparse_mat
|
||||
use psb_c_csc_mat_mod, only : psb_c_csc_sparse_mat, psb_lc_csc_sparse_mat
|
||||
|
||||
type :: psb_cspmat_type
|
||||
|
||||
@@ -579,7 +579,111 @@ module psb_d_csr_mat_mod
|
||||
end subroutine psb_d_csr_scals
|
||||
end interface
|
||||
|
||||
!> \namespace psb_base_mod \class psb_ld_csr_sparse_mat
|
||||
|
||||
type, extends(psb_d_csr_sparse_mat) :: psb_d_ecsr_sparse_mat
|
||||
|
||||
!> Number of non-empty rows
|
||||
integer(psb_ipk_) :: nnerws
|
||||
!> Indices of non-empty rows
|
||||
integer(psb_ipk_), allocatable :: nerwp(:)
|
||||
|
||||
contains
|
||||
procedure, nopass :: get_fmt => d_ecsr_get_fmt
|
||||
|
||||
! procedure, pass(a) :: csmm => psb_d_ecsr_csmm
|
||||
procedure, pass(a) :: csmv => psb_d_ecsr_csmv
|
||||
|
||||
procedure, pass(a) :: cp_from_coo => psb_d_cp_ecsr_from_coo
|
||||
procedure, pass(a) :: cp_from_fmt => psb_d_cp_ecsr_from_fmt
|
||||
procedure, pass(a) :: mv_from_coo => psb_d_mv_ecsr_from_coo
|
||||
procedure, pass(a) :: mv_from_fmt => psb_d_mv_ecsr_from_fmt
|
||||
|
||||
procedure, pass(a) :: cmp_nerwp => psb_d_ecsr_cmp_nerwp
|
||||
procedure, pass(a) :: free => d_ecsr_free
|
||||
procedure, pass(a) :: mold => psb_d_ecsr_mold
|
||||
|
||||
end type psb_d_ecsr_sparse_mat
|
||||
!> \memberof psb_d_ecsr_sparse_mat
|
||||
!! \see psb_d_base_mat_mod::psb_d_base_csmv
|
||||
interface
|
||||
subroutine psb_d_ecsr_csmv(alpha,a,x,beta,y,info,trans)
|
||||
import
|
||||
class(psb_d_ecsr_sparse_mat), intent(in) :: a
|
||||
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
|
||||
real(psb_dpk_), intent(inout) :: y(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
end subroutine psb_d_ecsr_csmv
|
||||
end interface
|
||||
|
||||
!> \memberof psb_d_ecsr_sparse_mat
|
||||
!! \see psb_d_base_mat_mod::psb_d_base_cp_from_coo
|
||||
interface
|
||||
subroutine psb_d_ecsr_cmp_nerwp(a,info)
|
||||
import
|
||||
class(psb_d_ecsr_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_d_ecsr_cmp_nerwp
|
||||
end interface
|
||||
|
||||
!> \memberof psb_d_ecsr_sparse_mat
|
||||
!! \see psb_d_base_mat_mod::psb_d_base_cp_from_coo
|
||||
interface
|
||||
subroutine psb_d_cp_ecsr_from_coo(a,b,info)
|
||||
import
|
||||
class(psb_d_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_d_coo_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_d_cp_ecsr_from_coo
|
||||
end interface
|
||||
|
||||
!> \memberof psb_d_ecsr_sparse_mat
|
||||
!! \see psb_d_base_mat_mod::psb_d_base_cp_from_fmt
|
||||
interface
|
||||
subroutine psb_d_cp_ecsr_from_fmt(a,b,info)
|
||||
import
|
||||
class(psb_d_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_d_base_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_d_cp_ecsr_from_fmt
|
||||
end interface
|
||||
|
||||
!> \memberof psb_d_ecsr_sparse_mat
|
||||
!! \see psb_d_base_mat_mod::psb_d_base_mv_from_coo
|
||||
interface
|
||||
subroutine psb_d_mv_ecsr_from_coo(a,b,info)
|
||||
import
|
||||
class(psb_d_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_d_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_d_mv_ecsr_from_coo
|
||||
end interface
|
||||
|
||||
!> \memberof psb_d_ecsr_sparse_mat
|
||||
!! \see psb_d_base_mat_mod::psb_d_base_mv_from_fmt
|
||||
interface
|
||||
subroutine psb_d_mv_ecsr_from_fmt(a,b,info)
|
||||
import
|
||||
class(psb_d_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_d_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_d_mv_ecsr_from_fmt
|
||||
end interface
|
||||
|
||||
!> \memberof psb_d_ecsr_sparse_mat
|
||||
!| \see psb_base_mat_mod::psb_base_mold
|
||||
interface
|
||||
subroutine psb_d_ecsr_mold(a,b,info)
|
||||
import
|
||||
class(psb_d_ecsr_sparse_mat), intent(in) :: a
|
||||
class(psb_d_base_sparse_mat), intent(inout), allocatable :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_d_ecsr_mold
|
||||
end interface
|
||||
|
||||
|
||||
|
||||
!> \namespace psb_base_mod \class psb_ld_csr_sparse_mat
|
||||
!! \extends psb_ld_base_mat_mod::psb_ld_base_sparse_mat
|
||||
!!
|
||||
!! psb_ld_csr_sparse_mat type and the related methods.
|
||||
@@ -1178,6 +1282,26 @@ contains
|
||||
|
||||
|
||||
|
||||
function d_ecsr_get_fmt() result(res)
|
||||
implicit none
|
||||
character(len=5) :: res
|
||||
res = 'ECSR'
|
||||
end function d_ecsr_get_fmt
|
||||
|
||||
subroutine d_ecsr_free(a)
|
||||
implicit none
|
||||
|
||||
class(psb_d_ecsr_sparse_mat), intent(inout) :: a
|
||||
|
||||
|
||||
if (allocated(a%nerwp)) deallocate(a%nerwp)
|
||||
a%nnerws = 0
|
||||
call a%psb_d_csr_sparse_mat%free()
|
||||
|
||||
return
|
||||
end subroutine d_ecsr_free
|
||||
|
||||
|
||||
! == ===================================
|
||||
!
|
||||
!
|
||||
|
||||
@@ -79,7 +79,8 @@
|
||||
module psb_d_mat_mod
|
||||
|
||||
use psb_d_base_mat_mod
|
||||
use psb_d_csr_mat_mod, only : psb_d_csr_sparse_mat, psb_ld_csr_sparse_mat
|
||||
use psb_d_csr_mat_mod, only : psb_d_csr_sparse_mat, psb_ld_csr_sparse_mat,&
|
||||
& psb_d_ecsr_sparse_mat
|
||||
use psb_d_csc_mat_mod, only : psb_d_csc_sparse_mat, psb_ld_csc_sparse_mat
|
||||
|
||||
type :: psb_dspmat_type
|
||||
|
||||
@@ -579,7 +579,111 @@ module psb_s_csr_mat_mod
|
||||
end subroutine psb_s_csr_scals
|
||||
end interface
|
||||
|
||||
!> \namespace psb_base_mod \class psb_ls_csr_sparse_mat
|
||||
|
||||
type, extends(psb_s_csr_sparse_mat) :: psb_s_ecsr_sparse_mat
|
||||
|
||||
!> Number of non-empty rows
|
||||
integer(psb_ipk_) :: nnerws
|
||||
!> Indices of non-empty rows
|
||||
integer(psb_ipk_), allocatable :: nerwp(:)
|
||||
|
||||
contains
|
||||
procedure, nopass :: get_fmt => s_ecsr_get_fmt
|
||||
|
||||
! procedure, pass(a) :: csmm => psb_s_ecsr_csmm
|
||||
procedure, pass(a) :: csmv => psb_s_ecsr_csmv
|
||||
|
||||
procedure, pass(a) :: cp_from_coo => psb_s_cp_ecsr_from_coo
|
||||
procedure, pass(a) :: cp_from_fmt => psb_s_cp_ecsr_from_fmt
|
||||
procedure, pass(a) :: mv_from_coo => psb_s_mv_ecsr_from_coo
|
||||
procedure, pass(a) :: mv_from_fmt => psb_s_mv_ecsr_from_fmt
|
||||
|
||||
procedure, pass(a) :: cmp_nerwp => psb_s_ecsr_cmp_nerwp
|
||||
procedure, pass(a) :: free => s_ecsr_free
|
||||
procedure, pass(a) :: mold => psb_s_ecsr_mold
|
||||
|
||||
end type psb_s_ecsr_sparse_mat
|
||||
!> \memberof psb_s_ecsr_sparse_mat
|
||||
!! \see psb_s_base_mat_mod::psb_s_base_csmv
|
||||
interface
|
||||
subroutine psb_s_ecsr_csmv(alpha,a,x,beta,y,info,trans)
|
||||
import
|
||||
class(psb_s_ecsr_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_), intent(in) :: alpha, beta, x(:)
|
||||
real(psb_spk_), intent(inout) :: y(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
end subroutine psb_s_ecsr_csmv
|
||||
end interface
|
||||
|
||||
!> \memberof psb_s_ecsr_sparse_mat
|
||||
!! \see psb_s_base_mat_mod::psb_s_base_cp_from_coo
|
||||
interface
|
||||
subroutine psb_s_ecsr_cmp_nerwp(a,info)
|
||||
import
|
||||
class(psb_s_ecsr_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_s_ecsr_cmp_nerwp
|
||||
end interface
|
||||
|
||||
!> \memberof psb_s_ecsr_sparse_mat
|
||||
!! \see psb_s_base_mat_mod::psb_s_base_cp_from_coo
|
||||
interface
|
||||
subroutine psb_s_cp_ecsr_from_coo(a,b,info)
|
||||
import
|
||||
class(psb_s_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_s_coo_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_s_cp_ecsr_from_coo
|
||||
end interface
|
||||
|
||||
!> \memberof psb_s_ecsr_sparse_mat
|
||||
!! \see psb_s_base_mat_mod::psb_s_base_cp_from_fmt
|
||||
interface
|
||||
subroutine psb_s_cp_ecsr_from_fmt(a,b,info)
|
||||
import
|
||||
class(psb_s_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_s_base_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_s_cp_ecsr_from_fmt
|
||||
end interface
|
||||
|
||||
!> \memberof psb_s_ecsr_sparse_mat
|
||||
!! \see psb_s_base_mat_mod::psb_s_base_mv_from_coo
|
||||
interface
|
||||
subroutine psb_s_mv_ecsr_from_coo(a,b,info)
|
||||
import
|
||||
class(psb_s_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_s_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_s_mv_ecsr_from_coo
|
||||
end interface
|
||||
|
||||
!> \memberof psb_s_ecsr_sparse_mat
|
||||
!! \see psb_s_base_mat_mod::psb_s_base_mv_from_fmt
|
||||
interface
|
||||
subroutine psb_s_mv_ecsr_from_fmt(a,b,info)
|
||||
import
|
||||
class(psb_s_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_s_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_s_mv_ecsr_from_fmt
|
||||
end interface
|
||||
|
||||
!> \memberof psb_s_ecsr_sparse_mat
|
||||
!| \see psb_base_mat_mod::psb_base_mold
|
||||
interface
|
||||
subroutine psb_s_ecsr_mold(a,b,info)
|
||||
import
|
||||
class(psb_s_ecsr_sparse_mat), intent(in) :: a
|
||||
class(psb_s_base_sparse_mat), intent(inout), allocatable :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_s_ecsr_mold
|
||||
end interface
|
||||
|
||||
|
||||
|
||||
!> \namespace psb_base_mod \class psb_ls_csr_sparse_mat
|
||||
!! \extends psb_ls_base_mat_mod::psb_ls_base_sparse_mat
|
||||
!!
|
||||
!! psb_ls_csr_sparse_mat type and the related methods.
|
||||
@@ -1178,6 +1282,26 @@ contains
|
||||
|
||||
|
||||
|
||||
function s_ecsr_get_fmt() result(res)
|
||||
implicit none
|
||||
character(len=5) :: res
|
||||
res = 'ECSR'
|
||||
end function s_ecsr_get_fmt
|
||||
|
||||
subroutine s_ecsr_free(a)
|
||||
implicit none
|
||||
|
||||
class(psb_s_ecsr_sparse_mat), intent(inout) :: a
|
||||
|
||||
|
||||
if (allocated(a%nerwp)) deallocate(a%nerwp)
|
||||
a%nnerws = 0
|
||||
call a%psb_s_csr_sparse_mat%free()
|
||||
|
||||
return
|
||||
end subroutine s_ecsr_free
|
||||
|
||||
|
||||
! == ===================================
|
||||
!
|
||||
!
|
||||
|
||||
@@ -79,7 +79,8 @@
|
||||
module psb_s_mat_mod
|
||||
|
||||
use psb_s_base_mat_mod
|
||||
use psb_s_csr_mat_mod, only : psb_s_csr_sparse_mat, psb_ls_csr_sparse_mat
|
||||
use psb_s_csr_mat_mod, only : psb_s_csr_sparse_mat, psb_ls_csr_sparse_mat,&
|
||||
& psb_s_ecsr_sparse_mat
|
||||
use psb_s_csc_mat_mod, only : psb_s_csc_sparse_mat, psb_ls_csc_sparse_mat
|
||||
|
||||
type :: psb_sspmat_type
|
||||
|
||||
@@ -579,7 +579,111 @@ module psb_z_csr_mat_mod
|
||||
end subroutine psb_z_csr_scals
|
||||
end interface
|
||||
|
||||
!> \namespace psb_base_mod \class psb_lz_csr_sparse_mat
|
||||
|
||||
type, extends(psb_z_csr_sparse_mat) :: psb_z_ecsr_sparse_mat
|
||||
|
||||
!> Number of non-empty rows
|
||||
integer(psb_ipk_) :: nnerws
|
||||
!> Indices of non-empty rows
|
||||
integer(psb_ipk_), allocatable :: nerwp(:)
|
||||
|
||||
contains
|
||||
procedure, nopass :: get_fmt => z_ecsr_get_fmt
|
||||
|
||||
! procedure, pass(a) :: csmm => psb_z_ecsr_csmm
|
||||
procedure, pass(a) :: csmv => psb_z_ecsr_csmv
|
||||
|
||||
procedure, pass(a) :: cp_from_coo => psb_z_cp_ecsr_from_coo
|
||||
procedure, pass(a) :: cp_from_fmt => psb_z_cp_ecsr_from_fmt
|
||||
procedure, pass(a) :: mv_from_coo => psb_z_mv_ecsr_from_coo
|
||||
procedure, pass(a) :: mv_from_fmt => psb_z_mv_ecsr_from_fmt
|
||||
|
||||
procedure, pass(a) :: cmp_nerwp => psb_z_ecsr_cmp_nerwp
|
||||
procedure, pass(a) :: free => z_ecsr_free
|
||||
procedure, pass(a) :: mold => psb_z_ecsr_mold
|
||||
|
||||
end type psb_z_ecsr_sparse_mat
|
||||
!> \memberof psb_z_ecsr_sparse_mat
|
||||
!! \see psb_z_base_mat_mod::psb_z_base_csmv
|
||||
interface
|
||||
subroutine psb_z_ecsr_csmv(alpha,a,x,beta,y,info,trans)
|
||||
import
|
||||
class(psb_z_ecsr_sparse_mat), intent(in) :: a
|
||||
complex(psb_dpk_), intent(in) :: alpha, beta, x(:)
|
||||
complex(psb_dpk_), intent(inout) :: y(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
end subroutine psb_z_ecsr_csmv
|
||||
end interface
|
||||
|
||||
!> \memberof psb_z_ecsr_sparse_mat
|
||||
!! \see psb_z_base_mat_mod::psb_z_base_cp_from_coo
|
||||
interface
|
||||
subroutine psb_z_ecsr_cmp_nerwp(a,info)
|
||||
import
|
||||
class(psb_z_ecsr_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_z_ecsr_cmp_nerwp
|
||||
end interface
|
||||
|
||||
!> \memberof psb_z_ecsr_sparse_mat
|
||||
!! \see psb_z_base_mat_mod::psb_z_base_cp_from_coo
|
||||
interface
|
||||
subroutine psb_z_cp_ecsr_from_coo(a,b,info)
|
||||
import
|
||||
class(psb_z_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_z_coo_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_z_cp_ecsr_from_coo
|
||||
end interface
|
||||
|
||||
!> \memberof psb_z_ecsr_sparse_mat
|
||||
!! \see psb_z_base_mat_mod::psb_z_base_cp_from_fmt
|
||||
interface
|
||||
subroutine psb_z_cp_ecsr_from_fmt(a,b,info)
|
||||
import
|
||||
class(psb_z_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_z_base_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_z_cp_ecsr_from_fmt
|
||||
end interface
|
||||
|
||||
!> \memberof psb_z_ecsr_sparse_mat
|
||||
!! \see psb_z_base_mat_mod::psb_z_base_mv_from_coo
|
||||
interface
|
||||
subroutine psb_z_mv_ecsr_from_coo(a,b,info)
|
||||
import
|
||||
class(psb_z_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_z_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_z_mv_ecsr_from_coo
|
||||
end interface
|
||||
|
||||
!> \memberof psb_z_ecsr_sparse_mat
|
||||
!! \see psb_z_base_mat_mod::psb_z_base_mv_from_fmt
|
||||
interface
|
||||
subroutine psb_z_mv_ecsr_from_fmt(a,b,info)
|
||||
import
|
||||
class(psb_z_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_z_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_z_mv_ecsr_from_fmt
|
||||
end interface
|
||||
|
||||
!> \memberof psb_z_ecsr_sparse_mat
|
||||
!| \see psb_base_mat_mod::psb_base_mold
|
||||
interface
|
||||
subroutine psb_z_ecsr_mold(a,b,info)
|
||||
import
|
||||
class(psb_z_ecsr_sparse_mat), intent(in) :: a
|
||||
class(psb_z_base_sparse_mat), intent(inout), allocatable :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_z_ecsr_mold
|
||||
end interface
|
||||
|
||||
|
||||
|
||||
!> \namespace psb_base_mod \class psb_lz_csr_sparse_mat
|
||||
!! \extends psb_lz_base_mat_mod::psb_lz_base_sparse_mat
|
||||
!!
|
||||
!! psb_lz_csr_sparse_mat type and the related methods.
|
||||
@@ -1178,6 +1282,26 @@ contains
|
||||
|
||||
|
||||
|
||||
function z_ecsr_get_fmt() result(res)
|
||||
implicit none
|
||||
character(len=5) :: res
|
||||
res = 'ECSR'
|
||||
end function z_ecsr_get_fmt
|
||||
|
||||
subroutine z_ecsr_free(a)
|
||||
implicit none
|
||||
|
||||
class(psb_z_ecsr_sparse_mat), intent(inout) :: a
|
||||
|
||||
|
||||
if (allocated(a%nerwp)) deallocate(a%nerwp)
|
||||
a%nnerws = 0
|
||||
call a%psb_z_csr_sparse_mat%free()
|
||||
|
||||
return
|
||||
end subroutine z_ecsr_free
|
||||
|
||||
|
||||
! == ===================================
|
||||
!
|
||||
!
|
||||
|
||||
@@ -79,7 +79,8 @@
|
||||
module psb_z_mat_mod
|
||||
|
||||
use psb_z_base_mat_mod
|
||||
use psb_z_csr_mat_mod, only : psb_z_csr_sparse_mat, psb_lz_csr_sparse_mat
|
||||
use psb_z_csr_mat_mod, only : psb_z_csr_sparse_mat, psb_lz_csr_sparse_mat,&
|
||||
& psb_z_ecsr_sparse_mat
|
||||
use psb_z_csc_mat_mod, only : psb_z_csc_sparse_mat, psb_lz_csc_sparse_mat
|
||||
|
||||
type :: psb_zspmat_type
|
||||
|
||||
@@ -3550,6 +3550,269 @@ contains
|
||||
|
||||
end subroutine psb_ccsrspspmm
|
||||
|
||||
subroutine psb_c_ecsr_mold(a,b,info)
|
||||
use psb_c_csr_mat_mod, psb_protect_name => psb_c_ecsr_mold
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_c_ecsr_sparse_mat), intent(in) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout), allocatable :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='ecsr_mold'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
|
||||
info = 0
|
||||
if (allocated(b)) then
|
||||
call b%free()
|
||||
deallocate(b,stat=info)
|
||||
end if
|
||||
if (info == 0) allocate(psb_c_ecsr_sparse_mat :: b, stat=info)
|
||||
|
||||
if (info /= 0) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_ecsr_mold
|
||||
|
||||
subroutine psb_c_ecsr_csmv(alpha,a,x,beta,y,info,trans)
|
||||
use psb_error_mod
|
||||
use psb_string_mod
|
||||
use psb_c_csr_mat_mod, psb_protect_name => psb_c_ecsr_csmv
|
||||
implicit none
|
||||
class(psb_c_ecsr_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
|
||||
complex(psb_spk_), intent(inout) :: y(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
|
||||
character :: trans_
|
||||
integer(psb_ipk_) :: m, n
|
||||
logical :: tra, ctra
|
||||
integer(psb_ipk_) :: err_act
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name='c_csr_csmv'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
|
||||
if (.not.a%is_asb()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
|
||||
if (tra.or.ctra) then
|
||||
m = a%get_ncols()
|
||||
n = a%get_nrows()
|
||||
else
|
||||
n = a%get_ncols()
|
||||
m = a%get_nrows()
|
||||
end if
|
||||
|
||||
if (size(x,1)<n) then
|
||||
info = psb_err_input_asize_small_i_
|
||||
ierr(1) = 3; ierr(2) = size(x); ierr(3) = n;
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(y,1)<m) then
|
||||
info = psb_err_input_asize_small_i_
|
||||
ierr(1) = 5; ierr(2) = size(y); ierr(3) =m;
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (((beta == cone).and..not.(tra.or.ctra))&
|
||||
& .or.(a%is_triangle()).or.(a%is_unit())) then
|
||||
|
||||
call psb_c_ecsr_csmv_inner(m,n,alpha,a%irp,a%ja,a%val,&
|
||||
& a%nnerws,a%nerwp,x,y)
|
||||
else
|
||||
call a%psb_c_csr_sparse_mat%csmv(alpha,x,beta,y,info,trans)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
contains
|
||||
subroutine psb_c_ecsr_csmv_inner(m,n,alpha,irp,ja,val,&
|
||||
& nnerws,nerwp,x,y)
|
||||
integer(psb_ipk_), intent(in) :: m,n,nnerws,irp(*),ja(*),nerwp(*)
|
||||
complex(psb_spk_), intent(in) :: alpha, x(*),val(*)
|
||||
complex(psb_spk_), intent(inout) :: y(*)
|
||||
|
||||
|
||||
integer(psb_ipk_) :: i,j,ir
|
||||
complex(psb_spk_) :: acc
|
||||
|
||||
if (alpha == czero) return
|
||||
|
||||
|
||||
|
||||
|
||||
if (alpha == cone) then
|
||||
!$omp parallel do private(ir,i,j,acc)
|
||||
do ir=1,nnerws
|
||||
i = nerwp(ir)
|
||||
acc = czero
|
||||
do j=irp(i), irp(i+1)-1
|
||||
acc = acc + val(j) * x(ja(j))
|
||||
enddo
|
||||
y(i) = y(i) + acc
|
||||
end do
|
||||
|
||||
else if (alpha == -cone) then
|
||||
|
||||
!$omp parallel do private(ir,i,j,acc)
|
||||
do ir=1,nnerws
|
||||
i = nerwp(ir)
|
||||
acc = czero
|
||||
do j=irp(i), irp(i+1)-1
|
||||
acc = acc + val(j) * x(ja(j))
|
||||
enddo
|
||||
y(i) = y(i) -acc
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
!$omp parallel do private(ir,i,j,acc)
|
||||
do ir=1,nnerws
|
||||
i = nerwp(ir)
|
||||
acc = czero
|
||||
do j=irp(i), irp(i+1)-1
|
||||
acc = acc + val(j) * x(ja(j))
|
||||
enddo
|
||||
y(i) = y(i) + alpha*acc
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end subroutine psb_c_ecsr_csmv_inner
|
||||
|
||||
end subroutine psb_c_ecsr_csmv
|
||||
|
||||
|
||||
subroutine psb_c_ecsr_cmp_nerwp(a,info)
|
||||
use psb_const_mod
|
||||
use psb_realloc_mod
|
||||
use psb_c_base_mat_mod
|
||||
use psb_c_csr_mat_mod, psb_protect_name => psb_c_ecsr_cmp_nerwp
|
||||
implicit none
|
||||
|
||||
class(psb_c_ecsr_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: nnerws, i, nr, nzr
|
||||
info = psb_success_
|
||||
nr = a%get_nrows()
|
||||
call psb_realloc(nr,a%nerwp,info)
|
||||
nnerws = 0
|
||||
do i=1, nr
|
||||
nzr = a%irp(i+1)-a%irp(i)
|
||||
if (nzr>0) then
|
||||
nnerws = nnerws + 1
|
||||
a%nerwp(nnerws) = i
|
||||
end if
|
||||
end do
|
||||
call psb_realloc(nnerws,a%nerwp,info)
|
||||
end subroutine psb_c_ecsr_cmp_nerwp
|
||||
|
||||
subroutine psb_c_cp_ecsr_from_coo(a,b,info)
|
||||
use psb_const_mod
|
||||
use psb_realloc_mod
|
||||
use psb_c_base_mat_mod
|
||||
use psb_c_csr_mat_mod, psb_protect_name => psb_c_cp_ecsr_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_c_csr_sparse_mat%cp_from_coo(b,info)
|
||||
if (info == psb_success_) call a%cmp_nerwp(info)
|
||||
|
||||
end subroutine psb_c_cp_ecsr_from_coo
|
||||
|
||||
subroutine psb_c_mv_ecsr_from_coo(a,b,info)
|
||||
use psb_const_mod
|
||||
use psb_realloc_mod
|
||||
use psb_error_mod
|
||||
use psb_c_base_mat_mod
|
||||
use psb_c_csr_mat_mod, psb_protect_name => psb_c_mv_ecsr_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_c_csr_sparse_mat%mv_from_coo(b,info)
|
||||
if (info == psb_success_) call a%cmp_nerwp(info)
|
||||
|
||||
end subroutine psb_c_mv_ecsr_from_coo
|
||||
|
||||
subroutine psb_c_mv_ecsr_from_fmt(a,b,info)
|
||||
use psb_const_mod
|
||||
use psb_c_base_mat_mod
|
||||
use psb_c_csr_mat_mod, psb_protect_name => psb_c_mv_ecsr_from_fmt
|
||||
implicit none
|
||||
|
||||
class(psb_c_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_c_csr_sparse_mat%mv_from_fmt(b,info)
|
||||
if (info == psb_success_) call a%cmp_nerwp(info)
|
||||
|
||||
end subroutine psb_c_mv_ecsr_from_fmt
|
||||
|
||||
subroutine psb_c_cp_ecsr_from_fmt(a,b,info)
|
||||
use psb_const_mod
|
||||
use psb_c_base_mat_mod
|
||||
use psb_realloc_mod
|
||||
use psb_c_csr_mat_mod, psb_protect_name => psb_c_cp_ecsr_from_fmt
|
||||
implicit none
|
||||
|
||||
class(psb_c_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_base_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_c_csr_sparse_mat%cp_from_fmt(b,info)
|
||||
if (info == psb_success_) call a%cmp_nerwp(info)
|
||||
|
||||
end subroutine psb_c_cp_ecsr_from_fmt
|
||||
|
||||
|
||||
!
|
||||
!
|
||||
|
||||
@@ -3550,6 +3550,269 @@ contains
|
||||
|
||||
end subroutine psb_dcsrspspmm
|
||||
|
||||
subroutine psb_d_ecsr_mold(a,b,info)
|
||||
use psb_d_csr_mat_mod, psb_protect_name => psb_d_ecsr_mold
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_d_ecsr_sparse_mat), intent(in) :: a
|
||||
class(psb_d_base_sparse_mat), intent(inout), allocatable :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='ecsr_mold'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
|
||||
info = 0
|
||||
if (allocated(b)) then
|
||||
call b%free()
|
||||
deallocate(b,stat=info)
|
||||
end if
|
||||
if (info == 0) allocate(psb_d_ecsr_sparse_mat :: b, stat=info)
|
||||
|
||||
if (info /= 0) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_d_ecsr_mold
|
||||
|
||||
subroutine psb_d_ecsr_csmv(alpha,a,x,beta,y,info,trans)
|
||||
use psb_error_mod
|
||||
use psb_string_mod
|
||||
use psb_d_csr_mat_mod, psb_protect_name => psb_d_ecsr_csmv
|
||||
implicit none
|
||||
class(psb_d_ecsr_sparse_mat), intent(in) :: a
|
||||
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
|
||||
real(psb_dpk_), intent(inout) :: y(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
|
||||
character :: trans_
|
||||
integer(psb_ipk_) :: m, n
|
||||
logical :: tra, ctra
|
||||
integer(psb_ipk_) :: err_act
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name='d_csr_csmv'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
|
||||
if (.not.a%is_asb()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
|
||||
if (tra.or.ctra) then
|
||||
m = a%get_ncols()
|
||||
n = a%get_nrows()
|
||||
else
|
||||
n = a%get_ncols()
|
||||
m = a%get_nrows()
|
||||
end if
|
||||
|
||||
if (size(x,1)<n) then
|
||||
info = psb_err_input_asize_small_i_
|
||||
ierr(1) = 3; ierr(2) = size(x); ierr(3) = n;
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(y,1)<m) then
|
||||
info = psb_err_input_asize_small_i_
|
||||
ierr(1) = 5; ierr(2) = size(y); ierr(3) =m;
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (((beta == done).and..not.(tra.or.ctra))&
|
||||
& .or.(a%is_triangle()).or.(a%is_unit())) then
|
||||
|
||||
call psb_d_ecsr_csmv_inner(m,n,alpha,a%irp,a%ja,a%val,&
|
||||
& a%nnerws,a%nerwp,x,y)
|
||||
else
|
||||
call a%psb_d_csr_sparse_mat%csmv(alpha,x,beta,y,info,trans)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
contains
|
||||
subroutine psb_d_ecsr_csmv_inner(m,n,alpha,irp,ja,val,&
|
||||
& nnerws,nerwp,x,y)
|
||||
integer(psb_ipk_), intent(in) :: m,n,nnerws,irp(*),ja(*),nerwp(*)
|
||||
real(psb_dpk_), intent(in) :: alpha, x(*),val(*)
|
||||
real(psb_dpk_), intent(inout) :: y(*)
|
||||
|
||||
|
||||
integer(psb_ipk_) :: i,j,ir
|
||||
real(psb_dpk_) :: acc
|
||||
|
||||
if (alpha == dzero) return
|
||||
|
||||
|
||||
|
||||
|
||||
if (alpha == done) then
|
||||
!$omp parallel do private(ir,i,j,acc)
|
||||
do ir=1,nnerws
|
||||
i = nerwp(ir)
|
||||
acc = dzero
|
||||
do j=irp(i), irp(i+1)-1
|
||||
acc = acc + val(j) * x(ja(j))
|
||||
enddo
|
||||
y(i) = y(i) + acc
|
||||
end do
|
||||
|
||||
else if (alpha == -done) then
|
||||
|
||||
!$omp parallel do private(ir,i,j,acc)
|
||||
do ir=1,nnerws
|
||||
i = nerwp(ir)
|
||||
acc = dzero
|
||||
do j=irp(i), irp(i+1)-1
|
||||
acc = acc + val(j) * x(ja(j))
|
||||
enddo
|
||||
y(i) = y(i) -acc
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
!$omp parallel do private(ir,i,j,acc)
|
||||
do ir=1,nnerws
|
||||
i = nerwp(ir)
|
||||
acc = dzero
|
||||
do j=irp(i), irp(i+1)-1
|
||||
acc = acc + val(j) * x(ja(j))
|
||||
enddo
|
||||
y(i) = y(i) + alpha*acc
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end subroutine psb_d_ecsr_csmv_inner
|
||||
|
||||
end subroutine psb_d_ecsr_csmv
|
||||
|
||||
|
||||
subroutine psb_d_ecsr_cmp_nerwp(a,info)
|
||||
use psb_const_mod
|
||||
use psb_realloc_mod
|
||||
use psb_d_base_mat_mod
|
||||
use psb_d_csr_mat_mod, psb_protect_name => psb_d_ecsr_cmp_nerwp
|
||||
implicit none
|
||||
|
||||
class(psb_d_ecsr_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: nnerws, i, nr, nzr
|
||||
info = psb_success_
|
||||
nr = a%get_nrows()
|
||||
call psb_realloc(nr,a%nerwp,info)
|
||||
nnerws = 0
|
||||
do i=1, nr
|
||||
nzr = a%irp(i+1)-a%irp(i)
|
||||
if (nzr>0) then
|
||||
nnerws = nnerws + 1
|
||||
a%nerwp(nnerws) = i
|
||||
end if
|
||||
end do
|
||||
call psb_realloc(nnerws,a%nerwp,info)
|
||||
end subroutine psb_d_ecsr_cmp_nerwp
|
||||
|
||||
subroutine psb_d_cp_ecsr_from_coo(a,b,info)
|
||||
use psb_const_mod
|
||||
use psb_realloc_mod
|
||||
use psb_d_base_mat_mod
|
||||
use psb_d_csr_mat_mod, psb_protect_name => psb_d_cp_ecsr_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_d_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_d_coo_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_d_csr_sparse_mat%cp_from_coo(b,info)
|
||||
if (info == psb_success_) call a%cmp_nerwp(info)
|
||||
|
||||
end subroutine psb_d_cp_ecsr_from_coo
|
||||
|
||||
subroutine psb_d_mv_ecsr_from_coo(a,b,info)
|
||||
use psb_const_mod
|
||||
use psb_realloc_mod
|
||||
use psb_error_mod
|
||||
use psb_d_base_mat_mod
|
||||
use psb_d_csr_mat_mod, psb_protect_name => psb_d_mv_ecsr_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_d_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_d_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_d_csr_sparse_mat%mv_from_coo(b,info)
|
||||
if (info == psb_success_) call a%cmp_nerwp(info)
|
||||
|
||||
end subroutine psb_d_mv_ecsr_from_coo
|
||||
|
||||
subroutine psb_d_mv_ecsr_from_fmt(a,b,info)
|
||||
use psb_const_mod
|
||||
use psb_d_base_mat_mod
|
||||
use psb_d_csr_mat_mod, psb_protect_name => psb_d_mv_ecsr_from_fmt
|
||||
implicit none
|
||||
|
||||
class(psb_d_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_d_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_d_csr_sparse_mat%mv_from_fmt(b,info)
|
||||
if (info == psb_success_) call a%cmp_nerwp(info)
|
||||
|
||||
end subroutine psb_d_mv_ecsr_from_fmt
|
||||
|
||||
subroutine psb_d_cp_ecsr_from_fmt(a,b,info)
|
||||
use psb_const_mod
|
||||
use psb_d_base_mat_mod
|
||||
use psb_realloc_mod
|
||||
use psb_d_csr_mat_mod, psb_protect_name => psb_d_cp_ecsr_from_fmt
|
||||
implicit none
|
||||
|
||||
class(psb_d_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_d_base_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_d_csr_sparse_mat%cp_from_fmt(b,info)
|
||||
if (info == psb_success_) call a%cmp_nerwp(info)
|
||||
|
||||
end subroutine psb_d_cp_ecsr_from_fmt
|
||||
|
||||
|
||||
!
|
||||
!
|
||||
|
||||
@@ -3550,6 +3550,269 @@ contains
|
||||
|
||||
end subroutine psb_scsrspspmm
|
||||
|
||||
subroutine psb_s_ecsr_mold(a,b,info)
|
||||
use psb_s_csr_mat_mod, psb_protect_name => psb_s_ecsr_mold
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_s_ecsr_sparse_mat), intent(in) :: a
|
||||
class(psb_s_base_sparse_mat), intent(inout), allocatable :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='ecsr_mold'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
|
||||
info = 0
|
||||
if (allocated(b)) then
|
||||
call b%free()
|
||||
deallocate(b,stat=info)
|
||||
end if
|
||||
if (info == 0) allocate(psb_s_ecsr_sparse_mat :: b, stat=info)
|
||||
|
||||
if (info /= 0) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_s_ecsr_mold
|
||||
|
||||
subroutine psb_s_ecsr_csmv(alpha,a,x,beta,y,info,trans)
|
||||
use psb_error_mod
|
||||
use psb_string_mod
|
||||
use psb_s_csr_mat_mod, psb_protect_name => psb_s_ecsr_csmv
|
||||
implicit none
|
||||
class(psb_s_ecsr_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_), intent(in) :: alpha, beta, x(:)
|
||||
real(psb_spk_), intent(inout) :: y(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
|
||||
character :: trans_
|
||||
integer(psb_ipk_) :: m, n
|
||||
logical :: tra, ctra
|
||||
integer(psb_ipk_) :: err_act
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name='s_csr_csmv'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
|
||||
if (.not.a%is_asb()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
|
||||
if (tra.or.ctra) then
|
||||
m = a%get_ncols()
|
||||
n = a%get_nrows()
|
||||
else
|
||||
n = a%get_ncols()
|
||||
m = a%get_nrows()
|
||||
end if
|
||||
|
||||
if (size(x,1)<n) then
|
||||
info = psb_err_input_asize_small_i_
|
||||
ierr(1) = 3; ierr(2) = size(x); ierr(3) = n;
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(y,1)<m) then
|
||||
info = psb_err_input_asize_small_i_
|
||||
ierr(1) = 5; ierr(2) = size(y); ierr(3) =m;
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (((beta == sone).and..not.(tra.or.ctra))&
|
||||
& .or.(a%is_triangle()).or.(a%is_unit())) then
|
||||
|
||||
call psb_s_ecsr_csmv_inner(m,n,alpha,a%irp,a%ja,a%val,&
|
||||
& a%nnerws,a%nerwp,x,y)
|
||||
else
|
||||
call a%psb_s_csr_sparse_mat%csmv(alpha,x,beta,y,info,trans)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
contains
|
||||
subroutine psb_s_ecsr_csmv_inner(m,n,alpha,irp,ja,val,&
|
||||
& nnerws,nerwp,x,y)
|
||||
integer(psb_ipk_), intent(in) :: m,n,nnerws,irp(*),ja(*),nerwp(*)
|
||||
real(psb_spk_), intent(in) :: alpha, x(*),val(*)
|
||||
real(psb_spk_), intent(inout) :: y(*)
|
||||
|
||||
|
||||
integer(psb_ipk_) :: i,j,ir
|
||||
real(psb_spk_) :: acc
|
||||
|
||||
if (alpha == szero) return
|
||||
|
||||
|
||||
|
||||
|
||||
if (alpha == sone) then
|
||||
!$omp parallel do private(ir,i,j,acc)
|
||||
do ir=1,nnerws
|
||||
i = nerwp(ir)
|
||||
acc = szero
|
||||
do j=irp(i), irp(i+1)-1
|
||||
acc = acc + val(j) * x(ja(j))
|
||||
enddo
|
||||
y(i) = y(i) + acc
|
||||
end do
|
||||
|
||||
else if (alpha == -sone) then
|
||||
|
||||
!$omp parallel do private(ir,i,j,acc)
|
||||
do ir=1,nnerws
|
||||
i = nerwp(ir)
|
||||
acc = szero
|
||||
do j=irp(i), irp(i+1)-1
|
||||
acc = acc + val(j) * x(ja(j))
|
||||
enddo
|
||||
y(i) = y(i) -acc
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
!$omp parallel do private(ir,i,j,acc)
|
||||
do ir=1,nnerws
|
||||
i = nerwp(ir)
|
||||
acc = szero
|
||||
do j=irp(i), irp(i+1)-1
|
||||
acc = acc + val(j) * x(ja(j))
|
||||
enddo
|
||||
y(i) = y(i) + alpha*acc
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end subroutine psb_s_ecsr_csmv_inner
|
||||
|
||||
end subroutine psb_s_ecsr_csmv
|
||||
|
||||
|
||||
subroutine psb_s_ecsr_cmp_nerwp(a,info)
|
||||
use psb_const_mod
|
||||
use psb_realloc_mod
|
||||
use psb_s_base_mat_mod
|
||||
use psb_s_csr_mat_mod, psb_protect_name => psb_s_ecsr_cmp_nerwp
|
||||
implicit none
|
||||
|
||||
class(psb_s_ecsr_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: nnerws, i, nr, nzr
|
||||
info = psb_success_
|
||||
nr = a%get_nrows()
|
||||
call psb_realloc(nr,a%nerwp,info)
|
||||
nnerws = 0
|
||||
do i=1, nr
|
||||
nzr = a%irp(i+1)-a%irp(i)
|
||||
if (nzr>0) then
|
||||
nnerws = nnerws + 1
|
||||
a%nerwp(nnerws) = i
|
||||
end if
|
||||
end do
|
||||
call psb_realloc(nnerws,a%nerwp,info)
|
||||
end subroutine psb_s_ecsr_cmp_nerwp
|
||||
|
||||
subroutine psb_s_cp_ecsr_from_coo(a,b,info)
|
||||
use psb_const_mod
|
||||
use psb_realloc_mod
|
||||
use psb_s_base_mat_mod
|
||||
use psb_s_csr_mat_mod, psb_protect_name => psb_s_cp_ecsr_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_s_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_s_coo_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_s_csr_sparse_mat%cp_from_coo(b,info)
|
||||
if (info == psb_success_) call a%cmp_nerwp(info)
|
||||
|
||||
end subroutine psb_s_cp_ecsr_from_coo
|
||||
|
||||
subroutine psb_s_mv_ecsr_from_coo(a,b,info)
|
||||
use psb_const_mod
|
||||
use psb_realloc_mod
|
||||
use psb_error_mod
|
||||
use psb_s_base_mat_mod
|
||||
use psb_s_csr_mat_mod, psb_protect_name => psb_s_mv_ecsr_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_s_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_s_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_s_csr_sparse_mat%mv_from_coo(b,info)
|
||||
if (info == psb_success_) call a%cmp_nerwp(info)
|
||||
|
||||
end subroutine psb_s_mv_ecsr_from_coo
|
||||
|
||||
subroutine psb_s_mv_ecsr_from_fmt(a,b,info)
|
||||
use psb_const_mod
|
||||
use psb_s_base_mat_mod
|
||||
use psb_s_csr_mat_mod, psb_protect_name => psb_s_mv_ecsr_from_fmt
|
||||
implicit none
|
||||
|
||||
class(psb_s_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_s_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_s_csr_sparse_mat%mv_from_fmt(b,info)
|
||||
if (info == psb_success_) call a%cmp_nerwp(info)
|
||||
|
||||
end subroutine psb_s_mv_ecsr_from_fmt
|
||||
|
||||
subroutine psb_s_cp_ecsr_from_fmt(a,b,info)
|
||||
use psb_const_mod
|
||||
use psb_s_base_mat_mod
|
||||
use psb_realloc_mod
|
||||
use psb_s_csr_mat_mod, psb_protect_name => psb_s_cp_ecsr_from_fmt
|
||||
implicit none
|
||||
|
||||
class(psb_s_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_s_base_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_s_csr_sparse_mat%cp_from_fmt(b,info)
|
||||
if (info == psb_success_) call a%cmp_nerwp(info)
|
||||
|
||||
end subroutine psb_s_cp_ecsr_from_fmt
|
||||
|
||||
|
||||
!
|
||||
!
|
||||
|
||||
@@ -3550,6 +3550,269 @@ contains
|
||||
|
||||
end subroutine psb_zcsrspspmm
|
||||
|
||||
subroutine psb_z_ecsr_mold(a,b,info)
|
||||
use psb_z_csr_mat_mod, psb_protect_name => psb_z_ecsr_mold
|
||||
use psb_error_mod
|
||||
implicit none
|
||||
class(psb_z_ecsr_sparse_mat), intent(in) :: a
|
||||
class(psb_z_base_sparse_mat), intent(inout), allocatable :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='ecsr_mold'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
|
||||
info = 0
|
||||
if (allocated(b)) then
|
||||
call b%free()
|
||||
deallocate(b,stat=info)
|
||||
end if
|
||||
if (info == 0) allocate(psb_z_ecsr_sparse_mat :: b, stat=info)
|
||||
|
||||
if (info /= 0) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_z_ecsr_mold
|
||||
|
||||
subroutine psb_z_ecsr_csmv(alpha,a,x,beta,y,info,trans)
|
||||
use psb_error_mod
|
||||
use psb_string_mod
|
||||
use psb_z_csr_mat_mod, psb_protect_name => psb_z_ecsr_csmv
|
||||
implicit none
|
||||
class(psb_z_ecsr_sparse_mat), intent(in) :: a
|
||||
complex(psb_dpk_), intent(in) :: alpha, beta, x(:)
|
||||
complex(psb_dpk_), intent(inout) :: y(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
|
||||
character :: trans_
|
||||
integer(psb_ipk_) :: m, n
|
||||
logical :: tra, ctra
|
||||
integer(psb_ipk_) :: err_act
|
||||
integer(psb_ipk_) :: ierr(5)
|
||||
character(len=20) :: name='z_csr_csmv'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
|
||||
if (.not.a%is_asb()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
|
||||
if (tra.or.ctra) then
|
||||
m = a%get_ncols()
|
||||
n = a%get_nrows()
|
||||
else
|
||||
n = a%get_ncols()
|
||||
m = a%get_nrows()
|
||||
end if
|
||||
|
||||
if (size(x,1)<n) then
|
||||
info = psb_err_input_asize_small_i_
|
||||
ierr(1) = 3; ierr(2) = size(x); ierr(3) = n;
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(y,1)<m) then
|
||||
info = psb_err_input_asize_small_i_
|
||||
ierr(1) = 5; ierr(2) = size(y); ierr(3) =m;
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (((beta == zone).and..not.(tra.or.ctra))&
|
||||
& .or.(a%is_triangle()).or.(a%is_unit())) then
|
||||
|
||||
call psb_z_ecsr_csmv_inner(m,n,alpha,a%irp,a%ja,a%val,&
|
||||
& a%nnerws,a%nerwp,x,y)
|
||||
else
|
||||
call a%psb_z_csr_sparse_mat%csmv(alpha,x,beta,y,info,trans)
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
contains
|
||||
subroutine psb_z_ecsr_csmv_inner(m,n,alpha,irp,ja,val,&
|
||||
& nnerws,nerwp,x,y)
|
||||
integer(psb_ipk_), intent(in) :: m,n,nnerws,irp(*),ja(*),nerwp(*)
|
||||
complex(psb_dpk_), intent(in) :: alpha, x(*),val(*)
|
||||
complex(psb_dpk_), intent(inout) :: y(*)
|
||||
|
||||
|
||||
integer(psb_ipk_) :: i,j,ir
|
||||
complex(psb_dpk_) :: acc
|
||||
|
||||
if (alpha == zzero) return
|
||||
|
||||
|
||||
|
||||
|
||||
if (alpha == zone) then
|
||||
!$omp parallel do private(ir,i,j,acc)
|
||||
do ir=1,nnerws
|
||||
i = nerwp(ir)
|
||||
acc = zzero
|
||||
do j=irp(i), irp(i+1)-1
|
||||
acc = acc + val(j) * x(ja(j))
|
||||
enddo
|
||||
y(i) = y(i) + acc
|
||||
end do
|
||||
|
||||
else if (alpha == -zone) then
|
||||
|
||||
!$omp parallel do private(ir,i,j,acc)
|
||||
do ir=1,nnerws
|
||||
i = nerwp(ir)
|
||||
acc = zzero
|
||||
do j=irp(i), irp(i+1)-1
|
||||
acc = acc + val(j) * x(ja(j))
|
||||
enddo
|
||||
y(i) = y(i) -acc
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
!$omp parallel do private(ir,i,j,acc)
|
||||
do ir=1,nnerws
|
||||
i = nerwp(ir)
|
||||
acc = zzero
|
||||
do j=irp(i), irp(i+1)-1
|
||||
acc = acc + val(j) * x(ja(j))
|
||||
enddo
|
||||
y(i) = y(i) + alpha*acc
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end subroutine psb_z_ecsr_csmv_inner
|
||||
|
||||
end subroutine psb_z_ecsr_csmv
|
||||
|
||||
|
||||
subroutine psb_z_ecsr_cmp_nerwp(a,info)
|
||||
use psb_const_mod
|
||||
use psb_realloc_mod
|
||||
use psb_z_base_mat_mod
|
||||
use psb_z_csr_mat_mod, psb_protect_name => psb_z_ecsr_cmp_nerwp
|
||||
implicit none
|
||||
|
||||
class(psb_z_ecsr_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: nnerws, i, nr, nzr
|
||||
info = psb_success_
|
||||
nr = a%get_nrows()
|
||||
call psb_realloc(nr,a%nerwp,info)
|
||||
nnerws = 0
|
||||
do i=1, nr
|
||||
nzr = a%irp(i+1)-a%irp(i)
|
||||
if (nzr>0) then
|
||||
nnerws = nnerws + 1
|
||||
a%nerwp(nnerws) = i
|
||||
end if
|
||||
end do
|
||||
call psb_realloc(nnerws,a%nerwp,info)
|
||||
end subroutine psb_z_ecsr_cmp_nerwp
|
||||
|
||||
subroutine psb_z_cp_ecsr_from_coo(a,b,info)
|
||||
use psb_const_mod
|
||||
use psb_realloc_mod
|
||||
use psb_z_base_mat_mod
|
||||
use psb_z_csr_mat_mod, psb_protect_name => psb_z_cp_ecsr_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_z_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_z_coo_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_z_csr_sparse_mat%cp_from_coo(b,info)
|
||||
if (info == psb_success_) call a%cmp_nerwp(info)
|
||||
|
||||
end subroutine psb_z_cp_ecsr_from_coo
|
||||
|
||||
subroutine psb_z_mv_ecsr_from_coo(a,b,info)
|
||||
use psb_const_mod
|
||||
use psb_realloc_mod
|
||||
use psb_error_mod
|
||||
use psb_z_base_mat_mod
|
||||
use psb_z_csr_mat_mod, psb_protect_name => psb_z_mv_ecsr_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_z_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_z_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_z_csr_sparse_mat%mv_from_coo(b,info)
|
||||
if (info == psb_success_) call a%cmp_nerwp(info)
|
||||
|
||||
end subroutine psb_z_mv_ecsr_from_coo
|
||||
|
||||
subroutine psb_z_mv_ecsr_from_fmt(a,b,info)
|
||||
use psb_const_mod
|
||||
use psb_z_base_mat_mod
|
||||
use psb_z_csr_mat_mod, psb_protect_name => psb_z_mv_ecsr_from_fmt
|
||||
implicit none
|
||||
|
||||
class(psb_z_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_z_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_z_csr_sparse_mat%mv_from_fmt(b,info)
|
||||
if (info == psb_success_) call a%cmp_nerwp(info)
|
||||
|
||||
end subroutine psb_z_mv_ecsr_from_fmt
|
||||
|
||||
subroutine psb_z_cp_ecsr_from_fmt(a,b,info)
|
||||
use psb_const_mod
|
||||
use psb_z_base_mat_mod
|
||||
use psb_realloc_mod
|
||||
use psb_z_csr_mat_mod, psb_protect_name => psb_z_cp_ecsr_from_fmt
|
||||
implicit none
|
||||
|
||||
class(psb_z_ecsr_sparse_mat), intent(inout) :: a
|
||||
class(psb_z_base_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
info = psb_success_
|
||||
call a%psb_z_csr_sparse_mat%cp_from_fmt(b,info)
|
||||
if (info == psb_success_) call a%cmp_nerwp(info)
|
||||
|
||||
end subroutine psb_z_cp_ecsr_from_fmt
|
||||
|
||||
|
||||
!
|
||||
!
|
||||
|
||||
@@ -175,13 +175,14 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, mold)
|
||||
block
|
||||
character(len=1024) :: fname
|
||||
type(psb_c_coo_sparse_mat) :: acoo
|
||||
type(psb_c_csr_sparse_mat), allocatable :: aclip, andclip
|
||||
type(psb_c_csr_sparse_mat), allocatable :: aclip
|
||||
type(psb_c_ecsr_sparse_mat), allocatable :: andclip
|
||||
allocate(aclip,andclip)
|
||||
call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.)
|
||||
call aclip%mv_from_coo(acoo,info)
|
||||
allocate(a%ad,mold=a%a)
|
||||
call a%ad%mv_from_coo(acoo,info)
|
||||
call a%a%csclip(acoo,info,jmin=n_row+1,jmax=n_col,rscale=.false.,cscale=.false.)
|
||||
call andclip%mv_from_coo(acoo,info)
|
||||
call move_alloc(aclip,a%ad)
|
||||
call move_alloc(andclip,a%and)
|
||||
if (.false.) then
|
||||
write(fname,'(a,i2.2,a)') 'adclip_',me,'.mtx'
|
||||
|
||||
@@ -175,13 +175,14 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold)
|
||||
block
|
||||
character(len=1024) :: fname
|
||||
type(psb_d_coo_sparse_mat) :: acoo
|
||||
type(psb_d_csr_sparse_mat), allocatable :: aclip, andclip
|
||||
type(psb_d_csr_sparse_mat), allocatable :: aclip
|
||||
type(psb_d_ecsr_sparse_mat), allocatable :: andclip
|
||||
allocate(aclip,andclip)
|
||||
call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.)
|
||||
call aclip%mv_from_coo(acoo,info)
|
||||
allocate(a%ad,mold=a%a)
|
||||
call a%ad%mv_from_coo(acoo,info)
|
||||
call a%a%csclip(acoo,info,jmin=n_row+1,jmax=n_col,rscale=.false.,cscale=.false.)
|
||||
call andclip%mv_from_coo(acoo,info)
|
||||
call move_alloc(aclip,a%ad)
|
||||
call move_alloc(andclip,a%and)
|
||||
if (.false.) then
|
||||
write(fname,'(a,i2.2,a)') 'adclip_',me,'.mtx'
|
||||
|
||||
@@ -175,13 +175,14 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, mold)
|
||||
block
|
||||
character(len=1024) :: fname
|
||||
type(psb_s_coo_sparse_mat) :: acoo
|
||||
type(psb_s_csr_sparse_mat), allocatable :: aclip, andclip
|
||||
type(psb_s_csr_sparse_mat), allocatable :: aclip
|
||||
type(psb_s_ecsr_sparse_mat), allocatable :: andclip
|
||||
allocate(aclip,andclip)
|
||||
call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.)
|
||||
call aclip%mv_from_coo(acoo,info)
|
||||
allocate(a%ad,mold=a%a)
|
||||
call a%ad%mv_from_coo(acoo,info)
|
||||
call a%a%csclip(acoo,info,jmin=n_row+1,jmax=n_col,rscale=.false.,cscale=.false.)
|
||||
call andclip%mv_from_coo(acoo,info)
|
||||
call move_alloc(aclip,a%ad)
|
||||
call move_alloc(andclip,a%and)
|
||||
if (.false.) then
|
||||
write(fname,'(a,i2.2,a)') 'adclip_',me,'.mtx'
|
||||
|
||||
@@ -175,13 +175,14 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, mold)
|
||||
block
|
||||
character(len=1024) :: fname
|
||||
type(psb_z_coo_sparse_mat) :: acoo
|
||||
type(psb_z_csr_sparse_mat), allocatable :: aclip, andclip
|
||||
type(psb_z_csr_sparse_mat), allocatable :: aclip
|
||||
type(psb_z_ecsr_sparse_mat), allocatable :: andclip
|
||||
allocate(aclip,andclip)
|
||||
call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.)
|
||||
call aclip%mv_from_coo(acoo,info)
|
||||
allocate(a%ad,mold=a%a)
|
||||
call a%ad%mv_from_coo(acoo,info)
|
||||
call a%a%csclip(acoo,info,jmin=n_row+1,jmax=n_col,rscale=.false.,cscale=.false.)
|
||||
call andclip%mv_from_coo(acoo,info)
|
||||
call move_alloc(aclip,a%ad)
|
||||
call move_alloc(andclip,a%and)
|
||||
if (.false.) then
|
||||
write(fname,'(a,i2.2,a)') 'adclip_',me,'.mtx'
|
||||
|
||||
@@ -2,7 +2,7 @@
|
||||
BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES FCG CGR
|
||||
BJAC Preconditioner NONE DIAG BJAC
|
||||
CSR Storage format for matrix A: CSR COO
|
||||
140 Domain size (acutal system is this**3 (pde3d) or **2 (pde2d) )
|
||||
100 Domain size (acutal system is this**3 (pde3d) or **2 (pde2d) )
|
||||
3 Partition: 1 BLOCK 3 3D
|
||||
2 Stopping criterion 1 2
|
||||
0100 MAXIT
|
||||
|
||||
Reference in New Issue
Block a user