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_c_base_mat_mod.f90
 base/modules/psb_c_csc_mat_mod.f90
 base/modules/psb_c_csr_mat_mod.f90
 base/modules/psb_d_base_mat_mod.f90
 base/modules/psb_d_csc_mat_mod.f90
 base/modules/psb_d_csr_mat_mod.f90
 base/modules/psb_s_base_mat_mod.f90
 base/modules/psb_s_csc_mat_mod.f90
 base/modules/psb_s_csr_mat_mod.f90
 base/modules/psb_z_base_mat_mod.f90
 base/modules/psb_z_csc_mat_mod.f90
 base/modules/psb_z_csr_mat_mod.f90
 base/serial/impl/psb_c_base_mat_impl.F90
 base/serial/impl/psb_c_coo_impl.f90
 base/serial/impl/psb_c_csc_impl.f90
 base/serial/impl/psb_c_csr_impl.f90
 base/serial/impl/psb_d_base_mat_impl.F90
 base/serial/impl/psb_d_coo_impl.f90
 base/serial/impl/psb_d_csc_impl.f90
 base/serial/impl/psb_d_csr_impl.f90
 base/serial/impl/psb_s_base_mat_impl.F90
 base/serial/impl/psb_s_coo_impl.f90
 base/serial/impl/psb_s_csc_impl.f90
 base/serial/impl/psb_s_csr_impl.f90
 base/serial/impl/psb_z_base_mat_impl.F90
 base/serial/impl/psb_z_coo_impl.f90
 base/serial/impl/psb_z_csc_impl.f90
 base/serial/impl/psb_z_csr_impl.f90

Fix use of is_by_rows/is_by_cols  MV|CP FROM_COO and select type COO
in FROM|TO_FMT
psblas3-accel
Salvatore Filippone 10 years ago
parent 13f163e0be
commit 9cf678a3ea
28 changed files with 260 additions and 148 deletions
Show Stats Download Patch File Download Diff File

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

@ -170,6 +170,7 @@ module psb_c_base_mat_mod
procedure, pass(a) :: set_by_rows => c_coo_set_by_rows
procedure, pass(a) :: set_by_cols => c_coo_set_by_cols
procedure, pass(a) :: set_sort_status => c_coo_set_sort_status
procedure, pass(a) :: get_sort_status => c_coo_get_sort_status
!
! This is COO specific
@ -1812,6 +1813,14 @@ contains
end subroutine c_coo_set_nzeros
function c_coo_get_sort_status(a) result(res)
implicit none
integer(psb_ipk_) :: res
class(psb_c_coo_sparse_mat), intent(in) :: a
res = a%sort_status
end function c_coo_get_sort_status
subroutine c_coo_set_sort_status(ist,a)
implicit none
integer(psb_ipk_), intent(in) :: ist

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

@ -170,6 +170,7 @@ module psb_d_base_mat_mod
procedure, pass(a) :: set_by_rows => d_coo_set_by_rows
procedure, pass(a) :: set_by_cols => d_coo_set_by_cols
procedure, pass(a) :: set_sort_status => d_coo_set_sort_status
procedure, pass(a) :: get_sort_status => d_coo_get_sort_status
!
! This is COO specific
@ -1812,6 +1813,14 @@ contains
end subroutine d_coo_set_nzeros
function d_coo_get_sort_status(a) result(res)
implicit none
integer(psb_ipk_) :: res
class(psb_d_coo_sparse_mat), intent(in) :: a
res = a%sort_status
end function d_coo_get_sort_status
subroutine d_coo_set_sort_status(ist,a)
implicit none
integer(psb_ipk_), intent(in) :: ist

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

@ -170,6 +170,7 @@ module psb_s_base_mat_mod
procedure, pass(a) :: set_by_rows => s_coo_set_by_rows
procedure, pass(a) :: set_by_cols => s_coo_set_by_cols
procedure, pass(a) :: set_sort_status => s_coo_set_sort_status
procedure, pass(a) :: get_sort_status => s_coo_get_sort_status
!
! This is COO specific
@ -1812,6 +1813,14 @@ contains
end subroutine s_coo_set_nzeros
function s_coo_get_sort_status(a) result(res)
implicit none
integer(psb_ipk_) :: res
class(psb_s_coo_sparse_mat), intent(in) :: a
res = a%sort_status
end function s_coo_get_sort_status
subroutine s_coo_set_sort_status(ist,a)
implicit none
integer(psb_ipk_), intent(in) :: ist

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

@ -170,6 +170,7 @@ module psb_z_base_mat_mod
procedure, pass(a) :: set_by_rows => z_coo_set_by_rows
procedure, pass(a) :: set_by_cols => z_coo_set_by_cols
procedure, pass(a) :: set_sort_status => z_coo_set_sort_status
procedure, pass(a) :: get_sort_status => z_coo_get_sort_status
!
! This is COO specific
@ -1812,6 +1813,14 @@ contains
end subroutine z_coo_set_nzeros
function z_coo_get_sort_status(a) result(res)
implicit none
integer(psb_ipk_) :: res
class(psb_z_coo_sparse_mat), intent(in) :: a
res = a%sort_status
end function z_coo_get_sort_status
subroutine z_coo_set_sort_status(ist,a)
implicit none
integer(psb_ipk_), intent(in) :: ist

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

@ -113,9 +113,13 @@ subroutine psb_c_base_cp_to_fmt(a,b,info)
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_c_coo_sparse_mat)
call a%cp_to_coo(b,info)
class default
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
@ -152,8 +156,13 @@ subroutine psb_c_base_cp_from_fmt(a,b,info)
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_c_coo_sparse_mat)
call a%cp_from_coo(b,info)
class default
call b%cp_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
@ -267,8 +276,13 @@ subroutine psb_c_base_mv_to_fmt(a,b,info)
! Default implementation
!
info = psb_success_
select type(b)
type is (psb_c_coo_sparse_mat)
call a%mv_to_coo(b,info)
class default
call a%mv_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
end select
return
@ -293,9 +307,13 @@ subroutine psb_c_base_mv_from_fmt(a,b,info)
! Default implementation
!
info = psb_success_
select type(b)
type is (psb_c_coo_sparse_mat)
call a%mv_from_coo(b,info)
class default
call b%mv_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
end select
return
end subroutine psb_c_base_mv_from_fmt

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

@ -466,7 +466,7 @@ function psb_c_coo_get_nz_row(idx,a) result(res)
res = 0
nza = a%get_nzeros()
if (a%is_sorted()) then
if (a%is_by_rows()) then
! In this case we can do a binary search.
ip = psb_ibsrch(idx,nza,a%ia)
if (ip /= -1) return
@ -580,7 +580,7 @@ subroutine psb_c_coo_cssm(alpha,a,x,beta,y,info,trans)
end if
if (beta == czero) then
call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),&
call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),&
& m,nc,nnz,a%ia,a%ja,a%val,&
& x,size(x,1,kind=psb_ipk_),y,size(y,1,kind=psb_ipk_),info)
do i = 1, m
@ -594,7 +594,7 @@ subroutine psb_c_coo_cssm(alpha,a,x,beta,y,info,trans)
goto 9999
end if
call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),&
call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),&
& m,nc,nnz,a%ia,a%ja,a%val,&
& x,size(x,1,kind=psb_ipk_),tmp,size(tmp,1,kind=psb_ipk_),info)
do i = 1, m
@ -933,7 +933,7 @@ subroutine psb_c_coo_cssv(alpha,a,x,beta,y,info,trans)
end if
if (beta == czero) then
call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),&
call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),&
& a%get_nrows(),a%get_nzeros(),a%ia,a%ja,a%val,&
& x,y,info)
if (info /= psb_success_) then
@ -951,7 +951,7 @@ subroutine psb_c_coo_cssv(alpha,a,x,beta,y,info,trans)
goto 9999
end if
call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),&
call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),&
& a%get_nrows(),a%get_nzeros(),a%ia,a%ja,a%val,&
& x,tmp,info)
if (info /= psb_success_) then
@ -1650,7 +1650,7 @@ function psb_c_coo_csnmi(a) result(res)
res = szero
nnz = a%get_nzeros()
is_unit = a%is_unit()
if (a%is_sorted()) then
if (a%is_by_rows()) then
i = 1
j = i
res = szero
@ -2067,7 +2067,7 @@ contains
nzin_ = 0
endif
if (a%is_sorted()) then
if (a%is_by_rows()) then
! In this case we can do a binary search.
if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name), ': srtdcoo '
@ -2344,7 +2344,7 @@ contains
nzin_ = 0
endif
if (a%is_sorted()) then
if (a%is_by_rows()) then
! In this case we can do a binary search.
if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name), ': srtdcoo '
@ -2884,7 +2884,7 @@ subroutine psb_c_cp_coo_to_coo(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat
call b%set_sort_status(a%get_sort_status())
nz = a%get_nzeros()
call b%set_nzeros(nz)
call b%reallocate(nz)
@ -2894,7 +2894,7 @@ subroutine psb_c_cp_coo_to_coo(a,b,info)
b%val(1:nz) = a%val(1:nz)
if (.not.b%is_sorted()) call b%fix(info)
if (.not.b%is_by_rows()) call b%fix(info)
if (info /= psb_success_) goto 9999
@ -2925,7 +2925,7 @@ subroutine psb_c_cp_coo_from_coo(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat
call a%set_sort_status(b%get_sort_status())
nz = b%get_nzeros()
call a%set_nzeros(nz)
call a%reallocate(nz)
@ -2934,7 +2934,7 @@ subroutine psb_c_cp_coo_from_coo(a,b,info)
a%ja(1:nz) = b%ja(1:nz)
a%val(1:nz) = b%val(1:nz)
if (.not.a%is_sorted()) call a%fix(info)
if (.not.a%is_by_rows()) call a%fix(info)
if (info /= psb_success_) goto 9999
@ -3036,6 +3036,7 @@ subroutine psb_c_mv_coo_to_coo(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat
call b%set_sort_status(a%get_sort_status())
call b%set_nzeros(a%get_nzeros())
call move_alloc(a%ia, b%ia)
@ -3043,7 +3044,7 @@ subroutine psb_c_mv_coo_to_coo(a,b,info)
call move_alloc(a%val, b%val)
call a%free()
if (.not.b%is_sorted()) call b%fix(info)
if (.not.b%is_by_rows()) call b%fix(info)
if (info /= psb_success_) goto 9999
@ -3077,13 +3078,14 @@ subroutine psb_c_mv_coo_from_coo(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat
call a%set_sort_status(b%get_sort_status())
call a%set_nzeros(b%get_nzeros())
call move_alloc(b%ia , a%ia )
call move_alloc(b%ja , a%ja )
call move_alloc(b%val, a%val )
call b%free()
if (.not.a%is_sorted()) call a%fix(info)
if (.not.a%is_by_rows()) call a%fix(info)
if (info /= psb_success_) goto 9999

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

@ -2140,7 +2140,6 @@ subroutine psb_c_cp_csc_from_coo(a,b,info)
class(psb_c_csc_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
type(psb_c_coo_sparse_mat) :: tmp
integer(psb_ipk_), allocatable :: itemp(:)
!locals

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

@ -2673,7 +2673,7 @@ subroutine psb_c_cp_csr_from_coo(a,b,info)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (.not.b%is_sorted()) then
if (.not.b%is_by_rows()) then
! This is to have fix_coo called behind the scenes
call tmp%cp_from_coo(b,info)
if (info /= psb_success_) return
@ -2871,7 +2871,7 @@ subroutine psb_c_mv_csr_from_coo(a,b,info)
debug_level = psb_get_debug_level()
if (.not.b%is_sorted()) call b%fix(info)
if (.not.b%is_by_rows()) call b%fix(info)
if (info /= psb_success_) return
nr = b%get_nrows()

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

@ -113,9 +113,13 @@ subroutine psb_d_base_cp_to_fmt(a,b,info)
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_d_coo_sparse_mat)
call a%cp_to_coo(b,info)
class default
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
@ -152,8 +156,13 @@ subroutine psb_d_base_cp_from_fmt(a,b,info)
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_d_coo_sparse_mat)
call a%cp_from_coo(b,info)
class default
call b%cp_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
@ -267,8 +276,13 @@ subroutine psb_d_base_mv_to_fmt(a,b,info)
! Default implementation
!
info = psb_success_
select type(b)
type is (psb_d_coo_sparse_mat)
call a%mv_to_coo(b,info)
class default
call a%mv_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
end select
return
@ -293,9 +307,13 @@ subroutine psb_d_base_mv_from_fmt(a,b,info)
! Default implementation
!
info = psb_success_
select type(b)
type is (psb_d_coo_sparse_mat)
call a%mv_from_coo(b,info)
class default
call b%mv_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
end select
return
end subroutine psb_d_base_mv_from_fmt

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

@ -466,7 +466,7 @@ function psb_d_coo_get_nz_row(idx,a) result(res)
res = 0
nza = a%get_nzeros()
if (a%is_sorted()) then
if (a%is_by_rows()) then
! In this case we can do a binary search.
ip = psb_ibsrch(idx,nza,a%ia)
if (ip /= -1) return
@ -580,7 +580,7 @@ subroutine psb_d_coo_cssm(alpha,a,x,beta,y,info,trans)
end if
if (beta == dzero) then
call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),&
call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),&
& m,nc,nnz,a%ia,a%ja,a%val,&
& x,size(x,1,kind=psb_ipk_),y,size(y,1,kind=psb_ipk_),info)
do i = 1, m
@ -594,7 +594,7 @@ subroutine psb_d_coo_cssm(alpha,a,x,beta,y,info,trans)
goto 9999
end if
call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),&
call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),&
& m,nc,nnz,a%ia,a%ja,a%val,&
& x,size(x,1,kind=psb_ipk_),tmp,size(tmp,1,kind=psb_ipk_),info)
do i = 1, m
@ -933,7 +933,7 @@ subroutine psb_d_coo_cssv(alpha,a,x,beta,y,info,trans)
end if
if (beta == dzero) then
call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),&
call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),&
& a%get_nrows(),a%get_nzeros(),a%ia,a%ja,a%val,&
& x,y,info)
if (info /= psb_success_) then
@ -951,7 +951,7 @@ subroutine psb_d_coo_cssv(alpha,a,x,beta,y,info,trans)
goto 9999
end if
call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),&
call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),&
& a%get_nrows(),a%get_nzeros(),a%ia,a%ja,a%val,&
& x,tmp,info)
if (info /= psb_success_) then
@ -1650,7 +1650,7 @@ function psb_d_coo_csnmi(a) result(res)
res = dzero
nnz = a%get_nzeros()
is_unit = a%is_unit()
if (a%is_sorted()) then
if (a%is_by_rows()) then
i = 1
j = i
res = dzero
@ -2067,7 +2067,7 @@ contains
nzin_ = 0
endif
if (a%is_sorted()) then
if (a%is_by_rows()) then
! In this case we can do a binary search.
if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name), ': srtdcoo '
@ -2344,7 +2344,7 @@ contains
nzin_ = 0
endif
if (a%is_sorted()) then
if (a%is_by_rows()) then
! In this case we can do a binary search.
if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name), ': srtdcoo '
@ -2884,7 +2884,7 @@ subroutine psb_d_cp_coo_to_coo(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat
call b%set_sort_status(a%get_sort_status())
nz = a%get_nzeros()
call b%set_nzeros(nz)
call b%reallocate(nz)
@ -2894,7 +2894,7 @@ subroutine psb_d_cp_coo_to_coo(a,b,info)
b%val(1:nz) = a%val(1:nz)
if (.not.b%is_sorted()) call b%fix(info)
if (.not.b%is_by_rows()) call b%fix(info)
if (info /= psb_success_) goto 9999
@ -2925,7 +2925,7 @@ subroutine psb_d_cp_coo_from_coo(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat
call a%set_sort_status(b%get_sort_status())
nz = b%get_nzeros()
call a%set_nzeros(nz)
call a%reallocate(nz)
@ -2934,7 +2934,7 @@ subroutine psb_d_cp_coo_from_coo(a,b,info)
a%ja(1:nz) = b%ja(1:nz)
a%val(1:nz) = b%val(1:nz)
if (.not.a%is_sorted()) call a%fix(info)
if (.not.a%is_by_rows()) call a%fix(info)
if (info /= psb_success_) goto 9999
@ -3036,6 +3036,7 @@ subroutine psb_d_mv_coo_to_coo(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat
call b%set_sort_status(a%get_sort_status())
call b%set_nzeros(a%get_nzeros())
call move_alloc(a%ia, b%ia)
@ -3043,7 +3044,7 @@ subroutine psb_d_mv_coo_to_coo(a,b,info)
call move_alloc(a%val, b%val)
call a%free()
if (.not.b%is_sorted()) call b%fix(info)
if (.not.b%is_by_rows()) call b%fix(info)
if (info /= psb_success_) goto 9999
@ -3077,13 +3078,14 @@ subroutine psb_d_mv_coo_from_coo(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat
call a%set_sort_status(b%get_sort_status())
call a%set_nzeros(b%get_nzeros())
call move_alloc(b%ia , a%ia )
call move_alloc(b%ja , a%ja )
call move_alloc(b%val, a%val )
call b%free()
if (.not.a%is_sorted()) call a%fix(info)
if (.not.a%is_by_rows()) call a%fix(info)
if (info /= psb_success_) goto 9999

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

@ -2140,7 +2140,6 @@ subroutine psb_d_cp_csc_from_coo(a,b,info)
class(psb_d_csc_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
type(psb_d_coo_sparse_mat) :: tmp
integer(psb_ipk_), allocatable :: itemp(:)
!locals

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

@ -2673,7 +2673,7 @@ subroutine psb_d_cp_csr_from_coo(a,b,info)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (.not.b%is_sorted()) then
if (.not.b%is_by_rows()) then
! This is to have fix_coo called behind the scenes
call tmp%cp_from_coo(b,info)
if (info /= psb_success_) return
@ -2871,7 +2871,7 @@ subroutine psb_d_mv_csr_from_coo(a,b,info)
debug_level = psb_get_debug_level()
if (.not.b%is_sorted()) call b%fix(info)
if (.not.b%is_by_rows()) call b%fix(info)
if (info /= psb_success_) return
nr = b%get_nrows()

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

@ -113,9 +113,13 @@ subroutine psb_s_base_cp_to_fmt(a,b,info)
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_s_coo_sparse_mat)
call a%cp_to_coo(b,info)
class default
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
@ -152,8 +156,13 @@ subroutine psb_s_base_cp_from_fmt(a,b,info)
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_s_coo_sparse_mat)
call a%cp_from_coo(b,info)
class default
call b%cp_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
@ -267,8 +276,13 @@ subroutine psb_s_base_mv_to_fmt(a,b,info)
! Default implementation
!
info = psb_success_
select type(b)
type is (psb_s_coo_sparse_mat)
call a%mv_to_coo(b,info)
class default
call a%mv_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
end select
return
@ -293,9 +307,13 @@ subroutine psb_s_base_mv_from_fmt(a,b,info)
! Default implementation
!
info = psb_success_
select type(b)
type is (psb_s_coo_sparse_mat)
call a%mv_from_coo(b,info)
class default
call b%mv_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
end select
return
end subroutine psb_s_base_mv_from_fmt

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

@ -466,7 +466,7 @@ function psb_s_coo_get_nz_row(idx,a) result(res)
res = 0
nza = a%get_nzeros()
if (a%is_sorted()) then
if (a%is_by_rows()) then
! In this case we can do a binary search.
ip = psb_ibsrch(idx,nza,a%ia)
if (ip /= -1) return
@ -580,7 +580,7 @@ subroutine psb_s_coo_cssm(alpha,a,x,beta,y,info,trans)
end if
if (beta == szero) then
call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),&
call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),&
& m,nc,nnz,a%ia,a%ja,a%val,&
& x,size(x,1,kind=psb_ipk_),y,size(y,1,kind=psb_ipk_),info)
do i = 1, m
@ -594,7 +594,7 @@ subroutine psb_s_coo_cssm(alpha,a,x,beta,y,info,trans)
goto 9999
end if
call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),&
call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),&
& m,nc,nnz,a%ia,a%ja,a%val,&
& x,size(x,1,kind=psb_ipk_),tmp,size(tmp,1,kind=psb_ipk_),info)
do i = 1, m
@ -933,7 +933,7 @@ subroutine psb_s_coo_cssv(alpha,a,x,beta,y,info,trans)
end if
if (beta == szero) then
call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),&
call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),&
& a%get_nrows(),a%get_nzeros(),a%ia,a%ja,a%val,&
& x,y,info)
if (info /= psb_success_) then
@ -951,7 +951,7 @@ subroutine psb_s_coo_cssv(alpha,a,x,beta,y,info,trans)
goto 9999
end if
call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),&
call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),&
& a%get_nrows(),a%get_nzeros(),a%ia,a%ja,a%val,&
& x,tmp,info)
if (info /= psb_success_) then
@ -1650,7 +1650,7 @@ function psb_s_coo_csnmi(a) result(res)
res = szero
nnz = a%get_nzeros()
is_unit = a%is_unit()
if (a%is_sorted()) then
if (a%is_by_rows()) then
i = 1
j = i
res = szero
@ -2067,7 +2067,7 @@ contains
nzin_ = 0
endif
if (a%is_sorted()) then
if (a%is_by_rows()) then
! In this case we can do a binary search.
if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name), ': srtdcoo '
@ -2344,7 +2344,7 @@ contains
nzin_ = 0
endif
if (a%is_sorted()) then
if (a%is_by_rows()) then
! In this case we can do a binary search.
if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name), ': srtdcoo '
@ -2884,7 +2884,7 @@ subroutine psb_s_cp_coo_to_coo(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
b%psb_s_base_sparse_mat = a%psb_s_base_sparse_mat
call b%set_sort_status(a%get_sort_status())
nz = a%get_nzeros()
call b%set_nzeros(nz)
call b%reallocate(nz)
@ -2894,7 +2894,7 @@ subroutine psb_s_cp_coo_to_coo(a,b,info)
b%val(1:nz) = a%val(1:nz)
if (.not.b%is_sorted()) call b%fix(info)
if (.not.b%is_by_rows()) call b%fix(info)
if (info /= psb_success_) goto 9999
@ -2925,7 +2925,7 @@ subroutine psb_s_cp_coo_from_coo(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat
call a%set_sort_status(b%get_sort_status())
nz = b%get_nzeros()
call a%set_nzeros(nz)
call a%reallocate(nz)
@ -2934,7 +2934,7 @@ subroutine psb_s_cp_coo_from_coo(a,b,info)
a%ja(1:nz) = b%ja(1:nz)
a%val(1:nz) = b%val(1:nz)
if (.not.a%is_sorted()) call a%fix(info)
if (.not.a%is_by_rows()) call a%fix(info)
if (info /= psb_success_) goto 9999
@ -3036,6 +3036,7 @@ subroutine psb_s_mv_coo_to_coo(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
b%psb_s_base_sparse_mat = a%psb_s_base_sparse_mat
call b%set_sort_status(a%get_sort_status())
call b%set_nzeros(a%get_nzeros())
call move_alloc(a%ia, b%ia)
@ -3043,7 +3044,7 @@ subroutine psb_s_mv_coo_to_coo(a,b,info)
call move_alloc(a%val, b%val)
call a%free()
if (.not.b%is_sorted()) call b%fix(info)
if (.not.b%is_by_rows()) call b%fix(info)
if (info /= psb_success_) goto 9999
@ -3077,13 +3078,14 @@ subroutine psb_s_mv_coo_from_coo(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
a%psb_s_base_sparse_mat = b%psb_s_base_sparse_mat
call a%set_sort_status(b%get_sort_status())
call a%set_nzeros(b%get_nzeros())
call move_alloc(b%ia , a%ia )
call move_alloc(b%ja , a%ja )
call move_alloc(b%val, a%val )
call b%free()
if (.not.a%is_sorted()) call a%fix(info)
if (.not.a%is_by_rows()) call a%fix(info)
if (info /= psb_success_) goto 9999

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

@ -2140,7 +2140,6 @@ subroutine psb_s_cp_csc_from_coo(a,b,info)
class(psb_s_csc_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
type(psb_s_coo_sparse_mat) :: tmp
integer(psb_ipk_), allocatable :: itemp(:)
!locals

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

@ -2673,7 +2673,7 @@ subroutine psb_s_cp_csr_from_coo(a,b,info)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (.not.b%is_sorted()) then
if (.not.b%is_by_rows()) then
! This is to have fix_coo called behind the scenes
call tmp%cp_from_coo(b,info)
if (info /= psb_success_) return
@ -2871,7 +2871,7 @@ subroutine psb_s_mv_csr_from_coo(a,b,info)
debug_level = psb_get_debug_level()
if (.not.b%is_sorted()) call b%fix(info)
if (.not.b%is_by_rows()) call b%fix(info)
if (info /= psb_success_) return
nr = b%get_nrows()

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

@ -113,9 +113,13 @@ subroutine psb_z_base_cp_to_fmt(a,b,info)
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_z_coo_sparse_mat)
call a%cp_to_coo(b,info)
class default
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
@ -152,8 +156,13 @@ subroutine psb_z_base_cp_from_fmt(a,b,info)
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_z_coo_sparse_mat)
call a%cp_from_coo(b,info)
class default
call b%cp_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
@ -267,8 +276,13 @@ subroutine psb_z_base_mv_to_fmt(a,b,info)
! Default implementation
!
info = psb_success_
select type(b)
type is (psb_z_coo_sparse_mat)
call a%mv_to_coo(b,info)
class default
call a%mv_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
end select
return
@ -293,9 +307,13 @@ subroutine psb_z_base_mv_from_fmt(a,b,info)
! Default implementation
!
info = psb_success_
select type(b)
type is (psb_z_coo_sparse_mat)
call a%mv_from_coo(b,info)
class default
call b%mv_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
end select
return
end subroutine psb_z_base_mv_from_fmt

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

@ -466,7 +466,7 @@ function psb_z_coo_get_nz_row(idx,a) result(res)
res = 0
nza = a%get_nzeros()
if (a%is_sorted()) then
if (a%is_by_rows()) then
! In this case we can do a binary search.
ip = psb_ibsrch(idx,nza,a%ia)
if (ip /= -1) return
@ -580,7 +580,7 @@ subroutine psb_z_coo_cssm(alpha,a,x,beta,y,info,trans)
end if
if (beta == zzero) then
call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),&
call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),&
& m,nc,nnz,a%ia,a%ja,a%val,&
& x,size(x,1,kind=psb_ipk_),y,size(y,1,kind=psb_ipk_),info)
do i = 1, m
@ -594,7 +594,7 @@ subroutine psb_z_coo_cssm(alpha,a,x,beta,y,info,trans)
goto 9999
end if
call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),&
call inner_coosm(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),&
& m,nc,nnz,a%ia,a%ja,a%val,&
& x,size(x,1,kind=psb_ipk_),tmp,size(tmp,1,kind=psb_ipk_),info)
do i = 1, m
@ -933,7 +933,7 @@ subroutine psb_z_coo_cssv(alpha,a,x,beta,y,info,trans)
end if
if (beta == zzero) then
call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),&
call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),&
& a%get_nrows(),a%get_nzeros(),a%ia,a%ja,a%val,&
& x,y,info)
if (info /= psb_success_) then
@ -951,7 +951,7 @@ subroutine psb_z_coo_cssv(alpha,a,x,beta,y,info,trans)
goto 9999
end if
call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_sorted(),&
call inner_coosv(tra,ctra,a%is_lower(),a%is_unit(),a%is_by_rows(),&
& a%get_nrows(),a%get_nzeros(),a%ia,a%ja,a%val,&
& x,tmp,info)
if (info /= psb_success_) then
@ -1650,7 +1650,7 @@ function psb_z_coo_csnmi(a) result(res)
res = dzero
nnz = a%get_nzeros()
is_unit = a%is_unit()
if (a%is_sorted()) then
if (a%is_by_rows()) then
i = 1
j = i
res = dzero
@ -2067,7 +2067,7 @@ contains
nzin_ = 0
endif
if (a%is_sorted()) then
if (a%is_by_rows()) then
! In this case we can do a binary search.
if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name), ': srtdcoo '
@ -2344,7 +2344,7 @@ contains
nzin_ = 0
endif
if (a%is_sorted()) then
if (a%is_by_rows()) then
! In this case we can do a binary search.
if (debug_level >= psb_debug_serial_)&
& write(debug_unit,*) trim(name), ': srtdcoo '
@ -2884,7 +2884,7 @@ subroutine psb_z_cp_coo_to_coo(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
b%psb_z_base_sparse_mat = a%psb_z_base_sparse_mat
call b%set_sort_status(a%get_sort_status())
nz = a%get_nzeros()
call b%set_nzeros(nz)
call b%reallocate(nz)
@ -2894,7 +2894,7 @@ subroutine psb_z_cp_coo_to_coo(a,b,info)
b%val(1:nz) = a%val(1:nz)
if (.not.b%is_sorted()) call b%fix(info)
if (.not.b%is_by_rows()) call b%fix(info)
if (info /= psb_success_) goto 9999
@ -2925,7 +2925,7 @@ subroutine psb_z_cp_coo_from_coo(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat
call a%set_sort_status(b%get_sort_status())
nz = b%get_nzeros()
call a%set_nzeros(nz)
call a%reallocate(nz)
@ -2934,7 +2934,7 @@ subroutine psb_z_cp_coo_from_coo(a,b,info)
a%ja(1:nz) = b%ja(1:nz)
a%val(1:nz) = b%val(1:nz)
if (.not.a%is_sorted()) call a%fix(info)
if (.not.a%is_by_rows()) call a%fix(info)
if (info /= psb_success_) goto 9999
@ -3036,6 +3036,7 @@ subroutine psb_z_mv_coo_to_coo(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
b%psb_z_base_sparse_mat = a%psb_z_base_sparse_mat
call b%set_sort_status(a%get_sort_status())
call b%set_nzeros(a%get_nzeros())
call move_alloc(a%ia, b%ia)
@ -3043,7 +3044,7 @@ subroutine psb_z_mv_coo_to_coo(a,b,info)
call move_alloc(a%val, b%val)
call a%free()
if (.not.b%is_sorted()) call b%fix(info)
if (.not.b%is_by_rows()) call b%fix(info)
if (info /= psb_success_) goto 9999
@ -3077,13 +3078,14 @@ subroutine psb_z_mv_coo_from_coo(a,b,info)
call psb_erractionsave(err_act)
info = psb_success_
a%psb_z_base_sparse_mat = b%psb_z_base_sparse_mat
call a%set_sort_status(b%get_sort_status())
call a%set_nzeros(b%get_nzeros())
call move_alloc(b%ia , a%ia )
call move_alloc(b%ja , a%ja )
call move_alloc(b%val, a%val )
call b%free()
if (.not.a%is_sorted()) call a%fix(info)
if (.not.a%is_by_rows()) call a%fix(info)
if (info /= psb_success_) goto 9999

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

@ -2140,7 +2140,6 @@ subroutine psb_z_cp_csc_from_coo(a,b,info)
class(psb_z_csc_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
type(psb_z_coo_sparse_mat) :: tmp
integer(psb_ipk_), allocatable :: itemp(:)
!locals

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

@ -2673,7 +2673,7 @@ subroutine psb_z_cp_csr_from_coo(a,b,info)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (.not.b%is_sorted()) then
if (.not.b%is_by_rows()) then
! This is to have fix_coo called behind the scenes
call tmp%cp_from_coo(b,info)
if (info /= psb_success_) return
@ -2871,7 +2871,7 @@ subroutine psb_z_mv_csr_from_coo(a,b,info)
debug_level = psb_get_debug_level()
if (.not.b%is_sorted()) call b%fix(info)
if (.not.b%is_by_rows()) call b%fix(info)
if (info /= psb_success_) return
nr = b%get_nrows()

Write Preview
Loading…
Cancel
Save