mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-06 14:44:55 +00:00
Fix matchbox internal interface names.
This commit is contained in:
Salvatore Filippone
@@ -68,7 +68,7 @@
|
||||
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
! POSSIBILITY OF SUCH DAMAGE.
|
||||
!
|
||||
module dmatchboxp_mod
|
||||
module amg_dmatchboxp_mod
|
||||
|
||||
use iso_c_binding
|
||||
use psb_base_cbind_mod
|
||||
@@ -94,34 +94,34 @@ module dmatchboxp_mod
|
||||
end subroutine dMatchBoxPC
|
||||
end interface MatchBoxPC
|
||||
|
||||
interface i_aggr_assign
|
||||
module procedure i_daggr_assign
|
||||
end interface i_aggr_assign
|
||||
interface amg_i_aggr_assign
|
||||
module procedure amg_i_daggr_assign
|
||||
end interface amg_i_aggr_assign
|
||||
|
||||
interface build_matching
|
||||
module procedure dbuild_matching
|
||||
end interface build_matching
|
||||
interface amg_build_matching
|
||||
module procedure amg_dbuild_matching
|
||||
end interface amg_build_matching
|
||||
|
||||
interface build_ahat
|
||||
module procedure dbuild_ahat
|
||||
end interface build_ahat
|
||||
interface amg_build_ahat
|
||||
module procedure amg_dbuild_ahat
|
||||
end interface amg_build_ahat
|
||||
|
||||
interface psb_gtranspose
|
||||
module procedure psb_dgtranspose
|
||||
end interface psb_gtranspose
|
||||
interface amg_gtranspose
|
||||
module procedure amg_dgtranspose
|
||||
end interface amg_gtranspose
|
||||
|
||||
interface psb_htranspose
|
||||
module procedure psb_dhtranspose
|
||||
end interface psb_htranspose
|
||||
interface amg_htranspose
|
||||
module procedure amg_dhtranspose
|
||||
end interface amg_htranspose
|
||||
|
||||
interface PMatchBox
|
||||
module procedure dPMatchBox
|
||||
end interface PMatchBox
|
||||
interface amg_PMatchBox
|
||||
module procedure amg_dPMatchBox
|
||||
end interface amg_PMatchBox
|
||||
|
||||
logical, parameter, private :: print_statistics=.false.
|
||||
contains
|
||||
|
||||
subroutine dmatchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,&
|
||||
subroutine amg_dmatchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,&
|
||||
& symmetrize,reproducible,display_inp, display_out, print_out)
|
||||
use psb_base_mod
|
||||
use psb_util_mod
|
||||
@@ -214,7 +214,7 @@ contains
|
||||
end if
|
||||
if (do_timings) call psb_toc(idx_phase1)
|
||||
if (do_timings) call psb_tic(idx_bldmtc)
|
||||
call build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize)
|
||||
call amg_build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize)
|
||||
if (do_timings) call psb_toc(idx_bldmtc)
|
||||
if (debug) write(0,*) iam,' buildprol from buildmatching:',&
|
||||
& info
|
||||
@@ -312,7 +312,7 @@ contains
|
||||
! Should be a symmetric function.
|
||||
!
|
||||
call desc_a%indxmap%qry_halo_owner(idx,iown,info)
|
||||
ip = i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg)
|
||||
ip = amg_i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg)
|
||||
if (iam == ip) then
|
||||
nlaggr(iam) = nlaggr(iam) + 1
|
||||
ilaggr(k) = nlaggr(iam)
|
||||
@@ -516,9 +516,9 @@ contains
|
||||
write(0,*) iam,' : error from Matching: ',info
|
||||
end if
|
||||
|
||||
end subroutine dmatchboxp_build_prol
|
||||
end subroutine amg_dmatchboxp_build_prol
|
||||
|
||||
function i_daggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) &
|
||||
function amg_i_daggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) &
|
||||
& result(iproc)
|
||||
!
|
||||
! How to break ties? This
|
||||
@@ -560,10 +560,10 @@ contains
|
||||
iproc = iown
|
||||
end if
|
||||
end if
|
||||
end function i_daggr_assign
|
||||
end function amg_i_daggr_assign
|
||||
|
||||
|
||||
subroutine dbuild_matching(w,a,desc_a,mate,info,display_inp, symmetrize)
|
||||
subroutine amg_dbuild_matching(w,a,desc_a,mate,info,display_inp, symmetrize)
|
||||
use psb_base_mod
|
||||
use psb_util_mod
|
||||
use iso_c_binding
|
||||
@@ -612,7 +612,7 @@ contains
|
||||
if (iam == 0) write(0,*)' Into build_ahat:'
|
||||
end if
|
||||
if (do_timings) call psb_tic(idx_bldahat)
|
||||
call build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize)
|
||||
call amg_build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize)
|
||||
if (do_timings) call psb_toc(idx_bldahat)
|
||||
if (info /= 0) then
|
||||
write(0,*) 'Error from build_ahat ', info
|
||||
@@ -703,7 +703,7 @@ contains
|
||||
!
|
||||
if (debug) write(0,*) iam,' buildmatching into PMatchBox:'
|
||||
if (do_timings) call psb_tic(idx_cmboxp)
|
||||
call PMatchBox(nr,nz,vlptr,vlind,ewght,&
|
||||
call amg_PMatchBox(nr,nz,vlptr,vlind,ewght,&
|
||||
& vnl, mate, iam, np,ictxt,&
|
||||
& msgis,msgas,msgprc,ph0t,ph1t,ph2t,ph1crd,ph2crd,info,display_inp)
|
||||
if (do_timings) call psb_toc(idx_cmboxp)
|
||||
@@ -767,9 +767,9 @@ contains
|
||||
val(1:n) = tmp(1:n)
|
||||
end subroutine fix_order
|
||||
|
||||
end subroutine dbuild_matching
|
||||
end subroutine amg_dbuild_matching
|
||||
|
||||
subroutine dbuild_ahat(w,a,ahat,desc_a,info,symmetrize)
|
||||
subroutine amg_dbuild_ahat(w,a,ahat,desc_a,info,symmetrize)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
real(psb_dpk_), intent(in) :: w(:)
|
||||
@@ -1005,9 +1005,9 @@ contains
|
||||
end block
|
||||
end if
|
||||
|
||||
end subroutine dbuild_ahat
|
||||
end subroutine amg_dbuild_ahat
|
||||
|
||||
subroutine psb_dgtranspose(ain,aout,desc_a,info)
|
||||
subroutine amg_dgtranspose(ain,aout,desc_a,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_ldspmat_type), intent(in) :: ain
|
||||
@@ -1128,9 +1128,9 @@ contains
|
||||
end if
|
||||
end if
|
||||
|
||||
end subroutine psb_dgtranspose
|
||||
end subroutine amg_dgtranspose
|
||||
|
||||
subroutine psb_dhtranspose(ain,aout,desc_a,info)
|
||||
subroutine amg_dhtranspose(ain,aout,desc_a,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_ldspmat_type), intent(in) :: ain
|
||||
@@ -1297,9 +1297,9 @@ contains
|
||||
end if
|
||||
end if
|
||||
|
||||
end subroutine psb_dhtranspose
|
||||
end subroutine amg_dhtranspose
|
||||
|
||||
subroutine dPMatchBox(nlver,nledge,verlocptr,verlocind,edgelocweight,&
|
||||
subroutine amg_dPMatchBox(nlver,nledge,verlocptr,verlocind,edgelocweight,&
|
||||
& verdistance, mate, myrank, numprocs, ictxt,&
|
||||
& msgindsent,msgactualsent,msgpercent,&
|
||||
& ph0_time, ph1_time, ph2_time, ph1_card, ph2_card,info,display_inp)
|
||||
@@ -1434,6 +1434,6 @@ contains
|
||||
end if
|
||||
where(mate>=0) mate = mate + 1
|
||||
|
||||
end subroutine dPMatchBox
|
||||
end subroutine amg_dPMatchBox
|
||||
|
||||
end module dmatchboxp_mod
|
||||
end module amg_dmatchboxp_mod
|
||||
|
||||
@@ -118,7 +118,7 @@
|
||||
|
||||
module amg_d_parmatch_aggregator_mod
|
||||
use amg_d_base_aggregator_mod
|
||||
use dmatchboxp_mod
|
||||
use amg_dmatchboxp_mod
|
||||
#if defined(SERIAL_MPI)
|
||||
type, extends(amg_d_base_aggregator_type) :: amg_d_parmatch_aggregator_type
|
||||
end type amg_d_parmatch_aggregator_type
|
||||
@@ -143,18 +143,18 @@ module amg_d_parmatch_aggregator_mod
|
||||
procedure, pass(ag) :: mat_asb => amg_d_parmatch_aggregator_mat_asb
|
||||
procedure, pass(ag) :: inner_mat_asb => amg_d_parmatch_aggregator_inner_mat_asb
|
||||
procedure, pass(ag) :: bld_map => amg_d_parmatch_aggregator_bld_map
|
||||
procedure, pass(ag) :: csetc => d_parmatch_aggr_csetc
|
||||
procedure, pass(ag) :: cseti => d_parmatch_aggr_cseti
|
||||
procedure, pass(ag) :: default => d_parmatch_aggr_set_default
|
||||
procedure, pass(ag) :: sizeof => d_parmatch_aggregator_sizeof
|
||||
procedure, pass(ag) :: update_next => d_parmatch_aggregator_update_next
|
||||
procedure, pass(ag) :: bld_wnxt => d_parmatch_bld_wnxt
|
||||
procedure, pass(ag) :: bld_default_w => d_bld_default_w
|
||||
procedure, pass(ag) :: set_c_default_w => d_set_prm_c_default_w
|
||||
procedure, pass(ag) :: descr => d_parmatch_aggregator_descr
|
||||
procedure, pass(ag) :: clone => d_parmatch_aggregator_clone
|
||||
procedure, pass(ag) :: free => d_parmatch_aggregator_free
|
||||
procedure, nopass :: fmt => d_parmatch_aggregator_fmt
|
||||
procedure, pass(ag) :: csetc => amg_d_parmatch_aggr_csetc
|
||||
procedure, pass(ag) :: cseti => amg_d_parmatch_aggr_cseti
|
||||
procedure, pass(ag) :: default => amg_d_parmatch_aggr_set_default
|
||||
procedure, pass(ag) :: sizeof => amg_d_parmatch_aggregator_sizeof
|
||||
procedure, pass(ag) :: update_next => amg_d_parmatch_aggregator_update_next
|
||||
procedure, pass(ag) :: bld_wnxt => amg_d_parmatch_bld_wnxt
|
||||
procedure, pass(ag) :: bld_default_w => amg_d_bld_default_w
|
||||
procedure, pass(ag) :: set_c_default_w => amg_d_set_prm_c_default_w
|
||||
procedure, pass(ag) :: descr => amg_d_parmatch_aggregator_descr
|
||||
procedure, pass(ag) :: clone => amg_d_parmatch_aggregator_clone
|
||||
procedure, pass(ag) :: free => amg_d_parmatch_aggregator_free
|
||||
procedure, nopass :: fmt => amg_d_parmatch_aggregator_fmt
|
||||
procedure, nopass :: xt_desc => amg_d_parmatch_aggregator_xt_desc
|
||||
end type amg_d_parmatch_aggregator_type
|
||||
|
||||
@@ -320,7 +320,7 @@ module amg_d_parmatch_aggregator_mod
|
||||
|
||||
contains
|
||||
|
||||
subroutine d_bld_default_w(ag,nr)
|
||||
subroutine amg_d_bld_default_w(ag,nr)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
@@ -330,9 +330,9 @@ contains
|
||||
if (info /= psb_success_) return
|
||||
ag%w = done
|
||||
!call ag%set_c_default_w()
|
||||
end subroutine d_bld_default_w
|
||||
end subroutine amg_d_bld_default_w
|
||||
|
||||
subroutine d_set_prm_c_default_w(ag)
|
||||
subroutine amg_d_set_prm_c_default_w(ag)
|
||||
use psb_realloc_mod
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
@@ -342,9 +342,9 @@ contains
|
||||
!write(0,*) 'prm_c_deafult_w '
|
||||
call psb_safe_ab_cpy(ag%w,ag%w_nxt,info)
|
||||
|
||||
end subroutine d_set_prm_c_default_w
|
||||
end subroutine amg_d_set_prm_c_default_w
|
||||
|
||||
subroutine d_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
|
||||
subroutine amg_d_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
@@ -358,14 +358,14 @@ contains
|
||||
!write(0,*) 'Executing bld_wnxt ',nx
|
||||
call psb_realloc(nx,ag%w_nxt,info)
|
||||
|
||||
end subroutine d_parmatch_bld_wnxt
|
||||
end subroutine amg_d_parmatch_bld_wnxt
|
||||
|
||||
function d_parmatch_aggregator_fmt() result(val)
|
||||
function amg_d_parmatch_aggregator_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Parallel Matching aggregation"
|
||||
end function d_parmatch_aggregator_fmt
|
||||
end function amg_d_parmatch_aggregator_fmt
|
||||
|
||||
function amg_d_parmatch_aggregator_xt_desc() result(val)
|
||||
implicit none
|
||||
@@ -374,7 +374,7 @@ contains
|
||||
val = .true.
|
||||
end function amg_d_parmatch_aggregator_xt_desc
|
||||
|
||||
function d_parmatch_aggregator_sizeof(ag) result(val)
|
||||
function amg_d_parmatch_aggregator_sizeof(ag) result(val)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), intent(in) :: ag
|
||||
@@ -390,9 +390,9 @@ contains
|
||||
if (allocated(ag%base_desc)) val = val + ag%base_desc%sizeof()
|
||||
if (allocated(ag%desc_ax)) val = val + ag%desc_ax%sizeof()
|
||||
|
||||
end function d_parmatch_aggregator_sizeof
|
||||
end function amg_d_parmatch_aggregator_sizeof
|
||||
|
||||
subroutine d_parmatch_aggregator_descr(ag,parms,iout,info)
|
||||
subroutine amg_d_parmatch_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), intent(in) :: ag
|
||||
type(amg_dml_parms), intent(in) :: parms
|
||||
@@ -406,7 +406,7 @@ contains
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine d_parmatch_aggregator_descr
|
||||
end subroutine amg_d_parmatch_aggregator_descr
|
||||
|
||||
function is_legal_malg(alg) result(val)
|
||||
logical :: val
|
||||
@@ -437,7 +437,7 @@ contains
|
||||
end function is_legal_nlevels
|
||||
|
||||
|
||||
subroutine d_parmatch_aggregator_update_next(ag,agnext,info)
|
||||
subroutine amg_d_parmatch_aggregator_update_next(ag,agnext,info)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
@@ -470,9 +470,9 @@ contains
|
||||
! What should we do here?
|
||||
end select
|
||||
info = 0
|
||||
end subroutine d_parmatch_aggregator_update_next
|
||||
end subroutine amg_d_parmatch_aggregator_update_next
|
||||
|
||||
subroutine d_parmatch_aggr_csetc(ag,what,val,info,idx)
|
||||
subroutine amg_d_parmatch_aggr_csetc(ag,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -514,9 +514,9 @@ contains
|
||||
! Do nothing
|
||||
end select
|
||||
return
|
||||
end subroutine d_parmatch_aggr_csetc
|
||||
end subroutine amg_d_parmatch_aggr_csetc
|
||||
|
||||
subroutine d_parmatch_aggr_cseti(ag,what,val,info,idx)
|
||||
subroutine amg_d_parmatch_aggr_cseti(ag,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -556,9 +556,9 @@ contains
|
||||
! Do nothing
|
||||
end select
|
||||
return
|
||||
end subroutine d_parmatch_aggr_cseti
|
||||
end subroutine amg_d_parmatch_aggr_cseti
|
||||
|
||||
subroutine d_parmatch_aggr_set_default(ag)
|
||||
subroutine amg_d_parmatch_aggr_set_default(ag)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -579,9 +579,9 @@ contains
|
||||
|
||||
return
|
||||
|
||||
end subroutine d_parmatch_aggr_set_default
|
||||
end subroutine amg_d_parmatch_aggr_set_default
|
||||
|
||||
subroutine d_parmatch_aggregator_free(ag,info)
|
||||
subroutine amg_d_parmatch_aggregator_free(ag,info)
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
|
||||
@@ -618,9 +618,9 @@ contains
|
||||
call ag%rwdesc%free(info); deallocate(ag%rwdesc,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine d_parmatch_aggregator_free
|
||||
end subroutine amg_d_parmatch_aggregator_free
|
||||
|
||||
subroutine d_parmatch_aggregator_clone(ag,agnext,info)
|
||||
subroutine amg_d_parmatch_aggregator_clone(ag,agnext,info)
|
||||
implicit none
|
||||
class(amg_d_parmatch_aggregator_type), intent(inout) :: ag
|
||||
class(amg_d_base_aggregator_type), allocatable, intent(inout) :: agnext
|
||||
@@ -640,7 +640,7 @@ contains
|
||||
! Should never ever get here
|
||||
info = -1
|
||||
end select
|
||||
end subroutine d_parmatch_aggregator_clone
|
||||
end subroutine amg_d_parmatch_aggregator_clone
|
||||
|
||||
subroutine amg_d_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
& op_restr,op_prol,map,info)
|
||||
|
||||
@@ -68,7 +68,7 @@
|
||||
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
! POSSIBILITY OF SUCH DAMAGE.
|
||||
!
|
||||
module smatchboxp_mod
|
||||
module amg_smatchboxp_mod
|
||||
|
||||
use iso_c_binding
|
||||
use psb_base_cbind_mod
|
||||
@@ -94,34 +94,34 @@ module smatchboxp_mod
|
||||
end subroutine sMatchBoxPC
|
||||
end interface MatchBoxPC
|
||||
|
||||
interface i_aggr_assign
|
||||
module procedure i_saggr_assign
|
||||
end interface i_aggr_assign
|
||||
interface amg_i_aggr_assign
|
||||
module procedure amg_i_saggr_assign
|
||||
end interface amg_i_aggr_assign
|
||||
|
||||
interface build_matching
|
||||
module procedure sbuild_matching
|
||||
end interface build_matching
|
||||
interface amg_build_matching
|
||||
module procedure amg_sbuild_matching
|
||||
end interface amg_build_matching
|
||||
|
||||
interface build_ahat
|
||||
module procedure sbuild_ahat
|
||||
end interface build_ahat
|
||||
interface amg_build_ahat
|
||||
module procedure amg_sbuild_ahat
|
||||
end interface amg_build_ahat
|
||||
|
||||
interface psb_gtranspose
|
||||
module procedure psb_sgtranspose
|
||||
end interface psb_gtranspose
|
||||
interface amg_gtranspose
|
||||
module procedure amg_sgtranspose
|
||||
end interface amg_gtranspose
|
||||
|
||||
interface psb_htranspose
|
||||
module procedure psb_shtranspose
|
||||
end interface psb_htranspose
|
||||
interface amg_htranspose
|
||||
module procedure amg_shtranspose
|
||||
end interface amg_htranspose
|
||||
|
||||
interface PMatchBox
|
||||
module procedure sPMatchBox
|
||||
end interface PMatchBox
|
||||
interface amg_PMatchBox
|
||||
module procedure amg_sPMatchBox
|
||||
end interface amg_PMatchBox
|
||||
|
||||
logical, parameter, private :: print_statistics=.false.
|
||||
contains
|
||||
|
||||
subroutine smatchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,&
|
||||
subroutine amg_smatchboxp_build_prol(w,a,desc_a,ilaggr,nlaggr,prol,info,&
|
||||
& symmetrize,reproducible,display_inp, display_out, print_out)
|
||||
use psb_base_mod
|
||||
use psb_util_mod
|
||||
@@ -214,7 +214,7 @@ contains
|
||||
end if
|
||||
if (do_timings) call psb_toc(idx_phase1)
|
||||
if (do_timings) call psb_tic(idx_bldmtc)
|
||||
call build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize)
|
||||
call amg_build_matching(w,a,desc_a,mate,info,display_inp=display_inp,symmetrize=symmetrize)
|
||||
if (do_timings) call psb_toc(idx_bldmtc)
|
||||
if (debug) write(0,*) iam,' buildprol from buildmatching:',&
|
||||
& info
|
||||
@@ -312,7 +312,7 @@ contains
|
||||
! Should be a symmetric function.
|
||||
!
|
||||
call desc_a%indxmap%qry_halo_owner(idx,iown,info)
|
||||
ip = i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg)
|
||||
ip = amg_i_aggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg)
|
||||
if (iam == ip) then
|
||||
nlaggr(iam) = nlaggr(iam) + 1
|
||||
ilaggr(k) = nlaggr(iam)
|
||||
@@ -516,9 +516,9 @@ contains
|
||||
write(0,*) iam,' : error from Matching: ',info
|
||||
end if
|
||||
|
||||
end subroutine smatchboxp_build_prol
|
||||
end subroutine amg_smatchboxp_build_prol
|
||||
|
||||
function i_saggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) &
|
||||
function amg_i_saggr_assign(iam, iown, kg, idxg, wk, widx, nrmagg) &
|
||||
& result(iproc)
|
||||
!
|
||||
! How to break ties? This
|
||||
@@ -560,10 +560,10 @@ contains
|
||||
iproc = iown
|
||||
end if
|
||||
end if
|
||||
end function i_saggr_assign
|
||||
end function amg_i_saggr_assign
|
||||
|
||||
|
||||
subroutine sbuild_matching(w,a,desc_a,mate,info,display_inp, symmetrize)
|
||||
subroutine amg_sbuild_matching(w,a,desc_a,mate,info,display_inp, symmetrize)
|
||||
use psb_base_mod
|
||||
use psb_util_mod
|
||||
use iso_c_binding
|
||||
@@ -612,7 +612,7 @@ contains
|
||||
if (iam == 0) write(0,*)' Into build_ahat:'
|
||||
end if
|
||||
if (do_timings) call psb_tic(idx_bldahat)
|
||||
call build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize)
|
||||
call amg_build_ahat(w,a,ahatnd,desc_a,info,symmetrize=symmetrize)
|
||||
if (do_timings) call psb_toc(idx_bldahat)
|
||||
if (info /= 0) then
|
||||
write(0,*) 'Error from build_ahat ', info
|
||||
@@ -703,7 +703,7 @@ contains
|
||||
!
|
||||
if (debug) write(0,*) iam,' buildmatching into PMatchBox:'
|
||||
if (do_timings) call psb_tic(idx_cmboxp)
|
||||
call PMatchBox(nr,nz,vlptr,vlind,ewght,&
|
||||
call amg_PMatchBox(nr,nz,vlptr,vlind,ewght,&
|
||||
& vnl, mate, iam, np,ictxt,&
|
||||
& msgis,msgas,msgprc,ph0t,ph1t,ph2t,ph1crd,ph2crd,info,display_inp)
|
||||
if (do_timings) call psb_toc(idx_cmboxp)
|
||||
@@ -767,9 +767,9 @@ contains
|
||||
val(1:n) = tmp(1:n)
|
||||
end subroutine fix_order
|
||||
|
||||
end subroutine sbuild_matching
|
||||
end subroutine amg_sbuild_matching
|
||||
|
||||
subroutine sbuild_ahat(w,a,ahat,desc_a,info,symmetrize)
|
||||
subroutine amg_sbuild_ahat(w,a,ahat,desc_a,info,symmetrize)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
real(psb_spk_), intent(in) :: w(:)
|
||||
@@ -1005,9 +1005,9 @@ contains
|
||||
end block
|
||||
end if
|
||||
|
||||
end subroutine sbuild_ahat
|
||||
end subroutine amg_sbuild_ahat
|
||||
|
||||
subroutine psb_sgtranspose(ain,aout,desc_a,info)
|
||||
subroutine amg_sgtranspose(ain,aout,desc_a,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_lsspmat_type), intent(in) :: ain
|
||||
@@ -1128,9 +1128,9 @@ contains
|
||||
end if
|
||||
end if
|
||||
|
||||
end subroutine psb_sgtranspose
|
||||
end subroutine amg_sgtranspose
|
||||
|
||||
subroutine psb_shtranspose(ain,aout,desc_a,info)
|
||||
subroutine amg_shtranspose(ain,aout,desc_a,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(psb_lsspmat_type), intent(in) :: ain
|
||||
@@ -1297,9 +1297,9 @@ contains
|
||||
end if
|
||||
end if
|
||||
|
||||
end subroutine psb_shtranspose
|
||||
end subroutine amg_shtranspose
|
||||
|
||||
subroutine sPMatchBox(nlver,nledge,verlocptr,verlocind,edgelocweight,&
|
||||
subroutine amg_sPMatchBox(nlver,nledge,verlocptr,verlocind,edgelocweight,&
|
||||
& verdistance, mate, myrank, numprocs, ictxt,&
|
||||
& msgindsent,msgactualsent,msgpercent,&
|
||||
& ph0_time, ph1_time, ph2_time, ph1_card, ph2_card,info,display_inp)
|
||||
@@ -1434,6 +1434,6 @@ contains
|
||||
end if
|
||||
where(mate>=0) mate = mate + 1
|
||||
|
||||
end subroutine sPMatchBox
|
||||
end subroutine amg_sPMatchBox
|
||||
|
||||
end module smatchboxp_mod
|
||||
end module amg_smatchboxp_mod
|
||||
|
||||
@@ -118,7 +118,7 @@
|
||||
|
||||
module amg_s_parmatch_aggregator_mod
|
||||
use amg_s_base_aggregator_mod
|
||||
use smatchboxp_mod
|
||||
use amg_smatchboxp_mod
|
||||
#if defined(SERIAL_MPI)
|
||||
type, extends(amg_s_base_aggregator_type) :: amg_s_parmatch_aggregator_type
|
||||
end type amg_s_parmatch_aggregator_type
|
||||
@@ -143,18 +143,18 @@ module amg_s_parmatch_aggregator_mod
|
||||
procedure, pass(ag) :: mat_asb => amg_s_parmatch_aggregator_mat_asb
|
||||
procedure, pass(ag) :: inner_mat_asb => amg_s_parmatch_aggregator_inner_mat_asb
|
||||
procedure, pass(ag) :: bld_map => amg_s_parmatch_aggregator_bld_map
|
||||
procedure, pass(ag) :: csetc => s_parmatch_aggr_csetc
|
||||
procedure, pass(ag) :: cseti => s_parmatch_aggr_cseti
|
||||
procedure, pass(ag) :: default => s_parmatch_aggr_set_default
|
||||
procedure, pass(ag) :: sizeof => s_parmatch_aggregator_sizeof
|
||||
procedure, pass(ag) :: update_next => s_parmatch_aggregator_update_next
|
||||
procedure, pass(ag) :: bld_wnxt => s_parmatch_bld_wnxt
|
||||
procedure, pass(ag) :: bld_default_w => s_bld_default_w
|
||||
procedure, pass(ag) :: set_c_default_w => s_set_prm_c_default_w
|
||||
procedure, pass(ag) :: descr => s_parmatch_aggregator_descr
|
||||
procedure, pass(ag) :: clone => s_parmatch_aggregator_clone
|
||||
procedure, pass(ag) :: free => s_parmatch_aggregator_free
|
||||
procedure, nopass :: fmt => s_parmatch_aggregator_fmt
|
||||
procedure, pass(ag) :: csetc => amg_s_parmatch_aggr_csetc
|
||||
procedure, pass(ag) :: cseti => amg_s_parmatch_aggr_cseti
|
||||
procedure, pass(ag) :: default => amg_s_parmatch_aggr_set_default
|
||||
procedure, pass(ag) :: sizeof => amg_s_parmatch_aggregator_sizeof
|
||||
procedure, pass(ag) :: update_next => amg_s_parmatch_aggregator_update_next
|
||||
procedure, pass(ag) :: bld_wnxt => amg_s_parmatch_bld_wnxt
|
||||
procedure, pass(ag) :: bld_default_w => amg_s_bld_default_w
|
||||
procedure, pass(ag) :: set_c_default_w => amg_s_set_prm_c_default_w
|
||||
procedure, pass(ag) :: descr => amg_s_parmatch_aggregator_descr
|
||||
procedure, pass(ag) :: clone => amg_s_parmatch_aggregator_clone
|
||||
procedure, pass(ag) :: free => amg_s_parmatch_aggregator_free
|
||||
procedure, nopass :: fmt => amg_s_parmatch_aggregator_fmt
|
||||
procedure, nopass :: xt_desc => amg_s_parmatch_aggregator_xt_desc
|
||||
end type amg_s_parmatch_aggregator_type
|
||||
|
||||
@@ -320,7 +320,7 @@ module amg_s_parmatch_aggregator_mod
|
||||
|
||||
contains
|
||||
|
||||
subroutine s_bld_default_w(ag,nr)
|
||||
subroutine amg_s_bld_default_w(ag,nr)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
@@ -330,9 +330,9 @@ contains
|
||||
if (info /= psb_success_) return
|
||||
ag%w = done
|
||||
!call ag%set_c_default_w()
|
||||
end subroutine s_bld_default_w
|
||||
end subroutine amg_s_bld_default_w
|
||||
|
||||
subroutine s_set_prm_c_default_w(ag)
|
||||
subroutine amg_s_set_prm_c_default_w(ag)
|
||||
use psb_realloc_mod
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
@@ -342,9 +342,9 @@ contains
|
||||
!write(0,*) 'prm_c_deafult_w '
|
||||
call psb_safe_ab_cpy(ag%w,ag%w_nxt,info)
|
||||
|
||||
end subroutine s_set_prm_c_default_w
|
||||
end subroutine amg_s_set_prm_c_default_w
|
||||
|
||||
subroutine s_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
|
||||
subroutine amg_s_parmatch_bld_wnxt(ag,ilaggr,valaggr,nx)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
@@ -358,14 +358,14 @@ contains
|
||||
!write(0,*) 'Executing bld_wnxt ',nx
|
||||
call psb_realloc(nx,ag%w_nxt,info)
|
||||
|
||||
end subroutine s_parmatch_bld_wnxt
|
||||
end subroutine amg_s_parmatch_bld_wnxt
|
||||
|
||||
function s_parmatch_aggregator_fmt() result(val)
|
||||
function amg_s_parmatch_aggregator_fmt() result(val)
|
||||
implicit none
|
||||
character(len=32) :: val
|
||||
|
||||
val = "Parallel Matching aggregation"
|
||||
end function s_parmatch_aggregator_fmt
|
||||
end function amg_s_parmatch_aggregator_fmt
|
||||
|
||||
function amg_s_parmatch_aggregator_xt_desc() result(val)
|
||||
implicit none
|
||||
@@ -374,7 +374,7 @@ contains
|
||||
val = .true.
|
||||
end function amg_s_parmatch_aggregator_xt_desc
|
||||
|
||||
function s_parmatch_aggregator_sizeof(ag) result(val)
|
||||
function amg_s_parmatch_aggregator_sizeof(ag) result(val)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), intent(in) :: ag
|
||||
@@ -390,9 +390,9 @@ contains
|
||||
if (allocated(ag%base_desc)) val = val + ag%base_desc%sizeof()
|
||||
if (allocated(ag%desc_ax)) val = val + ag%desc_ax%sizeof()
|
||||
|
||||
end function s_parmatch_aggregator_sizeof
|
||||
end function amg_s_parmatch_aggregator_sizeof
|
||||
|
||||
subroutine s_parmatch_aggregator_descr(ag,parms,iout,info)
|
||||
subroutine amg_s_parmatch_aggregator_descr(ag,parms,iout,info)
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), intent(in) :: ag
|
||||
type(amg_sml_parms), intent(in) :: parms
|
||||
@@ -406,7 +406,7 @@ contains
|
||||
call parms%mldescr(iout,info)
|
||||
|
||||
return
|
||||
end subroutine s_parmatch_aggregator_descr
|
||||
end subroutine amg_s_parmatch_aggregator_descr
|
||||
|
||||
function is_legal_malg(alg) result(val)
|
||||
logical :: val
|
||||
@@ -437,7 +437,7 @@ contains
|
||||
end function is_legal_nlevels
|
||||
|
||||
|
||||
subroutine s_parmatch_aggregator_update_next(ag,agnext,info)
|
||||
subroutine amg_s_parmatch_aggregator_update_next(ag,agnext,info)
|
||||
use psb_realloc_mod
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), target, intent(inout) :: ag
|
||||
@@ -470,9 +470,9 @@ contains
|
||||
! What should we do here?
|
||||
end select
|
||||
info = 0
|
||||
end subroutine s_parmatch_aggregator_update_next
|
||||
end subroutine amg_s_parmatch_aggregator_update_next
|
||||
|
||||
subroutine s_parmatch_aggr_csetc(ag,what,val,info,idx)
|
||||
subroutine amg_s_parmatch_aggr_csetc(ag,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -514,9 +514,9 @@ contains
|
||||
! Do nothing
|
||||
end select
|
||||
return
|
||||
end subroutine s_parmatch_aggr_csetc
|
||||
end subroutine amg_s_parmatch_aggr_csetc
|
||||
|
||||
subroutine s_parmatch_aggr_cseti(ag,what,val,info,idx)
|
||||
subroutine amg_s_parmatch_aggr_cseti(ag,what,val,info,idx)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -556,9 +556,9 @@ contains
|
||||
! Do nothing
|
||||
end select
|
||||
return
|
||||
end subroutine s_parmatch_aggr_cseti
|
||||
end subroutine amg_s_parmatch_aggr_cseti
|
||||
|
||||
subroutine s_parmatch_aggr_set_default(ag)
|
||||
subroutine amg_s_parmatch_aggr_set_default(ag)
|
||||
|
||||
Implicit None
|
||||
|
||||
@@ -579,9 +579,9 @@ contains
|
||||
|
||||
return
|
||||
|
||||
end subroutine s_parmatch_aggr_set_default
|
||||
end subroutine amg_s_parmatch_aggr_set_default
|
||||
|
||||
subroutine s_parmatch_aggregator_free(ag,info)
|
||||
subroutine amg_s_parmatch_aggregator_free(ag,info)
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
|
||||
@@ -618,9 +618,9 @@ contains
|
||||
call ag%rwdesc%free(info); deallocate(ag%rwdesc,stat=info)
|
||||
end if
|
||||
|
||||
end subroutine s_parmatch_aggregator_free
|
||||
end subroutine amg_s_parmatch_aggregator_free
|
||||
|
||||
subroutine s_parmatch_aggregator_clone(ag,agnext,info)
|
||||
subroutine amg_s_parmatch_aggregator_clone(ag,agnext,info)
|
||||
implicit none
|
||||
class(amg_s_parmatch_aggregator_type), intent(inout) :: ag
|
||||
class(amg_s_base_aggregator_type), allocatable, intent(inout) :: agnext
|
||||
@@ -640,7 +640,7 @@ contains
|
||||
! Should never ever get here
|
||||
info = -1
|
||||
end select
|
||||
end subroutine s_parmatch_aggregator_clone
|
||||
end subroutine amg_s_parmatch_aggregator_clone
|
||||
|
||||
subroutine amg_s_parmatch_aggregator_bld_map(ag,desc_a,desc_ac,ilaggr,nlaggr,&
|
||||
& op_restr,op_prol,map,info)
|
||||
|
||||
@@ -264,7 +264,7 @@ subroutine amg_d_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
!
|
||||
if (debug) write(0,*) me,' Into matchbox_build_prol ',info
|
||||
if (do_timings) call psb_tic(idx_mboxp)
|
||||
call dmatchboxp_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,&
|
||||
call amg_dmatchboxp_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,&
|
||||
& symmetrize=ag%need_symmetrize,reproducible=ag%reproducible_matching)
|
||||
if (do_timings) call psb_toc(idx_mboxp)
|
||||
if (debug) write(0,*) me,' Out from matchbox_build_prol ',info
|
||||
|
||||
@@ -264,7 +264,7 @@ subroutine amg_s_parmatch_aggregator_build_tprol(ag,parms,ag_data,&
|
||||
!
|
||||
if (debug) write(0,*) me,' Into matchbox_build_prol ',info
|
||||
if (do_timings) call psb_tic(idx_mboxp)
|
||||
call smatchboxp_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,&
|
||||
call amg_smatchboxp_build_prol(tmpw,acv(i-1),desc_acv(i-1),ixaggr,nxaggr,tmp_prol,info,&
|
||||
& symmetrize=ag%need_symmetrize,reproducible=ag%reproducible_matching)
|
||||
if (do_timings) call psb_toc(idx_mboxp)
|
||||
if (debug) write(0,*) me,' Out from matchbox_build_prol ',info
|
||||
|
||||
Reference in New Issue
Block a user