fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Unify build of unsmoothed, adjust map_to_tprol.

Browse Source
unify_aggr_bld
Salvatore Filippone 4 years ago
parent ce0850f6fc
commit dc03929a06
12 changed files with 60 additions and 272 deletions
Show Stats Download Patch File Download Diff File

4
mlprec/impl/aggregator/mld_c_map_to_tprol.f90
Unescape Escape View File

@ -124,9 +124,9 @@ subroutine mld_c_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
goto 9999 goto 9999
end if end if
call tmpcoo%allocate(ncol,ntaggr,ncol) call tmpcoo%allocate(nrow,ntaggr,ncol)
k = 0 k = 0
do i=1,ncol do i=1,nrow
! !
! Note: at this point, a value ilaggr(i)<=0 ! Note: at this point, a value ilaggr(i)<=0
! tags a "singleton" row, and it has to be ! tags a "singleton" row, and it has to be

2
mlprec/impl/aggregator/mld_c_spmm_bld_inner.f90
Unescape Escape View File

@ -63,7 +63,7 @@ subroutine mld_c_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
& nzt, naggrm1, naggrp1, i, k & nzt, naggrm1, naggrp1, i, k
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false. logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.
integer(psb_ipk_), save :: idx_spspmm=-1 integer(psb_ipk_), save :: idx_spspmm=-1
name='mld_spmm_bld_inner' name='mld_spmm_bld_inner'

77
mlprec/impl/aggregator/mld_caggrmat_nosmth_bld.f90
Unescape Escape View File

@ -145,71 +145,18 @@ subroutine mld_caggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
naggrm1 = sum(nlaggr(1:me)) naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1)) naggrp1 = sum(nlaggr(1:me+1))
if (.false.) then call a%cp_to(acsr)
! call op_prol%mv_to(coo_prol)
! If we ever want to switch to explicit product when building this.. inaggr = naggr
! call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
call a%cp_to(acsr) nzlp = coo_prol%get_nzeros()
call op_prol%mv_to(coo_prol) call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
inaggr = naggr call coo_prol%set_ncols(tmp_desc%get_local_cols())
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr) call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
nzlp = coo_prol%get_nzeros() & coo_prol,tmp_desc,coo_restr,info)
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
call coo_prol%set_ncols(tmp_desc%get_local_cols()) call op_prol%mv_from(coo_prol)
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,& call op_restr%mv_from(coo_restr)
& coo_prol,tmp_desc,coo_restr,info)
call op_prol%mv_from(coo_prol)
call op_restr%mv_from(coo_restr)
else
call a%cp_to(ac_coo)
nzt = ac_coo%get_nzeros()
k = 0
do i = 1, nzt
k = k + 1
ac_coo%ia(k) = ilaggr(ac_coo%ia(i))
ac_coo%ja(k) = ilaggr(ac_coo%ja(i))
ac_coo%val(k) = ac_coo%val(i)
! At this point, there may be negative entries,
! because that's how ILAGGR marks singletons
! If this is the case, roll back K
if ((ac_coo%ia(k)<=0).or.(ac_coo%ja(k)<=0)) k = k-1
enddo
call ac_coo%set_nrows(naggr)
call ac_coo%set_ncols(naggr)
call ac_coo%set_nzeros(k)
call ac_coo%set_dupl(psb_dupl_add_)
call ac_coo%fix(info)
call ac_coo%trim()
call ac%mv_from(ac_coo)
call op_prol%cp_to(tmpcoo)
call tmpcoo%transp()
!
! Now we have to fix this. The only rows of tmpcoo/op_restr that are correct
! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
!
nzl = tmpcoo%get_nzeros()
i = 0
do k = 1, nzl
if ((naggrm1 < tmpcoo%ia(k)) .and.(tmpcoo%ia(k) <= naggrp1)) then
i = i+1
tmpcoo%val(i) = tmpcoo%val(k)
tmpcoo%ia(i) = tmpcoo%ia(k)
tmpcoo%ja(i) = tmpcoo%ja(k)
end if
end do
call tmpcoo%set_nzeros(i)
call tmpcoo%trim()
call op_restr%mv_from(tmpcoo)
if (info /= psb_success_) goto 9999
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

4
mlprec/impl/aggregator/mld_d_map_to_tprol.f90
Unescape Escape View File

@ -124,9 +124,9 @@ subroutine mld_d_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
goto 9999 goto 9999
end if end if
call tmpcoo%allocate(ncol,ntaggr,ncol) call tmpcoo%allocate(nrow,ntaggr,ncol)
k = 0 k = 0
do i=1,ncol do i=1,nrow
! !
! Note: at this point, a value ilaggr(i)<=0 ! Note: at this point, a value ilaggr(i)<=0
! tags a "singleton" row, and it has to be ! tags a "singleton" row, and it has to be

2
mlprec/impl/aggregator/mld_d_spmm_bld_inner.f90
Unescape Escape View File

@ -63,7 +63,7 @@ subroutine mld_d_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
& nzt, naggrm1, naggrp1, i, k & nzt, naggrm1, naggrp1, i, k
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false. logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.
integer(psb_ipk_), save :: idx_spspmm=-1 integer(psb_ipk_), save :: idx_spspmm=-1
name='mld_spmm_bld_inner' name='mld_spmm_bld_inner'

77
mlprec/impl/aggregator/mld_daggrmat_nosmth_bld.f90
Unescape Escape View File

@ -145,71 +145,18 @@ subroutine mld_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
naggrm1 = sum(nlaggr(1:me)) naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1)) naggrp1 = sum(nlaggr(1:me+1))
if (.false.) then call a%cp_to(acsr)
! call op_prol%mv_to(coo_prol)
! If we ever want to switch to explicit product when building this.. inaggr = naggr
! call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
call a%cp_to(acsr) nzlp = coo_prol%get_nzeros()
call op_prol%mv_to(coo_prol) call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
inaggr = naggr call coo_prol%set_ncols(tmp_desc%get_local_cols())
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr) call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
nzlp = coo_prol%get_nzeros() & coo_prol,tmp_desc,coo_restr,info)
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
call coo_prol%set_ncols(tmp_desc%get_local_cols()) call op_prol%mv_from(coo_prol)
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,& call op_restr%mv_from(coo_restr)
& coo_prol,tmp_desc,coo_restr,info)
call op_prol%mv_from(coo_prol)
call op_restr%mv_from(coo_restr)
else
call a%cp_to(ac_coo)
nzt = ac_coo%get_nzeros()
k = 0
do i = 1, nzt
k = k + 1
ac_coo%ia(k) = ilaggr(ac_coo%ia(i))
ac_coo%ja(k) = ilaggr(ac_coo%ja(i))
ac_coo%val(k) = ac_coo%val(i)
! At this point, there may be negative entries,
! because that's how ILAGGR marks singletons
! If this is the case, roll back K
if ((ac_coo%ia(k)<=0).or.(ac_coo%ja(k)<=0)) k = k-1
enddo
call ac_coo%set_nrows(naggr)
call ac_coo%set_ncols(naggr)
call ac_coo%set_nzeros(k)
call ac_coo%set_dupl(psb_dupl_add_)
call ac_coo%fix(info)
call ac_coo%trim()
call ac%mv_from(ac_coo)
call op_prol%cp_to(tmpcoo)
call tmpcoo%transp()
!
! Now we have to fix this. The only rows of tmpcoo/op_restr that are correct
! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
!
nzl = tmpcoo%get_nzeros()
i = 0
do k = 1, nzl
if ((naggrm1 < tmpcoo%ia(k)) .and.(tmpcoo%ia(k) <= naggrp1)) then
i = i+1
tmpcoo%val(i) = tmpcoo%val(k)
tmpcoo%ia(i) = tmpcoo%ia(k)
tmpcoo%ja(i) = tmpcoo%ja(k)
end if
end do
call tmpcoo%set_nzeros(i)
call tmpcoo%trim()
call op_restr%mv_from(tmpcoo)
if (info /= psb_success_) goto 9999
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

4
mlprec/impl/aggregator/mld_s_map_to_tprol.f90
Unescape Escape View File

@ -124,9 +124,9 @@ subroutine mld_s_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
goto 9999 goto 9999
end if end if
call tmpcoo%allocate(ncol,ntaggr,ncol) call tmpcoo%allocate(nrow,ntaggr,ncol)
k = 0 k = 0
do i=1,ncol do i=1,nrow
! !
! Note: at this point, a value ilaggr(i)<=0 ! Note: at this point, a value ilaggr(i)<=0
! tags a "singleton" row, and it has to be ! tags a "singleton" row, and it has to be

2
mlprec/impl/aggregator/mld_s_spmm_bld_inner.f90
Unescape Escape View File

@ -63,7 +63,7 @@ subroutine mld_s_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
& nzt, naggrm1, naggrp1, i, k & nzt, naggrm1, naggrp1, i, k
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false. logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.
integer(psb_ipk_), save :: idx_spspmm=-1 integer(psb_ipk_), save :: idx_spspmm=-1
name='mld_spmm_bld_inner' name='mld_spmm_bld_inner'

77
mlprec/impl/aggregator/mld_saggrmat_nosmth_bld.f90
Unescape Escape View File

@ -145,71 +145,18 @@ subroutine mld_saggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
naggrm1 = sum(nlaggr(1:me)) naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1)) naggrp1 = sum(nlaggr(1:me+1))
if (.false.) then call a%cp_to(acsr)
! call op_prol%mv_to(coo_prol)
! If we ever want to switch to explicit product when building this.. inaggr = naggr
! call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
call a%cp_to(acsr) nzlp = coo_prol%get_nzeros()
call op_prol%mv_to(coo_prol) call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
inaggr = naggr call coo_prol%set_ncols(tmp_desc%get_local_cols())
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr) call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
nzlp = coo_prol%get_nzeros() & coo_prol,tmp_desc,coo_restr,info)
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
call coo_prol%set_ncols(tmp_desc%get_local_cols()) call op_prol%mv_from(coo_prol)
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,& call op_restr%mv_from(coo_restr)
& coo_prol,tmp_desc,coo_restr,info)
call op_prol%mv_from(coo_prol)
call op_restr%mv_from(coo_restr)
else
call a%cp_to(ac_coo)
nzt = ac_coo%get_nzeros()
k = 0
do i = 1, nzt
k = k + 1
ac_coo%ia(k) = ilaggr(ac_coo%ia(i))
ac_coo%ja(k) = ilaggr(ac_coo%ja(i))
ac_coo%val(k) = ac_coo%val(i)
! At this point, there may be negative entries,
! because that's how ILAGGR marks singletons
! If this is the case, roll back K
if ((ac_coo%ia(k)<=0).or.(ac_coo%ja(k)<=0)) k = k-1
enddo
call ac_coo%set_nrows(naggr)
call ac_coo%set_ncols(naggr)
call ac_coo%set_nzeros(k)
call ac_coo%set_dupl(psb_dupl_add_)
call ac_coo%fix(info)
call ac_coo%trim()
call ac%mv_from(ac_coo)
call op_prol%cp_to(tmpcoo)
call tmpcoo%transp()
!
! Now we have to fix this. The only rows of tmpcoo/op_restr that are correct
! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
!
nzl = tmpcoo%get_nzeros()
i = 0
do k = 1, nzl
if ((naggrm1 < tmpcoo%ia(k)) .and.(tmpcoo%ia(k) <= naggrp1)) then
i = i+1
tmpcoo%val(i) = tmpcoo%val(k)
tmpcoo%ia(i) = tmpcoo%ia(k)
tmpcoo%ja(i) = tmpcoo%ja(k)
end if
end do
call tmpcoo%set_nzeros(i)
call tmpcoo%trim()
call op_restr%mv_from(tmpcoo)
if (info /= psb_success_) goto 9999
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

4
mlprec/impl/aggregator/mld_z_map_to_tprol.f90
Unescape Escape View File

@ -124,9 +124,9 @@ subroutine mld_z_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
goto 9999 goto 9999
end if end if
call tmpcoo%allocate(ncol,ntaggr,ncol) call tmpcoo%allocate(nrow,ntaggr,ncol)
k = 0 k = 0
do i=1,ncol do i=1,nrow
! !
! Note: at this point, a value ilaggr(i)<=0 ! Note: at this point, a value ilaggr(i)<=0
! tags a "singleton" row, and it has to be ! tags a "singleton" row, and it has to be

2
mlprec/impl/aggregator/mld_z_spmm_bld_inner.f90
Unescape Escape View File

@ -63,7 +63,7 @@ subroutine mld_z_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, & integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
& nzt, naggrm1, naggrp1, i, k & nzt, naggrm1, naggrp1, i, k
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false. logical, parameter :: do_timings=.false., oldstyle=.false., debug=.false.
integer(psb_ipk_), save :: idx_spspmm=-1 integer(psb_ipk_), save :: idx_spspmm=-1
name='mld_spmm_bld_inner' name='mld_spmm_bld_inner'

77
mlprec/impl/aggregator/mld_zaggrmat_nosmth_bld.f90
Unescape Escape View File

@ -145,71 +145,18 @@ subroutine mld_zaggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
naggrm1 = sum(nlaggr(1:me)) naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1)) naggrp1 = sum(nlaggr(1:me+1))
if (.false.) then call a%cp_to(acsr)
! call op_prol%mv_to(coo_prol)
! If we ever want to switch to explicit product when building this.. inaggr = naggr
! call psb_cdall(ictxt,tmp_desc,info,nl=inaggr)
call a%cp_to(acsr) nzlp = coo_prol%get_nzeros()
call op_prol%mv_to(coo_prol) call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
inaggr = naggr call coo_prol%set_ncols(tmp_desc%get_local_cols())
call psb_cdall(ictxt,tmp_desc,info,nl=inaggr) call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,&
nzlp = coo_prol%get_nzeros() & coo_prol,tmp_desc,coo_restr,info)
call tmp_desc%indxmap%g2lip_ins(coo_prol%ja(1:nzlp),info)
call coo_prol%set_ncols(tmp_desc%get_local_cols()) call op_prol%mv_from(coo_prol)
call mld_spmm_bld_inner(acsr,desc_a,nlaggr,parms,ac,& call op_restr%mv_from(coo_restr)
& coo_prol,tmp_desc,coo_restr,info)
call op_prol%mv_from(coo_prol)
call op_restr%mv_from(coo_restr)
else
call a%cp_to(ac_coo)
nzt = ac_coo%get_nzeros()
k = 0
do i = 1, nzt
k = k + 1
ac_coo%ia(k) = ilaggr(ac_coo%ia(i))
ac_coo%ja(k) = ilaggr(ac_coo%ja(i))
ac_coo%val(k) = ac_coo%val(i)
! At this point, there may be negative entries,
! because that's how ILAGGR marks singletons
! If this is the case, roll back K
if ((ac_coo%ia(k)<=0).or.(ac_coo%ja(k)<=0)) k = k-1
enddo
call ac_coo%set_nrows(naggr)
call ac_coo%set_ncols(naggr)
call ac_coo%set_nzeros(k)
call ac_coo%set_dupl(psb_dupl_add_)
call ac_coo%fix(info)
call ac_coo%trim()
call ac%mv_from(ac_coo)
call op_prol%cp_to(tmpcoo)
call tmpcoo%transp()
!
! Now we have to fix this. The only rows of tmpcoo/op_restr that are correct
! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
!
nzl = tmpcoo%get_nzeros()
i = 0
do k = 1, nzl
if ((naggrm1 < tmpcoo%ia(k)) .and.(tmpcoo%ia(k) <= naggrp1)) then
i = i+1
tmpcoo%val(i) = tmpcoo%val(k)
tmpcoo%ia(i) = tmpcoo%ia(k)
tmpcoo%ja(i) = tmpcoo%ja(k)
end if
end do
call tmpcoo%set_nzeros(i)
call tmpcoo%trim()
call op_restr%mv_from(tmpcoo)
if (info /= psb_success_) goto 9999
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

Write Preview
Loading…
Cancel
Save