New ZCSRLI, first version

lambdaI
Salvatore Filippone 4 years ago
parent 7a849d65c2
commit 82d65ce5b1

@ -60,6 +60,7 @@ SERIAL_MODS=serial/psb_s_serial_mod.o serial/psb_d_serial_mod.o \
auxil/psb_d_hsort_x_mod.o \
auxil/psb_c_hsort_x_mod.o \
auxil/psb_z_hsort_x_mod.o \
serial/psb_z_csrli_mat_mod.o \
serial/psb_base_mat_mod.o serial/psb_mat_mod.o\
serial/psb_s_base_mat_mod.o serial/psb_s_csr_mat_mod.o serial/psb_s_csc_mat_mod.o serial/psb_s_mat_mod.o \
serial/psb_d_base_mat_mod.o serial/psb_d_csr_mat_mod.o serial/psb_d_csc_mat_mod.o serial/psb_d_mat_mod.o \
@ -241,8 +242,8 @@ serial/psb_s_base_mat_mod.o serial/psb_d_base_mat_mod.o serial/psb_c_base_mat_mo
serial/psb_s_base_mat_mod.o: serial/psb_s_base_vect_mod.o
serial/psb_d_base_mat_mod.o: serial/psb_d_base_vect_mod.o
#serial/psb_ld_base_mat_mod.o: serial/psb_d_base_vect_mod.o
serial/psb_c_base_mat_mod.o: serial/psb_c_base_vect_mod.o
serial/psb_z_base_mat_mod.o: serial/psb_z_base_vect_mod.o
serial/psb_c_base_mat_mod.o: serial/psb_c_base_vect_mod.o serial/psb_s_base_mat_mod.o
serial/psb_z_base_mat_mod.o: serial/psb_z_base_vect_mod.o serial/psb_d_base_mat_mod.o
serial/psb_l_base_vect_mod.o: serial/psb_i_base_vect_mod.o
serial/psb_c_base_vect_mod.o serial/psb_s_base_vect_mod.o serial/psb_d_base_vect_mod.o serial/psb_z_base_vect_mod.o: serial/psb_i_base_vect_mod.o serial/psb_l_base_vect_mod.o
serial/psb_i_base_vect_mod.o serial/psb_l_base_vect_mod.o serial/psb_c_base_vect_mod.o serial/psb_s_base_vect_mod.o serial/psb_d_base_vect_mod.o serial/psb_z_base_vect_mod.o: auxil/psi_serial_mod.o psb_realloc_mod.o
@ -253,11 +254,11 @@ serial/psb_d_mat_mod.o: serial/psb_d_base_mat_mod.o serial/psb_d_csr_mat_mod.o s
serial/psb_c_mat_mod.o: serial/psb_c_base_mat_mod.o serial/psb_c_csr_mat_mod.o serial/psb_c_csc_mat_mod.o serial/psb_c_vect_mod.o \
serial/psb_i_vect_mod.o serial/psb_l_vect_mod.o
serial/psb_z_mat_mod.o: serial/psb_z_base_mat_mod.o serial/psb_z_csr_mat_mod.o serial/psb_z_csc_mat_mod.o serial/psb_z_vect_mod.o \
serial/psb_i_vect_mod.o serial/psb_l_vect_mod.o
serial/psb_i_vect_mod.o serial/psb_l_vect_mod.o serial/psb_z_csrli_mat_mod.o
serial/psb_s_csc_mat_mod.o serial/psb_s_csr_mat_mod.o serial/psb_ls_csr_mat_mod.o: serial/psb_s_base_mat_mod.o
serial/psb_d_csc_mat_mod.o serial/psb_d_csr_mat_mod.o serial/psb_ld_csr_mat_mod.o: serial/psb_d_base_mat_mod.o
serial/psb_c_csc_mat_mod.o serial/psb_c_csr_mat_mod.o serial/psb_lc_csr_mat_mod.o: serial/psb_c_base_mat_mod.o
serial/psb_z_csc_mat_mod.o serial/psb_z_csr_mat_mod.o serial/psb_lz_csr_mat_mod.o: serial/psb_z_base_mat_mod.o
serial/psb_z_csrli_mat_mod.o serial/psb_z_csc_mat_mod.o serial/psb_z_csr_mat_mod.o serial/psb_lz_csr_mat_mod.o: serial/psb_z_base_mat_mod.o
serial/psb_mat_mod.o: serial/psb_vect_mod.o serial/psb_s_mat_mod.o serial/psb_d_mat_mod.o serial/psb_c_mat_mod.o serial/psb_z_mat_mod.o
serial/psb_serial_mod.o: serial/psb_s_serial_mod.o serial/psb_d_serial_mod.o serial/psb_c_serial_mod.o serial/psb_z_serial_mod.o auxil/psi_serial_mod.o

@ -35,7 +35,7 @@ module psb_c_base_mat_mod
use psb_base_mat_mod
use psb_c_base_vect_mod
use psb_s_base_mat_mod
!> \namespace psb_base_mod \class psb_c_base_sparse_mat
!! \extends psb_base_mat_mod::psb_base_sparse_mat
@ -90,6 +90,8 @@ module psb_c_base_mat_mod
procedure, pass(a) :: mv_from_lcoo => psb_c_base_mv_from_lcoo
procedure, pass(a) :: mv_to_lfmt => psb_c_base_mv_to_lfmt
procedure, pass(a) :: mv_from_lfmt => psb_c_base_mv_from_lfmt
procedure, pass(a) :: cp_to_real => psb_c_base_cp_to_real
procedure, pass(a) :: cp_from_real => psb_c_base_cp_from_real
!
@ -182,6 +184,8 @@ module psb_c_base_mat_mod
!
procedure, pass(a) :: cp_to_lcoo => psb_c_cp_coo_to_lcoo
procedure, pass(a) :: cp_from_lcoo => psb_c_cp_coo_from_lcoo
procedure, pass(a) :: cp_to_coo_real => psb_c_cp_coo_to_coo_real
procedure, pass(a) :: cp_from_coo_real => psb_c_cp_coo_from_coo_real
procedure, pass(a) :: csput_a => psb_c_coo_csput_a
procedure, pass(a) :: get_diag => psb_c_coo_get_diag
@ -1069,7 +1073,22 @@ module psb_c_base_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_mv_from_lfmt
end interface
interface
subroutine psb_c_base_cp_to_real(a,b,info)
import
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_cp_to_real
end interface
interface
subroutine psb_c_base_cp_from_real(a,b,info)
import
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_cp_from_real
end interface
!
!>
@ -1954,6 +1973,23 @@ module psb_c_base_mat_mod
end subroutine psb_c_cp_coo_from_lcoo
end interface
interface
subroutine psb_c_cp_coo_to_coo_real(a,b,info)
import
class(psb_c_coo_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_cp_coo_to_coo_real
end interface
interface
subroutine psb_c_cp_coo_from_coo_real(a,b,info)
import
class(psb_c_coo_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_cp_coo_from_coo_real
end interface
!>
!! \memberof psb_c_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_c_base_cp_from_coo

@ -36,7 +36,6 @@ module psb_d_base_mat_mod
use psb_base_mat_mod
use psb_d_base_vect_mod
!> \namespace psb_base_mod \class psb_d_base_sparse_mat
!! \extends psb_base_mat_mod::psb_base_sparse_mat
!! The psb_d_base_sparse_mat type, extending psb_base_sparse_mat,
@ -1070,7 +1069,6 @@ module psb_d_base_mat_mod
end subroutine psb_d_base_mv_from_lfmt
end interface
!
!>
!! \memberof psb_d_base_sparse_mat
@ -1954,6 +1952,7 @@ module psb_d_base_mat_mod
end subroutine psb_d_cp_coo_from_lcoo
end interface
!>
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_cp_from_coo

@ -36,7 +36,6 @@ module psb_s_base_mat_mod
use psb_base_mat_mod
use psb_s_base_vect_mod
!> \namespace psb_base_mod \class psb_s_base_sparse_mat
!! \extends psb_base_mat_mod::psb_base_sparse_mat
!! The psb_s_base_sparse_mat type, extending psb_base_sparse_mat,
@ -1070,7 +1069,6 @@ module psb_s_base_mat_mod
end subroutine psb_s_base_mv_from_lfmt
end interface
!
!>
!! \memberof psb_s_base_sparse_mat
@ -1954,6 +1952,7 @@ module psb_s_base_mat_mod
end subroutine psb_s_cp_coo_from_lcoo
end interface
!>
!! \memberof psb_s_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_s_base_cp_from_coo

@ -35,7 +35,7 @@ module psb_z_base_mat_mod
use psb_base_mat_mod
use psb_z_base_vect_mod
use psb_d_base_mat_mod
!> \namespace psb_base_mod \class psb_z_base_sparse_mat
!! \extends psb_base_mat_mod::psb_base_sparse_mat
@ -90,6 +90,8 @@ module psb_z_base_mat_mod
procedure, pass(a) :: mv_from_lcoo => psb_z_base_mv_from_lcoo
procedure, pass(a) :: mv_to_lfmt => psb_z_base_mv_to_lfmt
procedure, pass(a) :: mv_from_lfmt => psb_z_base_mv_from_lfmt
procedure, pass(a) :: cp_to_real => psb_z_base_cp_to_real
procedure, pass(a) :: cp_from_real => psb_z_base_cp_from_real
!
@ -182,6 +184,8 @@ module psb_z_base_mat_mod
!
procedure, pass(a) :: cp_to_lcoo => psb_z_cp_coo_to_lcoo
procedure, pass(a) :: cp_from_lcoo => psb_z_cp_coo_from_lcoo
procedure, pass(a) :: cp_to_coo_real => psb_z_cp_coo_to_coo_real
procedure, pass(a) :: cp_from_coo_real => psb_z_cp_coo_from_coo_real
procedure, pass(a) :: csput_a => psb_z_coo_csput_a
procedure, pass(a) :: get_diag => psb_z_coo_get_diag
@ -1069,7 +1073,22 @@ module psb_z_base_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_mv_from_lfmt
end interface
interface
subroutine psb_z_base_cp_to_real(a,b,info)
import
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_cp_to_real
end interface
interface
subroutine psb_z_base_cp_from_real(a,b,info)
import
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_cp_from_real
end interface
!
!>
@ -1954,6 +1973,23 @@ module psb_z_base_mat_mod
end subroutine psb_z_cp_coo_from_lcoo
end interface
interface
subroutine psb_z_cp_coo_to_coo_real(a,b,info)
import
class(psb_z_coo_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_cp_coo_to_coo_real
end interface
interface
subroutine psb_z_cp_coo_from_coo_real(a,b,info)
import
class(psb_z_coo_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_cp_coo_from_coo_real
end interface
!>
!! \memberof psb_z_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_cp_from_coo

@ -48,7 +48,7 @@ module psb_z_csrli_mat_mod
type, extends(psb_z_csr_sparse_mat) :: psb_z_csrli_sparse_mat
complex(psb_dpk_) :: lambda
complex(psb_dpk_) :: lambda=zzero
contains
procedure, nopass :: get_fmt => z_csrli_get_fmt
@ -57,15 +57,13 @@ module psb_z_csrli_mat_mod
procedure, pass(a) :: inner_cssm => psb_z_csrli_cssm
procedure, pass(a) :: inner_cssv => psb_z_csrli_cssv
procedure, pass(a) :: scals => psb_z_csrli_scals
!procedure, pass(a) :: scalv => psb_z_csrli_scal
procedure, pass(a) :: scalv => psb_z_csrli_scal
procedure, pass(a) :: maxval => psb_z_csrli_maxval
procedure, pass(a) :: spnmi => psb_z_csrli_csnmi
procedure, pass(a) :: rowsum => psb_z_csrli_rowsum
procedure, pass(a) :: arwsum => psb_z_csrli_arwsum
procedure, pass(a) :: colsum => psb_z_csrli_colsum
procedure, pass(a) :: aclsum => psb_z_csrli_aclsum
!!$ procedure, pass(a) :: reallocate_nz => psb_z_csrli_reallocate_nz
!!$ procedure, pass(a) :: allocate_mnnz => psb_z_csrli_allocate_mnnz
procedure, pass(a) :: tril => psb_z_csrli_tril
procedure, pass(a) :: triu => psb_z_csrli_triu
procedure, pass(a) :: cp_to_coo => psb_z_cp_csrli_to_coo
@ -83,6 +81,9 @@ module psb_z_csrli_mat_mod
procedure, pass(a) :: free => z_csrli_free
procedure, pass(a) :: mold => psb_z_csrli_mold
procedure, pass(a) :: set_lambda => z_csrli_set_lambda
procedure, pass(a) :: get_lambda => z_csrli_get_lambda
end type psb_z_csrli_sparse_mat
private :: z_csrli_get_nzeros, z_csrli_free, z_csrli_get_fmt, &
@ -109,14 +110,14 @@ module psb_z_csrli_mat_mod
end subroutine psb_z_csrli_reinit
end interface
!> \memberof psb_z_csrli_sparse_mat
!| \see psb_base_mat_mod::psb_base_trim
interface
subroutine psb_z_csrli_trim(a)
import
class(psb_z_csrli_sparse_mat), intent(inout) :: a
end subroutine psb_z_csrli_trim
end interface
!!$ !> \memberof psb_z_csrli_sparse_mat
!!$ !| \see psb_base_mat_mod::psb_base_trim
!!$ interface
!!$ subroutine psb_z_csrli_trim(a)
!!$ import
!!$ class(psb_z_csrli_sparse_mat), intent(inout) :: a
!!$ end subroutine psb_z_csrli_trim
!!$ end interface
!> \memberof psb_z_csrli_sparse_mat
@ -246,14 +247,14 @@ module psb_z_csrli_mat_mod
!! \memberof psb_z_csrli_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_clean_zeros
!
interface
subroutine psb_z_csrli_clean_zeros(a, info)
import
class(psb_z_csrli_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_csrli_clean_zeros
end interface
!!$ interface
!!$ subroutine psb_z_csrli_clean_zeros(a, info)
!!$ import
!!$ class(psb_z_csrli_sparse_mat), intent(inout) :: a
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine psb_z_csrli_clean_zeros
!!$ end interface
!!$
!> \memberof psb_z_csrli_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_cp_to_coo
interface
@ -363,36 +364,36 @@ module psb_z_csrli_mat_mod
end interface
!> \memberof psb_z_csrli_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_csput_a
interface
subroutine psb_z_csrli_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info)
import
class(psb_z_csrli_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),&
& imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_csrli_csput_a
end interface
!> \memberof psb_z_csrli_sparse_mat
!! \see psb_base_mat_mod::psb_base_csgetptn
interface
subroutine psb_z_csrli_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import
class(psb_z_csrli_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_), intent(out) :: nz
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_z_csrli_csgetptn
end interface
!!$ !> \memberof psb_z_csrli_sparse_mat
!!$ !! \see psb_z_base_mat_mod::psb_z_base_csput_a
!!$ interface
!!$ subroutine psb_z_csrli_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info)
!!$ import
!!$ class(psb_z_csrli_sparse_mat), intent(inout) :: a
!!$ complex(psb_dpk_), intent(in) :: val(:)
!!$ integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),&
!!$ & imin,imax,jmin,jmax
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine psb_z_csrli_csput_a
!!$ end interface
!!$
!!$ !> \memberof psb_z_csrli_sparse_mat
!!$ !! \see psb_base_mat_mod::psb_base_csgetptn
!!$ interface
!!$ subroutine psb_z_csrli_csgetptn(imin,imax,a,nz,ia,ja,info,&
!!$ & jmin,jmax,iren,append,nzin,rscale,cscale)
!!$ import
!!$ class(psb_z_csrli_sparse_mat), intent(in) :: a
!!$ integer(psb_ipk_), intent(in) :: imin,imax
!!$ integer(psb_ipk_), intent(out) :: nz
!!$ integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
!!$ integer(psb_ipk_),intent(out) :: info
!!$ logical, intent(in), optional :: append
!!$ integer(psb_ipk_), intent(in), optional :: iren(:)
!!$ integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
!!$ logical, intent(in), optional :: rscale,cscale
!!$ end subroutine psb_z_csrli_csgetptn
!!$ end interface
!> \memberof psb_z_csrli_sparse_mat
!! \see psb_z_base_mat_mod::psb_z_base_csgetrow
@ -580,6 +581,21 @@ contains
res = 'CSRLI'
end function z_csrli_get_fmt
function z_csrli_get_lambda(a) result(res)
implicit none
class(psb_z_csrli_sparse_mat), intent(in) :: a
complex(psb_dpk_) :: res
res = a%lambda
end function z_csrli_get_lambda
subroutine z_csrli_set_lambda(a,val)
implicit none
class(psb_z_csrli_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: val
a%lambda = val
end subroutine z_csrli_set_lambda
! == ===================================
!
!

@ -81,7 +81,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_csc_mat_mod, only : psb_z_csc_sparse_mat, psb_lz_csc_sparse_mat
use psb_z_csrli_mat_mod
type :: psb_zspmat_type
class(psb_z_base_sparse_mat), allocatable :: a

@ -16,7 +16,7 @@ DOBJS=psb_d_csr_impl.o psb_d_coo_impl.o psb_d_csc_impl.o psb_d_mat_impl.o
COBJS=psb_c_csr_impl.o psb_c_coo_impl.o psb_c_csc_impl.o psb_c_mat_impl.o
#\
psb_c_lcoo_impl.o psb_c_lcsr_impl.o
ZOBJS=psb_z_csr_impl.o psb_z_coo_impl.o psb_z_csc_impl.o psb_z_mat_impl.o
ZOBJS=psb_z_csr_impl.o psb_z_coo_impl.o psb_z_csc_impl.o psb_z_mat_impl.o psb_z_csrli_impl.o
#\
psb_z_lcoo_impl.o psb_z_lcsr_impl.o

@ -2507,6 +2507,81 @@ subroutine psb_c_base_mv_from_lfmt(a,b,info)
end subroutine psb_c_base_mv_from_lfmt
subroutine psb_c_base_cp_to_real(a,b,info)
use psb_c_base_mat_mod, psb_protect_name => psb_c_base_cp_to_real
use psb_s_base_mat_mod
use psb_error_mod
use psb_realloc_mod
implicit none
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_real'
logical, parameter :: debug=.false.
type(psb_s_coo_sparse_mat) :: rtemp
type(psb_c_coo_sparse_mat) :: ctemp
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
call a%sync()
call a%cp_to_coo(ctemp,info)
call ctemp%cp_to_coo_real(rtemp,info)
call ctemp%free()
call rtemp%cp_to_fmt(b,info)
call rtemp%free()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_c_base_cp_to_real
subroutine psb_c_base_cp_from_real(a,b,info)
use psb_c_base_mat_mod, psb_protect_name => psb_c_base_cp_from_real
use psb_s_base_mat_mod
use psb_error_mod
use psb_realloc_mod
implicit none
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_real'
logical, parameter :: debug=.false.
type(psb_s_coo_sparse_mat) :: rtemp
type(psb_c_coo_sparse_mat) :: ctemp
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
call rtemp%cp_from_fmt(b,info)
call ctemp%cp_from_coo_real(rtemp,info)
call rtemp%free()
call a%mv_from_coo(ctemp,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_c_base_cp_from_real
!
!
! lc implementation

@ -5114,6 +5114,92 @@ subroutine psb_c_cp_coo_from_lcoo(a,b,info)
end subroutine psb_c_cp_coo_from_lcoo
subroutine psb_c_cp_coo_to_coo_real(a,b,info)
use psb_error_mod
use psb_c_base_mat_mod, psb_protect_name => psb_c_cp_coo_to_coo_real
implicit none
class(psb_c_coo_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_coo_real'
logical, parameter :: debug=.false.
integer(psb_ipk_) :: m,n,nz
call psb_erractionsave(err_act)
info = psb_success_
call a%sync()
m = a%get_nrows()
n = a%get_ncols()
nz = a%get_nzeros()
call b%set_nrows(m)
call b%set_ncols(n)
call b%reallocate(nz)
b%ia(1:nz) = a%ia(1:nz)
b%ja(1:nz) = a%ja(1:nz)
b%val(1:nz) = real(a%val(1:nz))
call b%set_nzeros(nz)
call b%set_sorted(a%is_sorted())
call b%set_host()
call psb_erractionrestore(err_act)
return
9999 continue
call psb_errpush(info,name)
call psb_error_handler(err_act)
return
end subroutine psb_c_cp_coo_to_coo_real
subroutine psb_c_cp_coo_from_coo_real(a,b,info)
use psb_error_mod
use psb_c_base_mat_mod, psb_protect_name => psb_c_cp_coo_from_coo_real
implicit none
class(psb_c_coo_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_coo_real'
logical, parameter :: debug=.false.
integer(psb_ipk_) :: m,n,nz
call psb_erractionsave(err_act)
info = psb_success_
call b%sync()
m = b%get_nrows()
n = b%get_ncols()
nz = b%get_nzeros()
call a%set_nrows(m)
call a%set_ncols(n)
call a%reallocate(nz)
a%ia(1:nz) = b%ia(1:nz)
a%ja(1:nz) = b%ja(1:nz)
a%val(1:nz) = b%val(1:nz)
call a%set_nzeros(nz)
call a%set_sorted(b%is_sorted())
call a%set_host()
call psb_erractionrestore(err_act)
return
9999 continue
call psb_errpush(info,name)
call psb_error_handler(err_act)
return
end subroutine psb_c_cp_coo_from_coo_real
!
!

@ -2507,6 +2507,81 @@ subroutine psb_z_base_mv_from_lfmt(a,b,info)
end subroutine psb_z_base_mv_from_lfmt
subroutine psb_z_base_cp_to_real(a,b,info)
use psb_z_base_mat_mod, psb_protect_name => psb_z_base_cp_to_real
use psb_d_base_mat_mod
use psb_error_mod
use psb_realloc_mod
implicit none
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_real'
logical, parameter :: debug=.false.
type(psb_d_coo_sparse_mat) :: rtemp
type(psb_z_coo_sparse_mat) :: ctemp
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
call a%sync()
call a%cp_to_coo(ctemp,info)
call ctemp%cp_to_coo_real(rtemp,info)
call ctemp%free()
call rtemp%cp_to_fmt(b,info)
call rtemp%free()
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_z_base_cp_to_real
subroutine psb_z_base_cp_from_real(a,b,info)
use psb_z_base_mat_mod, psb_protect_name => psb_z_base_cp_from_real
use psb_d_base_mat_mod
use psb_error_mod
use psb_realloc_mod
implicit none
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_real'
logical, parameter :: debug=.false.
type(psb_d_coo_sparse_mat) :: rtemp
type(psb_z_coo_sparse_mat) :: ctemp
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
call rtemp%cp_from_fmt(b,info)
call ctemp%cp_from_coo_real(rtemp,info)
call rtemp%free()
call a%mv_from_coo(ctemp,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_z_base_cp_from_real
!
!
! lz implementation

@ -5114,6 +5114,92 @@ subroutine psb_z_cp_coo_from_lcoo(a,b,info)
end subroutine psb_z_cp_coo_from_lcoo
subroutine psb_z_cp_coo_to_coo_real(a,b,info)
use psb_error_mod
use psb_z_base_mat_mod, psb_protect_name => psb_z_cp_coo_to_coo_real
implicit none
class(psb_z_coo_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_coo_real'
logical, parameter :: debug=.false.
integer(psb_ipk_) :: m,n,nz
call psb_erractionsave(err_act)
info = psb_success_
call a%sync()
m = a%get_nrows()
n = a%get_ncols()
nz = a%get_nzeros()
call b%set_nrows(m)
call b%set_ncols(n)
call b%reallocate(nz)
b%ia(1:nz) = a%ia(1:nz)
b%ja(1:nz) = a%ja(1:nz)
b%val(1:nz) = real(a%val(1:nz))
call b%set_nzeros(nz)
call b%set_sorted(a%is_sorted())
call b%set_host()
call psb_erractionrestore(err_act)
return
9999 continue
call psb_errpush(info,name)
call psb_error_handler(err_act)
return
end subroutine psb_z_cp_coo_to_coo_real
subroutine psb_z_cp_coo_from_coo_real(a,b,info)
use psb_error_mod
use psb_z_base_mat_mod, psb_protect_name => psb_z_cp_coo_from_coo_real
implicit none
class(psb_z_coo_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_coo_real'
logical, parameter :: debug=.false.
integer(psb_ipk_) :: m,n,nz
call psb_erractionsave(err_act)
info = psb_success_
call b%sync()
m = b%get_nrows()
n = b%get_ncols()
nz = b%get_nzeros()
call a%set_nrows(m)
call a%set_ncols(n)
call a%reallocate(nz)
a%ia(1:nz) = b%ia(1:nz)
a%ja(1:nz) = b%ja(1:nz)
a%val(1:nz) = b%val(1:nz)
call a%set_nzeros(nz)
call a%set_sorted(b%is_sorted())
call a%set_host()
call psb_erractionrestore(err_act)
return
9999 continue
call psb_errpush(info,name)
call psb_error_handler(err_act)
return
end subroutine psb_z_cp_coo_from_coo_real
!
!

@ -16,11 +16,15 @@ FINCLUDES=$(FMFLAG)$(MODDIR) $(FMFLAG).
EXEDIR=./runs
all: runsd psb_d_pde3d psb_s_pde3d psb_d_pde2d psb_s_pde2d
all: runsd psb_tzcsrli psb_d_pde3d psb_s_pde3d psb_d_pde2d psb_s_pde2d
runsd:
(if test ! -d runs ; then mkdir runs; fi)
psb_tzcsrli: psb_tzcsrli.o
$(FLINK) psb_tzcsrli.o -o psb_tzcsrli $(PSBLAS_LIB) $(LDLIBS)
/bin/mv psb_tzcsrli $(EXEDIR)
psb_d_pde3d: psb_d_pde3d.o
$(FLINK) psb_d_pde3d.o -o psb_d_pde3d $(PSBLAS_LIB) $(LDLIBS)
/bin/mv psb_d_pde3d $(EXEDIR)
@ -41,7 +45,7 @@ psb_s_pde2d: psb_s_pde2d.o
clean:
/bin/rm -f psb_d_pde3d.o psb_s_pde3d.o psb_d_pde2d.o psb_s_pde2d.o *$(.mod) \
/bin/rm -f psb_tzcsrli.o psb_d_pde3d.o psb_s_pde3d.o psb_d_pde2d.o psb_s_pde2d.o *$(.mod) \
$(EXEDIR)/psb_d_pde3d $(EXEDIR)/psb_s_pde3d $(EXEDIR)/psb_d_pde2d $(EXEDIR)/psb_s_pde2d
verycleanlib:
(cd ../..; make veryclean)

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