From dc03929a0644b26e170f173a749d1457b9238b52 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 10 Jun 2020 08:57:25 +0200 Subject: [PATCH] Unify build of unsmoothed, adjust map_to_tprol. --- mlprec/impl/aggregator/mld_c_map_to_tprol.f90 | 4 +- .../impl/aggregator/mld_c_spmm_bld_inner.f90 | 2 +- .../aggregator/mld_caggrmat_nosmth_bld.f90 | 77 +++---------------- mlprec/impl/aggregator/mld_d_map_to_tprol.f90 | 4 +- .../impl/aggregator/mld_d_spmm_bld_inner.f90 | 2 +- .../aggregator/mld_daggrmat_nosmth_bld.f90 | 77 +++---------------- mlprec/impl/aggregator/mld_s_map_to_tprol.f90 | 4 +- .../impl/aggregator/mld_s_spmm_bld_inner.f90 | 2 +- .../aggregator/mld_saggrmat_nosmth_bld.f90 | 77 +++---------------- mlprec/impl/aggregator/mld_z_map_to_tprol.f90 | 4 +- .../impl/aggregator/mld_z_spmm_bld_inner.f90 | 2 +- .../aggregator/mld_zaggrmat_nosmth_bld.f90 | 77 +++---------------- 12 files changed, 60 insertions(+), 272 deletions(-) diff --git a/mlprec/impl/aggregator/mld_c_map_to_tprol.f90 b/mlprec/impl/aggregator/mld_c_map_to_tprol.f90 index 1c2c5516..fb3e65d4 100644 --- a/mlprec/impl/aggregator/mld_c_map_to_tprol.f90 +++ b/mlprec/impl/aggregator/mld_c_map_to_tprol.f90 @@ -124,9 +124,9 @@ subroutine mld_c_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) goto 9999 end if - call tmpcoo%allocate(ncol,ntaggr,ncol) + call tmpcoo%allocate(nrow,ntaggr,ncol) k = 0 - do i=1,ncol + do i=1,nrow ! ! Note: at this point, a value ilaggr(i)<=0 ! tags a "singleton" row, and it has to be diff --git a/mlprec/impl/aggregator/mld_c_spmm_bld_inner.f90 b/mlprec/impl/aggregator/mld_c_spmm_bld_inner.f90 index 1e912368..3ef031a8 100644 --- a/mlprec/impl/aggregator/mld_c_spmm_bld_inner.f90 +++ b/mlprec/impl/aggregator/mld_c_spmm_bld_inner.f90 @@ -63,7 +63,7 @@ subroutine mld_c_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,& integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & & nzt, naggrm1, naggrp1, i, k integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza - logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false. + logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false. integer(psb_ipk_), save :: idx_spspmm=-1 name='mld_spmm_bld_inner' diff --git a/mlprec/impl/aggregator/mld_caggrmat_nosmth_bld.f90 b/mlprec/impl/aggregator/mld_caggrmat_nosmth_bld.f90 index a31d5eda..dc3c1b43 100644 --- a/mlprec/impl/aggregator/mld_caggrmat_nosmth_bld.f90 +++ b/mlprec/impl/aggregator/mld_caggrmat_nosmth_bld.f90 @@ -145,71 +145,18 @@ subroutine mld_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re naggrm1 = sum(nlaggr(1:me)) naggrp1 = sum(nlaggr(1:me+1)) - if (.false.) then - ! - ! If we ever want to switch to explicit product when building this.. - ! - call a%cp_to(acsr) - call op_prol%mv_to(coo_prol) - inaggr = naggr - call psb_cdall(ictxt,tmp_desc,info,nl=inaggr) - nzlp = coo_prol%get_nzeros() - call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info) - call coo_prol%set_ncols(tmp_desc%get_local_cols()) - call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,& - & coo_prol,tmp_desc,coo_restr,info) - - call op_prol%mv_from(coo_prol) - call op_restr%mv_from(coo_restr) - - - else - - call a%cp_to(ac_coo) - nzt = ac_coo%get_nzeros() - k = 0 - do i = 1, nzt - k = k + 1 - ac_coo%ia(k) = ilaggr(ac_coo%ia(i)) - ac_coo%ja(k) = ilaggr(ac_coo%ja(i)) - ac_coo%val(k) = ac_coo%val(i) - ! At this point, there may be negative entries, - ! because that's how ILAGGR marks singletons - ! If this is the case, roll back K - if ((ac_coo%ia(k)<=0).or.(ac_coo%ja(k)<=0)) k = k-1 - enddo - call ac_coo%set_nrows(naggr) - call ac_coo%set_ncols(naggr) - call ac_coo%set_nzeros(k) - call ac_coo%set_dupl(psb_dupl_add_) - call ac_coo%fix(info) - call ac_coo%trim() - call ac%mv_from(ac_coo) - - call op_prol%cp_to(tmpcoo) - - call tmpcoo%transp() - ! - ! Now we have to fix this. The only rows of tmpcoo/op_restr that are correct - ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:) - ! - nzl = tmpcoo%get_nzeros() - i = 0 - do k = 1, nzl - if ((naggrm1 < tmpcoo%ia(k)) .and.(tmpcoo%ia(k) <= naggrp1)) then - i = i+1 - tmpcoo%val(i) = tmpcoo%val(k) - tmpcoo%ia(i) = tmpcoo%ia(k) - tmpcoo%ja(i) = tmpcoo%ja(k) - end if - end do - call tmpcoo%set_nzeros(i) - call tmpcoo%trim() - call op_restr%mv_from(tmpcoo) - - if (info /= psb_success_) goto 9999 - - end if + call a%cp_to(acsr) + call op_prol%mv_to(coo_prol) + inaggr = naggr + call psb_cdall(ictxt,tmp_desc,info,nl=inaggr) + nzlp = coo_prol%get_nzeros() + call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info) + call coo_prol%set_ncols(tmp_desc%get_local_cols()) + call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,& + & coo_prol,tmp_desc,coo_restr,info) + + call op_prol%mv_from(coo_prol) + call op_restr%mv_from(coo_restr) call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/aggregator/mld_d_map_to_tprol.f90 b/mlprec/impl/aggregator/mld_d_map_to_tprol.f90 index b8117d94..8e59d76c 100644 --- a/mlprec/impl/aggregator/mld_d_map_to_tprol.f90 +++ b/mlprec/impl/aggregator/mld_d_map_to_tprol.f90 @@ -124,9 +124,9 @@ subroutine mld_d_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) goto 9999 end if - call tmpcoo%allocate(ncol,ntaggr,ncol) + call tmpcoo%allocate(nrow,ntaggr,ncol) k = 0 - do i=1,ncol + do i=1,nrow ! ! Note: at this point, a value ilaggr(i)<=0 ! tags a "singleton" row, and it has to be diff --git a/mlprec/impl/aggregator/mld_d_spmm_bld_inner.f90 b/mlprec/impl/aggregator/mld_d_spmm_bld_inner.f90 index ddeed79b..585a5775 100644 --- a/mlprec/impl/aggregator/mld_d_spmm_bld_inner.f90 +++ b/mlprec/impl/aggregator/mld_d_spmm_bld_inner.f90 @@ -63,7 +63,7 @@ subroutine mld_d_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,& integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & & nzt, naggrm1, naggrp1, i, k integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza - logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false. + logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false. integer(psb_ipk_), save :: idx_spspmm=-1 name='mld_spmm_bld_inner' diff --git a/mlprec/impl/aggregator/mld_daggrmat_nosmth_bld.f90 b/mlprec/impl/aggregator/mld_daggrmat_nosmth_bld.f90 index ddef24a3..50640c23 100644 --- a/mlprec/impl/aggregator/mld_daggrmat_nosmth_bld.f90 +++ b/mlprec/impl/aggregator/mld_daggrmat_nosmth_bld.f90 @@ -145,71 +145,18 @@ subroutine mld_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re naggrm1 = sum(nlaggr(1:me)) naggrp1 = sum(nlaggr(1:me+1)) - if (.false.) then - ! - ! If we ever want to switch to explicit product when building this.. - ! - call a%cp_to(acsr) - call op_prol%mv_to(coo_prol) - inaggr = naggr - call psb_cdall(ictxt,tmp_desc,info,nl=inaggr) - nzlp = coo_prol%get_nzeros() - call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info) - call coo_prol%set_ncols(tmp_desc%get_local_cols()) - call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,& - & coo_prol,tmp_desc,coo_restr,info) - - call op_prol%mv_from(coo_prol) - call op_restr%mv_from(coo_restr) - - - else - - call a%cp_to(ac_coo) - nzt = ac_coo%get_nzeros() - k = 0 - do i = 1, nzt - k = k + 1 - ac_coo%ia(k) = ilaggr(ac_coo%ia(i)) - ac_coo%ja(k) = ilaggr(ac_coo%ja(i)) - ac_coo%val(k) = ac_coo%val(i) - ! At this point, there may be negative entries, - ! because that's how ILAGGR marks singletons - ! If this is the case, roll back K - if ((ac_coo%ia(k)<=0).or.(ac_coo%ja(k)<=0)) k = k-1 - enddo - call ac_coo%set_nrows(naggr) - call ac_coo%set_ncols(naggr) - call ac_coo%set_nzeros(k) - call ac_coo%set_dupl(psb_dupl_add_) - call ac_coo%fix(info) - call ac_coo%trim() - call ac%mv_from(ac_coo) - - call op_prol%cp_to(tmpcoo) - - call tmpcoo%transp() - ! - ! Now we have to fix this. The only rows of tmpcoo/op_restr that are correct - ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:) - ! - nzl = tmpcoo%get_nzeros() - i = 0 - do k = 1, nzl - if ((naggrm1 < tmpcoo%ia(k)) .and.(tmpcoo%ia(k) <= naggrp1)) then - i = i+1 - tmpcoo%val(i) = tmpcoo%val(k) - tmpcoo%ia(i) = tmpcoo%ia(k) - tmpcoo%ja(i) = tmpcoo%ja(k) - end if - end do - call tmpcoo%set_nzeros(i) - call tmpcoo%trim() - call op_restr%mv_from(tmpcoo) - - if (info /= psb_success_) goto 9999 - - end if + call a%cp_to(acsr) + call op_prol%mv_to(coo_prol) + inaggr = naggr + call psb_cdall(ictxt,tmp_desc,info,nl=inaggr) + nzlp = coo_prol%get_nzeros() + call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info) + call coo_prol%set_ncols(tmp_desc%get_local_cols()) + call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,& + & coo_prol,tmp_desc,coo_restr,info) + + call op_prol%mv_from(coo_prol) + call op_restr%mv_from(coo_restr) call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/aggregator/mld_s_map_to_tprol.f90 b/mlprec/impl/aggregator/mld_s_map_to_tprol.f90 index d0d68654..0de193c2 100644 --- a/mlprec/impl/aggregator/mld_s_map_to_tprol.f90 +++ b/mlprec/impl/aggregator/mld_s_map_to_tprol.f90 @@ -124,9 +124,9 @@ subroutine mld_s_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) goto 9999 end if - call tmpcoo%allocate(ncol,ntaggr,ncol) + call tmpcoo%allocate(nrow,ntaggr,ncol) k = 0 - do i=1,ncol + do i=1,nrow ! ! Note: at this point, a value ilaggr(i)<=0 ! tags a "singleton" row, and it has to be diff --git a/mlprec/impl/aggregator/mld_s_spmm_bld_inner.f90 b/mlprec/impl/aggregator/mld_s_spmm_bld_inner.f90 index 0ae800d5..8479f7c8 100644 --- a/mlprec/impl/aggregator/mld_s_spmm_bld_inner.f90 +++ b/mlprec/impl/aggregator/mld_s_spmm_bld_inner.f90 @@ -63,7 +63,7 @@ subroutine mld_s_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,& integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & & nzt, naggrm1, naggrp1, i, k integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza - logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false. + logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false. integer(psb_ipk_), save :: idx_spspmm=-1 name='mld_spmm_bld_inner' diff --git a/mlprec/impl/aggregator/mld_saggrmat_nosmth_bld.f90 b/mlprec/impl/aggregator/mld_saggrmat_nosmth_bld.f90 index 1805bd25..e1429a5e 100644 --- a/mlprec/impl/aggregator/mld_saggrmat_nosmth_bld.f90 +++ b/mlprec/impl/aggregator/mld_saggrmat_nosmth_bld.f90 @@ -145,71 +145,18 @@ subroutine mld_saggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re naggrm1 = sum(nlaggr(1:me)) naggrp1 = sum(nlaggr(1:me+1)) - if (.false.) then - ! - ! If we ever want to switch to explicit product when building this.. - ! - call a%cp_to(acsr) - call op_prol%mv_to(coo_prol) - inaggr = naggr - call psb_cdall(ictxt,tmp_desc,info,nl=inaggr) - nzlp = coo_prol%get_nzeros() - call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info) - call coo_prol%set_ncols(tmp_desc%get_local_cols()) - call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,& - & coo_prol,tmp_desc,coo_restr,info) - - call op_prol%mv_from(coo_prol) - call op_restr%mv_from(coo_restr) - - - else - - call a%cp_to(ac_coo) - nzt = ac_coo%get_nzeros() - k = 0 - do i = 1, nzt - k = k + 1 - ac_coo%ia(k) = ilaggr(ac_coo%ia(i)) - ac_coo%ja(k) = ilaggr(ac_coo%ja(i)) - ac_coo%val(k) = ac_coo%val(i) - ! At this point, there may be negative entries, - ! because that's how ILAGGR marks singletons - ! If this is the case, roll back K - if ((ac_coo%ia(k)<=0).or.(ac_coo%ja(k)<=0)) k = k-1 - enddo - call ac_coo%set_nrows(naggr) - call ac_coo%set_ncols(naggr) - call ac_coo%set_nzeros(k) - call ac_coo%set_dupl(psb_dupl_add_) - call ac_coo%fix(info) - call ac_coo%trim() - call ac%mv_from(ac_coo) - - call op_prol%cp_to(tmpcoo) - - call tmpcoo%transp() - ! - ! Now we have to fix this. The only rows of tmpcoo/op_restr that are correct - ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:) - ! - nzl = tmpcoo%get_nzeros() - i = 0 - do k = 1, nzl - if ((naggrm1 < tmpcoo%ia(k)) .and.(tmpcoo%ia(k) <= naggrp1)) then - i = i+1 - tmpcoo%val(i) = tmpcoo%val(k) - tmpcoo%ia(i) = tmpcoo%ia(k) - tmpcoo%ja(i) = tmpcoo%ja(k) - end if - end do - call tmpcoo%set_nzeros(i) - call tmpcoo%trim() - call op_restr%mv_from(tmpcoo) - - if (info /= psb_success_) goto 9999 - - end if + call a%cp_to(acsr) + call op_prol%mv_to(coo_prol) + inaggr = naggr + call psb_cdall(ictxt,tmp_desc,info,nl=inaggr) + nzlp = coo_prol%get_nzeros() + call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info) + call coo_prol%set_ncols(tmp_desc%get_local_cols()) + call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,& + & coo_prol,tmp_desc,coo_restr,info) + + call op_prol%mv_from(coo_prol) + call op_restr%mv_from(coo_restr) call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/aggregator/mld_z_map_to_tprol.f90 b/mlprec/impl/aggregator/mld_z_map_to_tprol.f90 index b006b976..2f8e16d7 100644 --- a/mlprec/impl/aggregator/mld_z_map_to_tprol.f90 +++ b/mlprec/impl/aggregator/mld_z_map_to_tprol.f90 @@ -124,9 +124,9 @@ subroutine mld_z_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) goto 9999 end if - call tmpcoo%allocate(ncol,ntaggr,ncol) + call tmpcoo%allocate(nrow,ntaggr,ncol) k = 0 - do i=1,ncol + do i=1,nrow ! ! Note: at this point, a value ilaggr(i)<=0 ! tags a "singleton" row, and it has to be diff --git a/mlprec/impl/aggregator/mld_z_spmm_bld_inner.f90 b/mlprec/impl/aggregator/mld_z_spmm_bld_inner.f90 index 65eaf1a3..7613b053 100644 --- a/mlprec/impl/aggregator/mld_z_spmm_bld_inner.f90 +++ b/mlprec/impl/aggregator/mld_z_spmm_bld_inner.f90 @@ -63,7 +63,7 @@ subroutine mld_z_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,& integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & & nzt, naggrm1, naggrp1, i, k integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza - logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false. + logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false. integer(psb_ipk_), save :: idx_spspmm=-1 name='mld_spmm_bld_inner' diff --git a/mlprec/impl/aggregator/mld_zaggrmat_nosmth_bld.f90 b/mlprec/impl/aggregator/mld_zaggrmat_nosmth_bld.f90 index 514399df..a117331d 100644 --- a/mlprec/impl/aggregator/mld_zaggrmat_nosmth_bld.f90 +++ b/mlprec/impl/aggregator/mld_zaggrmat_nosmth_bld.f90 @@ -145,71 +145,18 @@ subroutine mld_zaggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re naggrm1 = sum(nlaggr(1:me)) naggrp1 = sum(nlaggr(1:me+1)) - if (.false.) then - ! - ! If we ever want to switch to explicit product when building this.. - ! - call a%cp_to(acsr) - call op_prol%mv_to(coo_prol) - inaggr = naggr - call psb_cdall(ictxt,tmp_desc,info,nl=inaggr) - nzlp = coo_prol%get_nzeros() - call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info) - call coo_prol%set_ncols(tmp_desc%get_local_cols()) - call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,& - & coo_prol,tmp_desc,coo_restr,info) - - call op_prol%mv_from(coo_prol) - call op_restr%mv_from(coo_restr) - - - else - - call a%cp_to(ac_coo) - nzt = ac_coo%get_nzeros() - k = 0 - do i = 1, nzt - k = k + 1 - ac_coo%ia(k) = ilaggr(ac_coo%ia(i)) - ac_coo%ja(k) = ilaggr(ac_coo%ja(i)) - ac_coo%val(k) = ac_coo%val(i) - ! At this point, there may be negative entries, - ! because that's how ILAGGR marks singletons - ! If this is the case, roll back K - if ((ac_coo%ia(k)<=0).or.(ac_coo%ja(k)<=0)) k = k-1 - enddo - call ac_coo%set_nrows(naggr) - call ac_coo%set_ncols(naggr) - call ac_coo%set_nzeros(k) - call ac_coo%set_dupl(psb_dupl_add_) - call ac_coo%fix(info) - call ac_coo%trim() - call ac%mv_from(ac_coo) - - call op_prol%cp_to(tmpcoo) - - call tmpcoo%transp() - ! - ! Now we have to fix this. The only rows of tmpcoo/op_restr that are correct - ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:) - ! - nzl = tmpcoo%get_nzeros() - i = 0 - do k = 1, nzl - if ((naggrm1 < tmpcoo%ia(k)) .and.(tmpcoo%ia(k) <= naggrp1)) then - i = i+1 - tmpcoo%val(i) = tmpcoo%val(k) - tmpcoo%ia(i) = tmpcoo%ia(k) - tmpcoo%ja(i) = tmpcoo%ja(k) - end if - end do - call tmpcoo%set_nzeros(i) - call tmpcoo%trim() - call op_restr%mv_from(tmpcoo) - - if (info /= psb_success_) goto 9999 - - end if + call a%cp_to(acsr) + call op_prol%mv_to(coo_prol) + inaggr = naggr + call psb_cdall(ictxt,tmp_desc,info,nl=inaggr) + nzlp = coo_prol%get_nzeros() + call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info) + call coo_prol%set_ncols(tmp_desc%get_local_cols()) + call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,& + & coo_prol,tmp_desc,coo_restr,info) + + call op_prol%mv_from(coo_prol) + call op_restr%mv_from(coo_restr) call psb_erractionrestore(err_act) return