fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 22:55:12 +00:00
Code Issues Packages Projects Releases Wiki Activity

mld2p4-2:

Browse Source 
mlprec/impl/mld_c_bld_mlhier_aggsize.f90
 mlprec/impl/mld_c_bld_mlhier_array.f90
 mlprec/impl/mld_ccprecset.F90
 mlprec/impl/mld_cmlprec_bld.f90
 mlprec/impl/mld_cprecinit.F90
 mlprec/impl/mld_cprecset.F90
 mlprec/impl/mld_d_bld_mlhier_aggsize.f90
 mlprec/impl/mld_d_bld_mlhier_array.f90
 mlprec/impl/mld_dcprecset.F90
 mlprec/impl/mld_dmlprec_bld.f90
 mlprec/impl/mld_dprecinit.F90
 mlprec/impl/mld_dprecset.F90
 mlprec/impl/mld_s_bld_mlhier_aggsize.f90
 mlprec/impl/mld_s_bld_mlhier_array.f90
 mlprec/impl/mld_scprecset.F90
 mlprec/impl/mld_smlprec_bld.f90
 mlprec/impl/mld_sprecinit.F90
 mlprec/impl/mld_sprecset.F90
 mlprec/impl/mld_z_bld_mlhier_aggsize.f90
 mlprec/impl/mld_z_bld_mlhier_array.f90
 mlprec/impl/mld_zcprecset.F90
 mlprec/impl/mld_zmlprec_bld.f90
 mlprec/impl/mld_zprecinit.F90
 mlprec/impl/mld_zprecset.F90
 mlprec/mld_base_prec_type.F90
 mlprec/mld_c_inner_mod.f90
 mlprec/mld_c_prec_type.f90
 mlprec/mld_d_inner_mod.f90
 mlprec/mld_d_prec_type.f90
 mlprec/mld_s_inner_mod.f90
 mlprec/mld_s_prec_type.f90
 mlprec/mld_z_inner_mod.f90
 mlprec/mld_z_prec_type.f90
 tests/pdegen/ppde3d.f90

New strategies for building ML hierarchy.
This commit is contained in:
Salvatore Filippone
2016-05-22 12:52:49 +00:00
parent 46de48ffa9
commit a58a2081e2
34 changed files with 785 additions and 273 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/impl/mld_c_bld_mlhier_aggsize.f90
+30 -22
View File
@@ -40,27 +40,28 @@
! Build an aggregation hierarchy with a target aggregation size
!
!
subroutine mld_c_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
subroutine mld_c_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,info)
use psb_base_mod
use mld_c_inner_mod, mld_protect_name => mld_c_bld_mlhier_aggsize
use mld_c_prec_mod
implicit none
integer(psb_ipk_), intent(in) :: casize
integer(psb_ipk_), intent(inout) :: iszv
integer(psb_ipk_), intent(in) :: casize,mxplevs
real(psb_spk_) :: mnaggratio
type(psb_cspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_c_onelev_type), allocatable, target, intent(inout) :: precv(:)
integer(psb_ipk_), intent(out) :: info
! Local
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, newsz
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, iaggsize
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
character :: upd_
class(mld_c_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm
type(mld_sml_parms) :: baseparms, medparms, coarseparms
type(mld_sml_parms) :: baseparms, medparms, coarseparms
type(mld_c_onelev_node), pointer :: head, tail, newnode, current
integer(psb_ipk_) :: debug_level, debug_unit
real(psb_spk_) :: sizeratio
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
name = 'mld_bld_mlhier_aggsize'
if (psb_get_errstatus().ne.0) return
@@ -74,6 +75,7 @@ subroutine mld_c_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
!
! New strategy to build according to coarse size.
!
iszv = size(precv)
coarseparms = precv(iszv)%parms
baseparms = precv(1)%parms
medparms = precv(2)%parms
@@ -126,13 +128,27 @@ subroutine mld_c_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
call psb_errpush(info,name,a_err='build next level'); goto 9999
end if
if (newsz>2) then
if (all(current%item%map%naggr == newnode%item%map%naggr)) then
current => current%next
tail => current
iaggsize = sum(current%item%map%naggr)
if (iaggsize <= casize) then
!
! Target reached; but we may need to rebuild.
!
exit list_build_loop
end if
if (newsz>2) then
sizeratio = iaggsize
sizeratio = sum(current%prev%item%map%naggr)/sizeratio
if (sizeratio < mnaggratio) then
!
! We are not gaining anything
! We are not gaining
!
newsz = newsz-1
current%next => null()
current => current%prev
current%next =>null()
call newnode%item%free(info)
if (info == psb_success_) deallocate(newnode,stat=info)
if (info /= psb_success_) then
@@ -143,14 +159,6 @@ subroutine mld_c_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
end if
end if
current => current%next
tail => current
if (sum(current%item%map%naggr) <= casize) then
!
! Target reached; but we may need to rebuild.
!
exit list_build_loop
end if
end do list_build_loop
!
! At this point, we are at the list tail,
mlprec/impl/mld_c_bld_mlhier_array.f90
+62 -4
View File
@@ -37,20 +37,22 @@
!!$
!!$
subroutine mld_c_bld_mlhier_array(a,desc_a,iszv,precv,info)
subroutine mld_c_bld_mlhier_array(nplevs,a,desc_a,precv,info)
use psb_base_mod
use mld_c_inner_mod, mld_protect_name => mld_c_bld_mlhier_array
use mld_c_prec_mod
implicit none
integer(psb_ipk_), intent(inout) :: iszv
integer(psb_ipk_), intent(inout) :: nplevs
type(psb_cspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_c_onelev_type),intent(inout), allocatable, target :: precv(:)
integer(psb_ipk_), intent(out) :: info
! Local
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, newsz
integer(psb_ipk_) :: err,i,k, err_act, newsz, iszv
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
class(mld_c_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm
type(mld_sml_parms) :: baseparms, medparms, coarseparms
type(mld_c_onelev_type), allocatable :: tprecv(:)
integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: debug_level, debug_unit
@@ -64,6 +66,22 @@ subroutine mld_c_bld_mlhier_array(a,desc_a,iszv,precv,info)
debug_level = psb_get_debug_level()
ictxt = desc_a%get_ctxt()
call psb_info(ictxt,me,np)
iszv = size(precv)
coarseparms = precv(iszv)%parms
baseparms = precv(1)%parms
medparms = precv(2)%parms
allocate(coarse_sm, source=precv(iszv)%sm,stat=info)
if (info == psb_success_) &
& allocate(med_sm, source=precv(2)%sm,stat=info)
if (info == psb_success_) &
& allocate(base_sm, source=precv(1)%sm,stat=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
!
!
@@ -75,12 +93,52 @@ subroutine mld_c_bld_mlhier_array(a,desc_a,iszv,precv,info)
! on all processes.
!
call psb_bcast(ictxt,precv(1)%parms)
iszv = size(precv)
!
! First set desired number of levels
!
if (iszv /= nplevs) then
allocate(tprecv(nplevs),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='prec reallocation')
goto 9999
endif
tprecv(1)%parms = baseparms
allocate(tprecv(1)%sm,source=base_sm,stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='prec reallocation')
goto 9999
endif
do i=2,nplevs-1
tprecv(i)%parms = medparms
allocate(tprecv(i)%sm,source=med_sm,stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='prec reallocation')
goto 9999
endif
end do
tprecv(nplevs)%parms = coarseparms
allocate(tprecv(nplevs)%sm,source=coarse_sm,stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='prec reallocation')
goto 9999
endif
do i=1,iszv
call precv(i)%free(info)
end do
call move_alloc(tprecv,precv)
iszv = size(precv)
end if
!
! Finest level first; remember to fix base_a and base_desc
!
precv(1)%base_a => a
precv(1)%base_desc => desc_a
iszv = size(precv)
array_build_loop: do i=2, iszv
!
mlprec/impl/mld_ccprecset.F90
+18 -2
View File
@@ -132,10 +132,20 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,pos)
return
endif
if (psb_toupper(what) == 'COARSE_AGGR_SIZE') then
select case(psb_toupper(what))
case ('COARSE_AGGR_SIZE')
p%coarse_aggr_size = max(val,-1)
return
end if
case ('N_PREC_LEVS')
p%n_prec_levs = max(val,1)
return
case('MAX_PREC_LEVS')
p%max_prec_levs = max(val,1)
return
end select
!
! Set preconditioner parameters at level ilev.
!
@@ -465,6 +475,12 @@ subroutine mld_ccprecsetr(p,what,val,info,ilev,pos)
else
ilev_ = 1
end if
select case(psb_toupper(what))
case ('MIN_AGGR_RATIO')
p%min_aggr_ratio = max(sone,val)
return
end select
if (.not.allocated(p%precv)) then
write(psb_err_unit,*) name,&
mlprec/impl/mld_cmlprec_bld.f90
+54 -27
View File
@@ -93,12 +93,13 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
!!$ character, intent(in), optional :: upd
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
@@ -144,23 +145,42 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
!
! Check to ensure all procs have the same
!
newsz = -1
casize = p%coarse_aggr_size
iszv = size(p%precv)
newsz = -1
casize = p%coarse_aggr_size
nplevs = p%n_prec_levs
mxplevs = p%max_prec_levs
mnaggratio = p%min_aggr_ratio
casize = p%coarse_aggr_size
iszv = size(p%precv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize)
if (casize > 0) then
if (casize /= p%coarse_aggr_size) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size')
goto 9999
end if
else
if (iszv /= size(p%precv)) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999
end if
call psb_bcast(ictxt,nplevs)
call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio)
if (casize /= p%coarse_aggr_size) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size')
goto 9999
end if
if (nplevs /= p%n_prec_levs) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent n_prec_levs')
goto 9999
end if
if (mxplevs /= p%max_prec_levs) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs')
goto 9999
end if
if (mnaggratio /= p%min_aggr_ratio) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio')
goto 9999
end if
if (iszv /= size(p%precv)) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999
end if
if (iszv <= 1) then
@@ -171,20 +191,27 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
goto 9999
endif
if (casize>0) then
if (nplevs <= 0) then
!
! This should become the default strategy, we specify a target aggregation size.
!
call mld_bld_mlhier_aggsize(casize,a,desc_a,iszv,p%precv,info)
if (casize <=0) then
!
! Default to the cubic root of the size at base level.
!
casize = desc_a%get_global_rows()
casize = int((sone*casize)**(sone/(sone*3)),psb_ipk_)
casize = max(casize,ione)
end if
call mld_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,p%precv,info)
else
!
! Oldstyle with fixed number of levels.
!
call mld_bld_mlhier_array(a,desc_a,p%precv,info)
nplevs = max(itwo,min(nplevs,mxplevs))
call mld_bld_mlhier_array(nplevs,a,desc_a,p%precv,info)
end if
iszv = size(p%precv)
!
mlprec/impl/mld_cprecinit.F90
+4 -2
View File
@@ -165,9 +165,11 @@ subroutine mld_cprecinit(p,ptype,info,nlev)
case ('ML')
if (present(nlev)) then
nlev_ = max(1,nlev)
nlev_ = max(1,nlev)
p%n_prec_levs = nlev_
else
nlev_ = 2
nlev_ = 3
p%n_prec_levs = -ione
end if
ilev_ = 1
allocate(p%precv(nlev_),stat=info)
mlprec/impl/mld_cprecset.F90
+16 -2
View File
@@ -131,10 +131,18 @@ subroutine mld_cprecseti(p,what,val,info,ilev,pos)
return
endif
if (what == mld_coarse_aggr_size_) then
select case(what)
case (mld_coarse_aggr_size_)
p%coarse_aggr_size = max(val,-1)
return
end if
case (mld_n_prec_levs_)
p%n_prec_levs = max(val,1)
return
case(mld_max_prec_levs_)
p%max_prec_levs = max(val,1)
return
end select
!
! Set preconditioner parameters at level ilev.
@@ -564,6 +572,12 @@ subroutine mld_cprecsetr(p,what,val,info,ilev,pos)
info = psb_success_
select case(what)
case (mld_min_aggr_ratio_)
p%min_aggr_ratio = max(sone,val)
return
end select
if (present(ilev)) then
ilev_ = ilev
else
mlprec/impl/mld_d_bld_mlhier_aggsize.f90
+30 -22
View File
@@ -40,27 +40,28 @@
! Build an aggregation hierarchy with a target aggregation size
!
!
subroutine mld_d_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
subroutine mld_d_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,info)
use psb_base_mod
use mld_d_inner_mod, mld_protect_name => mld_d_bld_mlhier_aggsize
use mld_d_prec_mod
implicit none
integer(psb_ipk_), intent(in) :: casize
integer(psb_ipk_), intent(inout) :: iszv
integer(psb_ipk_), intent(in) :: casize,mxplevs
real(psb_dpk_) :: mnaggratio
type(psb_dspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_d_onelev_type), allocatable, target, intent(inout) :: precv(:)
integer(psb_ipk_), intent(out) :: info
! Local
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, newsz
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, iaggsize
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
character :: upd_
class(mld_d_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm
type(mld_dml_parms) :: baseparms, medparms, coarseparms
type(mld_dml_parms) :: baseparms, medparms, coarseparms
type(mld_d_onelev_node), pointer :: head, tail, newnode, current
integer(psb_ipk_) :: debug_level, debug_unit
real(psb_dpk_) :: sizeratio
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
name = 'mld_bld_mlhier_aggsize'
if (psb_get_errstatus().ne.0) return
@@ -74,6 +75,7 @@ subroutine mld_d_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
!
! New strategy to build according to coarse size.
!
iszv = size(precv)
coarseparms = precv(iszv)%parms
baseparms = precv(1)%parms
medparms = precv(2)%parms
@@ -126,13 +128,27 @@ subroutine mld_d_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
call psb_errpush(info,name,a_err='build next level'); goto 9999
end if
if (newsz>2) then
if (all(current%item%map%naggr == newnode%item%map%naggr)) then
current => current%next
tail => current
iaggsize = sum(current%item%map%naggr)
if (iaggsize <= casize) then
!
! Target reached; but we may need to rebuild.
!
exit list_build_loop
end if
if (newsz>2) then
sizeratio = iaggsize
sizeratio = sum(current%prev%item%map%naggr)/sizeratio
if (sizeratio < mnaggratio) then
!
! We are not gaining anything
! We are not gaining
!
newsz = newsz-1
current%next => null()
current => current%prev
current%next =>null()
call newnode%item%free(info)
if (info == psb_success_) deallocate(newnode,stat=info)
if (info /= psb_success_) then
@@ -143,14 +159,6 @@ subroutine mld_d_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
end if
end if
current => current%next
tail => current
if (sum(current%item%map%naggr) <= casize) then
!
! Target reached; but we may need to rebuild.
!
exit list_build_loop
end if
end do list_build_loop
!
! At this point, we are at the list tail,
mlprec/impl/mld_d_bld_mlhier_array.f90
+62 -4
View File
@@ -37,20 +37,22 @@
!!$
!!$
subroutine mld_d_bld_mlhier_array(a,desc_a,iszv,precv,info)
subroutine mld_d_bld_mlhier_array(nplevs,a,desc_a,precv,info)
use psb_base_mod
use mld_d_inner_mod, mld_protect_name => mld_d_bld_mlhier_array
use mld_d_prec_mod
implicit none
integer(psb_ipk_), intent(inout) :: iszv
integer(psb_ipk_), intent(inout) :: nplevs
type(psb_dspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_d_onelev_type),intent(inout), allocatable, target :: precv(:)
integer(psb_ipk_), intent(out) :: info
! Local
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, newsz
integer(psb_ipk_) :: err,i,k, err_act, newsz, iszv
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
class(mld_d_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm
type(mld_dml_parms) :: baseparms, medparms, coarseparms
type(mld_d_onelev_type), allocatable :: tprecv(:)
integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: debug_level, debug_unit
@@ -64,6 +66,22 @@ subroutine mld_d_bld_mlhier_array(a,desc_a,iszv,precv,info)
debug_level = psb_get_debug_level()
ictxt = desc_a%get_ctxt()
call psb_info(ictxt,me,np)
iszv = size(precv)
coarseparms = precv(iszv)%parms
baseparms = precv(1)%parms
medparms = precv(2)%parms
allocate(coarse_sm, source=precv(iszv)%sm,stat=info)
if (info == psb_success_) &
& allocate(med_sm, source=precv(2)%sm,stat=info)
if (info == psb_success_) &
& allocate(base_sm, source=precv(1)%sm,stat=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
!
!
@@ -75,12 +93,52 @@ subroutine mld_d_bld_mlhier_array(a,desc_a,iszv,precv,info)
! on all processes.
!
call psb_bcast(ictxt,precv(1)%parms)
iszv = size(precv)
!
! First set desired number of levels
!
if (iszv /= nplevs) then
allocate(tprecv(nplevs),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='prec reallocation')
goto 9999
endif
tprecv(1)%parms = baseparms
allocate(tprecv(1)%sm,source=base_sm,stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='prec reallocation')
goto 9999
endif
do i=2,nplevs-1
tprecv(i)%parms = medparms
allocate(tprecv(i)%sm,source=med_sm,stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='prec reallocation')
goto 9999
endif
end do
tprecv(nplevs)%parms = coarseparms
allocate(tprecv(nplevs)%sm,source=coarse_sm,stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='prec reallocation')
goto 9999
endif
do i=1,iszv
call precv(i)%free(info)
end do
call move_alloc(tprecv,precv)
iszv = size(precv)
end if
!
! Finest level first; remember to fix base_a and base_desc
!
precv(1)%base_a => a
precv(1)%base_desc => desc_a
iszv = size(precv)
array_build_loop: do i=2, iszv
!
mlprec/impl/mld_dcprecset.F90
+18 -2
View File
@@ -138,10 +138,20 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,pos)
return
endif
if (psb_toupper(what) == 'COARSE_AGGR_SIZE') then
select case(psb_toupper(what))
case ('COARSE_AGGR_SIZE')
p%coarse_aggr_size = max(val,-1)
return
end if
case ('N_PREC_LEVS')
p%n_prec_levs = max(val,1)
return
case('MAX_PREC_LEVS')
p%max_prec_levs = max(val,1)
return
end select
!
! Set preconditioner parameters at level ilev.
!
@@ -475,6 +485,12 @@ subroutine mld_dcprecsetr(p,what,val,info,ilev,pos)
else
ilev_ = 1
end if
select case(psb_toupper(what))
case ('MIN_AGGR_RATIO')
p%min_aggr_ratio = max(done,val)
return
end select
if (.not.allocated(p%precv)) then
write(psb_err_unit,*) name,&
mlprec/impl/mld_dmlprec_bld.f90
+54 -27
View File
@@ -93,12 +93,13 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
!!$ character, intent(in), optional :: upd
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
real(psb_dpk_) :: mnaggratio
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
@@ -144,23 +145,42 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
!
! Check to ensure all procs have the same
!
newsz = -1
casize = p%coarse_aggr_size
iszv = size(p%precv)
newsz = -1
casize = p%coarse_aggr_size
nplevs = p%n_prec_levs
mxplevs = p%max_prec_levs
mnaggratio = p%min_aggr_ratio
casize = p%coarse_aggr_size
iszv = size(p%precv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize)
if (casize > 0) then
if (casize /= p%coarse_aggr_size) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size')
goto 9999
end if
else
if (iszv /= size(p%precv)) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999
end if
call psb_bcast(ictxt,nplevs)
call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio)
if (casize /= p%coarse_aggr_size) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size')
goto 9999
end if
if (nplevs /= p%n_prec_levs) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent n_prec_levs')
goto 9999
end if
if (mxplevs /= p%max_prec_levs) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs')
goto 9999
end if
if (mnaggratio /= p%min_aggr_ratio) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio')
goto 9999
end if
if (iszv /= size(p%precv)) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999
end if
if (iszv <= 1) then
@@ -171,20 +191,27 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
goto 9999
endif
if (casize>0) then
if (nplevs <= 0) then
!
! This should become the default strategy, we specify a target aggregation size.
!
call mld_bld_mlhier_aggsize(casize,a,desc_a,iszv,p%precv,info)
if (casize <=0) then
!
! Default to the cubic root of the size at base level.
!
casize = desc_a%get_global_rows()
casize = int((done*casize)**(done/(done*3)),psb_ipk_)
casize = max(casize,ione)
end if
call mld_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,p%precv,info)
else
!
! Oldstyle with fixed number of levels.
!
call mld_bld_mlhier_array(a,desc_a,p%precv,info)
nplevs = max(itwo,min(nplevs,mxplevs))
call mld_bld_mlhier_array(nplevs,a,desc_a,p%precv,info)
end if
iszv = size(p%precv)
!
mlprec/impl/mld_dprecinit.F90
+4 -2
View File
@@ -168,9 +168,11 @@ subroutine mld_dprecinit(p,ptype,info,nlev)
case ('ML')
if (present(nlev)) then
nlev_ = max(1,nlev)
nlev_ = max(1,nlev)
!p%n_prec_levs = nlev_
else
nlev_ = 2
nlev_ = 3
!p%n_prec_levs = -ione
end if
ilev_ = 1
allocate(p%precv(nlev_),stat=info)
mlprec/impl/mld_dprecset.F90
+16 -2
View File
@@ -137,10 +137,18 @@ subroutine mld_dprecseti(p,what,val,info,ilev,pos)
return
endif
if (what == mld_coarse_aggr_size_) then
select case(what)
case (mld_coarse_aggr_size_)
p%coarse_aggr_size = max(val,-1)
return
end if
case (mld_n_prec_levs_)
p%n_prec_levs = max(val,1)
return
case(mld_max_prec_levs_)
p%max_prec_levs = max(val,1)
return
end select
!
! Set preconditioner parameters at level ilev.
@@ -574,6 +582,12 @@ subroutine mld_dprecsetr(p,what,val,info,ilev,pos)
info = psb_success_
select case(what)
case (mld_min_aggr_ratio_)
p%min_aggr_ratio = max(done,val)
return
end select
if (present(ilev)) then
ilev_ = ilev
else
mlprec/impl/mld_s_bld_mlhier_aggsize.f90
+30 -22
View File
@@ -40,27 +40,28 @@
! Build an aggregation hierarchy with a target aggregation size
!
!
subroutine mld_s_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
subroutine mld_s_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,info)
use psb_base_mod
use mld_s_inner_mod, mld_protect_name => mld_s_bld_mlhier_aggsize
use mld_s_prec_mod
implicit none
integer(psb_ipk_), intent(in) :: casize
integer(psb_ipk_), intent(inout) :: iszv
integer(psb_ipk_), intent(in) :: casize,mxplevs
real(psb_spk_) :: mnaggratio
type(psb_sspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_s_onelev_type), allocatable, target, intent(inout) :: precv(:)
integer(psb_ipk_), intent(out) :: info
! Local
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, newsz
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, iaggsize
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
character :: upd_
class(mld_s_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm
type(mld_sml_parms) :: baseparms, medparms, coarseparms
type(mld_sml_parms) :: baseparms, medparms, coarseparms
type(mld_s_onelev_node), pointer :: head, tail, newnode, current
integer(psb_ipk_) :: debug_level, debug_unit
real(psb_spk_) :: sizeratio
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
name = 'mld_bld_mlhier_aggsize'
if (psb_get_errstatus().ne.0) return
@@ -74,6 +75,7 @@ subroutine mld_s_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
!
! New strategy to build according to coarse size.
!
iszv = size(precv)
coarseparms = precv(iszv)%parms
baseparms = precv(1)%parms
medparms = precv(2)%parms
@@ -126,13 +128,27 @@ subroutine mld_s_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
call psb_errpush(info,name,a_err='build next level'); goto 9999
end if
if (newsz>2) then
if (all(current%item%map%naggr == newnode%item%map%naggr)) then
current => current%next
tail => current
iaggsize = sum(current%item%map%naggr)
if (iaggsize <= casize) then
!
! Target reached; but we may need to rebuild.
!
exit list_build_loop
end if
if (newsz>2) then
sizeratio = iaggsize
sizeratio = sum(current%prev%item%map%naggr)/sizeratio
if (sizeratio < mnaggratio) then
!
! We are not gaining anything
! We are not gaining
!
newsz = newsz-1
current%next => null()
current => current%prev
current%next =>null()
call newnode%item%free(info)
if (info == psb_success_) deallocate(newnode,stat=info)
if (info /= psb_success_) then
@@ -143,14 +159,6 @@ subroutine mld_s_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
end if
end if
current => current%next
tail => current
if (sum(current%item%map%naggr) <= casize) then
!
! Target reached; but we may need to rebuild.
!
exit list_build_loop
end if
end do list_build_loop
!
! At this point, we are at the list tail,
mlprec/impl/mld_s_bld_mlhier_array.f90
+62 -4
View File
@@ -37,20 +37,22 @@
!!$
!!$
subroutine mld_s_bld_mlhier_array(a,desc_a,iszv,precv,info)
subroutine mld_s_bld_mlhier_array(nplevs,a,desc_a,precv,info)
use psb_base_mod
use mld_s_inner_mod, mld_protect_name => mld_s_bld_mlhier_array
use mld_s_prec_mod
implicit none
integer(psb_ipk_), intent(inout) :: iszv
integer(psb_ipk_), intent(inout) :: nplevs
type(psb_sspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_s_onelev_type),intent(inout), allocatable, target :: precv(:)
integer(psb_ipk_), intent(out) :: info
! Local
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, newsz
integer(psb_ipk_) :: err,i,k, err_act, newsz, iszv
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
class(mld_s_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm
type(mld_sml_parms) :: baseparms, medparms, coarseparms
type(mld_s_onelev_type), allocatable :: tprecv(:)
integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: debug_level, debug_unit
@@ -64,6 +66,22 @@ subroutine mld_s_bld_mlhier_array(a,desc_a,iszv,precv,info)
debug_level = psb_get_debug_level()
ictxt = desc_a%get_ctxt()
call psb_info(ictxt,me,np)
iszv = size(precv)
coarseparms = precv(iszv)%parms
baseparms = precv(1)%parms
medparms = precv(2)%parms
allocate(coarse_sm, source=precv(iszv)%sm,stat=info)
if (info == psb_success_) &
& allocate(med_sm, source=precv(2)%sm,stat=info)
if (info == psb_success_) &
& allocate(base_sm, source=precv(1)%sm,stat=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
!
!
@@ -75,12 +93,52 @@ subroutine mld_s_bld_mlhier_array(a,desc_a,iszv,precv,info)
! on all processes.
!
call psb_bcast(ictxt,precv(1)%parms)
iszv = size(precv)
!
! First set desired number of levels
!
if (iszv /= nplevs) then
allocate(tprecv(nplevs),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='prec reallocation')
goto 9999
endif
tprecv(1)%parms = baseparms
allocate(tprecv(1)%sm,source=base_sm,stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='prec reallocation')
goto 9999
endif
do i=2,nplevs-1
tprecv(i)%parms = medparms
allocate(tprecv(i)%sm,source=med_sm,stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='prec reallocation')
goto 9999
endif
end do
tprecv(nplevs)%parms = coarseparms
allocate(tprecv(nplevs)%sm,source=coarse_sm,stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='prec reallocation')
goto 9999
endif
do i=1,iszv
call precv(i)%free(info)
end do
call move_alloc(tprecv,precv)
iszv = size(precv)
end if
!
! Finest level first; remember to fix base_a and base_desc
!
precv(1)%base_a => a
precv(1)%base_desc => desc_a
iszv = size(precv)
array_build_loop: do i=2, iszv
!
mlprec/impl/mld_scprecset.F90
+18 -2
View File
@@ -132,10 +132,20 @@ subroutine mld_scprecseti(p,what,val,info,ilev,pos)
return
endif
if (psb_toupper(what) == 'COARSE_AGGR_SIZE') then
select case(psb_toupper(what))
case ('COARSE_AGGR_SIZE')
p%coarse_aggr_size = max(val,-1)
return
end if
case ('N_PREC_LEVS')
p%n_prec_levs = max(val,1)
return
case('MAX_PREC_LEVS')
p%max_prec_levs = max(val,1)
return
end select
!
! Set preconditioner parameters at level ilev.
!
@@ -465,6 +475,12 @@ subroutine mld_scprecsetr(p,what,val,info,ilev,pos)
else
ilev_ = 1
end if
select case(psb_toupper(what))
case ('MIN_AGGR_RATIO')
p%min_aggr_ratio = max(sone,val)
return
end select
if (.not.allocated(p%precv)) then
write(psb_err_unit,*) name,&
mlprec/impl/mld_smlprec_bld.f90
+54 -27
View File
@@ -93,12 +93,13 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
!!$ character, intent(in), optional :: upd
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
@@ -144,23 +145,42 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
!
! Check to ensure all procs have the same
!
newsz = -1
casize = p%coarse_aggr_size
iszv = size(p%precv)
newsz = -1
casize = p%coarse_aggr_size
nplevs = p%n_prec_levs
mxplevs = p%max_prec_levs
mnaggratio = p%min_aggr_ratio
casize = p%coarse_aggr_size
iszv = size(p%precv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize)
if (casize > 0) then
if (casize /= p%coarse_aggr_size) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size')
goto 9999
end if
else
if (iszv /= size(p%precv)) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999
end if
call psb_bcast(ictxt,nplevs)
call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio)
if (casize /= p%coarse_aggr_size) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size')
goto 9999
end if
if (nplevs /= p%n_prec_levs) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent n_prec_levs')
goto 9999
end if
if (mxplevs /= p%max_prec_levs) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs')
goto 9999
end if
if (mnaggratio /= p%min_aggr_ratio) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio')
goto 9999
end if
if (iszv /= size(p%precv)) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999
end if
if (iszv <= 1) then
@@ -171,20 +191,27 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
goto 9999
endif
if (casize>0) then
if (nplevs <= 0) then
!
! This should become the default strategy, we specify a target aggregation size.
!
call mld_bld_mlhier_aggsize(casize,a,desc_a,iszv,p%precv,info)
if (casize <=0) then
!
! Default to the cubic root of the size at base level.
!
casize = desc_a%get_global_rows()
casize = int((sone*casize)**(sone/(sone*3)),psb_ipk_)
casize = max(casize,ione)
end if
call mld_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,p%precv,info)
else
!
! Oldstyle with fixed number of levels.
!
call mld_bld_mlhier_array(a,desc_a,p%precv,info)
nplevs = max(itwo,min(nplevs,mxplevs))
call mld_bld_mlhier_array(nplevs,a,desc_a,p%precv,info)
end if
iszv = size(p%precv)
!
mlprec/impl/mld_sprecinit.F90
+4 -2
View File
@@ -165,9 +165,11 @@ subroutine mld_sprecinit(p,ptype,info,nlev)
case ('ML')
if (present(nlev)) then
nlev_ = max(1,nlev)
nlev_ = max(1,nlev)
p%n_prec_levs = nlev_
else
nlev_ = 2
nlev_ = 3
p%n_prec_levs = -ione
end if
ilev_ = 1
allocate(p%precv(nlev_),stat=info)
mlprec/impl/mld_sprecset.F90
+16 -2
View File
@@ -131,10 +131,18 @@ subroutine mld_sprecseti(p,what,val,info,ilev,pos)
return
endif
if (what == mld_coarse_aggr_size_) then
select case(what)
case (mld_coarse_aggr_size_)
p%coarse_aggr_size = max(val,-1)
return
end if
case (mld_n_prec_levs_)
p%n_prec_levs = max(val,1)
return
case(mld_max_prec_levs_)
p%max_prec_levs = max(val,1)
return
end select
!
! Set preconditioner parameters at level ilev.
@@ -564,6 +572,12 @@ subroutine mld_sprecsetr(p,what,val,info,ilev,pos)
info = psb_success_
select case(what)
case (mld_min_aggr_ratio_)
p%min_aggr_ratio = max(sone,val)
return
end select
if (present(ilev)) then
ilev_ = ilev
else
mlprec/impl/mld_z_bld_mlhier_aggsize.f90
+30 -22
View File
@@ -40,27 +40,28 @@
! Build an aggregation hierarchy with a target aggregation size
!
!
subroutine mld_z_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
subroutine mld_z_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,info)
use psb_base_mod
use mld_z_inner_mod, mld_protect_name => mld_z_bld_mlhier_aggsize
use mld_z_prec_mod
implicit none
integer(psb_ipk_), intent(in) :: casize
integer(psb_ipk_), intent(inout) :: iszv
integer(psb_ipk_), intent(in) :: casize,mxplevs
real(psb_dpk_) :: mnaggratio
type(psb_zspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_z_onelev_type), allocatable, target, intent(inout) :: precv(:)
integer(psb_ipk_), intent(out) :: info
! Local
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, newsz
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, iaggsize
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
character :: upd_
class(mld_z_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm
type(mld_dml_parms) :: baseparms, medparms, coarseparms
type(mld_dml_parms) :: baseparms, medparms, coarseparms
type(mld_z_onelev_node), pointer :: head, tail, newnode, current
integer(psb_ipk_) :: debug_level, debug_unit
real(psb_dpk_) :: sizeratio
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
name = 'mld_bld_mlhier_aggsize'
if (psb_get_errstatus().ne.0) return
@@ -74,6 +75,7 @@ subroutine mld_z_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
!
! New strategy to build according to coarse size.
!
iszv = size(precv)
coarseparms = precv(iszv)%parms
baseparms = precv(1)%parms
medparms = precv(2)%parms
@@ -126,13 +128,27 @@ subroutine mld_z_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
call psb_errpush(info,name,a_err='build next level'); goto 9999
end if
if (newsz>2) then
if (all(current%item%map%naggr == newnode%item%map%naggr)) then
current => current%next
tail => current
iaggsize = sum(current%item%map%naggr)
if (iaggsize <= casize) then
!
! Target reached; but we may need to rebuild.
!
exit list_build_loop
end if
if (newsz>2) then
sizeratio = iaggsize
sizeratio = sum(current%prev%item%map%naggr)/sizeratio
if (sizeratio < mnaggratio) then
!
! We are not gaining anything
! We are not gaining
!
newsz = newsz-1
current%next => null()
current => current%prev
current%next =>null()
call newnode%item%free(info)
if (info == psb_success_) deallocate(newnode,stat=info)
if (info /= psb_success_) then
@@ -143,14 +159,6 @@ subroutine mld_z_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
end if
end if
current => current%next
tail => current
if (sum(current%item%map%naggr) <= casize) then
!
! Target reached; but we may need to rebuild.
!
exit list_build_loop
end if
end do list_build_loop
!
! At this point, we are at the list tail,
mlprec/impl/mld_z_bld_mlhier_array.f90
+62 -4
View File
@@ -37,20 +37,22 @@
!!$
!!$
subroutine mld_z_bld_mlhier_array(a,desc_a,iszv,precv,info)
subroutine mld_z_bld_mlhier_array(nplevs,a,desc_a,precv,info)
use psb_base_mod
use mld_z_inner_mod, mld_protect_name => mld_z_bld_mlhier_array
use mld_z_prec_mod
implicit none
integer(psb_ipk_), intent(inout) :: iszv
integer(psb_ipk_), intent(inout) :: nplevs
type(psb_zspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_z_onelev_type),intent(inout), allocatable, target :: precv(:)
integer(psb_ipk_), intent(out) :: info
! Local
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, newsz
integer(psb_ipk_) :: err,i,k, err_act, newsz, iszv
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
class(mld_z_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm
type(mld_dml_parms) :: baseparms, medparms, coarseparms
type(mld_z_onelev_type), allocatable :: tprecv(:)
integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: debug_level, debug_unit
@@ -64,6 +66,22 @@ subroutine mld_z_bld_mlhier_array(a,desc_a,iszv,precv,info)
debug_level = psb_get_debug_level()
ictxt = desc_a%get_ctxt()
call psb_info(ictxt,me,np)
iszv = size(precv)
coarseparms = precv(iszv)%parms
baseparms = precv(1)%parms
medparms = precv(2)%parms
allocate(coarse_sm, source=precv(iszv)%sm,stat=info)
if (info == psb_success_) &
& allocate(med_sm, source=precv(2)%sm,stat=info)
if (info == psb_success_) &
& allocate(base_sm, source=precv(1)%sm,stat=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
!
!
@@ -75,12 +93,52 @@ subroutine mld_z_bld_mlhier_array(a,desc_a,iszv,precv,info)
! on all processes.
!
call psb_bcast(ictxt,precv(1)%parms)
iszv = size(precv)
!
! First set desired number of levels
!
if (iszv /= nplevs) then
allocate(tprecv(nplevs),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='prec reallocation')
goto 9999
endif
tprecv(1)%parms = baseparms
allocate(tprecv(1)%sm,source=base_sm,stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='prec reallocation')
goto 9999
endif
do i=2,nplevs-1
tprecv(i)%parms = medparms
allocate(tprecv(i)%sm,source=med_sm,stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='prec reallocation')
goto 9999
endif
end do
tprecv(nplevs)%parms = coarseparms
allocate(tprecv(nplevs)%sm,source=coarse_sm,stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='prec reallocation')
goto 9999
endif
do i=1,iszv
call precv(i)%free(info)
end do
call move_alloc(tprecv,precv)
iszv = size(precv)
end if
!
! Finest level first; remember to fix base_a and base_desc
!
precv(1)%base_a => a
precv(1)%base_desc => desc_a
iszv = size(precv)
array_build_loop: do i=2, iszv
!
mlprec/impl/mld_zcprecset.F90
+18 -2
View File
@@ -138,10 +138,20 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,pos)
return
endif
if (psb_toupper(what) == 'COARSE_AGGR_SIZE') then
select case(psb_toupper(what))
case ('COARSE_AGGR_SIZE')
p%coarse_aggr_size = max(val,-1)
return
end if
case ('N_PREC_LEVS')
p%n_prec_levs = max(val,1)
return
case('MAX_PREC_LEVS')
p%max_prec_levs = max(val,1)
return
end select
!
! Set preconditioner parameters at level ilev.
!
@@ -475,6 +485,12 @@ subroutine mld_zcprecsetr(p,what,val,info,ilev,pos)
else
ilev_ = 1
end if
select case(psb_toupper(what))
case ('MIN_AGGR_RATIO')
p%min_aggr_ratio = max(done,val)
return
end select
if (.not.allocated(p%precv)) then
write(psb_err_unit,*) name,&
mlprec/impl/mld_zmlprec_bld.f90
+54 -27
View File
@@ -93,12 +93,13 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
!!$ character, intent(in), optional :: upd
! Local Variables
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
real(psb_dpk_) :: mnaggratio
integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
@@ -144,23 +145,42 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
!
! Check to ensure all procs have the same
!
newsz = -1
casize = p%coarse_aggr_size
iszv = size(p%precv)
newsz = -1
casize = p%coarse_aggr_size
nplevs = p%n_prec_levs
mxplevs = p%max_prec_levs
mnaggratio = p%min_aggr_ratio
casize = p%coarse_aggr_size
iszv = size(p%precv)
call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize)
if (casize > 0) then
if (casize /= p%coarse_aggr_size) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size')
goto 9999
end if
else
if (iszv /= size(p%precv)) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999
end if
call psb_bcast(ictxt,nplevs)
call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio)
if (casize /= p%coarse_aggr_size) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size')
goto 9999
end if
if (nplevs /= p%n_prec_levs) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent n_prec_levs')
goto 9999
end if
if (mxplevs /= p%max_prec_levs) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs')
goto 9999
end if
if (mnaggratio /= p%min_aggr_ratio) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio')
goto 9999
end if
if (iszv /= size(p%precv)) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent size of precv')
goto 9999
end if
if (iszv <= 1) then
@@ -171,20 +191,27 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
goto 9999
endif
if (casize>0) then
if (nplevs <= 0) then
!
! This should become the default strategy, we specify a target aggregation size.
!
call mld_bld_mlhier_aggsize(casize,a,desc_a,iszv,p%precv,info)
if (casize <=0) then
!
! Default to the cubic root of the size at base level.
!
casize = desc_a%get_global_rows()
casize = int((done*casize)**(done/(done*3)),psb_ipk_)
casize = max(casize,ione)
end if
call mld_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,p%precv,info)
else
!
! Oldstyle with fixed number of levels.
!
call mld_bld_mlhier_array(a,desc_a,p%precv,info)
nplevs = max(itwo,min(nplevs,mxplevs))
call mld_bld_mlhier_array(nplevs,a,desc_a,p%precv,info)
end if
iszv = size(p%precv)
!
mlprec/impl/mld_zprecinit.F90
+4 -2
View File
@@ -168,9 +168,11 @@ subroutine mld_zprecinit(p,ptype,info,nlev)
case ('ML')
if (present(nlev)) then
nlev_ = max(1,nlev)
nlev_ = max(1,nlev)
p%n_prec_levs = nlev_
else
nlev_ = 2
nlev_ = 3
p%n_prec_levs = -ione
end if
ilev_ = 1
allocate(p%precv(nlev_),stat=info)
mlprec/impl/mld_zprecset.F90
+16 -2
View File
@@ -137,10 +137,18 @@ subroutine mld_zprecseti(p,what,val,info,ilev,pos)
return
endif
if (what == mld_coarse_aggr_size_) then
select case(what)
case (mld_coarse_aggr_size_)
p%coarse_aggr_size = max(val,-1)
return
end if
case (mld_n_prec_levs_)
p%n_prec_levs = max(val,1)
return
case(mld_max_prec_levs_)
p%max_prec_levs = max(val,1)
return
end select
!
! Set preconditioner parameters at level ilev.
@@ -574,6 +582,12 @@ subroutine mld_zprecsetr(p,what,val,info,ilev,pos)
info = psb_success_
select case(what)
case (mld_min_aggr_ratio_)
p%min_aggr_ratio = max(done,val)
return
end select
if (present(ilev)) then
ilev_ = ilev
else
mlprec/mld_base_prec_type.F90
+6 -3
View File
@@ -161,9 +161,12 @@ module mld_base_prec_type
integer(psb_ipk_), parameter :: mld_coarse_fillin_ = 33
integer(psb_ipk_), parameter :: mld_coarse_subsolve_ = 34
integer(psb_ipk_), parameter :: mld_smoother_sweeps_ = 35
integer(psb_ipk_), parameter :: mld_coarse_aggr_size_ = 36
integer(psb_ipk_), parameter :: mld_solver_sweeps_ = 37
integer(psb_ipk_), parameter :: mld_ifpsz_ = 38
integer(psb_ipk_), parameter :: mld_solver_sweeps_ = 36
integer(psb_ipk_), parameter :: mld_coarse_aggr_size_ = 37
integer(psb_ipk_), parameter :: mld_n_prec_levs_ = 38
integer(psb_ipk_), parameter :: mld_max_prec_levs_ = 39
integer(psb_ipk_), parameter :: mld_min_aggr_ratio_ = 40
integer(psb_ipk_), parameter :: mld_ifpsz_ = 42
!
! Legal values for entry: mld_smoother_type_
mlprec/mld_c_inner_mod.f90
+8 -7
View File
@@ -110,12 +110,12 @@ module mld_c_inner_mod
interface mld_bld_mlhier_aggsize
subroutine mld_c_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
use psb_base_mod, only : psb_ipk_, psb_cspmat_type, psb_desc_type
subroutine mld_c_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,info)
use psb_base_mod, only : psb_ipk_, psb_cspmat_type, psb_desc_type,psb_spk_
use mld_c_prec_type, only : mld_c_onelev_type
implicit none
integer(psb_ipk_), intent(in) :: casize
integer(psb_ipk_), intent(inout) :: iszv
integer(psb_ipk_), intent(in) :: casize,mxplevs
real(psb_spk_) :: mnaggratio
type(psb_cspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_c_onelev_type), allocatable, target, intent(inout) :: precv(:)
@@ -124,12 +124,13 @@ module mld_c_inner_mod
end interface mld_bld_mlhier_aggsize
interface mld_bld_mlhier_array
subroutine mld_c_bld_mlhier_array(a,desc_a,precv,info)
subroutine mld_c_bld_mlhier_array(nplevs,a,desc_a,precv,info)
use psb_base_mod, only : psb_ipk_, psb_cspmat_type, psb_desc_type
use mld_c_prec_type, only : mld_c_onelev_type
implicit none
type(psb_cspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
integer(psb_ipk_), intent(inout) :: nplevs
type(psb_cspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_c_onelev_type), allocatable, target, intent(inout) :: precv(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_bld_mlhier_array
mlprec/mld_c_prec_type.f90
+2 -1
View File
@@ -84,7 +84,8 @@ module mld_c_prec_type
integer(psb_ipk_) :: coarse_aggr_size = izero
integer(psb_ipk_) :: n_prec_levs = -ione
integer(psb_ipk_) :: max_prec_levs = 20_psb_ipk_
real(psb_spk_) :: op_complexity=szero
real(psb_spk_) :: min_aggr_ratio = 1.5_psb_spk_
real(psb_spk_) :: op_complexity=szero
type(mld_c_onelev_type), allocatable :: precv(:)
contains
procedure, pass(prec) :: psb_c_apply2_vect => mld_c_apply2_vect
mlprec/mld_d_inner_mod.f90
+8 -7
View File
@@ -110,12 +110,12 @@ module mld_d_inner_mod
interface mld_bld_mlhier_aggsize
subroutine mld_d_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
use psb_base_mod, only : psb_ipk_, psb_dspmat_type, psb_desc_type
subroutine mld_d_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,info)
use psb_base_mod, only : psb_ipk_, psb_dspmat_type, psb_desc_type,psb_dpk_
use mld_d_prec_type, only : mld_d_onelev_type
implicit none
integer(psb_ipk_), intent(in) :: casize
integer(psb_ipk_), intent(inout) :: iszv
integer(psb_ipk_), intent(in) :: casize,mxplevs
real(psb_dpk_) :: mnaggratio
type(psb_dspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_d_onelev_type), allocatable, target, intent(inout) :: precv(:)
@@ -124,12 +124,13 @@ module mld_d_inner_mod
end interface mld_bld_mlhier_aggsize
interface mld_bld_mlhier_array
subroutine mld_d_bld_mlhier_array(a,desc_a,precv,info)
subroutine mld_d_bld_mlhier_array(nplevs,a,desc_a,precv,info)
use psb_base_mod, only : psb_ipk_, psb_dspmat_type, psb_desc_type
use mld_d_prec_type, only : mld_d_onelev_type
implicit none
type(psb_dspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
integer(psb_ipk_), intent(inout) :: nplevs
type(psb_dspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_d_onelev_type), allocatable, target, intent(inout) :: precv(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_bld_mlhier_array
mlprec/mld_d_prec_type.f90
+2 -1
View File
@@ -84,7 +84,8 @@ module mld_d_prec_type
integer(psb_ipk_) :: coarse_aggr_size = izero
integer(psb_ipk_) :: n_prec_levs = -ione
integer(psb_ipk_) :: max_prec_levs = 20_psb_ipk_
real(psb_dpk_) :: op_complexity=dzero
real(psb_dpk_) :: min_aggr_ratio = 1.5_psb_dpk_
real(psb_dpk_) :: op_complexity=dzero
type(mld_d_onelev_type), allocatable :: precv(:)
contains
procedure, pass(prec) :: psb_d_apply2_vect => mld_d_apply2_vect
mlprec/mld_s_inner_mod.f90
+8 -7
View File
@@ -110,12 +110,12 @@ module mld_s_inner_mod
interface mld_bld_mlhier_aggsize
subroutine mld_s_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
use psb_base_mod, only : psb_ipk_, psb_sspmat_type, psb_desc_type
subroutine mld_s_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,info)
use psb_base_mod, only : psb_ipk_, psb_sspmat_type, psb_desc_type,psb_spk_
use mld_s_prec_type, only : mld_s_onelev_type
implicit none
integer(psb_ipk_), intent(in) :: casize
integer(psb_ipk_), intent(inout) :: iszv
integer(psb_ipk_), intent(in) :: casize,mxplevs
real(psb_spk_) :: mnaggratio
type(psb_sspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_s_onelev_type), allocatable, target, intent(inout) :: precv(:)
@@ -124,12 +124,13 @@ module mld_s_inner_mod
end interface mld_bld_mlhier_aggsize
interface mld_bld_mlhier_array
subroutine mld_s_bld_mlhier_array(a,desc_a,precv,info)
subroutine mld_s_bld_mlhier_array(nplevs,a,desc_a,precv,info)
use psb_base_mod, only : psb_ipk_, psb_sspmat_type, psb_desc_type
use mld_s_prec_type, only : mld_s_onelev_type
implicit none
type(psb_sspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
integer(psb_ipk_), intent(inout) :: nplevs
type(psb_sspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_s_onelev_type), allocatable, target, intent(inout) :: precv(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_bld_mlhier_array
mlprec/mld_s_prec_type.f90
+2 -1
View File
@@ -84,7 +84,8 @@ module mld_s_prec_type
integer(psb_ipk_) :: coarse_aggr_size = izero
integer(psb_ipk_) :: n_prec_levs = -ione
integer(psb_ipk_) :: max_prec_levs = 20_psb_ipk_
real(psb_spk_) :: op_complexity=szero
real(psb_spk_) :: min_aggr_ratio = 1.5_psb_spk_
real(psb_spk_) :: op_complexity=szero
type(mld_s_onelev_type), allocatable :: precv(:)
contains
procedure, pass(prec) :: psb_s_apply2_vect => mld_s_apply2_vect
mlprec/mld_z_inner_mod.f90
+8 -7
View File
@@ -110,12 +110,12 @@ module mld_z_inner_mod
interface mld_bld_mlhier_aggsize
subroutine mld_z_bld_mlhier_aggsize(casize,a,desc_a,iszv,precv,info)
use psb_base_mod, only : psb_ipk_, psb_zspmat_type, psb_desc_type
subroutine mld_z_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,info)
use psb_base_mod, only : psb_ipk_, psb_zspmat_type, psb_desc_type,psb_dpk_
use mld_z_prec_type, only : mld_z_onelev_type
implicit none
integer(psb_ipk_), intent(in) :: casize
integer(psb_ipk_), intent(inout) :: iszv
integer(psb_ipk_), intent(in) :: casize,mxplevs
real(psb_dpk_) :: mnaggratio
type(psb_zspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_z_onelev_type), allocatable, target, intent(inout) :: precv(:)
@@ -124,12 +124,13 @@ module mld_z_inner_mod
end interface mld_bld_mlhier_aggsize
interface mld_bld_mlhier_array
subroutine mld_z_bld_mlhier_array(a,desc_a,precv,info)
subroutine mld_z_bld_mlhier_array(nplevs,a,desc_a,precv,info)
use psb_base_mod, only : psb_ipk_, psb_zspmat_type, psb_desc_type
use mld_z_prec_type, only : mld_z_onelev_type
implicit none
type(psb_zspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
integer(psb_ipk_), intent(inout) :: nplevs
type(psb_zspmat_type),intent(in), target :: a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_z_onelev_type), allocatable, target, intent(inout) :: precv(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_bld_mlhier_array
mlprec/mld_z_prec_type.f90
+2 -1
View File
@@ -84,7 +84,8 @@ module mld_z_prec_type
integer(psb_ipk_) :: coarse_aggr_size = izero
integer(psb_ipk_) :: n_prec_levs = -ione
integer(psb_ipk_) :: max_prec_levs = 20_psb_ipk_
real(psb_dpk_) :: op_complexity=dzero
real(psb_dpk_) :: min_aggr_ratio = 1.5_psb_dpk_
real(psb_dpk_) :: op_complexity=dzero
type(mld_z_onelev_type), allocatable :: precv(:)
contains
procedure, pass(prec) :: psb_z_apply2_vect => mld_z_apply2_vect
tests/pdegen/ppde3d.f90
+3 -2
View File
@@ -242,7 +242,8 @@ program ppde3d
!
if (psb_toupper(prectype%prec) == 'ML') then
nlv = prectype%nlev
call mld_precinit(prec,prectype%prec, info, nlev=nlv)
call mld_precinit(prec,prectype%prec, info, nlev=nlv)
!!$ call mld_precset(prec,'n_prec_levs', prectype%nlev, info)
call mld_precset(prec,'smoother_type', prectype%smther, info)
call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info)
call mld_precset(prec,'sub_ovr', prectype%novr, info)
@@ -265,7 +266,7 @@ program ppde3d
call mld_precset(prec,'coarse_fillin', prectype%cfill, info)
call mld_precset(prec,'coarse_iluthrs', prectype%cthres, info)
call mld_precset(prec,'coarse_sweeps', prectype%cjswp, info)
call mld_precset(prec,'coarse_aggr_size', prectype%csize, info)
if (prectype%csize>0) call mld_precset(prec,'coarse_aggr_size', prectype%csize, info)
else
nlv = 1
call mld_precinit(prec,prectype%prec, info, nlev=nlv)