From d707a6c9ba88f25849c140db19b6f279023f8d46 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 4 May 2018 21:05:10 +0100 Subject: [PATCH] Progress with compilation in aggregator subdir. --- mlprec/impl/Makefile | 10 +- mlprec/impl/aggregator/Makefile | 1 - .../mld_c_base_aggregator_mat_asb.f90 | 21 +- .../mld_c_base_aggregator_tprol.f90 | 20 +- mlprec/impl/aggregator/mld_c_dec_map_bld.f90 | 12 +- .../mld_c_hybrid_aggregator_tprol.f90 | 18 +- .../mld_c_symdec_aggregator_tprol.f90 | 14 +- .../mld_d_base_aggregator_mat_asb.f90 | 21 +- .../mld_d_base_aggregator_tprol.f90 | 20 +- mlprec/impl/aggregator/mld_d_dec_map_bld.f90 | 10 +- .../mld_d_hybrid_aggregator_tprol.f90 | 18 +- .../mld_d_symdec_aggregator_tprol.f90 | 14 +- .../mld_s_base_aggregator_mat_asb.f90 | 21 +- .../mld_s_base_aggregator_tprol.f90 | 20 +- mlprec/impl/aggregator/mld_s_dec_map_bld.f90 | 12 +- .../mld_s_hybrid_aggregator_tprol.f90 | 18 +- .../mld_s_symdec_aggregator_tprol.f90 | 14 +- .../mld_z_base_aggregator_mat_asb.f90 | 21 +- .../mld_z_base_aggregator_tprol.f90 | 20 +- mlprec/impl/aggregator/mld_z_dec_map_bld.f90 | 10 +- .../mld_z_hybrid_aggregator_tprol.f90 | 18 +- .../mld_z_symdec_aggregator_tprol.f90 | 14 +- mlprec/impl/mld_c_hierarchy_bld.f90 | 27 +- mlprec/impl/mld_c_lev_aggrmat_asb.f90 | 267 ------------------ mlprec/impl/mld_caggrmap_bld.f90 | 189 ------------- mlprec/impl/mld_caggrmat_asb.f90 | 193 ------------- mlprec/impl/mld_d_hierarchy_bld.f90 | 27 +- mlprec/impl/mld_d_lev_aggrmat_asb.f90 | 267 ------------------ mlprec/impl/mld_daggrmap_bld.f90 | 189 ------------- mlprec/impl/mld_daggrmat_asb.f90 | 193 ------------- mlprec/impl/mld_s_hierarchy_bld.f90 | 27 +- mlprec/impl/mld_s_lev_aggrmat_asb.f90 | 267 ------------------ mlprec/impl/mld_saggrmap_bld.f90 | 189 ------------- mlprec/impl/mld_saggrmat_asb.f90 | 193 ------------- mlprec/impl/mld_z_hierarchy_bld.f90 | 27 +- mlprec/impl/mld_z_lev_aggrmat_asb.f90 | 267 ------------------ mlprec/impl/mld_zaggrmap_bld.f90 | 189 ------------- mlprec/impl/mld_zaggrmat_asb.f90 | 193 ------------- mlprec/mld_c_base_aggregator_mod.f90 | 20 +- mlprec/mld_c_inner_mod.f90 | 2 +- mlprec/mld_c_onelev_mod.f90 | 41 ++- mlprec/mld_d_base_aggregator_mod.f90 | 20 +- mlprec/mld_d_inner_mod.f90 | 2 +- mlprec/mld_d_onelev_mod.f90 | 41 ++- mlprec/mld_s_base_aggregator_mod.f90 | 20 +- mlprec/mld_s_inner_mod.f90 | 2 +- mlprec/mld_s_onelev_mod.f90 | 41 ++- mlprec/mld_z_base_aggregator_mod.f90 | 20 +- mlprec/mld_z_inner_mod.f90 | 2 +- mlprec/mld_z_onelev_mod.f90 | 41 ++- 50 files changed, 467 insertions(+), 2836 deletions(-) delete mode 100644 mlprec/impl/mld_c_lev_aggrmat_asb.f90 delete mode 100644 mlprec/impl/mld_caggrmap_bld.f90 delete mode 100644 mlprec/impl/mld_caggrmat_asb.f90 delete mode 100644 mlprec/impl/mld_d_lev_aggrmat_asb.f90 delete mode 100644 mlprec/impl/mld_daggrmap_bld.f90 delete mode 100644 mlprec/impl/mld_daggrmat_asb.f90 delete mode 100644 mlprec/impl/mld_s_lev_aggrmat_asb.f90 delete mode 100644 mlprec/impl/mld_saggrmap_bld.f90 delete mode 100644 mlprec/impl/mld_saggrmat_asb.f90 delete mode 100644 mlprec/impl/mld_z_lev_aggrmat_asb.f90 delete mode 100644 mlprec/impl/mld_zaggrmap_bld.f90 delete mode 100644 mlprec/impl/mld_zaggrmat_asb.f90 diff --git a/mlprec/impl/Makefile b/mlprec/impl/Makefile index 9a0d92bf..27842294 100644 --- a/mlprec/impl/Makefile +++ b/mlprec/impl/Makefile @@ -25,22 +25,22 @@ MPCOBJS=mld_dslud_interface.o mld_zslud_interface.o DINNEROBJS= mld_dmlprec_bld.o mld_dfile_prec_descr.o \ mld_d_smoothers_bld.o mld_d_hierarchy_bld.o \ mld_dmlprec_aply.o \ - $(DMPFOBJS) mld_d_extprol_bld.o mld_d_lev_aggrmap_bld.o mld_d_lev_aggrmat_asb.o + $(DMPFOBJS) mld_d_extprol_bld.o SINNEROBJS= mld_smlprec_bld.o mld_sfile_prec_descr.o \ mld_s_smoothers_bld.o mld_s_hierarchy_bld.o \ mld_smlprec_aply.o \ - $(SMPFOBJS) mld_s_extprol_bld.o mld_s_lev_aggrmap_bld.o mld_s_lev_aggrmat_asb.o + $(SMPFOBJS) mld_s_extprol_bld.o ZINNEROBJS= mld_zmlprec_bld.o mld_zfile_prec_descr.o \ mld_z_smoothers_bld.o mld_z_hierarchy_bld.o \ mld_zmlprec_aply.o \ - $(ZMPFOBJS) mld_z_extprol_bld.o mld_z_lev_aggrmap_bld.o mld_z_lev_aggrmat_asb.o + $(ZMPFOBJS) mld_z_extprol_bld.o CINNEROBJS= mld_cmlprec_bld.o mld_cfile_prec_descr.o \ mld_c_smoothers_bld.o mld_c_hierarchy_bld.o \ mld_cmlprec_aply.o \ - $(CMPFOBJS) mld_c_extprol_bld.o mld_c_lev_aggrmap_bld.o mld_c_lev_aggrmat_asb.o + $(CMPFOBJS) mld_c_extprol_bld.o INNEROBJS= $(SINNEROBJS) $(DINNEROBJS) $(CINNEROBJS) $(ZINNEROBJS) @@ -67,7 +67,7 @@ OBJS=$(F90OBJS) $(COBJS) $(MPCOBJS) LIBNAME=libmld_prec.a -lib: $(OBJS) levd smoothd solvd aggrd +lib: $(OBJS) aggrd levd smoothd solvd $(AR) $(HERE)/$(LIBNAME) $(OBJS) $(RANLIB) $(HERE)/$(LIBNAME) diff --git a/mlprec/impl/aggregator/Makefile b/mlprec/impl/aggregator/Makefile index 1015a765..d96b835b 100644 --- a/mlprec/impl/aggregator/Makefile +++ b/mlprec/impl/aggregator/Makefile @@ -22,7 +22,6 @@ mld_d_bcmatch_aggregator_tprol.o\ mld_d_hybrid_aggregator_tprol.o \ mld_d_symdec_aggregator_tprol.o \ mld_d_map_to_tprol.o mld_d_dec_map_bld.o mld_d_hyb_map_bld.o\ -mld_daggrmat_unsmth_spmm_asb.o\ mld_daggrmat_biz_asb.o mld_daggrmat_minnrg_asb.o\ mld_daggrmat_nosmth_asb.o mld_daggrmat_smth_asb.o \ mld_c_base_aggregator_mat_asb.o \ diff --git a/mlprec/impl/aggregator/mld_c_base_aggregator_mat_asb.f90 b/mlprec/impl/aggregator/mld_c_base_aggregator_mat_asb.f90 index dc4bb1df..d67f2e3e 100644 --- a/mlprec/impl/aggregator/mld_c_base_aggregator_mat_asb.f90 +++ b/mlprec/impl/aggregator/mld_c_base_aggregator_mat_asb.f90 @@ -133,7 +133,8 @@ ! subroutine mld_c_base_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) use psb_base_mod - use mld_c_inner_mod, mld_protect_name => mld_c_base_aggregator_mat_asb + use mld_c_prec_type, mld_protect_name => mld_c_base_aggregator_mat_asb + use mld_c_inner_mod implicit none class(mld_c_base_aggregator_type), target, intent(inout) :: ag @@ -163,26 +164,12 @@ subroutine mld_c_base_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_ ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - call mld_check_def(parms%aggr_kind,'Smoother',& - & mld_smooth_prol_,is_legal_ml_aggr_kind) - call mld_check_def(parms%coarse_mat,'Coarse matrix',& - & mld_distr_mat_,is_legal_ml_coarse_mat) - call mld_check_def(parms%aggr_filter,'Use filtered matrix',& - & mld_no_filter_mat_,is_legal_aggr_filter) - call mld_check_def(parms%smoother_pos,'smooth_pos',& - & mld_pre_smooth_,is_legal_ml_smooth_pos) - call mld_check_def(parms%aggr_omega_alg,'Omega Alg.',& - & mld_eig_est_,is_legal_ml_aggr_omega_alg) - call mld_check_def(parms%aggr_eig,'Eigenvalue estimate',& - & mld_max_norm_,is_legal_ml_aggr_eig) - call mld_check_def(parms%aggr_omega_val,'Omega',szero,is_legal_s_omega) - ! ! 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_) + ! algorithm specified by ! - select case (parms%aggr_kind) + select case (parms%aggr_prol) case (mld_no_smooth_) call mld_caggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,& diff --git a/mlprec/impl/aggregator/mld_c_base_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_c_base_aggregator_tprol.f90 index 18c5428d..92a685a9 100644 --- a/mlprec/impl/aggregator/mld_c_base_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_c_base_aggregator_tprol.f90 @@ -1,3 +1,4 @@ + ! ! ! MLD2P4 version 2.1 @@ -75,8 +76,8 @@ ! subroutine mld_c_base_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod -! use mld_c_base_aggregator_mod - use mld_c_inner_mod, mld_protect_name => mld_c_base_aggregator_build_tprol + use mld_c_prec_type, mld_protect_name => mld_c_base_aggregator_build_tprol + use mld_c_inner_mod implicit none class(mld_c_base_aggregator_type), target, intent(inout) :: ag type(mld_sml_parms), intent(inout) :: parms @@ -102,10 +103,10 @@ subroutine mld_c_base_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - call mld_check_def(parms%ml_type,'Multilevel type',& - & mld_mult_ml_,is_legal_ml_type) - call mld_check_def(parms%aggr_alg,'Aggregation',& - & mld_dec_aggr_,is_legal_ml_aggr_alg) + call mld_check_def(parms%ml_cycle,'Multilevel cycle',& + & mld_mult_ml_,is_legal_ml_cycle) + call mld_check_def(parms%par_aggr_alg,'Aggregation',& + & mld_dec_aggr_,is_legal_ml_par_aggr_alg) call mld_check_def(parms%aggr_ord,'Ordering',& & mld_aggr_ord_nat_,is_legal_ml_aggr_ord) call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs) @@ -113,7 +114,12 @@ subroutine mld_c_base_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op call mld_dec_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info) - call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='dec_map_bld/map_to_tprol') + goto 9999 + endif call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/aggregator/mld_c_dec_map_bld.f90 b/mlprec/impl/aggregator/mld_c_dec_map_bld.f90 index 4c480c94..4f98159a 100644 --- a/mlprec/impl/aggregator/mld_c_dec_map_bld.f90 +++ b/mlprec/impl/aggregator/mld_c_dec_map_bld.f90 @@ -4,11 +4,12 @@ ! MultiLevel Domain Decomposition Parallel Preconditioners Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) ! -! (C) Copyright 2008-2018 +! (C) Copyright 2008, 2010, 2012, 2015, 2017 , 2017 ! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino +! Salvatore Filippone Cranfield University +! Ambra Abdullahi Hassan University of Rome Tor Vergata +! Pasqua D'Ambra IAC-CNR, Naples, IT +! Daniela di Serafino University of Campania "L. Vanvitelli", Caserta, IT ! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions @@ -70,7 +71,6 @@ subroutine mld_c_dec_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_dec_map_bld implicit none @@ -247,7 +247,7 @@ subroutine mld_c_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info) ! Find its strongly connected neighbourhood not ! already aggregated, and make it into a new aggregate. ! - cpling = dzero + cpling = szero ip = 0 do k=1, nz j = icol(k) diff --git a/mlprec/impl/aggregator/mld_c_hybrid_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_c_hybrid_aggregator_tprol.f90 index 675baaa7..291e17fc 100644 --- a/mlprec/impl/aggregator/mld_c_hybrid_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_c_hybrid_aggregator_tprol.f90 @@ -75,6 +75,7 @@ ! subroutine mld_c_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod + use mld_c_prec_type use mld_c_hybrid_aggregator_mod, mld_protect_name => mld_c_hybrid_aggregator_build_tprol use mld_c_inner_mod implicit none @@ -102,16 +103,23 @@ subroutine mld_c_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr, ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',& + call mld_check_def(parms%ml_cycle,'Multilevel cycle',& & mld_mult_ml_,is_legal_ml_cycle) - call mld_check_def(p%parms%par_aggr_alg,'Aggregation',& + call mld_check_def(parms%par_aggr_alg,'Aggregation',& & mld_dec_aggr_,is_legal_ml_par_aggr_alg) - call mld_check_def(p%parms%aggr_ord,'Ordering',& + call mld_check_def(parms%aggr_ord,'Ordering',& & mld_aggr_ord_nat_,is_legal_ml_aggr_ord) 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_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + + if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='hyb_map_bld/map_to_tprol') + goto 9999 + endif call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/aggregator/mld_c_symdec_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_c_symdec_aggregator_tprol.f90 index 8fe0b7a8..fc5c3611 100644 --- a/mlprec/impl/aggregator/mld_c_symdec_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_c_symdec_aggregator_tprol.f90 @@ -77,6 +77,7 @@ ! subroutine mld_c_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod + use mld_c_prec_type use mld_c_symdec_aggregator_mod, mld_protect_name => mld_c_symdec_aggregator_build_tprol use mld_c_inner_mod implicit none @@ -105,10 +106,10 @@ subroutine mld_c_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr, ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - call mld_check_def(parms%ml_type,'Multilevel type',& - & mld_mult_ml_,is_legal_ml_type) - call mld_check_def(parms%aggr_alg,'Aggregation',& - & mld_dec_aggr_,is_legal_ml_aggr_alg) + call mld_check_def(parms%ml_cycle,'Multilevel cycle',& + & mld_mult_ml_,is_legal_ml_cycle) + call mld_check_def(parms%par_aggr_alg,'Aggregation',& + & mld_dec_aggr_,is_legal_ml_par_aggr_alg) call mld_check_def(parms%aggr_ord,'Ordering',& & mld_aggr_ord_nat_,is_legal_ml_aggr_ord) call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs) @@ -131,6 +132,11 @@ subroutine mld_c_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr, if (info == psb_success_) call atmp%free() if (info == psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='dec_map_bld/map_to_tprol') + goto 9999 + endif call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/aggregator/mld_d_base_aggregator_mat_asb.f90 b/mlprec/impl/aggregator/mld_d_base_aggregator_mat_asb.f90 index ba600776..efbee053 100644 --- a/mlprec/impl/aggregator/mld_d_base_aggregator_mat_asb.f90 +++ b/mlprec/impl/aggregator/mld_d_base_aggregator_mat_asb.f90 @@ -133,7 +133,8 @@ ! subroutine mld_d_base_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) use psb_base_mod - use mld_d_inner_mod, mld_protect_name => mld_d_base_aggregator_mat_asb + use mld_d_prec_type, mld_protect_name => mld_d_base_aggregator_mat_asb + use mld_d_inner_mod implicit none class(mld_d_base_aggregator_type), target, intent(inout) :: ag @@ -163,26 +164,12 @@ subroutine mld_d_base_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_ ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - call mld_check_def(parms%aggr_kind,'Smoother',& - & mld_smooth_prol_,is_legal_ml_aggr_kind) - call mld_check_def(parms%coarse_mat,'Coarse matrix',& - & mld_distr_mat_,is_legal_ml_coarse_mat) - call mld_check_def(parms%aggr_filter,'Use filtered matrix',& - & mld_no_filter_mat_,is_legal_aggr_filter) - call mld_check_def(parms%smoother_pos,'smooth_pos',& - & mld_pre_smooth_,is_legal_ml_smooth_pos) - call mld_check_def(parms%aggr_omega_alg,'Omega Alg.',& - & mld_eig_est_,is_legal_ml_aggr_omega_alg) - call mld_check_def(parms%aggr_eig,'Eigenvalue estimate',& - & mld_max_norm_,is_legal_ml_aggr_eig) - call mld_check_def(parms%aggr_omega_val,'Omega',dzero,is_legal_d_omega) - ! ! 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_) + ! algorithm specified by ! - select case (parms%aggr_kind) + select case (parms%aggr_prol) case (mld_no_smooth_) call mld_daggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,& diff --git a/mlprec/impl/aggregator/mld_d_base_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_d_base_aggregator_tprol.f90 index 02ffb7d7..61e7ba86 100644 --- a/mlprec/impl/aggregator/mld_d_base_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_d_base_aggregator_tprol.f90 @@ -1,3 +1,4 @@ + ! ! ! MLD2P4 version 2.1 @@ -75,8 +76,8 @@ ! subroutine mld_d_base_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod -! use mld_d_base_aggregator_mod - use mld_d_inner_mod, mld_protect_name => mld_d_base_aggregator_build_tprol + use mld_d_prec_type, mld_protect_name => mld_d_base_aggregator_build_tprol + use mld_d_inner_mod implicit none class(mld_d_base_aggregator_type), target, intent(inout) :: ag type(mld_dml_parms), intent(inout) :: parms @@ -102,10 +103,10 @@ subroutine mld_d_base_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - call mld_check_def(parms%ml_type,'Multilevel type',& - & mld_mult_ml_,is_legal_ml_type) - call mld_check_def(parms%aggr_alg,'Aggregation',& - & mld_dec_aggr_,is_legal_ml_aggr_alg) + call mld_check_def(parms%ml_cycle,'Multilevel cycle',& + & mld_mult_ml_,is_legal_ml_cycle) + call mld_check_def(parms%par_aggr_alg,'Aggregation',& + & mld_dec_aggr_,is_legal_ml_par_aggr_alg) call mld_check_def(parms%aggr_ord,'Ordering',& & mld_aggr_ord_nat_,is_legal_ml_aggr_ord) call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs) @@ -113,7 +114,12 @@ subroutine mld_d_base_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op call mld_dec_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info) - call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='dec_map_bld/map_to_tprol') + goto 9999 + endif call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/aggregator/mld_d_dec_map_bld.f90 b/mlprec/impl/aggregator/mld_d_dec_map_bld.f90 index 4925233c..d7576861 100644 --- a/mlprec/impl/aggregator/mld_d_dec_map_bld.f90 +++ b/mlprec/impl/aggregator/mld_d_dec_map_bld.f90 @@ -4,11 +4,12 @@ ! MultiLevel Domain Decomposition Parallel Preconditioners Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) ! -! (C) Copyright 2008-2018 +! (C) Copyright 2008, 2010, 2012, 2015, 2017 , 2017 ! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino +! Salvatore Filippone Cranfield University +! Ambra Abdullahi Hassan University of Rome Tor Vergata +! Pasqua D'Ambra IAC-CNR, Naples, IT +! Daniela di Serafino University of Campania "L. Vanvitelli", Caserta, IT ! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions @@ -70,7 +71,6 @@ subroutine mld_d_dec_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_dec_map_bld implicit none diff --git a/mlprec/impl/aggregator/mld_d_hybrid_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_d_hybrid_aggregator_tprol.f90 index 43506b48..98e43275 100644 --- a/mlprec/impl/aggregator/mld_d_hybrid_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_d_hybrid_aggregator_tprol.f90 @@ -75,6 +75,7 @@ ! subroutine mld_d_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod + use mld_d_prec_type use mld_d_hybrid_aggregator_mod, mld_protect_name => mld_d_hybrid_aggregator_build_tprol use mld_d_inner_mod implicit none @@ -102,16 +103,23 @@ subroutine mld_d_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr, ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',& + call mld_check_def(parms%ml_cycle,'Multilevel cycle',& & mld_mult_ml_,is_legal_ml_cycle) - call mld_check_def(p%parms%par_aggr_alg,'Aggregation',& + call mld_check_def(parms%par_aggr_alg,'Aggregation',& & mld_dec_aggr_,is_legal_ml_par_aggr_alg) - call mld_check_def(p%parms%aggr_ord,'Ordering',& + call mld_check_def(parms%aggr_ord,'Ordering',& & mld_aggr_ord_nat_,is_legal_ml_aggr_ord) 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_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + + if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='hyb_map_bld/map_to_tprol') + goto 9999 + endif call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/aggregator/mld_d_symdec_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_d_symdec_aggregator_tprol.f90 index 8133b712..c9c00780 100644 --- a/mlprec/impl/aggregator/mld_d_symdec_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_d_symdec_aggregator_tprol.f90 @@ -77,6 +77,7 @@ ! subroutine mld_d_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod + use mld_d_prec_type use mld_d_symdec_aggregator_mod, mld_protect_name => mld_d_symdec_aggregator_build_tprol use mld_d_inner_mod implicit none @@ -105,10 +106,10 @@ subroutine mld_d_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr, ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - call mld_check_def(parms%ml_type,'Multilevel type',& - & mld_mult_ml_,is_legal_ml_type) - call mld_check_def(parms%aggr_alg,'Aggregation',& - & mld_dec_aggr_,is_legal_ml_aggr_alg) + call mld_check_def(parms%ml_cycle,'Multilevel cycle',& + & mld_mult_ml_,is_legal_ml_cycle) + call mld_check_def(parms%par_aggr_alg,'Aggregation',& + & mld_dec_aggr_,is_legal_ml_par_aggr_alg) call mld_check_def(parms%aggr_ord,'Ordering',& & mld_aggr_ord_nat_,is_legal_ml_aggr_ord) call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs) @@ -131,6 +132,11 @@ subroutine mld_d_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr, if (info == psb_success_) call atmp%free() if (info == psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='dec_map_bld/map_to_tprol') + goto 9999 + endif call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/aggregator/mld_s_base_aggregator_mat_asb.f90 b/mlprec/impl/aggregator/mld_s_base_aggregator_mat_asb.f90 index 4464cc84..10285bfa 100644 --- a/mlprec/impl/aggregator/mld_s_base_aggregator_mat_asb.f90 +++ b/mlprec/impl/aggregator/mld_s_base_aggregator_mat_asb.f90 @@ -133,7 +133,8 @@ ! subroutine mld_s_base_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) use psb_base_mod - use mld_s_inner_mod, mld_protect_name => mld_s_base_aggregator_mat_asb + use mld_s_prec_type, mld_protect_name => mld_s_base_aggregator_mat_asb + use mld_s_inner_mod implicit none class(mld_s_base_aggregator_type), target, intent(inout) :: ag @@ -163,26 +164,12 @@ subroutine mld_s_base_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_ ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - call mld_check_def(parms%aggr_kind,'Smoother',& - & mld_smooth_prol_,is_legal_ml_aggr_kind) - call mld_check_def(parms%coarse_mat,'Coarse matrix',& - & mld_distr_mat_,is_legal_ml_coarse_mat) - call mld_check_def(parms%aggr_filter,'Use filtered matrix',& - & mld_no_filter_mat_,is_legal_aggr_filter) - call mld_check_def(parms%smoother_pos,'smooth_pos',& - & mld_pre_smooth_,is_legal_ml_smooth_pos) - call mld_check_def(parms%aggr_omega_alg,'Omega Alg.',& - & mld_eig_est_,is_legal_ml_aggr_omega_alg) - call mld_check_def(parms%aggr_eig,'Eigenvalue estimate',& - & mld_max_norm_,is_legal_ml_aggr_eig) - call mld_check_def(parms%aggr_omega_val,'Omega',szero,is_legal_s_omega) - ! ! 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_) + ! algorithm specified by ! - select case (parms%aggr_kind) + select case (parms%aggr_prol) case (mld_no_smooth_) call mld_saggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,& diff --git a/mlprec/impl/aggregator/mld_s_base_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_s_base_aggregator_tprol.f90 index bf83a553..786748d1 100644 --- a/mlprec/impl/aggregator/mld_s_base_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_s_base_aggregator_tprol.f90 @@ -1,3 +1,4 @@ + ! ! ! MLD2P4 version 2.1 @@ -75,8 +76,8 @@ ! subroutine mld_s_base_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod -! use mld_s_base_aggregator_mod - use mld_s_inner_mod, mld_protect_name => mld_s_base_aggregator_build_tprol + use mld_s_prec_type, mld_protect_name => mld_s_base_aggregator_build_tprol + use mld_s_inner_mod implicit none class(mld_s_base_aggregator_type), target, intent(inout) :: ag type(mld_sml_parms), intent(inout) :: parms @@ -102,10 +103,10 @@ subroutine mld_s_base_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - call mld_check_def(parms%ml_type,'Multilevel type',& - & mld_mult_ml_,is_legal_ml_type) - call mld_check_def(parms%aggr_alg,'Aggregation',& - & mld_dec_aggr_,is_legal_ml_aggr_alg) + call mld_check_def(parms%ml_cycle,'Multilevel cycle',& + & mld_mult_ml_,is_legal_ml_cycle) + call mld_check_def(parms%par_aggr_alg,'Aggregation',& + & mld_dec_aggr_,is_legal_ml_par_aggr_alg) call mld_check_def(parms%aggr_ord,'Ordering',& & mld_aggr_ord_nat_,is_legal_ml_aggr_ord) call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs) @@ -113,7 +114,12 @@ subroutine mld_s_base_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op call mld_dec_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info) - call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='dec_map_bld/map_to_tprol') + goto 9999 + endif call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/aggregator/mld_s_dec_map_bld.f90 b/mlprec/impl/aggregator/mld_s_dec_map_bld.f90 index 24f1b408..d9af2f5f 100644 --- a/mlprec/impl/aggregator/mld_s_dec_map_bld.f90 +++ b/mlprec/impl/aggregator/mld_s_dec_map_bld.f90 @@ -4,11 +4,12 @@ ! MultiLevel Domain Decomposition Parallel Preconditioners Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) ! -! (C) Copyright 2008-2018 +! (C) Copyright 2008, 2010, 2012, 2015, 2017 , 2017 ! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino +! Salvatore Filippone Cranfield University +! Ambra Abdullahi Hassan University of Rome Tor Vergata +! Pasqua D'Ambra IAC-CNR, Naples, IT +! Daniela di Serafino University of Campania "L. Vanvitelli", Caserta, IT ! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions @@ -70,7 +71,6 @@ subroutine mld_s_dec_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_dec_map_bld implicit none @@ -247,7 +247,7 @@ subroutine mld_s_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info) ! Find its strongly connected neighbourhood not ! already aggregated, and make it into a new aggregate. ! - cpling = dzero + cpling = szero ip = 0 do k=1, nz j = icol(k) diff --git a/mlprec/impl/aggregator/mld_s_hybrid_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_s_hybrid_aggregator_tprol.f90 index 806f3184..659c3f86 100644 --- a/mlprec/impl/aggregator/mld_s_hybrid_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_s_hybrid_aggregator_tprol.f90 @@ -75,6 +75,7 @@ ! subroutine mld_s_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod + use mld_s_prec_type use mld_s_hybrid_aggregator_mod, mld_protect_name => mld_s_hybrid_aggregator_build_tprol use mld_s_inner_mod implicit none @@ -102,16 +103,23 @@ subroutine mld_s_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr, ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',& + call mld_check_def(parms%ml_cycle,'Multilevel cycle',& & mld_mult_ml_,is_legal_ml_cycle) - call mld_check_def(p%parms%par_aggr_alg,'Aggregation',& + call mld_check_def(parms%par_aggr_alg,'Aggregation',& & mld_dec_aggr_,is_legal_ml_par_aggr_alg) - call mld_check_def(p%parms%aggr_ord,'Ordering',& + call mld_check_def(parms%aggr_ord,'Ordering',& & mld_aggr_ord_nat_,is_legal_ml_aggr_ord) 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_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + + if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='hyb_map_bld/map_to_tprol') + goto 9999 + endif call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/aggregator/mld_s_symdec_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_s_symdec_aggregator_tprol.f90 index b73fe100..e308ab5f 100644 --- a/mlprec/impl/aggregator/mld_s_symdec_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_s_symdec_aggregator_tprol.f90 @@ -77,6 +77,7 @@ ! subroutine mld_s_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod + use mld_s_prec_type use mld_s_symdec_aggregator_mod, mld_protect_name => mld_s_symdec_aggregator_build_tprol use mld_s_inner_mod implicit none @@ -105,10 +106,10 @@ subroutine mld_s_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr, ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - call mld_check_def(parms%ml_type,'Multilevel type',& - & mld_mult_ml_,is_legal_ml_type) - call mld_check_def(parms%aggr_alg,'Aggregation',& - & mld_dec_aggr_,is_legal_ml_aggr_alg) + call mld_check_def(parms%ml_cycle,'Multilevel cycle',& + & mld_mult_ml_,is_legal_ml_cycle) + call mld_check_def(parms%par_aggr_alg,'Aggregation',& + & mld_dec_aggr_,is_legal_ml_par_aggr_alg) call mld_check_def(parms%aggr_ord,'Ordering',& & mld_aggr_ord_nat_,is_legal_ml_aggr_ord) call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs) @@ -131,6 +132,11 @@ subroutine mld_s_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr, if (info == psb_success_) call atmp%free() if (info == psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='dec_map_bld/map_to_tprol') + goto 9999 + endif call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/aggregator/mld_z_base_aggregator_mat_asb.f90 b/mlprec/impl/aggregator/mld_z_base_aggregator_mat_asb.f90 index 5bda2a48..b9eda046 100644 --- a/mlprec/impl/aggregator/mld_z_base_aggregator_mat_asb.f90 +++ b/mlprec/impl/aggregator/mld_z_base_aggregator_mat_asb.f90 @@ -133,7 +133,8 @@ ! subroutine mld_z_base_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) use psb_base_mod - use mld_z_inner_mod, mld_protect_name => mld_z_base_aggregator_mat_asb + use mld_z_prec_type, mld_protect_name => mld_z_base_aggregator_mat_asb + use mld_z_inner_mod implicit none class(mld_z_base_aggregator_type), target, intent(inout) :: ag @@ -163,26 +164,12 @@ subroutine mld_z_base_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_ ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - call mld_check_def(parms%aggr_kind,'Smoother',& - & mld_smooth_prol_,is_legal_ml_aggr_kind) - call mld_check_def(parms%coarse_mat,'Coarse matrix',& - & mld_distr_mat_,is_legal_ml_coarse_mat) - call mld_check_def(parms%aggr_filter,'Use filtered matrix',& - & mld_no_filter_mat_,is_legal_aggr_filter) - call mld_check_def(parms%smoother_pos,'smooth_pos',& - & mld_pre_smooth_,is_legal_ml_smooth_pos) - call mld_check_def(parms%aggr_omega_alg,'Omega Alg.',& - & mld_eig_est_,is_legal_ml_aggr_omega_alg) - call mld_check_def(parms%aggr_eig,'Eigenvalue estimate',& - & mld_max_norm_,is_legal_ml_aggr_eig) - call mld_check_def(parms%aggr_omega_val,'Omega',dzero,is_legal_d_omega) - ! ! 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_) + ! algorithm specified by ! - select case (parms%aggr_kind) + select case (parms%aggr_prol) case (mld_no_smooth_) call mld_zaggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,& diff --git a/mlprec/impl/aggregator/mld_z_base_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_z_base_aggregator_tprol.f90 index 81d8910f..894e4e7a 100644 --- a/mlprec/impl/aggregator/mld_z_base_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_z_base_aggregator_tprol.f90 @@ -1,3 +1,4 @@ + ! ! ! MLD2P4 version 2.1 @@ -75,8 +76,8 @@ ! subroutine mld_z_base_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod -! use mld_z_base_aggregator_mod - use mld_z_inner_mod, mld_protect_name => mld_z_base_aggregator_build_tprol + use mld_z_prec_type, mld_protect_name => mld_z_base_aggregator_build_tprol + use mld_z_inner_mod implicit none class(mld_z_base_aggregator_type), target, intent(inout) :: ag type(mld_dml_parms), intent(inout) :: parms @@ -102,10 +103,10 @@ subroutine mld_z_base_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - call mld_check_def(parms%ml_type,'Multilevel type',& - & mld_mult_ml_,is_legal_ml_type) - call mld_check_def(parms%aggr_alg,'Aggregation',& - & mld_dec_aggr_,is_legal_ml_aggr_alg) + call mld_check_def(parms%ml_cycle,'Multilevel cycle',& + & mld_mult_ml_,is_legal_ml_cycle) + call mld_check_def(parms%par_aggr_alg,'Aggregation',& + & mld_dec_aggr_,is_legal_ml_par_aggr_alg) call mld_check_def(parms%aggr_ord,'Ordering',& & mld_aggr_ord_nat_,is_legal_ml_aggr_ord) call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs) @@ -113,7 +114,12 @@ subroutine mld_z_base_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op call mld_dec_map_bld(parms%aggr_ord,parms%aggr_thresh,a,desc_a,nlaggr,ilaggr,info) - call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='dec_map_bld/map_to_tprol') + goto 9999 + endif call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/aggregator/mld_z_dec_map_bld.f90 b/mlprec/impl/aggregator/mld_z_dec_map_bld.f90 index 6900b221..7c992167 100644 --- a/mlprec/impl/aggregator/mld_z_dec_map_bld.f90 +++ b/mlprec/impl/aggregator/mld_z_dec_map_bld.f90 @@ -4,11 +4,12 @@ ! MultiLevel Domain Decomposition Parallel Preconditioners Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) ! -! (C) Copyright 2008-2018 +! (C) Copyright 2008, 2010, 2012, 2015, 2017 , 2017 ! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino +! Salvatore Filippone Cranfield University +! Ambra Abdullahi Hassan University of Rome Tor Vergata +! Pasqua D'Ambra IAC-CNR, Naples, IT +! Daniela di Serafino University of Campania "L. Vanvitelli", Caserta, IT ! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions @@ -70,7 +71,6 @@ subroutine mld_z_dec_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_dec_map_bld implicit none diff --git a/mlprec/impl/aggregator/mld_z_hybrid_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_z_hybrid_aggregator_tprol.f90 index d0a83ea4..742dbc80 100644 --- a/mlprec/impl/aggregator/mld_z_hybrid_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_z_hybrid_aggregator_tprol.f90 @@ -75,6 +75,7 @@ ! subroutine mld_z_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod + use mld_z_prec_type use mld_z_hybrid_aggregator_mod, mld_protect_name => mld_z_hybrid_aggregator_build_tprol use mld_z_inner_mod implicit none @@ -102,16 +103,23 @@ subroutine mld_z_hybrid_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr, ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',& + call mld_check_def(parms%ml_cycle,'Multilevel cycle',& & mld_mult_ml_,is_legal_ml_cycle) - call mld_check_def(p%parms%par_aggr_alg,'Aggregation',& + call mld_check_def(parms%par_aggr_alg,'Aggregation',& & mld_dec_aggr_,is_legal_ml_par_aggr_alg) - call mld_check_def(p%parms%aggr_ord,'Ordering',& + call mld_check_def(parms%aggr_ord,'Ordering',& & mld_aggr_ord_nat_,is_legal_ml_aggr_ord) 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_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + + if (info==psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='hyb_map_bld/map_to_tprol') + goto 9999 + endif call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/aggregator/mld_z_symdec_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_z_symdec_aggregator_tprol.f90 index 7a8d5967..8f1e8ff8 100644 --- a/mlprec/impl/aggregator/mld_z_symdec_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_z_symdec_aggregator_tprol.f90 @@ -77,6 +77,7 @@ ! subroutine mld_z_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod + use mld_z_prec_type use mld_z_symdec_aggregator_mod, mld_protect_name => mld_z_symdec_aggregator_build_tprol use mld_z_inner_mod implicit none @@ -105,10 +106,10 @@ subroutine mld_z_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr, ictxt = desc_a%get_context() call psb_info(ictxt,me,np) - call mld_check_def(parms%ml_type,'Multilevel type',& - & mld_mult_ml_,is_legal_ml_type) - call mld_check_def(parms%aggr_alg,'Aggregation',& - & mld_dec_aggr_,is_legal_ml_aggr_alg) + call mld_check_def(parms%ml_cycle,'Multilevel cycle',& + & mld_mult_ml_,is_legal_ml_cycle) + call mld_check_def(parms%par_aggr_alg,'Aggregation',& + & mld_dec_aggr_,is_legal_ml_par_aggr_alg) call mld_check_def(parms%aggr_ord,'Ordering',& & mld_aggr_ord_nat_,is_legal_ml_aggr_ord) call mld_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs) @@ -131,6 +132,11 @@ subroutine mld_z_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr, if (info == psb_success_) call atmp%free() if (info == psb_success_) call mld_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='dec_map_bld/map_to_tprol') + goto 9999 + endif call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/mld_c_hierarchy_bld.f90 b/mlprec/impl/mld_c_hierarchy_bld.f90 index a3bd0b10..38684e6a 100644 --- a/mlprec/impl/mld_c_hierarchy_bld.f90 +++ b/mlprec/impl/mld_c_hierarchy_bld.f90 @@ -84,6 +84,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info) real(psb_spk_) :: mnaggratio, sizeratio, athresh, aomega class(mld_c_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, & & base_sm2, med_sm2, coarse_sm2 + class(mld_c_base_aggregator_type), allocatable :: tmp_aggr type(mld_sml_parms) :: baseparms, medparms, coarseparms integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) type(psb_cspmat_type) :: op_prol @@ -216,19 +217,26 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info) allocate(tprecv(nplevs),stat=info) ! First all existing levels if (info == 0) tprecv(1)%parms = baseparms - if (info == 0) call restore_smoothers(tprecv(1),prec%precv(1)%sm,prec%precv(1)%sm2a,info) + if (info == 0) call restore_smoothers(tprecv(1),& + & prec%precv(1)%sm,prec%precv(1)%sm2a,info) + if (info == 0) call move_alloc(prec%precv(1)%aggr,tprecv(1)%aggr) do i=2, min(iszv,nplevs) - 1 if (info == 0) tprecv(i)%parms = medparms - if (info == 0) call restore_smoothers(tprecv(i),prec%precv(i)%sm,prec%precv(i)%sm2a,info) + if (info == 0) call restore_smoothers(tprecv(i),& + & prec%precv(i)%sm,prec%precv(i)%sm2a,info) + if (info == 0) call move_alloc(prec%precv(i)%aggr,tprecv(i)%aggr) end do ! Further intermediates, if any do i=iszv-1, nplevs - 1 if (info == 0) tprecv(i)%parms = medparms if (info == 0) call restore_smoothers(tprecv(i),med_sm,med_sm2,info) + if ((info == 0).and..not.allocated(tprecv(i)%aggr))& + & allocate(tprecv(i)%aggr,source=tprecv(1)%aggr,stat=info) end do ! Then coarse if (info == 0) tprecv(nplevs)%parms = coarseparms if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info) + if (info == 0) allocate(tprecv(nplevs)%aggr,source=tprecv(i)%aggr,stat=info) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,& & a_err='prec reallocation') @@ -272,9 +280,10 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info) ! ! Build the mapping between levels i-1 and i and the matrix ! at level i - ! - if (info == psb_success_) call mld_aggrmap_bld(prec%precv(i),& - & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,& + ! + if (info == psb_success_)& + & call prec%precv(i)%bld_tprol(prec%precv(i-1)%base_a,& + & prec%precv(i-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) if (info /= psb_success_) then @@ -282,6 +291,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info) & a_err='Map build') goto 9999 endif + if (i= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& @@ -346,7 +356,8 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info) prec%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_omega_val = aomega - if (info == 0) call restore_smoothers(prec%precv(newsz),coarse_sm,coarse_sm2,info) + if (info == 0) call restore_smoothers(prec%precv(newsz),& + & coarse_sm,coarse_sm2,info) if (newsz < i) then ! ! We are going back and revisit a previous leve; @@ -357,7 +368,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info) call prec%precv(newsz)%tprol%clone(op_prol,info) end if - if (info == psb_success_) call mld_lev_mat_asb(prec%precv(newsz),& + if (info == psb_success_) call prec%precv(newsz)%mat_asb( & & prec%precv(newsz-1)%base_a,prec%precv(newsz-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) if (info /= 0) then @@ -367,7 +378,7 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info) endif exit array_build_loop else - if (info == psb_success_) call mld_lev_mat_asb(prec%precv(i),& + if (info == psb_success_) call prec%precv(i)%mat_asb(& & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) end if diff --git a/mlprec/impl/mld_c_lev_aggrmat_asb.f90 b/mlprec/impl/mld_c_lev_aggrmat_asb.f90 deleted file mode 100644 index 5aa1730e..00000000 --- a/mlprec/impl/mld_c_lev_aggrmat_asb.f90 +++ /dev/null @@ -1,267 +0,0 @@ -! -! -! MLD2P4 version 2.1 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -! File: mld_c_lev_aggrmat_asb.f90 -! -! Subroutine: mld_c_lev_aggrmat_asb -! Version: complex -! -! This routine builds the matrix associated to the current level of the -! multilevel preconditioner from the matrix associated to the previous level, -! by using the user-specified aggregation technique (therefore, it also builds the -! prolongation and restriction operators mapping the current level to the -! previous one and vice versa). -! The current level is regarded as the coarse one, while the previous as -! the fine one. This is in agreement with the fact that the routine is called, -! by mld_mlprec_bld, only on levels >=2. -! The main structure is: -! 1. Perform sanity checks; -! 2. Call mld_Xaggrmat_asb to compute prolongator/restrictor/AC -! 3. According to the choice of DIST/REPL for AC, build a descriptor DESC_AC, -! and adjust the column numbering of AC/OP_PROL/OP_RESTR -! 4. Pack restrictor and prolongator into p%map -! 5. Fix base_a and base_desc pointers. -! -! -! Arguments: -! p - type(mld_c_onelev_type), input/output. -! The 'one-level' data structure containing the control -! parameters and (eventually) coarse matrix and prolongator/restrictors. -! -! a - type(psb_cspmat_type). -! The sparse matrix structure containing the local part of the -! fine-level matrix. -! desc_a - type(psb_desc_type), input. -! The communication descriptor of a. -! ilaggr - integer, dimension(:), input -! The mapping between the row indices of the coarse-level -! matrix and the row indices of the fine-level matrix. -! ilaggr(i)=j means that node i in the adjacency graph -! of the fine-level matrix is mapped onto node j in the -! adjacency graph of the coarse-level matrix. Note that the indices -! are assumed to be shifted so as to make sure the ranges on -! the various processes do not overlap. -! nlaggr - integer, dimension(:) input -! nlaggr(i) contains the aggregates held by process i. -! op_prol - type(psb_cspmat_type), input/output -! The tentative prolongator on input, released on output. -! -! info - integer, output. -! Error code. -! -subroutine mld_c_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info) - - use psb_base_mod - use mld_base_prec_type - use mld_c_inner_mod, mld_protect_name => mld_c_lev_aggrmat_asb - - implicit none - - ! Arguments - type(mld_c_onelev_type), intent(inout), target :: p - type(psb_cspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(inout) :: ilaggr(:),nlaggr(:) - type(psb_cspmat_type), intent(inout) :: op_prol - integer(psb_ipk_), intent(out) :: info - - - ! Local variables - character(len=24) :: name - integer(psb_mpik_) :: ictxt, np, me - integer(psb_ipk_) :: err_act - type(psb_cspmat_type) :: ac, op_restr - type(psb_c_coo_sparse_mat) :: acoo, bcoo - type(psb_c_csr_sparse_mat) :: acsr1 - integer(psb_ipk_) :: nzl, ntaggr - integer(psb_ipk_) :: debug_level, debug_unit - - name='mld_c_lev_aggrmat_asb' - if (psb_get_errstatus().ne.0) return - call psb_erractionsave(err_act) - debug_unit = psb_get_debug_unit() - debug_level = psb_get_debug_level() - info = psb_success_ - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) - - call mld_check_def(p%parms%aggr_prol,'Smoother',& - & mld_smooth_prol_,is_legal_ml_aggr_prol) - call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& - & mld_distr_mat_,is_legal_ml_coarse_mat) - call mld_check_def(p%parms%aggr_filter,'Use filtered matrix',& - & mld_no_filter_mat_,is_legal_aggr_filter) - call mld_check_def(p%parms%aggr_omega_alg,'Omega Alg.',& - & mld_eig_est_,is_legal_ml_aggr_omega_alg) - call mld_check_def(p%parms%aggr_eig,'Eigenvalue estimate',& - & mld_max_norm_,is_legal_ml_aggr_eig) - call mld_check_def(p%parms%aggr_omega_val,'Omega',szero,is_legal_s_omega) - - - ! - ! 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_prol_) - ! - call mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,p%parms,ac,op_prol,op_restr,info) - - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb') - goto 9999 - end if - - - ! Common code refactored here. - - ntaggr = sum(nlaggr) - - select case(p%parms%coarse_mat) - - case(mld_distr_mat_) - - call ac%mv_to(bcoo) - nzl = bcoo%get_nzeros() - - if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1)) - if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info) - if (info == psb_success_) call psb_cdasb(p%desc_ac,info) - if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I') - if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%desc_ac,info,iact='I') - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Creating p%desc_ac and converting ac') - goto 9999 - end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Assembld aux descr. distr.' - call p%ac%mv_from(bcoo) - - call p%ac%set_nrows(p%desc_ac%get_local_rows()) - call p%ac%set_ncols(p%desc_ac%get_local_cols()) - call p%ac%set_asb() - - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free') - goto 9999 - end if - - if (np>1) then - call op_prol%mv_to(acsr1) - nzl = acsr1%get_nzeros() - call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I') - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc') - goto 9999 - end if - call op_prol%mv_from(acsr1) - endif - call op_prol%set_ncols(p%desc_ac%get_local_cols()) - - if (np>1) then - call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_) - call op_restr%mv_to(acoo) - nzl = acoo%get_nzeros() - if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I') - call acoo%set_dupl(psb_dupl_add_) - if (info == psb_success_) call op_restr%mv_from(acoo) - if (info == psb_success_) call op_restr%cscnv(info,type='csr') - if(info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Converting op_restr to local') - goto 9999 - end if - end if - ! - ! Clip to local rows. - ! - call op_restr%set_nrows(p%desc_ac%get_local_rows()) - - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Done ac ' - - case(mld_repl_mat_) - ! - ! - call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) - if (info == psb_success_) call psb_cdasb(p%desc_ac,info) - if (info == psb_success_) & - & call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) - - if (info /= psb_success_) goto 9999 - - case default - info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') - goto 9999 - end select - - call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv') - goto 9999 - end if - - ! - ! Copy the prolongation/restriction matrices into the descriptor map. - ! op_restr => PR^T i.e. restriction operator - ! op_prol => PR i.e. prolongation operator - ! - - p%map = psb_linmap(psb_map_aggr_,desc_a,& - & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr) - if (info == psb_success_) call op_prol%free() - if (info == psb_success_) call op_restr%free() - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') - goto 9999 - end if - ! - ! Fix the base_a and base_desc pointers for handling of residuals. - ! This is correct because this routine is only called at levels >=2. - ! - p%base_a => p%ac - p%base_desc => p%desc_ac - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_c_lev_aggrmat_asb diff --git a/mlprec/impl/mld_caggrmap_bld.f90 b/mlprec/impl/mld_caggrmap_bld.f90 deleted file mode 100644 index 0ef77481..00000000 --- a/mlprec/impl/mld_caggrmap_bld.f90 +++ /dev/null @@ -1,189 +0,0 @@ -! -! -! MLD2P4 version 2.1 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -! File: mld_caggrmap_bld.f90 -! -! Subroutine: mld_caggrmap_bld -! Version: complex -! -! This routine builds a mapping from the row indices of the fine-level matrix -! to the row indices of the coarse-level matrix, according to a decoupled -! aggregation algorithm. This mapping will be used by mld_aggrmat_asb to -! build the coarse-level matrix. -! -! The aggregation algorithm is a parallel version of that described in -! * M. Brezina and P. Vanek, A black-box iterative solver based on a -! two-level Schwarz method, Computing, 63 (1999), 233-263. -! * P. Vanek, J. Mandel and M. Brezina, Algebraic Multigrid by Smoothed -! Aggregation for Second and Fourth Order Elliptic Problems, Computing, 56 -! (1996), 179-196. -! For more details see -! P. D'Ambra, D. di Serafino and S. Filippone, On the development of -! PSBLAS-based parallel two-level Schwarz preconditioners, Appl. Num. Math. -! 57 (2007), 1181-1196. -! -! -! Arguments: -! aggr_type - integer, input. -! The scalar used to identify the aggregation algorithm. -! theta - real, input. -! The aggregation threshold used in the aggregation algorithm. -! a - type(psb_cspmat_type), input. -! The sparse matrix structure containing the local part of -! the fine-level matrix. -! desc_a - type(psb_desc_type), input. -! The communication descriptor of the fine-level matrix. -! ilaggr - integer, dimension(:), allocatable. -! The mapping between the row indices of the coarse-level -! matrix and the row indices of the fine-level matrix. -! ilaggr(i)=j means that node i in the adjacency graph -! of the fine-level matrix is mapped onto node j in the -! adjacency graph of the coarse-level matrix. Note that on exit the indices -! will be shifted so as to make sure the ranges on the various processes do not -! overlap. -! nlaggr - integer, dimension(:), allocatable. -! nlaggr(i) contains the aggregates held by process i. -! op_prol - type(psb_cspmat_type). -! The tentative prolongator, based on ilaggr. -! -! info - integer, output. -! Error code. -! -subroutine mld_caggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info) - - use psb_base_mod - use mld_base_prec_type - use mld_c_inner_mod, mld_protect_name => mld_caggrmap_bld - - implicit none - - ! Arguments - integer(psb_ipk_), intent(in) :: iorder - integer(psb_ipk_), intent(in) :: aggr_type - real(psb_spk_), intent(in) :: theta - type(psb_cspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) - type(psb_cspmat_type), intent(out) :: op_prol - integer(psb_ipk_), intent(out) :: info - - ! Local variables - integer(psb_ipk_), allocatable :: ils(:), neigh(:) - integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m,naggrm1, naggrp1, ntaggr - type(psb_cspmat_type) :: atmp, atrans - type(psb_c_coo_sparse_mat) :: tmpcoo - integer(psb_ipk_) :: debug_level, debug_unit,err_act - integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: nrow, ncol, n_ne - character(len=20) :: name, ch_err - - if(psb_get_errstatus() /= 0) return - info=psb_success_ - name = 'mld_aggrmap_bld' - call psb_erractionsave(err_act) - debug_unit = psb_get_debug_unit() - debug_level = psb_get_debug_level() - ! - ictxt=desc_a%get_context() - call psb_info(ictxt,me,np) - nrow = desc_a%get_local_rows() - ncol = desc_a%get_local_cols() - - select case (aggr_type) - case (mld_dec_aggr_) - call mld_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info) - - case (mld_sym_dec_aggr_) - nr = a%get_nrows() - call a%csclip(atmp,info,imax=nr,jmax=nr,& - & rscale=.false.,cscale=.false.) - call atmp%set_nrows(nr) - call atmp%set_ncols(nr) - if (info == psb_success_) call atmp%transp(atrans) - if (info == psb_success_) call atrans%cscnv(info,type='COO') - if (info == psb_success_) call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.) - call atmp%set_nrows(nr) - call atmp%set_ncols(nr) - if (info == psb_success_) call atrans%free() - if (info == psb_success_) call atmp%cscnv(info,type='CSR') - if (info == psb_success_) call mld_dec_map_bld(iorder,theta,atmp,desc_a,nlaggr,ilaggr,info) - if (info == psb_success_) call atmp%free() - - case default - - info = -1 - call psb_errpush(psb_err_input_value_invalid_i_,name,& - & i_err=(/ione,aggr_type,izero,izero,izero/)) - goto 9999 - end select - - if (info /= psb_success_) then - info=psb_err_internal_error_ - call psb_errpush(info,name,a_err='dec_map_bld') - goto 9999 - end if - - naggr = nlaggr(me+1) - ntaggr = sum(nlaggr) - naggrm1 = sum(nlaggr(1:me)) - naggrp1 = sum(nlaggr(1:me+1)) - ilaggr(1:nrow) = ilaggr(1:nrow) + naggrm1 - call psb_halo(ilaggr,desc_a,info) - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_halo') - goto 9999 - end if - - call tmpcoo%allocate(ncol,ntaggr,ncol) - do i=1,ncol - tmpcoo%val(i) = cone - tmpcoo%ia(i) = i - tmpcoo%ja(i) = ilaggr(i) - end do - call tmpcoo%set_nzeros(ncol) - call tmpcoo%set_dupl(psb_dupl_add_) - call tmpcoo%set_sorted() ! At this point this is in row-major - call op_prol%mv_from(tmpcoo) - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine mld_caggrmap_bld diff --git a/mlprec/impl/mld_caggrmat_asb.f90 b/mlprec/impl/mld_caggrmat_asb.f90 deleted file mode 100644 index 4804626b..00000000 --- a/mlprec/impl/mld_caggrmat_asb.f90 +++ /dev/null @@ -1,193 +0,0 @@ -! -! -! MLD2P4 version 2.1 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -! File: mld_caggrmat_asb.f90 -! -! Subroutine: mld_caggrmat_asb -! Version: complex -! -! This routine builds a coarse-level matrix A_C from a fine-level matrix A -! by using the Galerkin approach, i.e. -! -! A_C = P_C^T A P_C, -! -! where P_C is a prolongator from the coarse level to the fine one. -! -! A mapping from the nodes of the adjacency graph of A to the nodes of the -! adjacency graph of A_C has been computed by the mld_aggrmap_bld subroutine. -! The prolongator P_C is built here from this mapping, according to the -! value of p%iprcparm(mld_aggr_prol_), specified by the user through -! mld_cprecinit and mld_zprecset. -! On output from this routine the entries of AC, op_prol, op_restr -! are still in "global numbering" mode; this is fixed in the calling routine -! mld_c_lev_aggrmat_asb. -! -! Currently four different prolongators are implemented, corresponding to -! four aggregation algorithms: -! 1. un-smoothed aggregation, -! 2. smoothed aggregation, -! 3. "bizarre" aggregation. -! 4. minimum energy -! 1. The non-smoothed aggregation uses as prolongator the piecewise constant -! interpolation operator corresponding to the fine-to-coarse level mapping built -! by mld_aggrmap_bld. This is called tentative prolongator. -! 2. The smoothed aggregation uses as prolongator the operator obtained by applying -! a damped Jacobi smoother to the tentative prolongator. -! 3. The "bizarre" aggregation uses a prolongator proposed by the authors of MLD2P4. -! This prolongator still requires a deep analysis and testing and its use is -! not recommended. -! 4. Minimum energy aggregation: ADD REFERENCE. -! -! For more details see -! M. Brezina and P. Vanek, A black-box iterative solver based on a two-level -! Schwarz method, Computing, 63 (1999), 233-263. -! P. D'Ambra, D. di Serafino and S. Filippone, On the development of PSBLAS-based -! parallel two-level Schwarz preconditioners, Appl. Num. Math., 57 (2007), -! 1181-1196. -! -! -! -! Arguments: -! a - type(psb_cspmat_type), input. -! The sparse matrix structure containing the local part of -! the fine-level matrix. -! desc_a - type(psb_desc_type), input. -! The communication descriptor of the fine-level matrix. -! p - type(mld_c_onelev_type), input/output. -! The 'one-level' data structure that will contain the local -! part of the matrix to be built as well as the information -! concerning the prolongator and its transpose. -! parms - type(mld_sml_parms), input -! Parameters controlling the choice of algorithm -! ac - type(psb_cspmat_type), output -! The coarse matrix on output -! -! ilaggr - integer, dimension(:), input -! The mapping between the row indices of the coarse-level -! matrix and the row indices of the fine-level matrix. -! ilaggr(i)=j means that node i in the adjacency graph -! of the fine-level matrix is mapped onto node j in the -! adjacency graph of the coarse-level matrix. Note that the indices -! are assumed to be shifted so as to make sure the ranges on -! the various processes do not overlap. -! nlaggr - integer, dimension(:) input -! nlaggr(i) contains the aggregates held by process i. -! op_prol - type(psb_cspmat_type), input/output -! The tentative prolongator on input, the computed prolongator on output -! -! op_restr - type(psb_cspmat_type), output -! The restrictor operator; normally, it is the transpose of the prolongator. -! -! info - integer, output. -! Error code. -! -subroutine mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) - - use psb_base_mod - use mld_base_prec_type - use mld_c_inner_mod, mld_protect_name => mld_caggrmat_asb - - implicit none - -! Arguments - type(psb_cspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(mld_sml_parms), intent(inout) :: parms - type(psb_cspmat_type), intent(inout) :: ac, op_prol,op_restr - integer(psb_ipk_), intent(out) :: info - -! Local variables - type(psb_c_coo_sparse_mat) :: acoo, bcoo - type(psb_c_csr_sparse_mat) :: acsr1 - integer(psb_ipk_) :: nzl,ntaggr, err_act - integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: ictxt,np,me - character(len=20) :: name - - name='mld_aggrmat_asb' - if(psb_get_errstatus().ne.0) return - info=psb_success_ - call psb_erractionsave(err_act) - debug_unit = psb_get_debug_unit() - debug_level = psb_get_debug_level() - - - ictxt = desc_a%get_context() - - call psb_info(ictxt, me, np) - - select case (parms%aggr_prol) - case (mld_no_smooth_) - - call mld_caggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,& - & parms,ac,op_prol,op_restr,info) - - case(mld_smooth_prol_) - - call mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr, & - & parms,ac,op_prol,op_restr,info) - - case(mld_biz_prol_) - - call mld_caggrmat_biz_asb(a,desc_a,ilaggr,nlaggr, & - & parms,ac,op_prol,op_restr,info) - - case(mld_min_energy_) - - call mld_caggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr, & - & parms,ac,op_prol,op_restr,info) - - case default - info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='Invalid aggr kind') - goto 9999 - - end select - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner aggrmat asb') - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine mld_caggrmat_asb diff --git a/mlprec/impl/mld_d_hierarchy_bld.f90 b/mlprec/impl/mld_d_hierarchy_bld.f90 index 6b68fa58..c7b882e3 100644 --- a/mlprec/impl/mld_d_hierarchy_bld.f90 +++ b/mlprec/impl/mld_d_hierarchy_bld.f90 @@ -84,6 +84,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info) real(psb_dpk_) :: mnaggratio, sizeratio, athresh, aomega class(mld_d_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, & & base_sm2, med_sm2, coarse_sm2 + class(mld_d_base_aggregator_type), allocatable :: tmp_aggr type(mld_dml_parms) :: baseparms, medparms, coarseparms integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) type(psb_dspmat_type) :: op_prol @@ -216,19 +217,26 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info) allocate(tprecv(nplevs),stat=info) ! First all existing levels if (info == 0) tprecv(1)%parms = baseparms - if (info == 0) call restore_smoothers(tprecv(1),prec%precv(1)%sm,prec%precv(1)%sm2a,info) + if (info == 0) call restore_smoothers(tprecv(1),& + & prec%precv(1)%sm,prec%precv(1)%sm2a,info) + if (info == 0) call move_alloc(prec%precv(1)%aggr,tprecv(1)%aggr) do i=2, min(iszv,nplevs) - 1 if (info == 0) tprecv(i)%parms = medparms - if (info == 0) call restore_smoothers(tprecv(i),prec%precv(i)%sm,prec%precv(i)%sm2a,info) + if (info == 0) call restore_smoothers(tprecv(i),& + & prec%precv(i)%sm,prec%precv(i)%sm2a,info) + if (info == 0) call move_alloc(prec%precv(i)%aggr,tprecv(i)%aggr) end do ! Further intermediates, if any do i=iszv-1, nplevs - 1 if (info == 0) tprecv(i)%parms = medparms if (info == 0) call restore_smoothers(tprecv(i),med_sm,med_sm2,info) + if ((info == 0).and..not.allocated(tprecv(i)%aggr))& + & allocate(tprecv(i)%aggr,source=tprecv(1)%aggr,stat=info) end do ! Then coarse if (info == 0) tprecv(nplevs)%parms = coarseparms if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info) + if (info == 0) allocate(tprecv(nplevs)%aggr,source=tprecv(i)%aggr,stat=info) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,& & a_err='prec reallocation') @@ -272,9 +280,10 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info) ! ! Build the mapping between levels i-1 and i and the matrix ! at level i - ! - if (info == psb_success_) call mld_aggrmap_bld(prec%precv(i),& - & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,& + ! + if (info == psb_success_)& + & call prec%precv(i)%bld_tprol(prec%precv(i-1)%base_a,& + & prec%precv(i-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) if (info /= psb_success_) then @@ -282,6 +291,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info) & a_err='Map build') goto 9999 endif + if (i= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& @@ -346,7 +356,8 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info) prec%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_omega_val = aomega - if (info == 0) call restore_smoothers(prec%precv(newsz),coarse_sm,coarse_sm2,info) + if (info == 0) call restore_smoothers(prec%precv(newsz),& + & coarse_sm,coarse_sm2,info) if (newsz < i) then ! ! We are going back and revisit a previous leve; @@ -357,7 +368,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info) call prec%precv(newsz)%tprol%clone(op_prol,info) end if - if (info == psb_success_) call mld_lev_mat_asb(prec%precv(newsz),& + if (info == psb_success_) call prec%precv(newsz)%mat_asb( & & prec%precv(newsz-1)%base_a,prec%precv(newsz-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) if (info /= 0) then @@ -367,7 +378,7 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info) endif exit array_build_loop else - if (info == psb_success_) call mld_lev_mat_asb(prec%precv(i),& + if (info == psb_success_) call prec%precv(i)%mat_asb(& & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) end if diff --git a/mlprec/impl/mld_d_lev_aggrmat_asb.f90 b/mlprec/impl/mld_d_lev_aggrmat_asb.f90 deleted file mode 100644 index 98c579a6..00000000 --- a/mlprec/impl/mld_d_lev_aggrmat_asb.f90 +++ /dev/null @@ -1,267 +0,0 @@ -! -! -! MLD2P4 version 2.1 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -! File: mld_d_lev_aggrmat_asb.f90 -! -! Subroutine: mld_d_lev_aggrmat_asb -! Version: real -! -! This routine builds the matrix associated to the current level of the -! multilevel preconditioner from the matrix associated to the previous level, -! by using the user-specified aggregation technique (therefore, it also builds the -! prolongation and restriction operators mapping the current level to the -! previous one and vice versa). -! The current level is regarded as the coarse one, while the previous as -! the fine one. This is in agreement with the fact that the routine is called, -! by mld_mlprec_bld, only on levels >=2. -! The main structure is: -! 1. Perform sanity checks; -! 2. Call mld_Xaggrmat_asb to compute prolongator/restrictor/AC -! 3. According to the choice of DIST/REPL for AC, build a descriptor DESC_AC, -! and adjust the column numbering of AC/OP_PROL/OP_RESTR -! 4. Pack restrictor and prolongator into p%map -! 5. Fix base_a and base_desc pointers. -! -! -! Arguments: -! p - type(mld_d_onelev_type), input/output. -! The 'one-level' data structure containing the control -! parameters and (eventually) coarse matrix and prolongator/restrictors. -! -! a - type(psb_dspmat_type). -! The sparse matrix structure containing the local part of the -! fine-level matrix. -! desc_a - type(psb_desc_type), input. -! The communication descriptor of a. -! ilaggr - integer, dimension(:), input -! The mapping between the row indices of the coarse-level -! matrix and the row indices of the fine-level matrix. -! ilaggr(i)=j means that node i in the adjacency graph -! of the fine-level matrix is mapped onto node j in the -! adjacency graph of the coarse-level matrix. Note that the indices -! are assumed to be shifted so as to make sure the ranges on -! the various processes do not overlap. -! nlaggr - integer, dimension(:) input -! nlaggr(i) contains the aggregates held by process i. -! op_prol - type(psb_dspmat_type), input/output -! The tentative prolongator on input, released on output. -! -! info - integer, output. -! Error code. -! -subroutine mld_d_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info) - - use psb_base_mod - use mld_base_prec_type - use mld_d_inner_mod, mld_protect_name => mld_d_lev_aggrmat_asb - - implicit none - - ! Arguments - type(mld_d_onelev_type), intent(inout), target :: p - type(psb_dspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(inout) :: ilaggr(:),nlaggr(:) - type(psb_dspmat_type), intent(inout) :: op_prol - integer(psb_ipk_), intent(out) :: info - - - ! Local variables - character(len=24) :: name - integer(psb_mpik_) :: ictxt, np, me - integer(psb_ipk_) :: err_act - type(psb_dspmat_type) :: ac, op_restr - type(psb_d_coo_sparse_mat) :: acoo, bcoo - type(psb_d_csr_sparse_mat) :: acsr1 - integer(psb_ipk_) :: nzl, ntaggr - integer(psb_ipk_) :: debug_level, debug_unit - - name='mld_d_lev_aggrmat_asb' - if (psb_get_errstatus().ne.0) return - call psb_erractionsave(err_act) - debug_unit = psb_get_debug_unit() - debug_level = psb_get_debug_level() - info = psb_success_ - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) - - call mld_check_def(p%parms%aggr_prol,'Smoother',& - & mld_smooth_prol_,is_legal_ml_aggr_prol) - call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& - & mld_distr_mat_,is_legal_ml_coarse_mat) - call mld_check_def(p%parms%aggr_filter,'Use filtered matrix',& - & mld_no_filter_mat_,is_legal_aggr_filter) - call mld_check_def(p%parms%aggr_omega_alg,'Omega Alg.',& - & mld_eig_est_,is_legal_ml_aggr_omega_alg) - call mld_check_def(p%parms%aggr_eig,'Eigenvalue estimate',& - & mld_max_norm_,is_legal_ml_aggr_eig) - call mld_check_def(p%parms%aggr_omega_val,'Omega',dzero,is_legal_d_omega) - - - ! - ! 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_prol_) - ! - call mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,p%parms,ac,op_prol,op_restr,info) - - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb') - goto 9999 - end if - - - ! Common code refactored here. - - ntaggr = sum(nlaggr) - - select case(p%parms%coarse_mat) - - case(mld_distr_mat_) - - call ac%mv_to(bcoo) - nzl = bcoo%get_nzeros() - - if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1)) - if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info) - if (info == psb_success_) call psb_cdasb(p%desc_ac,info) - if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I') - if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%desc_ac,info,iact='I') - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Creating p%desc_ac and converting ac') - goto 9999 - end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Assembld aux descr. distr.' - call p%ac%mv_from(bcoo) - - call p%ac%set_nrows(p%desc_ac%get_local_rows()) - call p%ac%set_ncols(p%desc_ac%get_local_cols()) - call p%ac%set_asb() - - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free') - goto 9999 - end if - - if (np>1) then - call op_prol%mv_to(acsr1) - nzl = acsr1%get_nzeros() - call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I') - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc') - goto 9999 - end if - call op_prol%mv_from(acsr1) - endif - call op_prol%set_ncols(p%desc_ac%get_local_cols()) - - if (np>1) then - call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_) - call op_restr%mv_to(acoo) - nzl = acoo%get_nzeros() - if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I') - call acoo%set_dupl(psb_dupl_add_) - if (info == psb_success_) call op_restr%mv_from(acoo) - if (info == psb_success_) call op_restr%cscnv(info,type='csr') - if(info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Converting op_restr to local') - goto 9999 - end if - end if - ! - ! Clip to local rows. - ! - call op_restr%set_nrows(p%desc_ac%get_local_rows()) - - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Done ac ' - - case(mld_repl_mat_) - ! - ! - call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) - if (info == psb_success_) call psb_cdasb(p%desc_ac,info) - if (info == psb_success_) & - & call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) - - if (info /= psb_success_) goto 9999 - - case default - info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') - goto 9999 - end select - - call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv') - goto 9999 - end if - - ! - ! Copy the prolongation/restriction matrices into the descriptor map. - ! op_restr => PR^T i.e. restriction operator - ! op_prol => PR i.e. prolongation operator - ! - - p%map = psb_linmap(psb_map_aggr_,desc_a,& - & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr) - if (info == psb_success_) call op_prol%free() - if (info == psb_success_) call op_restr%free() - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') - goto 9999 - end if - ! - ! Fix the base_a and base_desc pointers for handling of residuals. - ! This is correct because this routine is only called at levels >=2. - ! - p%base_a => p%ac - p%base_desc => p%desc_ac - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_d_lev_aggrmat_asb diff --git a/mlprec/impl/mld_daggrmap_bld.f90 b/mlprec/impl/mld_daggrmap_bld.f90 deleted file mode 100644 index e186d719..00000000 --- a/mlprec/impl/mld_daggrmap_bld.f90 +++ /dev/null @@ -1,189 +0,0 @@ -! -! -! MLD2P4 version 2.1 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -! File: mld_daggrmap_bld.f90 -! -! Subroutine: mld_daggrmap_bld -! Version: real -! -! This routine builds a mapping from the row indices of the fine-level matrix -! to the row indices of the coarse-level matrix, according to a decoupled -! aggregation algorithm. This mapping will be used by mld_aggrmat_asb to -! build the coarse-level matrix. -! -! The aggregation algorithm is a parallel version of that described in -! * M. Brezina and P. Vanek, A black-box iterative solver based on a -! two-level Schwarz method, Computing, 63 (1999), 233-263. -! * P. Vanek, J. Mandel and M. Brezina, Algebraic Multigrid by Smoothed -! Aggregation for Second and Fourth Order Elliptic Problems, Computing, 56 -! (1996), 179-196. -! For more details see -! P. D'Ambra, D. di Serafino and S. Filippone, On the development of -! PSBLAS-based parallel two-level Schwarz preconditioners, Appl. Num. Math. -! 57 (2007), 1181-1196. -! -! -! Arguments: -! aggr_type - integer, input. -! The scalar used to identify the aggregation algorithm. -! theta - real, input. -! The aggregation threshold used in the aggregation algorithm. -! a - type(psb_dspmat_type), input. -! The sparse matrix structure containing the local part of -! the fine-level matrix. -! desc_a - type(psb_desc_type), input. -! The communication descriptor of the fine-level matrix. -! ilaggr - integer, dimension(:), allocatable. -! The mapping between the row indices of the coarse-level -! matrix and the row indices of the fine-level matrix. -! ilaggr(i)=j means that node i in the adjacency graph -! of the fine-level matrix is mapped onto node j in the -! adjacency graph of the coarse-level matrix. Note that on exit the indices -! will be shifted so as to make sure the ranges on the various processes do not -! overlap. -! nlaggr - integer, dimension(:), allocatable. -! nlaggr(i) contains the aggregates held by process i. -! op_prol - type(psb_dspmat_type). -! The tentative prolongator, based on ilaggr. -! -! info - integer, output. -! Error code. -! -subroutine mld_daggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info) - - use psb_base_mod - use mld_base_prec_type - use mld_d_inner_mod, mld_protect_name => mld_daggrmap_bld - - implicit none - - ! Arguments - integer(psb_ipk_), intent(in) :: iorder - integer(psb_ipk_), intent(in) :: aggr_type - real(psb_dpk_), intent(in) :: theta - type(psb_dspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) - type(psb_dspmat_type), intent(out) :: op_prol - integer(psb_ipk_), intent(out) :: info - - ! Local variables - integer(psb_ipk_), allocatable :: ils(:), neigh(:) - integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m,naggrm1, naggrp1, ntaggr - type(psb_dspmat_type) :: atmp, atrans - type(psb_d_coo_sparse_mat) :: tmpcoo - integer(psb_ipk_) :: debug_level, debug_unit,err_act - integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: nrow, ncol, n_ne - character(len=20) :: name, ch_err - - if(psb_get_errstatus() /= 0) return - info=psb_success_ - name = 'mld_aggrmap_bld' - call psb_erractionsave(err_act) - debug_unit = psb_get_debug_unit() - debug_level = psb_get_debug_level() - ! - ictxt=desc_a%get_context() - call psb_info(ictxt,me,np) - nrow = desc_a%get_local_rows() - ncol = desc_a%get_local_cols() - - select case (aggr_type) - case (mld_dec_aggr_) - call mld_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info) - - case (mld_sym_dec_aggr_) - nr = a%get_nrows() - call a%csclip(atmp,info,imax=nr,jmax=nr,& - & rscale=.false.,cscale=.false.) - call atmp%set_nrows(nr) - call atmp%set_ncols(nr) - if (info == psb_success_) call atmp%transp(atrans) - if (info == psb_success_) call atrans%cscnv(info,type='COO') - if (info == psb_success_) call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.) - call atmp%set_nrows(nr) - call atmp%set_ncols(nr) - if (info == psb_success_) call atrans%free() - if (info == psb_success_) call atmp%cscnv(info,type='CSR') - if (info == psb_success_) call mld_dec_map_bld(iorder,theta,atmp,desc_a,nlaggr,ilaggr,info) - if (info == psb_success_) call atmp%free() - - case default - - info = -1 - call psb_errpush(psb_err_input_value_invalid_i_,name,& - & i_err=(/ione,aggr_type,izero,izero,izero/)) - goto 9999 - end select - - if (info /= psb_success_) then - info=psb_err_internal_error_ - call psb_errpush(info,name,a_err='dec_map_bld') - goto 9999 - end if - - naggr = nlaggr(me+1) - ntaggr = sum(nlaggr) - naggrm1 = sum(nlaggr(1:me)) - naggrp1 = sum(nlaggr(1:me+1)) - ilaggr(1:nrow) = ilaggr(1:nrow) + naggrm1 - call psb_halo(ilaggr,desc_a,info) - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_halo') - goto 9999 - end if - - call tmpcoo%allocate(ncol,ntaggr,ncol) - do i=1,ncol - tmpcoo%val(i) = done - tmpcoo%ia(i) = i - tmpcoo%ja(i) = ilaggr(i) - end do - call tmpcoo%set_nzeros(ncol) - call tmpcoo%set_dupl(psb_dupl_add_) - call tmpcoo%set_sorted() ! At this point this is in row-major - call op_prol%mv_from(tmpcoo) - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine mld_daggrmap_bld diff --git a/mlprec/impl/mld_daggrmat_asb.f90 b/mlprec/impl/mld_daggrmat_asb.f90 deleted file mode 100644 index 55f8a5b7..00000000 --- a/mlprec/impl/mld_daggrmat_asb.f90 +++ /dev/null @@ -1,193 +0,0 @@ -! -! -! MLD2P4 version 2.1 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -! File: mld_daggrmat_asb.f90 -! -! Subroutine: mld_daggrmat_asb -! Version: real -! -! This routine builds a coarse-level matrix A_C from a fine-level matrix A -! by using the Galerkin approach, i.e. -! -! A_C = P_C^T A P_C, -! -! where P_C is a prolongator from the coarse level to the fine one. -! -! A mapping from the nodes of the adjacency graph of A to the nodes of the -! adjacency graph of A_C has been computed by the mld_aggrmap_bld subroutine. -! The prolongator P_C is built here from this mapping, according to the -! value of p%iprcparm(mld_aggr_prol_), specified by the user through -! mld_dprecinit and mld_zprecset. -! On output from this routine the entries of AC, op_prol, op_restr -! are still in "global numbering" mode; this is fixed in the calling routine -! mld_d_lev_aggrmat_asb. -! -! Currently four different prolongators are implemented, corresponding to -! four aggregation algorithms: -! 1. un-smoothed aggregation, -! 2. smoothed aggregation, -! 3. "bizarre" aggregation. -! 4. minimum energy -! 1. The non-smoothed aggregation uses as prolongator the piecewise constant -! interpolation operator corresponding to the fine-to-coarse level mapping built -! by mld_aggrmap_bld. This is called tentative prolongator. -! 2. The smoothed aggregation uses as prolongator the operator obtained by applying -! a damped Jacobi smoother to the tentative prolongator. -! 3. The "bizarre" aggregation uses a prolongator proposed by the authors of MLD2P4. -! This prolongator still requires a deep analysis and testing and its use is -! not recommended. -! 4. Minimum energy aggregation: ADD REFERENCE. -! -! For more details see -! M. Brezina and P. Vanek, A black-box iterative solver based on a two-level -! Schwarz method, Computing, 63 (1999), 233-263. -! P. D'Ambra, D. di Serafino and S. Filippone, On the development of PSBLAS-based -! parallel two-level Schwarz preconditioners, Appl. Num. Math., 57 (2007), -! 1181-1196. -! -! -! -! Arguments: -! a - type(psb_dspmat_type), input. -! The sparse matrix structure containing the local part of -! the fine-level matrix. -! desc_a - type(psb_desc_type), input. -! The communication descriptor of the fine-level matrix. -! p - type(mld_d_onelev_type), input/output. -! The 'one-level' data structure that will contain the local -! part of the matrix to be built as well as the information -! concerning the prolongator and its transpose. -! parms - type(mld_dml_parms), input -! Parameters controlling the choice of algorithm -! ac - type(psb_dspmat_type), output -! The coarse matrix on output -! -! ilaggr - integer, dimension(:), input -! The mapping between the row indices of the coarse-level -! matrix and the row indices of the fine-level matrix. -! ilaggr(i)=j means that node i in the adjacency graph -! of the fine-level matrix is mapped onto node j in the -! adjacency graph of the coarse-level matrix. Note that the indices -! are assumed to be shifted so as to make sure the ranges on -! the various processes do not overlap. -! nlaggr - integer, dimension(:) input -! nlaggr(i) contains the aggregates held by process i. -! op_prol - type(psb_dspmat_type), input/output -! The tentative prolongator on input, the computed prolongator on output -! -! op_restr - type(psb_dspmat_type), output -! The restrictor operator; normally, it is the transpose of the prolongator. -! -! info - integer, output. -! Error code. -! -subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) - - use psb_base_mod - use mld_base_prec_type - use mld_d_inner_mod, mld_protect_name => mld_daggrmat_asb - - implicit none - -! Arguments - type(psb_dspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(mld_dml_parms), intent(inout) :: parms - type(psb_dspmat_type), intent(inout) :: ac, op_prol,op_restr - integer(psb_ipk_), intent(out) :: info - -! Local variables - type(psb_d_coo_sparse_mat) :: acoo, bcoo - type(psb_d_csr_sparse_mat) :: acsr1 - integer(psb_ipk_) :: nzl,ntaggr, err_act - integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: ictxt,np,me - character(len=20) :: name - - name='mld_aggrmat_asb' - if(psb_get_errstatus().ne.0) return - info=psb_success_ - call psb_erractionsave(err_act) - debug_unit = psb_get_debug_unit() - debug_level = psb_get_debug_level() - - - ictxt = desc_a%get_context() - - call psb_info(ictxt, me, np) - - select case (parms%aggr_prol) - case (mld_no_smooth_) - - call mld_daggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,& - & parms,ac,op_prol,op_restr,info) - - case(mld_smooth_prol_) - - call mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr, & - & parms,ac,op_prol,op_restr,info) - - case(mld_biz_prol_) - - call mld_daggrmat_biz_asb(a,desc_a,ilaggr,nlaggr, & - & parms,ac,op_prol,op_restr,info) - - case(mld_min_energy_) - - call mld_daggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr, & - & parms,ac,op_prol,op_restr,info) - - case default - info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='Invalid aggr kind') - goto 9999 - - end select - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner aggrmat asb') - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine mld_daggrmat_asb diff --git a/mlprec/impl/mld_s_hierarchy_bld.f90 b/mlprec/impl/mld_s_hierarchy_bld.f90 index 28fbf51d..a579348b 100644 --- a/mlprec/impl/mld_s_hierarchy_bld.f90 +++ b/mlprec/impl/mld_s_hierarchy_bld.f90 @@ -84,6 +84,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info) real(psb_spk_) :: mnaggratio, sizeratio, athresh, aomega class(mld_s_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, & & base_sm2, med_sm2, coarse_sm2 + class(mld_s_base_aggregator_type), allocatable :: tmp_aggr type(mld_sml_parms) :: baseparms, medparms, coarseparms integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) type(psb_sspmat_type) :: op_prol @@ -216,19 +217,26 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info) allocate(tprecv(nplevs),stat=info) ! First all existing levels if (info == 0) tprecv(1)%parms = baseparms - if (info == 0) call restore_smoothers(tprecv(1),prec%precv(1)%sm,prec%precv(1)%sm2a,info) + if (info == 0) call restore_smoothers(tprecv(1),& + & prec%precv(1)%sm,prec%precv(1)%sm2a,info) + if (info == 0) call move_alloc(prec%precv(1)%aggr,tprecv(1)%aggr) do i=2, min(iszv,nplevs) - 1 if (info == 0) tprecv(i)%parms = medparms - if (info == 0) call restore_smoothers(tprecv(i),prec%precv(i)%sm,prec%precv(i)%sm2a,info) + if (info == 0) call restore_smoothers(tprecv(i),& + & prec%precv(i)%sm,prec%precv(i)%sm2a,info) + if (info == 0) call move_alloc(prec%precv(i)%aggr,tprecv(i)%aggr) end do ! Further intermediates, if any do i=iszv-1, nplevs - 1 if (info == 0) tprecv(i)%parms = medparms if (info == 0) call restore_smoothers(tprecv(i),med_sm,med_sm2,info) + if ((info == 0).and..not.allocated(tprecv(i)%aggr))& + & allocate(tprecv(i)%aggr,source=tprecv(1)%aggr,stat=info) end do ! Then coarse if (info == 0) tprecv(nplevs)%parms = coarseparms if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info) + if (info == 0) allocate(tprecv(nplevs)%aggr,source=tprecv(i)%aggr,stat=info) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,& & a_err='prec reallocation') @@ -272,9 +280,10 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info) ! ! Build the mapping between levels i-1 and i and the matrix ! at level i - ! - if (info == psb_success_) call mld_aggrmap_bld(prec%precv(i),& - & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,& + ! + if (info == psb_success_)& + & call prec%precv(i)%bld_tprol(prec%precv(i-1)%base_a,& + & prec%precv(i-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) if (info /= psb_success_) then @@ -282,6 +291,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info) & a_err='Map build') goto 9999 endif + if (i= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& @@ -346,7 +356,8 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info) prec%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_omega_val = aomega - if (info == 0) call restore_smoothers(prec%precv(newsz),coarse_sm,coarse_sm2,info) + if (info == 0) call restore_smoothers(prec%precv(newsz),& + & coarse_sm,coarse_sm2,info) if (newsz < i) then ! ! We are going back and revisit a previous leve; @@ -357,7 +368,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info) call prec%precv(newsz)%tprol%clone(op_prol,info) end if - if (info == psb_success_) call mld_lev_mat_asb(prec%precv(newsz),& + if (info == psb_success_) call prec%precv(newsz)%mat_asb( & & prec%precv(newsz-1)%base_a,prec%precv(newsz-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) if (info /= 0) then @@ -367,7 +378,7 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info) endif exit array_build_loop else - if (info == psb_success_) call mld_lev_mat_asb(prec%precv(i),& + if (info == psb_success_) call prec%precv(i)%mat_asb(& & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) end if diff --git a/mlprec/impl/mld_s_lev_aggrmat_asb.f90 b/mlprec/impl/mld_s_lev_aggrmat_asb.f90 deleted file mode 100644 index 2433a1a0..00000000 --- a/mlprec/impl/mld_s_lev_aggrmat_asb.f90 +++ /dev/null @@ -1,267 +0,0 @@ -! -! -! MLD2P4 version 2.1 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -! File: mld_s_lev_aggrmat_asb.f90 -! -! Subroutine: mld_s_lev_aggrmat_asb -! Version: real -! -! This routine builds the matrix associated to the current level of the -! multilevel preconditioner from the matrix associated to the previous level, -! by using the user-specified aggregation technique (therefore, it also builds the -! prolongation and restriction operators mapping the current level to the -! previous one and vice versa). -! The current level is regarded as the coarse one, while the previous as -! the fine one. This is in agreement with the fact that the routine is called, -! by mld_mlprec_bld, only on levels >=2. -! The main structure is: -! 1. Perform sanity checks; -! 2. Call mld_Xaggrmat_asb to compute prolongator/restrictor/AC -! 3. According to the choice of DIST/REPL for AC, build a descriptor DESC_AC, -! and adjust the column numbering of AC/OP_PROL/OP_RESTR -! 4. Pack restrictor and prolongator into p%map -! 5. Fix base_a and base_desc pointers. -! -! -! Arguments: -! p - type(mld_s_onelev_type), input/output. -! The 'one-level' data structure containing the control -! parameters and (eventually) coarse matrix and prolongator/restrictors. -! -! a - type(psb_sspmat_type). -! The sparse matrix structure containing the local part of the -! fine-level matrix. -! desc_a - type(psb_desc_type), input. -! The communication descriptor of a. -! ilaggr - integer, dimension(:), input -! The mapping between the row indices of the coarse-level -! matrix and the row indices of the fine-level matrix. -! ilaggr(i)=j means that node i in the adjacency graph -! of the fine-level matrix is mapped onto node j in the -! adjacency graph of the coarse-level matrix. Note that the indices -! are assumed to be shifted so as to make sure the ranges on -! the various processes do not overlap. -! nlaggr - integer, dimension(:) input -! nlaggr(i) contains the aggregates held by process i. -! op_prol - type(psb_sspmat_type), input/output -! The tentative prolongator on input, released on output. -! -! info - integer, output. -! Error code. -! -subroutine mld_s_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info) - - use psb_base_mod - use mld_base_prec_type - use mld_s_inner_mod, mld_protect_name => mld_s_lev_aggrmat_asb - - implicit none - - ! Arguments - type(mld_s_onelev_type), intent(inout), target :: p - type(psb_sspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(inout) :: ilaggr(:),nlaggr(:) - type(psb_sspmat_type), intent(inout) :: op_prol - integer(psb_ipk_), intent(out) :: info - - - ! Local variables - character(len=24) :: name - integer(psb_mpik_) :: ictxt, np, me - integer(psb_ipk_) :: err_act - type(psb_sspmat_type) :: ac, op_restr - type(psb_s_coo_sparse_mat) :: acoo, bcoo - type(psb_s_csr_sparse_mat) :: acsr1 - integer(psb_ipk_) :: nzl, ntaggr - integer(psb_ipk_) :: debug_level, debug_unit - - name='mld_s_lev_aggrmat_asb' - if (psb_get_errstatus().ne.0) return - call psb_erractionsave(err_act) - debug_unit = psb_get_debug_unit() - debug_level = psb_get_debug_level() - info = psb_success_ - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) - - call mld_check_def(p%parms%aggr_prol,'Smoother',& - & mld_smooth_prol_,is_legal_ml_aggr_prol) - call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& - & mld_distr_mat_,is_legal_ml_coarse_mat) - call mld_check_def(p%parms%aggr_filter,'Use filtered matrix',& - & mld_no_filter_mat_,is_legal_aggr_filter) - call mld_check_def(p%parms%aggr_omega_alg,'Omega Alg.',& - & mld_eig_est_,is_legal_ml_aggr_omega_alg) - call mld_check_def(p%parms%aggr_eig,'Eigenvalue estimate',& - & mld_max_norm_,is_legal_ml_aggr_eig) - call mld_check_def(p%parms%aggr_omega_val,'Omega',szero,is_legal_s_omega) - - - ! - ! 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_prol_) - ! - call mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,p%parms,ac,op_prol,op_restr,info) - - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb') - goto 9999 - end if - - - ! Common code refactored here. - - ntaggr = sum(nlaggr) - - select case(p%parms%coarse_mat) - - case(mld_distr_mat_) - - call ac%mv_to(bcoo) - nzl = bcoo%get_nzeros() - - if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1)) - if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info) - if (info == psb_success_) call psb_cdasb(p%desc_ac,info) - if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I') - if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%desc_ac,info,iact='I') - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Creating p%desc_ac and converting ac') - goto 9999 - end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Assembld aux descr. distr.' - call p%ac%mv_from(bcoo) - - call p%ac%set_nrows(p%desc_ac%get_local_rows()) - call p%ac%set_ncols(p%desc_ac%get_local_cols()) - call p%ac%set_asb() - - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free') - goto 9999 - end if - - if (np>1) then - call op_prol%mv_to(acsr1) - nzl = acsr1%get_nzeros() - call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I') - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc') - goto 9999 - end if - call op_prol%mv_from(acsr1) - endif - call op_prol%set_ncols(p%desc_ac%get_local_cols()) - - if (np>1) then - call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_) - call op_restr%mv_to(acoo) - nzl = acoo%get_nzeros() - if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I') - call acoo%set_dupl(psb_dupl_add_) - if (info == psb_success_) call op_restr%mv_from(acoo) - if (info == psb_success_) call op_restr%cscnv(info,type='csr') - if(info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Converting op_restr to local') - goto 9999 - end if - end if - ! - ! Clip to local rows. - ! - call op_restr%set_nrows(p%desc_ac%get_local_rows()) - - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Done ac ' - - case(mld_repl_mat_) - ! - ! - call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) - if (info == psb_success_) call psb_cdasb(p%desc_ac,info) - if (info == psb_success_) & - & call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) - - if (info /= psb_success_) goto 9999 - - case default - info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') - goto 9999 - end select - - call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv') - goto 9999 - end if - - ! - ! Copy the prolongation/restriction matrices into the descriptor map. - ! op_restr => PR^T i.e. restriction operator - ! op_prol => PR i.e. prolongation operator - ! - - p%map = psb_linmap(psb_map_aggr_,desc_a,& - & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr) - if (info == psb_success_) call op_prol%free() - if (info == psb_success_) call op_restr%free() - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') - goto 9999 - end if - ! - ! Fix the base_a and base_desc pointers for handling of residuals. - ! This is correct because this routine is only called at levels >=2. - ! - p%base_a => p%ac - p%base_desc => p%desc_ac - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_s_lev_aggrmat_asb diff --git a/mlprec/impl/mld_saggrmap_bld.f90 b/mlprec/impl/mld_saggrmap_bld.f90 deleted file mode 100644 index 2009bf6e..00000000 --- a/mlprec/impl/mld_saggrmap_bld.f90 +++ /dev/null @@ -1,189 +0,0 @@ -! -! -! MLD2P4 version 2.1 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -! File: mld_saggrmap_bld.f90 -! -! Subroutine: mld_saggrmap_bld -! Version: real -! -! This routine builds a mapping from the row indices of the fine-level matrix -! to the row indices of the coarse-level matrix, according to a decoupled -! aggregation algorithm. This mapping will be used by mld_aggrmat_asb to -! build the coarse-level matrix. -! -! The aggregation algorithm is a parallel version of that described in -! * M. Brezina and P. Vanek, A black-box iterative solver based on a -! two-level Schwarz method, Computing, 63 (1999), 233-263. -! * P. Vanek, J. Mandel and M. Brezina, Algebraic Multigrid by Smoothed -! Aggregation for Second and Fourth Order Elliptic Problems, Computing, 56 -! (1996), 179-196. -! For more details see -! P. D'Ambra, D. di Serafino and S. Filippone, On the development of -! PSBLAS-based parallel two-level Schwarz preconditioners, Appl. Num. Math. -! 57 (2007), 1181-1196. -! -! -! Arguments: -! aggr_type - integer, input. -! The scalar used to identify the aggregation algorithm. -! theta - real, input. -! The aggregation threshold used in the aggregation algorithm. -! a - type(psb_sspmat_type), input. -! The sparse matrix structure containing the local part of -! the fine-level matrix. -! desc_a - type(psb_desc_type), input. -! The communication descriptor of the fine-level matrix. -! ilaggr - integer, dimension(:), allocatable. -! The mapping between the row indices of the coarse-level -! matrix and the row indices of the fine-level matrix. -! ilaggr(i)=j means that node i in the adjacency graph -! of the fine-level matrix is mapped onto node j in the -! adjacency graph of the coarse-level matrix. Note that on exit the indices -! will be shifted so as to make sure the ranges on the various processes do not -! overlap. -! nlaggr - integer, dimension(:), allocatable. -! nlaggr(i) contains the aggregates held by process i. -! op_prol - type(psb_sspmat_type). -! The tentative prolongator, based on ilaggr. -! -! info - integer, output. -! Error code. -! -subroutine mld_saggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info) - - use psb_base_mod - use mld_base_prec_type - use mld_s_inner_mod, mld_protect_name => mld_saggrmap_bld - - implicit none - - ! Arguments - integer(psb_ipk_), intent(in) :: iorder - integer(psb_ipk_), intent(in) :: aggr_type - real(psb_spk_), intent(in) :: theta - type(psb_sspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) - type(psb_sspmat_type), intent(out) :: op_prol - integer(psb_ipk_), intent(out) :: info - - ! Local variables - integer(psb_ipk_), allocatable :: ils(:), neigh(:) - integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m,naggrm1, naggrp1, ntaggr - type(psb_sspmat_type) :: atmp, atrans - type(psb_s_coo_sparse_mat) :: tmpcoo - integer(psb_ipk_) :: debug_level, debug_unit,err_act - integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: nrow, ncol, n_ne - character(len=20) :: name, ch_err - - if(psb_get_errstatus() /= 0) return - info=psb_success_ - name = 'mld_aggrmap_bld' - call psb_erractionsave(err_act) - debug_unit = psb_get_debug_unit() - debug_level = psb_get_debug_level() - ! - ictxt=desc_a%get_context() - call psb_info(ictxt,me,np) - nrow = desc_a%get_local_rows() - ncol = desc_a%get_local_cols() - - select case (aggr_type) - case (mld_dec_aggr_) - call mld_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info) - - case (mld_sym_dec_aggr_) - nr = a%get_nrows() - call a%csclip(atmp,info,imax=nr,jmax=nr,& - & rscale=.false.,cscale=.false.) - call atmp%set_nrows(nr) - call atmp%set_ncols(nr) - if (info == psb_success_) call atmp%transp(atrans) - if (info == psb_success_) call atrans%cscnv(info,type='COO') - if (info == psb_success_) call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.) - call atmp%set_nrows(nr) - call atmp%set_ncols(nr) - if (info == psb_success_) call atrans%free() - if (info == psb_success_) call atmp%cscnv(info,type='CSR') - if (info == psb_success_) call mld_dec_map_bld(iorder,theta,atmp,desc_a,nlaggr,ilaggr,info) - if (info == psb_success_) call atmp%free() - - case default - - info = -1 - call psb_errpush(psb_err_input_value_invalid_i_,name,& - & i_err=(/ione,aggr_type,izero,izero,izero/)) - goto 9999 - end select - - if (info /= psb_success_) then - info=psb_err_internal_error_ - call psb_errpush(info,name,a_err='dec_map_bld') - goto 9999 - end if - - naggr = nlaggr(me+1) - ntaggr = sum(nlaggr) - naggrm1 = sum(nlaggr(1:me)) - naggrp1 = sum(nlaggr(1:me+1)) - ilaggr(1:nrow) = ilaggr(1:nrow) + naggrm1 - call psb_halo(ilaggr,desc_a,info) - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_halo') - goto 9999 - end if - - call tmpcoo%allocate(ncol,ntaggr,ncol) - do i=1,ncol - tmpcoo%val(i) = sone - tmpcoo%ia(i) = i - tmpcoo%ja(i) = ilaggr(i) - end do - call tmpcoo%set_nzeros(ncol) - call tmpcoo%set_dupl(psb_dupl_add_) - call tmpcoo%set_sorted() ! At this point this is in row-major - call op_prol%mv_from(tmpcoo) - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine mld_saggrmap_bld diff --git a/mlprec/impl/mld_saggrmat_asb.f90 b/mlprec/impl/mld_saggrmat_asb.f90 deleted file mode 100644 index 263fa5e6..00000000 --- a/mlprec/impl/mld_saggrmat_asb.f90 +++ /dev/null @@ -1,193 +0,0 @@ -! -! -! MLD2P4 version 2.1 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -! File: mld_saggrmat_asb.f90 -! -! Subroutine: mld_saggrmat_asb -! Version: real -! -! This routine builds a coarse-level matrix A_C from a fine-level matrix A -! by using the Galerkin approach, i.e. -! -! A_C = P_C^T A P_C, -! -! where P_C is a prolongator from the coarse level to the fine one. -! -! A mapping from the nodes of the adjacency graph of A to the nodes of the -! adjacency graph of A_C has been computed by the mld_aggrmap_bld subroutine. -! The prolongator P_C is built here from this mapping, according to the -! value of p%iprcparm(mld_aggr_prol_), specified by the user through -! mld_sprecinit and mld_zprecset. -! On output from this routine the entries of AC, op_prol, op_restr -! are still in "global numbering" mode; this is fixed in the calling routine -! mld_s_lev_aggrmat_asb. -! -! Currently four different prolongators are implemented, corresponding to -! four aggregation algorithms: -! 1. un-smoothed aggregation, -! 2. smoothed aggregation, -! 3. "bizarre" aggregation. -! 4. minimum energy -! 1. The non-smoothed aggregation uses as prolongator the piecewise constant -! interpolation operator corresponding to the fine-to-coarse level mapping built -! by mld_aggrmap_bld. This is called tentative prolongator. -! 2. The smoothed aggregation uses as prolongator the operator obtained by applying -! a damped Jacobi smoother to the tentative prolongator. -! 3. The "bizarre" aggregation uses a prolongator proposed by the authors of MLD2P4. -! This prolongator still requires a deep analysis and testing and its use is -! not recommended. -! 4. Minimum energy aggregation: ADD REFERENCE. -! -! For more details see -! M. Brezina and P. Vanek, A black-box iterative solver based on a two-level -! Schwarz method, Computing, 63 (1999), 233-263. -! P. D'Ambra, D. di Serafino and S. Filippone, On the development of PSBLAS-based -! parallel two-level Schwarz preconditioners, Appl. Num. Math., 57 (2007), -! 1181-1196. -! -! -! -! Arguments: -! a - type(psb_sspmat_type), input. -! The sparse matrix structure containing the local part of -! the fine-level matrix. -! desc_a - type(psb_desc_type), input. -! The communication descriptor of the fine-level matrix. -! p - type(mld_s_onelev_type), input/output. -! The 'one-level' data structure that will contain the local -! part of the matrix to be built as well as the information -! concerning the prolongator and its transpose. -! parms - type(mld_sml_parms), input -! Parameters controlling the choice of algorithm -! ac - type(psb_sspmat_type), output -! The coarse matrix on output -! -! ilaggr - integer, dimension(:), input -! The mapping between the row indices of the coarse-level -! matrix and the row indices of the fine-level matrix. -! ilaggr(i)=j means that node i in the adjacency graph -! of the fine-level matrix is mapped onto node j in the -! adjacency graph of the coarse-level matrix. Note that the indices -! are assumed to be shifted so as to make sure the ranges on -! the various processes do not overlap. -! nlaggr - integer, dimension(:) input -! nlaggr(i) contains the aggregates held by process i. -! op_prol - type(psb_sspmat_type), input/output -! The tentative prolongator on input, the computed prolongator on output -! -! op_restr - type(psb_sspmat_type), output -! The restrictor operator; normally, it is the transpose of the prolongator. -! -! info - integer, output. -! Error code. -! -subroutine mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) - - use psb_base_mod - use mld_base_prec_type - use mld_s_inner_mod, mld_protect_name => mld_saggrmat_asb - - implicit none - -! Arguments - type(psb_sspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(mld_sml_parms), intent(inout) :: parms - type(psb_sspmat_type), intent(inout) :: ac, op_prol,op_restr - integer(psb_ipk_), intent(out) :: info - -! Local variables - type(psb_s_coo_sparse_mat) :: acoo, bcoo - type(psb_s_csr_sparse_mat) :: acsr1 - integer(psb_ipk_) :: nzl,ntaggr, err_act - integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: ictxt,np,me - character(len=20) :: name - - name='mld_aggrmat_asb' - if(psb_get_errstatus().ne.0) return - info=psb_success_ - call psb_erractionsave(err_act) - debug_unit = psb_get_debug_unit() - debug_level = psb_get_debug_level() - - - ictxt = desc_a%get_context() - - call psb_info(ictxt, me, np) - - select case (parms%aggr_prol) - case (mld_no_smooth_) - - call mld_saggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,& - & parms,ac,op_prol,op_restr,info) - - case(mld_smooth_prol_) - - call mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr, & - & parms,ac,op_prol,op_restr,info) - - case(mld_biz_prol_) - - call mld_saggrmat_biz_asb(a,desc_a,ilaggr,nlaggr, & - & parms,ac,op_prol,op_restr,info) - - case(mld_min_energy_) - - call mld_saggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr, & - & parms,ac,op_prol,op_restr,info) - - case default - info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='Invalid aggr kind') - goto 9999 - - end select - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner aggrmat asb') - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine mld_saggrmat_asb diff --git a/mlprec/impl/mld_z_hierarchy_bld.f90 b/mlprec/impl/mld_z_hierarchy_bld.f90 index 1c68b7c3..eeafc9f7 100644 --- a/mlprec/impl/mld_z_hierarchy_bld.f90 +++ b/mlprec/impl/mld_z_hierarchy_bld.f90 @@ -84,6 +84,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info) real(psb_dpk_) :: mnaggratio, sizeratio, athresh, aomega class(mld_z_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, & & base_sm2, med_sm2, coarse_sm2 + class(mld_z_base_aggregator_type), allocatable :: tmp_aggr type(mld_dml_parms) :: baseparms, medparms, coarseparms integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) type(psb_zspmat_type) :: op_prol @@ -216,19 +217,26 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info) allocate(tprecv(nplevs),stat=info) ! First all existing levels if (info == 0) tprecv(1)%parms = baseparms - if (info == 0) call restore_smoothers(tprecv(1),prec%precv(1)%sm,prec%precv(1)%sm2a,info) + if (info == 0) call restore_smoothers(tprecv(1),& + & prec%precv(1)%sm,prec%precv(1)%sm2a,info) + if (info == 0) call move_alloc(prec%precv(1)%aggr,tprecv(1)%aggr) do i=2, min(iszv,nplevs) - 1 if (info == 0) tprecv(i)%parms = medparms - if (info == 0) call restore_smoothers(tprecv(i),prec%precv(i)%sm,prec%precv(i)%sm2a,info) + if (info == 0) call restore_smoothers(tprecv(i),& + & prec%precv(i)%sm,prec%precv(i)%sm2a,info) + if (info == 0) call move_alloc(prec%precv(i)%aggr,tprecv(i)%aggr) end do ! Further intermediates, if any do i=iszv-1, nplevs - 1 if (info == 0) tprecv(i)%parms = medparms if (info == 0) call restore_smoothers(tprecv(i),med_sm,med_sm2,info) + if ((info == 0).and..not.allocated(tprecv(i)%aggr))& + & allocate(tprecv(i)%aggr,source=tprecv(1)%aggr,stat=info) end do ! Then coarse if (info == 0) tprecv(nplevs)%parms = coarseparms if (info == 0) call restore_smoothers(tprecv(nplevs),coarse_sm,coarse_sm2,info) + if (info == 0) allocate(tprecv(nplevs)%aggr,source=tprecv(i)%aggr,stat=info) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,& & a_err='prec reallocation') @@ -272,9 +280,10 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info) ! ! Build the mapping between levels i-1 and i and the matrix ! at level i - ! - if (info == psb_success_) call mld_aggrmap_bld(prec%precv(i),& - & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,& + ! + if (info == psb_success_)& + & call prec%precv(i)%bld_tprol(prec%precv(i-1)%base_a,& + & prec%precv(i-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) if (info /= psb_success_) then @@ -282,6 +291,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info) & a_err='Map build') goto 9999 endif + if (i= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& @@ -346,7 +356,8 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info) prec%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_omega_val = aomega - if (info == 0) call restore_smoothers(prec%precv(newsz),coarse_sm,coarse_sm2,info) + if (info == 0) call restore_smoothers(prec%precv(newsz),& + & coarse_sm,coarse_sm2,info) if (newsz < i) then ! ! We are going back and revisit a previous leve; @@ -357,7 +368,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info) call prec%precv(newsz)%tprol%clone(op_prol,info) end if - if (info == psb_success_) call mld_lev_mat_asb(prec%precv(newsz),& + if (info == psb_success_) call prec%precv(newsz)%mat_asb( & & prec%precv(newsz-1)%base_a,prec%precv(newsz-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) if (info /= 0) then @@ -367,7 +378,7 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info) endif exit array_build_loop else - if (info == psb_success_) call mld_lev_mat_asb(prec%precv(i),& + if (info == psb_success_) call prec%precv(i)%mat_asb(& & prec%precv(i-1)%base_a,prec%precv(i-1)%base_desc,& & ilaggr,nlaggr,op_prol,info) end if diff --git a/mlprec/impl/mld_z_lev_aggrmat_asb.f90 b/mlprec/impl/mld_z_lev_aggrmat_asb.f90 deleted file mode 100644 index 07cac52e..00000000 --- a/mlprec/impl/mld_z_lev_aggrmat_asb.f90 +++ /dev/null @@ -1,267 +0,0 @@ -! -! -! MLD2P4 version 2.1 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -! File: mld_z_lev_aggrmat_asb.f90 -! -! Subroutine: mld_z_lev_aggrmat_asb -! Version: complex -! -! This routine builds the matrix associated to the current level of the -! multilevel preconditioner from the matrix associated to the previous level, -! by using the user-specified aggregation technique (therefore, it also builds the -! prolongation and restriction operators mapping the current level to the -! previous one and vice versa). -! The current level is regarded as the coarse one, while the previous as -! the fine one. This is in agreement with the fact that the routine is called, -! by mld_mlprec_bld, only on levels >=2. -! The main structure is: -! 1. Perform sanity checks; -! 2. Call mld_Xaggrmat_asb to compute prolongator/restrictor/AC -! 3. According to the choice of DIST/REPL for AC, build a descriptor DESC_AC, -! and adjust the column numbering of AC/OP_PROL/OP_RESTR -! 4. Pack restrictor and prolongator into p%map -! 5. Fix base_a and base_desc pointers. -! -! -! Arguments: -! p - type(mld_z_onelev_type), input/output. -! The 'one-level' data structure containing the control -! parameters and (eventually) coarse matrix and prolongator/restrictors. -! -! a - type(psb_zspmat_type). -! The sparse matrix structure containing the local part of the -! fine-level matrix. -! desc_a - type(psb_desc_type), input. -! The communication descriptor of a. -! ilaggr - integer, dimension(:), input -! The mapping between the row indices of the coarse-level -! matrix and the row indices of the fine-level matrix. -! ilaggr(i)=j means that node i in the adjacency graph -! of the fine-level matrix is mapped onto node j in the -! adjacency graph of the coarse-level matrix. Note that the indices -! are assumed to be shifted so as to make sure the ranges on -! the various processes do not overlap. -! nlaggr - integer, dimension(:) input -! nlaggr(i) contains the aggregates held by process i. -! op_prol - type(psb_zspmat_type), input/output -! The tentative prolongator on input, released on output. -! -! info - integer, output. -! Error code. -! -subroutine mld_z_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info) - - use psb_base_mod - use mld_base_prec_type - use mld_z_inner_mod, mld_protect_name => mld_z_lev_aggrmat_asb - - implicit none - - ! Arguments - type(mld_z_onelev_type), intent(inout), target :: p - type(psb_zspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(inout) :: ilaggr(:),nlaggr(:) - type(psb_zspmat_type), intent(inout) :: op_prol - integer(psb_ipk_), intent(out) :: info - - - ! Local variables - character(len=24) :: name - integer(psb_mpik_) :: ictxt, np, me - integer(psb_ipk_) :: err_act - type(psb_zspmat_type) :: ac, op_restr - type(psb_z_coo_sparse_mat) :: acoo, bcoo - type(psb_z_csr_sparse_mat) :: acsr1 - integer(psb_ipk_) :: nzl, ntaggr - integer(psb_ipk_) :: debug_level, debug_unit - - name='mld_z_lev_aggrmat_asb' - if (psb_get_errstatus().ne.0) return - call psb_erractionsave(err_act) - debug_unit = psb_get_debug_unit() - debug_level = psb_get_debug_level() - info = psb_success_ - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) - - call mld_check_def(p%parms%aggr_prol,'Smoother',& - & mld_smooth_prol_,is_legal_ml_aggr_prol) - call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& - & mld_distr_mat_,is_legal_ml_coarse_mat) - call mld_check_def(p%parms%aggr_filter,'Use filtered matrix',& - & mld_no_filter_mat_,is_legal_aggr_filter) - call mld_check_def(p%parms%aggr_omega_alg,'Omega Alg.',& - & mld_eig_est_,is_legal_ml_aggr_omega_alg) - call mld_check_def(p%parms%aggr_eig,'Eigenvalue estimate',& - & mld_max_norm_,is_legal_ml_aggr_eig) - call mld_check_def(p%parms%aggr_omega_val,'Omega',dzero,is_legal_d_omega) - - - ! - ! 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_prol_) - ! - call mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,p%parms,ac,op_prol,op_restr,info) - - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb') - goto 9999 - end if - - - ! Common code refactored here. - - ntaggr = sum(nlaggr) - - select case(p%parms%coarse_mat) - - case(mld_distr_mat_) - - call ac%mv_to(bcoo) - nzl = bcoo%get_nzeros() - - if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1)) - if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info) - if (info == psb_success_) call psb_cdasb(p%desc_ac,info) - if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I') - if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%desc_ac,info,iact='I') - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Creating p%desc_ac and converting ac') - goto 9999 - end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Assembld aux descr. distr.' - call p%ac%mv_from(bcoo) - - call p%ac%set_nrows(p%desc_ac%get_local_rows()) - call p%ac%set_ncols(p%desc_ac%get_local_cols()) - call p%ac%set_asb() - - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free') - goto 9999 - end if - - if (np>1) then - call op_prol%mv_to(acsr1) - nzl = acsr1%get_nzeros() - call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I') - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc') - goto 9999 - end if - call op_prol%mv_from(acsr1) - endif - call op_prol%set_ncols(p%desc_ac%get_local_cols()) - - if (np>1) then - call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_) - call op_restr%mv_to(acoo) - nzl = acoo%get_nzeros() - if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I') - call acoo%set_dupl(psb_dupl_add_) - if (info == psb_success_) call op_restr%mv_from(acoo) - if (info == psb_success_) call op_restr%cscnv(info,type='csr') - if(info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Converting op_restr to local') - goto 9999 - end if - end if - ! - ! Clip to local rows. - ! - call op_restr%set_nrows(p%desc_ac%get_local_rows()) - - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Done ac ' - - case(mld_repl_mat_) - ! - ! - call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) - if (info == psb_success_) call psb_cdasb(p%desc_ac,info) - if (info == psb_success_) & - & call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) - - if (info /= psb_success_) goto 9999 - - case default - info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') - goto 9999 - end select - - call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv') - goto 9999 - end if - - ! - ! Copy the prolongation/restriction matrices into the descriptor map. - ! op_restr => PR^T i.e. restriction operator - ! op_prol => PR i.e. prolongation operator - ! - - p%map = psb_linmap(psb_map_aggr_,desc_a,& - & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr) - if (info == psb_success_) call op_prol%free() - if (info == psb_success_) call op_restr%free() - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') - goto 9999 - end if - ! - ! Fix the base_a and base_desc pointers for handling of residuals. - ! This is correct because this routine is only called at levels >=2. - ! - p%base_a => p%ac - p%base_desc => p%desc_ac - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_z_lev_aggrmat_asb diff --git a/mlprec/impl/mld_zaggrmap_bld.f90 b/mlprec/impl/mld_zaggrmap_bld.f90 deleted file mode 100644 index dc9adbc9..00000000 --- a/mlprec/impl/mld_zaggrmap_bld.f90 +++ /dev/null @@ -1,189 +0,0 @@ -! -! -! MLD2P4 version 2.1 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -! File: mld_zaggrmap_bld.f90 -! -! Subroutine: mld_zaggrmap_bld -! Version: complex -! -! This routine builds a mapping from the row indices of the fine-level matrix -! to the row indices of the coarse-level matrix, according to a decoupled -! aggregation algorithm. This mapping will be used by mld_aggrmat_asb to -! build the coarse-level matrix. -! -! The aggregation algorithm is a parallel version of that described in -! * M. Brezina and P. Vanek, A black-box iterative solver based on a -! two-level Schwarz method, Computing, 63 (1999), 233-263. -! * P. Vanek, J. Mandel and M. Brezina, Algebraic Multigrid by Smoothed -! Aggregation for Second and Fourth Order Elliptic Problems, Computing, 56 -! (1996), 179-196. -! For more details see -! P. D'Ambra, D. di Serafino and S. Filippone, On the development of -! PSBLAS-based parallel two-level Schwarz preconditioners, Appl. Num. Math. -! 57 (2007), 1181-1196. -! -! -! Arguments: -! aggr_type - integer, input. -! The scalar used to identify the aggregation algorithm. -! theta - real, input. -! The aggregation threshold used in the aggregation algorithm. -! a - type(psb_zspmat_type), input. -! The sparse matrix structure containing the local part of -! the fine-level matrix. -! desc_a - type(psb_desc_type), input. -! The communication descriptor of the fine-level matrix. -! ilaggr - integer, dimension(:), allocatable. -! The mapping between the row indices of the coarse-level -! matrix and the row indices of the fine-level matrix. -! ilaggr(i)=j means that node i in the adjacency graph -! of the fine-level matrix is mapped onto node j in the -! adjacency graph of the coarse-level matrix. Note that on exit the indices -! will be shifted so as to make sure the ranges on the various processes do not -! overlap. -! nlaggr - integer, dimension(:), allocatable. -! nlaggr(i) contains the aggregates held by process i. -! op_prol - type(psb_zspmat_type). -! The tentative prolongator, based on ilaggr. -! -! info - integer, output. -! Error code. -! -subroutine mld_zaggrmap_bld(aggr_type,iorder,theta,a,desc_a,ilaggr,nlaggr,op_prol,info) - - use psb_base_mod - use mld_base_prec_type - use mld_z_inner_mod, mld_protect_name => mld_zaggrmap_bld - - implicit none - - ! Arguments - integer(psb_ipk_), intent(in) :: iorder - integer(psb_ipk_), intent(in) :: aggr_type - real(psb_dpk_), intent(in) :: theta - type(psb_zspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) - type(psb_zspmat_type), intent(out) :: op_prol - integer(psb_ipk_), intent(out) :: info - - ! Local variables - integer(psb_ipk_), allocatable :: ils(:), neigh(:) - integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m,naggrm1, naggrp1, ntaggr - type(psb_zspmat_type) :: atmp, atrans - type(psb_z_coo_sparse_mat) :: tmpcoo - integer(psb_ipk_) :: debug_level, debug_unit,err_act - integer(psb_ipk_) :: ictxt,np,me - integer(psb_ipk_) :: nrow, ncol, n_ne - character(len=20) :: name, ch_err - - if(psb_get_errstatus() /= 0) return - info=psb_success_ - name = 'mld_aggrmap_bld' - call psb_erractionsave(err_act) - debug_unit = psb_get_debug_unit() - debug_level = psb_get_debug_level() - ! - ictxt=desc_a%get_context() - call psb_info(ictxt,me,np) - nrow = desc_a%get_local_rows() - ncol = desc_a%get_local_cols() - - select case (aggr_type) - case (mld_dec_aggr_) - call mld_dec_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info) - - case (mld_sym_dec_aggr_) - nr = a%get_nrows() - call a%csclip(atmp,info,imax=nr,jmax=nr,& - & rscale=.false.,cscale=.false.) - call atmp%set_nrows(nr) - call atmp%set_ncols(nr) - if (info == psb_success_) call atmp%transp(atrans) - if (info == psb_success_) call atrans%cscnv(info,type='COO') - if (info == psb_success_) call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.) - call atmp%set_nrows(nr) - call atmp%set_ncols(nr) - if (info == psb_success_) call atrans%free() - if (info == psb_success_) call atmp%cscnv(info,type='CSR') - if (info == psb_success_) call mld_dec_map_bld(iorder,theta,atmp,desc_a,nlaggr,ilaggr,info) - if (info == psb_success_) call atmp%free() - - case default - - info = -1 - call psb_errpush(psb_err_input_value_invalid_i_,name,& - & i_err=(/ione,aggr_type,izero,izero,izero/)) - goto 9999 - end select - - if (info /= psb_success_) then - info=psb_err_internal_error_ - call psb_errpush(info,name,a_err='dec_map_bld') - goto 9999 - end if - - naggr = nlaggr(me+1) - ntaggr = sum(nlaggr) - naggrm1 = sum(nlaggr(1:me)) - naggrp1 = sum(nlaggr(1:me+1)) - ilaggr(1:nrow) = ilaggr(1:nrow) + naggrm1 - call psb_halo(ilaggr,desc_a,info) - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_halo') - goto 9999 - end if - - call tmpcoo%allocate(ncol,ntaggr,ncol) - do i=1,ncol - tmpcoo%val(i) = zone - tmpcoo%ia(i) = i - tmpcoo%ja(i) = ilaggr(i) - end do - call tmpcoo%set_nzeros(ncol) - call tmpcoo%set_dupl(psb_dupl_add_) - call tmpcoo%set_sorted() ! At this point this is in row-major - call op_prol%mv_from(tmpcoo) - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine mld_zaggrmap_bld diff --git a/mlprec/impl/mld_zaggrmat_asb.f90 b/mlprec/impl/mld_zaggrmat_asb.f90 deleted file mode 100644 index afb53865..00000000 --- a/mlprec/impl/mld_zaggrmat_asb.f90 +++ /dev/null @@ -1,193 +0,0 @@ -! -! -! MLD2P4 version 2.1 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! Redistribution and use in source and binary forms, with or without -! modification, are permitted provided that the following conditions -! are met: -! 1. Redistributions of source code must retain the above copyright -! notice, this list of conditions and the following disclaimer. -! 2. Redistributions in binary form must reproduce the above copyright -! notice, this list of conditions, and the following disclaimer in the -! documentation and/or other materials provided with the distribution. -! 3. The name of the MLD2P4 group or the names of its contributors may -! not be used to endorse or promote products derived from this -! software without specific written permission. -! -! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS -! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -! POSSIBILITY OF SUCH DAMAGE. -! -! -! File: mld_zaggrmat_asb.f90 -! -! Subroutine: mld_zaggrmat_asb -! Version: complex -! -! This routine builds a coarse-level matrix A_C from a fine-level matrix A -! by using the Galerkin approach, i.e. -! -! A_C = P_C^T A P_C, -! -! where P_C is a prolongator from the coarse level to the fine one. -! -! A mapping from the nodes of the adjacency graph of A to the nodes of the -! adjacency graph of A_C has been computed by the mld_aggrmap_bld subroutine. -! The prolongator P_C is built here from this mapping, according to the -! value of p%iprcparm(mld_aggr_prol_), specified by the user through -! mld_zprecinit and mld_zprecset. -! On output from this routine the entries of AC, op_prol, op_restr -! are still in "global numbering" mode; this is fixed in the calling routine -! mld_z_lev_aggrmat_asb. -! -! Currently four different prolongators are implemented, corresponding to -! four aggregation algorithms: -! 1. un-smoothed aggregation, -! 2. smoothed aggregation, -! 3. "bizarre" aggregation. -! 4. minimum energy -! 1. The non-smoothed aggregation uses as prolongator the piecewise constant -! interpolation operator corresponding to the fine-to-coarse level mapping built -! by mld_aggrmap_bld. This is called tentative prolongator. -! 2. The smoothed aggregation uses as prolongator the operator obtained by applying -! a damped Jacobi smoother to the tentative prolongator. -! 3. The "bizarre" aggregation uses a prolongator proposed by the authors of MLD2P4. -! This prolongator still requires a deep analysis and testing and its use is -! not recommended. -! 4. Minimum energy aggregation: ADD REFERENCE. -! -! For more details see -! M. Brezina and P. Vanek, A black-box iterative solver based on a two-level -! Schwarz method, Computing, 63 (1999), 233-263. -! P. D'Ambra, D. di Serafino and S. Filippone, On the development of PSBLAS-based -! parallel two-level Schwarz preconditioners, Appl. Num. Math., 57 (2007), -! 1181-1196. -! -! -! -! Arguments: -! a - type(psb_zspmat_type), input. -! The sparse matrix structure containing the local part of -! the fine-level matrix. -! desc_a - type(psb_desc_type), input. -! The communication descriptor of the fine-level matrix. -! p - type(mld_z_onelev_type), input/output. -! The 'one-level' data structure that will contain the local -! part of the matrix to be built as well as the information -! concerning the prolongator and its transpose. -! parms - type(mld_dml_parms), input -! Parameters controlling the choice of algorithm -! ac - type(psb_zspmat_type), output -! The coarse matrix on output -! -! ilaggr - integer, dimension(:), input -! The mapping between the row indices of the coarse-level -! matrix and the row indices of the fine-level matrix. -! ilaggr(i)=j means that node i in the adjacency graph -! of the fine-level matrix is mapped onto node j in the -! adjacency graph of the coarse-level matrix. Note that the indices -! are assumed to be shifted so as to make sure the ranges on -! the various processes do not overlap. -! nlaggr - integer, dimension(:) input -! nlaggr(i) contains the aggregates held by process i. -! op_prol - type(psb_zspmat_type), input/output -! The tentative prolongator on input, the computed prolongator on output -! -! op_restr - type(psb_zspmat_type), output -! The restrictor operator; normally, it is the transpose of the prolongator. -! -! info - integer, output. -! Error code. -! -subroutine mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,info) - - use psb_base_mod - use mld_base_prec_type - use mld_z_inner_mod, mld_protect_name => mld_zaggrmat_asb - - implicit none - -! Arguments - type(psb_zspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(mld_dml_parms), intent(inout) :: parms - type(psb_zspmat_type), intent(inout) :: ac, op_prol,op_restr - integer(psb_ipk_), intent(out) :: info - -! Local variables - type(psb_z_coo_sparse_mat) :: acoo, bcoo - type(psb_z_csr_sparse_mat) :: acsr1 - integer(psb_ipk_) :: nzl,ntaggr, err_act - integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: ictxt,np,me - character(len=20) :: name - - name='mld_aggrmat_asb' - if(psb_get_errstatus().ne.0) return - info=psb_success_ - call psb_erractionsave(err_act) - debug_unit = psb_get_debug_unit() - debug_level = psb_get_debug_level() - - - ictxt = desc_a%get_context() - - call psb_info(ictxt, me, np) - - select case (parms%aggr_prol) - case (mld_no_smooth_) - - call mld_zaggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,& - & parms,ac,op_prol,op_restr,info) - - case(mld_smooth_prol_) - - call mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr, & - & parms,ac,op_prol,op_restr,info) - - case(mld_biz_prol_) - - call mld_zaggrmat_biz_asb(a,desc_a,ilaggr,nlaggr, & - & parms,ac,op_prol,op_restr,info) - - case(mld_min_energy_) - - call mld_zaggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr, & - & parms,ac,op_prol,op_restr,info) - - case default - info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='Invalid aggr kind') - goto 9999 - - end select - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='Inner aggrmat asb') - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return - -end subroutine mld_zaggrmat_asb diff --git a/mlprec/mld_c_base_aggregator_mod.f90 b/mlprec/mld_c_base_aggregator_mod.f90 index 6fd291cc..7bfb4428 100644 --- a/mlprec/mld_c_base_aggregator_mod.f90 +++ b/mlprec/mld_c_base_aggregator_mod.f90 @@ -97,14 +97,14 @@ module mld_c_base_aggregator_mod type mld_c_base_aggregator_type contains - procedure, pass(ag) :: bld_tprol => mld_c_base_aggregator_build_tprol - procedure, pass(ag) :: mat_asb => mld_c_base_aggregator_mat_asb - procedure, pass(ag) :: update_level => mld_c_base_aggregator_update_level - procedure, pass(ag) :: clone => mld_c_base_aggregator_clone - 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, nopass :: fmt => mld_c_base_aggregator_fmt + procedure, pass(ag) :: bld_tprol => mld_c_base_aggregator_build_tprol + procedure, pass(ag) :: mat_asb => mld_c_base_aggregator_mat_asb + procedure, pass(ag) :: update_next => mld_c_base_aggregator_update_next + procedure, pass(ag) :: clone => mld_c_base_aggregator_clone + 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, nopass :: fmt => mld_c_base_aggregator_fmt end type mld_c_base_aggregator_type @@ -142,7 +142,7 @@ module mld_c_base_aggregator_mod contains - subroutine mld_c_base_aggregator_update_level(ag,agnext,info) + subroutine mld_c_base_aggregator_update_next(ag,agnext,info) implicit none class(mld_c_base_aggregator_type), target, intent(inout) :: ag, agnext integer(psb_ipk_), intent(out) :: info @@ -151,7 +151,7 @@ contains ! Base version does nothing. ! info = 0 - end subroutine mld_c_base_aggregator_update_level + end subroutine mld_c_base_aggregator_update_next subroutine mld_c_base_aggregator_clone(ag,agnext,info) implicit none diff --git a/mlprec/mld_c_inner_mod.f90 b/mlprec/mld_c_inner_mod.f90 index 0de61dca..432c73b5 100644 --- a/mlprec/mld_c_inner_mod.f90 +++ b/mlprec/mld_c_inner_mod.f90 @@ -44,7 +44,7 @@ ! The interfaces of the user level routines are defined in mld_prec_mod.f90. ! module mld_c_inner_mod -! use mld_c_prec_type, only : mld_c_prec_type + use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_i_base_vect_type, & & psb_spk_, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_, & & psb_c_vect_type diff --git a/mlprec/mld_c_onelev_mod.f90 b/mlprec/mld_c_onelev_mod.f90 index fe5a84a3..de6ec194 100644 --- a/mlprec/mld_c_onelev_mod.f90 +++ b/mlprec/mld_c_onelev_mod.f90 @@ -151,6 +151,9 @@ module mld_c_onelev_mod type(psb_clinmap_type) :: map real(psb_spk_) :: szratio contains + procedure, pass(lv) :: bld_tprol => c_base_onelev_bld_tprol + procedure, pass(lv) :: mat_asb => mld_c_base_onelev_mat_asb + procedure, pass(lv) :: update_aggr => c_base_onelev_update_aggr procedure, pass(lv) :: bld => mld_c_base_onelev_build procedure, pass(lv) :: clone => c_base_onelev_clone procedure, pass(lv) :: cnv => mld_c_base_onelev_cnv @@ -178,6 +181,7 @@ module mld_c_onelev_mod procedure, pass(lv) :: free_wrk => c_base_onelev_free_wrk procedure, nopass :: stringval => mld_stringval procedure, pass(lv) :: move_alloc => c_base_onelev_move_alloc + end type mld_c_onelev_type type mld_c_onelev_node @@ -191,7 +195,19 @@ module mld_c_onelev_mod & c_base_onelev_get_wrksize, c_base_onelev_allocate_wrk, & & c_base_onelev_free_wrk - + interface + subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) + import :: psb_cspmat_type, psb_desc_type, psb_spk_, psb_ipk_ + import :: mld_c_onelev_type + implicit none + class(mld_c_onelev_type), intent(inout), target :: lv + type(psb_cspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(inout) :: ilaggr(:),nlaggr(:) + type(psb_cspmat_type), intent(inout) :: op_prol + integer(psb_ipk_), intent(out) :: info + end subroutine mld_c_base_onelev_mat_asb + end interface interface subroutine mld_c_base_onelev_build(lv,info,amold,vmold,imold) @@ -498,6 +514,29 @@ contains end subroutine c_base_onelev_default + subroutine c_base_onelev_bld_tprol(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) + implicit none + class(mld_c_onelev_type), intent(inout), target :: lv + type(psb_cspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) + type(psb_cspmat_type), intent(out) :: op_prol + integer(psb_ipk_), intent(out) :: info + + call lv%aggr%bld_tprol(lv%parms,a,desc_a,ilaggr,nlaggr,op_prol,info) + + end subroutine c_base_onelev_bld_tprol + + + subroutine c_base_onelev_update_aggr(lv,lvnext,info) + implicit none + class(mld_c_onelev_type), intent(inout), target :: lv, lvnext + integer(psb_ipk_), intent(out) :: info + + call lv%aggr%update_next(lvnext%aggr,info) + + end subroutine c_base_onelev_update_aggr + subroutine c_base_onelev_clone(lv,lvout,info) diff --git a/mlprec/mld_d_base_aggregator_mod.f90 b/mlprec/mld_d_base_aggregator_mod.f90 index fd231c39..876e36d4 100644 --- a/mlprec/mld_d_base_aggregator_mod.f90 +++ b/mlprec/mld_d_base_aggregator_mod.f90 @@ -97,14 +97,14 @@ module mld_d_base_aggregator_mod type mld_d_base_aggregator_type contains - procedure, pass(ag) :: bld_tprol => mld_d_base_aggregator_build_tprol - procedure, pass(ag) :: mat_asb => mld_d_base_aggregator_mat_asb - procedure, pass(ag) :: update_level => mld_d_base_aggregator_update_level - procedure, pass(ag) :: clone => mld_d_base_aggregator_clone - 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, nopass :: fmt => mld_d_base_aggregator_fmt + procedure, pass(ag) :: bld_tprol => mld_d_base_aggregator_build_tprol + procedure, pass(ag) :: mat_asb => mld_d_base_aggregator_mat_asb + procedure, pass(ag) :: update_next => mld_d_base_aggregator_update_next + procedure, pass(ag) :: clone => mld_d_base_aggregator_clone + 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, nopass :: fmt => mld_d_base_aggregator_fmt end type mld_d_base_aggregator_type @@ -142,7 +142,7 @@ module mld_d_base_aggregator_mod contains - subroutine mld_d_base_aggregator_update_level(ag,agnext,info) + subroutine mld_d_base_aggregator_update_next(ag,agnext,info) implicit none class(mld_d_base_aggregator_type), target, intent(inout) :: ag, agnext integer(psb_ipk_), intent(out) :: info @@ -151,7 +151,7 @@ contains ! Base version does nothing. ! info = 0 - end subroutine mld_d_base_aggregator_update_level + end subroutine mld_d_base_aggregator_update_next subroutine mld_d_base_aggregator_clone(ag,agnext,info) implicit none diff --git a/mlprec/mld_d_inner_mod.f90 b/mlprec/mld_d_inner_mod.f90 index 810d5831..ed052f69 100644 --- a/mlprec/mld_d_inner_mod.f90 +++ b/mlprec/mld_d_inner_mod.f90 @@ -44,7 +44,7 @@ ! The interfaces of the user level routines are defined in mld_prec_mod.f90. ! module mld_d_inner_mod -! use mld_d_prec_type, only : mld_d_prec_type + use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_i_base_vect_type, & & psb_dpk_, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_, & & psb_d_vect_type diff --git a/mlprec/mld_d_onelev_mod.f90 b/mlprec/mld_d_onelev_mod.f90 index 30c7376c..1c5da02a 100644 --- a/mlprec/mld_d_onelev_mod.f90 +++ b/mlprec/mld_d_onelev_mod.f90 @@ -151,6 +151,9 @@ module mld_d_onelev_mod type(psb_dlinmap_type) :: map real(psb_dpk_) :: szratio contains + procedure, pass(lv) :: bld_tprol => d_base_onelev_bld_tprol + procedure, pass(lv) :: mat_asb => mld_d_base_onelev_mat_asb + procedure, pass(lv) :: update_aggr => d_base_onelev_update_aggr procedure, pass(lv) :: bld => mld_d_base_onelev_build procedure, pass(lv) :: clone => d_base_onelev_clone procedure, pass(lv) :: cnv => mld_d_base_onelev_cnv @@ -178,6 +181,7 @@ module mld_d_onelev_mod procedure, pass(lv) :: free_wrk => d_base_onelev_free_wrk procedure, nopass :: stringval => mld_stringval procedure, pass(lv) :: move_alloc => d_base_onelev_move_alloc + end type mld_d_onelev_type type mld_d_onelev_node @@ -191,7 +195,19 @@ module mld_d_onelev_mod & d_base_onelev_get_wrksize, d_base_onelev_allocate_wrk, & & d_base_onelev_free_wrk - + interface + subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) + import :: psb_dspmat_type, psb_desc_type, psb_dpk_, psb_ipk_ + import :: mld_d_onelev_type + implicit none + class(mld_d_onelev_type), intent(inout), target :: lv + type(psb_dspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(inout) :: ilaggr(:),nlaggr(:) + type(psb_dspmat_type), intent(inout) :: op_prol + integer(psb_ipk_), intent(out) :: info + end subroutine mld_d_base_onelev_mat_asb + end interface interface subroutine mld_d_base_onelev_build(lv,info,amold,vmold,imold) @@ -498,6 +514,29 @@ contains end subroutine d_base_onelev_default + subroutine d_base_onelev_bld_tprol(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) + implicit none + class(mld_d_onelev_type), intent(inout), target :: lv + type(psb_dspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) + type(psb_dspmat_type), intent(out) :: op_prol + integer(psb_ipk_), intent(out) :: info + + call lv%aggr%bld_tprol(lv%parms,a,desc_a,ilaggr,nlaggr,op_prol,info) + + end subroutine d_base_onelev_bld_tprol + + + subroutine d_base_onelev_update_aggr(lv,lvnext,info) + implicit none + class(mld_d_onelev_type), intent(inout), target :: lv, lvnext + integer(psb_ipk_), intent(out) :: info + + call lv%aggr%update_next(lvnext%aggr,info) + + end subroutine d_base_onelev_update_aggr + subroutine d_base_onelev_clone(lv,lvout,info) diff --git a/mlprec/mld_s_base_aggregator_mod.f90 b/mlprec/mld_s_base_aggregator_mod.f90 index 3021e19c..79eb9ca7 100644 --- a/mlprec/mld_s_base_aggregator_mod.f90 +++ b/mlprec/mld_s_base_aggregator_mod.f90 @@ -97,14 +97,14 @@ module mld_s_base_aggregator_mod type mld_s_base_aggregator_type contains - procedure, pass(ag) :: bld_tprol => mld_s_base_aggregator_build_tprol - procedure, pass(ag) :: mat_asb => mld_s_base_aggregator_mat_asb - procedure, pass(ag) :: update_level => mld_s_base_aggregator_update_level - procedure, pass(ag) :: clone => mld_s_base_aggregator_clone - 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, nopass :: fmt => mld_s_base_aggregator_fmt + procedure, pass(ag) :: bld_tprol => mld_s_base_aggregator_build_tprol + procedure, pass(ag) :: mat_asb => mld_s_base_aggregator_mat_asb + procedure, pass(ag) :: update_next => mld_s_base_aggregator_update_next + procedure, pass(ag) :: clone => mld_s_base_aggregator_clone + 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, nopass :: fmt => mld_s_base_aggregator_fmt end type mld_s_base_aggregator_type @@ -142,7 +142,7 @@ module mld_s_base_aggregator_mod contains - subroutine mld_s_base_aggregator_update_level(ag,agnext,info) + subroutine mld_s_base_aggregator_update_next(ag,agnext,info) implicit none class(mld_s_base_aggregator_type), target, intent(inout) :: ag, agnext integer(psb_ipk_), intent(out) :: info @@ -151,7 +151,7 @@ contains ! Base version does nothing. ! info = 0 - end subroutine mld_s_base_aggregator_update_level + end subroutine mld_s_base_aggregator_update_next subroutine mld_s_base_aggregator_clone(ag,agnext,info) implicit none diff --git a/mlprec/mld_s_inner_mod.f90 b/mlprec/mld_s_inner_mod.f90 index 73baa6a8..42317490 100644 --- a/mlprec/mld_s_inner_mod.f90 +++ b/mlprec/mld_s_inner_mod.f90 @@ -44,7 +44,7 @@ ! The interfaces of the user level routines are defined in mld_prec_mod.f90. ! module mld_s_inner_mod -! use mld_s_prec_type, only : mld_s_prec_type + use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_i_base_vect_type, & & psb_spk_, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_, & & psb_s_vect_type diff --git a/mlprec/mld_s_onelev_mod.f90 b/mlprec/mld_s_onelev_mod.f90 index baba63cc..0c6b653d 100644 --- a/mlprec/mld_s_onelev_mod.f90 +++ b/mlprec/mld_s_onelev_mod.f90 @@ -151,6 +151,9 @@ module mld_s_onelev_mod type(psb_slinmap_type) :: map real(psb_spk_) :: szratio contains + procedure, pass(lv) :: bld_tprol => s_base_onelev_bld_tprol + procedure, pass(lv) :: mat_asb => mld_s_base_onelev_mat_asb + procedure, pass(lv) :: update_aggr => s_base_onelev_update_aggr procedure, pass(lv) :: bld => mld_s_base_onelev_build procedure, pass(lv) :: clone => s_base_onelev_clone procedure, pass(lv) :: cnv => mld_s_base_onelev_cnv @@ -178,6 +181,7 @@ module mld_s_onelev_mod procedure, pass(lv) :: free_wrk => s_base_onelev_free_wrk procedure, nopass :: stringval => mld_stringval procedure, pass(lv) :: move_alloc => s_base_onelev_move_alloc + end type mld_s_onelev_type type mld_s_onelev_node @@ -191,7 +195,19 @@ module mld_s_onelev_mod & s_base_onelev_get_wrksize, s_base_onelev_allocate_wrk, & & s_base_onelev_free_wrk - + interface + subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) + import :: psb_sspmat_type, psb_desc_type, psb_spk_, psb_ipk_ + import :: mld_s_onelev_type + implicit none + class(mld_s_onelev_type), intent(inout), target :: lv + type(psb_sspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(inout) :: ilaggr(:),nlaggr(:) + type(psb_sspmat_type), intent(inout) :: op_prol + integer(psb_ipk_), intent(out) :: info + end subroutine mld_s_base_onelev_mat_asb + end interface interface subroutine mld_s_base_onelev_build(lv,info,amold,vmold,imold) @@ -498,6 +514,29 @@ contains end subroutine s_base_onelev_default + subroutine s_base_onelev_bld_tprol(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) + implicit none + class(mld_s_onelev_type), intent(inout), target :: lv + type(psb_sspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) + type(psb_sspmat_type), intent(out) :: op_prol + integer(psb_ipk_), intent(out) :: info + + call lv%aggr%bld_tprol(lv%parms,a,desc_a,ilaggr,nlaggr,op_prol,info) + + end subroutine s_base_onelev_bld_tprol + + + subroutine s_base_onelev_update_aggr(lv,lvnext,info) + implicit none + class(mld_s_onelev_type), intent(inout), target :: lv, lvnext + integer(psb_ipk_), intent(out) :: info + + call lv%aggr%update_next(lvnext%aggr,info) + + end subroutine s_base_onelev_update_aggr + subroutine s_base_onelev_clone(lv,lvout,info) diff --git a/mlprec/mld_z_base_aggregator_mod.f90 b/mlprec/mld_z_base_aggregator_mod.f90 index 6f3a8096..b3bd3cf2 100644 --- a/mlprec/mld_z_base_aggregator_mod.f90 +++ b/mlprec/mld_z_base_aggregator_mod.f90 @@ -97,14 +97,14 @@ module mld_z_base_aggregator_mod type mld_z_base_aggregator_type contains - procedure, pass(ag) :: bld_tprol => mld_z_base_aggregator_build_tprol - procedure, pass(ag) :: mat_asb => mld_z_base_aggregator_mat_asb - procedure, pass(ag) :: update_level => mld_z_base_aggregator_update_level - procedure, pass(ag) :: clone => mld_z_base_aggregator_clone - 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, nopass :: fmt => mld_z_base_aggregator_fmt + procedure, pass(ag) :: bld_tprol => mld_z_base_aggregator_build_tprol + procedure, pass(ag) :: mat_asb => mld_z_base_aggregator_mat_asb + procedure, pass(ag) :: update_next => mld_z_base_aggregator_update_next + procedure, pass(ag) :: clone => mld_z_base_aggregator_clone + 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, nopass :: fmt => mld_z_base_aggregator_fmt end type mld_z_base_aggregator_type @@ -142,7 +142,7 @@ module mld_z_base_aggregator_mod contains - subroutine mld_z_base_aggregator_update_level(ag,agnext,info) + subroutine mld_z_base_aggregator_update_next(ag,agnext,info) implicit none class(mld_z_base_aggregator_type), target, intent(inout) :: ag, agnext integer(psb_ipk_), intent(out) :: info @@ -151,7 +151,7 @@ contains ! Base version does nothing. ! info = 0 - end subroutine mld_z_base_aggregator_update_level + end subroutine mld_z_base_aggregator_update_next subroutine mld_z_base_aggregator_clone(ag,agnext,info) implicit none diff --git a/mlprec/mld_z_inner_mod.f90 b/mlprec/mld_z_inner_mod.f90 index e6dcf6ee..b512d3db 100644 --- a/mlprec/mld_z_inner_mod.f90 +++ b/mlprec/mld_z_inner_mod.f90 @@ -44,7 +44,7 @@ ! The interfaces of the user level routines are defined in mld_prec_mod.f90. ! module mld_z_inner_mod -! use mld_z_prec_type, only : mld_z_prec_type + use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_i_base_vect_type, & & psb_dpk_, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_, & & psb_z_vect_type diff --git a/mlprec/mld_z_onelev_mod.f90 b/mlprec/mld_z_onelev_mod.f90 index be8eaaf3..0effdfeb 100644 --- a/mlprec/mld_z_onelev_mod.f90 +++ b/mlprec/mld_z_onelev_mod.f90 @@ -151,6 +151,9 @@ module mld_z_onelev_mod type(psb_zlinmap_type) :: map real(psb_dpk_) :: szratio contains + procedure, pass(lv) :: bld_tprol => z_base_onelev_bld_tprol + procedure, pass(lv) :: mat_asb => mld_z_base_onelev_mat_asb + procedure, pass(lv) :: update_aggr => z_base_onelev_update_aggr procedure, pass(lv) :: bld => mld_z_base_onelev_build procedure, pass(lv) :: clone => z_base_onelev_clone procedure, pass(lv) :: cnv => mld_z_base_onelev_cnv @@ -178,6 +181,7 @@ module mld_z_onelev_mod procedure, pass(lv) :: free_wrk => z_base_onelev_free_wrk procedure, nopass :: stringval => mld_stringval procedure, pass(lv) :: move_alloc => z_base_onelev_move_alloc + end type mld_z_onelev_type type mld_z_onelev_node @@ -191,7 +195,19 @@ module mld_z_onelev_mod & z_base_onelev_get_wrksize, z_base_onelev_allocate_wrk, & & z_base_onelev_free_wrk - + interface + subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) + import :: psb_zspmat_type, psb_desc_type, psb_dpk_, psb_ipk_ + import :: mld_z_onelev_type + implicit none + class(mld_z_onelev_type), intent(inout), target :: lv + type(psb_zspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(inout) :: ilaggr(:),nlaggr(:) + type(psb_zspmat_type), intent(inout) :: op_prol + integer(psb_ipk_), intent(out) :: info + end subroutine mld_z_base_onelev_mat_asb + end interface interface subroutine mld_z_base_onelev_build(lv,info,amold,vmold,imold) @@ -498,6 +514,29 @@ contains end subroutine z_base_onelev_default + subroutine z_base_onelev_bld_tprol(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) + implicit none + class(mld_z_onelev_type), intent(inout), target :: lv + type(psb_zspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) + type(psb_zspmat_type), intent(out) :: op_prol + integer(psb_ipk_), intent(out) :: info + + call lv%aggr%bld_tprol(lv%parms,a,desc_a,ilaggr,nlaggr,op_prol,info) + + end subroutine z_base_onelev_bld_tprol + + + subroutine z_base_onelev_update_aggr(lv,lvnext,info) + implicit none + class(mld_z_onelev_type), intent(inout), target :: lv, lvnext + integer(psb_ipk_), intent(out) :: info + + call lv%aggr%update_next(lvnext%aggr,info) + + end subroutine z_base_onelev_update_aggr + subroutine z_base_onelev_clone(lv,lvout,info)