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
! POSSIBILITY OF SUCH DAMAGE.
!
module amg_d_matchboxp_mod
module dmatchboxp_mod
use iso_c_binding
use psb_base_cbind_mod
@ -94,21 +94,17 @@ module amg_d_matchboxp_mod
end subroutine dMatchBoxPC
end interface MatchBoxPC
interface amg_i_aggr_assign
module procedure amg_i_daggr_assign
end interface amg_i_aggr_assign
interface i_aggr_assign
module procedure i_daggr_assign
end interface i_aggr_assign
interface amg_build_matching
module procedure amg_d_build_matching
end interface amg_build_matching
interface build_matching
module procedure dbuild_matching
end interface build_matching
interface amg_matchboxp_build_prol
module procedure amg_d_matchboxp_build_prol
end interface amg_matchboxp_build_prol
interface amg_build_ahat
module procedure amg_d_build_ahat
end interface amg_build_ahat
interface build_ahat
module procedure dbuild_ahat
end interface build_ahat
interface psb_gtranspose
module procedure psb_dgtranspose
@ -124,7 +120,7 @@ module amg_d_matchboxp_mod
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)
use psb_base_mod
use psb_util_mod
@ -198,11 +194,6 @@ contains
ilv = [(i,i=1,desc_a%get_local_cols())]
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)
ilaggr = -1
call psb_geasb(ilaggr,desc_a,info)
@ -222,7 +213,7 @@ contains
end if
if (do_timings) call psb_toc(idx_phase1)
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 (debug) write(0,*) iam,' buildprol from buildmatching:',&
& info
@ -316,11 +307,11 @@ contains
else
! Use a statistically unbiased tie-breaking rule,
! this will give an even spread.
! Delegate to amg_i_aggr_assign.
! Delegate to i_aggr_assign.
! Should be a symmetric function.
!
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
nlaggr(iam) = nlaggr(iam) + 1
ilaggr(k) = nlaggr(iam)
@ -429,9 +420,6 @@ contains
nlsingl = v(2)
nlpairs = v(3)
!!$ call psb_sum(ictxt,nunmatched)
!!$ call psb_sum(ictxt,nlsingl)
!!$ call psb_sum(ictxt,nlpairs)
end block
if (iam == 0) then
write(0,*) 'Matching statistics: Unmatched nodes ',&
@ -525,9 +513,9 @@ contains
write(0,*) iam,' : error from Matching: ',info
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)
!
! How to break ties? This
@ -569,10 +557,10 @@ contains
iproc = iown
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_util_mod
use iso_c_binding
@ -598,7 +586,7 @@ contains
integer(psb_ipk_), save :: cnt=2
logical, parameter :: debug=.false., dump_ahat=.false., debug_sync=.false.
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
logical, parameter :: do_timings=.true.
@ -621,7 +609,7 @@ contains
if (iam == 0) write(0,*)' Into build_ahat:'
end if
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 (info /= 0) then
write(0,*) 'Error from build_ahat ', info
@ -776,9 +764,9 @@ contains
val(1:n) = tmp(1:n)
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
implicit none
real(psb_dpk_), intent(in) :: w(:)
@ -885,8 +873,6 @@ contains
else
tcoo2%val(k2) = eps
end if
!!$ tcoo2%val(k2) = abs( tcoo2%val(k2) )
!!$ minabs = min(minabs, tcoo2%val(k2) )
end if
!else
! write(0,*) 'build_ahat: index error :',ii,jj,' : boundaries :',nr,nc
@ -1016,8 +1002,7 @@ contains
end block
end if
end subroutine amg_d_build_ahat
end subroutine dbuild_ahat
subroutine psb_dgtranspose(ain,aout,desc_a,info)
use psb_base_mod
@ -1080,10 +1065,7 @@ contains
! FIXME THIS NEEDS REWORKING
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,&
!!$ & colcnv=.false.,rowscale=.true.)
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 (debug) then
@ -1248,10 +1230,7 @@ contains
else
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()
!!$ call psb_set_debug_level(0)
if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo)
if (debug) then
@ -1265,7 +1244,6 @@ contains
call atmp%cp_to(tmpcoo)
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 (.true.) then
call tmpcoo%clean_negidx(info)
@ -1455,4 +1433,4 @@ contains
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
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
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
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
subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
& 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 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
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
! POSSIBILITY OF SUCH DAMAGE.
!
module amg_s_matchboxp_mod
module smatchboxp_mod
use iso_c_binding
use psb_base_cbind_mod
@ -94,21 +94,17 @@ module amg_s_matchboxp_mod
end subroutine sMatchBoxPC
end interface MatchBoxPC
interface amg_i_aggr_assign
module procedure amg_i_saggr_assign
end interface amg_i_aggr_assign
interface i_aggr_assign
module procedure i_saggr_assign
end interface i_aggr_assign
interface amg_matchboxp_build_prol
module procedure amg_s_matchboxp_build_prol
end interface amg_matchboxp_build_prol
interface build_matching
module procedure sbuild_matching
end interface build_matching
interface amg_build_matching
module procedure amg_s_build_matching
end interface amg_build_matching
interface amg_build_ahat
module procedure amg_s_build_ahat
end interface amg_build_ahat
interface build_ahat
module procedure sbuild_ahat
end interface build_ahat
interface psb_gtranspose
module procedure psb_sgtranspose
@ -124,7 +120,7 @@ module amg_s_matchboxp_mod
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)
use psb_base_mod
use psb_util_mod
@ -198,11 +194,6 @@ contains
ilv = [(i,i=1,desc_a%get_local_cols())]
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)
ilaggr = -1
call psb_geasb(ilaggr,desc_a,info)
@ -222,7 +213,7 @@ contains
end if
if (do_timings) call psb_toc(idx_phase1)
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 (debug) write(0,*) iam,' buildprol from buildmatching:',&
& info
@ -316,11 +307,11 @@ contains
else
! Use a statistically unbiased tie-breaking rule,
! this will give an even spread.
! Delegate to amg_i_aggr_assign.
! Delegate to i_aggr_assign.
! Should be a symmetric function.
!
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
nlaggr(iam) = nlaggr(iam) + 1
ilaggr(k) = nlaggr(iam)
@ -429,9 +420,6 @@ contains
nlsingl = v(2)
nlpairs = v(3)
!!$ call psb_sum(ictxt,nunmatched)
!!$ call psb_sum(ictxt,nlsingl)
!!$ call psb_sum(ictxt,nlpairs)
end block
if (iam == 0) then
write(0,*) 'Matching statistics: Unmatched nodes ',&
@ -525,9 +513,9 @@ contains
write(0,*) iam,' : error from Matching: ',info
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)
!
! How to break ties? This
@ -569,10 +557,10 @@ contains
iproc = iown
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_util_mod
use iso_c_binding
@ -621,7 +609,7 @@ contains
if (iam == 0) write(0,*)' Into build_ahat:'
end if
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 (info /= 0) then
write(0,*) 'Error from build_ahat ', info
@ -776,9 +764,9 @@ contains
val(1:n) = tmp(1:n)
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
implicit none
real(psb_spk_), intent(in) :: w(:)
@ -885,8 +873,6 @@ contains
else
tcoo2%val(k2) = eps
end if
!!$ tcoo2%val(k2) = abs( tcoo2%val(k2) )
!!$ minabs = min(minabs, tcoo2%val(k2) )
end if
!else
! write(0,*) 'build_ahat: index error :',ii,jj,' : boundaries :',nr,nc
@ -1016,8 +1002,7 @@ contains
end block
end if
end subroutine amg_s_build_ahat
end subroutine sbuild_ahat
subroutine psb_sgtranspose(ain,aout,desc_a,info)
use psb_base_mod
@ -1080,10 +1065,7 @@ contains
! FIXME THIS NEEDS REWORKING
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,&
!!$ & colcnv=.false.,rowscale=.true.)
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 (debug) then
@ -1248,10 +1230,7 @@ contains
else
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()
!!$ call psb_set_debug_level(0)
if (info == psb_success_) call psb_rwextd(ncol,atmp,info,b=ahalo)
if (debug) then
@ -1265,7 +1244,6 @@ contains
call atmp%cp_to(tmpcoo)
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 (.true.) then
call tmpcoo%clean_negidx(info)
@ -1455,4 +1433,4 @@ contains
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
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
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
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
subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
& 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 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
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 coo_restr%set_nrows(desc_ac%get_local_rows())
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
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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 ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
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)
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)
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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),' ',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())
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)
naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
!
! 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 icoo_restr%set_nrows(desc_ac%get_local_rows())
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)
end block
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
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 ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
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)
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)
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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),' ',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())
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
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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 ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
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)
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)
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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),' ',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_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)

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)
naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
!
! 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)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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),' ',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())
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 (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)
if (do_timings) call psb_toc(idx_mboxp)
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 (debug) then
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
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
! need it to build the final
! 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),&
& 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
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
csz = sum(nxaggr)
call psb_bcast(ictxt,csz)
@ -413,13 +406,11 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
end if
call acv(i-1)%free()
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
exit sweeps_loop
end if
if (debug) then
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
end if
@ -427,11 +418,8 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
if (debug) then
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
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 (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)%free(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%restr)) allocate(ag%restr)
!call desc_acv(x_sweeps)%clone(ag%desc_ac,info)
call psb_cd_reinit(ag%desc_ac,info)
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.
!
call prolv(x_sweeps)%mv_to(csr_prol)
!call csr_prol%set_ncols(ag%desc_ac%get_local_cols())
if (debug) then
call psb_barrier(ictxt)
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
call prolv(i)%mv_to(csr_pvi)
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)
if ((info /=0).or.psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 2',info
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')
goto 9999
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)
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_) :: i
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(aname,'(a,i0,a,i0,a)') 'tprol-',desc_a%get_global_rows(),'-p',me,'.mtx'
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),' ',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
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'
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 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)
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
info=psb_err_from_subroutine_
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 coo_restr%set_nrows(desc_ac%get_local_rows())
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
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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 ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
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)
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)
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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),' ',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())
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)
naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
!
! 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 icoo_restr%set_nrows(desc_ac%get_local_rows())
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)
end block
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
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 ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
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)
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)
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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),' ',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())
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
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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 ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
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)
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)
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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),' ',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_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)

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)
naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
!
! 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)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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),' ',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())
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 (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)
if (do_timings) call psb_toc(idx_mboxp)
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 (debug) then
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
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
! need it to build the final
! 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),&
& 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
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
csz = sum(nxaggr)
call psb_bcast(ictxt,csz)
@ -413,13 +406,11 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
end if
call acv(i-1)%free()
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
exit sweeps_loop
end if
if (debug) then
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
end if
@ -427,11 +418,8 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
if (debug) then
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
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 (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)%free(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%restr)) allocate(ag%restr)
!call desc_acv(x_sweeps)%clone(ag%desc_ac,info)
call psb_cd_reinit(ag%desc_ac,info)
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.
!
call prolv(x_sweeps)%mv_to(csr_prol)
!call csr_prol%set_ncols(ag%desc_ac%get_local_cols())
if (debug) then
call psb_barrier(ictxt)
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
call prolv(i)%mv_to(csr_pvi)
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)
if ((info /=0).or.psb_errstatus_fatal()) write(0,*) me,' Fatal error in prolongator loop 2',info
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')
goto 9999
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)
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_) :: i
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(aname,'(a,i0,a,i0,a)') 'tprol-',desc_a%get_global_rows(),'-p',me,'.mtx'
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),' ',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
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'
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 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)
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
info=psb_err_from_subroutine_
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 coo_restr%set_nrows(desc_ac%get_local_rows())
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
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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 ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
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)
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)
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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),' ',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())
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)
naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
!
! 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 icoo_restr%set_nrows(desc_ac%get_local_rows())
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)
end block
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
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 ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
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)
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)
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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),' ',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())
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
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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 ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
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)
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)
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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),' ',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_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)

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)
naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
!
! 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)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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),' ',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())
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 coo_restr%set_nrows(desc_ac%get_local_rows())
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
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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 ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
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)
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)
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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),' ',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())
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)
naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
!
! 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 icoo_restr%set_nrows(desc_ac%get_local_rows())
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)
end block
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
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 ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
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)
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)
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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),' ',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())
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
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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 ',&
& csr_prol%get_nrows(),csr_prol%get_ncols(),csr_prol%get_nzeros()
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)
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)
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
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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),' ',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_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)

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)
naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
!
! 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)
!!$ write(0,*)me,' ',name,' after transposition ',coo_restr%get_nrows(),coo_restr%get_ncols(),coo_restr%get_nzeros()
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr')
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),' ',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())
if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr)

Write Preview
Loading…
Cancel
Save