From aa205fa4f9aa6e731c0f6ac4c0a9befdfb41ec81 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 20 Feb 2020 13:51:33 +0000 Subject: [PATCH] Fix coarse matrix build for replicated. --- .../impl/aggregator/mld_c_spmm_bld_inner.f90 | 184 ------------------ .../impl/aggregator/mld_caggrmat_biz_bld.f90 | 28 +-- .../impl/aggregator/mld_caggrmat_smth_bld.f90 | 26 +-- .../impl/aggregator/mld_d_spmm_bld_inner.f90 | 184 ------------------ .../impl/aggregator/mld_daggrmat_biz_bld.f90 | 28 +-- .../impl/aggregator/mld_daggrmat_smth_bld.f90 | 26 +-- .../impl/aggregator/mld_s_spmm_bld_inner.f90 | 184 ------------------ .../impl/aggregator/mld_saggrmat_biz_bld.f90 | 28 +-- .../impl/aggregator/mld_saggrmat_smth_bld.f90 | 26 +-- .../impl/aggregator/mld_z_spmm_bld_inner.f90 | 184 ------------------ .../impl/aggregator/mld_zaggrmat_biz_bld.f90 | 28 +-- .../impl/aggregator/mld_zaggrmat_smth_bld.f90 | 26 +-- mlprec/mld_c_base_aggregator_mod.f90 | 15 -- mlprec/mld_d_base_aggregator_mod.f90 | 15 -- mlprec/mld_s_base_aggregator_mod.f90 | 15 -- mlprec/mld_z_base_aggregator_mod.f90 | 15 -- 16 files changed, 68 insertions(+), 944 deletions(-) diff --git a/mlprec/impl/aggregator/mld_c_spmm_bld_inner.f90 b/mlprec/impl/aggregator/mld_c_spmm_bld_inner.f90 index 8ddd1385..ec9dc221 100644 --- a/mlprec/impl/aggregator/mld_c_spmm_bld_inner.f90 +++ b/mlprec/impl/aggregator/mld_c_spmm_bld_inner.f90 @@ -215,187 +215,3 @@ subroutine mld_c_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,& return end subroutine mld_c_spmm_bld_inner -subroutine mld_c_old_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,ac,& - & op_prol,op_restr,info) - use psb_base_mod - use mld_c_inner_mod - use mld_c_base_aggregator_mod, mld_protect_name => mld_c_old_spmm_bld_inner - implicit none - - ! Arguments - type(psb_lc_csr_sparse_mat), intent(inout) :: a_csr - type(psb_desc_type), intent(in) :: desc_a - integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(mld_sml_parms), intent(inout) :: parms - type(psb_lcspmat_type), intent(inout) :: op_prol, op_restr - type(psb_lcspmat_type), intent(out) :: ac - integer(psb_ipk_), intent(out) :: info - - ! Local variables - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo - character(len=40) :: name - integer(psb_ipk_) :: ierr(5) - type(psb_lc_coo_sparse_mat) :: ac_coo, tmpcoo - type(psb_lc_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr - type(psb_desc_type), target :: tmp_desc - integer(psb_ipk_) :: debug_level, debug_unit, naggr - integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & - & nzt, naggrm1, naggrp1, i, k - integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza, nrpsave, ncpsave, nzpsave - logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false. - integer(psb_ipk_), save :: idx_spspmm=-1 - - name='mld_spmm_bld_inner' - if(psb_get_errstatus().ne.0) return - info=psb_success_ - call psb_erractionsave(err_act) - - - ictxt = desc_a%get_context() - icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) - debug_unit = psb_get_debug_unit() - debug_level = psb_get_debug_level() - nglob = desc_a%get_global_rows() - nrow = desc_a%get_local_rows() - ncol = desc_a%get_local_cols() - - if ((do_timings).and.(idx_spspmm==-1)) & - & idx_spspmm = psb_get_timer_idx("SPMM_BLD: par_spspmm") - - naggr = nlaggr(me+1) - ntaggr = sum(nlaggr) - naggrm1 = sum(nlaggr(1:me)) - naggrp1 = sum(nlaggr(1:me+1)) - !write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr - nrpsave = op_prol%get_nrows() - ncpsave = op_prol%get_ncols() - nzpsave = op_prol%get_nzeros() - !write(0,*)me,' ',name,' input op_prol ',nrpsave,ncpsave,nzpsave - - ! - ! Here OP_PROL should be with GLOBAL indices on the cols - ! and LOCAL indices on the rows. - ! - if (debug) write(0,*) me,' ',trim(name),' Size check on entry New: ',& - & op_prol%get_fmt(),op_prol%get_nrows(),op_prol%get_ncols(),op_prol%get_nzeros(),& - & nrow,ntaggr,naggr - - call op_prol%cp_to(tmpcoo) - - if (debug) write(0,*) me,' ',trim(name),' tmpcoo: ',& - & tmpcoo%ia(1:min(10,nzpsave)),' :',tmpcoo%ja(1:min(10,nzpsave)) - call psb_cdall(ictxt,tmp_desc,info,nl=naggr) - call tmp_desc%indxmap%g2lip_ins(tmpcoo%ja(1:nzpsave),info) - call tmpcoo%set_ncols(tmp_desc%get_local_cols()) - call tmpcoo%mv_to_fmt(csr_prol,info) - - if (debug) write(0,*) me,trim(name),' Product AxPROL ',& - & a_csr%get_nrows(),a_csr%get_ncols(), csr_prol%get_nrows(), & - & desc_a%get_local_rows(),desc_a%get_local_cols(),& - & tmp_desc%get_local_rows(),desc_a%get_local_cols() - if (debug) flush(0) - - if (do_timings) call psb_tic(idx_spspmm) - call psb_par_spspmm(a_csr,desc_a,csr_prol,acsr3,tmp_desc,info) - if (do_timings) call psb_toc(idx_spspmm) - - if (debug) write(0,*) me,trim(name),' Done AxPROL ',& - & acsr3%get_nrows(),acsr3%get_ncols(), acsr3%get_nzeros(),& - & tmp_desc%get_local_rows(),tmp_desc%get_local_cols() - - ! - ! Ok first product done. - ! - ! Remember that RESTR must be built from PROL after halo extension, - ! which is done above in psb_par_spspmm - 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%cp_to_fmt(tmpcoo,info) -!!$ write(0,*)me,' ',name,' new into transposition ',tmpcoo%get_nrows(),& -!!$ & tmpcoo%get_ncols(),tmpcoo%get_nzeros() - call tmpcoo%transp() - nzl = tmpcoo%get_nzeros() - call tmp_desc%l2gip(tmpcoo%ia(1:nzl),info) - i=0 - ! - ! Now we have to fix this. The only rows of the restrictor that are correct - ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:) - ! - 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%fix(info) - call op_restr%cp_from(tmpcoo) -!!$ write(0,*)me,' ',name,' after transposition ',tmpcoo%get_nrows(),tmpcoo%get_ncols(),tmpcoo%get_nzeros() - - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr') - goto 9999 - end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'starting sphalo/ rwxtd' - nzl = tmpcoo%get_nzeros() - call psb_glob_to_loc(tmpcoo%ia(1:nzl),tmp_desc,info,iact='I',owned=.true.) - call tmpcoo%clean_negidx(info) - nzl = tmpcoo%get_nzeros() - call tmpcoo%set_nrows(tmp_desc%get_local_rows()) - call tmpcoo%set_ncols(desc_a%get_local_cols()) -!!$ write(0,*)me,' ',name,' after G2L on rows ',tmpcoo%get_nrows(),tmpcoo%get_ncols(),tmpcoo%get_nzeros() - call csr_restr%mv_from_coo(tmpcoo,info) - - - if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& - & csr_restr%get_nrows(),csr_restr%get_ncols(), & - & tmp_desc%get_local_rows(),desc_a%get_local_cols(),& - & acsr3%get_nrows(),acsr3%get_ncols() - if (do_timings) call psb_tic(idx_spspmm) - call psb_par_spspmm(csr_restr,desc_a,acsr3,ac_csr,tmp_desc,info) - if (do_timings) call psb_toc(idx_spspmm) - call ac_csr%mv_to_coo(ac_coo,info) - nza = ac_coo%get_nzeros() - if (debug) write(0,*) me,trim(name),' Fixing ac ',& - & ac_coo%get_nrows(),ac_coo%get_ncols(), nza - - call ac_coo%fix(info) - call tmp_desc%indxmap%l2gip(ac_coo%ia(1:nza),info) - call tmp_desc%indxmap%l2gip(ac_coo%ja(1:nza),info) - call ac_coo%set_nrows(ntaggr) - call ac_coo%set_ncols(ntaggr) - if (debug) write(0,*) me,' ',trim(name),' Before mv_from',psb_get_errstatus() - if (info == 0) call ac%mv_from(ac_coo) - 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 (debug) then - write(0,*) me,' ',trim(name),' Checkpoint at exit' - call psb_barrier(ictxt) - write(0,*) me,' ',trim(name),' Checkpoint through' - end if - - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3') - goto 9999 - end if - - - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Done smooth_aggregate ' - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine mld_c_old_spmm_bld_inner diff --git a/mlprec/impl/aggregator/mld_caggrmat_biz_bld.f90 b/mlprec/impl/aggregator/mld_caggrmat_biz_bld.f90 index 0d71db36..ee9ed3e1 100644 --- a/mlprec/impl/aggregator/mld_caggrmat_biz_bld.f90 +++ b/mlprec/impl/aggregator/mld_caggrmat_biz_bld.f90 @@ -117,7 +117,7 @@ subroutine mld_caggrmat_biz_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr logical, parameter :: debug_new=.false. character(len=80) :: filename - name='mld_aggrmat_smth_bld' + name='mld_aggrmat_biz_bld' info=psb_success_ call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then @@ -258,24 +258,14 @@ subroutine mld_caggrmat_biz_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Done SPSPMM 1' - if (.true.) then - nzl = acsr1%get_nzeros() - call acsr1%mv_to_coo(coo_prol,info) - - 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 - nzl = acsr1%get_nzeros() - call tmp_desc%l2gip(acsr1%ja(1:nzl),info) - call op_prol%mv_from(acsr1) - - call mld_spmm_bld_inner(acsr,desc_a,ilaggr,nlaggr,parms,ac,& - & op_prol,op_restr,info) - - end if + nzl = acsr1%get_nzeros() + call acsr1%mv_to_coo(coo_prol,info) + + 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) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& diff --git a/mlprec/impl/aggregator/mld_caggrmat_smth_bld.f90 b/mlprec/impl/aggregator/mld_caggrmat_smth_bld.f90 index 0c757fd2..45244868 100644 --- a/mlprec/impl/aggregator/mld_caggrmat_smth_bld.f90 +++ b/mlprec/impl/aggregator/mld_caggrmat_smth_bld.f90 @@ -278,24 +278,14 @@ subroutine mld_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Done SPSPMM 1' - if (.true.) then - nzl = acsr1%get_nzeros() - call acsr1%mv_to_coo(coo_prol,info) - - 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 - nzl = acsr1%get_nzeros() - call tmp_desc%l2gip(acsr1%ja(1:nzl),info) - call op_prol%mv_from(acsr1) - - call mld_spmm_bld_inner(acsr,desc_a,ilaggr,nlaggr,parms,ac,& - & op_prol,op_restr,info) - - end if + nzl = acsr1%get_nzeros() + call acsr1%mv_to_coo(coo_prol,info) + + 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) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& diff --git a/mlprec/impl/aggregator/mld_d_spmm_bld_inner.f90 b/mlprec/impl/aggregator/mld_d_spmm_bld_inner.f90 index 60bbbad8..bd79f475 100644 --- a/mlprec/impl/aggregator/mld_d_spmm_bld_inner.f90 +++ b/mlprec/impl/aggregator/mld_d_spmm_bld_inner.f90 @@ -215,187 +215,3 @@ subroutine mld_d_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,& return end subroutine mld_d_spmm_bld_inner -subroutine mld_d_old_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,ac,& - & op_prol,op_restr,info) - use psb_base_mod - use mld_d_inner_mod - use mld_d_base_aggregator_mod, mld_protect_name => mld_d_old_spmm_bld_inner - implicit none - - ! Arguments - type(psb_ld_csr_sparse_mat), intent(inout) :: a_csr - type(psb_desc_type), intent(in) :: desc_a - integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(mld_dml_parms), intent(inout) :: parms - type(psb_ldspmat_type), intent(inout) :: op_prol, op_restr - type(psb_ldspmat_type), intent(out) :: ac - integer(psb_ipk_), intent(out) :: info - - ! Local variables - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo - character(len=40) :: name - integer(psb_ipk_) :: ierr(5) - type(psb_ld_coo_sparse_mat) :: ac_coo, tmpcoo - type(psb_ld_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr - type(psb_desc_type), target :: tmp_desc - integer(psb_ipk_) :: debug_level, debug_unit, naggr - integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & - & nzt, naggrm1, naggrp1, i, k - integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza, nrpsave, ncpsave, nzpsave - logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false. - integer(psb_ipk_), save :: idx_spspmm=-1 - - name='mld_spmm_bld_inner' - if(psb_get_errstatus().ne.0) return - info=psb_success_ - call psb_erractionsave(err_act) - - - ictxt = desc_a%get_context() - icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) - debug_unit = psb_get_debug_unit() - debug_level = psb_get_debug_level() - nglob = desc_a%get_global_rows() - nrow = desc_a%get_local_rows() - ncol = desc_a%get_local_cols() - - if ((do_timings).and.(idx_spspmm==-1)) & - & idx_spspmm = psb_get_timer_idx("SPMM_BLD: par_spspmm") - - naggr = nlaggr(me+1) - ntaggr = sum(nlaggr) - naggrm1 = sum(nlaggr(1:me)) - naggrp1 = sum(nlaggr(1:me+1)) - !write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr - nrpsave = op_prol%get_nrows() - ncpsave = op_prol%get_ncols() - nzpsave = op_prol%get_nzeros() - !write(0,*)me,' ',name,' input op_prol ',nrpsave,ncpsave,nzpsave - - ! - ! Here OP_PROL should be with GLOBAL indices on the cols - ! and LOCAL indices on the rows. - ! - if (debug) write(0,*) me,' ',trim(name),' Size check on entry New: ',& - & op_prol%get_fmt(),op_prol%get_nrows(),op_prol%get_ncols(),op_prol%get_nzeros(),& - & nrow,ntaggr,naggr - - call op_prol%cp_to(tmpcoo) - - if (debug) write(0,*) me,' ',trim(name),' tmpcoo: ',& - & tmpcoo%ia(1:min(10,nzpsave)),' :',tmpcoo%ja(1:min(10,nzpsave)) - call psb_cdall(ictxt,tmp_desc,info,nl=naggr) - call tmp_desc%indxmap%g2lip_ins(tmpcoo%ja(1:nzpsave),info) - call tmpcoo%set_ncols(tmp_desc%get_local_cols()) - call tmpcoo%mv_to_fmt(csr_prol,info) - - if (debug) write(0,*) me,trim(name),' Product AxPROL ',& - & a_csr%get_nrows(),a_csr%get_ncols(), csr_prol%get_nrows(), & - & desc_a%get_local_rows(),desc_a%get_local_cols(),& - & tmp_desc%get_local_rows(),desc_a%get_local_cols() - if (debug) flush(0) - - if (do_timings) call psb_tic(idx_spspmm) - call psb_par_spspmm(a_csr,desc_a,csr_prol,acsr3,tmp_desc,info) - if (do_timings) call psb_toc(idx_spspmm) - - if (debug) write(0,*) me,trim(name),' Done AxPROL ',& - & acsr3%get_nrows(),acsr3%get_ncols(), acsr3%get_nzeros(),& - & tmp_desc%get_local_rows(),tmp_desc%get_local_cols() - - ! - ! Ok first product done. - ! - ! Remember that RESTR must be built from PROL after halo extension, - ! which is done above in psb_par_spspmm - 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%cp_to_fmt(tmpcoo,info) -!!$ write(0,*)me,' ',name,' new into transposition ',tmpcoo%get_nrows(),& -!!$ & tmpcoo%get_ncols(),tmpcoo%get_nzeros() - call tmpcoo%transp() - nzl = tmpcoo%get_nzeros() - call tmp_desc%l2gip(tmpcoo%ia(1:nzl),info) - i=0 - ! - ! Now we have to fix this. The only rows of the restrictor that are correct - ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:) - ! - 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%fix(info) - call op_restr%cp_from(tmpcoo) -!!$ write(0,*)me,' ',name,' after transposition ',tmpcoo%get_nrows(),tmpcoo%get_ncols(),tmpcoo%get_nzeros() - - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr') - goto 9999 - end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'starting sphalo/ rwxtd' - nzl = tmpcoo%get_nzeros() - call psb_glob_to_loc(tmpcoo%ia(1:nzl),tmp_desc,info,iact='I',owned=.true.) - call tmpcoo%clean_negidx(info) - nzl = tmpcoo%get_nzeros() - call tmpcoo%set_nrows(tmp_desc%get_local_rows()) - call tmpcoo%set_ncols(desc_a%get_local_cols()) -!!$ write(0,*)me,' ',name,' after G2L on rows ',tmpcoo%get_nrows(),tmpcoo%get_ncols(),tmpcoo%get_nzeros() - call csr_restr%mv_from_coo(tmpcoo,info) - - - if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& - & csr_restr%get_nrows(),csr_restr%get_ncols(), & - & tmp_desc%get_local_rows(),desc_a%get_local_cols(),& - & acsr3%get_nrows(),acsr3%get_ncols() - if (do_timings) call psb_tic(idx_spspmm) - call psb_par_spspmm(csr_restr,desc_a,acsr3,ac_csr,tmp_desc,info) - if (do_timings) call psb_toc(idx_spspmm) - call ac_csr%mv_to_coo(ac_coo,info) - nza = ac_coo%get_nzeros() - if (debug) write(0,*) me,trim(name),' Fixing ac ',& - & ac_coo%get_nrows(),ac_coo%get_ncols(), nza - - call ac_coo%fix(info) - call tmp_desc%indxmap%l2gip(ac_coo%ia(1:nza),info) - call tmp_desc%indxmap%l2gip(ac_coo%ja(1:nza),info) - call ac_coo%set_nrows(ntaggr) - call ac_coo%set_ncols(ntaggr) - if (debug) write(0,*) me,' ',trim(name),' Before mv_from',psb_get_errstatus() - if (info == 0) call ac%mv_from(ac_coo) - 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 (debug) then - write(0,*) me,' ',trim(name),' Checkpoint at exit' - call psb_barrier(ictxt) - write(0,*) me,' ',trim(name),' Checkpoint through' - end if - - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3') - goto 9999 - end if - - - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Done smooth_aggregate ' - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine mld_d_old_spmm_bld_inner diff --git a/mlprec/impl/aggregator/mld_daggrmat_biz_bld.f90 b/mlprec/impl/aggregator/mld_daggrmat_biz_bld.f90 index ad08740c..055f8b8c 100644 --- a/mlprec/impl/aggregator/mld_daggrmat_biz_bld.f90 +++ b/mlprec/impl/aggregator/mld_daggrmat_biz_bld.f90 @@ -117,7 +117,7 @@ subroutine mld_daggrmat_biz_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr logical, parameter :: debug_new=.false. character(len=80) :: filename - name='mld_aggrmat_smth_bld' + name='mld_aggrmat_biz_bld' info=psb_success_ call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then @@ -258,24 +258,14 @@ subroutine mld_daggrmat_biz_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Done SPSPMM 1' - if (.true.) then - nzl = acsr1%get_nzeros() - call acsr1%mv_to_coo(coo_prol,info) - - 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 - nzl = acsr1%get_nzeros() - call tmp_desc%l2gip(acsr1%ja(1:nzl),info) - call op_prol%mv_from(acsr1) - - call mld_spmm_bld_inner(acsr,desc_a,ilaggr,nlaggr,parms,ac,& - & op_prol,op_restr,info) - - end if + nzl = acsr1%get_nzeros() + call acsr1%mv_to_coo(coo_prol,info) + + 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) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& diff --git a/mlprec/impl/aggregator/mld_daggrmat_smth_bld.f90 b/mlprec/impl/aggregator/mld_daggrmat_smth_bld.f90 index 28504d57..95ca613b 100644 --- a/mlprec/impl/aggregator/mld_daggrmat_smth_bld.f90 +++ b/mlprec/impl/aggregator/mld_daggrmat_smth_bld.f90 @@ -278,24 +278,14 @@ subroutine mld_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Done SPSPMM 1' - if (.true.) then - nzl = acsr1%get_nzeros() - call acsr1%mv_to_coo(coo_prol,info) - - 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 - nzl = acsr1%get_nzeros() - call tmp_desc%l2gip(acsr1%ja(1:nzl),info) - call op_prol%mv_from(acsr1) - - call mld_spmm_bld_inner(acsr,desc_a,ilaggr,nlaggr,parms,ac,& - & op_prol,op_restr,info) - - end if + nzl = acsr1%get_nzeros() + call acsr1%mv_to_coo(coo_prol,info) + + 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) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& diff --git a/mlprec/impl/aggregator/mld_s_spmm_bld_inner.f90 b/mlprec/impl/aggregator/mld_s_spmm_bld_inner.f90 index 3d97aa46..d7acb319 100644 --- a/mlprec/impl/aggregator/mld_s_spmm_bld_inner.f90 +++ b/mlprec/impl/aggregator/mld_s_spmm_bld_inner.f90 @@ -215,187 +215,3 @@ subroutine mld_s_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,& return end subroutine mld_s_spmm_bld_inner -subroutine mld_s_old_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,ac,& - & op_prol,op_restr,info) - use psb_base_mod - use mld_s_inner_mod - use mld_s_base_aggregator_mod, mld_protect_name => mld_s_old_spmm_bld_inner - implicit none - - ! Arguments - type(psb_ls_csr_sparse_mat), intent(inout) :: a_csr - type(psb_desc_type), intent(in) :: desc_a - integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(mld_sml_parms), intent(inout) :: parms - type(psb_lsspmat_type), intent(inout) :: op_prol, op_restr - type(psb_lsspmat_type), intent(out) :: ac - integer(psb_ipk_), intent(out) :: info - - ! Local variables - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo - character(len=40) :: name - integer(psb_ipk_) :: ierr(5) - type(psb_ls_coo_sparse_mat) :: ac_coo, tmpcoo - type(psb_ls_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr - type(psb_desc_type), target :: tmp_desc - integer(psb_ipk_) :: debug_level, debug_unit, naggr - integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & - & nzt, naggrm1, naggrp1, i, k - integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza, nrpsave, ncpsave, nzpsave - logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false. - integer(psb_ipk_), save :: idx_spspmm=-1 - - name='mld_spmm_bld_inner' - if(psb_get_errstatus().ne.0) return - info=psb_success_ - call psb_erractionsave(err_act) - - - ictxt = desc_a%get_context() - icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) - debug_unit = psb_get_debug_unit() - debug_level = psb_get_debug_level() - nglob = desc_a%get_global_rows() - nrow = desc_a%get_local_rows() - ncol = desc_a%get_local_cols() - - if ((do_timings).and.(idx_spspmm==-1)) & - & idx_spspmm = psb_get_timer_idx("SPMM_BLD: par_spspmm") - - naggr = nlaggr(me+1) - ntaggr = sum(nlaggr) - naggrm1 = sum(nlaggr(1:me)) - naggrp1 = sum(nlaggr(1:me+1)) - !write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr - nrpsave = op_prol%get_nrows() - ncpsave = op_prol%get_ncols() - nzpsave = op_prol%get_nzeros() - !write(0,*)me,' ',name,' input op_prol ',nrpsave,ncpsave,nzpsave - - ! - ! Here OP_PROL should be with GLOBAL indices on the cols - ! and LOCAL indices on the rows. - ! - if (debug) write(0,*) me,' ',trim(name),' Size check on entry New: ',& - & op_prol%get_fmt(),op_prol%get_nrows(),op_prol%get_ncols(),op_prol%get_nzeros(),& - & nrow,ntaggr,naggr - - call op_prol%cp_to(tmpcoo) - - if (debug) write(0,*) me,' ',trim(name),' tmpcoo: ',& - & tmpcoo%ia(1:min(10,nzpsave)),' :',tmpcoo%ja(1:min(10,nzpsave)) - call psb_cdall(ictxt,tmp_desc,info,nl=naggr) - call tmp_desc%indxmap%g2lip_ins(tmpcoo%ja(1:nzpsave),info) - call tmpcoo%set_ncols(tmp_desc%get_local_cols()) - call tmpcoo%mv_to_fmt(csr_prol,info) - - if (debug) write(0,*) me,trim(name),' Product AxPROL ',& - & a_csr%get_nrows(),a_csr%get_ncols(), csr_prol%get_nrows(), & - & desc_a%get_local_rows(),desc_a%get_local_cols(),& - & tmp_desc%get_local_rows(),desc_a%get_local_cols() - if (debug) flush(0) - - if (do_timings) call psb_tic(idx_spspmm) - call psb_par_spspmm(a_csr,desc_a,csr_prol,acsr3,tmp_desc,info) - if (do_timings) call psb_toc(idx_spspmm) - - if (debug) write(0,*) me,trim(name),' Done AxPROL ',& - & acsr3%get_nrows(),acsr3%get_ncols(), acsr3%get_nzeros(),& - & tmp_desc%get_local_rows(),tmp_desc%get_local_cols() - - ! - ! Ok first product done. - ! - ! Remember that RESTR must be built from PROL after halo extension, - ! which is done above in psb_par_spspmm - 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%cp_to_fmt(tmpcoo,info) -!!$ write(0,*)me,' ',name,' new into transposition ',tmpcoo%get_nrows(),& -!!$ & tmpcoo%get_ncols(),tmpcoo%get_nzeros() - call tmpcoo%transp() - nzl = tmpcoo%get_nzeros() - call tmp_desc%l2gip(tmpcoo%ia(1:nzl),info) - i=0 - ! - ! Now we have to fix this. The only rows of the restrictor that are correct - ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:) - ! - 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%fix(info) - call op_restr%cp_from(tmpcoo) -!!$ write(0,*)me,' ',name,' after transposition ',tmpcoo%get_nrows(),tmpcoo%get_ncols(),tmpcoo%get_nzeros() - - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr') - goto 9999 - end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'starting sphalo/ rwxtd' - nzl = tmpcoo%get_nzeros() - call psb_glob_to_loc(tmpcoo%ia(1:nzl),tmp_desc,info,iact='I',owned=.true.) - call tmpcoo%clean_negidx(info) - nzl = tmpcoo%get_nzeros() - call tmpcoo%set_nrows(tmp_desc%get_local_rows()) - call tmpcoo%set_ncols(desc_a%get_local_cols()) -!!$ write(0,*)me,' ',name,' after G2L on rows ',tmpcoo%get_nrows(),tmpcoo%get_ncols(),tmpcoo%get_nzeros() - call csr_restr%mv_from_coo(tmpcoo,info) - - - if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& - & csr_restr%get_nrows(),csr_restr%get_ncols(), & - & tmp_desc%get_local_rows(),desc_a%get_local_cols(),& - & acsr3%get_nrows(),acsr3%get_ncols() - if (do_timings) call psb_tic(idx_spspmm) - call psb_par_spspmm(csr_restr,desc_a,acsr3,ac_csr,tmp_desc,info) - if (do_timings) call psb_toc(idx_spspmm) - call ac_csr%mv_to_coo(ac_coo,info) - nza = ac_coo%get_nzeros() - if (debug) write(0,*) me,trim(name),' Fixing ac ',& - & ac_coo%get_nrows(),ac_coo%get_ncols(), nza - - call ac_coo%fix(info) - call tmp_desc%indxmap%l2gip(ac_coo%ia(1:nza),info) - call tmp_desc%indxmap%l2gip(ac_coo%ja(1:nza),info) - call ac_coo%set_nrows(ntaggr) - call ac_coo%set_ncols(ntaggr) - if (debug) write(0,*) me,' ',trim(name),' Before mv_from',psb_get_errstatus() - if (info == 0) call ac%mv_from(ac_coo) - 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 (debug) then - write(0,*) me,' ',trim(name),' Checkpoint at exit' - call psb_barrier(ictxt) - write(0,*) me,' ',trim(name),' Checkpoint through' - end if - - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3') - goto 9999 - end if - - - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Done smooth_aggregate ' - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine mld_s_old_spmm_bld_inner diff --git a/mlprec/impl/aggregator/mld_saggrmat_biz_bld.f90 b/mlprec/impl/aggregator/mld_saggrmat_biz_bld.f90 index 382f1c33..3d333ade 100644 --- a/mlprec/impl/aggregator/mld_saggrmat_biz_bld.f90 +++ b/mlprec/impl/aggregator/mld_saggrmat_biz_bld.f90 @@ -117,7 +117,7 @@ subroutine mld_saggrmat_biz_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr logical, parameter :: debug_new=.false. character(len=80) :: filename - name='mld_aggrmat_smth_bld' + name='mld_aggrmat_biz_bld' info=psb_success_ call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then @@ -258,24 +258,14 @@ subroutine mld_saggrmat_biz_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Done SPSPMM 1' - if (.true.) then - nzl = acsr1%get_nzeros() - call acsr1%mv_to_coo(coo_prol,info) - - 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 - nzl = acsr1%get_nzeros() - call tmp_desc%l2gip(acsr1%ja(1:nzl),info) - call op_prol%mv_from(acsr1) - - call mld_spmm_bld_inner(acsr,desc_a,ilaggr,nlaggr,parms,ac,& - & op_prol,op_restr,info) - - end if + nzl = acsr1%get_nzeros() + call acsr1%mv_to_coo(coo_prol,info) + + 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) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& diff --git a/mlprec/impl/aggregator/mld_saggrmat_smth_bld.f90 b/mlprec/impl/aggregator/mld_saggrmat_smth_bld.f90 index 236e9455..79505416 100644 --- a/mlprec/impl/aggregator/mld_saggrmat_smth_bld.f90 +++ b/mlprec/impl/aggregator/mld_saggrmat_smth_bld.f90 @@ -278,24 +278,14 @@ subroutine mld_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Done SPSPMM 1' - if (.true.) then - nzl = acsr1%get_nzeros() - call acsr1%mv_to_coo(coo_prol,info) - - 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 - nzl = acsr1%get_nzeros() - call tmp_desc%l2gip(acsr1%ja(1:nzl),info) - call op_prol%mv_from(acsr1) - - call mld_spmm_bld_inner(acsr,desc_a,ilaggr,nlaggr,parms,ac,& - & op_prol,op_restr,info) - - end if + nzl = acsr1%get_nzeros() + call acsr1%mv_to_coo(coo_prol,info) + + 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) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& diff --git a/mlprec/impl/aggregator/mld_z_spmm_bld_inner.f90 b/mlprec/impl/aggregator/mld_z_spmm_bld_inner.f90 index cf8f824b..0fbcb9ad 100644 --- a/mlprec/impl/aggregator/mld_z_spmm_bld_inner.f90 +++ b/mlprec/impl/aggregator/mld_z_spmm_bld_inner.f90 @@ -215,187 +215,3 @@ subroutine mld_z_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,& return end subroutine mld_z_spmm_bld_inner -subroutine mld_z_old_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,ac,& - & op_prol,op_restr,info) - use psb_base_mod - use mld_z_inner_mod - use mld_z_base_aggregator_mod, mld_protect_name => mld_z_old_spmm_bld_inner - implicit none - - ! Arguments - type(psb_lz_csr_sparse_mat), intent(inout) :: a_csr - type(psb_desc_type), intent(in) :: desc_a - integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(mld_dml_parms), intent(inout) :: parms - type(psb_lzspmat_type), intent(inout) :: op_prol, op_restr - type(psb_lzspmat_type), intent(out) :: ac - integer(psb_ipk_), intent(out) :: info - - ! Local variables - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo - character(len=40) :: name - integer(psb_ipk_) :: ierr(5) - type(psb_lz_coo_sparse_mat) :: ac_coo, tmpcoo - type(psb_lz_csr_sparse_mat) :: acsr3, csr_prol, ac_csr, csr_restr - type(psb_desc_type), target :: tmp_desc - integer(psb_ipk_) :: debug_level, debug_unit, naggr - integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & - & nzt, naggrm1, naggrp1, i, k - integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza, nrpsave, ncpsave, nzpsave - logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false. - integer(psb_ipk_), save :: idx_spspmm=-1 - - name='mld_spmm_bld_inner' - if(psb_get_errstatus().ne.0) return - info=psb_success_ - call psb_erractionsave(err_act) - - - ictxt = desc_a%get_context() - icomm = desc_a%get_mpic() - call psb_info(ictxt, me, np) - debug_unit = psb_get_debug_unit() - debug_level = psb_get_debug_level() - nglob = desc_a%get_global_rows() - nrow = desc_a%get_local_rows() - ncol = desc_a%get_local_cols() - - if ((do_timings).and.(idx_spspmm==-1)) & - & idx_spspmm = psb_get_timer_idx("SPMM_BLD: par_spspmm") - - naggr = nlaggr(me+1) - ntaggr = sum(nlaggr) - naggrm1 = sum(nlaggr(1:me)) - naggrp1 = sum(nlaggr(1:me+1)) - !write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr - nrpsave = op_prol%get_nrows() - ncpsave = op_prol%get_ncols() - nzpsave = op_prol%get_nzeros() - !write(0,*)me,' ',name,' input op_prol ',nrpsave,ncpsave,nzpsave - - ! - ! Here OP_PROL should be with GLOBAL indices on the cols - ! and LOCAL indices on the rows. - ! - if (debug) write(0,*) me,' ',trim(name),' Size check on entry New: ',& - & op_prol%get_fmt(),op_prol%get_nrows(),op_prol%get_ncols(),op_prol%get_nzeros(),& - & nrow,ntaggr,naggr - - call op_prol%cp_to(tmpcoo) - - if (debug) write(0,*) me,' ',trim(name),' tmpcoo: ',& - & tmpcoo%ia(1:min(10,nzpsave)),' :',tmpcoo%ja(1:min(10,nzpsave)) - call psb_cdall(ictxt,tmp_desc,info,nl=naggr) - call tmp_desc%indxmap%g2lip_ins(tmpcoo%ja(1:nzpsave),info) - call tmpcoo%set_ncols(tmp_desc%get_local_cols()) - call tmpcoo%mv_to_fmt(csr_prol,info) - - if (debug) write(0,*) me,trim(name),' Product AxPROL ',& - & a_csr%get_nrows(),a_csr%get_ncols(), csr_prol%get_nrows(), & - & desc_a%get_local_rows(),desc_a%get_local_cols(),& - & tmp_desc%get_local_rows(),desc_a%get_local_cols() - if (debug) flush(0) - - if (do_timings) call psb_tic(idx_spspmm) - call psb_par_spspmm(a_csr,desc_a,csr_prol,acsr3,tmp_desc,info) - if (do_timings) call psb_toc(idx_spspmm) - - if (debug) write(0,*) me,trim(name),' Done AxPROL ',& - & acsr3%get_nrows(),acsr3%get_ncols(), acsr3%get_nzeros(),& - & tmp_desc%get_local_rows(),tmp_desc%get_local_cols() - - ! - ! Ok first product done. - ! - ! Remember that RESTR must be built from PROL after halo extension, - ! which is done above in psb_par_spspmm - 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%cp_to_fmt(tmpcoo,info) -!!$ write(0,*)me,' ',name,' new into transposition ',tmpcoo%get_nrows(),& -!!$ & tmpcoo%get_ncols(),tmpcoo%get_nzeros() - call tmpcoo%transp() - nzl = tmpcoo%get_nzeros() - call tmp_desc%l2gip(tmpcoo%ia(1:nzl),info) - i=0 - ! - ! Now we have to fix this. The only rows of the restrictor that are correct - ! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:) - ! - 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%fix(info) - call op_restr%cp_from(tmpcoo) -!!$ write(0,*)me,' ',name,' after transposition ',tmpcoo%get_nrows(),tmpcoo%get_ncols(),tmpcoo%get_nzeros() - - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv op_restr') - goto 9999 - end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'starting sphalo/ rwxtd' - nzl = tmpcoo%get_nzeros() - call psb_glob_to_loc(tmpcoo%ia(1:nzl),tmp_desc,info,iact='I',owned=.true.) - call tmpcoo%clean_negidx(info) - nzl = tmpcoo%get_nzeros() - call tmpcoo%set_nrows(tmp_desc%get_local_rows()) - call tmpcoo%set_ncols(desc_a%get_local_cols()) -!!$ write(0,*)me,' ',name,' after G2L on rows ',tmpcoo%get_nrows(),tmpcoo%get_ncols(),tmpcoo%get_nzeros() - call csr_restr%mv_from_coo(tmpcoo,info) - - - if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& - & csr_restr%get_nrows(),csr_restr%get_ncols(), & - & tmp_desc%get_local_rows(),desc_a%get_local_cols(),& - & acsr3%get_nrows(),acsr3%get_ncols() - if (do_timings) call psb_tic(idx_spspmm) - call psb_par_spspmm(csr_restr,desc_a,acsr3,ac_csr,tmp_desc,info) - if (do_timings) call psb_toc(idx_spspmm) - call ac_csr%mv_to_coo(ac_coo,info) - nza = ac_coo%get_nzeros() - if (debug) write(0,*) me,trim(name),' Fixing ac ',& - & ac_coo%get_nrows(),ac_coo%get_ncols(), nza - - call ac_coo%fix(info) - call tmp_desc%indxmap%l2gip(ac_coo%ia(1:nza),info) - call tmp_desc%indxmap%l2gip(ac_coo%ja(1:nza),info) - call ac_coo%set_nrows(ntaggr) - call ac_coo%set_ncols(ntaggr) - if (debug) write(0,*) me,' ',trim(name),' Before mv_from',psb_get_errstatus() - if (info == 0) call ac%mv_from(ac_coo) - 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 (debug) then - write(0,*) me,' ',trim(name),' Checkpoint at exit' - call psb_barrier(ictxt) - write(0,*) me,' ',trim(name),' Checkpoint through' - end if - - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3') - goto 9999 - end if - - - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Done smooth_aggregate ' - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine mld_z_old_spmm_bld_inner diff --git a/mlprec/impl/aggregator/mld_zaggrmat_biz_bld.f90 b/mlprec/impl/aggregator/mld_zaggrmat_biz_bld.f90 index fc0d807e..36fe3f5e 100644 --- a/mlprec/impl/aggregator/mld_zaggrmat_biz_bld.f90 +++ b/mlprec/impl/aggregator/mld_zaggrmat_biz_bld.f90 @@ -117,7 +117,7 @@ subroutine mld_zaggrmat_biz_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr logical, parameter :: debug_new=.false. character(len=80) :: filename - name='mld_aggrmat_smth_bld' + name='mld_aggrmat_biz_bld' info=psb_success_ call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then @@ -258,24 +258,14 @@ subroutine mld_zaggrmat_biz_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Done SPSPMM 1' - if (.true.) then - nzl = acsr1%get_nzeros() - call acsr1%mv_to_coo(coo_prol,info) - - 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 - nzl = acsr1%get_nzeros() - call tmp_desc%l2gip(acsr1%ja(1:nzl),info) - call op_prol%mv_from(acsr1) - - call mld_spmm_bld_inner(acsr,desc_a,ilaggr,nlaggr,parms,ac,& - & op_prol,op_restr,info) - - end if + nzl = acsr1%get_nzeros() + call acsr1%mv_to_coo(coo_prol,info) + + 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) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& diff --git a/mlprec/impl/aggregator/mld_zaggrmat_smth_bld.f90 b/mlprec/impl/aggregator/mld_zaggrmat_smth_bld.f90 index ff2cd3dc..f1196725 100644 --- a/mlprec/impl/aggregator/mld_zaggrmat_smth_bld.f90 +++ b/mlprec/impl/aggregator/mld_zaggrmat_smth_bld.f90 @@ -278,24 +278,14 @@ subroutine mld_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Done SPSPMM 1' - if (.true.) then - nzl = acsr1%get_nzeros() - call acsr1%mv_to_coo(coo_prol,info) - - 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 - nzl = acsr1%get_nzeros() - call tmp_desc%l2gip(acsr1%ja(1:nzl),info) - call op_prol%mv_from(acsr1) - - call mld_spmm_bld_inner(acsr,desc_a,ilaggr,nlaggr,parms,ac,& - & op_prol,op_restr,info) - - end if + nzl = acsr1%get_nzeros() + call acsr1%mv_to_coo(coo_prol,info) + + 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) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& diff --git a/mlprec/mld_c_base_aggregator_mod.f90 b/mlprec/mld_c_base_aggregator_mod.f90 index 52397233..3aea89f1 100644 --- a/mlprec/mld_c_base_aggregator_mod.f90 +++ b/mlprec/mld_c_base_aggregator_mod.f90 @@ -133,21 +133,6 @@ module mld_c_base_aggregator_mod type(psb_lcspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info end subroutine mld_c_spmm_bld_inner - subroutine mld_c_old_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,ac,& - & op_prol,op_restr,info) - import :: psb_lc_csr_sparse_mat, psb_lcspmat_type, psb_desc_type, & - & mld_sml_parms, psb_spk_, psb_ipk_, psb_lpk_ - implicit none - - ! Arguments - type(psb_lc_csr_sparse_mat), intent(inout) :: a_csr - type(psb_desc_type), intent(in) :: desc_a - integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(mld_sml_parms), intent(inout) :: parms - type(psb_lcspmat_type), intent(inout) :: op_prol, op_restr - type(psb_lcspmat_type), intent(out) :: ac - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_old_spmm_bld_inner end interface mld_spmm_bld_inner contains diff --git a/mlprec/mld_d_base_aggregator_mod.f90 b/mlprec/mld_d_base_aggregator_mod.f90 index 205a89cc..5fa11460 100644 --- a/mlprec/mld_d_base_aggregator_mod.f90 +++ b/mlprec/mld_d_base_aggregator_mod.f90 @@ -133,21 +133,6 @@ module mld_d_base_aggregator_mod type(psb_ldspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info end subroutine mld_d_spmm_bld_inner - subroutine mld_d_old_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,ac,& - & op_prol,op_restr,info) - import :: psb_ld_csr_sparse_mat, psb_ldspmat_type, psb_desc_type, & - & mld_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_ - implicit none - - ! Arguments - type(psb_ld_csr_sparse_mat), intent(inout) :: a_csr - type(psb_desc_type), intent(in) :: desc_a - integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(mld_dml_parms), intent(inout) :: parms - type(psb_ldspmat_type), intent(inout) :: op_prol, op_restr - type(psb_ldspmat_type), intent(out) :: ac - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_old_spmm_bld_inner end interface mld_spmm_bld_inner contains diff --git a/mlprec/mld_s_base_aggregator_mod.f90 b/mlprec/mld_s_base_aggregator_mod.f90 index 18e774a4..df09a0d4 100644 --- a/mlprec/mld_s_base_aggregator_mod.f90 +++ b/mlprec/mld_s_base_aggregator_mod.f90 @@ -133,21 +133,6 @@ module mld_s_base_aggregator_mod type(psb_lsspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info end subroutine mld_s_spmm_bld_inner - subroutine mld_s_old_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,ac,& - & op_prol,op_restr,info) - import :: psb_ls_csr_sparse_mat, psb_lsspmat_type, psb_desc_type, & - & mld_sml_parms, psb_spk_, psb_ipk_, psb_lpk_ - implicit none - - ! Arguments - type(psb_ls_csr_sparse_mat), intent(inout) :: a_csr - type(psb_desc_type), intent(in) :: desc_a - integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(mld_sml_parms), intent(inout) :: parms - type(psb_lsspmat_type), intent(inout) :: op_prol, op_restr - type(psb_lsspmat_type), intent(out) :: ac - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_old_spmm_bld_inner end interface mld_spmm_bld_inner contains diff --git a/mlprec/mld_z_base_aggregator_mod.f90 b/mlprec/mld_z_base_aggregator_mod.f90 index 07840546..8733b661 100644 --- a/mlprec/mld_z_base_aggregator_mod.f90 +++ b/mlprec/mld_z_base_aggregator_mod.f90 @@ -133,21 +133,6 @@ module mld_z_base_aggregator_mod type(psb_lzspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info end subroutine mld_z_spmm_bld_inner - subroutine mld_z_old_spmm_bld_inner(a_csr,desc_a,ilaggr,nlaggr,parms,ac,& - & op_prol,op_restr,info) - import :: psb_lz_csr_sparse_mat, psb_lzspmat_type, psb_desc_type, & - & mld_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_ - implicit none - - ! Arguments - type(psb_lz_csr_sparse_mat), intent(inout) :: a_csr - type(psb_desc_type), intent(in) :: desc_a - integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(mld_dml_parms), intent(inout) :: parms - type(psb_lzspmat_type), intent(inout) :: op_prol, op_restr - type(psb_lzspmat_type), intent(out) :: ac - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_old_spmm_bld_inner end interface mld_spmm_bld_inner contains