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

Fix target coarse size handling.

Browse Source
fix-sludist7
Salvatore Filippone 3 years ago
parent 818f7a78a0
commit 794080e386
2 changed files with 26 additions and 26 deletions
Show Stats Download Patch File Download Diff File

26
amgprec/impl/aggregator/amg_d_parmatch_aggregator_tprol.F90
Unescape Escape View File

@ -68,7 +68,7 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
real(psb_dpk_), allocatable :: tmpw(:), tmpwnxt(:) real(psb_dpk_), allocatable :: tmpw(:), tmpwnxt(:)
integer(psb_lpk_), allocatable :: ixaggr(:), nxaggr(:), tlaggr(:), ivr(:) integer(psb_lpk_), allocatable :: ixaggr(:), nxaggr(:), tlaggr(:), ivr(:)
type(psb_dspmat_type) :: a_tmp type(psb_dspmat_type) :: a_tmp
integer(c_int) :: match_algorithm, n_sweeps, max_csize, max_nlevels integer(c_int) :: match_algorithm, n_sweeps, target_csize, max_nlevels
character(len=40) :: name, ch_err character(len=40) :: name, ch_err
character(len=80) :: fname, prefix_ character(len=80) :: fname, prefix_
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ictxt
@ -128,10 +128,10 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
write(debug_unit, *) 'Warning: AGGR_SIZE reset to value ',2**n_sweeps write(debug_unit, *) 'Warning: AGGR_SIZE reset to value ',2**n_sweeps
end if end if
end if end if
if (ag%max_csize > 0) then if (ag_data%target_coarse_size > 0) then
max_csize = ag%max_csize target_csize = ag_data%target_coarse_size
else else
max_csize = ag_data%min_coarse_size target_csize = ag_data%min_coarse_size
end if end if
if (ag%max_nlevels > 0) then if (ag%max_nlevels > 0) then
max_nlevels = ag%max_nlevels max_nlevels = ag%max_nlevels
@ -141,14 +141,14 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
if (.true.) then if (.true.) then
block block
integer(psb_ipk_) :: ipv(2) integer(psb_ipk_) :: ipv(2)
ipv(1) = max_csize ipv(1) = target_csize
ipv(2) = n_sweeps ipv(2) = n_sweeps
call psb_bcast(ictxt,ipv) call psb_bcast(ictxt,ipv)
max_csize = ipv(1) target_csize = ipv(1)
n_sweeps = ipv(2) n_sweeps = ipv(2)
end block end block
else else
call psb_bcast(ictxt,max_csize) call psb_bcast(ictxt,target_csize)
call psb_bcast(ictxt,n_sweeps) call psb_bcast(ictxt,n_sweeps)
end if end if
if (n_sweeps /= ag%n_sweeps) then if (n_sweeps /= ag%n_sweeps) then
@ -156,7 +156,7 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
end if end if
!!$ if (me==0) write(0,*) 'Matching sweeps: ',n_sweeps !!$ if (me==0) write(0,*) 'Matching sweeps: ',n_sweeps
n_sweeps = max(1,n_sweeps) n_sweeps = max(1,n_sweeps)
if (debug) write(0,*) me,' Copies, with n_sweeps: ',n_sweeps,max_csize if (debug) write(0,*) me,' Copies, with n_sweeps: ',n_sweeps,target_csize
if (ag%unsmoothed_hierarchy.and.allocated(ag%base_a)) then if (ag%unsmoothed_hierarchy.and.allocated(ag%base_a)) then
call ag%base_a%cp_to(acsr) call ag%base_a%cp_to(acsr)
if (ag%do_clean_zeros) call acsr%clean_zeros(info) if (ag%do_clean_zeros) call acsr%clean_zeros(info)
@ -242,7 +242,7 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
if (debug) then if (debug) then
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (me == 0) write(0,*) 'N_sweeps ',n_sweeps,nr,desc_acv(0)%is_ok(),max_csize if (me == 0) write(0,*) 'N_sweeps ',n_sweeps,nr,desc_acv(0)%is_ok(),target_csize
end if end if
! !
@ -300,11 +300,11 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
if (debug) then if (debug) then
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),max_csize,info if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),target_csize,info
csz = sum(nxaggr) csz = sum(nxaggr)
call psb_bcast(ictxt,csz) call psb_bcast(ictxt,csz)
if (csz /= sum(nxaggr)) write(0,*) me,trim(name),' Mismatch matasb',& if (csz /= sum(nxaggr)) write(0,*) me,trim(name),' Mismatch matasb',&
& csz,sum(nxaggr),max_csize & csz,sum(nxaggr),target_csize
end if end if
if (psb_errstatus_fatal()) write(0,*)me,trim(name),'Error fatal on entry to tmpwnxt 2' if (psb_errstatus_fatal()) write(0,*)me,trim(name),'Error fatal on entry to tmpwnxt 2'
@ -342,10 +342,10 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
call move_alloc(tmpwnxt,tmpw) call move_alloc(tmpwnxt,tmpw)
if (debug) then if (debug) then
if (csz /= sum(nlaggr)) write(0,*) me,trim(name),' Mismatch 2 matasb',& if (csz /= sum(nlaggr)) write(0,*) me,trim(name),' Mismatch 2 matasb',&
& csz,sum(nlaggr),max_csize, info & csz,sum(nlaggr),target_csize, info
end if end if
call acv(i-1)%free() call acv(i-1)%free()
if ((sum(nlaggr) <= max_csize).or.(any(nlaggr==0))) then if ((sum(nlaggr) <= target_csize).or.(any(nlaggr==0))) then
x_sweeps = i x_sweeps = i
exit sweeps_loop exit sweeps_loop
end if end if

26
amgprec/impl/aggregator/amg_s_parmatch_aggregator_tprol.F90
Unescape Escape View File

@ -68,7 +68,7 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
real(psb_spk_), allocatable :: tmpw(:), tmpwnxt(:) real(psb_spk_), allocatable :: tmpw(:), tmpwnxt(:)
integer(psb_lpk_), allocatable :: ixaggr(:), nxaggr(:), tlaggr(:), ivr(:) integer(psb_lpk_), allocatable :: ixaggr(:), nxaggr(:), tlaggr(:), ivr(:)
type(psb_sspmat_type) :: a_tmp type(psb_sspmat_type) :: a_tmp
integer(c_int) :: match_algorithm, n_sweeps, max_csize, max_nlevels integer(c_int) :: match_algorithm, n_sweeps, target_csize, max_nlevels
character(len=40) :: name, ch_err character(len=40) :: name, ch_err
character(len=80) :: fname, prefix_ character(len=80) :: fname, prefix_
type(psb_ctxt_type) :: ictxt type(psb_ctxt_type) :: ictxt
@ -128,10 +128,10 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
write(debug_unit, *) 'Warning: AGGR_SIZE reset to value ',2**n_sweeps write(debug_unit, *) 'Warning: AGGR_SIZE reset to value ',2**n_sweeps
end if end if
end if end if
if (ag%max_csize > 0) then if (ag_data%target_coarse_size > 0) then
max_csize = ag%max_csize target_csize = ag_data%target_coarse_size
else else
max_csize = ag_data%min_coarse_size target_csize = ag_data%min_coarse_size
end if end if
if (ag%max_nlevels > 0) then if (ag%max_nlevels > 0) then
max_nlevels = ag%max_nlevels max_nlevels = ag%max_nlevels
@ -141,14 +141,14 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
if (.true.) then if (.true.) then
block block
integer(psb_ipk_) :: ipv(2) integer(psb_ipk_) :: ipv(2)
ipv(1) = max_csize ipv(1) = target_csize
ipv(2) = n_sweeps ipv(2) = n_sweeps
call psb_bcast(ictxt,ipv) call psb_bcast(ictxt,ipv)
max_csize = ipv(1) target_csize = ipv(1)
n_sweeps = ipv(2) n_sweeps = ipv(2)
end block end block
else else
call psb_bcast(ictxt,max_csize) call psb_bcast(ictxt,target_csize)
call psb_bcast(ictxt,n_sweeps) call psb_bcast(ictxt,n_sweeps)
end if end if
if (n_sweeps /= ag%n_sweeps) then if (n_sweeps /= ag%n_sweeps) then
@ -156,7 +156,7 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
end if end if
!!$ if (me==0) write(0,*) 'Matching sweeps: ',n_sweeps !!$ if (me==0) write(0,*) 'Matching sweeps: ',n_sweeps
n_sweeps = max(1,n_sweeps) n_sweeps = max(1,n_sweeps)
if (debug) write(0,*) me,' Copies, with n_sweeps: ',n_sweeps,max_csize if (debug) write(0,*) me,' Copies, with n_sweeps: ',n_sweeps,target_csize
if (ag%unsmoothed_hierarchy.and.allocated(ag%base_a)) then if (ag%unsmoothed_hierarchy.and.allocated(ag%base_a)) then
call ag%base_a%cp_to(acsr) call ag%base_a%cp_to(acsr)
if (ag%do_clean_zeros) call acsr%clean_zeros(info) if (ag%do_clean_zeros) call acsr%clean_zeros(info)
@ -242,7 +242,7 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
if (debug) then if (debug) then
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (me == 0) write(0,*) 'N_sweeps ',n_sweeps,nr,desc_acv(0)%is_ok(),max_csize if (me == 0) write(0,*) 'N_sweeps ',n_sweeps,nr,desc_acv(0)%is_ok(),target_csize
end if end if
! !
@ -300,11 +300,11 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
if (debug) then if (debug) then
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),max_csize,info if (me==0) write(0,*) me,trim(name),' Done mat_asb:',i,sum(nxaggr),target_csize,info
csz = sum(nxaggr) csz = sum(nxaggr)
call psb_bcast(ictxt,csz) call psb_bcast(ictxt,csz)
if (csz /= sum(nxaggr)) write(0,*) me,trim(name),' Mismatch matasb',& if (csz /= sum(nxaggr)) write(0,*) me,trim(name),' Mismatch matasb',&
& csz,sum(nxaggr),max_csize & csz,sum(nxaggr),target_csize
end if end if
if (psb_errstatus_fatal()) write(0,*)me,trim(name),'Error fatal on entry to tmpwnxt 2' if (psb_errstatus_fatal()) write(0,*)me,trim(name),'Error fatal on entry to tmpwnxt 2'
@ -342,10 +342,10 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
call move_alloc(tmpwnxt,tmpw) call move_alloc(tmpwnxt,tmpw)
if (debug) then if (debug) then
if (csz /= sum(nlaggr)) write(0,*) me,trim(name),' Mismatch 2 matasb',& if (csz /= sum(nlaggr)) write(0,*) me,trim(name),' Mismatch 2 matasb',&
& csz,sum(nlaggr),max_csize, info & csz,sum(nlaggr),target_csize, info
end if end if
call acv(i-1)%free() call acv(i-1)%free()
if ((sum(nlaggr) <= max_csize).or.(any(nlaggr==0))) then if ((sum(nlaggr) <= target_csize).or.(any(nlaggr==0))) then
x_sweeps = i x_sweeps = i
exit sweeps_loop exit sweeps_loop
end if end if

Write Preview
Loading…
Cancel
Save