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

psblas-3.3-maint:

Browse Source 
base/internals/psi_cswapdata.F90
 base/internals/psi_cswaptran.F90
 base/internals/psi_dswapdata.F90
 base/internals/psi_dswaptran.F90
 base/internals/psi_iswapdata.F90
 base/internals/psi_iswaptran.F90
 base/internals/psi_sswapdata.F90
 base/internals/psi_sswaptran.F90
 base/internals/psi_zswapdata.F90
 base/internals/psi_zswaptran.F90
 base/modules/psb_c_base_mat_mod.f90
 base/modules/psb_c_csc_mat_mod.f90
 base/modules/psb_c_csr_mat_mod.f90
 base/modules/psb_const_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_error_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
 config/pac.m4
 configure.ac
 configure
 util/metis_int.c
 util/psb_d_mmio_impl.f90
 util/psb_metispart_mod.F90

Merged optimizations from trunk, going onto 3.3.2.
psblas-3.3-maint
Salvatore Filippone 10 years ago
parent 43d7878529 9cf678a3ea
commit a292f638f4
46 changed files with 812 additions and 238 deletions
Show Stats Download Patch File Download Diff File

46
base/internals/psi_cswapdata.F90
Unescape Escape View File

@ -643,6 +643,17 @@ subroutine psi_cswapdatav(flag,beta,y,desc_a,work,info,data)
end subroutine psi_cswapdatav
!
!
! Subroutine: psi_cswapdataidxv
! Does the data exchange among processes.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_cswapidxv
@ -998,6 +1009,15 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
return
end subroutine psi_cswapidxv
!
!
! Subroutine: psi_cswapdata_vect
! Data exchange among processes.
!
! Takes care of Y an exanspulated vector.
!
!
!
subroutine psi_cswapdata_vect(flag,beta,y,desc_a,work,info,data)
use psi_mod, psb_protect_name => psi_cswapdata_vect
@ -1072,6 +1092,19 @@ subroutine psi_cswapdata_vect(flag,beta,y,desc_a,work,info,data)
end subroutine psi_cswapdata_vect
!
!
! Subroutine: psi_cswapidx_vect
! Data exchange among processes.
!
! Takes care of Y an exanspulated vector. Relies on the gather/scatter methods
! of vectors.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_cswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_cswapidx_vect
@ -1430,6 +1463,19 @@ subroutine psi_cswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
end subroutine psi_cswapidx_vect
!
!
! Subroutine: psi_cswapvidx_vect
! Data exchange among processes.
!
! Case where the index vector is also encapsulated.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_cswap_vidx_vect

21
base/internals/psi_cswaptran.F90
Unescape Escape View File

@ -653,6 +653,17 @@ subroutine psi_cswaptranv(flag,beta,y,desc_a,work,info,data)
end subroutine psi_cswaptranv
!
!
! Subroutine: psi_ctranidxv
! Does the data exchange among processes.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
@ -1025,6 +1036,16 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
end subroutine psi_ctranidxv
!
!
!
!
! Subroutine: psi_cswaptran_vect
! Data exchange among processes.
!
! Takes care of Y an exanspulated vector.
!
!
subroutine psi_cswaptran_vect(flag,beta,y,desc_a,work,info,data)
use psi_mod, psb_protect_name => psi_cswaptran_vect

46
base/internals/psi_dswapdata.F90
Unescape Escape View File

@ -643,6 +643,17 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
end subroutine psi_dswapdatav
!
!
! Subroutine: psi_dswapdataidxv
! Does the data exchange among processes.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_dswapidxv
@ -998,6 +1009,15 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
return
end subroutine psi_dswapidxv
!
!
! Subroutine: psi_dswapdata_vect
! Data exchange among processes.
!
! Takes care of Y an exanspulated vector.
!
!
!
subroutine psi_dswapdata_vect(flag,beta,y,desc_a,work,info,data)
use psi_mod, psb_protect_name => psi_dswapdata_vect
@ -1072,6 +1092,19 @@ subroutine psi_dswapdata_vect(flag,beta,y,desc_a,work,info,data)
end subroutine psi_dswapdata_vect
!
!
! Subroutine: psi_dswapidx_vect
! Data exchange among processes.
!
! Takes care of Y an exanspulated vector. Relies on the gather/scatter methods
! of vectors.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_dswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_dswapidx_vect
@ -1430,6 +1463,19 @@ subroutine psi_dswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
end subroutine psi_dswapidx_vect
!
!
! Subroutine: psi_dswapvidx_vect
! Data exchange among processes.
!
! Case where the index vector is also encapsulated.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_dswap_vidx_vect

21
base/internals/psi_dswaptran.F90
Unescape Escape View File

@ -653,6 +653,17 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
end subroutine psi_dswaptranv
!
!
! Subroutine: psi_dtranidxv
! Does the data exchange among processes.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
@ -1025,6 +1036,16 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
end subroutine psi_dtranidxv
!
!
!
!
! Subroutine: psi_dswaptran_vect
! Data exchange among processes.
!
! Takes care of Y an exanspulated vector.
!
!
subroutine psi_dswaptran_vect(flag,beta,y,desc_a,work,info,data)
use psi_mod, psb_protect_name => psi_dswaptran_vect

46
base/internals/psi_iswapdata.F90
Unescape Escape View File

@ -643,6 +643,17 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
end subroutine psi_iswapdatav
!
!
! Subroutine: psi_iswapdataidxv
! Does the data exchange among processes.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_iswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_iswapidxv
@ -998,6 +1009,15 @@ subroutine psi_iswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
return
end subroutine psi_iswapidxv
!
!
! Subroutine: psi_iswapdata_vect
! Data exchange among processes.
!
! Takes care of Y an exanspulated vector.
!
!
!
subroutine psi_iswapdata_vect(flag,beta,y,desc_a,work,info,data)
use psi_mod, psb_protect_name => psi_iswapdata_vect
@ -1072,6 +1092,19 @@ subroutine psi_iswapdata_vect(flag,beta,y,desc_a,work,info,data)
end subroutine psi_iswapdata_vect
!
!
! Subroutine: psi_iswapidx_vect
! Data exchange among processes.
!
! Takes care of Y an exanspulated vector. Relies on the gather/scatter methods
! of vectors.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_iswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_iswapidx_vect
@ -1430,6 +1463,19 @@ subroutine psi_iswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
end subroutine psi_iswapidx_vect
!
!
! Subroutine: psi_iswapvidx_vect
! Data exchange among processes.
!
! Case where the index vector is also encapsulated.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_iswap_vidx_vect

21
base/internals/psi_iswaptran.F90
Unescape Escape View File

@ -653,6 +653,17 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
end subroutine psi_iswaptranv
!
!
! Subroutine: psi_itranidxv
! Does the data exchange among processes.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_itranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
@ -1025,6 +1036,16 @@ subroutine psi_itranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
end subroutine psi_itranidxv
!
!
!
!
! Subroutine: psi_iswaptran_vect
! Data exchange among processes.
!
! Takes care of Y an exanspulated vector.
!
!
subroutine psi_iswaptran_vect(flag,beta,y,desc_a,work,info,data)
use psi_mod, psb_protect_name => psi_iswaptran_vect

46
base/internals/psi_sswapdata.F90
Unescape Escape View File

@ -643,6 +643,17 @@ subroutine psi_sswapdatav(flag,beta,y,desc_a,work,info,data)
end subroutine psi_sswapdatav
!
!
! Subroutine: psi_sswapdataidxv
! Does the data exchange among processes.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_sswapidxv
@ -998,6 +1009,15 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
return
end subroutine psi_sswapidxv
!
!
! Subroutine: psi_sswapdata_vect
! Data exchange among processes.
!
! Takes care of Y an exanspulated vector.
!
!
!
subroutine psi_sswapdata_vect(flag,beta,y,desc_a,work,info,data)
use psi_mod, psb_protect_name => psi_sswapdata_vect
@ -1072,6 +1092,19 @@ subroutine psi_sswapdata_vect(flag,beta,y,desc_a,work,info,data)
end subroutine psi_sswapdata_vect
!
!
! Subroutine: psi_sswapidx_vect
! Data exchange among processes.
!
! Takes care of Y an exanspulated vector. Relies on the gather/scatter methods
! of vectors.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_sswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_sswapidx_vect
@ -1430,6 +1463,19 @@ subroutine psi_sswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
end subroutine psi_sswapidx_vect
!
!
! Subroutine: psi_sswapvidx_vect
! Data exchange among processes.
!
! Case where the index vector is also encapsulated.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_sswap_vidx_vect

21
base/internals/psi_sswaptran.F90
Unescape Escape View File

@ -653,6 +653,17 @@ subroutine psi_sswaptranv(flag,beta,y,desc_a,work,info,data)
end subroutine psi_sswaptranv
!
!
! Subroutine: psi_stranidxv
! Does the data exchange among processes.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
@ -1025,6 +1036,16 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
end subroutine psi_stranidxv
!
!
!
!
! Subroutine: psi_sswaptran_vect
! Data exchange among processes.
!
! Takes care of Y an exanspulated vector.
!
!
subroutine psi_sswaptran_vect(flag,beta,y,desc_a,work,info,data)
use psi_mod, psb_protect_name => psi_sswaptran_vect

46
base/internals/psi_zswapdata.F90
Unescape Escape View File

@ -643,6 +643,17 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
end subroutine psi_zswapdatav
!
!
! Subroutine: psi_zswapdataidxv
! Does the data exchange among processes.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_zswapidxv
@ -998,6 +1009,15 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
return
end subroutine psi_zswapidxv
!
!
! Subroutine: psi_zswapdata_vect
! Data exchange among processes.
!
! Takes care of Y an exanspulated vector.
!
!
!
subroutine psi_zswapdata_vect(flag,beta,y,desc_a,work,info,data)
use psi_mod, psb_protect_name => psi_zswapdata_vect
@ -1072,6 +1092,19 @@ subroutine psi_zswapdata_vect(flag,beta,y,desc_a,work,info,data)
end subroutine psi_zswapdata_vect
!
!
! Subroutine: psi_zswapidx_vect
! Data exchange among processes.
!
! Takes care of Y an exanspulated vector. Relies on the gather/scatter methods
! of vectors.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_zswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_zswapidx_vect
@ -1430,6 +1463,19 @@ subroutine psi_zswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
end subroutine psi_zswapidx_vect
!
!
! Subroutine: psi_zswapvidx_vect
! Data exchange among processes.
!
! Case where the index vector is also encapsulated.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
use psi_mod, psb_protect_name => psi_zswap_vidx_vect

21
base/internals/psi_zswaptran.F90
Unescape Escape View File

@ -653,6 +653,17 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
end subroutine psi_zswaptranv
!
!
! Subroutine: psi_ztranidxv
! Does the data exchange among processes.
!
! The real workhorse: the outer routines will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
@ -1025,6 +1036,16 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
end subroutine psi_ztranidxv
!
!
!
!
! Subroutine: psi_zswaptran_vect
! Data exchange among processes.
!
! Takes care of Y an exanspulated vector.
!
!
subroutine psi_zswaptran_vect(flag,beta,y,desc_a,work,info,data)
use psi_mod, psb_protect_name => psi_zswaptran_vect

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

@ -133,7 +133,7 @@ module psb_c_base_mat_mod
!> Coefficient values.
complex(psb_spk_), allocatable :: val(:)
integer, private :: sort_status=psb_unsorted_
integer, private :: sort_status=psb_unsorted_
contains
!
@ -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
@ -428,8 +429,8 @@ module psb_c_base_mat_mod
subroutine psb_c_base_tril(a,b,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(out) :: b
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: diag,imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
@ -469,8 +470,8 @@ module psb_c_base_mat_mod
subroutine psb_c_base_triu(a,b,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
class(psb_c_base_sparse_mat), intent(in) :: a
class(psb_c_coo_sparse_mat), intent(out) :: b
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: diag,imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
@ -586,7 +587,7 @@ module psb_c_base_mat_mod
subroutine psb_c_base_cp_from_coo(a,b,info)
import :: psb_ipk_, psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(in) :: b
class(psb_c_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_cp_from_coo
end interface
@ -656,7 +657,7 @@ module psb_c_base_mat_mod
subroutine psb_c_base_mv_from_coo(a,b,info)
import :: psb_ipk_, psb_c_base_sparse_mat, psb_c_coo_sparse_mat, psb_spk_
class(psb_c_base_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(inout) :: b
class(psb_c_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_mv_from_coo
end interface
@ -1367,7 +1368,7 @@ module psb_c_base_mat_mod
import :: psb_ipk_, psb_c_coo_sparse_mat
class(psb_c_coo_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_cp_coo_from_coo
end interface
@ -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

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

@ -186,7 +186,7 @@ module psb_c_csc_mat_mod
import :: psb_ipk_, psb_c_csc_sparse_mat, psb_c_coo_sparse_mat
class(psb_c_csc_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_cp_csc_from_coo
end interface

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

@ -189,7 +189,7 @@ module psb_c_csr_mat_mod
import :: psb_ipk_, psb_c_csr_sparse_mat, psb_c_coo_sparse_mat
class(psb_c_csr_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_cp_csr_from_coo
end interface

4
base/modules/psb_const_mod.F90
Unescape Escape View File

@ -89,10 +89,10 @@ module psb_const_mod
!
! Version
!
character(len=*), parameter :: psb_version_string_ = "3.3.1"
character(len=*), parameter :: psb_version_string_ = "3.3.2"
integer(psb_ipk_), parameter :: psb_version_major_ = 3
integer(psb_ipk_), parameter :: psb_version_minor_ = 3
integer(psb_ipk_), parameter :: psb_patchlevel_ = 1
integer(psb_ipk_), parameter :: psb_patchlevel_ = 2
!
! Handy & miscellaneous constants

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

@ -133,7 +133,7 @@ module psb_d_base_mat_mod
!> Coefficient values.
real(psb_dpk_), allocatable :: val(:)
integer, private :: sort_status=psb_unsorted_
integer, private :: sort_status=psb_unsorted_
contains
!
@ -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
@ -428,8 +429,8 @@ module psb_d_base_mat_mod
subroutine psb_d_base_tril(a,b,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(out) :: b
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: diag,imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
@ -469,8 +470,8 @@ module psb_d_base_mat_mod
subroutine psb_d_base_triu(a,b,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(out) :: b
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: diag,imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
@ -586,7 +587,7 @@ module psb_d_base_mat_mod
subroutine psb_d_base_cp_from_coo(a,b,info)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(in) :: b
class(psb_d_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_base_cp_from_coo
end interface
@ -656,7 +657,7 @@ module psb_d_base_mat_mod
subroutine psb_d_base_mv_from_coo(a,b,info)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
class(psb_d_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_base_mv_from_coo
end interface
@ -1367,7 +1368,7 @@ module psb_d_base_mat_mod
import :: psb_ipk_, psb_d_coo_sparse_mat
class(psb_d_coo_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_cp_coo_from_coo
end interface
@ -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

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

@ -186,7 +186,7 @@ module psb_d_csc_mat_mod
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_d_coo_sparse_mat
class(psb_d_csc_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_cp_csc_from_coo
end interface

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

@ -189,7 +189,7 @@ module psb_d_csr_mat_mod
import :: psb_ipk_, psb_d_csr_sparse_mat, psb_d_coo_sparse_mat
class(psb_d_csr_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_cp_csr_from_coo
end interface

2
base/modules/psb_error_mod.F90
Unescape Escape View File

@ -69,7 +69,7 @@ module psb_error_mod
interface psb_error_handler
subroutine psb_ser_error_handler(err_act)
import :: psb_ipk_
integer(psb_ipk_), intent(in) :: err_act
integer(psb_ipk_), intent(inout) :: err_act
end subroutine psb_ser_error_handler
subroutine psb_par_error_handler(ictxt,err_act)
import :: psb_ipk_,psb_mpik_

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

@ -133,7 +133,7 @@ module psb_s_base_mat_mod
!> Coefficient values.
real(psb_spk_), allocatable :: val(:)
integer, private :: sort_status=psb_unsorted_
integer, private :: sort_status=psb_unsorted_
contains
!
@ -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
@ -428,8 +429,8 @@ module psb_s_base_mat_mod
subroutine psb_s_base_tril(a,b,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(out) :: b
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: diag,imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
@ -469,8 +470,8 @@ module psb_s_base_mat_mod
subroutine psb_s_base_triu(a,b,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
class(psb_s_base_sparse_mat), intent(in) :: a
class(psb_s_coo_sparse_mat), intent(out) :: b
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: diag,imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
@ -586,7 +587,7 @@ module psb_s_base_mat_mod
subroutine psb_s_base_cp_from_coo(a,b,info)
import :: psb_ipk_, psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(in) :: b
class(psb_s_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_base_cp_from_coo
end interface
@ -656,7 +657,7 @@ module psb_s_base_mat_mod
subroutine psb_s_base_mv_from_coo(a,b,info)
import :: psb_ipk_, psb_s_base_sparse_mat, psb_s_coo_sparse_mat, psb_spk_
class(psb_s_base_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(inout) :: b
class(psb_s_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_base_mv_from_coo
end interface
@ -1367,7 +1368,7 @@ module psb_s_base_mat_mod
import :: psb_ipk_, psb_s_coo_sparse_mat
class(psb_s_coo_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_cp_coo_from_coo
end interface
@ -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

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

@ -186,7 +186,7 @@ module psb_s_csc_mat_mod
import :: psb_ipk_, psb_s_csc_sparse_mat, psb_s_coo_sparse_mat
class(psb_s_csc_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_cp_csc_from_coo
end interface

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

@ -189,7 +189,7 @@ module psb_s_csr_mat_mod
import :: psb_ipk_, psb_s_csr_sparse_mat, psb_s_coo_sparse_mat
class(psb_s_csr_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_cp_csr_from_coo
end interface

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

@ -133,7 +133,7 @@ module psb_z_base_mat_mod
!> Coefficient values.
complex(psb_dpk_), allocatable :: val(:)
integer, private :: sort_status=psb_unsorted_
integer, private :: sort_status=psb_unsorted_
contains
!
@ -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
@ -428,8 +429,8 @@ module psb_z_base_mat_mod
subroutine psb_z_base_tril(a,b,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_z_coo_sparse_mat), intent(out) :: b
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: diag,imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
@ -469,8 +470,8 @@ module psb_z_base_mat_mod
subroutine psb_z_base_triu(a,b,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
class(psb_z_base_sparse_mat), intent(in) :: a
class(psb_z_coo_sparse_mat), intent(out) :: b
integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), intent(in), optional :: diag,imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
@ -586,7 +587,7 @@ module psb_z_base_mat_mod
subroutine psb_z_base_cp_from_coo(a,b,info)
import :: psb_ipk_, psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(in) :: b
class(psb_z_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_cp_from_coo
end interface
@ -656,7 +657,7 @@ module psb_z_base_mat_mod
subroutine psb_z_base_mv_from_coo(a,b,info)
import :: psb_ipk_, psb_z_base_sparse_mat, psb_z_coo_sparse_mat, psb_dpk_
class(psb_z_base_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(inout) :: b
class(psb_z_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_mv_from_coo
end interface
@ -1367,7 +1368,7 @@ module psb_z_base_mat_mod
import :: psb_ipk_, psb_z_coo_sparse_mat
class(psb_z_coo_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_cp_coo_from_coo
end interface
@ -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

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

@ -186,7 +186,7 @@ module psb_z_csc_mat_mod
import :: psb_ipk_, psb_z_csc_sparse_mat, psb_z_coo_sparse_mat
class(psb_z_csc_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_cp_csc_from_coo
end interface

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

@ -189,7 +189,7 @@ module psb_z_csr_mat_mod
import :: psb_ipk_, psb_z_csr_sparse_mat, psb_z_coo_sparse_mat
class(psb_z_csr_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_cp_csr_from_coo
end interface

40
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)
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
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')
@ -151,9 +155,14 @@ subroutine psb_c_base_cp_from_fmt(a,b,info)
!
info = psb_success_
call psb_erractionsave(err_act)
call b%cp_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
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_
call a%mv_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
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_
call b%mv_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
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

32
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
@ -2912,7 +2912,7 @@ subroutine psb_c_cp_coo_from_coo(a,b,info)
use psb_c_base_mat_mod, psb_protect_name => psb_c_cp_coo_from_coo
implicit none
class(psb_c_coo_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(in) :: b
class(psb_c_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
@ -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

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

@ -2139,8 +2139,7 @@ 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
integer(psb_ipk_), intent(out) :: info
type(psb_c_coo_sparse_mat) :: tmp
integer(psb_ipk_), allocatable :: itemp(:)
!locals

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

@ -2658,7 +2658,7 @@ subroutine psb_c_cp_csr_from_coo(a,b,info)
class(psb_c_csr_sparse_mat), intent(inout) :: a
class(psb_c_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
type(psb_c_coo_sparse_mat) :: tmp
integer(psb_ipk_), allocatable :: itemp(:)
@ -2667,13 +2667,13 @@ subroutine psb_c_cp_csr_from_coo(a,b,info)
integer(psb_ipk_) :: nza, nr, i,j,irw, err_act, nc
integer(psb_ipk_), Parameter :: maxtry=8
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
character(len=20) :: name='c_cp_csr_from_coo'
info = psb_success_
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()

40
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)
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
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')
@ -151,9 +155,14 @@ subroutine psb_d_base_cp_from_fmt(a,b,info)
!
info = psb_success_
call psb_erractionsave(err_act)
call b%cp_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
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_
call a%mv_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
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_
call b%mv_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
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

32
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
@ -2912,7 +2912,7 @@ subroutine psb_d_cp_coo_from_coo(a,b,info)
use psb_d_base_mat_mod, psb_protect_name => psb_d_cp_coo_from_coo
implicit none
class(psb_d_coo_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(in) :: b
class(psb_d_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
@ -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

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

@ -2139,8 +2139,7 @@ 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
integer(psb_ipk_), intent(out) :: info
type(psb_d_coo_sparse_mat) :: tmp
integer(psb_ipk_), allocatable :: itemp(:)
!locals

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

@ -2658,7 +2658,7 @@ subroutine psb_d_cp_csr_from_coo(a,b,info)
class(psb_d_csr_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
type(psb_d_coo_sparse_mat) :: tmp
integer(psb_ipk_), allocatable :: itemp(:)
@ -2667,13 +2667,13 @@ subroutine psb_d_cp_csr_from_coo(a,b,info)
integer(psb_ipk_) :: nza, nr, i,j,irw, err_act, nc
integer(psb_ipk_), Parameter :: maxtry=8
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
character(len=20) :: name='d_cp_csr_from_coo'
info = psb_success_
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
@ -2869,15 +2869,15 @@ subroutine psb_d_mv_csr_from_coo(a,b,info)
info = psb_success_
debug_unit = psb_get_debug_unit()
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()
nc = b%get_ncols()
nza = b%get_nzeros()
a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat
! Dirty trick: call move_alloc to have the new data allocated just once.
@ -2887,6 +2887,7 @@ subroutine psb_d_mv_csr_from_coo(a,b,info)
call psb_realloc(max(nr+1,nc+1),a%irp,info)
call b%free()
if (nza <= 0) then
a%irp(:) = 1
else
@ -2936,7 +2937,6 @@ subroutine psb_d_mv_csr_from_coo(a,b,info)
endif
end subroutine psb_d_mv_csr_from_coo

40
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)
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
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')
@ -151,9 +155,14 @@ subroutine psb_s_base_cp_from_fmt(a,b,info)
!
info = psb_success_
call psb_erractionsave(err_act)
call b%cp_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
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_
call a%mv_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
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_
call b%mv_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
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

32
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
@ -2912,7 +2912,7 @@ subroutine psb_s_cp_coo_from_coo(a,b,info)
use psb_s_base_mat_mod, psb_protect_name => psb_s_cp_coo_from_coo
implicit none
class(psb_s_coo_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(in) :: b
class(psb_s_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
@ -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

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

@ -2139,8 +2139,7 @@ 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
integer(psb_ipk_), intent(out) :: info
type(psb_s_coo_sparse_mat) :: tmp
integer(psb_ipk_), allocatable :: itemp(:)
!locals

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

@ -2658,7 +2658,7 @@ subroutine psb_s_cp_csr_from_coo(a,b,info)
class(psb_s_csr_sparse_mat), intent(inout) :: a
class(psb_s_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
type(psb_s_coo_sparse_mat) :: tmp
integer(psb_ipk_), allocatable :: itemp(:)
@ -2667,13 +2667,13 @@ subroutine psb_s_cp_csr_from_coo(a,b,info)
integer(psb_ipk_) :: nza, nr, i,j,irw, err_act, nc
integer(psb_ipk_), Parameter :: maxtry=8
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
character(len=20) :: name='s_cp_csr_from_coo'
info = psb_success_
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()

40
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)
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
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')
@ -151,9 +155,14 @@ subroutine psb_z_base_cp_from_fmt(a,b,info)
!
info = psb_success_
call psb_erractionsave(err_act)
call b%cp_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
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_
call a%mv_to_coo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
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_
call b%mv_to_coo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
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

32
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
@ -2912,7 +2912,7 @@ subroutine psb_z_cp_coo_from_coo(a,b,info)
use psb_z_base_mat_mod, psb_protect_name => psb_z_cp_coo_from_coo
implicit none
class(psb_z_coo_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(in) :: b
class(psb_z_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
@ -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

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

@ -2139,8 +2139,7 @@ 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
integer(psb_ipk_), intent(out) :: info
type(psb_z_coo_sparse_mat) :: tmp
integer(psb_ipk_), allocatable :: itemp(:)
!locals

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

@ -2658,7 +2658,7 @@ subroutine psb_z_cp_csr_from_coo(a,b,info)
class(psb_z_csr_sparse_mat), intent(inout) :: a
class(psb_z_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
type(psb_z_coo_sparse_mat) :: tmp
integer(psb_ipk_), allocatable :: itemp(:)
@ -2667,13 +2667,13 @@ subroutine psb_z_cp_csr_from_coo(a,b,info)
integer(psb_ipk_) :: nza, nr, i,j,irw, err_act, nc
integer(psb_ipk_), Parameter :: maxtry=8
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name
character(len=20) :: name='z_cp_csr_from_coo'
info = psb_success_
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()

12
config/pac.m4
Unescape Escape View File

@ -1860,8 +1860,8 @@ if test "x$pac_metis_header_ok" == "xyes" ; then
psblas_cv_metis_includes="$METIS_INCLUDES"
METIS_LIBS="$psblas_cv_metis $METIS_LIBDIR"
LIBS="$METIS_LIBS -lm $LIBS";
AC_MSG_CHECKING([for METIS_PartGraphRecursive in $METIS_LIBS])
AC_TRY_LINK_FUNC(METIS_PartGraphRecursive,
AC_MSG_CHECKING([for METIS_PartGraphKway in $METIS_LIBS])
AC_TRY_LINK_FUNC(METIS_PartGraphKway,
[psblas_cv_have_metis=yes;pac_metis_lib_ok=yes; ],
[psblas_cv_have_metis=no;pac_metis_lib_ok=no; METIS_LIBS=""])
AC_MSG_RESULT($pac_metis_lib_ok)
@ -1871,8 +1871,8 @@ if test "x$pac_metis_header_ok" == "xyes" ; then
METIS_LIBS="$psblas_cv_metis $METIS_LIBDIR"
LIBS="$METIS_LIBS -lm $SAVE_LIBS"
AC_MSG_CHECKING([for METIS_PartGraphRecursive in $METIS_LIBS])
AC_TRY_LINK_FUNC(METIS_PartGraphRecursive,
AC_MSG_CHECKING([for METIS_PartGraphKway in $METIS_LIBS])
AC_TRY_LINK_FUNC(METIS_PartGraphKway,
[psblas_cv_have_metis=yes;pac_metis_lib_ok=yes; ],
[psblas_cv_have_metis=no;pac_metis_lib_ok=no; METIS_LIBS=""])
AC_MSG_RESULT($pac_metis_lib_ok)
@ -1882,8 +1882,8 @@ if test "x$pac_metis_header_ok" == "xyes" ; then
METIS_LIBDIR="-L$psblas_cv_metisdir/METIS/Lib -L$psblas_cv_metisdir/METIS/Lib"
METIS_LIBS="$psblas_cv_metis $METIS_LIBDIR"
LIBS="$METIS_LIBS -lm $SAVE_LIBS"
AC_MSG_CHECKING([for METIS_PartGraphRecursive in $METIS_LIBS])
AC_TRY_LINK_FUNC(METIS_PartGraphRecursive,
AC_MSG_CHECKING([for METIS_PartGraphKway in $METIS_LIBS])
AC_TRY_LINK_FUNC(METIS_PartGraphKway,
[psblas_cv_have_metis=yes;pac_metis_lib_ok=yes; ],
[psblas_cv_have_metis=no;pac_metis_lib_ok=no; METIS_LIBS=""])
AC_MSG_RESULT($pac_metis_lib_ok)

59
configure vendored
Unescape Escape View File

@ -7385,7 +7385,37 @@ fi
if test x"$pac_cv_serial_mpi" == x"yes" ; then
FDEFINES="$psblas_cv_define_prepend-DSERIAL_MPI $psblas_cv_define_prepend-DMPI_MOD $FDEFINES";
else
ac_exeext=''
ac_exeext=''
ac_ext='f90'
ac_link='${MPIFC-$FC} -o conftest${ac_exeext} $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
{ $as_echo "$as_me:$LINENO: checking MPI Fortran 2008 interface" >&5
$as_echo_n "checking MPI Fortran 2008 interface... " >&6; }
cat > conftest.$ac_ext <<EOF
program test
use mpi_f08
end program test
EOF
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
(eval $ac_link) 2>&5
ac_status=$?
$as_echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && test -s conftest${ac_exeext}; then
pac_cv_mpi_f08="yes";
{ $as_echo "$as_me:$LINENO: result: use mpi_f08. " >&5
$as_echo " use mpi_f08. " >&6; }
:
else
pac_cv_mpi_f08="no";
echo "configure: failed program was:" >&5
cat conftest.$ac_ext >&5
{ $as_echo "$as_me:$LINENO: result: no. " >&5
$as_echo " no. " >&6; }
fi
rm -f conftest*
if test x"$pac_cv_mpi_f08" == x"yes" ; then
FDEFINES="$psblas_cv_define_prepend-DMPI_MOD $FDEFINES";
else
ac_exeext=''
ac_ext='f90'
ac_link='${MPIFC-$FC} -o conftest${ac_exeext} $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
{ $as_echo "$as_me:$LINENO: checking MPI Fortran interface" >&5
@ -7413,7 +7443,8 @@ $as_echo " include mpif.h " >&6; }
FDEFINES="$psblas_cv_define_prepend-DMPI_H $FDEFINES"
fi
rm -f conftest*
fi
fi
fi
{ $as_echo "$as_me:$LINENO: checking whether we want long (8 bytes) integers" >&5
@ -9943,8 +9974,8 @@ if test "x$pac_metis_header_ok" == "xyes" ; then
psblas_cv_metis_includes="$METIS_INCLUDES"
METIS_LIBS="$psblas_cv_metis $METIS_LIBDIR"
LIBS="$METIS_LIBS -lm $LIBS";
{ $as_echo "$as_me:$LINENO: checking for METIS_PartGraphRecursive in $METIS_LIBS" >&5
$as_echo_n "checking for METIS_PartGraphRecursive in $METIS_LIBS... " >&6; }
{ $as_echo "$as_me:$LINENO: checking for METIS_PartGraphKway in $METIS_LIBS" >&5
$as_echo_n "checking for METIS_PartGraphKway in $METIS_LIBS... " >&6; }
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
@ -9958,11 +9989,11 @@ cat >>conftest.$ac_ext <<_ACEOF
#ifdef __cplusplus
extern "C"
#endif
char METIS_PartGraphRecursive ();
char METIS_PartGraphKway ();
int
main ()
{
return METIS_PartGraphRecursive ();
return METIS_PartGraphKway ();
;
return 0;
}
@ -10006,8 +10037,8 @@ $as_echo "$pac_metis_lib_ok" >&6; }
METIS_LIBS="$psblas_cv_metis $METIS_LIBDIR"
LIBS="$METIS_LIBS -lm $SAVE_LIBS"
{ $as_echo "$as_me:$LINENO: checking for METIS_PartGraphRecursive in $METIS_LIBS" >&5
$as_echo_n "checking for METIS_PartGraphRecursive in $METIS_LIBS... " >&6; }
{ $as_echo "$as_me:$LINENO: checking for METIS_PartGraphKway in $METIS_LIBS" >&5
$as_echo_n "checking for METIS_PartGraphKway in $METIS_LIBS... " >&6; }
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
@ -10021,11 +10052,11 @@ cat >>conftest.$ac_ext <<_ACEOF
#ifdef __cplusplus
extern "C"
#endif
char METIS_PartGraphRecursive ();
char METIS_PartGraphKway ();
int
main ()
{
return METIS_PartGraphRecursive ();
return METIS_PartGraphKway ();
;
return 0;
}
@ -10069,8 +10100,8 @@ $as_echo "$pac_metis_lib_ok" >&6; }
METIS_LIBDIR="-L$psblas_cv_metisdir/METIS/Lib -L$psblas_cv_metisdir/METIS/Lib"
METIS_LIBS="$psblas_cv_metis $METIS_LIBDIR"
LIBS="$METIS_LIBS -lm $SAVE_LIBS"
{ $as_echo "$as_me:$LINENO: checking for METIS_PartGraphRecursive in $METIS_LIBS" >&5
$as_echo_n "checking for METIS_PartGraphRecursive in $METIS_LIBS... " >&6; }
{ $as_echo "$as_me:$LINENO: checking for METIS_PartGraphKway in $METIS_LIBS" >&5
$as_echo_n "checking for METIS_PartGraphKway in $METIS_LIBS... " >&6; }
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
@ -10084,11 +10115,11 @@ cat >>conftest.$ac_ext <<_ACEOF
#ifdef __cplusplus
extern "C"
#endif
char METIS_PartGraphRecursive ();
char METIS_PartGraphKway ();
int
main ()
{
return METIS_PartGraphRecursive ();
return METIS_PartGraphKway ();
;
return 0;
}

17
configure.ac
Unescape Escape View File

@ -515,15 +515,16 @@ fi
if test x"$pac_cv_serial_mpi" == x"yes" ; then
FDEFINES="$psblas_cv_define_prepend-DSERIAL_MPI $psblas_cv_define_prepend-DMPI_MOD $FDEFINES";
else
dnl PAC_FORTRAN_CHECK_HAVE_MPI_MOD_F08()
dnl if test x"$pac_cv_mpi_f08" == x"yes" ; then
PAC_FORTRAN_CHECK_HAVE_MPI_MOD_F08()
if test x"$pac_cv_mpi_f08" == x"yes" ; then
dnl FDEFINES="$psblas_cv_define_prepend-DMPI_MOD_F08 $FDEFINES";
dnl else
PAC_FORTRAN_CHECK_HAVE_MPI_MOD(
[FDEFINES="$psblas_cv_define_prepend-DMPI_MOD $FDEFINES"],
[FDEFINES="$psblas_cv_define_prepend-DMPI_H $FDEFINES"])
fi
dnl fi
FDEFINES="$psblas_cv_define_prepend-DMPI_MOD $FDEFINES";
else
PAC_FORTRAN_CHECK_HAVE_MPI_MOD(
[FDEFINES="$psblas_cv_define_prepend-DMPI_MOD $FDEFINES"],
[FDEFINES="$psblas_cv_define_prepend-DMPI_H $FDEFINES"])
fi
fi
PAC_ARG_LONG_INTEGERS
if test x"$pac_cv_long_integers" == x"yes" ; then

12
util/metis_int.c
Unescape Escape View File

@ -2,10 +2,10 @@
#if defined(HAVE_METIS_)
#include "metis.h"
/* extern int METIS_PartGraphRecursive(int *, int *, int *, int *, int *, int *, int *, int *, float *, float, int *, int *, int *); */
/* extern int METIS_PartGraphKway(int *, int *, int *, int *, int *, int *, int *, int *, float *, float, int *, int *, int *); */
int metis_PartGraphRecursive_C(int *n, int *ixadj, int *iadj, int *ivwg,
int metis_PartGraphKway_C(int *n, int *ixadj, int *iadj, int *ivwg,
int *iajw, int *nparts, float *weights,
int *graphpart)
{
@ -19,14 +19,14 @@ int metis_PartGraphRecursive_C(int *n, int *ixadj, int *iadj, int *ivwg,
//printf("n:%p ncon:%p ixadj:%p iadj:%p npart:%p weights:%p options:%p objval:%p graphpart: %p\n",n,&ncon,ixadj,iadj,nparts,NULL,options,&objval,graphpart);
/* fprintf(stderr,"From metis_int: %f\n",weights[0]); */
if (weights[0] == -1.0) {
res = METIS_PartGraphRecursive((idx_t*)n,(idx_t *)&ncon,(idx_t *)ixadj,(idx_t *)iadj,
res = METIS_PartGraphKway((idx_t*)n,(idx_t *)&ncon,(idx_t *)ixadj,(idx_t *)iadj,
NULL,NULL,NULL,(idx_t *)nparts,NULL,NULL,options,
&objval,(idx_t *)graphpart);
} else {
/* res = METIS_PartGraphRecursive((idx_t*)n,(idx_t *)&ncon,(idx_t *)ixadj,(idx_t *)iadj, */
/* res = METIS_PartGraphKway((idx_t*)n,(idx_t *)&ncon,(idx_t *)ixadj,(idx_t *)iadj, */
/* NULL,NULL,NULL,(idx_t *)nparts,NULL,NULL,NULL, */
/* &objval,(idx_t *)graphpart); */
res = METIS_PartGraphRecursive((idx_t*)n,(idx_t *)&ncon,(idx_t *)ixadj,(idx_t *)iadj,
res = METIS_PartGraphKway((idx_t*)n,(idx_t *)&ncon,(idx_t *)ixadj,(idx_t *)iadj,
NULL,NULL,NULL,(idx_t *)nparts,weights,NULL,options,
&objval,(idx_t *)graphpart);
}
@ -40,7 +40,7 @@ int metis_PartGraphRecursive_C(int *n, int *ixadj, int *iadj, int *ivwg,
#else
int metis_PartGraphRecursive_C(int *n, int *ixadj, int *iadj, int *ivwg,
int metis_PartGraphKway_C(int *n, int *ixadj, int *iadj, int *ivwg,
int *iajw, int *nparts, float *weights,
int *graphpart)
{

35
util/psb_d_mmio_impl.f90
Unescape Escape View File

@ -335,10 +335,14 @@ subroutine dmm_mat_read(a, info, iunit, filename)
read(infile,fmt=*,end=902,err=905) acoo%ia(i),acoo%ja(i),acoo%val(i)
end do
call acoo%set_nzeros(nnzero)
call acoo%fix(info)
call a%mv_from(acoo)
call a%cscnv(ircode,type='csr')
else if ((psb_tolower(type) == 'pattern').and.(psb_tolower(sym) == 'general')) then
call acoo%allocate(nrow,ncol,nnzero)
do i=1,nnzero
read(infile,fmt=*,end=902,err=905) acoo%ia(i),acoo%ja(i)
end do
acoo%val(:) = done
call acoo%set_nzeros(nnzero)
else if ((psb_tolower(type) == 'real').and.(psb_tolower(sym) == 'symmetric')) then
! we are generally working with non-symmetric matrices, so
@ -357,15 +361,34 @@ subroutine dmm_mat_read(a, info, iunit, filename)
end if
end do
call acoo%set_nzeros(nzr)
call acoo%fix(info)
call a%mv_from(acoo)
call a%cscnv(ircode,type='csr')
else if ((psb_tolower(type) == 'pattern').and.(psb_tolower(sym) == 'symmetric')) then
call acoo%allocate(nrow,ncol,2*nnzero)
do i=1,nnzero
read(infile,fmt=*,end=902,err=905) acoo%ia(i),acoo%ja(i)
end do
acoo%val(:) = done
nzr = nnzero
do i=1,nnzero
if (acoo%ia(i) /= acoo%ja(i)) then
nzr = nzr + 1
acoo%ia(nzr) = acoo%ja(i)
acoo%ja(nzr) = acoo%ia(i)
end if
end do
call acoo%set_nzeros(nzr)
else
write(psb_err_unit,*) 'read_matrix: matrix type not yet supported'
info=904
end if
if (info == 0) then
call acoo%fix(info)
call a%mv_from(acoo)
call a%cscnv(ircode,type='csr')
end if
if (infile /= 5) close(infile)
return

120
util/psb_metispart_mod.F90
Unescape Escape View File

@ -45,7 +45,7 @@
! integer(psb_ipk_) :: NPARTS How many parts we are requiring to the
! partition utility
!
! DISTR_MTPART(RROOT,CROOT,ICTXT): This subroutine will be called by
! DISTR_MTPART(ROOT,ICTXT): This subroutine will be called by
! all processes to distribute the information computed by the root
! process, to be used subsequently.
!
@ -55,14 +55,21 @@
!
module psb_metispart_mod
use psb_base_mod, only : psb_ipk_, psb_sspmat_type, psb_cspmat_type,&
& psb_dspmat_type, psb_zspmat_type, psb_err_unit, psb_mpik_
& psb_dspmat_type, psb_zspmat_type, psb_err_unit, psb_mpik_,&
& psb_s_csr_sparse_mat, psb_d_csr_sparse_mat, &
& psb_c_csr_sparse_mat, psb_z_csr_sparse_mat
public part_graph, build_mtpart, distr_mtpart,&
& getv_mtpart, free_part
private
integer(psb_ipk_), allocatable, save :: graph_vect(:)
interface build_mtpart
module procedure build_mtpart, d_mat_build_mtpart, s_mat_build_mtpart, z_mat_build_mtpart, c_mat_build_mtpart
module procedure build_mtpart,&
& d_mat_build_mtpart, s_mat_build_mtpart,&
& z_mat_build_mtpart, c_mat_build_mtpart, &
& d_csr_build_mtpart, s_csr_build_mtpart,&
& z_csr_build_mtpart, c_csr_build_mtpart
end interface
contains
@ -154,11 +161,10 @@ contains
if (allocated(wgh_)) then
call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts,wgh_)
else
call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts,wgh_)
call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts)
end if
class default
write(psb_err_unit,*) 'Sorry, right now we only take CSR input!'
call psb_abort(ictxt)
end select
end subroutine d_mat_build_mtpart
@ -173,7 +179,7 @@ contains
select type (aa=>a%a)
type is (psb_z_csr_sparse_mat)
type is (psb_z_csr_sparse_mat)
if (present(weights)) then
if (size(weights)==nparts) then
wgh_ = weights
@ -182,11 +188,10 @@ contains
if (allocated(wgh_)) then
call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts,wgh_)
else
call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts,wgh_)
call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts)
end if
class default
write(psb_err_unit,*) 'Sorry, right now we only take CSR input!'
call psb_abort(ictxt)
end select
end subroutine z_mat_build_mtpart
@ -204,7 +209,6 @@ contains
call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts,weights)
class default
write(psb_err_unit,*) 'Sorry, right now we only take CSR input!'
call psb_abort(ictxt)
end select
end subroutine s_mat_build_mtpart
@ -222,11 +226,79 @@ contains
call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts,weights)
class default
write(psb_err_unit,*) 'Sorry, right now we only take CSR input!'
call psb_abort(ictxt)
end select
end subroutine c_mat_build_mtpart
subroutine d_csr_build_mtpart(a,nparts,weights)
use psb_base_mod
type(psb_d_csr_sparse_mat), intent(in) :: a
integer(psb_ipk_) :: nparts
real(psb_dpk_), optional :: weights(:)
real(psb_spk_), allocatable :: wgh_(:)
if (present(weights)) then
if (size(weights)==nparts) then
wgh_ = weights
end if
end if
if (allocated(wgh_)) then
call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,wgh_)
else
call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts)
end if
end subroutine d_csr_build_mtpart
subroutine z_csr_build_mtpart(a,nparts,weights)
use psb_base_mod
type(psb_z_csr_sparse_mat), intent(in) :: a
integer(psb_ipk_) :: nparts
real(psb_dpk_), optional :: weights(:)
real(psb_spk_), allocatable :: wgh_(:)
if (present(weights)) then
if (size(weights)==nparts) then
wgh_ = weights
end if
end if
if (allocated(wgh_)) then
call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,wgh_)
else
call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts)
end if
end subroutine z_csr_build_mtpart
subroutine s_csr_build_mtpart(a,nparts,weights)
use psb_base_mod
type(psb_s_csr_sparse_mat), intent(in) :: a
integer(psb_ipk_) :: nparts
real(psb_spk_), optional :: weights(:)
call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,weights)
end subroutine s_csr_build_mtpart
subroutine c_csr_build_mtpart(a,nparts,weights)
use psb_base_mod
type(psb_c_csr_sparse_mat), intent(in) :: a
integer(psb_ipk_) :: nparts
real(psb_spk_), optional :: weights(:)
call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,weights)
end subroutine c_csr_build_mtpart
subroutine build_mtpart(n,fida,ja,irp,nparts,weights)
use psb_base_mod
implicit none
@ -244,7 +316,7 @@ contains
#if defined(HAVE_METIS)
interface
! subroutine METIS_PartGraphRecursive(n,ixadj,iadj,ivwg,iajw,&
! subroutine METIS_PartGraphKway(n,ixadj,iadj,ivwg,iajw,&
! & wgflag,numflag,nparts,weights,iopt,nedc,part) bind(c)
! use iso_c_binding
! integer(c_int) :: n,wgflag,numflag,nparts,nedc
@ -252,10 +324,10 @@ contains
! real(c_float) :: weights(*)
! !integer(psb_ipk_) :: n,wgflag,numflag,nparts,nedc
! !integer(psb_ipk_) :: ixadj(*),iadj(*),ivwg(*),iajw(*),iopt(*),part(*)
! end subroutine METIS_PartGraphRecursive
! end subroutine METIS_PartGraphKway
function METIS_PartGraphRecursive(n,ixadj,iadj,ivwg,iajw,&
& nparts,weights,part) bind(c,name="metis_PartGraphRecursive_C") result(res)
function METIS_PartGraphKway(n,ixadj,iadj,ivwg,iajw,&
& nparts,weights,part) bind(c,name="metis_PartGraphKway_C") result(res)
use iso_c_binding
integer(c_int) :: res
integer(c_int) :: n,nparts
@ -263,7 +335,7 @@ contains
real(c_float) :: weights(*)
!integer(psb_ipk_) :: n,wgflag,numflag,nparts,nedc
!integer(psb_ipk_) :: ixadj(*),iadj(*),ivwg(*),iajw(*),iopt(*),part(*)
end function METIS_PartGraphRecursive
end function METIS_PartGraphKway
end interface
call psb_realloc(n,graph_vect,info)
@ -280,7 +352,7 @@ contains
numflag = 1
wgflag = 0
write(*,*) 'Before allocation',nparts
!!$ write(*,*) 'Before allocation',nparts
irpl=irp
jal = ja
@ -289,23 +361,23 @@ contains
wgh_ = -1.0
if(present(weights)) then
if (size(weights) == nptl) then
write(*,*) 'weights present',weights
! call METIS_PartGraphRecursive(n,irp,ja,idummy,jdummy,&
!!$ write(*,*) 'weights present',weights
! call METIS_PartGraphKway(n,irp,ja,idummy,jdummy,&
! & wgflag,numflag,nparts,weights,iopt,nedc,graph_vect)
info = METIS_PartGraphRecursive(nl,irpl,jal,idummy,jdummy,&
info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,&
& nptl,weights,gvl)
else
write(*,*) 'weights absent',wgh_
info = METIS_PartGraphRecursive(nl,irpl,jal,idummy,jdummy,&
!!$ write(*,*) 'weights absent',wgh_
info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,&
& nptl,wgh_,gvl)
end if
else
write(*,*) 'weights absent',wgh_
info = METIS_PartGraphRecursive(nl,irpl,jal,idummy,jdummy,&
!!$ write(*,*) 'weights absent',wgh_
info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,&
& nptl,wgh_,gvl)
endif
write(*,*) 'after allocation',info
!!$ write(*,*) 'after allocation',info
do i=1, n
graph_vect(i) = gvl(i) - 1

Write Preview
Loading…
Cancel
Save