From 189a4170ec72eb4f8d501c384dc05a2e7a6f5cd9 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 9 Apr 2021 04:22:09 -0400 Subject: [PATCH] Fix internal naming schemes for MatchBox related code, fix dependencies --- amgprec/Makefile | 7 +- amgprec/amg_d_matchboxp_mod.f90 | 366 ++---------------- amgprec/amg_d_parmatch_aggregator_mod.F90 | 5 +- amgprec/amg_s_matchboxp_mod.f90 | 364 ++--------------- amgprec/amg_s_parmatch_aggregator_mod.F90 | 5 +- .../amg_d_parmatch_aggregator_tprol.f90 | 2 +- .../amg_s_parmatch_aggregator_tprol.f90 | 2 +- 7 files changed, 63 insertions(+), 688 deletions(-) diff --git a/amgprec/Makefile b/amgprec/Makefile index 1e2cfab8..641b1fdd 100644 --- a/amgprec/Makefile +++ b/amgprec/Makefile @@ -17,7 +17,6 @@ DMODOBJS=amg_d_prec_type.o \ amg_d_ainv_solver.o amg_d_base_ainv_mod.o \ amg_d_invk_solver.o amg_d_invt_solver.o amg_d_krm_solver.o \ amg_d_matchboxp_mod.o amg_d_parmatch_aggregator_mod.o -#amg_d_bcmatch_aggregator_mod.o SMODOBJS=amg_s_prec_type.o amg_s_ilu_fact_mod.o \ amg_s_inner_mod.o amg_s_ilu_solver.o amg_s_diag_solver.o amg_s_jac_smoother.o amg_s_as_smoother.o \ @@ -113,18 +112,20 @@ amg_d_prec_type.o: amg_d_onelev_mod.o amg_c_prec_type.o: amg_c_onelev_mod.o amg_z_prec_type.o: amg_z_onelev_mod.o -amg_s_onelev_mod.o: amg_s_base_smoother_mod.o amg_s_dec_aggregator_mod.o -amg_d_onelev_mod.o: amg_d_base_smoother_mod.o amg_d_dec_aggregator_mod.o +amg_s_onelev_mod.o: amg_s_base_smoother_mod.o amg_s_dec_aggregator_mod.o amg_s_parmatch_aggregator_mod.o +amg_d_onelev_mod.o: amg_d_base_smoother_mod.o amg_d_dec_aggregator_mod.o amg_d_parmatch_aggregator_mod.o amg_c_onelev_mod.o: amg_c_base_smoother_mod.o amg_c_dec_aggregator_mod.o amg_z_onelev_mod.o: amg_z_base_smoother_mod.o amg_z_dec_aggregator_mod.o amg_s_base_aggregator_mod.o: amg_base_prec_type.o amg_s_parmatch_aggregator_mod.o amg_s_dec_aggregator_mod.o: amg_s_base_aggregator_mod.o amg_s_hybrid_aggregator_mod.o amg_s_symdec_aggregator_mod.o: amg_s_dec_aggregator_mod.o +amg_s_parmatch_aggregator_mod.o: amg_s_matchboxp_mod.o amg_d_base_aggregator_mod.o: amg_base_prec_type.o amg_d_parmatch_aggregator_mod.o amg_d_dec_aggregator_mod.o: amg_d_base_aggregator_mod.o amg_d_hybrid_aggregator_mod.o amg_d_symdec_aggregator_mod.o: amg_d_dec_aggregator_mod.o +amg_d_parmatch_aggregator_mod.o: amg_d_matchboxp_mod.o amg_c_base_aggregator_mod.o: amg_base_prec_type.o amg_c_parmatch_aggregator_mod.o amg_c_dec_aggregator_mod.o: amg_c_base_aggregator_mod.o diff --git a/amgprec/amg_d_matchboxp_mod.f90 b/amgprec/amg_d_matchboxp_mod.f90 index 3be08ca7..37944025 100644 --- a/amgprec/amg_d_matchboxp_mod.f90 +++ b/amgprec/amg_d_matchboxp_mod.f90 @@ -9,9 +9,6 @@ ! Salvatore Filippone ! Pasqua D'Ambra ! Fabio Durastante -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante ! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions @@ -71,7 +68,7 @@ ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. ! -module dmatchboxp_mod +module amg_d_matchboxp_mod use iso_c_binding use psb_base_cbind_mod @@ -97,17 +94,21 @@ module dmatchboxp_mod end subroutine dMatchBoxPC end interface MatchBoxPC - interface i_aggr_assign - module procedure i_daggr_assign - end interface i_aggr_assign + interface amg_i_aggr_assign + module procedure amg_i_daggr_assign + end interface amg_i_aggr_assign + + interface amg_build_matching + module procedure amg_d_build_matching + end interface amg_build_matching - interface build_matching - module procedure dbuild_matching - end interface build_matching + interface amg_matchboxp_build_prol + module procedure amg_d_matchboxp_build_prol + end interface amg_matchboxp_build_prol - interface build_ahat - module procedure dbuild_ahat - end interface build_ahat + interface amg_build_ahat + module procedure amg_d_build_ahat + end interface amg_build_ahat interface psb_gtranspose module procedure psb_dgtranspose @@ -123,7 +124,7 @@ module dmatchboxp_mod contains - subroutine dmatchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,& + subroutine amg_d_matchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,& & symmetrize,reproducible,display_inp, display_out, print_out) use psb_base_mod use psb_util_mod @@ -221,7 +222,7 @@ contains end if if (do_timings) call psb_toc(idx_phase1) if (do_timings) call psb_tic(idx_bldmtc) - call build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize) + call amg_build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize) if (do_timings) call psb_toc(idx_bldmtc) if (debug) write(0,*) iam,' buildprol from buildmatching:',& & info @@ -315,11 +316,11 @@ contains else ! Use a statistically unbiased tie-breaking rule, ! this will give an even spread. - ! Delegate to i_aggr_assign. + ! Delegate to amg_i_aggr_assign. ! Should be a symmetric function. ! call desc_a%indxmap%qry_halo_owner(idx,iown,info) - ip = i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) + ip = amg_i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) if (iam == ip) then nlaggr(iam) = nlaggr(iam) + 1 ilaggr(k) = nlaggr(iam) @@ -524,9 +525,9 @@ contains write(0,*) iam,' : error from Matching: ',info end if - end subroutine dmatchboxp_build_prol + end subroutine amg_d_matchboxp_build_prol - function i_daggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) & + function amg_i_daggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) & & result(iproc) ! ! How to break ties? This @@ -568,10 +569,10 @@ contains iproc = iown end if end if - end function i_daggr_assign + end function amg_i_daggr_assign - subroutine dbuild_matching(w,a,desc_a,mate,info,display_inp, symmetrize) + subroutine amg_d_build_matching(w,a,desc_a,mate,info,display_inp, symmetrize) use psb_base_mod use psb_util_mod use iso_c_binding @@ -597,7 +598,7 @@ contains integer(psb_ipk_), save :: cnt=2 logical, parameter :: debug=.false., dump_ahat=.false., debug_sync=.false. logical, parameter :: old_style=.false., sort_minp=.true. - character(len=40) :: name='build_matching', fname + character(len=40) :: name='amg_build_matching', fname integer(psb_ipk_), save :: idx_cmboxp=-1, idx_bldahat=-1, idx_phase2=-1, idx_phase3=-1 logical, parameter :: do_timings=.true. @@ -620,7 +621,7 @@ contains if (iam == 0) write(0,*)' Into build_ahat:' end if if (do_timings) call psb_tic(idx_bldahat) - call build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize) + call amg_build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize) if (do_timings) call psb_toc(idx_bldahat) if (info /= 0) then write(0,*) 'Error from build_ahat ', info @@ -775,9 +776,9 @@ contains val(1:n) = tmp(1:n) end subroutine fix_order - end subroutine dbuild_matching + end subroutine amg_d_build_matching - subroutine dbuild_ahat(w,a,ahat,desc_a,info,symmetrize) + subroutine amg_d_build_ahat(w,a,ahat,desc_a,info,symmetrize) use psb_base_mod implicit none real(psb_dpk_), intent(in) :: w(:) @@ -1015,320 +1016,9 @@ contains end block end if - end subroutine dbuild_ahat + end subroutine amg_d_build_ahat -! subroutine build_ahat_old(w,a,ahat,desc_a,info,symmetrize) -! use psb_base_mod -! implicit none -! real(psb_dpk_) :: w(:) -! type(psb_ldspmat_type), intent(inout) :: a -! type(psb_ldspmat_type), intent(out) :: ahat -! type(psb_desc_type) :: desc_a -! integer(psb_ipk_), intent(out) :: info -! logical, optional :: symmetrize -! -! type(psb_ldspmat_type) :: atnd -! type(psb_ld_coo_sparse_mat) :: tcoo1, tcoo2, tcoo3 -! real(psb_dpk_), allocatable :: diag(:) -! integer(psb_lpk_), allocatable :: ilv(:) -! logical, parameter :: debug=.false., dump=.false., dump_ahat=.false. -! logical :: symmetrize_ -! logical, parameter :: half_ahat=.true. -! real(psb_dpk_) :: aii, ajj, aij, wii, wjj, tmp1, tmp2, minabs, edgnrm -! integer(psb_lpk_) :: nr, nc, nz, i, nz2, nrg, ii, jj, k, k2 -! type(psb_ctxt_type) :: ictxt -! integer(psb_ipk_) :: me, np -! character(len=80) :: aname -! real(psb_dpk_), parameter :: eps=epsilon(1.d0) -! -! ictxt = desc_a%get_ctxt() -! call psb_info(ictxt,me,np) -! if (present(symmetrize)) then -! symmetrize_ = symmetrize -! else -! symmetrize_ = .false. -! end if -! -! ! -! ! Extract off-diagonal part of A into ahat -! ! Extract diagonal of A -! ! -! call a%clip_diag(ahat,info) -! call ahat%mv_to(tcoo1) -! nr = tcoo1%get_nrows() -! nc = tcoo1%get_ncols() -! nz = tcoo1%get_nzeros() -! diag = a%get_diag(info) -! call psb_realloc(nc,diag,info) -! call psb_halo(diag,desc_a,info) -! -! if (half_ahat) then -! !!$ write(0,*) me,' Temp placeholder ' -! ilv = [(i,i=1,desc_a%get_local_cols())] -! call desc_a%l2gip(ilv,info,owned=.false.) -! ! -! ! At this point the matrix is symmetric, hence we will encounter -! ! all entries as appropriate. -! ! -! nr = tcoo1%get_nrows() -! nc = tcoo1%get_ncols() -! nz = tcoo1%get_nzeros() -! call tcoo2%allocate(nr,nc,nz) -! k2 = 0 -! do k = 1, nz -! ii = tcoo1%ia(k) -! jj = tcoo1%ja(k) -! ! -! ! Run over only one strict triangle -! ! -! if (ilv(ii) eps) then -! tcoo2%val(k2) = done - (2*done*aij*wii*wjj)/(aii*(wii**2) + ajj*(wjj**2)) -! else -! tcoo2%val(k2) = eps -! end if -! -! end if -! !else -! ! write(0,*) 'build_ahat: index error :',ii,jj,' : boundaries :',nr,nc -! !end if -! end do -! call tcoo2%set_nzeros(k2) -! if (dump) then -! block -! type(psb_ldspmat_type) :: amglob -! call ahat%cp_from(tcoo2) -! call psb_gather(amglob,ahat,desc_a,info) -! if (me==psb_root_) then -! write(aname,'(a,i0,a)') 'ahat-gu-',amglob%get_nrows(),'.mtx' -! call amglob%print(fname=aname,head='Test ') -! end if -! write(0,*) 'Done build_ahat' -! end block -! end if -! -! call psb_glob_transpose(tcoo2,desc_a,info,atrans=tcoo1) -! -! if (dump) then -! block -! type(psb_ldspmat_type) :: amglob -! call atnd%cp_from(tcoo1) -! call psb_gather(amglob,atnd,desc_a,info) -! if (me==psb_root_) then -! write(aname,'(a,i0,a)') 'ahat-gl-',amglob%get_nrows(),'.mtx' -! call amglob%print(fname=aname,head='Test ') -! end if -! write(0,*) 'Done build_ahat' -! end block -! end if -! -! nz = tcoo1%get_nzeros() -! nz2 = tcoo2%get_nzeros() -! call tcoo2%reallocate(nz+nz2) -! tcoo2%ia(nz2+1:nz2+nz) = tcoo1%ia(1:nz) -! tcoo2%ja(nz2+1:nz2+nz) = tcoo1%ja(1:nz) -! tcoo2%val(nz2+1:nz2+nz) = tcoo1%val(1:nz) -! call tcoo2%set_nzeros(nz+nz2) -! call tcoo2%fix(info) -! call tcoo1%free() -! nz = tcoo2%get_nzeros() -! minabs = minval(abs(tcoo2%val(1:nz))) -! call psb_min(ictxt,minabs) -! if (minabs == dzero) then -! if (me == 0) write(0,*) me, 'Min value for log correction is zero! ' -! minabs = done -! end if -! tcoo2%val(1:nz) = log(abs(tcoo2%val(1:nz))/(0.999*minabs)) -! if (any(tcoo2%val(1:nz)<0)) write(0,*) me, 'Warning: negative log output!' -! call ahat%mv_from(tcoo2) -! if (dump_ahat) then -! block -! character(len=40) :: fname -! integer(psb_ipk_) :: k, nr -! integer(psb_lpk_), allocatable :: ilv(:) -! nr = desc_a%get_local_rows() -! ilv = desc_a%get_global_indices(owned=.false.) -! write(fname,'(a,i3.3,a,i3.3,a)') 'aa-i',me,'-p',np,'.mtx' -! !!$ call a%print(fname=fname,head='Original matrix ',iv=ilv) -! write(fname,'(a,i3.3,a,i3.3,a)') 'ah2-inp-i',me,'-p',np,'.mtx' -! call ahat%print(fname=fname,head='ahat ',iv=ilv) -! end block -! end if -! -! if (dump) then -! write(aname,'(a,i3.3,a)') 'ahat-hfa-l-',me,'.mtx' -! call ahat%print(fname=aname,head='Test ',iv=ilv) -! end if -! -! if (dump) then -! block -! type(psb_ldspmat_type) :: amglob -! !!$ call psb_gather(amglob,a,desc_a,info) -! !!$ if (me==psb_root_) then -! !!$ write(aname,'(a,i3.3,a)') 'a-g-',amglob%get_nrows(),'.mtx' -! !!$ call amglob%print(fname=aname,head='Test ') -! !!$ end if -! call psb_gather(amglob,ahat,desc_a,info) -! if (me==psb_root_) then -! write(aname,'(a,i0,a)') 'ahat-hfa-g-',amglob%get_nrows(),'.mtx' -! call amglob%print(fname=aname,head='Test ') -! end if -! write(0,*) 'Done build_ahat' -! end block -! end if -! -! -! else -! -! if (debug) then -! ilv = [(i,i=1,desc_a%get_local_cols())] -! call desc_a%l2gip(ilv,info,owned=.false.) -! end if -! if (symmetrize_) then -! ! Is this faster than storing by CSR, going over the -! ! upper triangle, searching for lower triangle entry and -! ! then duplicating the output? Probably yes. -! if (debug) write(0,*) me,' Build_ahat: symmetrize :',nr,nc,nz -! call ahat%cp_from(tcoo1) -! call psb_htranspose(ahat,atnd,desc_a,info) -! if (debug) write(0,*) me,' Build_ahat: done transpose' -! -! if (dump) then -! write(aname,'(a,i3.3,a)') 'ainp-',me,'.mtx' -! call ahat%print(fname=aname,head='Test ',iv=ilv) -! write(aname,'(a,i3.3,a)') 'atnd-',me,'.mtx' -! call atnd%print(fname=aname,head='Test ',iv=ilv) -! end if -! call ahat%free() -! call atnd%mv_to(tcoo2) -! nz2 = tcoo2%get_nzeros() -! -! if (debug) then -! write(0,*) me,':',tcoo1%get_nrows(),tcoo1%get_ncols(),tcoo1%get_nzeros(),& -! & tcoo2%get_nrows(),tcoo2%get_ncols(),tcoo2%get_nzeros() -! flush(0) -! end if -! -! call tcoo3%allocate(nr, nc, max(2*nz,nz+nz2)) -! tcoo3%ia(1:nz) = tcoo1%ia(1:nz) -! tcoo3%ja(1:nz) = tcoo1%ja(1:nz) -! tcoo3%val(1:nz) = tcoo1%val(1:nz) -! tcoo3%ia(nz+1:nz+nz2) = tcoo2%ia(1:nz2) -! tcoo3%ja(nz+1:nz+nz2) = tcoo2%ja(1:nz2) -! tcoo3%val(nz+1:nz+nz2) = tcoo2%val(1:nz2) -! call tcoo3%set_nzeros(nz+nz2) -! call tcoo3%set_dupl(psb_dupl_add_) -! call tcoo3%fix(info) -! nz = tcoo3%get_nzeros() -! tcoo3%val(1:nz) = 0.5d0 * tcoo3%val(1:nz) -! call tcoo3%mv_to_coo(tcoo1,info) -! end if -! -! if (dump_ahat) then -! block -! character(len=40) :: fname -! integer(psb_ipk_) :: k, nr -! integer(psb_lpk_), allocatable :: ilv(:) -! nr = desc_a%get_local_rows() -! ilv = desc_a%get_global_indices(owned=.false.) -! write(fname,'(a,i3.3,a,i3.3,a)') 'aa-i',me,'-p',np,'.mtx' -! !!$ call a%print(fname=fname,head='Original matrix ',iv=ilv) -! write(fname,'(a,i3.3,a,i3.3,a)') 'ahat-inp-i',me,'-p',np,'.mtx' -! call ahat%print(fname=fname,head='Before building_ahat ',iv=ilv) -! end block -! end if -! -! -! ! -! ! At this point the matrix is symmetric, hence we will encounter -! ! all entries as appropriate. -! ! -! call tcoo1%cp_to_coo(tcoo2,info) -! nz = tcoo1%get_nzeros() -! do k = 1, nz -! ii = tcoo1%ia(k) -! jj = tcoo1%ja(k) -! aij = tcoo1%val(k) -! !if ((ii<= nr).and.(jj<=nc).and.(ii/=jj)) then -! ! This is already guaranteed by construction -! ! -! aii = diag(ii) -! ajj = diag(jj) -! wii = w(ii) -! wjj = w(jj) -! edgnrm = aii*(wii**2) + ajj*(wjj**2) -! if (edgnrm > eps) then -! tcoo2%val(k) = done - (2*done*aij*wii*wjj)/(aii*(wii**2) + ajj*(wjj**2)) -! else -! tcoo2%val(k)=eps -! end if -! if (debug) then -! block -! integer(psb_ipk_), parameter :: nr1=329, nc1=393 -! integer(psb_ipk_), parameter :: nr2=13, nc2=77 -! integer(psb_ipk_), parameter :: nr3=313, nc3=249 -! if ( ((ilv(ii)==nr1).and.(ilv(jj)==nc1)).or.((ilv(ii)==nc1).and.(ilv(jj)==nr1))& -! &.or.((ilv(ii)==nr2).and.(ilv(jj)==nc2)).or.((ilv(ii)==nc2).and.(ilv(jj)==nr2)) & -! &.or.((ilv(ii)==nr3).and.(ilv(jj)==nc3)).or.((ilv(ii)==nc3).and.(ilv(jj)==nr3)) & -! &) then -! write(0,*)me, 'Check on ahat:',ii,jj,ilv(ii),ilv(jj),aij,aii,ajj,wii,wjj,tcoo2%val(k) -! end if -! end block -! end if -! -! !else -! ! write(0,*) 'build_ahat: index error :',ii,jj,' : boundaries :',nr,nc -! !end if -! end do -! nz = tcoo2%get_nzeros() -! minabs = minval(abs(tcoo2%val(1:nz))) -! call psb_min(ictxt,minabs) -! if (minabs == dzero) then -! if (me == 0) write(0,*) me, 'Min value for log correction is zero! ' -! minabs = done -! end if -! tcoo2%val(1:nz) = log(abs(tcoo2%val(1:nz))/(0.999*minabs)) -! if (any(tcoo2%val(1:nz)<0)) write(0,*) me, 'Warning: negative log output!' -! call ahat%mv_from(tcoo2) -! -! if (dump) then -! write(aname,'(a,i3.3,a)') 'ahat-l-',me,'.mtx' -! call ahat%print(fname=aname,head='Test ',iv=ilv) -! end if -! -! if (dump) then -! block -! type(psb_ldspmat_type) :: amglob -! !!$ call psb_gather(amglob,a,desc_a,info) -! !!$ if (me==psb_root_) then -! !!$ write(aname,'(a,i3.3,a)') 'a-g-',amglob%get_nrows(),'.mtx' -! !!$ call amglob%print(fname=aname,head='Test ') -! !!$ end if -! call psb_gather(amglob,ahat,desc_a,info) -! if (me==psb_root_) then -! write(aname,'(a,i0,a)') 'ahat-g-',amglob%get_nrows(),'.mtx' -! call amglob%print(fname=aname,head='Test ') -! end if -! write(0,*) 'Done build_ahat' -! end block -! end if -! end if -! -! end subroutine build_ahat_old - subroutine psb_dgtranspose(ain,aout,desc_a,info) use psb_base_mod implicit none @@ -1765,4 +1455,4 @@ contains end subroutine dPMatchBox -end module dmatchboxp_mod +end module amg_d_matchboxp_mod diff --git a/amgprec/amg_d_parmatch_aggregator_mod.F90 b/amgprec/amg_d_parmatch_aggregator_mod.F90 index f671fc81..44159775 100644 --- a/amgprec/amg_d_parmatch_aggregator_mod.F90 +++ b/amgprec/amg_d_parmatch_aggregator_mod.F90 @@ -9,9 +9,6 @@ ! Salvatore Filippone ! Pasqua D'Ambra ! Fabio Durastante -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante ! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions @@ -121,7 +118,7 @@ module amg_d_parmatch_aggregator_mod use amg_d_base_aggregator_mod - use dmatchboxp_mod + use amg_d_matchboxp_mod type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type integer(psb_ipk_) :: matching_alg diff --git a/amgprec/amg_s_matchboxp_mod.f90 b/amgprec/amg_s_matchboxp_mod.f90 index 4f8d8181..687e2fab 100644 --- a/amgprec/amg_s_matchboxp_mod.f90 +++ b/amgprec/amg_s_matchboxp_mod.f90 @@ -9,9 +9,6 @@ ! Salvatore Filippone ! Pasqua D'Ambra ! Fabio Durastante -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante ! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions @@ -71,7 +68,7 @@ ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. ! -module smatchboxp_mod +module amg_s_matchboxp_mod use iso_c_binding use psb_base_cbind_mod @@ -97,17 +94,21 @@ module smatchboxp_mod end subroutine sMatchBoxPC end interface MatchBoxPC - interface i_aggr_assign - module procedure i_saggr_assign - end interface i_aggr_assign + interface amg_i_aggr_assign + module procedure amg_i_saggr_assign + end interface amg_i_aggr_assign + + interface amg_matchboxp_build_prol + module procedure amg_s_matchboxp_build_prol + end interface amg_matchboxp_build_prol - interface build_matching - module procedure sbuild_matching - end interface build_matching + interface amg_build_matching + module procedure amg_s_build_matching + end interface amg_build_matching - interface build_ahat - module procedure sbuild_ahat - end interface build_ahat + interface amg_build_ahat + module procedure amg_s_build_ahat + end interface amg_build_ahat interface psb_gtranspose module procedure psb_sgtranspose @@ -123,7 +124,7 @@ module smatchboxp_mod contains - subroutine smatchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,& + subroutine amg_s_matchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,& & symmetrize,reproducible,display_inp, display_out, print_out) use psb_base_mod use psb_util_mod @@ -221,7 +222,7 @@ contains end if if (do_timings) call psb_toc(idx_phase1) if (do_timings) call psb_tic(idx_bldmtc) - call build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize) + call amg_build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize) if (do_timings) call psb_toc(idx_bldmtc) if (debug) write(0,*) iam,' buildprol from buildmatching:',& & info @@ -315,11 +316,11 @@ contains else ! Use a statistically unbiased tie-breaking rule, ! this will give an even spread. - ! Delegate to i_aggr_assign. + ! Delegate to amg_i_aggr_assign. ! Should be a symmetric function. ! call desc_a%indxmap%qry_halo_owner(idx,iown,info) - ip = i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) + ip = amg_i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) if (iam == ip) then nlaggr(iam) = nlaggr(iam) + 1 ilaggr(k) = nlaggr(iam) @@ -524,9 +525,9 @@ contains write(0,*) iam,' : error from Matching: ',info end if - end subroutine smatchboxp_build_prol + end subroutine amg_s_matchboxp_build_prol - function i_saggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) & + function amg_i_saggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) & & result(iproc) ! ! How to break ties? This @@ -568,10 +569,10 @@ contains iproc = iown end if end if - end function i_saggr_assign + end function amg_i_saggr_assign - subroutine sbuild_matching(w,a,desc_a,mate,info,display_inp, symmetrize) + subroutine amg_s_build_matching(w,a,desc_a,mate,info,display_inp, symmetrize) use psb_base_mod use psb_util_mod use iso_c_binding @@ -620,7 +621,7 @@ contains if (iam == 0) write(0,*)' Into build_ahat:' end if if (do_timings) call psb_tic(idx_bldahat) - call build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize) + call amg_build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize) if (do_timings) call psb_toc(idx_bldahat) if (info /= 0) then write(0,*) 'Error from build_ahat ', info @@ -775,9 +776,9 @@ contains val(1:n) = tmp(1:n) end subroutine fix_order - end subroutine sbuild_matching + end subroutine amg_s_build_matching - subroutine sbuild_ahat(w,a,ahat,desc_a,info,symmetrize) + subroutine amg_s_build_ahat(w,a,ahat,desc_a,info,symmetrize) use psb_base_mod implicit none real(psb_spk_), intent(in) :: w(:) @@ -1015,320 +1016,9 @@ contains end block end if - end subroutine sbuild_ahat + end subroutine amg_s_build_ahat -! subroutine build_ahat_old(w,a,ahat,desc_a,info,symmetrize) -! use psb_base_mod -! implicit none -! real(psb_dpk_) :: w(:) -! type(psb_ldspmat_type), intent(inout) :: a -! type(psb_ldspmat_type), intent(out) :: ahat -! type(psb_desc_type) :: desc_a -! integer(psb_ipk_), intent(out) :: info -! logical, optional :: symmetrize -! -! type(psb_ldspmat_type) :: atnd -! type(psb_ld_coo_sparse_mat) :: tcoo1, tcoo2, tcoo3 -! real(psb_dpk_), allocatable :: diag(:) -! integer(psb_lpk_), allocatable :: ilv(:) -! logical, parameter :: debug=.false., dump=.false., dump_ahat=.false. -! logical :: symmetrize_ -! logical, parameter :: half_ahat=.true. -! real(psb_dpk_) :: aii, ajj, aij, wii, wjj, tmp1, tmp2, minabs, edgnrm -! integer(psb_lpk_) :: nr, nc, nz, i, nz2, nrg, ii, jj, k, k2 -! type(psb_ctxt_type) :: ictxt -! integer(psb_ipk_) :: me, np -! character(len=80) :: aname -! real(psb_dpk_), parameter :: eps=epsilon(1.d0) -! -! ictxt = desc_a%get_ctxt() -! call psb_info(ictxt,me,np) -! if (present(symmetrize)) then -! symmetrize_ = symmetrize -! else -! symmetrize_ = .false. -! end if -! -! ! -! ! Extract off-diagonal part of A into ahat -! ! Extract diagonal of A -! ! -! call a%clip_diag(ahat,info) -! call ahat%mv_to(tcoo1) -! nr = tcoo1%get_nrows() -! nc = tcoo1%get_ncols() -! nz = tcoo1%get_nzeros() -! diag = a%get_diag(info) -! call psb_realloc(nc,diag,info) -! call psb_halo(diag,desc_a,info) -! -! if (half_ahat) then -! !!$ write(0,*) me,' Temp placeholder ' -! ilv = [(i,i=1,desc_a%get_local_cols())] -! call desc_a%l2gip(ilv,info,owned=.false.) -! ! -! ! At this point the matrix is symmetric, hence we will encounter -! ! all entries as appropriate. -! ! -! nr = tcoo1%get_nrows() -! nc = tcoo1%get_ncols() -! nz = tcoo1%get_nzeros() -! call tcoo2%allocate(nr,nc,nz) -! k2 = 0 -! do k = 1, nz -! ii = tcoo1%ia(k) -! jj = tcoo1%ja(k) -! ! -! ! Run over only one strict triangle -! ! -! if (ilv(ii) eps) then -! tcoo2%val(k2) = done - (2*done*aij*wii*wjj)/(aii*(wii**2) + ajj*(wjj**2)) -! else -! tcoo2%val(k2) = eps -! end if -! -! end if -! !else -! ! write(0,*) 'build_ahat: index error :',ii,jj,' : boundaries :',nr,nc -! !end if -! end do -! call tcoo2%set_nzeros(k2) -! if (dump) then -! block -! type(psb_ldspmat_type) :: amglob -! call ahat%cp_from(tcoo2) -! call psb_gather(amglob,ahat,desc_a,info) -! if (me==psb_root_) then -! write(aname,'(a,i0,a)') 'ahat-gu-',amglob%get_nrows(),'.mtx' -! call amglob%print(fname=aname,head='Test ') -! end if -! write(0,*) 'Done build_ahat' -! end block -! end if -! -! call psb_glob_transpose(tcoo2,desc_a,info,atrans=tcoo1) -! -! if (dump) then -! block -! type(psb_ldspmat_type) :: amglob -! call atnd%cp_from(tcoo1) -! call psb_gather(amglob,atnd,desc_a,info) -! if (me==psb_root_) then -! write(aname,'(a,i0,a)') 'ahat-gl-',amglob%get_nrows(),'.mtx' -! call amglob%print(fname=aname,head='Test ') -! end if -! write(0,*) 'Done build_ahat' -! end block -! end if -! -! nz = tcoo1%get_nzeros() -! nz2 = tcoo2%get_nzeros() -! call tcoo2%reallocate(nz+nz2) -! tcoo2%ia(nz2+1:nz2+nz) = tcoo1%ia(1:nz) -! tcoo2%ja(nz2+1:nz2+nz) = tcoo1%ja(1:nz) -! tcoo2%val(nz2+1:nz2+nz) = tcoo1%val(1:nz) -! call tcoo2%set_nzeros(nz+nz2) -! call tcoo2%fix(info) -! call tcoo1%free() -! nz = tcoo2%get_nzeros() -! minabs = minval(abs(tcoo2%val(1:nz))) -! call psb_min(ictxt,minabs) -! if (minabs == dzero) then -! if (me == 0) write(0,*) me, 'Min value for log correction is zero! ' -! minabs = done -! end if -! tcoo2%val(1:nz) = log(abs(tcoo2%val(1:nz))/(0.999*minabs)) -! if (any(tcoo2%val(1:nz)<0)) write(0,*) me, 'Warning: negative log output!' -! call ahat%mv_from(tcoo2) -! if (dump_ahat) then -! block -! character(len=40) :: fname -! integer(psb_ipk_) :: k, nr -! integer(psb_lpk_), allocatable :: ilv(:) -! nr = desc_a%get_local_rows() -! ilv = desc_a%get_global_indices(owned=.false.) -! write(fname,'(a,i3.3,a,i3.3,a)') 'aa-i',me,'-p',np,'.mtx' -! !!$ call a%print(fname=fname,head='Original matrix ',iv=ilv) -! write(fname,'(a,i3.3,a,i3.3,a)') 'ah2-inp-i',me,'-p',np,'.mtx' -! call ahat%print(fname=fname,head='ahat ',iv=ilv) -! end block -! end if -! -! if (dump) then -! write(aname,'(a,i3.3,a)') 'ahat-hfa-l-',me,'.mtx' -! call ahat%print(fname=aname,head='Test ',iv=ilv) -! end if -! -! if (dump) then -! block -! type(psb_ldspmat_type) :: amglob -! !!$ call psb_gather(amglob,a,desc_a,info) -! !!$ if (me==psb_root_) then -! !!$ write(aname,'(a,i3.3,a)') 'a-g-',amglob%get_nrows(),'.mtx' -! !!$ call amglob%print(fname=aname,head='Test ') -! !!$ end if -! call psb_gather(amglob,ahat,desc_a,info) -! if (me==psb_root_) then -! write(aname,'(a,i0,a)') 'ahat-hfa-g-',amglob%get_nrows(),'.mtx' -! call amglob%print(fname=aname,head='Test ') -! end if -! write(0,*) 'Done build_ahat' -! end block -! end if -! -! -! else -! -! if (debug) then -! ilv = [(i,i=1,desc_a%get_local_cols())] -! call desc_a%l2gip(ilv,info,owned=.false.) -! end if -! if (symmetrize_) then -! ! Is this faster than storing by CSR, going over the -! ! upper triangle, searching for lower triangle entry and -! ! then duplicating the output? Probably yes. -! if (debug) write(0,*) me,' Build_ahat: symmetrize :',nr,nc,nz -! call ahat%cp_from(tcoo1) -! call psb_htranspose(ahat,atnd,desc_a,info) -! if (debug) write(0,*) me,' Build_ahat: done transpose' -! -! if (dump) then -! write(aname,'(a,i3.3,a)') 'ainp-',me,'.mtx' -! call ahat%print(fname=aname,head='Test ',iv=ilv) -! write(aname,'(a,i3.3,a)') 'atnd-',me,'.mtx' -! call atnd%print(fname=aname,head='Test ',iv=ilv) -! end if -! call ahat%free() -! call atnd%mv_to(tcoo2) -! nz2 = tcoo2%get_nzeros() -! -! if (debug) then -! write(0,*) me,':',tcoo1%get_nrows(),tcoo1%get_ncols(),tcoo1%get_nzeros(),& -! & tcoo2%get_nrows(),tcoo2%get_ncols(),tcoo2%get_nzeros() -! flush(0) -! end if -! -! call tcoo3%allocate(nr, nc, max(2*nz,nz+nz2)) -! tcoo3%ia(1:nz) = tcoo1%ia(1:nz) -! tcoo3%ja(1:nz) = tcoo1%ja(1:nz) -! tcoo3%val(1:nz) = tcoo1%val(1:nz) -! tcoo3%ia(nz+1:nz+nz2) = tcoo2%ia(1:nz2) -! tcoo3%ja(nz+1:nz+nz2) = tcoo2%ja(1:nz2) -! tcoo3%val(nz+1:nz+nz2) = tcoo2%val(1:nz2) -! call tcoo3%set_nzeros(nz+nz2) -! call tcoo3%set_dupl(psb_dupl_add_) -! call tcoo3%fix(info) -! nz = tcoo3%get_nzeros() -! tcoo3%val(1:nz) = 0.5d0 * tcoo3%val(1:nz) -! call tcoo3%mv_to_coo(tcoo1,info) -! end if -! -! if (dump_ahat) then -! block -! character(len=40) :: fname -! integer(psb_ipk_) :: k, nr -! integer(psb_lpk_), allocatable :: ilv(:) -! nr = desc_a%get_local_rows() -! ilv = desc_a%get_global_indices(owned=.false.) -! write(fname,'(a,i3.3,a,i3.3,a)') 'aa-i',me,'-p',np,'.mtx' -! !!$ call a%print(fname=fname,head='Original matrix ',iv=ilv) -! write(fname,'(a,i3.3,a,i3.3,a)') 'ahat-inp-i',me,'-p',np,'.mtx' -! call ahat%print(fname=fname,head='Before building_ahat ',iv=ilv) -! end block -! end if -! -! -! ! -! ! At this point the matrix is symmetric, hence we will encounter -! ! all entries as appropriate. -! ! -! call tcoo1%cp_to_coo(tcoo2,info) -! nz = tcoo1%get_nzeros() -! do k = 1, nz -! ii = tcoo1%ia(k) -! jj = tcoo1%ja(k) -! aij = tcoo1%val(k) -! !if ((ii<= nr).and.(jj<=nc).and.(ii/=jj)) then -! ! This is already guaranteed by construction -! ! -! aii = diag(ii) -! ajj = diag(jj) -! wii = w(ii) -! wjj = w(jj) -! edgnrm = aii*(wii**2) + ajj*(wjj**2) -! if (edgnrm > eps) then -! tcoo2%val(k) = done - (2*done*aij*wii*wjj)/(aii*(wii**2) + ajj*(wjj**2)) -! else -! tcoo2%val(k)=eps -! end if -! if (debug) then -! block -! integer(psb_ipk_), parameter :: nr1=329, nc1=393 -! integer(psb_ipk_), parameter :: nr2=13, nc2=77 -! integer(psb_ipk_), parameter :: nr3=313, nc3=249 -! if ( ((ilv(ii)==nr1).and.(ilv(jj)==nc1)).or.((ilv(ii)==nc1).and.(ilv(jj)==nr1))& -! &.or.((ilv(ii)==nr2).and.(ilv(jj)==nc2)).or.((ilv(ii)==nc2).and.(ilv(jj)==nr2)) & -! &.or.((ilv(ii)==nr3).and.(ilv(jj)==nc3)).or.((ilv(ii)==nc3).and.(ilv(jj)==nr3)) & -! &) then -! write(0,*)me, 'Check on ahat:',ii,jj,ilv(ii),ilv(jj),aij,aii,ajj,wii,wjj,tcoo2%val(k) -! end if -! end block -! end if -! -! !else -! ! write(0,*) 'build_ahat: index error :',ii,jj,' : boundaries :',nr,nc -! !end if -! end do -! nz = tcoo2%get_nzeros() -! minabs = minval(abs(tcoo2%val(1:nz))) -! call psb_min(ictxt,minabs) -! if (minabs == dzero) then -! if (me == 0) write(0,*) me, 'Min value for log correction is zero! ' -! minabs = done -! end if -! tcoo2%val(1:nz) = log(abs(tcoo2%val(1:nz))/(0.999*minabs)) -! if (any(tcoo2%val(1:nz)<0)) write(0,*) me, 'Warning: negative log output!' -! call ahat%mv_from(tcoo2) -! -! if (dump) then -! write(aname,'(a,i3.3,a)') 'ahat-l-',me,'.mtx' -! call ahat%print(fname=aname,head='Test ',iv=ilv) -! end if -! -! if (dump) then -! block -! type(psb_ldspmat_type) :: amglob -! !!$ call psb_gather(amglob,a,desc_a,info) -! !!$ if (me==psb_root_) then -! !!$ write(aname,'(a,i3.3,a)') 'a-g-',amglob%get_nrows(),'.mtx' -! !!$ call amglob%print(fname=aname,head='Test ') -! !!$ end if -! call psb_gather(amglob,ahat,desc_a,info) -! if (me==psb_root_) then -! write(aname,'(a,i0,a)') 'ahat-g-',amglob%get_nrows(),'.mtx' -! call amglob%print(fname=aname,head='Test ') -! end if -! write(0,*) 'Done build_ahat' -! end block -! end if -! end if -! -! end subroutine build_ahat_old - subroutine psb_sgtranspose(ain,aout,desc_a,info) use psb_base_mod implicit none @@ -1765,4 +1455,4 @@ contains end subroutine sPMatchBox -end module smatchboxp_mod +end module amg_s_matchboxp_mod diff --git a/amgprec/amg_s_parmatch_aggregator_mod.F90 b/amgprec/amg_s_parmatch_aggregator_mod.F90 index c0aa84cf..dd24ca48 100644 --- a/amgprec/amg_s_parmatch_aggregator_mod.F90 +++ b/amgprec/amg_s_parmatch_aggregator_mod.F90 @@ -9,9 +9,6 @@ ! Salvatore Filippone ! Pasqua D'Ambra ! Fabio Durastante -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante ! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions @@ -121,7 +118,7 @@ module amg_s_parmatch_aggregator_mod use amg_s_base_aggregator_mod - use smatchboxp_mod + use amg_s_matchboxp_mod type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type integer(psb_ipk_) :: matching_alg diff --git a/amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.f90 b/amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.f90 index f50233b3..d1012bd6 100644 --- a/amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.f90 +++ b/amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.f90 @@ -324,7 +324,7 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,& ! if (debug) write(0,*) me,' Into matchbox_build_prol ',info if (do_timings) call psb_tic(idx_mboxp) - call dmatchboxp_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,& + call amg_d_matchboxp_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,& & symmetrize=ag%need_symmetrize,reproducible=ag%reproducible_matching) if (do_timings) call psb_toc(idx_mboxp) if (debug) write(0,*) me,' Out from matchbox_build_prol ',info diff --git a/amgprec/impl/aggregator/amg_s_parmatch_aggregator_tprol.f90 b/amgprec/impl/aggregator/amg_s_parmatch_aggregator_tprol.f90 index 0b4347a5..43bca37a 100644 --- a/amgprec/impl/aggregator/amg_s_parmatch_aggregator_tprol.f90 +++ b/amgprec/impl/aggregator/amg_s_parmatch_aggregator_tprol.f90 @@ -324,7 +324,7 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,& ! if (debug) write(0,*) me,' Into matchbox_build_prol ',info if (do_timings) call psb_tic(idx_mboxp) - call smatchboxp_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,& + call amg_s_matchboxp_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,& & symmetrize=ag%need_symmetrize,reproducible=ag%reproducible_matching) if (do_timings) call psb_toc(idx_mboxp) if (debug) write(0,*) me,' Out from matchbox_build_prol ',info