From 028ccea2e378e3399aa0c30f553afad7cb4acf2e Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 22 Apr 2020 10:37:56 +0100 Subject: [PATCH 1/2] Fix handling of aggregator/smoother parms upon resizing --- mlprec/impl/mld_c_hierarchy_bld.f90 | 43 ++++++++++++++++------------- mlprec/impl/mld_d_hierarchy_bld.f90 | 43 ++++++++++++++++------------- mlprec/impl/mld_s_hierarchy_bld.f90 | 43 ++++++++++++++++------------- mlprec/impl/mld_z_hierarchy_bld.f90 | 43 ++++++++++++++++------------- 4 files changed, 96 insertions(+), 76 deletions(-) diff --git a/mlprec/impl/mld_c_hierarchy_bld.f90 b/mlprec/impl/mld_c_hierarchy_bld.f90 index f9678195..c05e4c41 100644 --- a/mlprec/impl/mld_c_hierarchy_bld.f90 +++ b/mlprec/impl/mld_c_hierarchy_bld.f90 @@ -83,15 +83,17 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info) & nplevs, mxplevs integer(psb_lpk_) :: iaggsize, casize real(psb_spk_) :: mnaggratio, sizeratio, athresh, aomega - class(mld_c_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, & - & base_sm2, med_sm2, coarse_sm2 + class(mld_c_base_smoother_type), allocatable :: coarse_sm, med_sm, & + & med_sm2, coarse_sm2 class(mld_c_base_aggregator_type), allocatable :: tmp_aggr - type(mld_sml_parms) :: baseparms, medparms, coarseparms + type(mld_sml_parms) :: medparms, coarseparms integer(psb_lpk_), allocatable :: ilaggr(:), nlaggr(:) type(psb_lcspmat_type) :: op_prol type(mld_c_onelev_type), allocatable :: tprecv(:) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err + integer(psb_ipk_), save :: idx_bldtp=-1, idx_matasb=-1 + logical, parameter :: do_timings=.false. info=psb_success_ err=0 @@ -110,6 +112,10 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Entering ' + if ((do_timings).and.(idx_bldtp==-1)) & + & idx_bldtp = psb_get_timer_idx("BLD_HIER: bld_tprol") + if ((do_timings).and.(idx_matasb==-1)) & + & idx_matasb = psb_get_timer_idx("BLD_HIER: mmat_asb") ! if (.not.allocated(prec%precv)) then @@ -207,15 +213,12 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info) end if nplevs = max(itwo,mxplevs) + ! + ! The coarse parameters will be needed later + ! coarseparms = prec%precv(iszv)%parms - baseparms = prec%precv(1)%parms - medparms = prec%precv(2)%parms - call save_smoothers(prec%precv(iszv),coarse_sm,coarse_sm2,info) - if (info == 0) call save_smoothers(prec%precv(2),med_sm,med_sm2,info) - if (info == 0) call save_smoothers(prec%precv(1),base_sm,base_sm2,info) if (info /= psb_success_) then - write(0,*) 'Error in saving smoothers',info call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') goto 9999 end if @@ -225,19 +228,17 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info) if (iszv /= nplevs) then allocate(tprecv(nplevs),stat=info) ! First all existing levels - if (info == 0) tprecv(1)%parms = baseparms - if (info == 0) call restore_smoothers(tprecv(1),& - & prec%precv(1)%sm,prec%precv(1)%sm2a,info) - if (info == 0) call move_alloc(prec%precv(1)%aggr,tprecv(1)%aggr) - do i=2, min(iszv,nplevs) - 1 - if (info == 0) tprecv(i)%parms = medparms + do i=1, min(iszv,nplevs) - 1 + if (info == 0) tprecv(i)%parms = prec%precv(i)%parms if (info == 0) call restore_smoothers(tprecv(i),& & prec%precv(i)%sm,prec%precv(i)%sm2a,info) if (info == 0) call move_alloc(prec%precv(i)%aggr,tprecv(i)%aggr) end do if (iszv < nplevs) then + ! Further intermediates, if needed allocate(tmp_aggr,source=tprecv(iszv-1)%aggr,stat=info) - ! Further intermediates, if any + medparms = prec%precv(iszv-1)%parms + call save_smoothers(prec%precv(iszv-1),med_sm,med_sm2,info) do i=iszv, nplevs - 1 if (info == 0) tprecv(i)%parms = medparms if (info == 0) call restore_smoothers(tprecv(i),med_sm,med_sm2,info) @@ -302,11 +303,12 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info) ! Build the mapping between levels i-1 and i and the matrix ! at level i ! + if (do_timings) call psb_tic(idx_bldtp) if (info == psb_success_)& & call prec%precv(i)%bld_tprol(prec%precv(i-1)%base_a,& & prec%precv(i-1)%base_desc,& & ilaggr,nlaggr,op_prol,prec%ag_data,info) - + if (do_timings) call psb_toc(idx_bldtp) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Map build') @@ -387,20 +389,23 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info) nlaggr = prec%precv(newsz)%map%naggr call prec%precv(newsz)%tprol%clone(op_prol,info) end if - + if (do_timings) call psb_tic(idx_matasb) if (info == psb_success_) call prec%precv(newsz)%mat_asb( & & prec%precv(newsz-1)%base_a,prec%precv(newsz-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) + if (do_timings) call psb_toc(idx_matasb) if (info /= 0) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Mat asb') goto 9999 endif exit array_build_loop - else + else + if (do_timings) call psb_tic(idx_matasb) if (info == psb_success_) call prec%precv(i)%mat_asb(& & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) + if (do_timings) call psb_toc(idx_matasb) end if if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/mld_d_hierarchy_bld.f90 b/mlprec/impl/mld_d_hierarchy_bld.f90 index ca76f75d..0d6d174a 100644 --- a/mlprec/impl/mld_d_hierarchy_bld.f90 +++ b/mlprec/impl/mld_d_hierarchy_bld.f90 @@ -83,15 +83,17 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info) & nplevs, mxplevs integer(psb_lpk_) :: iaggsize, casize real(psb_dpk_) :: mnaggratio, sizeratio, athresh, aomega - class(mld_d_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, & - & base_sm2, med_sm2, coarse_sm2 + class(mld_d_base_smoother_type), allocatable :: coarse_sm, med_sm, & + & med_sm2, coarse_sm2 class(mld_d_base_aggregator_type), allocatable :: tmp_aggr - type(mld_dml_parms) :: baseparms, medparms, coarseparms + type(mld_dml_parms) :: medparms, coarseparms integer(psb_lpk_), allocatable :: ilaggr(:), nlaggr(:) type(psb_ldspmat_type) :: op_prol type(mld_d_onelev_type), allocatable :: tprecv(:) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err + integer(psb_ipk_), save :: idx_bldtp=-1, idx_matasb=-1 + logical, parameter :: do_timings=.false. info=psb_success_ err=0 @@ -110,6 +112,10 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Entering ' + if ((do_timings).and.(idx_bldtp==-1)) & + & idx_bldtp = psb_get_timer_idx("BLD_HIER: bld_tprol") + if ((do_timings).and.(idx_matasb==-1)) & + & idx_matasb = psb_get_timer_idx("BLD_HIER: mmat_asb") ! if (.not.allocated(prec%precv)) then @@ -207,15 +213,12 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info) end if nplevs = max(itwo,mxplevs) + ! + ! The coarse parameters will be needed later + ! coarseparms = prec%precv(iszv)%parms - baseparms = prec%precv(1)%parms - medparms = prec%precv(2)%parms - call save_smoothers(prec%precv(iszv),coarse_sm,coarse_sm2,info) - if (info == 0) call save_smoothers(prec%precv(2),med_sm,med_sm2,info) - if (info == 0) call save_smoothers(prec%precv(1),base_sm,base_sm2,info) if (info /= psb_success_) then - write(0,*) 'Error in saving smoothers',info call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') goto 9999 end if @@ -225,19 +228,17 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info) if (iszv /= nplevs) then allocate(tprecv(nplevs),stat=info) ! First all existing levels - if (info == 0) tprecv(1)%parms = baseparms - if (info == 0) call restore_smoothers(tprecv(1),& - & prec%precv(1)%sm,prec%precv(1)%sm2a,info) - if (info == 0) call move_alloc(prec%precv(1)%aggr,tprecv(1)%aggr) - do i=2, min(iszv,nplevs) - 1 - if (info == 0) tprecv(i)%parms = medparms + do i=1, min(iszv,nplevs) - 1 + if (info == 0) tprecv(i)%parms = prec%precv(i)%parms if (info == 0) call restore_smoothers(tprecv(i),& & prec%precv(i)%sm,prec%precv(i)%sm2a,info) if (info == 0) call move_alloc(prec%precv(i)%aggr,tprecv(i)%aggr) end do if (iszv < nplevs) then + ! Further intermediates, if needed allocate(tmp_aggr,source=tprecv(iszv-1)%aggr,stat=info) - ! Further intermediates, if any + medparms = prec%precv(iszv-1)%parms + call save_smoothers(prec%precv(iszv-1),med_sm,med_sm2,info) do i=iszv, nplevs - 1 if (info == 0) tprecv(i)%parms = medparms if (info == 0) call restore_smoothers(tprecv(i),med_sm,med_sm2,info) @@ -302,11 +303,12 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info) ! Build the mapping between levels i-1 and i and the matrix ! at level i ! + if (do_timings) call psb_tic(idx_bldtp) if (info == psb_success_)& & call prec%precv(i)%bld_tprol(prec%precv(i-1)%base_a,& & prec%precv(i-1)%base_desc,& & ilaggr,nlaggr,op_prol,prec%ag_data,info) - + if (do_timings) call psb_toc(idx_bldtp) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Map build') @@ -387,20 +389,23 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info) nlaggr = prec%precv(newsz)%map%naggr call prec%precv(newsz)%tprol%clone(op_prol,info) end if - + if (do_timings) call psb_tic(idx_matasb) if (info == psb_success_) call prec%precv(newsz)%mat_asb( & & prec%precv(newsz-1)%base_a,prec%precv(newsz-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) + if (do_timings) call psb_toc(idx_matasb) if (info /= 0) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Mat asb') goto 9999 endif exit array_build_loop - else + else + if (do_timings) call psb_tic(idx_matasb) if (info == psb_success_) call prec%precv(i)%mat_asb(& & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) + if (do_timings) call psb_toc(idx_matasb) end if if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/mld_s_hierarchy_bld.f90 b/mlprec/impl/mld_s_hierarchy_bld.f90 index 91e24322..5669e758 100644 --- a/mlprec/impl/mld_s_hierarchy_bld.f90 +++ b/mlprec/impl/mld_s_hierarchy_bld.f90 @@ -83,15 +83,17 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info) & nplevs, mxplevs integer(psb_lpk_) :: iaggsize, casize real(psb_spk_) :: mnaggratio, sizeratio, athresh, aomega - class(mld_s_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, & - & base_sm2, med_sm2, coarse_sm2 + class(mld_s_base_smoother_type), allocatable :: coarse_sm, med_sm, & + & med_sm2, coarse_sm2 class(mld_s_base_aggregator_type), allocatable :: tmp_aggr - type(mld_sml_parms) :: baseparms, medparms, coarseparms + type(mld_sml_parms) :: medparms, coarseparms integer(psb_lpk_), allocatable :: ilaggr(:), nlaggr(:) type(psb_lsspmat_type) :: op_prol type(mld_s_onelev_type), allocatable :: tprecv(:) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err + integer(psb_ipk_), save :: idx_bldtp=-1, idx_matasb=-1 + logical, parameter :: do_timings=.false. info=psb_success_ err=0 @@ -110,6 +112,10 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Entering ' + if ((do_timings).and.(idx_bldtp==-1)) & + & idx_bldtp = psb_get_timer_idx("BLD_HIER: bld_tprol") + if ((do_timings).and.(idx_matasb==-1)) & + & idx_matasb = psb_get_timer_idx("BLD_HIER: mmat_asb") ! if (.not.allocated(prec%precv)) then @@ -207,15 +213,12 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info) end if nplevs = max(itwo,mxplevs) + ! + ! The coarse parameters will be needed later + ! coarseparms = prec%precv(iszv)%parms - baseparms = prec%precv(1)%parms - medparms = prec%precv(2)%parms - call save_smoothers(prec%precv(iszv),coarse_sm,coarse_sm2,info) - if (info == 0) call save_smoothers(prec%precv(2),med_sm,med_sm2,info) - if (info == 0) call save_smoothers(prec%precv(1),base_sm,base_sm2,info) if (info /= psb_success_) then - write(0,*) 'Error in saving smoothers',info call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') goto 9999 end if @@ -225,19 +228,17 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info) if (iszv /= nplevs) then allocate(tprecv(nplevs),stat=info) ! First all existing levels - if (info == 0) tprecv(1)%parms = baseparms - if (info == 0) call restore_smoothers(tprecv(1),& - & prec%precv(1)%sm,prec%precv(1)%sm2a,info) - if (info == 0) call move_alloc(prec%precv(1)%aggr,tprecv(1)%aggr) - do i=2, min(iszv,nplevs) - 1 - if (info == 0) tprecv(i)%parms = medparms + do i=1, min(iszv,nplevs) - 1 + if (info == 0) tprecv(i)%parms = prec%precv(i)%parms if (info == 0) call restore_smoothers(tprecv(i),& & prec%precv(i)%sm,prec%precv(i)%sm2a,info) if (info == 0) call move_alloc(prec%precv(i)%aggr,tprecv(i)%aggr) end do if (iszv < nplevs) then + ! Further intermediates, if needed allocate(tmp_aggr,source=tprecv(iszv-1)%aggr,stat=info) - ! Further intermediates, if any + medparms = prec%precv(iszv-1)%parms + call save_smoothers(prec%precv(iszv-1),med_sm,med_sm2,info) do i=iszv, nplevs - 1 if (info == 0) tprecv(i)%parms = medparms if (info == 0) call restore_smoothers(tprecv(i),med_sm,med_sm2,info) @@ -302,11 +303,12 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info) ! Build the mapping between levels i-1 and i and the matrix ! at level i ! + if (do_timings) call psb_tic(idx_bldtp) if (info == psb_success_)& & call prec%precv(i)%bld_tprol(prec%precv(i-1)%base_a,& & prec%precv(i-1)%base_desc,& & ilaggr,nlaggr,op_prol,prec%ag_data,info) - + if (do_timings) call psb_toc(idx_bldtp) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Map build') @@ -387,20 +389,23 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info) nlaggr = prec%precv(newsz)%map%naggr call prec%precv(newsz)%tprol%clone(op_prol,info) end if - + if (do_timings) call psb_tic(idx_matasb) if (info == psb_success_) call prec%precv(newsz)%mat_asb( & & prec%precv(newsz-1)%base_a,prec%precv(newsz-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) + if (do_timings) call psb_toc(idx_matasb) if (info /= 0) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Mat asb') goto 9999 endif exit array_build_loop - else + else + if (do_timings) call psb_tic(idx_matasb) if (info == psb_success_) call prec%precv(i)%mat_asb(& & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) + if (do_timings) call psb_toc(idx_matasb) end if if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/mld_z_hierarchy_bld.f90 b/mlprec/impl/mld_z_hierarchy_bld.f90 index 087c50e5..c295efdc 100644 --- a/mlprec/impl/mld_z_hierarchy_bld.f90 +++ b/mlprec/impl/mld_z_hierarchy_bld.f90 @@ -83,15 +83,17 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info) & nplevs, mxplevs integer(psb_lpk_) :: iaggsize, casize real(psb_dpk_) :: mnaggratio, sizeratio, athresh, aomega - class(mld_z_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, & - & base_sm2, med_sm2, coarse_sm2 + class(mld_z_base_smoother_type), allocatable :: coarse_sm, med_sm, & + & med_sm2, coarse_sm2 class(mld_z_base_aggregator_type), allocatable :: tmp_aggr - type(mld_dml_parms) :: baseparms, medparms, coarseparms + type(mld_dml_parms) :: medparms, coarseparms integer(psb_lpk_), allocatable :: ilaggr(:), nlaggr(:) type(psb_lzspmat_type) :: op_prol type(mld_z_onelev_type), allocatable :: tprecv(:) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name, ch_err + integer(psb_ipk_), save :: idx_bldtp=-1, idx_matasb=-1 + logical, parameter :: do_timings=.false. info=psb_success_ err=0 @@ -110,6 +112,10 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & 'Entering ' + if ((do_timings).and.(idx_bldtp==-1)) & + & idx_bldtp = psb_get_timer_idx("BLD_HIER: bld_tprol") + if ((do_timings).and.(idx_matasb==-1)) & + & idx_matasb = psb_get_timer_idx("BLD_HIER: mmat_asb") ! if (.not.allocated(prec%precv)) then @@ -207,15 +213,12 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info) end if nplevs = max(itwo,mxplevs) + ! + ! The coarse parameters will be needed later + ! coarseparms = prec%precv(iszv)%parms - baseparms = prec%precv(1)%parms - medparms = prec%precv(2)%parms - call save_smoothers(prec%precv(iszv),coarse_sm,coarse_sm2,info) - if (info == 0) call save_smoothers(prec%precv(2),med_sm,med_sm2,info) - if (info == 0) call save_smoothers(prec%precv(1),base_sm,base_sm2,info) if (info /= psb_success_) then - write(0,*) 'Error in saving smoothers',info call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') goto 9999 end if @@ -225,19 +228,17 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info) if (iszv /= nplevs) then allocate(tprecv(nplevs),stat=info) ! First all existing levels - if (info == 0) tprecv(1)%parms = baseparms - if (info == 0) call restore_smoothers(tprecv(1),& - & prec%precv(1)%sm,prec%precv(1)%sm2a,info) - if (info == 0) call move_alloc(prec%precv(1)%aggr,tprecv(1)%aggr) - do i=2, min(iszv,nplevs) - 1 - if (info == 0) tprecv(i)%parms = medparms + do i=1, min(iszv,nplevs) - 1 + if (info == 0) tprecv(i)%parms = prec%precv(i)%parms if (info == 0) call restore_smoothers(tprecv(i),& & prec%precv(i)%sm,prec%precv(i)%sm2a,info) if (info == 0) call move_alloc(prec%precv(i)%aggr,tprecv(i)%aggr) end do if (iszv < nplevs) then + ! Further intermediates, if needed allocate(tmp_aggr,source=tprecv(iszv-1)%aggr,stat=info) - ! Further intermediates, if any + medparms = prec%precv(iszv-1)%parms + call save_smoothers(prec%precv(iszv-1),med_sm,med_sm2,info) do i=iszv, nplevs - 1 if (info == 0) tprecv(i)%parms = medparms if (info == 0) call restore_smoothers(tprecv(i),med_sm,med_sm2,info) @@ -302,11 +303,12 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info) ! Build the mapping between levels i-1 and i and the matrix ! at level i ! + if (do_timings) call psb_tic(idx_bldtp) if (info == psb_success_)& & call prec%precv(i)%bld_tprol(prec%precv(i-1)%base_a,& & prec%precv(i-1)%base_desc,& & ilaggr,nlaggr,op_prol,prec%ag_data,info) - + if (do_timings) call psb_toc(idx_bldtp) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Map build') @@ -387,20 +389,23 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info) nlaggr = prec%precv(newsz)%map%naggr call prec%precv(newsz)%tprol%clone(op_prol,info) end if - + if (do_timings) call psb_tic(idx_matasb) if (info == psb_success_) call prec%precv(newsz)%mat_asb( & & prec%precv(newsz-1)%base_a,prec%precv(newsz-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) + if (do_timings) call psb_toc(idx_matasb) if (info /= 0) then call psb_errpush(psb_err_internal_error_,name,& & a_err='Mat asb') goto 9999 endif exit array_build_loop - else + else + if (do_timings) call psb_tic(idx_matasb) if (info == psb_success_) call prec%precv(i)%mat_asb(& & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) + if (do_timings) call psb_toc(idx_matasb) end if if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& From fa4623f54b20a626692db621d714e58734818084 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 22 Apr 2020 10:41:08 +0100 Subject: [PATCH 2/2] Ensure using correct NZ value --- mlprec/impl/aggregator/mld_c_spmm_bld_inner.f90 | 3 ++- mlprec/impl/aggregator/mld_d_spmm_bld_inner.f90 | 3 ++- mlprec/impl/aggregator/mld_s_spmm_bld_inner.f90 | 3 ++- mlprec/impl/aggregator/mld_z_spmm_bld_inner.f90 | 3 ++- 4 files changed, 8 insertions(+), 4 deletions(-) diff --git a/mlprec/impl/aggregator/mld_c_spmm_bld_inner.f90 b/mlprec/impl/aggregator/mld_c_spmm_bld_inner.f90 index 0e75eb30..deea748f 100644 --- a/mlprec/impl/aggregator/mld_c_spmm_bld_inner.f90 +++ b/mlprec/impl/aggregator/mld_c_spmm_bld_inner.f90 @@ -170,10 +170,11 @@ subroutine mld_c_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,& call csr_restr%free() call acsr3%free() call ac_csr%mv_to_lcoo(ac_coo,info) - call ac_coo%fix(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) + nza = ac_coo%get_nzeros() call desc_cprol%indxmap%l2gip(ac_coo%ia(1:nza),info) call desc_cprol%indxmap%l2gip(ac_coo%ja(1:nza),info) call ac_coo%set_nrows(ntaggr) diff --git a/mlprec/impl/aggregator/mld_d_spmm_bld_inner.f90 b/mlprec/impl/aggregator/mld_d_spmm_bld_inner.f90 index 0d85c647..ecde7398 100644 --- a/mlprec/impl/aggregator/mld_d_spmm_bld_inner.f90 +++ b/mlprec/impl/aggregator/mld_d_spmm_bld_inner.f90 @@ -170,10 +170,11 @@ subroutine mld_d_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,& call csr_restr%free() call acsr3%free() call ac_csr%mv_to_lcoo(ac_coo,info) - call ac_coo%fix(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) + nza = ac_coo%get_nzeros() call desc_cprol%indxmap%l2gip(ac_coo%ia(1:nza),info) call desc_cprol%indxmap%l2gip(ac_coo%ja(1:nza),info) call ac_coo%set_nrows(ntaggr) diff --git a/mlprec/impl/aggregator/mld_s_spmm_bld_inner.f90 b/mlprec/impl/aggregator/mld_s_spmm_bld_inner.f90 index 4ae68bbb..a2c2d1d0 100644 --- a/mlprec/impl/aggregator/mld_s_spmm_bld_inner.f90 +++ b/mlprec/impl/aggregator/mld_s_spmm_bld_inner.f90 @@ -170,10 +170,11 @@ subroutine mld_s_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,& call csr_restr%free() call acsr3%free() call ac_csr%mv_to_lcoo(ac_coo,info) - call ac_coo%fix(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) + nza = ac_coo%get_nzeros() call desc_cprol%indxmap%l2gip(ac_coo%ia(1:nza),info) call desc_cprol%indxmap%l2gip(ac_coo%ja(1:nza),info) call ac_coo%set_nrows(ntaggr) diff --git a/mlprec/impl/aggregator/mld_z_spmm_bld_inner.f90 b/mlprec/impl/aggregator/mld_z_spmm_bld_inner.f90 index 98aa63f2..b0c459d5 100644 --- a/mlprec/impl/aggregator/mld_z_spmm_bld_inner.f90 +++ b/mlprec/impl/aggregator/mld_z_spmm_bld_inner.f90 @@ -170,10 +170,11 @@ subroutine mld_z_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,& call csr_restr%free() call acsr3%free() call ac_csr%mv_to_lcoo(ac_coo,info) - call ac_coo%fix(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) + nza = ac_coo%get_nzeros() call desc_cprol%indxmap%l2gip(ac_coo%ia(1:nza),info) call desc_cprol%indxmap%l2gip(ac_coo%ja(1:nza),info) call ac_coo%set_nrows(ntaggr)