fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Start work on interfacing new matching

Browse Source
TestFerdous
Salvatore Filippone 3 years ago
parent 2396123b44
commit 9ab599367b
7 changed files with 126 additions and 248 deletions
Show Stats Download Patch File Download Diff File

3
amgprec/Makefile
Unescape Escape View File

@ -17,7 +17,7 @@ DMODOBJS=amg_d_prec_type.o \
amg_d_ainv_solver.o amg_d_base_ainv_mod.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_invk_solver.o amg_d_invt_solver.o amg_d_krm_solver.o \
amg_d_matchboxp_mod.o amg_d_parmatch_aggregator_mod.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 \ 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 \ 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_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_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_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_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 amg_c_parmatch_aggregator_mod.o amg_c_dec_aggregator_mod.o: amg_c_base_aggregator_mod.o

28
amgprec/amg_d_newmatch_aggregator_mod.F90
Unescape Escape View File

@ -49,13 +49,13 @@ module amg_d_newmatch_aggregator_mod
use amg_d_base_aggregator_mod use amg_d_base_aggregator_mod
use iso_c_binding use iso_c_binding
type, bind(c):: bcm_Vector type, bind(c):: nwm_Vector
type(c_ptr) :: data type(c_ptr) :: data
integer(c_int) :: size integer(c_int) :: size
integer(c_int) :: owns_data 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) :: i
type(c_ptr) :: j type(c_ptr) :: j
integer(c_int) :: num_rows integer(c_int) :: num_rows
@ -63,7 +63,7 @@ module amg_d_newmatch_aggregator_mod
integer(c_int) :: num_nonzeros integer(c_int) :: num_nonzeros
integer(c_int) :: owns_data integer(c_int) :: owns_data
type(c_ptr) :: 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 type, extends(amg_d_base_aggregator_type) :: amg_d_newmatch_aggregator_type
integer(psb_ipk_) :: matching_alg integer(psb_ipk_) :: matching_alg
@ -74,7 +74,7 @@ module amg_d_newmatch_aggregator_mod
! before passing it to the matching ! before passing it to the matching
! !
real(psb_dpk_), allocatable :: w(:), w_nxt(:) 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_csize
integer(psb_ipk_) :: max_nlevels integer(psb_ipk_) :: max_nlevels
contains contains
@ -86,7 +86,7 @@ module amg_d_newmatch_aggregator_mod
procedure, pass(ag) :: update_next => d_newmatch_aggregator_update_next procedure, pass(ag) :: update_next => d_newmatch_aggregator_update_next
procedure, pass(ag) :: bld_wnxt => d_newmatch_bld_wnxt procedure, pass(ag) :: bld_wnxt => d_newmatch_bld_wnxt
procedure, pass(ag) :: bld_default_w => d_bld_default_w 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) :: descr => d_newmatch_aggregator_descr
procedure, pass(ag) :: clone => d_newmatch_aggregator_clone procedure, pass(ag) :: clone => d_newmatch_aggregator_clone
procedure, pass(ag) :: free => d_newmatch_aggregator_free procedure, pass(ag) :: free => d_newmatch_aggregator_free
@ -219,7 +219,7 @@ contains
call ag%set_c_default_w() call ag%set_c_default_w()
end subroutine d_bld_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 psb_realloc_mod
use iso_c_binding use iso_c_binding
implicit none implicit none
@ -231,12 +231,12 @@ contains
ag%w_c_nxt%owns_data = 0 ag%w_c_nxt%owns_data = 0
if (ag%w_c_nxt%size > 0) call set_cloc(ag%w_nxt, ag%w_c_nxt) 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) subroutine set_cloc(vect,w_c_nxt)
use iso_c_binding use iso_c_binding
real(psb_dpk_), target :: vect(:) real(psb_dpk_), target :: vect(:)
type(bcm_Vector) :: w_c_nxt type(nwm_Vector) :: w_c_nxt
w_c_nxt%data = c_loc(vect) w_c_nxt%data = c_loc(vect)
end subroutine set_cloc end subroutine set_cloc
@ -355,15 +355,15 @@ contains
! For now we ignore IDX ! For now we ignore IDX
select case(what) select case(what)
case('BCM_MATCH_ALG') case('NWM_MATCH_ALG')
ag%matching_alg=val ag%matching_alg=val
case('BCM_SWEEPS') case('NWM_SWEEPS')
ag%n_sweeps=val ag%n_sweeps=val
case('BCM_MAX_CSIZE') case('NWM_MAX_CSIZE')
ag%max_csize=val ag%max_csize=val
case('BCM_MAX_NLEVELS') case('NWM_MAX_NLEVELS')
ag%max_nlevels=val ag%max_nlevels=val
case('BCM_W_SIZE') case('NWM_W_SIZE')
call ag%bld_default_w(val) call ag%bld_default_w(val)
case default case default
! Do nothing ! Do nothing

6
amgprec/impl/aggregator/Makefile
Unescape Escape View File

@ -59,7 +59,11 @@ amg_s_parmatch_spmm_bld.o \
amg_s_parmatch_spmm_bld_ov.o \ amg_s_parmatch_spmm_bld_ov.o \
amg_s_parmatch_unsmth_bld.o \ amg_s_parmatch_unsmth_bld.o \
amg_s_parmatch_smth_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 \ MPCOBJS=MatchBoxPC.o \
algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o algoDistEdgeApproxDomEdgesLinearSearchMesgBndlSmallMateC.o

74
amgprec/impl/aggregator/mld_d_bcmatch_aggregator_mat_asb.f90 → amgprec/impl/aggregator/amg_d_newmatch_aggregator_mat_asb.f90
Unescape Escape View File

@ -1,52 +1,17 @@
! !
! !
! MLD2P4 version 2.2 ! File: amg_d_newmatch_aggregator_mat_asb.f90
! MultiLevel Domain Decomposition Parallel Preconditioners Package
! based on PSBLAS (Parallel Sparse BLAS version 3.5)
! !
! (C) Copyright 2008-2018 ! Subroutine: amg_d_newmatch_aggregator_mat_asb
!
! 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
!
! Subroutine: mld_d_bcmatch_aggregator_mat_asb
! Version: real ! Version: real
! !
! !
! From a given AC to final format, generating DESC_AC ! From a given AC to final format, generating DESC_AC
! !
! Arguments: ! Arguments:
! ag - type(mld_d_bcmatch_aggregator_type), input/output. ! ag - type(amg_d_newmatch_aggregator_type), input/output.
! The aggregator object ! The aggregator object
! parms - type(mld_dml_parms), input ! parms - type(amg_dml_parms), input
! The aggregation parameters ! The aggregation parameters
! a - type(psb_dspmat_type), input. ! a - type(psb_dspmat_type), input.
! The sparse matrix structure containing the local part of ! The sparse matrix structure containing the local part of
@ -83,27 +48,28 @@
! info - integer, output. ! info - integer, output.
! Error code. ! 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) & ac,desc_ac, op_prol,op_restr,info)
use psb_base_mod use psb_base_mod
use mld_base_prec_type use amg_base_prec_type
use mld_d_bcmatch_aggregator_mod, mld_protect_name => mld_d_bcmatch_aggregator_mat_asb use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_aggregator_mat_asb
implicit none implicit none
class(mld_d_bcmatch_aggregator_type), target, intent(inout) :: ag class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
type(mld_dml_parms), intent(inout) :: parms type(amg_dml_parms), intent(inout) :: parms
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
type(psb_dspmat_type), intent(inout) :: op_prol, ac,op_restr type(psb_dspmat_type), intent(inout) :: op_prol, ac,op_restr
type(psb_desc_type), intent(inout) :: desc_ac type(psb_desc_type), intent(inout) :: desc_ac
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
! !
integer(psb_ipk_) :: ictxt, np, me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
type(psb_ld_coo_sparse_mat) :: tmpcoo type(psb_ld_coo_sparse_mat) :: tmpcoo
type(psb_ldspmat_type) :: tmp_ac type(psb_ldspmat_type) :: tmp_ac
integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl integer(psb_ipk_) :: i_nr, i_nc, i_nl, nzl
integer(psb_lpk_) :: ntaggr integer(psb_lpk_) :: ntaggr
integer(psb_ipk_) :: err_act, debug_level, debug_unit 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 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_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
select case(parms%coarse_mat) select case(parms%coarse_mat)
case(mld_distr_mat_) case(amg_distr_mat_)
call ac%cscnv(info,type='csr') call ac%cscnv(info,type='csr')
call op_prol%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),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done ac ' & 'Done ac '
case(mld_repl_mat_) case(amg_repl_mat_)
! !
! We are assuming here that an d matrix ! We are assuming here that an d matrix
! can hold all entries ! can hold all entries
@ -136,7 +102,7 @@ subroutine mld_d_bcmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
i_nr = ntaggr i_nr = ntaggr
else else
info = psb_err_internal_error_ 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 goto 9999
end if 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 tmp_ac%mv_to(tmpcoo)
call ac%mv_from(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) if (info == psb_success_) call psb_cdasb(desc_ac,info)
! !
! Now that we have the descriptors and the restrictor, we should ! 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 case default
info = psb_err_internal_error_ 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 goto 9999
end select end select
@ -181,4 +147,4 @@ subroutine mld_d_bcmatch_aggregator_mat_asb(ag,parms,a,desc_a,&
return return
end subroutine mld_d_bcmatch_aggregator_mat_asb end subroutine amg_d_newmatch_aggregator_mat_asb

95
amgprec/impl/aggregator/mld_d_bcmatch_aggregator_mat_bld.f90 → amgprec/impl/aggregator/amg_d_newmatch_aggregator_mat_bld.f90
Unescape Escape View File

@ -1,40 +1,8 @@
! !
! !
! MLD2P4 Extensions ! File: amg_d_base_aggregator_mat_bld.f90
! !
! (C) Copyright 2019 ! Subroutine: amg_d_base_aggregator_mat_bld
!
! 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
!
! Subroutine: mld_d_base_aggregator_mat_bld
! Version: real ! Version: real
! !
! This routine builds the matrix associated to the current level of the ! This routine builds the matrix associated to the current level of the
@ -44,7 +12,7 @@
! previous one and vice versa). ! previous one and vice versa).
! The current level is regarded as the coarse one, while the previous as ! 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, ! 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 ! The coarse-level matrix A_C is built from a fine-level matrix A
! by using the Galerkin approach, i.e. ! 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. ! 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 ! 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 ! 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 ! value of p%iprcparm(amg_aggr_kind_), specified by the user through
! mld_dprecinit and mld_zprecset. ! amg_dprecinit and amg_zprecset.
! On output from this routine the entries of AC, op_prol, op_restr ! 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 ! 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 ! Currently four different prolongators are implemented, corresponding to
! four aggregation algorithms: ! four aggregation algorithms:
@ -93,9 +61,9 @@
! !
! !
! Arguments: ! Arguments:
! ag - type(mld_d_base_aggregator_type), input/output. ! ag - type(amg_d_base_aggregator_type), input/output.
! The aggregator object ! The aggregator object
! parms - type(mld_dml_parms), input ! parms - type(amg_dml_parms), input
! The aggregation parameters ! The aggregation parameters
! a - type(psb_dspmat_type), input. ! a - type(psb_dspmat_type), input.
! The sparse matrix structure containing the local part of ! The sparse matrix structure containing the local part of
@ -127,16 +95,16 @@
! info - integer, output. ! info - integer, output.
! Error code. ! 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) & ac,desc_ac,op_prol,op_restr,t_prol,info)
use psb_base_mod use psb_base_mod
use mld_d_inner_mod use amg_d_inner_mod
use mld_d_prec_type use amg_d_prec_type
use mld_d_bcmatch_aggregator_mod, mld_protect_name => mld_d_bcmatch_aggregator_mat_bld use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_aggregator_mat_bld
implicit none implicit none
class(mld_d_bcmatch_aggregator_type), target, intent(inout) :: ag class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
type(mld_dml_parms), intent(inout) :: parms type(amg_dml_parms), intent(inout) :: parms
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) 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 ! Local variables
character(len=20) :: name 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_coo_sparse_mat) :: acoo, bcoo
type(psb_ld_csr_sparse_mat) :: acsr1 type(psb_ld_csr_sparse_mat) :: acsr1
integer(psb_lpk_) :: nzl,ntaggr integer(psb_lpk_) :: nzl,ntaggr
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: debug_level, debug_unit 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 if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
! !
! Build the coarse-level matrix from the fine-level one, starting from ! 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 ! algorithm specified by
! !
select case (parms%aggr_prol) 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) !!$ & 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) & 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) & 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) !!$ & 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) & parms,ac,desc_ac,op_prol,op_restr,t_prol,info)
case default case default
@ -211,4 +180,4 @@ subroutine mld_d_bcmatch_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,&
return return
end subroutine mld_d_bcmatch_aggregator_mat_bld end subroutine amg_d_newmatch_aggregator_mat_bld

101
amgprec/impl/aggregator/mld_d_bcmatch_aggregator_tprol.f90 → amgprec/impl/aggregator/amg_d_newmatch_aggregator_tprol.f90
Unescape Escape View File

@ -1,55 +1,23 @@
! !
! !
! MLD2P4 Extensions ! File: amg_d_newmatch_aggregator_tprol.f90
! !
! (C) Copyright 2019 ! Subroutine: amg_d_newmatch_aggregator_tprol
!
! 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
!
! Subroutine: mld_d_bcmatch_aggregator_tprol
! Version: real ! 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) & a,desc_a,ilaggr,nlaggr,op_prol,info)
use psb_base_mod use psb_base_mod
use mld_d_prec_type use amg_d_prec_type
use mld_d_bcmatch_aggregator_mod, mld_protect_name => mld_d_bcmatch_aggregator_build_tprol use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_aggregator_build_tprol
use mld_d_inner_mod use amg_d_inner_mod
use iso_c_binding use iso_c_binding
implicit none implicit none
class(mld_d_bcmatch_aggregator_type), target, intent(inout) :: ag class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
type(mld_dml_parms), intent(inout) :: parms type(amg_dml_parms), intent(inout) :: parms
type(mld_daggr_data), intent(in) :: ag_data type(amg_daggr_data), intent(in) :: ag_data
type(psb_dspmat_type), intent(inout) :: a type(psb_dspmat_type), intent(inout) :: a
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), allocatable, intent(out) :: ilaggr(:),nlaggr(:) 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 ! Local variables
real(psb_dpk_), allocatable:: valaggr(:) real(psb_dpk_), allocatable:: valaggr(:)
type(psb_dspmat_type) :: a_tmp 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 integer(c_int) :: match_algorithm, n_sweeps, max_csize, max_nlevels
character(len=20) :: name, ch_err 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_) :: err_act, ierr
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: i, j, k, nr, nc, isz, num_pcols 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 use iso_c_binding
import import
implicit none implicit none
type(bcm_CSRMatrix) :: C, P type(nwm_CSRMatrix) :: C, P
type(bcm_Vector) :: w type(nwm_Vector) :: w
integer(c_int) :: match_alg integer(c_int) :: match_alg
integer(c_int) :: n_sweeps integer(c_int) :: n_sweeps
integer(c_int) :: max_nlevels integer(c_int) :: max_nlevels
@ -87,14 +56,14 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,ag_data,&
end interface end interface
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) & & 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 use iso_c_binding
import import
implicit none implicit none
type(bcm_CSRMatrix) :: C, P type(nwm_CSRMatrix) :: C, P
type(bcm_Vector) :: w type(nwm_Vector) :: w
integer(c_int), value :: match_alg integer(c_int), value :: match_alg
integer(c_int), value :: n_sweeps integer(c_int), value :: n_sweeps
integer(c_int), value :: max_nlevels 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(*) integer(c_int) :: ilaggr(*)
real(c_double) :: valaggr(*) real(c_double) :: valaggr(*)
integer(c_int) :: iret integer(c_int) :: iret
end function mld_bootCMatch_if end function amg_bootCMatch_if
end interface end interface
name='mld_d_bcmatch_aggregator_tprol' name='amg_d_newmatch_aggregator_tprol'
ictxt = desc_a%get_context() ctxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
if (psb_get_errstatus().ne.0) return if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
@ -117,13 +86,13 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,ag_data,&
info = psb_success_ info = psb_success_
call mld_check_def(parms%ml_cycle,'Multilevel cycle',& call amg_check_def(parms%ml_cycle,'Multilevel cycle',&
& mld_mult_ml_,is_legal_ml_cycle) & amg_mult_ml_,is_legal_ml_cycle)
call mld_check_def(parms%par_aggr_alg,'Aggregation',& call amg_check_def(parms%par_aggr_alg,'Aggregation',&
& mld_dec_aggr_,is_legal_ml_par_aggr_alg) & amg_dec_aggr_,is_legal_decoupled_par_aggr_alg)
call mld_check_def(parms%aggr_ord,'Ordering',& call amg_check_def(parms%aggr_ord,'Ordering',&
& mld_aggr_ord_nat_,is_legal_ml_aggr_ord) & amg_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%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()) 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 max_nlevels = ag_data%max_levs
end if 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) & ag%w_c_nxt, isz, c_ilaggr, valaggr, num_pcols)
if (info /= psb_success_) then if (info /= psb_success_) then
!!$ write(0,*) 'On return from bootCMatch_if:',info !!$ 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 goto 9999
end if end if
ilaggr(1:nr) = c_ilaggr(1:nr) 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(:)=0
nlaggr(me+1) = num_pcols 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 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 goto 9999
end if end if
@ -206,4 +175,4 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,ag_data,&
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine mld_d_bcmatch_aggregator_build_tprol end subroutine amg_d_newmatch_aggregator_build_tprol

53
amgprec/impl/aggregator/mld_d_bcmatch_map_to_tprol.f90 → amgprec/impl/aggregator/amg_d_newmatch_map_to_tprol.f90
Unescape Escape View File

@ -1,40 +1,8 @@
! !
! !
! MLD2P4 Extensions ! File: amg_d_newmatch_map_to_tprol.f90
! !
! (C) Copyright 2019 ! Subroutine: amg_d_newmatch_map_to_tprol
!
! 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
!
! Subroutine: mld_d_bcmatch_map_to_tprol
! Version: real ! Version: real
! !
! This routine uses a mapping from the row indices of the fine-level matrix ! This routine uses a mapping from the row indices of the fine-level matrix
@ -82,11 +50,11 @@
! info - integer, output. ! info - integer, output.
! Error code. ! 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 psb_base_mod
use mld_d_inner_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 mld_d_bcmatch_aggregator_mod, mld_protect_name => mld_d_bcmatch_map_to_tprol use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_map_to_tprol
implicit none implicit none
@ -101,19 +69,20 @@ subroutine mld_d_bcmatch_map_to_tprol(desc_a,ilaggr,nlaggr,valaggr, op_prol,info
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 type(psb_ld_coo_sparse_mat) :: tmpcoo
integer(psb_ipk_) :: debug_level, debug_unit,err_act integer(psb_ipk_) :: debug_level, debug_unit,err_act
integer(psb_ipk_) :: ictxt,np,me type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me
integer(psb_lpk_) :: nrow, ncol, n_ne integer(psb_lpk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info=psb_success_
name = 'mld_d_bcmatch_map_to_tprol' name = 'amg_d_newmatch_map_to_tprol'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit() debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level() debug_level = psb_get_debug_level()
! !
ictxt=desc_a%get_context() ctxt=desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ctxt,me,np)
nrow = desc_a%get_local_rows() nrow = desc_a%get_local_rows()
ncol = desc_a%get_local_cols() 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 return
end subroutine mld_d_bcmatch_map_to_tprol end subroutine amg_d_newmatch_map_to_tprol
Write Preview
Loading…
Cancel
Save