From e1d9157136e808cc8394e78a4990a444241f3fde Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 11 May 2018 13:38:22 +0100 Subject: [PATCH] Unified vmb and hyb map_bld inside dec_aggregator. --- .../aggregator/mld_c_dec_aggregator_tprol.f90 | 3 +- mlprec/impl/aggregator/mld_c_hyb_map_bld.f90 | 2 +- mlprec/impl/aggregator/mld_c_vmb_map_bld.f90 | 2 +- .../aggregator/mld_d_dec_aggregator_tprol.f90 | 3 +- mlprec/impl/aggregator/mld_d_hyb_map_bld.f90 | 2 +- mlprec/impl/aggregator/mld_d_vmb_map_bld.f90 | 2 +- .../aggregator/mld_s_dec_aggregator_tprol.f90 | 3 +- mlprec/impl/aggregator/mld_s_hyb_map_bld.f90 | 2 +- mlprec/impl/aggregator/mld_s_vmb_map_bld.f90 | 2 +- .../aggregator/mld_z_dec_aggregator_tprol.f90 | 3 +- mlprec/impl/aggregator/mld_z_hyb_map_bld.f90 | 2 +- mlprec/impl/aggregator/mld_z_vmb_map_bld.f90 | 2 +- mlprec/impl/level/mld_c_base_onelev_cseti.F90 | 6 +- mlprec/impl/level/mld_c_base_onelev_seti.F90 | 5 +- mlprec/impl/level/mld_d_base_onelev_cseti.F90 | 6 +- mlprec/impl/level/mld_d_base_onelev_seti.F90 | 5 +- mlprec/impl/level/mld_s_base_onelev_cseti.F90 | 6 +- mlprec/impl/level/mld_s_base_onelev_seti.F90 | 5 +- mlprec/impl/level/mld_z_base_onelev_cseti.F90 | 6 +- mlprec/impl/level/mld_z_base_onelev_seti.F90 | 5 +- mlprec/mld_c_base_aggregator_mod.f90 | 12 ++++ mlprec/mld_c_dec_aggregator_mod.f90 | 56 ++++++++++++++++++- mlprec/mld_c_inner_mod.f90 | 15 ----- mlprec/mld_d_base_aggregator_mod.f90 | 12 ++++ mlprec/mld_d_dec_aggregator_mod.f90 | 56 ++++++++++++++++++- mlprec/mld_d_inner_mod.f90 | 15 ----- mlprec/mld_s_base_aggregator_mod.f90 | 12 ++++ mlprec/mld_s_dec_aggregator_mod.f90 | 56 ++++++++++++++++++- mlprec/mld_s_inner_mod.f90 | 15 ----- mlprec/mld_z_base_aggregator_mod.f90 | 12 ++++ mlprec/mld_z_dec_aggregator_mod.f90 | 56 ++++++++++++++++++- mlprec/mld_z_inner_mod.f90 | 15 ----- 32 files changed, 296 insertions(+), 108 deletions(-) diff --git a/mlprec/impl/aggregator/mld_c_dec_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_c_dec_aggregator_tprol.f90 index b9e6ae1f..f6caf655 100644 --- a/mlprec/impl/aggregator/mld_c_dec_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_c_dec_aggregator_tprol.f90 @@ -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 diff --git a/mlprec/impl/aggregator/mld_c_hyb_map_bld.f90 b/mlprec/impl/aggregator/mld_c_hyb_map_bld.f90 index dc993846..e6d0d75c 100644 --- a/mlprec/impl/aggregator/mld_c_hyb_map_bld.f90 +++ b/mlprec/impl/aggregator/mld_c_hyb_map_bld.f90 @@ -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 diff --git a/mlprec/impl/aggregator/mld_c_vmb_map_bld.f90 b/mlprec/impl/aggregator/mld_c_vmb_map_bld.f90 index 1c300ae4..4c5cf944 100644 --- a/mlprec/impl/aggregator/mld_c_vmb_map_bld.f90 +++ b/mlprec/impl/aggregator/mld_c_vmb_map_bld.f90 @@ -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 diff --git a/mlprec/impl/aggregator/mld_d_dec_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_d_dec_aggregator_tprol.f90 index b3f1d099..cd5196bc 100644 --- a/mlprec/impl/aggregator/mld_d_dec_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_d_dec_aggregator_tprol.f90 @@ -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 diff --git a/mlprec/impl/aggregator/mld_d_hyb_map_bld.f90 b/mlprec/impl/aggregator/mld_d_hyb_map_bld.f90 index e7bc63dc..ad73ae50 100644 --- a/mlprec/impl/aggregator/mld_d_hyb_map_bld.f90 +++ b/mlprec/impl/aggregator/mld_d_hyb_map_bld.f90 @@ -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 diff --git a/mlprec/impl/aggregator/mld_d_vmb_map_bld.f90 b/mlprec/impl/aggregator/mld_d_vmb_map_bld.f90 index 2b523f7c..83d22fc4 100644 --- a/mlprec/impl/aggregator/mld_d_vmb_map_bld.f90 +++ b/mlprec/impl/aggregator/mld_d_vmb_map_bld.f90 @@ -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 diff --git a/mlprec/impl/aggregator/mld_s_dec_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_s_dec_aggregator_tprol.f90 index a1a784e1..f305e2e6 100644 --- a/mlprec/impl/aggregator/mld_s_dec_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_s_dec_aggregator_tprol.f90 @@ -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 diff --git a/mlprec/impl/aggregator/mld_s_hyb_map_bld.f90 b/mlprec/impl/aggregator/mld_s_hyb_map_bld.f90 index 96fe92d6..04bd60ff 100644 --- a/mlprec/impl/aggregator/mld_s_hyb_map_bld.f90 +++ b/mlprec/impl/aggregator/mld_s_hyb_map_bld.f90 @@ -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 diff --git a/mlprec/impl/aggregator/mld_s_vmb_map_bld.f90 b/mlprec/impl/aggregator/mld_s_vmb_map_bld.f90 index b0de5055..93293632 100644 --- a/mlprec/impl/aggregator/mld_s_vmb_map_bld.f90 +++ b/mlprec/impl/aggregator/mld_s_vmb_map_bld.f90 @@ -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 diff --git a/mlprec/impl/aggregator/mld_z_dec_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_z_dec_aggregator_tprol.f90 index 2cb8d57c..a2ff5ca9 100644 --- a/mlprec/impl/aggregator/mld_z_dec_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_z_dec_aggregator_tprol.f90 @@ -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 diff --git a/mlprec/impl/aggregator/mld_z_hyb_map_bld.f90 b/mlprec/impl/aggregator/mld_z_hyb_map_bld.f90 index 4fc95dd3..0648421f 100644 --- a/mlprec/impl/aggregator/mld_z_hyb_map_bld.f90 +++ b/mlprec/impl/aggregator/mld_z_hyb_map_bld.f90 @@ -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 diff --git a/mlprec/impl/aggregator/mld_z_vmb_map_bld.f90 b/mlprec/impl/aggregator/mld_z_vmb_map_bld.f90 index ff131c33..507877fc 100644 --- a/mlprec/impl/aggregator/mld_z_vmb_map_bld.f90 +++ b/mlprec/impl/aggregator/mld_z_vmb_map_bld.f90 @@ -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 diff --git a/mlprec/impl/level/mld_c_base_onelev_cseti.F90 b/mlprec/impl/level/mld_c_base_onelev_cseti.F90 index a2cf8bfc..b51817b3 100644 --- a/mlprec/impl/level/mld_c_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_c_base_onelev_cseti.F90 @@ -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 diff --git a/mlprec/impl/level/mld_c_base_onelev_seti.F90 b/mlprec/impl/level/mld_c_base_onelev_seti.F90 index 583bf2f1..534915cc 100644 --- a/mlprec/impl/level/mld_c_base_onelev_seti.F90 +++ b/mlprec/impl/level/mld_c_base_onelev_seti.F90 @@ -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 diff --git a/mlprec/impl/level/mld_d_base_onelev_cseti.F90 b/mlprec/impl/level/mld_d_base_onelev_cseti.F90 index ea44e7de..25b34802 100644 --- a/mlprec/impl/level/mld_d_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_d_base_onelev_cseti.F90 @@ -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 diff --git a/mlprec/impl/level/mld_d_base_onelev_seti.F90 b/mlprec/impl/level/mld_d_base_onelev_seti.F90 index 82234b51..d68f2ec6 100644 --- a/mlprec/impl/level/mld_d_base_onelev_seti.F90 +++ b/mlprec/impl/level/mld_d_base_onelev_seti.F90 @@ -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 diff --git a/mlprec/impl/level/mld_s_base_onelev_cseti.F90 b/mlprec/impl/level/mld_s_base_onelev_cseti.F90 index fc95bc22..12fcc41b 100644 --- a/mlprec/impl/level/mld_s_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_s_base_onelev_cseti.F90 @@ -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 diff --git a/mlprec/impl/level/mld_s_base_onelev_seti.F90 b/mlprec/impl/level/mld_s_base_onelev_seti.F90 index ad241194..7d12cf9b 100644 --- a/mlprec/impl/level/mld_s_base_onelev_seti.F90 +++ b/mlprec/impl/level/mld_s_base_onelev_seti.F90 @@ -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 diff --git a/mlprec/impl/level/mld_z_base_onelev_cseti.F90 b/mlprec/impl/level/mld_z_base_onelev_cseti.F90 index d519e8a6..0d0c2bc0 100644 --- a/mlprec/impl/level/mld_z_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_z_base_onelev_cseti.F90 @@ -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 diff --git a/mlprec/impl/level/mld_z_base_onelev_seti.F90 b/mlprec/impl/level/mld_z_base_onelev_seti.F90 index 1d1505f4..bfba8765 100644 --- a/mlprec/impl/level/mld_z_base_onelev_seti.F90 +++ b/mlprec/impl/level/mld_z_base_onelev_seti.F90 @@ -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 diff --git a/mlprec/mld_c_base_aggregator_mod.f90 b/mlprec/mld_c_base_aggregator_mod.f90 index 85d16d4d..b62c9af1 100644 --- a/mlprec/mld_c_base_aggregator_mod.f90 +++ b/mlprec/mld_c_base_aggregator_mod.f90 @@ -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 diff --git a/mlprec/mld_c_dec_aggregator_mod.f90 b/mlprec/mld_c_dec_aggregator_mod.f90 index 4548b4b0..ecf6f43c 100644 --- a/mlprec/mld_c_dec_aggregator_mod.f90 +++ b/mlprec/mld_c_dec_aggregator_mod.f90 @@ -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 diff --git a/mlprec/mld_c_inner_mod.f90 b/mlprec/mld_c_inner_mod.f90 index d84296d4..46b74f36 100644 --- a/mlprec/mld_c_inner_mod.f90 +++ b/mlprec/mld_c_inner_mod.f90 @@ -122,21 +122,6 @@ module mld_c_inner_mod integer(psb_ipk_), intent(out) :: info 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) diff --git a/mlprec/mld_d_base_aggregator_mod.f90 b/mlprec/mld_d_base_aggregator_mod.f90 index f89b636a..515d64c7 100644 --- a/mlprec/mld_d_base_aggregator_mod.f90 +++ b/mlprec/mld_d_base_aggregator_mod.f90 @@ -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 diff --git a/mlprec/mld_d_dec_aggregator_mod.f90 b/mlprec/mld_d_dec_aggregator_mod.f90 index 4ddb8f5a..3a64e30f 100644 --- a/mlprec/mld_d_dec_aggregator_mod.f90 +++ b/mlprec/mld_d_dec_aggregator_mod.f90 @@ -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 diff --git a/mlprec/mld_d_inner_mod.f90 b/mlprec/mld_d_inner_mod.f90 index 9b33e872..81cb1ee2 100644 --- a/mlprec/mld_d_inner_mod.f90 +++ b/mlprec/mld_d_inner_mod.f90 @@ -122,21 +122,6 @@ module mld_d_inner_mod integer(psb_ipk_), intent(out) :: info 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) diff --git a/mlprec/mld_s_base_aggregator_mod.f90 b/mlprec/mld_s_base_aggregator_mod.f90 index 6128df62..f668023a 100644 --- a/mlprec/mld_s_base_aggregator_mod.f90 +++ b/mlprec/mld_s_base_aggregator_mod.f90 @@ -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 diff --git a/mlprec/mld_s_dec_aggregator_mod.f90 b/mlprec/mld_s_dec_aggregator_mod.f90 index 76604cbf..67a2618a 100644 --- a/mlprec/mld_s_dec_aggregator_mod.f90 +++ b/mlprec/mld_s_dec_aggregator_mod.f90 @@ -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 diff --git a/mlprec/mld_s_inner_mod.f90 b/mlprec/mld_s_inner_mod.f90 index 3793d055..55bd0ad0 100644 --- a/mlprec/mld_s_inner_mod.f90 +++ b/mlprec/mld_s_inner_mod.f90 @@ -122,21 +122,6 @@ module mld_s_inner_mod integer(psb_ipk_), intent(out) :: info 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) diff --git a/mlprec/mld_z_base_aggregator_mod.f90 b/mlprec/mld_z_base_aggregator_mod.f90 index e76f4561..660bc415 100644 --- a/mlprec/mld_z_base_aggregator_mod.f90 +++ b/mlprec/mld_z_base_aggregator_mod.f90 @@ -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 diff --git a/mlprec/mld_z_dec_aggregator_mod.f90 b/mlprec/mld_z_dec_aggregator_mod.f90 index 391ec596..1ed1fa4f 100644 --- a/mlprec/mld_z_dec_aggregator_mod.f90 +++ b/mlprec/mld_z_dec_aggregator_mod.f90 @@ -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 diff --git a/mlprec/mld_z_inner_mod.f90 b/mlprec/mld_z_inner_mod.f90 index 461de81d..04c41c4f 100644 --- a/mlprec/mld_z_inner_mod.f90 +++ b/mlprec/mld_z_inner_mod.f90 @@ -122,21 +122,6 @@ module mld_z_inner_mod integer(psb_ipk_), intent(out) :: info 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)