Unified vmb and hyb map_bld inside dec_aggregator.

stopcriterion
Salvatore Filippone 7 years ago
parent 9f2c23b2a4
commit e1d9157136

@ -110,7 +110,8 @@ 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_c_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
call ag%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

@ -70,7 +70,7 @@ subroutine mld_c_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod
use mld_base_prec_type
use mld_c_inner_mod, mld_protect_name => mld_c_hyb_map_bld
use mld_c_inner_mod!, mld_protect_name => mld_c_hyb_map_bld
implicit none

@ -71,7 +71,7 @@ subroutine mld_c_vmb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod
use mld_base_prec_type
use mld_c_inner_mod, mld_protect_name => mld_c_vmb_map_bld
use mld_c_inner_mod!, mld_protect_name => mld_c_vmb_map_bld
implicit none

@ -110,7 +110,8 @@ 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_d_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
call ag%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

@ -70,7 +70,7 @@ subroutine mld_d_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod
use mld_base_prec_type
use mld_d_inner_mod, mld_protect_name => mld_d_hyb_map_bld
use mld_d_inner_mod!, mld_protect_name => mld_d_hyb_map_bld
implicit none

@ -71,7 +71,7 @@ subroutine mld_d_vmb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod
use mld_base_prec_type
use mld_d_inner_mod, mld_protect_name => mld_d_vmb_map_bld
use mld_d_inner_mod!, mld_protect_name => mld_d_vmb_map_bld
implicit none

@ -110,7 +110,8 @@ 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_s_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
call ag%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

@ -70,7 +70,7 @@ subroutine mld_s_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod
use mld_base_prec_type
use mld_s_inner_mod, mld_protect_name => mld_s_hyb_map_bld
use mld_s_inner_mod!, mld_protect_name => mld_s_hyb_map_bld
implicit none

@ -71,7 +71,7 @@ subroutine mld_s_vmb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod
use mld_base_prec_type
use mld_s_inner_mod, mld_protect_name => mld_s_vmb_map_bld
use mld_s_inner_mod!, mld_protect_name => mld_s_vmb_map_bld
implicit none

@ -110,7 +110,8 @@ 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_z_vmb_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info)
call ag%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

@ -70,7 +70,7 @@ subroutine mld_z_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod
use mld_base_prec_type
use mld_z_inner_mod, mld_protect_name => mld_z_hyb_map_bld
use mld_z_inner_mod!, mld_protect_name => mld_z_hyb_map_bld
implicit none

@ -71,7 +71,7 @@ subroutine mld_z_vmb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
use psb_base_mod
use mld_base_prec_type
use mld_z_inner_mod, mld_protect_name => mld_z_vmb_map_bld
use mld_z_inner_mod!, mld_protect_name => mld_z_vmb_map_bld
implicit none

@ -200,17 +200,17 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos)
allocate(mld_c_dec_aggregator_type :: lv%aggr, stat=info)
case(mld_sym_dec_aggr_)
allocate(mld_c_symdec_aggregator_type :: lv%aggr, stat=info)
!!$ case(mld_hybrid_aggr_)
!!$ allocate(mld_c_hybrid_aggregator_type :: lv%aggr, stat=info)
case default
info = psb_err_internal_error_
end select
if (info == psb_success_) call lv%aggr%default()
case ('AGGR_ORD')
lv%parms%aggr_ord = val
case ('AGGR_TYPE')
lv%parms%aggr_type = val
if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info)
case ('AGGR_PROL')
lv%parms%aggr_prol = val

@ -42,7 +42,6 @@ subroutine mld_c_base_onelev_seti(lv,what,val,info,pos)
use mld_c_base_aggregator_mod
use mld_c_dec_aggregator_mod
use mld_c_symdec_aggregator_mod
use mld_c_hybrid_aggregator_mod
use mld_c_jac_smoother
use mld_c_as_smoother
use mld_c_diag_solver
@ -200,17 +199,17 @@ subroutine mld_c_base_onelev_seti(lv,what,val,info,pos)
allocate(mld_c_dec_aggregator_type :: lv%aggr, stat=info)
case(mld_sym_dec_aggr_)
allocate(mld_c_symdec_aggregator_type :: lv%aggr, stat=info)
!!$ case(mld_hybrid_aggr_)
!!$ allocate(mld_c_hybrid_aggregator_type :: lv%aggr, stat=info)
case default
info = psb_err_internal_error_
end select
if (info == psb_success_) call lv%aggr%default()
case (mld_aggr_ord_)
lv%parms%aggr_ord = val
case (mld_aggr_type_)
lv%parms%aggr_type = val
if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info)
case (mld_aggr_prol_)
lv%parms%aggr_prol = val

@ -220,17 +220,17 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos)
allocate(mld_d_dec_aggregator_type :: lv%aggr, stat=info)
case(mld_sym_dec_aggr_)
allocate(mld_d_symdec_aggregator_type :: lv%aggr, stat=info)
!!$ case(mld_hybrid_aggr_)
!!$ allocate(mld_d_hybrid_aggregator_type :: lv%aggr, stat=info)
case default
info = psb_err_internal_error_
end select
if (info == psb_success_) call lv%aggr%default()
case ('AGGR_ORD')
lv%parms%aggr_ord = val
case ('AGGR_TYPE')
lv%parms%aggr_type = val
if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info)
case ('AGGR_PROL')
lv%parms%aggr_prol = val

@ -42,7 +42,6 @@ subroutine mld_d_base_onelev_seti(lv,what,val,info,pos)
use mld_d_base_aggregator_mod
use mld_d_dec_aggregator_mod
use mld_d_symdec_aggregator_mod
use mld_d_hybrid_aggregator_mod
use mld_d_jac_smoother
use mld_d_as_smoother
use mld_d_diag_solver
@ -220,17 +219,17 @@ subroutine mld_d_base_onelev_seti(lv,what,val,info,pos)
allocate(mld_d_dec_aggregator_type :: lv%aggr, stat=info)
case(mld_sym_dec_aggr_)
allocate(mld_d_symdec_aggregator_type :: lv%aggr, stat=info)
!!$ case(mld_hybrid_aggr_)
!!$ allocate(mld_d_hybrid_aggregator_type :: lv%aggr, stat=info)
case default
info = psb_err_internal_error_
end select
if (info == psb_success_) call lv%aggr%default()
case (mld_aggr_ord_)
lv%parms%aggr_ord = val
case (mld_aggr_type_)
lv%parms%aggr_type = val
if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info)
case (mld_aggr_prol_)
lv%parms%aggr_prol = val

@ -200,17 +200,17 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos)
allocate(mld_s_dec_aggregator_type :: lv%aggr, stat=info)
case(mld_sym_dec_aggr_)
allocate(mld_s_symdec_aggregator_type :: lv%aggr, stat=info)
!!$ case(mld_hybrid_aggr_)
!!$ allocate(mld_s_hybrid_aggregator_type :: lv%aggr, stat=info)
case default
info = psb_err_internal_error_
end select
if (info == psb_success_) call lv%aggr%default()
case ('AGGR_ORD')
lv%parms%aggr_ord = val
case ('AGGR_TYPE')
lv%parms%aggr_type = val
if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info)
case ('AGGR_PROL')
lv%parms%aggr_prol = val

@ -42,7 +42,6 @@ subroutine mld_s_base_onelev_seti(lv,what,val,info,pos)
use mld_s_base_aggregator_mod
use mld_s_dec_aggregator_mod
use mld_s_symdec_aggregator_mod
use mld_s_hybrid_aggregator_mod
use mld_s_jac_smoother
use mld_s_as_smoother
use mld_s_diag_solver
@ -200,17 +199,17 @@ subroutine mld_s_base_onelev_seti(lv,what,val,info,pos)
allocate(mld_s_dec_aggregator_type :: lv%aggr, stat=info)
case(mld_sym_dec_aggr_)
allocate(mld_s_symdec_aggregator_type :: lv%aggr, stat=info)
!!$ case(mld_hybrid_aggr_)
!!$ allocate(mld_s_hybrid_aggregator_type :: lv%aggr, stat=info)
case default
info = psb_err_internal_error_
end select
if (info == psb_success_) call lv%aggr%default()
case (mld_aggr_ord_)
lv%parms%aggr_ord = val
case (mld_aggr_type_)
lv%parms%aggr_type = val
if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info)
case (mld_aggr_prol_)
lv%parms%aggr_prol = val

@ -220,17 +220,17 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos)
allocate(mld_z_dec_aggregator_type :: lv%aggr, stat=info)
case(mld_sym_dec_aggr_)
allocate(mld_z_symdec_aggregator_type :: lv%aggr, stat=info)
!!$ case(mld_hybrid_aggr_)
!!$ allocate(mld_z_hybrid_aggregator_type :: lv%aggr, stat=info)
case default
info = psb_err_internal_error_
end select
if (info == psb_success_) call lv%aggr%default()
case ('AGGR_ORD')
lv%parms%aggr_ord = val
case ('AGGR_TYPE')
lv%parms%aggr_type = val
if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info)
case ('AGGR_PROL')
lv%parms%aggr_prol = val

@ -42,7 +42,6 @@ subroutine mld_z_base_onelev_seti(lv,what,val,info,pos)
use mld_z_base_aggregator_mod
use mld_z_dec_aggregator_mod
use mld_z_symdec_aggregator_mod
use mld_z_hybrid_aggregator_mod
use mld_z_jac_smoother
use mld_z_as_smoother
use mld_z_diag_solver
@ -220,17 +219,17 @@ subroutine mld_z_base_onelev_seti(lv,what,val,info,pos)
allocate(mld_z_dec_aggregator_type :: lv%aggr, stat=info)
case(mld_sym_dec_aggr_)
allocate(mld_z_symdec_aggregator_type :: lv%aggr, stat=info)
!!$ case(mld_hybrid_aggr_)
!!$ allocate(mld_z_hybrid_aggregator_type :: lv%aggr, stat=info)
case default
info = psb_err_internal_error_
end select
if (info == psb_success_) call lv%aggr%default()
case (mld_aggr_ord_)
lv%parms%aggr_ord = val
case (mld_aggr_type_)
lv%parms%aggr_type = val
if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info)
case (mld_aggr_prol_)
lv%parms%aggr_prol = val

@ -103,6 +103,7 @@ module mld_c_base_aggregator_mod
procedure, pass(ag) :: free => mld_c_base_aggregator_free
procedure, pass(ag) :: default => mld_c_base_aggregator_default
procedure, pass(ag) :: descr => mld_c_base_aggregator_descr
procedure, pass(ag) :: set_aggr_type => mld_c_base_aggregator_set_aggr_type
procedure, nopass :: fmt => mld_c_base_aggregator_fmt
end type mld_c_base_aggregator_type
@ -173,6 +174,17 @@ contains
return
end subroutine mld_c_base_aggregator_descr
subroutine mld_c_base_aggregator_set_aggr_type(ag,parms,info)
implicit none
class(mld_c_base_aggregator_type), intent(inout) :: ag
type(mld_sml_parms), intent(in) :: parms
integer(psb_ipk_), intent(out) :: info
! Do nothing
return
end subroutine mld_c_base_aggregator_set_aggr_type
subroutine mld_c_base_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod
implicit none

@ -90,14 +90,32 @@ module mld_c_dec_aggregator_mod
!
!
type, extends(mld_c_base_aggregator_type) :: mld_c_dec_aggregator_type
procedure(mld_c_map_bld), nopass, pointer :: map_bld => null()
contains
procedure, pass(ag) :: bld_tprol => mld_c_dec_aggregator_build_tprol
procedure, pass(ag) :: mat_asb => mld_c_dec_aggregator_mat_asb
procedure, nopass :: fmt => mld_c_dec_aggregator_fmt
procedure, pass(ag) :: bld_tprol => mld_c_dec_aggregator_build_tprol
procedure, pass(ag) :: mat_asb => mld_c_dec_aggregator_mat_asb
procedure, pass(ag) :: default => mld_c_dec_aggregator_default
procedure, pass(ag) :: set_aggr_type => mld_c_dec_aggregator_set_aggr_type
procedure, nopass :: fmt => mld_c_dec_aggregator_fmt
end type mld_c_dec_aggregator_type
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
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_map_bld
end interface
procedure(mld_c_map_bld) :: mld_c_vmb_map_bld, mld_c_hyb_map_bld
interface
subroutine mld_c_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
import :: mld_c_dec_aggregator_type, psb_desc_type, psb_cspmat_type, psb_spk_, &
@ -133,6 +151,38 @@ module mld_c_dec_aggregator_mod
contains
subroutine mld_c_dec_aggregator_set_aggr_type(ag,parms,info)
use mld_base_prec_type
implicit none
class(mld_c_dec_aggregator_type), intent(inout) :: ag
type(mld_sml_parms), intent(in) :: parms
integer(psb_ipk_), intent(out) :: info
select case(parms%aggr_type)
case (mld_noalg_)
ag%map_bld => null()
case (mld_vmb_)
ag%map_bld => mld_c_vmb_map_bld
case (mld_hyb_)
ag%map_bld => mld_c_hyb_map_bld
case default
write(0,*) 'Unknown aggregation type, defaulting to VMB'
ag%map_bld => mld_c_vmb_map_bld
end select
return
end subroutine mld_c_dec_aggregator_set_aggr_type
subroutine mld_c_dec_aggregator_default(ag)
implicit none
class(mld_c_dec_aggregator_type), intent(inout) :: ag
ag%map_bld => mld_c_vmb_map_bld
return
end subroutine mld_c_dec_aggregator_default
function mld_c_dec_aggregator_fmt() result(val)
implicit none
character(len=32) :: val

@ -123,21 +123,6 @@ module mld_c_inner_mod
end subroutine mld_caggrmap_bld
end interface mld_aggrmap_bld
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
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_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_

@ -103,6 +103,7 @@ module mld_d_base_aggregator_mod
procedure, pass(ag) :: free => mld_d_base_aggregator_free
procedure, pass(ag) :: default => mld_d_base_aggregator_default
procedure, pass(ag) :: descr => mld_d_base_aggregator_descr
procedure, pass(ag) :: set_aggr_type => mld_d_base_aggregator_set_aggr_type
procedure, nopass :: fmt => mld_d_base_aggregator_fmt
end type mld_d_base_aggregator_type
@ -173,6 +174,17 @@ contains
return
end subroutine mld_d_base_aggregator_descr
subroutine mld_d_base_aggregator_set_aggr_type(ag,parms,info)
implicit none
class(mld_d_base_aggregator_type), intent(inout) :: ag
type(mld_dml_parms), intent(in) :: parms
integer(psb_ipk_), intent(out) :: info
! Do nothing
return
end subroutine mld_d_base_aggregator_set_aggr_type
subroutine mld_d_base_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod
implicit none

@ -90,14 +90,32 @@ module mld_d_dec_aggregator_mod
!
!
type, extends(mld_d_base_aggregator_type) :: mld_d_dec_aggregator_type
procedure(mld_d_map_bld), nopass, pointer :: map_bld => null()
contains
procedure, pass(ag) :: bld_tprol => mld_d_dec_aggregator_build_tprol
procedure, pass(ag) :: mat_asb => mld_d_dec_aggregator_mat_asb
procedure, nopass :: fmt => mld_d_dec_aggregator_fmt
procedure, pass(ag) :: bld_tprol => mld_d_dec_aggregator_build_tprol
procedure, pass(ag) :: mat_asb => mld_d_dec_aggregator_mat_asb
procedure, pass(ag) :: default => mld_d_dec_aggregator_default
procedure, pass(ag) :: set_aggr_type => mld_d_dec_aggregator_set_aggr_type
procedure, nopass :: fmt => mld_d_dec_aggregator_fmt
end type mld_d_dec_aggregator_type
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
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_map_bld
end interface
procedure(mld_d_map_bld) :: mld_d_vmb_map_bld, mld_d_hyb_map_bld
interface
subroutine mld_d_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
import :: mld_d_dec_aggregator_type, psb_desc_type, psb_dspmat_type, psb_dpk_, &
@ -133,6 +151,38 @@ module mld_d_dec_aggregator_mod
contains
subroutine mld_d_dec_aggregator_set_aggr_type(ag,parms,info)
use mld_base_prec_type
implicit none
class(mld_d_dec_aggregator_type), intent(inout) :: ag
type(mld_dml_parms), intent(in) :: parms
integer(psb_ipk_), intent(out) :: info
select case(parms%aggr_type)
case (mld_noalg_)
ag%map_bld => null()
case (mld_vmb_)
ag%map_bld => mld_d_vmb_map_bld
case (mld_hyb_)
ag%map_bld => mld_d_hyb_map_bld
case default
write(0,*) 'Unknown aggregation type, defaulting to VMB'
ag%map_bld => mld_d_vmb_map_bld
end select
return
end subroutine mld_d_dec_aggregator_set_aggr_type
subroutine mld_d_dec_aggregator_default(ag)
implicit none
class(mld_d_dec_aggregator_type), intent(inout) :: ag
ag%map_bld => mld_d_vmb_map_bld
return
end subroutine mld_d_dec_aggregator_default
function mld_d_dec_aggregator_fmt() result(val)
implicit none
character(len=32) :: val

@ -123,21 +123,6 @@ module mld_d_inner_mod
end subroutine mld_daggrmap_bld
end interface mld_aggrmap_bld
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
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_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_

@ -103,6 +103,7 @@ module mld_s_base_aggregator_mod
procedure, pass(ag) :: free => mld_s_base_aggregator_free
procedure, pass(ag) :: default => mld_s_base_aggregator_default
procedure, pass(ag) :: descr => mld_s_base_aggregator_descr
procedure, pass(ag) :: set_aggr_type => mld_s_base_aggregator_set_aggr_type
procedure, nopass :: fmt => mld_s_base_aggregator_fmt
end type mld_s_base_aggregator_type
@ -173,6 +174,17 @@ contains
return
end subroutine mld_s_base_aggregator_descr
subroutine mld_s_base_aggregator_set_aggr_type(ag,parms,info)
implicit none
class(mld_s_base_aggregator_type), intent(inout) :: ag
type(mld_sml_parms), intent(in) :: parms
integer(psb_ipk_), intent(out) :: info
! Do nothing
return
end subroutine mld_s_base_aggregator_set_aggr_type
subroutine mld_s_base_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod
implicit none

@ -90,14 +90,32 @@ module mld_s_dec_aggregator_mod
!
!
type, extends(mld_s_base_aggregator_type) :: mld_s_dec_aggregator_type
procedure(mld_s_map_bld), nopass, pointer :: map_bld => null()
contains
procedure, pass(ag) :: bld_tprol => mld_s_dec_aggregator_build_tprol
procedure, pass(ag) :: mat_asb => mld_s_dec_aggregator_mat_asb
procedure, nopass :: fmt => mld_s_dec_aggregator_fmt
procedure, pass(ag) :: bld_tprol => mld_s_dec_aggregator_build_tprol
procedure, pass(ag) :: mat_asb => mld_s_dec_aggregator_mat_asb
procedure, pass(ag) :: default => mld_s_dec_aggregator_default
procedure, pass(ag) :: set_aggr_type => mld_s_dec_aggregator_set_aggr_type
procedure, nopass :: fmt => mld_s_dec_aggregator_fmt
end type mld_s_dec_aggregator_type
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
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_map_bld
end interface
procedure(mld_s_map_bld) :: mld_s_vmb_map_bld, mld_s_hyb_map_bld
interface
subroutine mld_s_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
import :: mld_s_dec_aggregator_type, psb_desc_type, psb_sspmat_type, psb_spk_, &
@ -133,6 +151,38 @@ module mld_s_dec_aggregator_mod
contains
subroutine mld_s_dec_aggregator_set_aggr_type(ag,parms,info)
use mld_base_prec_type
implicit none
class(mld_s_dec_aggregator_type), intent(inout) :: ag
type(mld_sml_parms), intent(in) :: parms
integer(psb_ipk_), intent(out) :: info
select case(parms%aggr_type)
case (mld_noalg_)
ag%map_bld => null()
case (mld_vmb_)
ag%map_bld => mld_s_vmb_map_bld
case (mld_hyb_)
ag%map_bld => mld_s_hyb_map_bld
case default
write(0,*) 'Unknown aggregation type, defaulting to VMB'
ag%map_bld => mld_s_vmb_map_bld
end select
return
end subroutine mld_s_dec_aggregator_set_aggr_type
subroutine mld_s_dec_aggregator_default(ag)
implicit none
class(mld_s_dec_aggregator_type), intent(inout) :: ag
ag%map_bld => mld_s_vmb_map_bld
return
end subroutine mld_s_dec_aggregator_default
function mld_s_dec_aggregator_fmt() result(val)
implicit none
character(len=32) :: val

@ -123,21 +123,6 @@ module mld_s_inner_mod
end subroutine mld_saggrmap_bld
end interface mld_aggrmap_bld
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
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_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_

@ -103,6 +103,7 @@ module mld_z_base_aggregator_mod
procedure, pass(ag) :: free => mld_z_base_aggregator_free
procedure, pass(ag) :: default => mld_z_base_aggregator_default
procedure, pass(ag) :: descr => mld_z_base_aggregator_descr
procedure, pass(ag) :: set_aggr_type => mld_z_base_aggregator_set_aggr_type
procedure, nopass :: fmt => mld_z_base_aggregator_fmt
end type mld_z_base_aggregator_type
@ -173,6 +174,17 @@ contains
return
end subroutine mld_z_base_aggregator_descr
subroutine mld_z_base_aggregator_set_aggr_type(ag,parms,info)
implicit none
class(mld_z_base_aggregator_type), intent(inout) :: ag
type(mld_dml_parms), intent(in) :: parms
integer(psb_ipk_), intent(out) :: info
! Do nothing
return
end subroutine mld_z_base_aggregator_set_aggr_type
subroutine mld_z_base_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod
implicit none

@ -90,14 +90,32 @@ module mld_z_dec_aggregator_mod
!
!
type, extends(mld_z_base_aggregator_type) :: mld_z_dec_aggregator_type
procedure(mld_z_map_bld), nopass, pointer :: map_bld => null()
contains
procedure, pass(ag) :: bld_tprol => mld_z_dec_aggregator_build_tprol
procedure, pass(ag) :: mat_asb => mld_z_dec_aggregator_mat_asb
procedure, nopass :: fmt => mld_z_dec_aggregator_fmt
procedure, pass(ag) :: bld_tprol => mld_z_dec_aggregator_build_tprol
procedure, pass(ag) :: mat_asb => mld_z_dec_aggregator_mat_asb
procedure, pass(ag) :: default => mld_z_dec_aggregator_default
procedure, pass(ag) :: set_aggr_type => mld_z_dec_aggregator_set_aggr_type
procedure, nopass :: fmt => mld_z_dec_aggregator_fmt
end type mld_z_dec_aggregator_type
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
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_map_bld
end interface
procedure(mld_z_map_bld) :: mld_z_vmb_map_bld, mld_z_hyb_map_bld
interface
subroutine mld_z_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info)
import :: mld_z_dec_aggregator_type, psb_desc_type, psb_zspmat_type, psb_dpk_, &
@ -133,6 +151,38 @@ module mld_z_dec_aggregator_mod
contains
subroutine mld_z_dec_aggregator_set_aggr_type(ag,parms,info)
use mld_base_prec_type
implicit none
class(mld_z_dec_aggregator_type), intent(inout) :: ag
type(mld_dml_parms), intent(in) :: parms
integer(psb_ipk_), intent(out) :: info
select case(parms%aggr_type)
case (mld_noalg_)
ag%map_bld => null()
case (mld_vmb_)
ag%map_bld => mld_z_vmb_map_bld
case (mld_hyb_)
ag%map_bld => mld_z_hyb_map_bld
case default
write(0,*) 'Unknown aggregation type, defaulting to VMB'
ag%map_bld => mld_z_vmb_map_bld
end select
return
end subroutine mld_z_dec_aggregator_set_aggr_type
subroutine mld_z_dec_aggregator_default(ag)
implicit none
class(mld_z_dec_aggregator_type), intent(inout) :: ag
ag%map_bld => mld_z_vmb_map_bld
return
end subroutine mld_z_dec_aggregator_default
function mld_z_dec_aggregator_fmt() result(val)
implicit none
character(len=32) :: val

@ -123,21 +123,6 @@ module mld_z_inner_mod
end subroutine mld_zaggrmap_bld
end interface mld_aggrmap_bld
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
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_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_

Loading…
Cancel
Save