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_d_mat_mod.f03
 base/modules/psb_s_mat_mod.f03
 test/fileread/runs/dfs.inp
 test/serial/d_coo_matgen.f03
 test/serial/d_matgen.f03
 test/serial/psb_d_cxx_impl.f03
 test/serial/psb_d_cxx_mat_mod.f03

Fixes: introduced clip_diag for use with point Jacobi preconditioners.
psblas3-type-indexed
Salvatore Filippone 15 years ago
parent 086d5187b4
commit d4cf5acc20
7 changed files with 1351 additions and 430 deletions
Show Stats Download Patch File Download Diff File

124
base/modules/psb_d_mat_mod.f03
Unescape Escape View File

@ -56,6 +56,9 @@ module psb_d_mat_mod
procedure, pass(a) :: d_csclip
procedure, pass(a) :: d_b_csclip
generic, public :: csclip => d_b_csclip, d_csclip
procedure, pass(a) :: d_clip_d_ip
procedure, pass(a) :: d_clip_d
generic, public :: clip_diag => d_clip_d_ip, d_clip_d
procedure, pass(a) :: reall => reallocate_nz
procedure, pass(a) :: get_neigh
procedure, pass(a) :: d_cscnv
@ -99,7 +102,7 @@ module psb_d_mat_mod
private :: get_nrows, get_ncols, get_nzeros, get_size, &
& get_state, get_dupl, is_null, is_bld, is_upd, &
& is_asb, is_sorted, is_upper, is_lower, is_triangle, &
& is_unit, get_neigh, csall, csput, d_csgetrow,&
& is_unit, get_neigh, csall, csput, d_csgetrow, d_clip_d_ip, d_clip_d,&
& d_csgetblk, d_csclip, d_b_csclip, d_cscnv, d_cscnv_ip, &
& reallocate_nz, free, trim, &
& sparse_print, reinit, &
@ -1599,6 +1602,125 @@ contains
end subroutine d_cscnv_base
subroutine d_clip_d(a,b,info)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_d_base_mat_mod
implicit none
class(psb_d_sparse_mat), intent(in) :: a
class(psb_d_sparse_mat), intent(out) :: b
integer,intent(out) :: info
Integer :: err_act
character(len=20) :: name='clip_diag'
logical, parameter :: debug=.false.
type(psb_d_coo_sparse_mat), allocatable :: acoo
integer :: i, j, nz
info = 0
call psb_erractionsave(err_act)
if (a%is_null()) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
allocate(acoo,stat=info)
if (info == 0) call a%a%cp_to_coo(acoo,info)
if (info /= 0) then
info = 4000
call psb_errpush(info,name)
goto 9999
endif
nz = acoo%get_nzeros()
j = 0
do i=1, nz
if (acoo%ia(i) /= acoo%ja(i)) then
j = j + 1
acoo%ia(j) = acoo%ia(i)
acoo%ja(j) = acoo%ja(i)
acoo%val(j) = acoo%val(i)
end if
end do
call acoo%set_nzeros(j)
call acoo%trim()
call b%mv_from(acoo)
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 d_clip_d
subroutine d_clip_d_ip(a,info)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_d_base_mat_mod
implicit none
class(psb_d_sparse_mat), intent(inout) :: a
integer,intent(out) :: info
Integer :: err_act
character(len=20) :: name='clip_diag'
logical, parameter :: debug=.false.
type(psb_d_coo_sparse_mat), allocatable :: acoo
integer :: i, j, nz
info = 0
call psb_erractionsave(err_act)
if (a%is_null()) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
allocate(acoo,stat=info)
if (info == 0) call a%a%mv_to_coo(acoo,info)
if (info /= 0) then
info = 4000
call psb_errpush(info,name)
goto 9999
endif
nz = acoo%get_nzeros()
j = 0
do i=1, nz
if (acoo%ia(i) /= acoo%ja(i)) then
j = j + 1
acoo%ia(j) = acoo%ia(i)
acoo%ja(j) = acoo%ja(i)
acoo%val(j) = acoo%val(i)
end if
end do
call acoo%set_nzeros(j)
call acoo%trim()
call a%mv_from(acoo)
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 d_clip_d_ip
subroutine d_mv_from(a,b)
use psb_error_mod

313
base/modules/psb_s_mat_mod.f03
Unescape Escape View File

@ -54,6 +54,9 @@ module psb_s_mat_mod
procedure, pass(a) :: s_csgetblk
generic, public :: csget => s_csgetptn, s_csgetrow, s_csgetblk
procedure, pass(a) :: csclip
procedure, pass(a) :: s_clip_d_ip
procedure, pass(a) :: s_clip_d
generic, public :: clip_diag => s_clip_d_ip, s_clip_d
procedure, pass(a) :: reall => reallocate_nz
procedure, pass(a) :: get_neigh
procedure, pass(a) :: s_cscnv
@ -63,8 +66,19 @@ module psb_s_mat_mod
procedure, pass(a) :: print => sparse_print
procedure, pass(a) :: s_mv_from
generic, public :: mv_from => s_mv_from
procedure, pass(a) :: s_mv_to
generic, public :: mv_to => s_mv_to
procedure, pass(a) :: s_cp_from
generic, public :: cp_from => s_cp_from
procedure, pass(a) :: s_cp_to
generic, public :: cp_to => s_cp_to
procedure, pass(a) :: s_transp_1mat
procedure, pass(a) :: s_transp_2mat
generic, public :: transp => s_transp_1mat, s_transp_2mat
procedure, pass(a) :: s_transc_1mat
procedure, pass(a) :: s_transc_2mat
generic, public :: transc => s_transc_1mat, s_transc_2mat
! Computational routines
@ -85,7 +99,7 @@ module psb_s_mat_mod
private :: get_nrows, get_ncols, get_nzeros, get_size, &
& get_state, get_dupl, is_null, is_bld, is_upd, &
& is_asb, is_sorted, is_upper, is_lower, is_triangle, &
& is_unit, get_neigh, csall, csput, s_csgetrow,&
& is_unit, get_neigh, csall, csput, s_csgetrow, s_clip_d_ip, s_clip_d,&
& s_csgetblk, csclip, s_cscnv, s_cscnv_ip, &
& reallocate_nz, free, trim, &
& sparse_print, reinit, &
@ -94,7 +108,9 @@ module psb_s_mat_mod
& set_upd, set_asb, set_sorted, &
& set_upper, set_lower, set_triangle, &
& set_unit, get_diag, get_nz_row, s_csgetptn, &
& s_mv_from, s_cp_from
& s_mv_from, s_mv_to, s_cp_from, s_cp_to,&
& s_transp_1mat, s_transp_2mat, &
& s_transc_1mat, s_transc_2mat
interface psb_sizeof
module procedure s_sizeof
@ -1486,6 +1502,126 @@ contains
end subroutine s_cscnv_ip
subroutine s_clip_d(a,b,info)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_s_base_mat_mod
implicit none
class(psb_s_sparse_mat), intent(in) :: a
class(psb_s_sparse_mat), intent(out) :: b
integer,intent(out) :: info
Integer :: err_act
character(len=20) :: name='clip_diag'
logical, parameter :: debug=.false.
type(psb_s_coo_sparse_mat), allocatable :: acoo
integer :: i, j, nz
info = 0
call psb_erractionsave(err_act)
if (a%is_null()) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
allocate(acoo,stat=info)
if (info == 0) call a%a%cp_to_coo(acoo,info)
if (info /= 0) then
info = 4000
call psb_errpush(info,name)
goto 9999
endif
nz = acoo%get_nzeros()
j = 0
do i=1, nz
if (acoo%ia(i) /= acoo%ja(i)) then
j = j + 1
acoo%ia(j) = acoo%ia(i)
acoo%ja(j) = acoo%ja(i)
acoo%val(j) = acoo%val(i)
end if
end do
call acoo%set_nzeros(j)
call acoo%trim()
call b%mv_from(acoo)
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 s_clip_d
subroutine s_clip_d_ip(a,info)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_s_base_mat_mod
implicit none
class(psb_s_sparse_mat), intent(inout) :: a
integer,intent(out) :: info
Integer :: err_act
character(len=20) :: name='clip_diag'
logical, parameter :: debug=.false.
type(psb_s_coo_sparse_mat), allocatable :: acoo
integer :: i, j, nz
info = 0
call psb_erractionsave(err_act)
if (a%is_null()) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
allocate(acoo,stat=info)
if (info == 0) call a%a%mv_to_coo(acoo,info)
if (info /= 0) then
info = 4000
call psb_errpush(info,name)
goto 9999
endif
nz = acoo%get_nzeros()
j = 0
do i=1, nz
if (acoo%ia(i) /= acoo%ja(i)) then
j = j + 1
acoo%ia(j) = acoo%ia(i)
acoo%ja(j) = acoo%ja(i)
acoo%val(j) = acoo%val(i)
end if
end do
call acoo%set_nzeros(j)
call acoo%trim()
call a%mv_from(acoo)
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 s_clip_d_ip
subroutine s_mv_from(a,b)
use psb_error_mod
use psb_string_mod
@ -1530,6 +1666,32 @@ contains
end if
end subroutine s_cp_from
subroutine s_mv_to(a,b)
use psb_error_mod
use psb_string_mod
implicit none
class(psb_s_sparse_mat), intent(inout) :: a
class(psb_s_base_sparse_mat), intent(out) :: b
integer :: info
call b%mv_from_fmt(a%a,info)
return
end subroutine s_mv_to
subroutine s_cp_to(a,b)
use psb_error_mod
use psb_string_mod
implicit none
class(psb_s_sparse_mat), intent(in) :: a
class(psb_s_base_sparse_mat), intent(out) :: b
integer :: info
call b%cp_from_fmt(a%a,info)
return
end subroutine s_cp_to
subroutine s_sparse_mat_move(a,b,info)
use psb_error_mod
use psb_string_mod
@ -1582,6 +1744,153 @@ contains
end subroutine s_sparse_mat_clone
subroutine s_transp_1mat(a)
use psb_error_mod
use psb_string_mod
implicit none
class(psb_s_sparse_mat), intent(inout) :: a
Integer :: err_act, info
character(len=20) :: name='transp'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_null()) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
call a%a%transp()
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 s_transp_1mat
subroutine s_transp_2mat(a,b)
use psb_error_mod
use psb_string_mod
implicit none
class(psb_s_sparse_mat), intent(out) :: a
class(psb_s_sparse_mat), intent(in) :: b
Integer :: err_act, info
character(len=20) :: name='transp'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (b%is_null()) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
allocate(a%a,source=b%a,stat=info)
if (info /= 0) then
info = 4000
goto 9999
end if
call a%a%transp(b%a)
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 s_transp_2mat
subroutine s_transc_1mat(a)
use psb_error_mod
use psb_string_mod
implicit none
class(psb_s_sparse_mat), intent(inout) :: a
Integer :: err_act, info
character(len=20) :: name='transc'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_null()) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
call a%a%transc()
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 s_transc_1mat
subroutine s_transc_2mat(a,b)
use psb_error_mod
use psb_string_mod
implicit none
class(psb_s_sparse_mat), intent(out) :: a
class(psb_s_sparse_mat), intent(in) :: b
Integer :: err_act, info
character(len=20) :: name='transc'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (b%is_null()) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
allocate(a%a,source=b%a,stat=info)
if (info /= 0) then
info = 4000
goto 9999
end if
call a%a%transc(b%a)
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 s_transc_2mat
subroutine reinit(a,clear)
use psb_error_mod
implicit none

2
test/fileread/runs/dfs.inp
Unescape Escape View File

@ -7,7 +7,7 @@ BJAC Preconditioner NONE DIAG BJAC
CSR Storage format CSR COO JAD
0 IPART: Partition method 0: BLK 2: graph (with Metis)
2 ISTOPC
00010 ITMAX
00200 ITMAX
01 ITRACE
30 IRST (restart for RGMRES and BiCGSTABL)
1.d-6 EPS

9
test/serial/d_coo_matgen.f03
Unescape Escape View File

@ -17,7 +17,7 @@ program d_coo_matgen
real(psb_dpk_) :: t1, t2, tprec
! sparse matrix and preconditioner
type(psb_dspmat_type) :: a
type(psb_d_sparse_mat) :: a
type(psb_dprec_type) :: prec
! descriptor
type(psb_desc_type) :: desc_a
@ -145,7 +145,7 @@ contains
type(psb_desc_type) :: desc_a
integer :: ictxt, info
character :: afmt*5
type(psb_dspmat_type) :: a
type(psb_d_sparse_mat) :: a
real(psb_dpk_) :: zt(nb),glob_x,glob_y,glob_z
integer :: m,n,nnz,glob_row,nlr,i,ii,ib,k
integer :: x,y,z,ia,indx_owner
@ -164,7 +164,7 @@ contains
external :: a1, a2, a3, a4, b1, b2, b3
integer :: err_act
character(len=20) :: name, ch_err
character(len=20) :: name, ch_err, asbfmt
info = 0
name = 'create_matrix'
@ -404,8 +404,9 @@ contains
tmov = psb_wtime()-t1
!!$ call acsr%print(22)
if(iam == psb_root_) then
asbfmt = a%get_fmt()
write(*,'("The matrix has been generated and assembled in ",a3," format.")')&
& a%fida(1:3)
& asbfmt
write(*,'("-allocation time : ",es12.5)') talc
write(*,'("-coeff. gen. time : ",es12.5)') tgen
write(*,'("-assembly time : ",es12.5)') tasb

4
test/serial/d_matgen.f03
Unescape Escape View File

@ -18,7 +18,7 @@ program d_matgen
real(psb_dpk_) :: t1, t2, tprec
! sparse matrix and preconditioner
type(psb_dspmat_type) :: a
type(psb_d_sparse_mat) :: a
type(psb_dprec_type) :: prec
! descriptor
type(psb_desc_type) :: desc_a
@ -147,7 +147,7 @@ contains
type(psb_desc_type) :: desc_a
integer :: ictxt, info
character :: afmt*5
type(psb_dspmat_type) :: a
type(psb_d_sparse_mat) :: a
real(psb_dpk_) :: zt(nb),glob_x,glob_y,glob_z
integer :: m,n,nnz,glob_row,nlr,i,ii,ib,k
integer :: x,y,z,ia,indx_owner

840
test/serial/psb_d_cxx_impl.f03
View File

File diff suppressed because it is too large Load Diff

239
test/serial/psb_d_cxx_mat_mod.f03
Unescape Escape View File

@ -29,12 +29,22 @@ module psb_d_cxx_mat_mod
procedure, pass(a) :: mv_from_coo => d_mv_cxx_from_coo
procedure, pass(a) :: mv_to_fmt => d_mv_cxx_to_fmt
procedure, pass(a) :: mv_from_fmt => d_mv_cxx_from_fmt
procedure, pass(a) :: csgetptn => d_cxx_csgetptn
procedure, pass(a) :: d_csgetrow => d_cxx_csgetrow
procedure, pass(a) :: get_nz_row => d_cxx_get_nz_row
procedure, pass(a) :: get_size => d_cxx_get_size
procedure, pass(a) :: free => d_cxx_free
procedure, pass(a) :: trim => d_cxx_trim
procedure, pass(a) :: print => d_cxx_print
procedure, pass(a) :: sizeof => d_cxx_sizeof
procedure, pass(a) :: reinit => d_cxx_reinit
procedure, pass(a) :: d_cxx_cp_from
generic, public :: cp_from => d_cxx_cp_from
procedure, pass(a) :: d_cxx_mv_from
generic, public :: mv_from => d_cxx_mv_from
end type psb_d_cxx_sparse_mat
private :: d_cxx_get_nzeros, d_cxx_csmm, d_cxx_csmv, d_cxx_cssm, d_cxx_cssv, &
& d_cxx_csput, d_cxx_reallocate_nz, d_cxx_allocate_mnnz, &
& d_cxx_free, d_cxx_print, d_cxx_get_fmt, d_cxx_csnmi, get_diag, &
@ -42,7 +52,8 @@ module psb_d_cxx_mat_mod
& d_mv_cxx_to_coo, d_mv_cxx_from_coo, &
& d_cp_cxx_to_fmt, d_cp_cxx_from_fmt, &
& d_mv_cxx_to_fmt, d_mv_cxx_from_fmt, &
& d_cxx_scals, d_cxx_scal, d_cxx_trim, d_cxx_csgetrow, d_cxx_get_size
& d_cxx_scals, d_cxx_scal, d_cxx_trim, d_cxx_csgetrow, d_cxx_get_size, &
& d_cxx_sizeof, d_cxx_csgetptn, d_cxx_get_nz_row, d_cxx_reinit
interface
@ -147,6 +158,25 @@ module psb_d_cxx_mat_mod
end subroutine d_cxx_csput_impl
end interface
interface
subroutine d_cxx_csgetptn_impl(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
use psb_const_mod
import psb_d_cxx_sparse_mat
implicit none
class(psb_d_cxx_sparse_mat), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine d_cxx_csgetptn_impl
end interface
interface
subroutine d_cxx_csgetrow_impl(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
@ -234,6 +264,18 @@ contains
!
!=====================================
function d_cxx_sizeof(a) result(res)
implicit none
class(psb_d_cxx_sparse_mat), intent(in) :: a
integer(psb_long_int_k_) :: res
res = 8
res = res + psb_sizeof_dp * size(a%val)
res = res + psb_sizeof_int * size(a%irp)
res = res + psb_sizeof_int * size(a%ja)
end function d_cxx_sizeof
function d_cxx_get_fmt(a) result(res)
implicit none
class(psb_d_cxx_sparse_mat), intent(in) :: a
@ -245,7 +287,7 @@ contains
implicit none
class(psb_d_cxx_sparse_mat), intent(in) :: a
integer :: res
res = a%irp(a%m+1)-1
res = a%irp(a%get_nrows()+1)-1
end function d_cxx_get_nzeros
function d_cxx_get_size(a) result(res)
@ -272,6 +314,26 @@ contains
end function d_cxx_get_size
function d_cxx_get_nz_row(idx,a) result(res)
use psb_const_mod
implicit none
class(psb_d_cxx_sparse_mat), intent(in) :: a
integer, intent(in) :: idx
integer :: res
res = 0
if ((1<=idx).and.(idx<=a%get_nrows())) then
res = a%irp(idx+1)-a%irp(idx)
end if
end function d_cxx_get_nz_row
!=====================================
!
!
@ -299,7 +361,8 @@ contains
call psb_realloc(nz,a%ja,info)
if (info == 0) call psb_realloc(nz,a%val,info)
if (info == 0) call psb_realloc(max(nz,a%m+1,a%n+1),a%irp,info)
if (info == 0) call psb_realloc(&
& max(nz,a%get_nrows()+1,a%get_ncols()+1),a%irp,info)
if (info /= 0) then
call psb_errpush(4000,name)
goto 9999
@ -382,6 +445,49 @@ contains
return
end subroutine d_cxx_csput
subroutine d_cxx_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
implicit none
class(psb_d_cxx_sparse_mat), intent(in) :: a
integer, intent(in) :: imin,imax
integer, intent(out) :: nz
integer, allocatable, intent(inout) :: ia(:), ja(:)
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), optional :: iren(:)
integer, intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
Integer :: err_act
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
call d_cxx_csgetptn_impl(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
if (info /= 0) 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
return
end subroutine d_cxx_csgetptn
subroutine d_cxx_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
! Output is always in COO format
@ -591,6 +697,55 @@ contains
end subroutine d_cxx_free
subroutine d_cxx_reinit(a,clear)
use psb_error_mod
implicit none
class(psb_d_cxx_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
Integer :: err_act, info
character(len=20) :: name='reinit'
logical :: clear_
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
if (present(clear)) then
clear_ = clear
else
clear_ = .true.
end if
if (a%is_bld() .or. a%is_upd()) then
! do nothing
return
else if (a%is_asb()) then
if (clear_) a%val(:) = dzero
call a%set_upd()
else
info = 1121
call psb_errpush(info,name)
goto 9999
end if
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
return
end subroutine d_cxx_reinit
subroutine d_cxx_trim(a)
use psb_realloc_mod
use psb_error_mod
@ -927,6 +1082,7 @@ contains
call a%set_ncols(n)
call a%set_bld()
call a%set_triangle(.false.)
call a%set_unit(.false.)
end if
call psb_erractionrestore(err_act)
@ -1025,6 +1181,81 @@ contains
end subroutine d_cxx_print
subroutine d_cxx_cp_from(a,b)
use psb_error_mod
implicit none
class(psb_d_cxx_sparse_mat), intent(out) :: a
type(psb_d_cxx_sparse_mat), intent(in) :: b
Integer :: err_act, info
character(len=20) :: name='cp_from'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
call a%allocate(b%get_nrows(),b%get_ncols(),b%get_nzeros())
call a%psb_d_base_sparse_mat%cp_from(b%psb_d_base_sparse_mat)
a%irp = b%irp
a%ja = b%ja
a%val = b%val
if (info /= 0) 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 d_cxx_cp_from
subroutine d_cxx_mv_from(a,b)
use psb_error_mod
implicit none
class(psb_d_cxx_sparse_mat), intent(out) :: a
type(psb_d_cxx_sparse_mat), intent(inout) :: b
Integer :: err_act, info
character(len=20) :: name='mv_from'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
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 d_cxx_mv_from
!=====================================
!
!
@ -1151,7 +1382,6 @@ contains
if (.not. (a%is_triangle())) then
write(0,*) 'Called SM on a non-triangular mat!'
info = 1121
call psb_errpush(info,name)
goto 9999
@ -1205,7 +1435,6 @@ contains
if (.not. (a%is_triangle())) then
write(0,*) 'Called SM on a non-triangular mat!'
info = 1121
call psb_errpush(info,name)
goto 9999

Write Preview
Loading…
Cancel
Save