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

Fix new parmatch stuff

Browse Source
mergeparmatch
Salvatore Filippone 4 years ago
parent 52f6900fc6
commit c045b2af4a
18 changed files with 51 additions and 401 deletions
Show Stats Download Patch File Download Diff File

70
amgprec/amg_d_matchboxp_mod.f90
Unescape Escape View File

@ -68,7 +68,7 @@
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
module amg_d_matchboxp_mod module dmatchboxp_mod
use iso_c_binding use iso_c_binding
use psb_base_cbind_mod use psb_base_cbind_mod
@ -94,21 +94,17 @@ module amg_d_matchboxp_mod
end subroutine dMatchBoxPC end subroutine dMatchBoxPC
end interface MatchBoxPC end interface MatchBoxPC
interface amg_i_aggr_assign interface i_aggr_assign
module procedure amg_i_daggr_assign module procedure i_daggr_assign
end interface amg_i_aggr_assign end interface i_aggr_assign
interface amg_build_matching interface build_matching
module procedure amg_d_build_matching module procedure dbuild_matching
end interface amg_build_matching end interface build_matching
interface amg_matchboxp_build_prol interface build_ahat
module procedure amg_d_matchboxp_build_prol module procedure dbuild_ahat
end interface amg_matchboxp_build_prol end interface build_ahat
interface amg_build_ahat
module procedure amg_d_build_ahat
end interface amg_build_ahat
interface psb_gtranspose interface psb_gtranspose
module procedure psb_dgtranspose module procedure psb_dgtranspose
@ -124,7 +120,7 @@ module amg_d_matchboxp_mod
contains contains
subroutine amg_d_matchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,& subroutine dmatchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,&
& symmetrize,reproducible,display_inp, display_out, print_out) & symmetrize,reproducible,display_inp, display_out, print_out)
use psb_base_mod use psb_base_mod
use psb_util_mod use psb_util_mod
@ -198,11 +194,6 @@ contains
ilv = [(i,i=1,desc_a%get_local_cols())] ilv = [(i,i=1,desc_a%get_local_cols())]
call desc_a%l2gip(ilv,info,owned=.false.) call desc_a%l2gip(ilv,info,owned=.false.)
!!$ if (dump) then
!!$ write(aname,'(a,i3.3,a)') 'amat',iam,'.mtx'
!!$ call a%print(fname=aname,head='Test ',iv=ilv)
!!$ end if
call psb_geall(ilaggr,desc_a,info) call psb_geall(ilaggr,desc_a,info)
ilaggr = -1 ilaggr = -1
call psb_geasb(ilaggr,desc_a,info) call psb_geasb(ilaggr,desc_a,info)
@ -222,7 +213,7 @@ contains
end if end if
if (do_timings) call psb_toc(idx_phase1) if (do_timings) call psb_toc(idx_phase1)
if (do_timings) call psb_tic(idx_bldmtc) if (do_timings) call psb_tic(idx_bldmtc)
call amg_build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize) call build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize)
if (do_timings) call psb_toc(idx_bldmtc) if (do_timings) call psb_toc(idx_bldmtc)
if (debug) write(0,*) iam,' buildprol from buildmatching:',& if (debug) write(0,*) iam,' buildprol from buildmatching:',&
& info & info
@ -316,11 +307,11 @@ contains
else else
! Use a statistically unbiased tie-breaking rule, ! Use a statistically unbiased tie-breaking rule,
! this will give an even spread. ! this will give an even spread.
! Delegate to amg_i_aggr_assign. ! Delegate to i_aggr_assign.
! Should be a symmetric function. ! Should be a symmetric function.
! !
call desc_a%indxmap%qry_halo_owner(idx,iown,info) call desc_a%indxmap%qry_halo_owner(idx,iown,info)
ip = amg_i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) ip = i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg)
if (iam == ip) then if (iam == ip) then
nlaggr(iam) = nlaggr(iam) + 1 nlaggr(iam) = nlaggr(iam) + 1
ilaggr(k) = nlaggr(iam) ilaggr(k) = nlaggr(iam)
@ -429,9 +420,6 @@ contains
nlsingl = v(2) nlsingl = v(2)
nlpairs = v(3) nlpairs = v(3)
!!$ call psb_sum(ictxt,nunmatched)
!!$ call psb_sum(ictxt,nlsingl)
!!$ call psb_sum(ictxt,nlpairs)
end block end block
if (iam == 0) then if (iam == 0) then
write(0,*) 'Matching statistics: Unmatched nodes ',& write(0,*) 'Matching statistics: Unmatched nodes ',&
@ -525,9 +513,9 @@ contains
write(0,*) iam,' : error from Matching: ',info write(0,*) iam,' : error from Matching: ',info
end if end if
end subroutine amg_d_matchboxp_build_prol end subroutine dmatchboxp_build_prol
function amg_i_daggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) & function i_daggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) &
& result(iproc) & result(iproc)
! !
! How to break ties? This ! How to break ties? This
@ -569,10 +557,10 @@ contains
iproc = iown iproc = iown
end if end if
end if end if
end function amg_i_daggr_assign end function i_daggr_assign
subroutine amg_d_build_matching(w,a,desc_a,mate,info,display_inp, symmetrize) subroutine dbuild_matching(w,a,desc_a,mate,info,display_inp, symmetrize)
use psb_base_mod use psb_base_mod
use psb_util_mod use psb_util_mod
use iso_c_binding use iso_c_binding
@ -598,7 +586,7 @@ contains
integer(psb_ipk_), save :: cnt=2 integer(psb_ipk_), save :: cnt=2
logical, parameter :: debug=.false., dump_ahat=.false., debug_sync=.false. logical, parameter :: debug=.false., dump_ahat=.false., debug_sync=.false.
logical, parameter :: old_style=.false., sort_minp=.true. logical, parameter :: old_style=.false., sort_minp=.true.
character(len=40) :: name='amg_build_matching', fname character(len=40) :: name='build_matching', fname
integer(psb_ipk_), save :: idx_cmboxp=-1, idx_bldahat=-1, idx_phase2=-1, idx_phase3=-1 integer(psb_ipk_), save :: idx_cmboxp=-1, idx_bldahat=-1, idx_phase2=-1, idx_phase3=-1
logical, parameter :: do_timings=.true. logical, parameter :: do_timings=.true.
@ -621,7 +609,7 @@ contains
if (iam == 0) write(0,*)' Into build_ahat:' if (iam == 0) write(0,*)' Into build_ahat:'
end if end if
if (do_timings) call psb_tic(idx_bldahat) if (do_timings) call psb_tic(idx_bldahat)
call amg_build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize) call build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize)
if (do_timings) call psb_toc(idx_bldahat) if (do_timings) call psb_toc(idx_bldahat)
if (info /= 0) then if (info /= 0) then
write(0,*) 'Error from build_ahat ', info write(0,*) 'Error from build_ahat ', info
@ -776,9 +764,9 @@ contains
val(1:n) = tmp(1:n) val(1:n) = tmp(1:n)
end subroutine fix_order end subroutine fix_order
end subroutine amg_d_build_matching end subroutine dbuild_matching
subroutine amg_d_build_ahat(w,a,ahat,desc_a,info,symmetrize) subroutine dbuild_ahat(w,a,ahat,desc_a,info,symmetrize)
use psb_base_mod use psb_base_mod
implicit none implicit none
real(psb_dpk_), intent(in) :: w(:) real(psb_dpk_), intent(in) :: w(:)
@ -885,8 +873,6 @@ contains
else else
tcoo2%val(k2) = eps tcoo2%val(k2) = eps
end if end if
!!$ tcoo2%val(k2) = abs( tcoo2%val(k2) )
!!$ minabs = min(minabs, tcoo2%val(k2) )
end if end if
!else !else
! write(0,*) 'build_ahat: index error :',ii,jj,' : boundaries :',nr,nc ! write(0,*) 'build_ahat: index error :',ii,jj,' : boundaries :',nr,nc
@ -1016,8 +1002,7 @@ contains
end block end block
end if end if
end subroutine amg_d_build_ahat end subroutine dbuild_ahat
subroutine psb_dgtranspose(ain,aout,desc_a,info) subroutine psb_dgtranspose(ain,aout,desc_a,info)
use psb_base_mod use psb_base_mod
@ -1080,10 +1065,7 @@ contains
! FIXME THIS NEEDS REWORKING ! FIXME THIS NEEDS REWORKING
if (debug) write(0,*) me,' Gtranspose into sphalo :',atmp%get_nrows(),atmp%get_ncols() if (debug) write(0,*) me,' Gtranspose into sphalo :',atmp%get_nrows(),atmp%get_ncols()
call psb_sphalo(atmp,desc_a,ahalo,info,rowscale=.true.) call psb_sphalo(atmp,desc_a,ahalo,info,rowscale=.true.)
!!$ call psb_sphalo(atmp,desc_a,ahalo,info,&
!!$ & colcnv=.false.,rowscale=.true.)
if (debug) write(0,*) me,' Gtranspose from sphalo :',ahalo%get_nrows(),ahalo%get_ncols() if (debug) write(0,*) me,' Gtranspose from sphalo :',ahalo%get_nrows(),ahalo%get_ncols()
!!$ call psb_set_debug_level(0)
if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo) if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo)
if (debug) then if (debug) then
@ -1248,10 +1230,7 @@ contains
else else
call psb_sphalo(atmp,desc_a,ahalo,info, rowscale=.true.) call psb_sphalo(atmp,desc_a,ahalo,info, rowscale=.true.)
!!$ call psb_sphalo(atmp,desc_a,ahalo,info,&
!!$ & colcnv=.false.,rowscale=.true.)
if (debug) write(0,*) me,' Htranspose from sphalo :',ahalo%get_nrows(),ahalo%get_ncols() if (debug) write(0,*) me,' Htranspose from sphalo :',ahalo%get_nrows(),ahalo%get_ncols()
!!$ call psb_set_debug_level(0)
if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo) if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo)
if (debug) then if (debug) then
@ -1265,7 +1244,6 @@ contains
call atmp%cp_to(tmpcoo) call atmp%cp_to(tmpcoo)
call tmpcoo%transp() call tmpcoo%transp()
!call psb_glob_to_loc(tmpcoo%ia,desc_a,info,iact='I')
if (debug) write(0,*) 'Before cleanup:',tmpcoo%get_nzeros() if (debug) write(0,*) 'Before cleanup:',tmpcoo%get_nzeros()
if (.true.) then if (.true.) then
call tmpcoo%clean_negidx(info) call tmpcoo%clean_negidx(info)
@ -1455,4 +1433,4 @@ contains
end subroutine dPMatchBox end subroutine dPMatchBox
end module amg_d_matchboxp_mod end module dmatchboxp_mod

28
amgprec/amg_d_parmatch_aggregator_mod.F90
Unescape Escape View File

@ -118,7 +118,7 @@
module amg_d_parmatch_aggregator_mod module amg_d_parmatch_aggregator_mod
use amg_d_base_aggregator_mod use amg_d_base_aggregator_mod
use amg_d_matchboxp_mod use dmatchboxp_mod
type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type
integer(psb_ipk_) :: matching_alg integer(psb_ipk_) :: matching_alg
@ -155,18 +155,6 @@ module amg_d_parmatch_aggregator_mod
procedure, nopass :: xt_desc => amg_d_parmatch_aggregator_xt_desc procedure, nopass :: xt_desc => amg_d_parmatch_aggregator_xt_desc
end type amg_d_parmatch_aggregator_type end type amg_d_parmatch_aggregator_type
!!$ interface
!!$ subroutine glob_transpose(ain,desc_r,desc_c,atrans,desc_rx,info)
!!$ import :: psb_desc_type, psb_ld_coo_sparse_mat, psb_ipk_
!!$ implicit none
!!$ type(psb_ld_coo_sparse_mat), intent(in) :: ain
!!$ type(psb_ld_coo_sparse_mat), intent(out) :: atrans
!!$ type(psb_desc_type), intent(inout) :: desc_r, desc_c
!!$ type(psb_desc_type), intent(out) :: desc_rx
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine glob_transpose
!!$ end interface
interface interface
subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,& subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,t_prol,info) & a,desc_a,ilaggr,nlaggr,t_prol,info)
@ -325,20 +313,6 @@ module amg_d_parmatch_aggregator_mod
end subroutine amg_d_parmatch_spmm_bld_inner end subroutine amg_d_parmatch_spmm_bld_inner
end interface end interface
!!$ interface
!!$ Subroutine amg_d_p_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data)
!!$ import
!!$ Implicit None
!!$ type(psb_ld_csr_sparse_mat),intent(in) :: acsr
!!$ type(psb_ld_csr_sparse_mat),intent(inout) :: bcsr
!!$ type(psb_ld_csr_sparse_mat),intent(out) :: ccsr
!!$ type(psb_desc_type),intent(in) :: desc_a
!!$ type(psb_desc_type),intent(inout) :: desc_c
!!$ integer(psb_ipk_), intent(out) :: info
!!$ integer(psb_ipk_), intent(in), optional :: data
!!$ end Subroutine amg_d_p_csr_spspmm
!!$ end interface
private :: is_legal_malg, is_legal_csize, is_legal_nsweeps, is_legal_nlevels private :: is_legal_malg, is_legal_csize, is_legal_nsweeps, is_legal_nlevels
contains contains

68
amgprec/amg_s_matchboxp_mod.f90
Unescape Escape View File

@ -68,7 +68,7 @@
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE. ! POSSIBILITY OF SUCH DAMAGE.
! !
module amg_s_matchboxp_mod module smatchboxp_mod
use iso_c_binding use iso_c_binding
use psb_base_cbind_mod use psb_base_cbind_mod
@ -94,21 +94,17 @@ module amg_s_matchboxp_mod
end subroutine sMatchBoxPC end subroutine sMatchBoxPC
end interface MatchBoxPC end interface MatchBoxPC
interface amg_i_aggr_assign interface i_aggr_assign
module procedure amg_i_saggr_assign module procedure i_saggr_assign
end interface amg_i_aggr_assign end interface i_aggr_assign
interface amg_matchboxp_build_prol interface build_matching
module procedure amg_s_matchboxp_build_prol module procedure sbuild_matching
end interface amg_matchboxp_build_prol end interface build_matching
interface amg_build_matching interface build_ahat
module procedure amg_s_build_matching module procedure sbuild_ahat
end interface amg_build_matching end interface build_ahat
interface amg_build_ahat
module procedure amg_s_build_ahat
end interface amg_build_ahat
interface psb_gtranspose interface psb_gtranspose
module procedure psb_sgtranspose module procedure psb_sgtranspose
@ -124,7 +120,7 @@ module amg_s_matchboxp_mod
contains contains
subroutine amg_s_matchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,& subroutine smatchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,&
& symmetrize,reproducible,display_inp, display_out, print_out) & symmetrize,reproducible,display_inp, display_out, print_out)
use psb_base_mod use psb_base_mod
use psb_util_mod use psb_util_mod
@ -198,11 +194,6 @@ contains
ilv = [(i,i=1,desc_a%get_local_cols())] ilv = [(i,i=1,desc_a%get_local_cols())]
call desc_a%l2gip(ilv,info,owned=.false.) call desc_a%l2gip(ilv,info,owned=.false.)
!!$ if (dump) then
!!$ write(aname,'(a,i3.3,a)') 'amat',iam,'.mtx'
!!$ call a%print(fname=aname,head='Test ',iv=ilv)
!!$ end if
call psb_geall(ilaggr,desc_a,info) call psb_geall(ilaggr,desc_a,info)
ilaggr = -1 ilaggr = -1
call psb_geasb(ilaggr,desc_a,info) call psb_geasb(ilaggr,desc_a,info)
@ -222,7 +213,7 @@ contains
end if end if
if (do_timings) call psb_toc(idx_phase1) if (do_timings) call psb_toc(idx_phase1)
if (do_timings) call psb_tic(idx_bldmtc) if (do_timings) call psb_tic(idx_bldmtc)
call amg_build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize) call build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize)
if (do_timings) call psb_toc(idx_bldmtc) if (do_timings) call psb_toc(idx_bldmtc)
if (debug) write(0,*) iam,' buildprol from buildmatching:',& if (debug) write(0,*) iam,' buildprol from buildmatching:',&
& info & info
@ -316,11 +307,11 @@ contains
else else
! Use a statistically unbiased tie-breaking rule, ! Use a statistically unbiased tie-breaking rule,
! this will give an even spread. ! this will give an even spread.
! Delegate to amg_i_aggr_assign. ! Delegate to i_aggr_assign.
! Should be a symmetric function. ! Should be a symmetric function.
! !
call desc_a%indxmap%qry_halo_owner(idx,iown,info) call desc_a%indxmap%qry_halo_owner(idx,iown,info)
ip = amg_i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) ip = i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg)
if (iam == ip) then if (iam == ip) then
nlaggr(iam) = nlaggr(iam) + 1 nlaggr(iam) = nlaggr(iam) + 1
ilaggr(k) = nlaggr(iam) ilaggr(k) = nlaggr(iam)
@ -429,9 +420,6 @@ contains
nlsingl = v(2) nlsingl = v(2)
nlpairs = v(3) nlpairs = v(3)
!!$ call psb_sum(ictxt,nunmatched)
!!$ call psb_sum(ictxt,nlsingl)
!!$ call psb_sum(ictxt,nlpairs)
end block end block
if (iam == 0) then if (iam == 0) then
write(0,*) 'Matching statistics: Unmatched nodes ',& write(0,*) 'Matching statistics: Unmatched nodes ',&
@ -525,9 +513,9 @@ contains
write(0,*) iam,' : error from Matching: ',info write(0,*) iam,' : error from Matching: ',info
end if end if
end subroutine amg_s_matchboxp_build_prol end subroutine smatchboxp_build_prol
function amg_i_saggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) & function i_saggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) &
& result(iproc) & result(iproc)
! !
! How to break ties? This ! How to break ties? This
@ -569,10 +557,10 @@ contains
iproc = iown iproc = iown
end if end if
end if end if
end function amg_i_saggr_assign end function i_saggr_assign
subroutine amg_s_build_matching(w,a,desc_a,mate,info,display_inp, symmetrize) subroutine sbuild_matching(w,a,desc_a,mate,info,display_inp, symmetrize)
use psb_base_mod use psb_base_mod
use psb_util_mod use psb_util_mod
use iso_c_binding use iso_c_binding
@ -621,7 +609,7 @@ contains
if (iam == 0) write(0,*)' Into build_ahat:' if (iam == 0) write(0,*)' Into build_ahat:'
end if end if
if (do_timings) call psb_tic(idx_bldahat) if (do_timings) call psb_tic(idx_bldahat)
call amg_build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize) call build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize)
if (do_timings) call psb_toc(idx_bldahat) if (do_timings) call psb_toc(idx_bldahat)
if (info /= 0) then if (info /= 0) then
write(0,*) 'Error from build_ahat ', info write(0,*) 'Error from build_ahat ', info
@ -776,9 +764,9 @@ contains
val(1:n) = tmp(1:n) val(1:n) = tmp(1:n)
end subroutine fix_order end subroutine fix_order
end subroutine amg_s_build_matching end subroutine sbuild_matching
subroutine amg_s_build_ahat(w,a,ahat,desc_a,info,symmetrize) subroutine sbuild_ahat(w,a,ahat,desc_a,info,symmetrize)
use psb_base_mod use psb_base_mod
implicit none implicit none
real(psb_spk_), intent(in) :: w(:) real(psb_spk_), intent(in) :: w(:)
@ -885,8 +873,6 @@ contains
else else
tcoo2%val(k2) = eps tcoo2%val(k2) = eps
end if end if
!!$ tcoo2%val(k2) = abs( tcoo2%val(k2) )
!!$ minabs = min(minabs, tcoo2%val(k2) )
end if end if
!else !else
! write(0,*) 'build_ahat: index error :',ii,jj,' : boundaries :',nr,nc ! write(0,*) 'build_ahat: index error :',ii,jj,' : boundaries :',nr,nc
@ -1016,8 +1002,7 @@ contains
end block end block
end if end if
end subroutine amg_s_build_ahat end subroutine sbuild_ahat
subroutine psb_sgtranspose(ain,aout,desc_a,info) subroutine psb_sgtranspose(ain,aout,desc_a,info)
use psb_base_mod use psb_base_mod
@ -1080,10 +1065,7 @@ contains
! FIXME THIS NEEDS REWORKING ! FIXME THIS NEEDS REWORKING
if (debug) write(0,*) me,' Gtranspose into sphalo :',atmp%get_nrows(),atmp%get_ncols() if (debug) write(0,*) me,' Gtranspose into sphalo :',atmp%get_nrows(),atmp%get_ncols()
call psb_sphalo(atmp,desc_a,ahalo,info,rowscale=.true.) call psb_sphalo(atmp,desc_a,ahalo,info,rowscale=.true.)
!!$ call psb_sphalo(atmp,desc_a,ahalo,info,&
!!$ & colcnv=.false.,rowscale=.true.)
if (debug) write(0,*) me,' Gtranspose from sphalo :',ahalo%get_nrows(),ahalo%get_ncols() if (debug) write(0,*) me,' Gtranspose from sphalo :',ahalo%get_nrows(),ahalo%get_ncols()
!!$ call psb_set_debug_level(0)
if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo) if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo)
if (debug) then if (debug) then
@ -1248,10 +1230,7 @@ contains
else else
call psb_sphalo(atmp,desc_a,ahalo,info, rowscale=.true.) call psb_sphalo(atmp,desc_a,ahalo,info, rowscale=.true.)
!!$ call psb_sphalo(atmp,desc_a,ahalo,info,&
!!$ & colcnv=.false.,rowscale=.true.)
if (debug) write(0,*) me,' Htranspose from sphalo :',ahalo%get_nrows(),ahalo%get_ncols() if (debug) write(0,*) me,' Htranspose from sphalo :',ahalo%get_nrows(),ahalo%get_ncols()
!!$ call psb_set_debug_level(0)
if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo) if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo)
if (debug) then if (debug) then
@ -1265,7 +1244,6 @@ contains
call atmp%cp_to(tmpcoo) call atmp%cp_to(tmpcoo)
call tmpcoo%transp() call tmpcoo%transp()
!call psb_glob_to_loc(tmpcoo%ia,desc_a,info,iact='I')
if (debug) write(0,*) 'Before cleanup:',tmpcoo%get_nzeros() if (debug) write(0,*) 'Before cleanup:',tmpcoo%get_nzeros()
if (.true.) then if (.true.) then
call tmpcoo%clean_negidx(info) call tmpcoo%clean_negidx(info)
@ -1455,4 +1433,4 @@ contains
end subroutine sPMatchBox end subroutine sPMatchBox
end module amg_s_matchboxp_mod end module smatchboxp_mod

28
amgprec/amg_s_parmatch_aggregator_mod.F90
Unescape Escape View File

@ -118,7 +118,7 @@
module amg_s_parmatch_aggregator_mod module amg_s_parmatch_aggregator_mod
use amg_s_base_aggregator_mod use amg_s_base_aggregator_mod
use amg_s_matchboxp_mod use smatchboxp_mod
type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type
integer(psb_ipk_) :: matching_alg integer(psb_ipk_) :: matching_alg
@ -155,18 +155,6 @@ module amg_s_parmatch_aggregator_mod
procedure, nopass :: xt_desc => amg_s_parmatch_aggregator_xt_desc procedure, nopass :: xt_desc => amg_s_parmatch_aggregator_xt_desc
end type amg_s_parmatch_aggregator_type end type amg_s_parmatch_aggregator_type
!!$ interface
!!$ subroutine glob_transpose(ain,desc_r,desc_c,atrans,desc_rx,info)
!!$ import :: psb_desc_type, psb_ld_coo_sparse_mat, psb_ipk_
!!$ implicit none
!!$ type(psb_ld_coo_sparse_mat), intent(in) :: ain
!!$ type(psb_ld_coo_sparse_mat), intent(out) :: atrans
!!$ type(psb_desc_type), intent(inout) :: desc_r, desc_c
!!$ type(psb_desc_type), intent(out) :: desc_rx
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine glob_transpose
!!$ end interface
interface interface
subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,& subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
& a,desc_a,ilaggr,nlaggr,t_prol,info) & a,desc_a,ilaggr,nlaggr,t_prol,info)
@ -325,20 +313,6 @@ module amg_s_parmatch_aggregator_mod
end subroutine amg_s_parmatch_spmm_bld_inner end subroutine amg_s_parmatch_spmm_bld_inner
end interface end interface
!!$ interface
!!$ Subroutine amg_d_p_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data)
!!$ import
!!$ Implicit None
!!$ type(psb_ld_csr_sparse_mat),intent(in) :: acsr
!!$ type(psb_ld_csr_sparse_mat),intent(inout) :: bcsr
!!$ type(psb_ld_csr_sparse_mat),intent(out) :: ccsr
!!$ type(psb_desc_type),intent(in) :: desc_a
!!$ type(psb_desc_type),intent(inout) :: desc_c
!!$ integer(psb_ipk_), intent(out) :: info
!!$ integer(psb_ipk_), intent(in), optional :: data
!!$ end Subroutine amg_d_p_csr_spspmm
!!$ end interface
private :: is_legal_malg, is_legal_csize, is_legal_nsweeps, is_legal_nlevels private :: is_legal_malg, is_legal_csize, is_legal_nsweeps, is_legal_nlevels
contains contains

34
amgprec/impl/aggregator/amg_c_ptap_bld.f90
Unescape Escape View File

@ -135,16 +135,9 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_c_coo_glob_transpose(coo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax) call psb_c_coo_glob_transpose(coo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax)
call coo_restr%set_nrows(desc_ac%get_local_rows()) call coo_restr%set_nrows(desc_ac%get_local_rows())
call coo_restr%set_ncols(desc_ax%get_local_cols()) call coo_restr%set_ncols(desc_ax%get_local_cols())
! !$ write(0,*) me,' ',trim(name),' check on glob_transpose 1: ',&
! !$ & desc_a%get_local_cols(),desc_ax%get_local_cols(),coo_restr%get_nzeros()
! !$ if (desc_a%get_local_cols()<desc_ax%get_local_cols()) then
! !$ write(0,*) me,' ',trim(name),' WARNING: GLOB_TRANSPOSE NEW INDICES '
! !$ end if
end block end block
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -170,8 +163,6 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',& if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros() & csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
call csr_prol%mv_to_coo(coo_restr,info) call csr_prol%mv_to_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' new into transposition ',coo_restr%get_nrows(),&
!!$ & coo_restr%get_ncols(),coo_restr%get_nzeros()
if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr)
call coo_restr%transp() call coo_restr%transp()
@ -197,8 +188,6 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -226,7 +215,6 @@ subroutine amg_c_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
call coo_prol%set_ncols(desc_ac%get_local_cols()) call coo_prol%set_ncols(desc_ac%get_local_cols())
if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)
@ -312,7 +300,6 @@ subroutine amg_c_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
ntaggr = sum(nlaggr) ntaggr = sum(nlaggr)
naggrm1 = sum(nlaggr(1:me)) naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1)) naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
! !
! COO_PROL should arrive here with local numbering ! COO_PROL should arrive here with local numbering
@ -350,16 +337,10 @@ subroutine amg_c_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_c_coo_glob_transpose(icoo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax) call psb_c_coo_glob_transpose(icoo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax)
call icoo_restr%set_nrows(desc_ac%get_local_rows()) call icoo_restr%set_nrows(desc_ac%get_local_rows())
call icoo_restr%set_ncols(desc_ax%get_local_cols()) call icoo_restr%set_ncols(desc_ax%get_local_cols())
! !$ write(0,*) me,' ',trim(name),' check on glob_transpose 1: ',&
! !$ & desc_a%get_local_cols(),desc_ax%get_local_cols(),icoo_restr%get_nzeros()
! !$ if (desc_a%get_local_cols()<desc_ax%get_local_cols()) then
! !$ write(0,*) me,' ',trim(name),' WARNING: GLOB_TRANSPOSE NEW INDICES '
! !$ end if
call coo_restr%cp_from_icoo(icoo_restr,info) call coo_restr%cp_from_icoo(icoo_restr,info)
end block end block
call csr_restr%cp_from_lcoo(coo_restr,info) call csr_restr%cp_from_lcoo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
@ -386,8 +367,6 @@ subroutine amg_c_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',& if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros() & csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
call csr_prol%mv_to_lcoo(coo_restr,info) call csr_prol%mv_to_lcoo(coo_restr,info)
!!$ write(0,*)me,' ',name,' new into transposition ',coo_restr%get_nrows(),&
!!$ & coo_restr%get_ncols(),coo_restr%get_nzeros()
if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr)
call coo_restr%transp() call coo_restr%transp()
@ -413,8 +392,6 @@ subroutine amg_c_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
call csr_restr%cp_from_lcoo(coo_restr,info) call csr_restr%cp_from_lcoo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -442,7 +419,6 @@ subroutine amg_c_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
call coo_prol%set_ncols(desc_ac%get_local_cols()) call coo_prol%set_ncols(desc_ac%get_local_cols())
if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)
@ -575,8 +551,6 @@ subroutine amg_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
end block end block
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -602,8 +576,6 @@ subroutine amg_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',& if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros() & csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
call csr_prol%mv_to_coo(coo_restr,info) call csr_prol%mv_to_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' new into transposition ',coo_restr%get_nrows(),&
!!$ & coo_restr%get_ncols(),coo_restr%get_nzeros()
if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr)
call coo_restr%transp() call coo_restr%transp()
@ -629,8 +601,6 @@ subroutine amg_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -658,12 +628,8 @@ subroutine amg_lc_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
call coo_prol%set_ncols(desc_ac%get_local_cols()) call coo_prol%set_ncols(desc_ac%get_local_cols())
!call coo_restr%mv_from_ifmt(csr_restr,info)
!!$ call coo_restr%set_nrows(desc_ac%get_local_rows())
!!$ call coo_restr%set_ncols(desc_a%get_local_cols())
if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)

4
amgprec/impl/aggregator/amg_c_rap.f90
Unescape Escape View File

@ -93,7 +93,6 @@ subroutine amg_c_rap(a_csr,desc_a,nlaggr,parms,ac,&
ntaggr = sum(nlaggr) ntaggr = sum(nlaggr)
naggrm1 = sum(nlaggr(1:me)) naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1)) naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
! !
! COO_PROL should arrive here with local numbering ! COO_PROL should arrive here with local numbering
@ -125,8 +124,6 @@ subroutine amg_c_rap(a_csr,desc_a,nlaggr,parms,ac,&
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -150,7 +147,6 @@ subroutine amg_c_rap(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
call coo_prol%set_ncols(desc_ac%get_local_cols()) call coo_prol%set_ncols(desc_ac%get_local_cols())
if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)

21
amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.f90
Unescape Escape View File

@ -324,7 +324,7 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
! !
if (debug) write(0,*) me,' Into matchbox_build_prol ',info if (debug) write(0,*) me,' Into matchbox_build_prol ',info
if (do_timings) call psb_tic(idx_mboxp) if (do_timings) call psb_tic(idx_mboxp)
call amg_d_matchboxp_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,& call dmatchboxp_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,&
& symmetrize=ag%need_symmetrize,reproducible=ag%reproducible_matching) & symmetrize=ag%need_symmetrize,reproducible=ag%reproducible_matching)
if (do_timings) call psb_toc(idx_mboxp) if (do_timings) call psb_toc(idx_mboxp)
if (debug) write(0,*) me,' Out from matchbox_build_prol ',info if (debug) write(0,*) me,' Out from matchbox_build_prol ',info
@ -348,7 +348,6 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
if (psb_errstatus_fatal()) write(0,*)me,trim(name),'Error fatal on exit from bld_ov(i)',info if (psb_errstatus_fatal()) write(0,*)me,trim(name),'Error fatal on exit from bld_ov(i)',info
if (debug) then if (debug) then
call psb_barrier(ictxt) call psb_barrier(ictxt)
!!$ write(0,*) name,' Call spmm_bld sweep:',i,n_sweeps
if (me==0) write(0,*) me,trim(name),' Done spmm_bld:',i if (me==0) write(0,*) me,trim(name),' Done spmm_bld:',i
end if end if
@ -356,17 +355,11 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
! Keep a copy of prolv(i) in global numbering for the time being, will ! Keep a copy of prolv(i) in global numbering for the time being, will
! need it to build the final ! need it to build the final
! if (i == n_sweeps) call prolv(i)%clone(tmp_prol,info) ! if (i == n_sweeps) call prolv(i)%clone(tmp_prol,info)
!!$ write(0,*) name,' Call mat_asb sweep:',i,n_sweeps
call ag%inner_mat_asb(parms,acv(i-1),desc_acv(i-1),& call ag%inner_mat_asb(parms,acv(i-1),desc_acv(i-1),&
& acv(i),desc_acv(i),prolv(i),restrv(1),info) & acv(i),desc_acv(i),prolv(i),restrv(1),info)
!!$ write(0,*) me,' From in_mat_asb:',&
!!$ & prolv(i)%get_nrows(),prolv(i)%get_ncols(),&
!!$ & restrv(1)%get_nrows(),restrv(1)%get_ncols(),&
!!$ & desc_acv(i)%get_local_rows(), desc_acv(i)%get_local_cols()
if (debug) then if (debug) then
call psb_barrier(ictxt) call psb_barrier(ictxt)
!!$ write(0,*) name,' Call spmm_bld sweep:',i,n_sweeps
if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),max_csize,info if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),max_csize,info
csz = sum(nxaggr) csz = sum(nxaggr)
call psb_bcast(ictxt,csz) call psb_bcast(ictxt,csz)
@ -413,13 +406,11 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
end if end if
call acv(i-1)%free() call acv(i-1)%free()
if ((sum(nlaggr) <= max_csize).or.(any(nlaggr==0))) then if ((sum(nlaggr) <= max_csize).or.(any(nlaggr==0))) then
!if (me==0) write(0,*) 'Early exit ',any(nlaggr==0),sum(nlaggr),max_csize,i
x_sweeps = i x_sweeps = i
exit sweeps_loop exit sweeps_loop
end if end if
if (debug) then if (debug) then
call psb_barrier(ictxt) call psb_barrier(ictxt)
!!$ write(0,*) name,' Call spmm_bld sweep:',i,n_sweeps
if (me==0) write(0,*) me,trim(name),' Done sweeps_loop iteration:',i,' of ',n_sweeps if (me==0) write(0,*) me,trim(name),' Done sweeps_loop iteration:',i,' of ',n_sweeps
end if end if
@ -427,11 +418,8 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
if (debug) then if (debug) then
call psb_barrier(ictxt) call psb_barrier(ictxt)
!!$ write(0,*) name,' Call spmm_bld sweep:',i,n_sweeps
if (me==0) write(0,*) me,trim(name),' Done sweeps_loop:',x_sweeps if (me==0) write(0,*) me,trim(name),' Done sweeps_loop:',x_sweeps
end if end if
!!$ write(0,*) me,name,' : End of aggregation sweeps ',&
!!$ & n_sweeps,' Final size:',max_csize,desc_acv(n_sweeps)%get_local_rows(),t_prol%get_ncols(),tmp_prol%get_ncols()
if (x_sweeps<=0) x_sweeps = n_sweeps if (x_sweeps<=0) x_sweeps = n_sweeps
if (do_timings) call psb_tic(idx_sweeps_mult) if (do_timings) call psb_tic(idx_sweeps_mult)
@ -450,11 +438,9 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
call desc_acv(x_sweeps)%clone(ag%desc_ac,info) call desc_acv(x_sweeps)%clone(ag%desc_ac,info)
call desc_acv(x_sweeps)%free(info) call desc_acv(x_sweeps)%free(info)
call acv(x_sweeps)%move_alloc(ag%ac,info) call acv(x_sweeps)%move_alloc(ag%ac,info)
!!$ call acv(x_sweeps)%clone(ag%ac,info)
if (.not.allocated(ag%prol)) allocate(ag%prol) if (.not.allocated(ag%prol)) allocate(ag%prol)
if (.not.allocated(ag%restr)) allocate(ag%restr) if (.not.allocated(ag%restr)) allocate(ag%restr)
!call desc_acv(x_sweeps)%clone(ag%desc_ac,info)
call psb_cd_reinit(ag%desc_ac,info) call psb_cd_reinit(ag%desc_ac,info)
ncsave = ag%desc_ac%get_global_rows() ncsave = ag%desc_ac%get_global_rows()
! !
@ -462,7 +448,6 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
! because of the call to mat_asb in the loop above. ! because of the call to mat_asb in the loop above.
! !
call prolv(x_sweeps)%mv_to(csr_prol) call prolv(x_sweeps)%mv_to(csr_prol)
!call csr_prol%set_ncols(ag%desc_ac%get_local_cols())
if (debug) then if (debug) then
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (me == 0) write(0,*) 'Enter prolongator product loop ',x_sweeps if (me == 0) write(0,*) 'Enter prolongator product loop ',x_sweeps
@ -471,8 +456,6 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
do i=x_sweeps-1, 1, -1 do i=x_sweeps-1, 1, -1
call prolv(i)%mv_to(csr_pvi) call prolv(i)%mv_to(csr_pvi)
if (psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 1' if (psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 1'
!!$ write(0,*) me,' SPMM1 ',csr_pvi%get_nrows(),csr_pvi%get_ncols(),&
!!$ & csr_prol%get_nrows(),csr_prol%get_ncols()
call psb_par_spspmm(csr_pvi,desc_acv(i),csr_prol,csr_prod_res,ag%desc_ac,info) call psb_par_spspmm(csr_pvi,desc_acv(i),csr_prol,csr_prod_res,ag%desc_ac,info)
if ((info /=0).or.psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 2',info if ((info /=0).or.psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 2',info
call csr_pvi%free() call csr_pvi%free()
@ -547,8 +530,6 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_bootCMatch_if') call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_bootCMatch_if')
goto 9999 goto 9999
end if end if
!!$ write(0,*)me,' ',name,' Getting out with info ',info,&
!!$ & allocated(ilaggr),psb_size(ilaggr),allocated(nlaggr),psb_size(nlaggr)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

12
amgprec/impl/aggregator/amg_d_parmatch_smth_bld.f90
Unescape Escape View File

@ -197,10 +197,6 @@ subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
integer(psb_lpk_), allocatable :: ivr(:), ivc(:) integer(psb_lpk_), allocatable :: ivr(:), ivc(:)
integer(psb_lpk_) :: i integer(psb_lpk_) :: i
character(len=132) :: aname character(len=132) :: aname
type(psb_ldspmat_type) :: aglob
type(psb_dspmat_type) :: atmp
!!$ call a%cp_to(acsr)
!!$ call atmp%cp_from(acsr)
write(0,*) me,' ',trim(name),' Dumping inp_prol/restr' write(0,*) me,' ',trim(name),' Dumping inp_prol/restr'
write(aname,'(a,i0,a,i0,a)') 'tprol-',desc_a%get_global_rows(),'-p',me,'.mtx' write(aname,'(a,i0,a,i0,a)') 'tprol-',desc_a%get_global_rows(),'-p',me,'.mtx'
call t_prol%print(fname=aname,head='Test ') call t_prol%print(fname=aname,head='Test ')
@ -351,7 +347,6 @@ subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
if (dump_r) then if (dump_r) then
block block
@ -369,13 +364,6 @@ subroutine amg_d_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
write(aname,'(a,i0,a,i0,a)') 'restr-',desc_ac%get_global_rows(),'-p',me,'.mtx' write(aname,'(a,i0,a,i0,a)') 'restr-',desc_ac%get_global_rows(),'-p',me,'.mtx'
call op_restr%print(fname=aname,head='Test ',ivc=ivc) call op_restr%print(fname=aname,head='Test ',ivc=ivc)
!!$ write(aname,'(a,i0,a,i0,a)') 'prol-',desc_ac%get_global_rows(),'-p',me,'.mtx'
!!$ call op_prol%print(fname=aname,head='Test ')
!!$ call psb_gather(aglob,atmp,desc_a,info)
!!$ if (me==psb_root_) then
!!$ write(aname,'(a,i0,a)') 'a-inp-g-',aglob%get_nrows(),'.mtx'
!!$ call aglob%print(fname=aname,head='Test ')
!!$ end if
end block end block
end if end if

20
amgprec/impl/aggregator/amg_d_parmatch_spmm_bld_ov.f90
Unescape Escape View File

@ -140,26 +140,6 @@ subroutine amg_d_parmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
& ac,desc_ac,op_prol,op_restr,t_prol,info) & ac,desc_ac,op_prol,op_restr,t_prol,info)
if (psb_errstatus_fatal()) write(0,*)me,trim(name),'Error fatal on exit from bld_inner',info if (psb_errstatus_fatal()) write(0,*)me,trim(name),'Error fatal on exit from bld_inner',info
!!$ else
!!$ naggr = nlaggr(me+1)
!!$ ntaggr = sum(nlaggr)
!!$ naggrm1 = sum(nlaggr(1:me))
!!$ naggrp1 = sum(nlaggr(1:me+1))
!!$ call op_prol%mv_to(coo_prol)
!!$ inaggr = naggr
!!$ call psb_cdall(ictxt,desc_ac,info,nl=inaggr)
!!$ nzlp = coo_prol%get_nzeros()
!!$ call desc_ac%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
!!$ call coo_prol%set_ncols(desc_ac%get_local_cols())
!!$ call amg_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
!!$ & coo_prol,desc_ac,coo_restr,info)
!!$ call psb_cdasb(desc_ac,info)
!!$ !call desc_ac%free(info)
!!$ !write(0,*) me, 'Size of nlaggr',size(nlaggr),nlaggr(1)
!!$ call op_prol%mv_from(coo_prol)
!!$ call op_restr%mv_from(coo_restr)
!!$
!!$ end if
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err="SPMM_BLD_INNER") call psb_errpush(info,name,a_err="SPMM_BLD_INNER")

34
amgprec/impl/aggregator/amg_d_ptap_bld.f90
Unescape Escape View File

@ -135,16 +135,9 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_d_coo_glob_transpose(coo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax) call psb_d_coo_glob_transpose(coo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax)
call coo_restr%set_nrows(desc_ac%get_local_rows()) call coo_restr%set_nrows(desc_ac%get_local_rows())
call coo_restr%set_ncols(desc_ax%get_local_cols()) call coo_restr%set_ncols(desc_ax%get_local_cols())
! !$ write(0,*) me,' ',trim(name),' check on glob_transpose 1: ',&
! !$ & desc_a%get_local_cols(),desc_ax%get_local_cols(),coo_restr%get_nzeros()
! !$ if (desc_a%get_local_cols()<desc_ax%get_local_cols()) then
! !$ write(0,*) me,' ',trim(name),' WARNING: GLOB_TRANSPOSE NEW INDICES '
! !$ end if
end block end block
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -170,8 +163,6 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',& if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros() & csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
call csr_prol%mv_to_coo(coo_restr,info) call csr_prol%mv_to_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' new into transposition ',coo_restr%get_nrows(),&
!!$ & coo_restr%get_ncols(),coo_restr%get_nzeros()
if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr)
call coo_restr%transp() call coo_restr%transp()
@ -197,8 +188,6 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -226,7 +215,6 @@ subroutine amg_d_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
call coo_prol%set_ncols(desc_ac%get_local_cols()) call coo_prol%set_ncols(desc_ac%get_local_cols())
if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)
@ -312,7 +300,6 @@ subroutine amg_d_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
ntaggr = sum(nlaggr) ntaggr = sum(nlaggr)
naggrm1 = sum(nlaggr(1:me)) naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1)) naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
! !
! COO_PROL should arrive here with local numbering ! COO_PROL should arrive here with local numbering
@ -350,16 +337,10 @@ subroutine amg_d_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_d_coo_glob_transpose(icoo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax) call psb_d_coo_glob_transpose(icoo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax)
call icoo_restr%set_nrows(desc_ac%get_local_rows()) call icoo_restr%set_nrows(desc_ac%get_local_rows())
call icoo_restr%set_ncols(desc_ax%get_local_cols()) call icoo_restr%set_ncols(desc_ax%get_local_cols())
! !$ write(0,*) me,' ',trim(name),' check on glob_transpose 1: ',&
! !$ & desc_a%get_local_cols(),desc_ax%get_local_cols(),icoo_restr%get_nzeros()
! !$ if (desc_a%get_local_cols()<desc_ax%get_local_cols()) then
! !$ write(0,*) me,' ',trim(name),' WARNING: GLOB_TRANSPOSE NEW INDICES '
! !$ end if
call coo_restr%cp_from_icoo(icoo_restr,info) call coo_restr%cp_from_icoo(icoo_restr,info)
end block end block
call csr_restr%cp_from_lcoo(coo_restr,info) call csr_restr%cp_from_lcoo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
@ -386,8 +367,6 @@ subroutine amg_d_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',& if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros() & csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
call csr_prol%mv_to_lcoo(coo_restr,info) call csr_prol%mv_to_lcoo(coo_restr,info)
!!$ write(0,*)me,' ',name,' new into transposition ',coo_restr%get_nrows(),&
!!$ & coo_restr%get_ncols(),coo_restr%get_nzeros()
if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr)
call coo_restr%transp() call coo_restr%transp()
@ -413,8 +392,6 @@ subroutine amg_d_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
call csr_restr%cp_from_lcoo(coo_restr,info) call csr_restr%cp_from_lcoo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -442,7 +419,6 @@ subroutine amg_d_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
call coo_prol%set_ncols(desc_ac%get_local_cols()) call coo_prol%set_ncols(desc_ac%get_local_cols())
if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)
@ -575,8 +551,6 @@ subroutine amg_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
end block end block
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -602,8 +576,6 @@ subroutine amg_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',& if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros() & csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
call csr_prol%mv_to_coo(coo_restr,info) call csr_prol%mv_to_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' new into transposition ',coo_restr%get_nrows(),&
!!$ & coo_restr%get_ncols(),coo_restr%get_nzeros()
if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr)
call coo_restr%transp() call coo_restr%transp()
@ -629,8 +601,6 @@ subroutine amg_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -658,12 +628,8 @@ subroutine amg_ld_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
call coo_prol%set_ncols(desc_ac%get_local_cols()) call coo_prol%set_ncols(desc_ac%get_local_cols())
!call coo_restr%mv_from_ifmt(csr_restr,info)
!!$ call coo_restr%set_nrows(desc_ac%get_local_rows())
!!$ call coo_restr%set_ncols(desc_a%get_local_cols())
if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)

4
amgprec/impl/aggregator/amg_d_rap.f90
Unescape Escape View File

@ -93,7 +93,6 @@ subroutine amg_d_rap(a_csr,desc_a,nlaggr,parms,ac,&
ntaggr = sum(nlaggr) ntaggr = sum(nlaggr)
naggrm1 = sum(nlaggr(1:me)) naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1)) naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
! !
! COO_PROL should arrive here with local numbering ! COO_PROL should arrive here with local numbering
@ -125,8 +124,6 @@ subroutine amg_d_rap(a_csr,desc_a,nlaggr,parms,ac,&
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -150,7 +147,6 @@ subroutine amg_d_rap(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
call coo_prol%set_ncols(desc_ac%get_local_cols()) call coo_prol%set_ncols(desc_ac%get_local_cols())
if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)

21
amgprec/impl/aggregator/amg_s_parmatch_aggregator_tprol.f90
Unescape Escape View File

@ -324,7 +324,7 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
! !
if (debug) write(0,*) me,' Into matchbox_build_prol ',info if (debug) write(0,*) me,' Into matchbox_build_prol ',info
if (do_timings) call psb_tic(idx_mboxp) if (do_timings) call psb_tic(idx_mboxp)
call amg_s_matchboxp_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,& call smatchboxp_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,&
& symmetrize=ag%need_symmetrize,reproducible=ag%reproducible_matching) & symmetrize=ag%need_symmetrize,reproducible=ag%reproducible_matching)
if (do_timings) call psb_toc(idx_mboxp) if (do_timings) call psb_toc(idx_mboxp)
if (debug) write(0,*) me,' Out from matchbox_build_prol ',info if (debug) write(0,*) me,' Out from matchbox_build_prol ',info
@ -348,7 +348,6 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
if (psb_errstatus_fatal()) write(0,*)me,trim(name),'Error fatal on exit from bld_ov(i)',info if (psb_errstatus_fatal()) write(0,*)me,trim(name),'Error fatal on exit from bld_ov(i)',info
if (debug) then if (debug) then
call psb_barrier(ictxt) call psb_barrier(ictxt)
!!$ write(0,*) name,' Call spmm_bld sweep:',i,n_sweeps
if (me==0) write(0,*) me,trim(name),' Done spmm_bld:',i if (me==0) write(0,*) me,trim(name),' Done spmm_bld:',i
end if end if
@ -356,17 +355,11 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
! Keep a copy of prolv(i) in global numbering for the time being, will ! Keep a copy of prolv(i) in global numbering for the time being, will
! need it to build the final ! need it to build the final
! if (i == n_sweeps) call prolv(i)%clone(tmp_prol,info) ! if (i == n_sweeps) call prolv(i)%clone(tmp_prol,info)
!!$ write(0,*) name,' Call mat_asb sweep:',i,n_sweeps
call ag%inner_mat_asb(parms,acv(i-1),desc_acv(i-1),& call ag%inner_mat_asb(parms,acv(i-1),desc_acv(i-1),&
& acv(i),desc_acv(i),prolv(i),restrv(1),info) & acv(i),desc_acv(i),prolv(i),restrv(1),info)
!!$ write(0,*) me,' From in_mat_asb:',&
!!$ & prolv(i)%get_nrows(),prolv(i)%get_ncols(),&
!!$ & restrv(1)%get_nrows(),restrv(1)%get_ncols(),&
!!$ & desc_acv(i)%get_local_rows(), desc_acv(i)%get_local_cols()
if (debug) then if (debug) then
call psb_barrier(ictxt) call psb_barrier(ictxt)
!!$ write(0,*) name,' Call spmm_bld sweep:',i,n_sweeps
if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),max_csize,info if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),max_csize,info
csz = sum(nxaggr) csz = sum(nxaggr)
call psb_bcast(ictxt,csz) call psb_bcast(ictxt,csz)
@ -413,13 +406,11 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
end if end if
call acv(i-1)%free() call acv(i-1)%free()
if ((sum(nlaggr) <= max_csize).or.(any(nlaggr==0))) then if ((sum(nlaggr) <= max_csize).or.(any(nlaggr==0))) then
!if (me==0) write(0,*) 'Early exit ',any(nlaggr==0),sum(nlaggr),max_csize,i
x_sweeps = i x_sweeps = i
exit sweeps_loop exit sweeps_loop
end if end if
if (debug) then if (debug) then
call psb_barrier(ictxt) call psb_barrier(ictxt)
!!$ write(0,*) name,' Call spmm_bld sweep:',i,n_sweeps
if (me==0) write(0,*) me,trim(name),' Done sweeps_loop iteration:',i,' of ',n_sweeps if (me==0) write(0,*) me,trim(name),' Done sweeps_loop iteration:',i,' of ',n_sweeps
end if end if
@ -427,11 +418,8 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
if (debug) then if (debug) then
call psb_barrier(ictxt) call psb_barrier(ictxt)
!!$ write(0,*) name,' Call spmm_bld sweep:',i,n_sweeps
if (me==0) write(0,*) me,trim(name),' Done sweeps_loop:',x_sweeps if (me==0) write(0,*) me,trim(name),' Done sweeps_loop:',x_sweeps
end if end if
!!$ write(0,*) me,name,' : End of aggregation sweeps ',&
!!$ & n_sweeps,' Final size:',max_csize,desc_acv(n_sweeps)%get_local_rows(),t_prol%get_ncols(),tmp_prol%get_ncols()
if (x_sweeps<=0) x_sweeps = n_sweeps if (x_sweeps<=0) x_sweeps = n_sweeps
if (do_timings) call psb_tic(idx_sweeps_mult) if (do_timings) call psb_tic(idx_sweeps_mult)
@ -450,11 +438,9 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
call desc_acv(x_sweeps)%clone(ag%desc_ac,info) call desc_acv(x_sweeps)%clone(ag%desc_ac,info)
call desc_acv(x_sweeps)%free(info) call desc_acv(x_sweeps)%free(info)
call acv(x_sweeps)%move_alloc(ag%ac,info) call acv(x_sweeps)%move_alloc(ag%ac,info)
!!$ call acv(x_sweeps)%clone(ag%ac,info)
if (.not.allocated(ag%prol)) allocate(ag%prol) if (.not.allocated(ag%prol)) allocate(ag%prol)
if (.not.allocated(ag%restr)) allocate(ag%restr) if (.not.allocated(ag%restr)) allocate(ag%restr)
!call desc_acv(x_sweeps)%clone(ag%desc_ac,info)
call psb_cd_reinit(ag%desc_ac,info) call psb_cd_reinit(ag%desc_ac,info)
ncsave = ag%desc_ac%get_global_rows() ncsave = ag%desc_ac%get_global_rows()
! !
@ -462,7 +448,6 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
! because of the call to mat_asb in the loop above. ! because of the call to mat_asb in the loop above.
! !
call prolv(x_sweeps)%mv_to(csr_prol) call prolv(x_sweeps)%mv_to(csr_prol)
!call csr_prol%set_ncols(ag%desc_ac%get_local_cols())
if (debug) then if (debug) then
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (me == 0) write(0,*) 'Enter prolongator product loop ',x_sweeps if (me == 0) write(0,*) 'Enter prolongator product loop ',x_sweeps
@ -471,8 +456,6 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
do i=x_sweeps-1, 1, -1 do i=x_sweeps-1, 1, -1
call prolv(i)%mv_to(csr_pvi) call prolv(i)%mv_to(csr_pvi)
if (psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 1' if (psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 1'
!!$ write(0,*) me,' SPMM1 ',csr_pvi%get_nrows(),csr_pvi%get_ncols(),&
!!$ & csr_prol%get_nrows(),csr_prol%get_ncols()
call psb_par_spspmm(csr_pvi,desc_acv(i),csr_prol,csr_prod_res,ag%desc_ac,info) call psb_par_spspmm(csr_pvi,desc_acv(i),csr_prol,csr_prod_res,ag%desc_ac,info)
if ((info /=0).or.psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 2',info if ((info /=0).or.psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 2',info
call csr_pvi%free() call csr_pvi%free()
@ -547,8 +530,6 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_bootCMatch_if') call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_bootCMatch_if')
goto 9999 goto 9999
end if end if
!!$ write(0,*)me,' ',name,' Getting out with info ',info,&
!!$ & allocated(ilaggr),psb_size(ilaggr),allocated(nlaggr),psb_size(nlaggr)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

12
amgprec/impl/aggregator/amg_s_parmatch_smth_bld.f90
Unescape Escape View File

@ -197,10 +197,6 @@ subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
integer(psb_lpk_), allocatable :: ivr(:), ivc(:) integer(psb_lpk_), allocatable :: ivr(:), ivc(:)
integer(psb_lpk_) :: i integer(psb_lpk_) :: i
character(len=132) :: aname character(len=132) :: aname
type(psb_lsspmat_type) :: aglob
type(psb_sspmat_type) :: atmp
!!$ call a%cp_to(acsr)
!!$ call atmp%cp_from(acsr)
write(0,*) me,' ',trim(name),' Dumping inp_prol/restr' write(0,*) me,' ',trim(name),' Dumping inp_prol/restr'
write(aname,'(a,i0,a,i0,a)') 'tprol-',desc_a%get_global_rows(),'-p',me,'.mtx' write(aname,'(a,i0,a,i0,a)') 'tprol-',desc_a%get_global_rows(),'-p',me,'.mtx'
call t_prol%print(fname=aname,head='Test ') call t_prol%print(fname=aname,head='Test ')
@ -351,7 +347,6 @@ subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
if (dump_r) then if (dump_r) then
block block
@ -369,13 +364,6 @@ subroutine amg_s_parmatch_smth_bld(ag,a,desc_a,ilaggr,nlaggr,parms,&
write(aname,'(a,i0,a,i0,a)') 'restr-',desc_ac%get_global_rows(),'-p',me,'.mtx' write(aname,'(a,i0,a,i0,a)') 'restr-',desc_ac%get_global_rows(),'-p',me,'.mtx'
call op_restr%print(fname=aname,head='Test ',ivc=ivc) call op_restr%print(fname=aname,head='Test ',ivc=ivc)
!!$ write(aname,'(a,i0,a,i0,a)') 'prol-',desc_ac%get_global_rows(),'-p',me,'.mtx'
!!$ call op_prol%print(fname=aname,head='Test ')
!!$ call psb_gather(aglob,atmp,desc_a,info)
!!$ if (me==psb_root_) then
!!$ write(aname,'(a,i0,a)') 'a-inp-g-',aglob%get_nrows(),'.mtx'
!!$ call aglob%print(fname=aname,head='Test ')
!!$ end if
end block end block
end if end if

20
amgprec/impl/aggregator/amg_s_parmatch_spmm_bld_ov.f90
Unescape Escape View File

@ -140,26 +140,6 @@ subroutine amg_s_parmatch_spmm_bld_ov(a,desc_a,ilaggr,nlaggr,parms,&
& ac,desc_ac,op_prol,op_restr,t_prol,info) & ac,desc_ac,op_prol,op_restr,t_prol,info)
if (psb_errstatus_fatal()) write(0,*)me,trim(name),'Error fatal on exit from bld_inner',info if (psb_errstatus_fatal()) write(0,*)me,trim(name),'Error fatal on exit from bld_inner',info
!!$ else
!!$ naggr = nlaggr(me+1)
!!$ ntaggr = sum(nlaggr)
!!$ naggrm1 = sum(nlaggr(1:me))
!!$ naggrp1 = sum(nlaggr(1:me+1))
!!$ call op_prol%mv_to(coo_prol)
!!$ inaggr = naggr
!!$ call psb_cdall(ictxt,desc_ac,info,nl=inaggr)
!!$ nzlp = coo_prol%get_nzeros()
!!$ call desc_ac%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
!!$ call coo_prol%set_ncols(desc_ac%get_local_cols())
!!$ call amg_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
!!$ & coo_prol,desc_ac,coo_restr,info)
!!$ call psb_cdasb(desc_ac,info)
!!$ !call desc_ac%free(info)
!!$ !write(0,*) me, 'Size of nlaggr',size(nlaggr),nlaggr(1)
!!$ call op_prol%mv_from(coo_prol)
!!$ call op_restr%mv_from(coo_restr)
!!$
!!$ end if
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err="SPMM_BLD_INNER") call psb_errpush(info,name,a_err="SPMM_BLD_INNER")

34
amgprec/impl/aggregator/amg_s_ptap_bld.f90
Unescape Escape View File

@ -135,16 +135,9 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_s_coo_glob_transpose(coo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax) call psb_s_coo_glob_transpose(coo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax)
call coo_restr%set_nrows(desc_ac%get_local_rows()) call coo_restr%set_nrows(desc_ac%get_local_rows())
call coo_restr%set_ncols(desc_ax%get_local_cols()) call coo_restr%set_ncols(desc_ax%get_local_cols())
! !$ write(0,*) me,' ',trim(name),' check on glob_transpose 1: ',&
! !$ & desc_a%get_local_cols(),desc_ax%get_local_cols(),coo_restr%get_nzeros()
! !$ if (desc_a%get_local_cols()<desc_ax%get_local_cols()) then
! !$ write(0,*) me,' ',trim(name),' WARNING: GLOB_TRANSPOSE NEW INDICES '
! !$ end if
end block end block
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -170,8 +163,6 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',& if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros() & csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
call csr_prol%mv_to_coo(coo_restr,info) call csr_prol%mv_to_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' new into transposition ',coo_restr%get_nrows(),&
!!$ & coo_restr%get_ncols(),coo_restr%get_nzeros()
if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr)
call coo_restr%transp() call coo_restr%transp()
@ -197,8 +188,6 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -226,7 +215,6 @@ subroutine amg_s_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
call coo_prol%set_ncols(desc_ac%get_local_cols()) call coo_prol%set_ncols(desc_ac%get_local_cols())
if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)
@ -312,7 +300,6 @@ subroutine amg_s_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
ntaggr = sum(nlaggr) ntaggr = sum(nlaggr)
naggrm1 = sum(nlaggr(1:me)) naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1)) naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
! !
! COO_PROL should arrive here with local numbering ! COO_PROL should arrive here with local numbering
@ -350,16 +337,10 @@ subroutine amg_s_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_s_coo_glob_transpose(icoo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax) call psb_s_coo_glob_transpose(icoo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax)
call icoo_restr%set_nrows(desc_ac%get_local_rows()) call icoo_restr%set_nrows(desc_ac%get_local_rows())
call icoo_restr%set_ncols(desc_ax%get_local_cols()) call icoo_restr%set_ncols(desc_ax%get_local_cols())
! !$ write(0,*) me,' ',trim(name),' check on glob_transpose 1: ',&
! !$ & desc_a%get_local_cols(),desc_ax%get_local_cols(),icoo_restr%get_nzeros()
! !$ if (desc_a%get_local_cols()<desc_ax%get_local_cols()) then
! !$ write(0,*) me,' ',trim(name),' WARNING: GLOB_TRANSPOSE NEW INDICES '
! !$ end if
call coo_restr%cp_from_icoo(icoo_restr,info) call coo_restr%cp_from_icoo(icoo_restr,info)
end block end block
call csr_restr%cp_from_lcoo(coo_restr,info) call csr_restr%cp_from_lcoo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
@ -386,8 +367,6 @@ subroutine amg_s_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',& if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros() & csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
call csr_prol%mv_to_lcoo(coo_restr,info) call csr_prol%mv_to_lcoo(coo_restr,info)
!!$ write(0,*)me,' ',name,' new into transposition ',coo_restr%get_nrows(),&
!!$ & coo_restr%get_ncols(),coo_restr%get_nzeros()
if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr)
call coo_restr%transp() call coo_restr%transp()
@ -413,8 +392,6 @@ subroutine amg_s_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
call csr_restr%cp_from_lcoo(coo_restr,info) call csr_restr%cp_from_lcoo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -442,7 +419,6 @@ subroutine amg_s_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
call coo_prol%set_ncols(desc_ac%get_local_cols()) call coo_prol%set_ncols(desc_ac%get_local_cols())
if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)
@ -575,8 +551,6 @@ subroutine amg_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
end block end block
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -602,8 +576,6 @@ subroutine amg_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',& if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros() & csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
call csr_prol%mv_to_coo(coo_restr,info) call csr_prol%mv_to_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' new into transposition ',coo_restr%get_nrows(),&
!!$ & coo_restr%get_ncols(),coo_restr%get_nzeros()
if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr)
call coo_restr%transp() call coo_restr%transp()
@ -629,8 +601,6 @@ subroutine amg_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -658,12 +628,8 @@ subroutine amg_ls_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
call coo_prol%set_ncols(desc_ac%get_local_cols()) call coo_prol%set_ncols(desc_ac%get_local_cols())
!call coo_restr%mv_from_ifmt(csr_restr,info)
!!$ call coo_restr%set_nrows(desc_ac%get_local_rows())
!!$ call coo_restr%set_ncols(desc_a%get_local_cols())
if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)

4
amgprec/impl/aggregator/amg_s_rap.f90
Unescape Escape View File

@ -93,7 +93,6 @@ subroutine amg_s_rap(a_csr,desc_a,nlaggr,parms,ac,&
ntaggr = sum(nlaggr) ntaggr = sum(nlaggr)
naggrm1 = sum(nlaggr(1:me)) naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1)) naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
! !
! COO_PROL should arrive here with local numbering ! COO_PROL should arrive here with local numbering
@ -125,8 +124,6 @@ subroutine amg_s_rap(a_csr,desc_a,nlaggr,parms,ac,&
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -150,7 +147,6 @@ subroutine amg_s_rap(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
call coo_prol%set_ncols(desc_ac%get_local_cols()) call coo_prol%set_ncols(desc_ac%get_local_cols())
if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)

34
amgprec/impl/aggregator/amg_z_ptap_bld.f90
Unescape Escape View File

@ -135,16 +135,9 @@ subroutine amg_z_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_z_coo_glob_transpose(coo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax) call psb_z_coo_glob_transpose(coo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax)
call coo_restr%set_nrows(desc_ac%get_local_rows()) call coo_restr%set_nrows(desc_ac%get_local_rows())
call coo_restr%set_ncols(desc_ax%get_local_cols()) call coo_restr%set_ncols(desc_ax%get_local_cols())
! !$ write(0,*) me,' ',trim(name),' check on glob_transpose 1: ',&
! !$ & desc_a%get_local_cols(),desc_ax%get_local_cols(),coo_restr%get_nzeros()
! !$ if (desc_a%get_local_cols()<desc_ax%get_local_cols()) then
! !$ write(0,*) me,' ',trim(name),' WARNING: GLOB_TRANSPOSE NEW INDICES '
! !$ end if
end block end block
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -170,8 +163,6 @@ subroutine amg_z_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',& if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros() & csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
call csr_prol%mv_to_coo(coo_restr,info) call csr_prol%mv_to_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' new into transposition ',coo_restr%get_nrows(),&
!!$ & coo_restr%get_ncols(),coo_restr%get_nzeros()
if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr)
call coo_restr%transp() call coo_restr%transp()
@ -197,8 +188,6 @@ subroutine amg_z_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -226,7 +215,6 @@ subroutine amg_z_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
call coo_prol%set_ncols(desc_ac%get_local_cols()) call coo_prol%set_ncols(desc_ac%get_local_cols())
if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)
@ -312,7 +300,6 @@ subroutine amg_z_lz_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
ntaggr = sum(nlaggr) ntaggr = sum(nlaggr)
naggrm1 = sum(nlaggr(1:me)) naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1)) naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
! !
! COO_PROL should arrive here with local numbering ! COO_PROL should arrive here with local numbering
@ -350,16 +337,10 @@ subroutine amg_z_lz_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
call psb_z_coo_glob_transpose(icoo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax) call psb_z_coo_glob_transpose(icoo_restr,desc_a,info,desc_c=desc_ac,desc_rx=desc_ax)
call icoo_restr%set_nrows(desc_ac%get_local_rows()) call icoo_restr%set_nrows(desc_ac%get_local_rows())
call icoo_restr%set_ncols(desc_ax%get_local_cols()) call icoo_restr%set_ncols(desc_ax%get_local_cols())
! !$ write(0,*) me,' ',trim(name),' check on glob_transpose 1: ',&
! !$ & desc_a%get_local_cols(),desc_ax%get_local_cols(),icoo_restr%get_nzeros()
! !$ if (desc_a%get_local_cols()<desc_ax%get_local_cols()) then
! !$ write(0,*) me,' ',trim(name),' WARNING: GLOB_TRANSPOSE NEW INDICES '
! !$ end if
call coo_restr%cp_from_icoo(icoo_restr,info) call coo_restr%cp_from_icoo(icoo_restr,info)
end block end block
call csr_restr%cp_from_lcoo(coo_restr,info) call csr_restr%cp_from_lcoo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
@ -386,8 +367,6 @@ subroutine amg_z_lz_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',& if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros() & csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
call csr_prol%mv_to_lcoo(coo_restr,info) call csr_prol%mv_to_lcoo(coo_restr,info)
!!$ write(0,*)me,' ',name,' new into transposition ',coo_restr%get_nrows(),&
!!$ & coo_restr%get_ncols(),coo_restr%get_nzeros()
if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr)
call coo_restr%transp() call coo_restr%transp()
@ -413,8 +392,6 @@ subroutine amg_z_lz_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
call csr_restr%cp_from_lcoo(coo_restr,info) call csr_restr%cp_from_lcoo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -442,7 +419,6 @@ subroutine amg_z_lz_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
call coo_prol%set_ncols(desc_ac%get_local_cols()) call coo_prol%set_ncols(desc_ac%get_local_cols())
if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)
@ -575,8 +551,6 @@ subroutine amg_lz_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
end block end block
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -602,8 +576,6 @@ subroutine amg_lz_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',& if (debug) write(0,*)me,' ',name,' No inp_restr, transposing prol ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros() & csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
call csr_prol%mv_to_coo(coo_restr,info) call csr_prol%mv_to_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' new into transposition ',coo_restr%get_nrows(),&
!!$ & coo_restr%get_ncols(),coo_restr%get_nzeros()
if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 1 (before transp) on coo_restr:',coo_restr)
call coo_restr%transp() call coo_restr%transp()
@ -629,8 +601,6 @@ subroutine amg_lz_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 2 on coo_restr:',coo_restr)
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -658,12 +628,8 @@ subroutine amg_lz_ptap_bld(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
call coo_prol%set_ncols(desc_ac%get_local_cols()) call coo_prol%set_ncols(desc_ac%get_local_cols())
!call coo_restr%mv_from_ifmt(csr_restr,info)
!!$ call coo_restr%set_nrows(desc_ac%get_local_rows())
!!$ call coo_restr%set_ncols(desc_a%get_local_cols())
if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)

4
amgprec/impl/aggregator/amg_z_rap.f90
Unescape Escape View File

@ -93,7 +93,6 @@ subroutine amg_z_rap(a_csr,desc_a,nlaggr,parms,ac,&
ntaggr = sum(nlaggr) ntaggr = sum(nlaggr)
naggrm1 = sum(nlaggr(1:me)) naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1)) naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
! !
! COO_PROL should arrive here with local numbering ! COO_PROL should arrive here with local numbering
@ -125,8 +124,6 @@ subroutine amg_z_rap(a_csr,desc_a,nlaggr,parms,ac,&
call csr_restr%cp_from_coo(coo_restr,info) call csr_restr%cp_from_coo(coo_restr,info)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
goto 9999 goto 9999
@ -150,7 +147,6 @@ subroutine amg_z_rap(a_csr,desc_a,nlaggr,parms,ac,&
if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus()
if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr
! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros()
call coo_prol%set_ncols(desc_ac%get_local_cols()) call coo_prol%set_ncols(desc_ac%get_local_cols())
if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)

Write Preview
Loading…
Cancel
Save