mld2p4-extaggr:

mlprec/impl/mld_dcoarse_bld.f90
 mlprec/mld_base_prec_type.F90

First steps towards external aggrgation.
stopcriterion
Salvatore Filippone 8 years ago
parent 9e5f72bad0
commit 26119298bd

@ -112,40 +112,58 @@ subroutine mld_dcoarse_bld(a,desc_a,p,info)
call mld_check_def(p%parms%aggr_omega_val,'Omega',dzero,is_legal_d_omega) call mld_check_def(p%parms%aggr_omega_val,'Omega',dzero,is_legal_d_omega)
call mld_check_def(p%parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs) call mld_check_def(p%parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)
select case(p%parms%aggr_alg)
case (mld_dec_aggr_, mld_sym_dec_aggr_)
! !
! Build a mapping between the row indices of the fine-level matrix ! Build a mapping between the row indices of the fine-level matrix
! and the row indices of the coarse-level matrix, according to a decoupled ! and the row indices of the coarse-level matrix, according to a decoupled
! aggregation algorithm. This also defines a tentative prolongator from ! aggregation algorithm. This also defines a tentative prolongator from
! the coarse to the fine level. ! the coarse to the fine level.
! !
call mld_aggrmap_bld(p%parms%aggr_alg,p%parms%aggr_ord,p%parms%aggr_thresh,& call mld_aggrmap_bld(p%parms%aggr_alg,p%parms%aggr_ord,p%parms%aggr_thresh,&
& a,desc_a,ilaggr,nlaggr,info) & a,desc_a,ilaggr,nlaggr,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmap_bld')
goto 9999
end if
!
! Build the coarse-level matrix from the fine-level one, starting from
! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by p%iprcparm(mld_aggr_kind_)
!
call mld_aggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')
goto 9999
end if
if (info /= psb_success_) then case (mld_bcmatch_aggr_)
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmap_bld') write(0,*) 'Matching is not implemented yet '
info = -1111
call psb_errpush(psb_err_input_value_invalid_i_,name,&
& i_err=(/ione,p%parms%aggr_alg,izero,izero,izero/))
goto 9999 goto 9999
end if
case default
! info = -1
! Build the coarse-level matrix from the fine-level one, starting from call psb_errpush(psb_err_input_value_invalid_i_,name,&
! the mapping defined by mld_aggrmap_bld and applying the aggregation & i_err=(/ione,p%parms%aggr_alg,izero,izero,izero/))
! algorithm specified by p%iprcparm(mld_aggr_kind_)
!
call mld_aggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')
goto 9999 goto 9999
end if
end select
! !
! Fix the base_a and base_desc pointers for handling of residuals. ! Fix the base_a and base_desc pointers for handling of residuals.
! This is correct because this routine is only called at levels >=2. ! This is correct because this routine is only called at levels >=2.
! !
p%base_a => p%ac p%base_a => p%ac
p%base_desc => p%desc_ac p%base_desc => p%desc_ac
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

@ -257,10 +257,11 @@ module mld_base_prec_type
! !
integer(psb_ipk_), parameter :: mld_dec_aggr_ = 0 integer(psb_ipk_), parameter :: mld_dec_aggr_ = 0
integer(psb_ipk_), parameter :: mld_sym_dec_aggr_ = 1 integer(psb_ipk_), parameter :: mld_sym_dec_aggr_ = 1
integer(psb_ipk_), parameter :: mld_ext_aggr_ = 2 integer(psb_ipk_), parameter :: mld_bcmatch_aggr_ = 2
integer(psb_ipk_), parameter :: mld_glb_aggr_ = 3 integer(psb_ipk_), parameter :: mld_ext_aggr_ = 3
integer(psb_ipk_), parameter :: mld_new_dec_aggr_ = 4 integer(psb_ipk_), parameter :: mld_glb_aggr_ = 4
integer(psb_ipk_), parameter :: mld_new_glb_aggr_ = 5 integer(psb_ipk_), parameter :: mld_new_dec_aggr_ = 5
integer(psb_ipk_), parameter :: mld_new_glb_aggr_ = 6
integer(psb_ipk_), parameter :: mld_max_aggr_alg_ = mld_ext_aggr_ integer(psb_ipk_), parameter :: mld_max_aggr_alg_ = mld_ext_aggr_
! !
! Legal values for entry: mld_aggr_ord_ ! Legal values for entry: mld_aggr_ord_
@ -335,8 +336,8 @@ module mld_base_prec_type
character(len=15), parameter, private :: & character(len=15), parameter, private :: &
& matrix_names(0:1)=(/'distributed ','replicated '/) & matrix_names(0:1)=(/'distributed ','replicated '/)
character(len=18), parameter, private :: & character(len=18), parameter, private :: &
& aggr_names(0:5)=(/'local aggregation ','sym. local aggr. ',& & aggr_names(0:6)=(/'local aggregation ','sym. local aggr. ',&
& 'user defined aggr.', 'global aggregation', & & 'bootchmatch aggr. ','user defined aggr.', 'global aggregation', &
& 'new local aggr. ','new global aggr. '/) & 'new local aggr. ','new global aggr. '/)
character(len=18), parameter, private :: & character(len=18), parameter, private :: &
& ord_names(0:1)=(/'Natural ordering ','Desc. degree ord. '/) & ord_names(0:1)=(/'Natural ordering ','Desc. degree ord. '/)
@ -450,6 +451,8 @@ contains
val = mld_dec_aggr_ val = mld_dec_aggr_
case('SYMDEC') case('SYMDEC')
val = mld_sym_dec_aggr_ val = mld_sym_dec_aggr_
case('BCMATCH')
val = mld_bcmatch_aggr_
case('NAT','NATURAL') case('NAT','NATURAL')
val = mld_aggr_ord_nat_ val = mld_aggr_ord_nat_
case('DESC','RDEGREE','DEGREE') case('DESC','RDEGREE','DEGREE')

Loading…
Cancel
Save