diff --git a/amgprec/Makefile b/amgprec/Makefile index c7438730..c518fe8e 100644 --- a/amgprec/Makefile +++ b/amgprec/Makefile @@ -17,7 +17,7 @@ DMODOBJS=amg_d_prec_type.o \ amg_d_ainv_solver.o amg_d_base_ainv_mod.o \ amg_d_invk_solver.o amg_d_invt_solver.o amg_d_krm_solver.o \ amg_d_matchboxp_mod.o amg_d_parmatch_aggregator_mod.o \ - amd_d_newmatch_aggregator_mod.o + amg_d_newmatch_aggregator_mod.o SMODOBJS=amg_s_prec_type.o amg_s_ilu_fact_mod.o \ amg_s_inner_mod.o amg_s_ilu_solver.o amg_s_diag_solver.o amg_s_jac_smoother.o amg_s_as_smoother.o \ @@ -127,6 +127,7 @@ amg_d_base_aggregator_mod.o: amg_base_prec_type.o amg_d_parmatch_aggregator_mod.o amg_d_dec_aggregator_mod.o: amg_d_base_aggregator_mod.o amg_d_hybrid_aggregator_mod.o amg_d_symdec_aggregator_mod.o: amg_d_dec_aggregator_mod.o amg_d_parmatch_aggregator_mod.o: amg_d_matchboxp_mod.o +amg_d_newmatch_aggregator_mod.o: amg_d_dec_aggregator_mod.o amg_c_base_aggregator_mod.o: amg_base_prec_type.o amg_c_parmatch_aggregator_mod.o amg_c_dec_aggregator_mod.o: amg_c_base_aggregator_mod.o diff --git a/amgprec/amg_d_newmatch_aggregator_mod.F90 b/amgprec/amg_d_newmatch_aggregator_mod.F90 index b6c4fc97..59ca4c76 100644 --- a/amgprec/amg_d_newmatch_aggregator_mod.F90 +++ b/amgprec/amg_d_newmatch_aggregator_mod.F90 @@ -49,13 +49,13 @@ module amg_d_newmatch_aggregator_mod use amg_d_base_aggregator_mod use iso_c_binding - type, bind(c):: bcm_Vector + type, bind(c):: nwm_Vector type(c_ptr) :: data integer(c_int) :: size integer(c_int) :: owns_data - end type bcm_Vector + end type nwm_Vector - type, bind(c):: bcm_CSRMatrix + type, bind(c):: nwm_CSRMatrix type(c_ptr) :: i type(c_ptr) :: j integer(c_int) :: num_rows @@ -63,7 +63,7 @@ module amg_d_newmatch_aggregator_mod integer(c_int) :: num_nonzeros integer(c_int) :: owns_data type(c_ptr) :: data - end type bcm_CSRMatrix + end type nwm_CSRMatrix type, extends(amg_d_base_aggregator_type) :: amg_d_newmatch_aggregator_type integer(psb_ipk_) :: matching_alg @@ -74,7 +74,7 @@ module amg_d_newmatch_aggregator_mod ! before passing it to the matching ! real(psb_dpk_), allocatable :: w(:), w_nxt(:) - type(bcm_Vector) :: w_c_nxt + type(nwm_Vector) :: w_c_nxt integer(psb_ipk_) :: max_csize integer(psb_ipk_) :: max_nlevels contains @@ -86,7 +86,7 @@ module amg_d_newmatch_aggregator_mod procedure, pass(ag) :: update_next => d_newmatch_aggregator_update_next procedure, pass(ag) :: bld_wnxt => d_newmatch_bld_wnxt procedure, pass(ag) :: bld_default_w => d_bld_default_w - procedure, pass(ag) :: set_c_default_w => d_set_default_bcm_w + procedure, pass(ag) :: set_c_default_w => d_set_default_nwm_w procedure, pass(ag) :: descr => d_newmatch_aggregator_descr procedure, pass(ag) :: clone => d_newmatch_aggregator_clone procedure, pass(ag) :: free => d_newmatch_aggregator_free @@ -219,7 +219,7 @@ contains call ag%set_c_default_w() end subroutine d_bld_default_w - subroutine d_set_default_bcm_w(ag) + subroutine d_set_default_nwm_w(ag) use psb_realloc_mod use iso_c_binding implicit none @@ -231,12 +231,12 @@ contains ag%w_c_nxt%owns_data = 0 if (ag%w_c_nxt%size > 0) call set_cloc(ag%w_nxt, ag%w_c_nxt) - end subroutine d_set_default_bcm_w + end subroutine d_set_default_nwm_w subroutine set_cloc(vect,w_c_nxt) use iso_c_binding real(psb_dpk_), target :: vect(:) - type(bcm_Vector) :: w_c_nxt + type(nwm_Vector) :: w_c_nxt w_c_nxt%data = c_loc(vect) end subroutine set_cloc @@ -355,15 +355,15 @@ contains ! For now we ignore IDX select case(what) - case('BCM_MATCH_ALG') + case('NWM_MATCH_ALG') ag%matching_alg=val - case('BCM_SWEEPS') + case('NWM_SWEEPS') ag%n_sweeps=val - case('BCM_MAX_CSIZE') + case('NWM_MAX_CSIZE') ag%max_csize=val - case('BCM_MAX_NLEVELS') + case('NWM_MAX_NLEVELS') ag%max_nlevels=val - case('BCM_W_SIZE') + case('NWM_W_SIZE') call ag%bld_default_w(val) case default ! Do nothing diff --git a/amgprec/impl/aggregator/Makefile b/amgprec/impl/aggregator/Makefile index d857a3b0..06dec3dd 100644 --- a/amgprec/impl/aggregator/Makefile +++ b/amgprec/impl/aggregator/Makefile @@ -59,7 +59,11 @@ amg_s_parmatch_spmm_bld.o \ amg_s_parmatch_spmm_bld_ov.o \ amg_s_parmatch_unsmth_bld.o \ amg_s_parmatch_smth_bld.o \ -amg_s_parmatch_spmm_bld_inner.o +amg_s_parmatch_spmm_bld_inner.o \ +amg_d_newmatch_aggregator_mat_asb.o \ +amg_d_newmatch_aggregator_mat_bld.o \ +amg_d_newmatch_aggregator_tprol.o \ +amg_d_newmatch_map_to_tprol.o MPCOBJS=MatchBoxPC.o \ algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o diff --git a/amgprec/impl/aggregator/mld_d_bcmatch_aggregator_mat_asb.f90 b/amgprec/impl/aggregator/amg_d_newmatch_aggregator_mat_asb.f90 similarity index 59% rename from amgprec/impl/aggregator/mld_d_bcmatch_aggregator_mat_asb.f90 rename to amgprec/impl/aggregator/amg_d_newmatch_aggregator_mat_asb.f90 index 92609a14..7d3a29d8 100644 --- a/amgprec/impl/aggregator/mld_d_bcmatch_aggregator_mat_asb.f90 +++ b/amgprec/impl/aggregator/amg_d_newmatch_aggregator_mat_asb.f90 @@ -1,52 +1,17 @@ -! -! -! MLD2P4 version 2.2 -! 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_bcmatch_aggregator_mat_asb.f90 +! File: amg_d_newmatch_aggregator_mat_asb.f90 ! -! Subroutine: mld_d_bcmatch_aggregator_mat_asb +! Subroutine: amg_d_newmatch_aggregator_mat_asb ! Version: real ! ! ! From a given AC to final format, generating DESC_AC ! ! Arguments: -! ag - type(mld_d_bcmatch_aggregator_type), input/output. +! ag - type(amg_d_newmatch_aggregator_type), input/output. ! The aggregator object -! parms - type(mld_dml_parms), input +! parms - type(amg_dml_parms), input ! The aggregation parameters ! a - type(psb_dspmat_type), input. ! The sparse matrix structure containing the local part of @@ -83,27 +48,28 @@ ! info - integer, output. ! Error code. ! -subroutine mld_d_bcmatch_aggregator_mat_asb(ag,parms,a,desc_a,& +subroutine amg_d_newmatch_aggregator_mat_asb(ag,parms,a,desc_a,& & ac,desc_ac, op_prol,op_restr,info) use psb_base_mod - use mld_base_prec_type - use mld_d_bcmatch_aggregator_mod, mld_protect_name => mld_d_bcmatch_aggregator_mat_asb + use amg_base_prec_type + use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_aggregator_mat_asb implicit none - class(mld_d_bcmatch_aggregator_type), target, intent(inout) :: ag - type(mld_dml_parms), intent(inout) :: parms + class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag + type(amg_dml_parms), intent(inout) :: parms type(psb_dspmat_type), intent(in) :: a type(psb_desc_type), intent(inout) :: desc_a type(psb_dspmat_type), intent(inout) :: op_prol, ac,op_restr type(psb_desc_type), intent(inout) :: desc_ac integer(psb_ipk_), intent(out) :: info ! - integer(psb_ipk_) :: ictxt, np, me - type(psb_ld_coo_sparse_mat) :: tmpcoo - type(psb_ldspmat_type) :: tmp_ac - integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl - integer(psb_lpk_) :: ntaggr + type(psb_ctxt_type) :: ctxt + integer(psb_ipk_) :: np, me + type(psb_ld_coo_sparse_mat) :: tmpcoo + type(psb_ldspmat_type) :: tmp_ac + integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl + integer(psb_lpk_) :: ntaggr integer(psb_ipk_) :: err_act, debug_level, debug_unit - character(len=20) :: name='d_bcmatch_aggregator_mat_asb' + character(len=20) :: name='d_newmatch_aggregator_mat_asb' if (psb_get_errstatus().ne.0) return @@ -111,12 +77,12 @@ subroutine mld_d_bcmatch_aggregator_mat_asb(ag,parms,a,desc_a,& 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) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) select case(parms%coarse_mat) - case(mld_distr_mat_) + case(amg_distr_mat_) call ac%cscnv(info,type='csr') call op_prol%cscnv(info,type='csr') @@ -126,7 +92,7 @@ subroutine mld_d_bcmatch_aggregator_mat_asb(ag,parms,a,desc_a,& & write(debug_unit,*) me,' ',trim(name),& & 'Done ac ' - case(mld_repl_mat_) + case(amg_repl_mat_) ! ! We are assuming here that an d matrix ! can hold all entries @@ -136,7 +102,7 @@ subroutine mld_d_bcmatch_aggregator_mat_asb(ag,parms,a,desc_a,& i_nr = ntaggr else info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') + call psb_errpush(info,name,a_err='invalid amg_coarse_mat_') goto 9999 end if @@ -158,7 +124,7 @@ subroutine mld_d_bcmatch_aggregator_mat_asb(ag,parms,a,desc_a,& call tmp_ac%mv_to(tmpcoo) call ac%mv_from(tmpcoo) - call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.) + call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.) if (info == psb_success_) call psb_cdasb(desc_ac,info) ! ! Now that we have the descriptors and the restrictor, we should @@ -170,7 +136,7 @@ subroutine mld_d_bcmatch_aggregator_mat_asb(ag,parms,a,desc_a,& case default info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') + call psb_errpush(info,name,a_err='invalid amg_coarse_mat_') goto 9999 end select @@ -181,4 +147,4 @@ subroutine mld_d_bcmatch_aggregator_mat_asb(ag,parms,a,desc_a,& return -end subroutine mld_d_bcmatch_aggregator_mat_asb +end subroutine amg_d_newmatch_aggregator_mat_asb diff --git a/amgprec/impl/aggregator/mld_d_bcmatch_aggregator_mat_bld.f90 b/amgprec/impl/aggregator/amg_d_newmatch_aggregator_mat_bld.f90 similarity index 65% rename from amgprec/impl/aggregator/mld_d_bcmatch_aggregator_mat_bld.f90 rename to amgprec/impl/aggregator/amg_d_newmatch_aggregator_mat_bld.f90 index 6ea944c1..e3e49769 100644 --- a/amgprec/impl/aggregator/mld_d_bcmatch_aggregator_mat_bld.f90 +++ b/amgprec/impl/aggregator/amg_d_newmatch_aggregator_mat_bld.f90 @@ -1,40 +1,8 @@ ! -! -! MLD2P4 Extensions -! -! (C) Copyright 2019 -! -! Salvatore Filippone Cranfield University -! Pasqua D'Ambra IAC-CNR, Naples, IT -! -! 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_base_aggregator_mat_bld.f90 +! File: amg_d_base_aggregator_mat_bld.f90 ! -! Subroutine: mld_d_base_aggregator_mat_bld +! Subroutine: amg_d_base_aggregator_mat_bld ! Version: real ! ! This routine builds the matrix associated to the current level of the @@ -44,7 +12,7 @@ ! 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. +! by amg_mlprec_bld, only on levels >=2. ! The coarse-level matrix A_C is built from a fine-level matrix A ! by using the Galerkin approach, i.e. ! @@ -53,13 +21,13 @@ ! 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. +! adjacency graph of A_C has been computed by the amg_aggrmap_bld subroutine. ! The prolongator P_C is built here from this mapping, according to the -! value of p%iprcparm(mld_aggr_kind_), specified by the user through -! mld_dprecinit and mld_zprecset. +! value of p%iprcparm(amg_aggr_kind_), specified by the user through +! amg_dprecinit and amg_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_bld. +! amg_d_lev_aggrmat_bld. ! ! Currently four different prolongators are implemented, corresponding to ! four aggregation algorithms: @@ -93,9 +61,9 @@ ! ! ! Arguments: -! ag - type(mld_d_base_aggregator_type), input/output. +! ag - type(amg_d_base_aggregator_type), input/output. ! The aggregator object -! parms - type(mld_dml_parms), input +! parms - type(amg_dml_parms), input ! The aggregation parameters ! a - type(psb_dspmat_type), input. ! The sparse matrix structure containing the local part of @@ -127,16 +95,16 @@ ! info - integer, output. ! Error code. ! -subroutine mld_d_bcmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,& +subroutine amg_d_newmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,& & ac,desc_ac,op_prol,op_restr,t_prol,info) use psb_base_mod - use mld_d_inner_mod - use mld_d_prec_type - use mld_d_bcmatch_aggregator_mod, mld_protect_name => mld_d_bcmatch_aggregator_mat_bld + use amg_d_inner_mod + use amg_d_prec_type + use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_aggregator_mat_bld implicit none - class(mld_d_bcmatch_aggregator_type), target, intent(inout) :: ag - type(mld_dml_parms), intent(inout) :: parms + class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag + type(amg_dml_parms), intent(inout) :: parms type(psb_dspmat_type), intent(in) :: a type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) @@ -147,49 +115,50 @@ subroutine mld_d_bcmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,& ! Local variables character(len=20) :: name - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ctxt + integer(psb_mpk_) :: np, me type(psb_ld_coo_sparse_mat) :: acoo, bcoo type(psb_ld_csr_sparse_mat) :: acsr1 integer(psb_lpk_) :: nzl,ntaggr integer(psb_ipk_) :: err_act integer(psb_ipk_) :: debug_level, debug_unit - name='mld_d_bcmatch_aggregator_mat_bld' + name='amg_d_newmatch_aggregator_mat_bld' 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) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) ! ! Build the coarse-level matrix from the fine-level one, starting from - ! the mapping defined by mld_aggrmap_bld and applying the aggregation + ! the mapping defined by amg_aggrmap_bld and applying the aggregation ! algorithm specified by ! select case (parms%aggr_prol) - case (mld_no_smooth_) + case (amg_no_smooth_) -!!$ call mld_d_bcmatch_unsmth_spmm_bld(a,desc_a,ilaggr,nlaggr,& +!!$ call amg_d_newmatch_unsmth_spmm_bld(a,desc_a,ilaggr,nlaggr,& !!$ & parms,ac,desc_ac,op_prol,op_restr,t_prol,info) - call mld_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr, & + call amg_daggrmat_nosmth_bld(a,desc_a,ilaggr,nlaggr, & & parms,ac,desc_ac,op_prol,op_restr,t_prol,info) - case(mld_smooth_prol_) + case(amg_smooth_prol_) - call mld_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr, & + call amg_daggrmat_smth_bld(a,desc_a,ilaggr,nlaggr, & & parms,ac,desc_ac,op_prol,op_restr,t_prol,info) -!!$ case(mld_biz_prol_) +!!$ case(amg_biz_prol_) !!$ -!!$ call mld_daggrmat_biz_bld(a,desc_a,ilaggr,nlaggr, & +!!$ call amg_daggrmat_biz_bld(a,desc_a,ilaggr,nlaggr, & !!$ & parms,ac,desc_ac,op_prol,op_restr,info) - case(mld_min_energy_) + case(amg_min_energy_) - call mld_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr, & + call amg_daggrmat_minnrg_bld(a,desc_a,ilaggr,nlaggr, & & parms,ac,desc_ac,op_prol,op_restr,t_prol,info) case default @@ -211,4 +180,4 @@ subroutine mld_d_bcmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,& return -end subroutine mld_d_bcmatch_aggregator_mat_bld +end subroutine amg_d_newmatch_aggregator_mat_bld diff --git a/amgprec/impl/aggregator/mld_d_bcmatch_aggregator_tprol.f90 b/amgprec/impl/aggregator/amg_d_newmatch_aggregator_tprol.f90 similarity index 55% rename from amgprec/impl/aggregator/mld_d_bcmatch_aggregator_tprol.f90 rename to amgprec/impl/aggregator/amg_d_newmatch_aggregator_tprol.f90 index 941dd05e..290f9796 100644 --- a/amgprec/impl/aggregator/mld_d_bcmatch_aggregator_tprol.f90 +++ b/amgprec/impl/aggregator/amg_d_newmatch_aggregator_tprol.f90 @@ -1,55 +1,23 @@ ! -! -! MLD2P4 Extensions -! -! (C) Copyright 2019 -! -! Salvatore Filippone Cranfield University -! Pasqua D'Ambra IAC-CNR, Naples, IT -! -! 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_bcmatch_aggregator_tprol.f90 +! File: amg_d_newmatch_aggregator_tprol.f90 ! -! Subroutine: mld_d_bcmatch_aggregator_tprol +! Subroutine: amg_d_newmatch_aggregator_tprol ! Version: real ! ! -subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,ag_data,& +subroutine amg_d_newmatch_aggregator_build_tprol(ag,parms,ag_data,& & a,desc_a,ilaggr,nlaggr,op_prol,info) use psb_base_mod - use mld_d_prec_type - use mld_d_bcmatch_aggregator_mod, mld_protect_name => mld_d_bcmatch_aggregator_build_tprol - use mld_d_inner_mod + use amg_d_prec_type + use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_aggregator_build_tprol + use amg_d_inner_mod use iso_c_binding implicit none - class(mld_d_bcmatch_aggregator_type), target, intent(inout) :: ag - type(mld_dml_parms), intent(inout) :: parms - type(mld_daggr_data), intent(in) :: ag_data + class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag + type(amg_dml_parms), intent(inout) :: parms + type(amg_daggr_data), intent(in) :: ag_data type(psb_dspmat_type), intent(inout) :: a type(psb_desc_type), intent(inout) :: desc_a integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) @@ -60,10 +28,11 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,ag_data,& ! Local variables real(psb_dpk_), allocatable:: valaggr(:) type(psb_dspmat_type) :: a_tmp - type(bcm_CSRMatrix) :: C, P + type(nwm_CSRMatrix) :: C, P integer(c_int) :: match_algorithm, n_sweeps, max_csize, max_nlevels character(len=20) :: name, ch_err - integer(psb_mpk_) :: ictxt, np, me + type(psb_ctxt_type) :: ctxt + integer(psb_mpk_) :: np, me integer(psb_ipk_) :: err_act, ierr integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: i, j, k, nr, nc, isz, num_pcols @@ -77,8 +46,8 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,ag_data,& use iso_c_binding import implicit none - type(bcm_CSRMatrix) :: C, P - type(bcm_Vector) :: w + type(nwm_CSRMatrix) :: C, P + type(nwm_Vector) :: w integer(c_int) :: match_alg integer(c_int) :: n_sweeps integer(c_int) :: max_nlevels @@ -87,14 +56,14 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,ag_data,& end interface interface - function mld_bootCMatch_if(C,match_alg,n_sweeps,max_nlevels,max_csize,& + function amg_bootCMatch_if(C,match_alg,n_sweeps,max_nlevels,max_csize,& & w,isz,ilaggr,valaggr, num_cols) & - & bind(c,name='mld_bootCMatch_if') result(iret) + & bind(c,name='amg_bootCMatch_if') result(iret) use iso_c_binding import implicit none - type(bcm_CSRMatrix) :: C, P - type(bcm_Vector) :: w + type(nwm_CSRMatrix) :: C, P + type(nwm_Vector) :: w integer(c_int), value :: match_alg integer(c_int), value :: n_sweeps integer(c_int), value :: max_nlevels @@ -104,12 +73,12 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,ag_data,& integer(c_int) :: ilaggr(*) real(c_double) :: valaggr(*) integer(c_int) :: iret - end function mld_bootCMatch_if + end function amg_bootCMatch_if end interface - name='mld_d_bcmatch_aggregator_tprol' - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + name='amg_d_newmatch_aggregator_tprol' + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) if (psb_get_errstatus().ne.0) return call psb_erractionsave(err_act) debug_unit = psb_get_debug_unit() @@ -117,13 +86,13 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,ag_data,& info = psb_success_ - 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) + call amg_check_def(parms%ml_cycle,'Multilevel cycle',& + & amg_mult_ml_,is_legal_ml_cycle) + call amg_check_def(parms%par_aggr_alg,'Aggregation',& + & amg_dec_aggr_,is_legal_decoupled_par_aggr_alg) + call amg_check_def(parms%aggr_ord,'Ordering',& + & amg_aggr_ord_nat_,is_legal_ml_aggr_ord) + call amg_check_def(parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs) call a%csclip(b=a_tmp, info=info, jmax=a%get_nrows(), imax=a%get_nrows()) @@ -167,11 +136,11 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,ag_data,& max_nlevels = ag_data%max_levs end if - info = mld_bootCMatch_if(C,match_algorithm,n_sweeps,max_nlevels,max_csize,& + info = amg_bootCMatch_if(C,match_algorithm,n_sweeps,max_nlevels,max_csize,& & ag%w_c_nxt, isz, c_ilaggr, valaggr, num_pcols) if (info /= psb_success_) then !!$ write(0,*) 'On return from bootCMatch_if:',info - call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_bootCMatch_if') + call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_bootCMatch_if') goto 9999 end if ilaggr(1:nr) = c_ilaggr(1:nr) @@ -191,12 +160,12 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,ag_data,& nlaggr(:)=0 nlaggr(me+1) = num_pcols - call psb_sum(ictxt,nlaggr(1:np)) + call psb_sum(ctxt,nlaggr(1:np)) - call mld_d_bcmatch_map_to_tprol(desc_a,ilaggr,nlaggr,valaggr,op_prol,info) + call amg_d_newmatch_map_to_tprol(desc_a,ilaggr,nlaggr,valaggr,op_prol,info) if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_bcmatch_map_to_tprol') + call psb_errpush(psb_err_from_subroutine_,name,a_err='amg_newmatch_map_to_tprol') goto 9999 end if @@ -206,4 +175,4 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,ag_data,& 9999 call psb_error_handler(err_act) return -end subroutine mld_d_bcmatch_aggregator_build_tprol +end subroutine amg_d_newmatch_aggregator_build_tprol diff --git a/amgprec/impl/aggregator/mld_d_bcmatch_map_to_tprol.f90 b/amgprec/impl/aggregator/amg_d_newmatch_map_to_tprol.f90 similarity index 61% rename from amgprec/impl/aggregator/mld_d_bcmatch_map_to_tprol.f90 rename to amgprec/impl/aggregator/amg_d_newmatch_map_to_tprol.f90 index 2ab92c4f..668e2ba5 100644 --- a/amgprec/impl/aggregator/mld_d_bcmatch_map_to_tprol.f90 +++ b/amgprec/impl/aggregator/amg_d_newmatch_map_to_tprol.f90 @@ -1,40 +1,8 @@ ! -! -! MLD2P4 Extensions -! -! (C) Copyright 2019 -! -! Salvatore Filippone Cranfield University -! Pasqua D'Ambra IAC-CNR, Naples, IT -! -! 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_bcmatch_map_to_tprol.f90 +! File: amg_d_newmatch_map_to_tprol.f90 ! -! Subroutine: mld_d_bcmatch_map_to_tprol +! Subroutine: amg_d_newmatch_map_to_tprol ! Version: real ! ! This routine uses a mapping from the row indices of the fine-level matrix @@ -82,11 +50,11 @@ ! info - integer, output. ! Error code. ! -subroutine mld_d_bcmatch_map_to_tprol(desc_a,ilaggr,nlaggr,valaggr, op_prol,info) +subroutine amg_d_newmatch_map_to_tprol(desc_a,ilaggr,nlaggr,valaggr, op_prol,info) use psb_base_mod - use mld_d_inner_mod!, mld_protect_name => mld_d_bcmatch_map_to_tprol - use mld_d_bcmatch_aggregator_mod, mld_protect_name => mld_d_bcmatch_map_to_tprol + use amg_d_inner_mod!, amg_protect_name => amg_d_newmatch_map_to_tprol + use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_map_to_tprol implicit none @@ -98,22 +66,23 @@ subroutine mld_d_bcmatch_map_to_tprol(desc_a,ilaggr,nlaggr,valaggr, op_prol,info integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_lpk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m,naggrm1, naggrp1, ntaggr + integer(psb_lpk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m,naggrm1, naggrp1, ntaggr type(psb_ld_coo_sparse_mat) :: tmpcoo - integer(psb_ipk_) :: debug_level, debug_unit,err_act - integer(psb_ipk_) :: ictxt,np,me - integer(psb_lpk_) :: nrow, ncol, n_ne - character(len=20) :: name, ch_err + integer(psb_ipk_) :: debug_level, debug_unit,err_act + type(psb_ctxt_type) :: ctxt + integer(psb_ipk_) :: np, me + integer(psb_lpk_) :: nrow, ncol, n_ne + character(len=20) :: name, ch_err if(psb_get_errstatus() /= 0) return info=psb_success_ - name = 'mld_d_bcmatch_map_to_tprol' + name = 'amg_d_newmatch_map_to_tprol' 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) + ctxt=desc_a%get_context() + call psb_info(ctxt,me,np) nrow = desc_a%get_local_rows() ncol = desc_a%get_local_cols() @@ -156,4 +125,4 @@ subroutine mld_d_bcmatch_map_to_tprol(desc_a,ilaggr,nlaggr,valaggr, op_prol,info return -end subroutine mld_d_bcmatch_map_to_tprol +end subroutine amg_d_newmatch_map_to_tprol