From 7acf594798908e3ee8bca0394e51fc1ed0735254 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 15 Jun 2020 15:28:10 +0200 Subject: [PATCH] Define PTAP and use in aggregation. --- mlprec/impl/aggregator/mld_c_ptap.f90 | 279 ++++++++++++------ .../aggregator/mld_caggrmat_minnrg_bld.f90 | 6 +- .../aggregator/mld_caggrmat_nosmth_bld.f90 | 2 +- .../impl/aggregator/mld_caggrmat_smth_bld.f90 | 2 +- mlprec/impl/aggregator/mld_d_ptap.f90 | 279 ++++++++++++------ .../aggregator/mld_daggrmat_minnrg_bld.f90 | 6 +- .../aggregator/mld_daggrmat_nosmth_bld.f90 | 2 +- .../impl/aggregator/mld_daggrmat_smth_bld.f90 | 2 +- mlprec/impl/aggregator/mld_s_ptap.f90 | 279 ++++++++++++------ .../aggregator/mld_saggrmat_minnrg_bld.f90 | 6 +- .../aggregator/mld_saggrmat_nosmth_bld.f90 | 2 +- .../impl/aggregator/mld_saggrmat_smth_bld.f90 | 2 +- mlprec/impl/aggregator/mld_z_ptap.f90 | 279 ++++++++++++------ .../aggregator/mld_zaggrmat_minnrg_bld.f90 | 6 +- .../aggregator/mld_zaggrmat_nosmth_bld.f90 | 2 +- .../impl/aggregator/mld_zaggrmat_smth_bld.f90 | 2 +- mlprec/mld_c_base_aggregator_mod.f90 | 6 +- mlprec/mld_c_inner_mod.f90 | 2 +- mlprec/mld_d_base_aggregator_mod.f90 | 6 +- mlprec/mld_d_inner_mod.f90 | 2 +- mlprec/mld_s_base_aggregator_mod.f90 | 6 +- mlprec/mld_s_inner_mod.f90 | 2 +- mlprec/mld_z_base_aggregator_mod.f90 | 6 +- mlprec/mld_z_inner_mod.f90 | 2 +- 24 files changed, 772 insertions(+), 416 deletions(-) diff --git a/mlprec/impl/aggregator/mld_c_ptap.f90 b/mlprec/impl/aggregator/mld_c_ptap.f90 index 964eb5be..6a5b3b7b 100644 --- a/mlprec/impl/aggregator/mld_c_ptap.f90 +++ b/mlprec/impl/aggregator/mld_c_ptap.f90 @@ -36,7 +36,7 @@ ! ! subroutine mld_c_ptap(a_csr,desc_a,nlaggr,parms,ac,& - & coo_prol,desc_ac,coo_restr,info) + & coo_prol,desc_ac,coo_restr,info,desc_ax) use psb_base_mod use mld_c_inner_mod use mld_c_base_aggregator_mod, mld_protect_name => mld_c_ptap @@ -44,13 +44,14 @@ subroutine mld_c_ptap(a_csr,desc_a,nlaggr,parms,ac,& ! Arguments type(psb_c_csr_sparse_mat), intent(inout) :: a_csr - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: nlaggr(:) type(mld_sml_parms), intent(inout) :: parms type(psb_lc_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr type(psb_desc_type), intent(inout) :: desc_ac type(psb_lcspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(inout), optional :: desc_ax ! Local variables integer(psb_ipk_) :: err_act @@ -115,57 +116,99 @@ subroutine mld_c_ptap(a_csr,desc_a,nlaggr,parms,ac,& ! ! 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%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() - nzl = coo_restr%get_nzeros() - nrl = desc_ac%get_local_rows() - i=0 - ! - ! Only keep local rows - ! - do k=1, nzl - if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then - i = i+1 - coo_restr%val(i) = coo_restr%val(k) - coo_restr%ia(i) = coo_restr%ia(k) - coo_restr%ja(i) = coo_restr%ja(k) + if (present(desc_ax)) then + block + type(psb_c_coo_sparse_mat) :: icoo_restr + + call coo_prol%cp_to_icoo(icoo_restr,info) + call icoo_restr%set_ncols(desc_ac%get_local_cols()) + call icoo_restr%set_nrows(desc_a%get_local_rows()) + 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()= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting sphalo/ rwxtd' + + if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& + & csr_restr%get_nrows(),csr_restr%get_ncols(), & + & desc_ac%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_ax,acsr3,ac_csr,desc_ac,info) + if (do_timings) call psb_toc(idx_spspmm) + call acsr3%free() + + else + + ! + ! 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%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() + nzl = coo_restr%get_nzeros() + nrl = desc_ac%get_local_rows() + i=0 + ! + ! Only keep local rows + ! + do k=1, nzl + if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then + i = i+1 + coo_restr%val(i) = coo_restr%val(k) + coo_restr%ia(i) = coo_restr%ia(k) + coo_restr%ja(i) = coo_restr%ja(k) + end if + end do + call coo_restr%set_nzeros(i) + call coo_restr%fix(info) + nzl = coo_restr%get_nzeros() + 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 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 + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') + goto 9999 + end if + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting sphalo/ rwxtd' + + if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& + & csr_restr%get_nrows(),csr_restr%get_ncols(), & + & desc_ac%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,desc_ac,info) + if (do_timings) call psb_toc(idx_spspmm) + call acsr3%free() end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'starting sphalo/ rwxtd' - - if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& - & csr_restr%get_nrows(),csr_restr%get_ncols(), & - & desc_ac%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,desc_ac,info) - if (do_timings) call psb_toc(idx_spspmm) - call acsr3%free() call psb_cdasb(desc_ac,info) @@ -175,11 +218,10 @@ subroutine mld_c_ptap(a_csr,desc_a,nlaggr,parms,ac,& call ac%set_asb() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() - if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),& - & ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr + if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr + ! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros() call coo_prol%set_ncols(desc_ac%get_local_cols()) - if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug_level >= psb_debug_outer_) & @@ -211,7 +253,7 @@ contains end subroutine mld_c_ptap subroutine mld_lc_ptap(a_csr,desc_a,nlaggr,parms,ac,& - & coo_prol,desc_ac,coo_restr,info) + & coo_prol,desc_ac,coo_restr,info,desc_ax) use psb_base_mod use mld_c_inner_mod use mld_c_base_aggregator_mod, mld_protect_name => mld_lc_ptap @@ -219,13 +261,14 @@ subroutine mld_lc_ptap(a_csr,desc_a,nlaggr,parms,ac,& ! Arguments type(psb_lc_csr_sparse_mat), intent(inout) :: a_csr - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: nlaggr(:) type(mld_sml_parms), intent(inout) :: parms type(psb_lc_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr type(psb_desc_type), intent(inout) :: desc_ac type(psb_lcspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(inout), optional :: desc_ax ! Local variables integer(psb_ipk_) :: err_act @@ -290,57 +333,99 @@ subroutine mld_lc_ptap(a_csr,desc_a,nlaggr,parms,ac,& ! ! 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%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() - nzl = coo_restr%get_nzeros() - nrl = desc_ac%get_local_rows() - i=0 - ! - ! Only keep local rows - ! - do k=1, nzl - if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then - i = i+1 - coo_restr%val(i) = coo_restr%val(k) - coo_restr%ia(i) = coo_restr%ia(k) - coo_restr%ja(i) = coo_restr%ja(k) + if (present(desc_ax)) then + block + type(psb_c_coo_sparse_mat) :: icoo_restr + + call coo_prol%cp_to_icoo(icoo_restr,info) + call icoo_restr%set_ncols(desc_ac%get_local_cols()) + call icoo_restr%set_nrows(desc_a%get_local_rows()) + 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()= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting sphalo/ rwxtd' + + if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& + & csr_restr%get_nrows(),csr_restr%get_ncols(), & + & desc_ac%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_ax,acsr3,ac_csr,desc_ac,info) + if (do_timings) call psb_toc(idx_spspmm) + call acsr3%free() + + else + + ! + ! 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%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() + nzl = coo_restr%get_nzeros() + nrl = desc_ac%get_local_rows() + i=0 + ! + ! Only keep local rows + ! + do k=1, nzl + if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then + i = i+1 + coo_restr%val(i) = coo_restr%val(k) + coo_restr%ia(i) = coo_restr%ia(k) + coo_restr%ja(i) = coo_restr%ja(k) + end if + end do + call coo_restr%set_nzeros(i) + call coo_restr%fix(info) + nzl = coo_restr%get_nzeros() + 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 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 + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') + goto 9999 + end if + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting sphalo/ rwxtd' + + if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& + & csr_restr%get_nrows(),csr_restr%get_ncols(), & + & desc_ac%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,desc_ac,info) + if (do_timings) call psb_toc(idx_spspmm) + call acsr3%free() end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'starting sphalo/ rwxtd' - - if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& - & csr_restr%get_nrows(),csr_restr%get_ncols(), & - & desc_ac%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,desc_ac,info) - if (do_timings) call psb_toc(idx_spspmm) - call acsr3%free() call psb_cdasb(desc_ac,info) diff --git a/mlprec/impl/aggregator/mld_caggrmat_minnrg_bld.f90 b/mlprec/impl/aggregator/mld_caggrmat_minnrg_bld.f90 index 21365f6f..e33b955e 100644 --- a/mlprec/impl/aggregator/mld_caggrmat_minnrg_bld.f90 +++ b/mlprec/impl/aggregator/mld_caggrmat_minnrg_bld.f90 @@ -104,7 +104,8 @@ ! Error code. ! ! -subroutine mld_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) +subroutine mld_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,& + & ac,desc_ac,op_prol,op_restr,info) use psb_base_mod use mld_base_prec_type use mld_c_inner_mod, mld_protect_name => mld_caggrmat_minnrg_bld @@ -113,11 +114,12 @@ subroutine mld_caggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re ! Arguments type(psb_cspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) type(mld_sml_parms), intent(inout) :: parms type(psb_lcspmat_type), intent(inout) :: op_prol type(psb_lcspmat_type), intent(out) :: ac,op_restr + type(psb_desc_type), intent(inout) :: desc_ac integer(psb_ipk_), intent(out) :: info ! Local variables diff --git a/mlprec/impl/aggregator/mld_caggrmat_nosmth_bld.f90 b/mlprec/impl/aggregator/mld_caggrmat_nosmth_bld.f90 index eac910d4..849a4cf8 100644 --- a/mlprec/impl/aggregator/mld_caggrmat_nosmth_bld.f90 +++ b/mlprec/impl/aggregator/mld_caggrmat_nosmth_bld.f90 @@ -106,7 +106,7 @@ subroutine mld_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,& ! Arguments type(psb_cspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) type(mld_sml_parms), intent(inout) :: parms type(psb_lcspmat_type), intent(inout) :: op_prol diff --git a/mlprec/impl/aggregator/mld_caggrmat_smth_bld.f90 b/mlprec/impl/aggregator/mld_caggrmat_smth_bld.f90 index 015c772c..97b221e0 100644 --- a/mlprec/impl/aggregator/mld_caggrmat_smth_bld.f90 +++ b/mlprec/impl/aggregator/mld_caggrmat_smth_bld.f90 @@ -113,7 +113,7 @@ subroutine mld_caggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& ! Arguments type(psb_cspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) type(mld_sml_parms), intent(inout) :: parms type(psb_lcspmat_type), intent(inout) :: op_prol diff --git a/mlprec/impl/aggregator/mld_d_ptap.f90 b/mlprec/impl/aggregator/mld_d_ptap.f90 index 0c74e460..b1229946 100644 --- a/mlprec/impl/aggregator/mld_d_ptap.f90 +++ b/mlprec/impl/aggregator/mld_d_ptap.f90 @@ -36,7 +36,7 @@ ! ! subroutine mld_d_ptap(a_csr,desc_a,nlaggr,parms,ac,& - & coo_prol,desc_ac,coo_restr,info) + & coo_prol,desc_ac,coo_restr,info,desc_ax) use psb_base_mod use mld_d_inner_mod use mld_d_base_aggregator_mod, mld_protect_name => mld_d_ptap @@ -44,13 +44,14 @@ subroutine mld_d_ptap(a_csr,desc_a,nlaggr,parms,ac,& ! Arguments type(psb_d_csr_sparse_mat), intent(inout) :: a_csr - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: nlaggr(:) type(mld_dml_parms), intent(inout) :: parms type(psb_ld_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr type(psb_desc_type), intent(inout) :: desc_ac type(psb_ldspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(inout), optional :: desc_ax ! Local variables integer(psb_ipk_) :: err_act @@ -115,57 +116,99 @@ subroutine mld_d_ptap(a_csr,desc_a,nlaggr,parms,ac,& ! ! 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%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() - nzl = coo_restr%get_nzeros() - nrl = desc_ac%get_local_rows() - i=0 - ! - ! Only keep local rows - ! - do k=1, nzl - if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then - i = i+1 - coo_restr%val(i) = coo_restr%val(k) - coo_restr%ia(i) = coo_restr%ia(k) - coo_restr%ja(i) = coo_restr%ja(k) + if (present(desc_ax)) then + block + type(psb_d_coo_sparse_mat) :: icoo_restr + + call coo_prol%cp_to_icoo(icoo_restr,info) + call icoo_restr%set_ncols(desc_ac%get_local_cols()) + call icoo_restr%set_nrows(desc_a%get_local_rows()) + 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()= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting sphalo/ rwxtd' + + if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& + & csr_restr%get_nrows(),csr_restr%get_ncols(), & + & desc_ac%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_ax,acsr3,ac_csr,desc_ac,info) + if (do_timings) call psb_toc(idx_spspmm) + call acsr3%free() + + else + + ! + ! 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%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() + nzl = coo_restr%get_nzeros() + nrl = desc_ac%get_local_rows() + i=0 + ! + ! Only keep local rows + ! + do k=1, nzl + if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then + i = i+1 + coo_restr%val(i) = coo_restr%val(k) + coo_restr%ia(i) = coo_restr%ia(k) + coo_restr%ja(i) = coo_restr%ja(k) + end if + end do + call coo_restr%set_nzeros(i) + call coo_restr%fix(info) + nzl = coo_restr%get_nzeros() + 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 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 + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') + goto 9999 + end if + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting sphalo/ rwxtd' + + if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& + & csr_restr%get_nrows(),csr_restr%get_ncols(), & + & desc_ac%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,desc_ac,info) + if (do_timings) call psb_toc(idx_spspmm) + call acsr3%free() end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'starting sphalo/ rwxtd' - - if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& - & csr_restr%get_nrows(),csr_restr%get_ncols(), & - & desc_ac%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,desc_ac,info) - if (do_timings) call psb_toc(idx_spspmm) - call acsr3%free() call psb_cdasb(desc_ac,info) @@ -175,11 +218,10 @@ subroutine mld_d_ptap(a_csr,desc_a,nlaggr,parms,ac,& call ac%set_asb() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() - if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),& - & ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr + if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr + ! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros() call coo_prol%set_ncols(desc_ac%get_local_cols()) - if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug_level >= psb_debug_outer_) & @@ -211,7 +253,7 @@ contains end subroutine mld_d_ptap subroutine mld_ld_ptap(a_csr,desc_a,nlaggr,parms,ac,& - & coo_prol,desc_ac,coo_restr,info) + & coo_prol,desc_ac,coo_restr,info,desc_ax) use psb_base_mod use mld_d_inner_mod use mld_d_base_aggregator_mod, mld_protect_name => mld_ld_ptap @@ -219,13 +261,14 @@ subroutine mld_ld_ptap(a_csr,desc_a,nlaggr,parms,ac,& ! Arguments type(psb_ld_csr_sparse_mat), intent(inout) :: a_csr - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: nlaggr(:) type(mld_dml_parms), intent(inout) :: parms type(psb_ld_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr type(psb_desc_type), intent(inout) :: desc_ac type(psb_ldspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(inout), optional :: desc_ax ! Local variables integer(psb_ipk_) :: err_act @@ -290,57 +333,99 @@ subroutine mld_ld_ptap(a_csr,desc_a,nlaggr,parms,ac,& ! ! 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%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() - nzl = coo_restr%get_nzeros() - nrl = desc_ac%get_local_rows() - i=0 - ! - ! Only keep local rows - ! - do k=1, nzl - if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then - i = i+1 - coo_restr%val(i) = coo_restr%val(k) - coo_restr%ia(i) = coo_restr%ia(k) - coo_restr%ja(i) = coo_restr%ja(k) + if (present(desc_ax)) then + block + type(psb_d_coo_sparse_mat) :: icoo_restr + + call coo_prol%cp_to_icoo(icoo_restr,info) + call icoo_restr%set_ncols(desc_ac%get_local_cols()) + call icoo_restr%set_nrows(desc_a%get_local_rows()) + 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()= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting sphalo/ rwxtd' + + if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& + & csr_restr%get_nrows(),csr_restr%get_ncols(), & + & desc_ac%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_ax,acsr3,ac_csr,desc_ac,info) + if (do_timings) call psb_toc(idx_spspmm) + call acsr3%free() + + else + + ! + ! 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%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() + nzl = coo_restr%get_nzeros() + nrl = desc_ac%get_local_rows() + i=0 + ! + ! Only keep local rows + ! + do k=1, nzl + if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then + i = i+1 + coo_restr%val(i) = coo_restr%val(k) + coo_restr%ia(i) = coo_restr%ia(k) + coo_restr%ja(i) = coo_restr%ja(k) + end if + end do + call coo_restr%set_nzeros(i) + call coo_restr%fix(info) + nzl = coo_restr%get_nzeros() + 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 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 + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') + goto 9999 + end if + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting sphalo/ rwxtd' + + if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& + & csr_restr%get_nrows(),csr_restr%get_ncols(), & + & desc_ac%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,desc_ac,info) + if (do_timings) call psb_toc(idx_spspmm) + call acsr3%free() end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'starting sphalo/ rwxtd' - - if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& - & csr_restr%get_nrows(),csr_restr%get_ncols(), & - & desc_ac%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,desc_ac,info) - if (do_timings) call psb_toc(idx_spspmm) - call acsr3%free() call psb_cdasb(desc_ac,info) diff --git a/mlprec/impl/aggregator/mld_daggrmat_minnrg_bld.f90 b/mlprec/impl/aggregator/mld_daggrmat_minnrg_bld.f90 index dac54e8f..468dacb1 100644 --- a/mlprec/impl/aggregator/mld_daggrmat_minnrg_bld.f90 +++ b/mlprec/impl/aggregator/mld_daggrmat_minnrg_bld.f90 @@ -104,7 +104,8 @@ ! Error code. ! ! -subroutine mld_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) +subroutine mld_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,& + & ac,desc_ac,op_prol,op_restr,info) use psb_base_mod use mld_base_prec_type use mld_d_inner_mod, mld_protect_name => mld_daggrmat_minnrg_bld @@ -113,11 +114,12 @@ subroutine mld_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re ! Arguments type(psb_dspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) type(mld_dml_parms), intent(inout) :: parms type(psb_ldspmat_type), intent(inout) :: op_prol type(psb_ldspmat_type), intent(out) :: ac,op_restr + type(psb_desc_type), intent(inout) :: desc_ac integer(psb_ipk_), intent(out) :: info ! Local variables diff --git a/mlprec/impl/aggregator/mld_daggrmat_nosmth_bld.f90 b/mlprec/impl/aggregator/mld_daggrmat_nosmth_bld.f90 index ff6eb6e1..fe7d9e77 100644 --- a/mlprec/impl/aggregator/mld_daggrmat_nosmth_bld.f90 +++ b/mlprec/impl/aggregator/mld_daggrmat_nosmth_bld.f90 @@ -106,7 +106,7 @@ subroutine mld_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,& ! Arguments type(psb_dspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) type(mld_dml_parms), intent(inout) :: parms type(psb_ldspmat_type), intent(inout) :: op_prol diff --git a/mlprec/impl/aggregator/mld_daggrmat_smth_bld.f90 b/mlprec/impl/aggregator/mld_daggrmat_smth_bld.f90 index 70d7e7b4..874c8134 100644 --- a/mlprec/impl/aggregator/mld_daggrmat_smth_bld.f90 +++ b/mlprec/impl/aggregator/mld_daggrmat_smth_bld.f90 @@ -113,7 +113,7 @@ subroutine mld_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& ! Arguments type(psb_dspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) type(mld_dml_parms), intent(inout) :: parms type(psb_ldspmat_type), intent(inout) :: op_prol diff --git a/mlprec/impl/aggregator/mld_s_ptap.f90 b/mlprec/impl/aggregator/mld_s_ptap.f90 index b1284d28..1a6f709e 100644 --- a/mlprec/impl/aggregator/mld_s_ptap.f90 +++ b/mlprec/impl/aggregator/mld_s_ptap.f90 @@ -36,7 +36,7 @@ ! ! subroutine mld_s_ptap(a_csr,desc_a,nlaggr,parms,ac,& - & coo_prol,desc_ac,coo_restr,info) + & coo_prol,desc_ac,coo_restr,info,desc_ax) use psb_base_mod use mld_s_inner_mod use mld_s_base_aggregator_mod, mld_protect_name => mld_s_ptap @@ -44,13 +44,14 @@ subroutine mld_s_ptap(a_csr,desc_a,nlaggr,parms,ac,& ! Arguments type(psb_s_csr_sparse_mat), intent(inout) :: a_csr - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: nlaggr(:) type(mld_sml_parms), intent(inout) :: parms type(psb_ls_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr type(psb_desc_type), intent(inout) :: desc_ac type(psb_lsspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(inout), optional :: desc_ax ! Local variables integer(psb_ipk_) :: err_act @@ -115,57 +116,99 @@ subroutine mld_s_ptap(a_csr,desc_a,nlaggr,parms,ac,& ! ! 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%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() - nzl = coo_restr%get_nzeros() - nrl = desc_ac%get_local_rows() - i=0 - ! - ! Only keep local rows - ! - do k=1, nzl - if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then - i = i+1 - coo_restr%val(i) = coo_restr%val(k) - coo_restr%ia(i) = coo_restr%ia(k) - coo_restr%ja(i) = coo_restr%ja(k) + if (present(desc_ax)) then + block + type(psb_s_coo_sparse_mat) :: icoo_restr + + call coo_prol%cp_to_icoo(icoo_restr,info) + call icoo_restr%set_ncols(desc_ac%get_local_cols()) + call icoo_restr%set_nrows(desc_a%get_local_rows()) + 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()= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting sphalo/ rwxtd' + + if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& + & csr_restr%get_nrows(),csr_restr%get_ncols(), & + & desc_ac%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_ax,acsr3,ac_csr,desc_ac,info) + if (do_timings) call psb_toc(idx_spspmm) + call acsr3%free() + + else + + ! + ! 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%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() + nzl = coo_restr%get_nzeros() + nrl = desc_ac%get_local_rows() + i=0 + ! + ! Only keep local rows + ! + do k=1, nzl + if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then + i = i+1 + coo_restr%val(i) = coo_restr%val(k) + coo_restr%ia(i) = coo_restr%ia(k) + coo_restr%ja(i) = coo_restr%ja(k) + end if + end do + call coo_restr%set_nzeros(i) + call coo_restr%fix(info) + nzl = coo_restr%get_nzeros() + 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 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 + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') + goto 9999 + end if + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting sphalo/ rwxtd' + + if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& + & csr_restr%get_nrows(),csr_restr%get_ncols(), & + & desc_ac%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,desc_ac,info) + if (do_timings) call psb_toc(idx_spspmm) + call acsr3%free() end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'starting sphalo/ rwxtd' - - if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& - & csr_restr%get_nrows(),csr_restr%get_ncols(), & - & desc_ac%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,desc_ac,info) - if (do_timings) call psb_toc(idx_spspmm) - call acsr3%free() call psb_cdasb(desc_ac,info) @@ -175,11 +218,10 @@ subroutine mld_s_ptap(a_csr,desc_a,nlaggr,parms,ac,& call ac%set_asb() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() - if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),& - & ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr + if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr + ! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros() call coo_prol%set_ncols(desc_ac%get_local_cols()) - if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug_level >= psb_debug_outer_) & @@ -211,7 +253,7 @@ contains end subroutine mld_s_ptap subroutine mld_ls_ptap(a_csr,desc_a,nlaggr,parms,ac,& - & coo_prol,desc_ac,coo_restr,info) + & coo_prol,desc_ac,coo_restr,info,desc_ax) use psb_base_mod use mld_s_inner_mod use mld_s_base_aggregator_mod, mld_protect_name => mld_ls_ptap @@ -219,13 +261,14 @@ subroutine mld_ls_ptap(a_csr,desc_a,nlaggr,parms,ac,& ! Arguments type(psb_ls_csr_sparse_mat), intent(inout) :: a_csr - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: nlaggr(:) type(mld_sml_parms), intent(inout) :: parms type(psb_ls_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr type(psb_desc_type), intent(inout) :: desc_ac type(psb_lsspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(inout), optional :: desc_ax ! Local variables integer(psb_ipk_) :: err_act @@ -290,57 +333,99 @@ subroutine mld_ls_ptap(a_csr,desc_a,nlaggr,parms,ac,& ! ! 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%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() - nzl = coo_restr%get_nzeros() - nrl = desc_ac%get_local_rows() - i=0 - ! - ! Only keep local rows - ! - do k=1, nzl - if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then - i = i+1 - coo_restr%val(i) = coo_restr%val(k) - coo_restr%ia(i) = coo_restr%ia(k) - coo_restr%ja(i) = coo_restr%ja(k) + if (present(desc_ax)) then + block + type(psb_s_coo_sparse_mat) :: icoo_restr + + call coo_prol%cp_to_icoo(icoo_restr,info) + call icoo_restr%set_ncols(desc_ac%get_local_cols()) + call icoo_restr%set_nrows(desc_a%get_local_rows()) + 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()= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting sphalo/ rwxtd' + + if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& + & csr_restr%get_nrows(),csr_restr%get_ncols(), & + & desc_ac%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_ax,acsr3,ac_csr,desc_ac,info) + if (do_timings) call psb_toc(idx_spspmm) + call acsr3%free() + + else + + ! + ! 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%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() + nzl = coo_restr%get_nzeros() + nrl = desc_ac%get_local_rows() + i=0 + ! + ! Only keep local rows + ! + do k=1, nzl + if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then + i = i+1 + coo_restr%val(i) = coo_restr%val(k) + coo_restr%ia(i) = coo_restr%ia(k) + coo_restr%ja(i) = coo_restr%ja(k) + end if + end do + call coo_restr%set_nzeros(i) + call coo_restr%fix(info) + nzl = coo_restr%get_nzeros() + 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 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 + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') + goto 9999 + end if + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting sphalo/ rwxtd' + + if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& + & csr_restr%get_nrows(),csr_restr%get_ncols(), & + & desc_ac%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,desc_ac,info) + if (do_timings) call psb_toc(idx_spspmm) + call acsr3%free() end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'starting sphalo/ rwxtd' - - if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& - & csr_restr%get_nrows(),csr_restr%get_ncols(), & - & desc_ac%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,desc_ac,info) - if (do_timings) call psb_toc(idx_spspmm) - call acsr3%free() call psb_cdasb(desc_ac,info) diff --git a/mlprec/impl/aggregator/mld_saggrmat_minnrg_bld.f90 b/mlprec/impl/aggregator/mld_saggrmat_minnrg_bld.f90 index 4f765e85..ce7a4e68 100644 --- a/mlprec/impl/aggregator/mld_saggrmat_minnrg_bld.f90 +++ b/mlprec/impl/aggregator/mld_saggrmat_minnrg_bld.f90 @@ -104,7 +104,8 @@ ! Error code. ! ! -subroutine mld_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) +subroutine mld_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,& + & ac,desc_ac,op_prol,op_restr,info) use psb_base_mod use mld_base_prec_type use mld_s_inner_mod, mld_protect_name => mld_saggrmat_minnrg_bld @@ -113,11 +114,12 @@ subroutine mld_saggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re ! Arguments type(psb_sspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) type(mld_sml_parms), intent(inout) :: parms type(psb_lsspmat_type), intent(inout) :: op_prol type(psb_lsspmat_type), intent(out) :: ac,op_restr + type(psb_desc_type), intent(inout) :: desc_ac integer(psb_ipk_), intent(out) :: info ! Local variables diff --git a/mlprec/impl/aggregator/mld_saggrmat_nosmth_bld.f90 b/mlprec/impl/aggregator/mld_saggrmat_nosmth_bld.f90 index 8f7d6d6a..2bf967a2 100644 --- a/mlprec/impl/aggregator/mld_saggrmat_nosmth_bld.f90 +++ b/mlprec/impl/aggregator/mld_saggrmat_nosmth_bld.f90 @@ -106,7 +106,7 @@ subroutine mld_saggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,& ! Arguments type(psb_sspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) type(mld_sml_parms), intent(inout) :: parms type(psb_lsspmat_type), intent(inout) :: op_prol diff --git a/mlprec/impl/aggregator/mld_saggrmat_smth_bld.f90 b/mlprec/impl/aggregator/mld_saggrmat_smth_bld.f90 index b44f59d1..df2beec2 100644 --- a/mlprec/impl/aggregator/mld_saggrmat_smth_bld.f90 +++ b/mlprec/impl/aggregator/mld_saggrmat_smth_bld.f90 @@ -113,7 +113,7 @@ subroutine mld_saggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& ! Arguments type(psb_sspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) type(mld_sml_parms), intent(inout) :: parms type(psb_lsspmat_type), intent(inout) :: op_prol diff --git a/mlprec/impl/aggregator/mld_z_ptap.f90 b/mlprec/impl/aggregator/mld_z_ptap.f90 index 432366b5..404afa46 100644 --- a/mlprec/impl/aggregator/mld_z_ptap.f90 +++ b/mlprec/impl/aggregator/mld_z_ptap.f90 @@ -36,7 +36,7 @@ ! ! subroutine mld_z_ptap(a_csr,desc_a,nlaggr,parms,ac,& - & coo_prol,desc_ac,coo_restr,info) + & coo_prol,desc_ac,coo_restr,info,desc_ax) use psb_base_mod use mld_z_inner_mod use mld_z_base_aggregator_mod, mld_protect_name => mld_z_ptap @@ -44,13 +44,14 @@ subroutine mld_z_ptap(a_csr,desc_a,nlaggr,parms,ac,& ! Arguments type(psb_z_csr_sparse_mat), intent(inout) :: a_csr - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: nlaggr(:) type(mld_dml_parms), intent(inout) :: parms type(psb_lz_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr type(psb_desc_type), intent(inout) :: desc_ac type(psb_lzspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(inout), optional :: desc_ax ! Local variables integer(psb_ipk_) :: err_act @@ -115,57 +116,99 @@ subroutine mld_z_ptap(a_csr,desc_a,nlaggr,parms,ac,& ! ! 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%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() - nzl = coo_restr%get_nzeros() - nrl = desc_ac%get_local_rows() - i=0 - ! - ! Only keep local rows - ! - do k=1, nzl - if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then - i = i+1 - coo_restr%val(i) = coo_restr%val(k) - coo_restr%ia(i) = coo_restr%ia(k) - coo_restr%ja(i) = coo_restr%ja(k) + if (present(desc_ax)) then + block + type(psb_z_coo_sparse_mat) :: icoo_restr + + call coo_prol%cp_to_icoo(icoo_restr,info) + call icoo_restr%set_ncols(desc_ac%get_local_cols()) + call icoo_restr%set_nrows(desc_a%get_local_rows()) + 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()= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting sphalo/ rwxtd' + + if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& + & csr_restr%get_nrows(),csr_restr%get_ncols(), & + & desc_ac%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_ax,acsr3,ac_csr,desc_ac,info) + if (do_timings) call psb_toc(idx_spspmm) + call acsr3%free() + + else + + ! + ! 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%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() + nzl = coo_restr%get_nzeros() + nrl = desc_ac%get_local_rows() + i=0 + ! + ! Only keep local rows + ! + do k=1, nzl + if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then + i = i+1 + coo_restr%val(i) = coo_restr%val(k) + coo_restr%ia(i) = coo_restr%ia(k) + coo_restr%ja(i) = coo_restr%ja(k) + end if + end do + call coo_restr%set_nzeros(i) + call coo_restr%fix(info) + nzl = coo_restr%get_nzeros() + 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 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 + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') + goto 9999 + end if + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting sphalo/ rwxtd' + + if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& + & csr_restr%get_nrows(),csr_restr%get_ncols(), & + & desc_ac%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,desc_ac,info) + if (do_timings) call psb_toc(idx_spspmm) + call acsr3%free() end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'starting sphalo/ rwxtd' - - if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& - & csr_restr%get_nrows(),csr_restr%get_ncols(), & - & desc_ac%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,desc_ac,info) - if (do_timings) call psb_toc(idx_spspmm) - call acsr3%free() call psb_cdasb(desc_ac,info) @@ -175,11 +218,10 @@ subroutine mld_z_ptap(a_csr,desc_a,nlaggr,parms,ac,& call ac%set_asb() if (debug) write(0,*) me,' ',trim(name),' After mv_from',psb_get_errstatus() - if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),& - & ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr + if (debug) write(0,*) me,' ',trim(name),' ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros(),naggr,ntaggr + ! write(0,*) me,' ',trim(name),' Final AC newstyle ',ac%get_fmt(),ac%get_nrows(),ac%get_ncols(),ac%get_nzeros() call coo_prol%set_ncols(desc_ac%get_local_cols()) - if (debug) call check_coo(me,trim(name)//' Check 3 on coo_restr:',coo_restr) if (debug_level >= psb_debug_outer_) & @@ -211,7 +253,7 @@ contains end subroutine mld_z_ptap subroutine mld_lz_ptap(a_csr,desc_a,nlaggr,parms,ac,& - & coo_prol,desc_ac,coo_restr,info) + & coo_prol,desc_ac,coo_restr,info,desc_ax) use psb_base_mod use mld_z_inner_mod use mld_z_base_aggregator_mod, mld_protect_name => mld_lz_ptap @@ -219,13 +261,14 @@ subroutine mld_lz_ptap(a_csr,desc_a,nlaggr,parms,ac,& ! Arguments type(psb_lz_csr_sparse_mat), intent(inout) :: a_csr - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: nlaggr(:) type(mld_dml_parms), intent(inout) :: parms type(psb_lz_coo_sparse_mat), intent(inout) :: coo_prol, coo_restr type(psb_desc_type), intent(inout) :: desc_ac type(psb_lzspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(inout), optional :: desc_ax ! Local variables integer(psb_ipk_) :: err_act @@ -290,57 +333,99 @@ subroutine mld_lz_ptap(a_csr,desc_a,nlaggr,parms,ac,& ! ! 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%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() - nzl = coo_restr%get_nzeros() - nrl = desc_ac%get_local_rows() - i=0 - ! - ! Only keep local rows - ! - do k=1, nzl - if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then - i = i+1 - coo_restr%val(i) = coo_restr%val(k) - coo_restr%ia(i) = coo_restr%ia(k) - coo_restr%ja(i) = coo_restr%ja(k) + if (present(desc_ax)) then + block + type(psb_z_coo_sparse_mat) :: icoo_restr + + call coo_prol%cp_to_icoo(icoo_restr,info) + call icoo_restr%set_ncols(desc_ac%get_local_cols()) + call icoo_restr%set_nrows(desc_a%get_local_rows()) + 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()= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting sphalo/ rwxtd' + + if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& + & csr_restr%get_nrows(),csr_restr%get_ncols(), & + & desc_ac%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_ax,acsr3,ac_csr,desc_ac,info) + if (do_timings) call psb_toc(idx_spspmm) + call acsr3%free() + + else + + ! + ! 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%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() + nzl = coo_restr%get_nzeros() + nrl = desc_ac%get_local_rows() + i=0 + ! + ! Only keep local rows + ! + do k=1, nzl + if ((1 <= coo_restr%ia(k)) .and.(coo_restr%ia(k) <= nrl)) then + i = i+1 + coo_restr%val(i) = coo_restr%val(k) + coo_restr%ia(i) = coo_restr%ia(k) + coo_restr%ja(i) = coo_restr%ja(k) + end if + end do + call coo_restr%set_nzeros(i) + call coo_restr%fix(info) + nzl = coo_restr%get_nzeros() + 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 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 + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv coo_restr') + goto 9999 + end if + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),& + & 'starting sphalo/ rwxtd' + + if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& + & csr_restr%get_nrows(),csr_restr%get_ncols(), & + & desc_ac%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,desc_ac,info) + if (do_timings) call psb_toc(idx_spspmm) + call acsr3%free() end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'starting sphalo/ rwxtd' - - if (debug) write(0,*) me,trim(name),' Product RESTRxAP ',& - & csr_restr%get_nrows(),csr_restr%get_ncols(), & - & desc_ac%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,desc_ac,info) - if (do_timings) call psb_toc(idx_spspmm) - call acsr3%free() call psb_cdasb(desc_ac,info) diff --git a/mlprec/impl/aggregator/mld_zaggrmat_minnrg_bld.f90 b/mlprec/impl/aggregator/mld_zaggrmat_minnrg_bld.f90 index 76bdcc7c..c7dc4b5b 100644 --- a/mlprec/impl/aggregator/mld_zaggrmat_minnrg_bld.f90 +++ b/mlprec/impl/aggregator/mld_zaggrmat_minnrg_bld.f90 @@ -104,7 +104,8 @@ ! Error code. ! ! -subroutine mld_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) +subroutine mld_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,& + & ac,desc_ac,op_prol,op_restr,info) use psb_base_mod use mld_base_prec_type use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_minnrg_bld @@ -113,11 +114,12 @@ subroutine mld_zaggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re ! Arguments type(psb_zspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) type(mld_dml_parms), intent(inout) :: parms type(psb_lzspmat_type), intent(inout) :: op_prol type(psb_lzspmat_type), intent(out) :: ac,op_restr + type(psb_desc_type), intent(inout) :: desc_ac integer(psb_ipk_), intent(out) :: info ! Local variables diff --git a/mlprec/impl/aggregator/mld_zaggrmat_nosmth_bld.f90 b/mlprec/impl/aggregator/mld_zaggrmat_nosmth_bld.f90 index c939ac0d..c04993a4 100644 --- a/mlprec/impl/aggregator/mld_zaggrmat_nosmth_bld.f90 +++ b/mlprec/impl/aggregator/mld_zaggrmat_nosmth_bld.f90 @@ -106,7 +106,7 @@ subroutine mld_zaggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,& ! Arguments type(psb_zspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) type(mld_dml_parms), intent(inout) :: parms type(psb_lzspmat_type), intent(inout) :: op_prol diff --git a/mlprec/impl/aggregator/mld_zaggrmat_smth_bld.f90 b/mlprec/impl/aggregator/mld_zaggrmat_smth_bld.f90 index 551a8a6a..f968e573 100644 --- a/mlprec/impl/aggregator/mld_zaggrmat_smth_bld.f90 +++ b/mlprec/impl/aggregator/mld_zaggrmat_smth_bld.f90 @@ -113,7 +113,7 @@ subroutine mld_zaggrmat_smth_bld(a,desc_a,ilaggr,nlaggr,parms,& ! Arguments type(psb_zspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) type(mld_dml_parms), intent(inout) :: parms type(psb_lzspmat_type), intent(inout) :: op_prol diff --git a/mlprec/mld_c_base_aggregator_mod.f90 b/mlprec/mld_c_base_aggregator_mod.f90 index 9bee9368..88f9c132 100644 --- a/mlprec/mld_c_base_aggregator_mod.f90 +++ b/mlprec/mld_c_base_aggregator_mod.f90 @@ -152,7 +152,7 @@ module mld_c_base_aggregator_mod interface mld_ptap subroutine mld_c_ptap(a_csr,desc_a,nlaggr,parms,ac,& - & coo_prol,desc_cprol,coo_restr,info) + & coo_prol,desc_cprol,coo_restr,info,desc_ax) import :: psb_c_csr_sparse_mat, psb_lcspmat_type, psb_desc_type, & & psb_lc_coo_sparse_mat, mld_sml_parms, psb_spk_, psb_ipk_, psb_lpk_ implicit none @@ -164,9 +164,10 @@ module mld_c_base_aggregator_mod type(psb_desc_type), intent(inout) :: desc_cprol type(psb_lcspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(inout), optional :: desc_ax end subroutine mld_c_ptap subroutine mld_lc_ptap(a_csr,desc_a,nlaggr,parms,ac,& - & coo_prol,desc_cprol,coo_restr,info) + & coo_prol,desc_cprol,coo_restr,info,desc_ax) import :: psb_lc_csr_sparse_mat, psb_lcspmat_type, psb_desc_type, & & psb_lc_coo_sparse_mat, mld_sml_parms, psb_spk_, psb_ipk_, psb_lpk_ implicit none @@ -178,6 +179,7 @@ module mld_c_base_aggregator_mod type(psb_desc_type), intent(inout) :: desc_cprol type(psb_lcspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(inout), optional :: desc_ax end subroutine mld_lc_ptap end interface mld_ptap diff --git a/mlprec/mld_c_inner_mod.f90 b/mlprec/mld_c_inner_mod.f90 index 95c6f396..ba357f02 100644 --- a/mlprec/mld_c_inner_mod.f90 +++ b/mlprec/mld_c_inner_mod.f90 @@ -115,7 +115,7 @@ module mld_c_inner_mod import :: mld_c_onelev_type, mld_sml_parms implicit none type(psb_cspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) type(mld_sml_parms), intent(inout) :: parms type(psb_lcspmat_type), intent(inout) :: op_prol diff --git a/mlprec/mld_d_base_aggregator_mod.f90 b/mlprec/mld_d_base_aggregator_mod.f90 index 21231e3a..842af868 100644 --- a/mlprec/mld_d_base_aggregator_mod.f90 +++ b/mlprec/mld_d_base_aggregator_mod.f90 @@ -152,7 +152,7 @@ module mld_d_base_aggregator_mod interface mld_ptap subroutine mld_d_ptap(a_csr,desc_a,nlaggr,parms,ac,& - & coo_prol,desc_cprol,coo_restr,info) + & coo_prol,desc_cprol,coo_restr,info,desc_ax) import :: psb_d_csr_sparse_mat, psb_ldspmat_type, psb_desc_type, & & psb_ld_coo_sparse_mat, mld_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_ implicit none @@ -164,9 +164,10 @@ module mld_d_base_aggregator_mod type(psb_desc_type), intent(inout) :: desc_cprol type(psb_ldspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(inout), optional :: desc_ax end subroutine mld_d_ptap subroutine mld_ld_ptap(a_csr,desc_a,nlaggr,parms,ac,& - & coo_prol,desc_cprol,coo_restr,info) + & coo_prol,desc_cprol,coo_restr,info,desc_ax) import :: psb_ld_csr_sparse_mat, psb_ldspmat_type, psb_desc_type, & & psb_ld_coo_sparse_mat, mld_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_ implicit none @@ -178,6 +179,7 @@ module mld_d_base_aggregator_mod type(psb_desc_type), intent(inout) :: desc_cprol type(psb_ldspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(inout), optional :: desc_ax end subroutine mld_ld_ptap end interface mld_ptap diff --git a/mlprec/mld_d_inner_mod.f90 b/mlprec/mld_d_inner_mod.f90 index c839ec00..a6606a01 100644 --- a/mlprec/mld_d_inner_mod.f90 +++ b/mlprec/mld_d_inner_mod.f90 @@ -115,7 +115,7 @@ module mld_d_inner_mod import :: mld_d_onelev_type, mld_dml_parms implicit none type(psb_dspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) type(mld_dml_parms), intent(inout) :: parms type(psb_ldspmat_type), intent(inout) :: op_prol diff --git a/mlprec/mld_s_base_aggregator_mod.f90 b/mlprec/mld_s_base_aggregator_mod.f90 index e277bd10..57300bb0 100644 --- a/mlprec/mld_s_base_aggregator_mod.f90 +++ b/mlprec/mld_s_base_aggregator_mod.f90 @@ -152,7 +152,7 @@ module mld_s_base_aggregator_mod interface mld_ptap subroutine mld_s_ptap(a_csr,desc_a,nlaggr,parms,ac,& - & coo_prol,desc_cprol,coo_restr,info) + & coo_prol,desc_cprol,coo_restr,info,desc_ax) import :: psb_s_csr_sparse_mat, psb_lsspmat_type, psb_desc_type, & & psb_ls_coo_sparse_mat, mld_sml_parms, psb_spk_, psb_ipk_, psb_lpk_ implicit none @@ -164,9 +164,10 @@ module mld_s_base_aggregator_mod type(psb_desc_type), intent(inout) :: desc_cprol type(psb_lsspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(inout), optional :: desc_ax end subroutine mld_s_ptap subroutine mld_ls_ptap(a_csr,desc_a,nlaggr,parms,ac,& - & coo_prol,desc_cprol,coo_restr,info) + & coo_prol,desc_cprol,coo_restr,info,desc_ax) import :: psb_ls_csr_sparse_mat, psb_lsspmat_type, psb_desc_type, & & psb_ls_coo_sparse_mat, mld_sml_parms, psb_spk_, psb_ipk_, psb_lpk_ implicit none @@ -178,6 +179,7 @@ module mld_s_base_aggregator_mod type(psb_desc_type), intent(inout) :: desc_cprol type(psb_lsspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(inout), optional :: desc_ax end subroutine mld_ls_ptap end interface mld_ptap diff --git a/mlprec/mld_s_inner_mod.f90 b/mlprec/mld_s_inner_mod.f90 index 03d7d78b..f671607b 100644 --- a/mlprec/mld_s_inner_mod.f90 +++ b/mlprec/mld_s_inner_mod.f90 @@ -115,7 +115,7 @@ module mld_s_inner_mod import :: mld_s_onelev_type, mld_sml_parms implicit none type(psb_sspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) type(mld_sml_parms), intent(inout) :: parms type(psb_lsspmat_type), intent(inout) :: op_prol diff --git a/mlprec/mld_z_base_aggregator_mod.f90 b/mlprec/mld_z_base_aggregator_mod.f90 index ef5c39e1..a0a72da2 100644 --- a/mlprec/mld_z_base_aggregator_mod.f90 +++ b/mlprec/mld_z_base_aggregator_mod.f90 @@ -152,7 +152,7 @@ module mld_z_base_aggregator_mod interface mld_ptap subroutine mld_z_ptap(a_csr,desc_a,nlaggr,parms,ac,& - & coo_prol,desc_cprol,coo_restr,info) + & coo_prol,desc_cprol,coo_restr,info,desc_ax) import :: psb_z_csr_sparse_mat, psb_lzspmat_type, psb_desc_type, & & psb_lz_coo_sparse_mat, mld_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_ implicit none @@ -164,9 +164,10 @@ module mld_z_base_aggregator_mod type(psb_desc_type), intent(inout) :: desc_cprol type(psb_lzspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(inout), optional :: desc_ax end subroutine mld_z_ptap subroutine mld_lz_ptap(a_csr,desc_a,nlaggr,parms,ac,& - & coo_prol,desc_cprol,coo_restr,info) + & coo_prol,desc_cprol,coo_restr,info,desc_ax) import :: psb_lz_csr_sparse_mat, psb_lzspmat_type, psb_desc_type, & & psb_lz_coo_sparse_mat, mld_dml_parms, psb_dpk_, psb_ipk_, psb_lpk_ implicit none @@ -178,6 +179,7 @@ module mld_z_base_aggregator_mod type(psb_desc_type), intent(inout) :: desc_cprol type(psb_lzspmat_type), intent(out) :: ac integer(psb_ipk_), intent(out) :: info + type(psb_desc_type), intent(inout), optional :: desc_ax end subroutine mld_lz_ptap end interface mld_ptap diff --git a/mlprec/mld_z_inner_mod.f90 b/mlprec/mld_z_inner_mod.f90 index c1e8632b..dd2cff3b 100644 --- a/mlprec/mld_z_inner_mod.f90 +++ b/mlprec/mld_z_inner_mod.f90 @@ -115,7 +115,7 @@ module mld_z_inner_mod import :: mld_z_onelev_type, mld_dml_parms implicit none type(psb_zspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a + type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) type(mld_dml_parms), intent(inout) :: parms type(psb_lzspmat_type), intent(inout) :: op_prol