Redefine map_bld interfaces.

stopcriterion
Salvatore Filippone 7 years ago
parent cce189c450
commit 9f2c23b2a4

@ -110,7 +110,7 @@ subroutine mld_c_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)
call mld_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
call mld_c_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then

@ -112,7 +112,7 @@ subroutine mld_c_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)
call mld_hyb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
call mld_c_hyb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then

@ -127,7 +127,7 @@ subroutine mld_c_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
if (info == psb_success_) call atmp%cscnv(info,type='CSR')
if (info == psb_success_) &
& call mld_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,atmp,desc_a,nlaggr,ilaggr,info)
& call mld_c_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,atmp,desc_a,nlaggr,ilaggr,info)
if (info == psb_success_) call atmp%free()
if (info == psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)

@ -110,7 +110,7 @@ subroutine mld_d_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)
call mld_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
call mld_d_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then

@ -112,7 +112,7 @@ subroutine mld_d_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)
call mld_hyb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
call mld_d_hyb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then

@ -127,7 +127,7 @@ subroutine mld_d_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
if (info == psb_success_) call atmp%cscnv(info,type='CSR')
if (info == psb_success_) &
& call mld_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,atmp,desc_a,nlaggr,ilaggr,info)
& call mld_d_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,atmp,desc_a,nlaggr,ilaggr,info)
if (info == psb_success_) call atmp%free()
if (info == psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)

@ -110,7 +110,7 @@ subroutine mld_s_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)
call mld_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
call mld_s_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then

@ -112,7 +112,7 @@ subroutine mld_s_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)
call mld_hyb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
call mld_s_hyb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then

@ -127,7 +127,7 @@ subroutine mld_s_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
if (info == psb_success_) call atmp%cscnv(info,type='CSR')
if (info == psb_success_) &
& call mld_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,atmp,desc_a,nlaggr,ilaggr,info)
& call mld_s_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,atmp,desc_a,nlaggr,ilaggr,info)
if (info == psb_success_) call atmp%free()
if (info == psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)

@ -110,7 +110,7 @@ subroutine mld_z_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)
call mld_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
call mld_z_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then

@ -112,7 +112,7 @@ subroutine mld_z_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)
call mld_hyb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
call mld_z_hyb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then

@ -127,7 +127,7 @@ subroutine mld_z_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
if (info == psb_success_) call atmp%cscnv(info,type='CSR')
if (info == psb_success_) &
& call mld_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,atmp,desc_a,nlaggr,ilaggr,info)
& call mld_z_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,atmp,desc_a,nlaggr,ilaggr,info)
if (info == psb_success_) call atmp%free()
if (info == psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)

@ -66,9 +66,18 @@ subroutine mld_c_base_onelev_descr(lv,il,nl,ilmin,info,iout)
write(iout_,*)
if (il == ilmin) then
call lv%parms%mldescr(iout_,info)
call lv%parms%mlcycledsc(iout_,info)
if (allocated(lv%aggr)) then
call lv%aggr%descr(lv%parms,iout_,info)
else
write(iout_,*) 'Internal error: unallocated aggregator object'
info = psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
write(iout_,*)
end if
if (il > 1) then
if (coarse) then

@ -66,9 +66,18 @@ subroutine mld_d_base_onelev_descr(lv,il,nl,ilmin,info,iout)
write(iout_,*)
if (il == ilmin) then
call lv%parms%mldescr(iout_,info)
call lv%parms%mlcycledsc(iout_,info)
if (allocated(lv%aggr)) then
call lv%aggr%descr(lv%parms,iout_,info)
else
write(iout_,*) 'Internal error: unallocated aggregator object'
info = psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
write(iout_,*)
end if
if (il > 1) then
if (coarse) then

@ -66,9 +66,18 @@ subroutine mld_s_base_onelev_descr(lv,il,nl,ilmin,info,iout)
write(iout_,*)
if (il == ilmin) then
call lv%parms%mldescr(iout_,info)
call lv%parms%mlcycledsc(iout_,info)
if (allocated(lv%aggr)) then
call lv%aggr%descr(lv%parms,iout_,info)
else
write(iout_,*) 'Internal error: unallocated aggregator object'
info = psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
write(iout_,*)
end if
if (il > 1) then
if (coarse) then

@ -66,9 +66,18 @@ subroutine mld_z_base_onelev_descr(lv,il,nl,ilmin,info,iout)
write(iout_,*)
if (il == ilmin) then
call lv%parms%mldescr(iout_,info)
call lv%parms%mlcycledsc(iout_,info)
if (allocated(lv%aggr)) then
call lv%aggr%descr(lv%parms,iout_,info)
else
write(iout_,*) 'Internal error: unallocated aggregator object'
info = psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
end if
write(iout_,*)
end if
if (il > 1) then
if (coarse) then

@ -569,10 +569,10 @@ contains
if ((pm%ml_cycle>=mld_no_ml_).and.(pm%ml_cycle<=mld_max_ml_cycle_)) then
write(iout,*) ' Parallel aggregation algorithm: ',&
& par_aggr_alg_names(pm%par_aggr_alg)
write(iout,*) ' Aggregation type: ',&
& aggr_type_names(pm%aggr_type)
write(iout,*) ' parallel algorithm: ',&
& par_aggr_alg_names(pm%par_aggr_alg)
if (pm%par_aggr_alg /= mld_ext_aggr_) then
if ( pm%aggr_ord /= mld_aggr_ord_nat_) &
& write(iout,*) ' with initial ordering: ',&
@ -601,6 +601,33 @@ contains
end subroutine ml_parms_mldescr
subroutine ml_parms_descr(pm,iout,info,coarse)
Implicit None
! Arguments
class(mld_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
logical :: coarse_
info = psb_success_
if (present(coarse)) then
coarse_ = coarse
else
coarse_ = .false.
end if
if (coarse_) then
call pm%coarsedescr(iout,info)
end if
return
end subroutine ml_parms_descr
subroutine ml_parms_coarsedescr(pm,iout,info)
@ -632,32 +659,6 @@ contains
end subroutine ml_parms_coarsedescr
subroutine ml_parms_descr(pm,iout,info,coarse)
Implicit None
! Arguments
class(mld_ml_parms), intent(in) :: pm
integer(psb_ipk_), intent(in) :: iout
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: coarse
logical :: coarse_
info = psb_success_
if (present(coarse)) then
coarse_ = coarse
else
coarse_ = .false.
end if
if (coarse_) then
call pm%coarsedescr(iout,info)
end if
return
end subroutine ml_parms_descr
subroutine s_ml_parms_descr(pm,iout,info,coarse)
Implicit None

@ -123,9 +123,8 @@ module mld_c_inner_mod
end subroutine mld_caggrmap_bld
end interface mld_aggrmap_bld
interface mld_vmb_map_bld
subroutine mld_c_vmb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
abstract interface
subroutine mld_c_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
implicit none
integer(psb_ipk_), intent(in) :: iorder
@ -134,22 +133,11 @@ module mld_c_inner_mod
real(psb_spk_), intent(in) :: theta
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_vmb_map_bld
end interface mld_vmb_map_bld
interface mld_hyb_map_bld
subroutine mld_c_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
implicit none
integer(psb_ipk_), intent(in) :: iorder
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), intent(in) :: theta
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_hyb_map_bld
end interface mld_hyb_map_bld
end subroutine mld_c_map_bld
end interface
procedure(mld_c_map_bld) :: mld_c_vmb_map_bld, mld_c_hyb_map_bld
interface mld_map_to_tprol
subroutine mld_c_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_
@ -162,7 +150,6 @@ module mld_c_inner_mod
end subroutine mld_c_map_to_tprol
end interface mld_map_to_tprol
interface mld_lev_mat_asb
subroutine mld_c_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_

@ -123,9 +123,8 @@ module mld_d_inner_mod
end subroutine mld_daggrmap_bld
end interface mld_aggrmap_bld
interface mld_vmb_map_bld
subroutine mld_d_vmb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
abstract interface
subroutine mld_d_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
implicit none
integer(psb_ipk_), intent(in) :: iorder
@ -134,22 +133,11 @@ module mld_d_inner_mod
real(psb_dpk_), intent(in) :: theta
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_vmb_map_bld
end interface mld_vmb_map_bld
interface mld_hyb_map_bld
subroutine mld_d_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
implicit none
integer(psb_ipk_), intent(in) :: iorder
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_), intent(in) :: theta
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_hyb_map_bld
end interface mld_hyb_map_bld
end subroutine mld_d_map_bld
end interface
procedure(mld_d_map_bld) :: mld_d_vmb_map_bld, mld_d_hyb_map_bld
interface mld_map_to_tprol
subroutine mld_d_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
@ -162,7 +150,6 @@ module mld_d_inner_mod
end subroutine mld_d_map_to_tprol
end interface mld_map_to_tprol
interface mld_lev_mat_asb
subroutine mld_d_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_

@ -123,9 +123,8 @@ module mld_s_inner_mod
end subroutine mld_saggrmap_bld
end interface mld_aggrmap_bld
interface mld_vmb_map_bld
subroutine mld_s_vmb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
abstract interface
subroutine mld_s_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
implicit none
integer(psb_ipk_), intent(in) :: iorder
@ -134,22 +133,11 @@ module mld_s_inner_mod
real(psb_spk_), intent(in) :: theta
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_vmb_map_bld
end interface mld_vmb_map_bld
interface mld_hyb_map_bld
subroutine mld_s_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
implicit none
integer(psb_ipk_), intent(in) :: iorder
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), intent(in) :: theta
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_hyb_map_bld
end interface mld_hyb_map_bld
end subroutine mld_s_map_bld
end interface
procedure(mld_s_map_bld) :: mld_s_vmb_map_bld, mld_s_hyb_map_bld
interface mld_map_to_tprol
subroutine mld_s_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_
@ -162,7 +150,6 @@ module mld_s_inner_mod
end subroutine mld_s_map_to_tprol
end interface mld_map_to_tprol
interface mld_lev_mat_asb
subroutine mld_s_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_

@ -123,9 +123,8 @@ module mld_z_inner_mod
end subroutine mld_zaggrmap_bld
end interface mld_aggrmap_bld
interface mld_vmb_map_bld
subroutine mld_z_vmb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
abstract interface
subroutine mld_z_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
implicit none
integer(psb_ipk_), intent(in) :: iorder
@ -134,22 +133,11 @@ module mld_z_inner_mod
real(psb_dpk_), intent(in) :: theta
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_vmb_map_bld
end interface mld_vmb_map_bld
interface mld_hyb_map_bld
subroutine mld_z_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
implicit none
integer(psb_ipk_), intent(in) :: iorder
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_), intent(in) :: theta
integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_hyb_map_bld
end interface mld_hyb_map_bld
end subroutine mld_z_map_bld
end interface
procedure(mld_z_map_bld) :: mld_z_vmb_map_bld, mld_z_hyb_map_bld
interface mld_map_to_tprol
subroutine mld_z_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_
@ -162,7 +150,6 @@ module mld_z_inner_mod
end subroutine mld_z_map_to_tprol
end interface mld_map_to_tprol
interface mld_lev_mat_asb
subroutine mld_z_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_

Loading…
Cancel
Save