mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-20 12:52:16 +00:00
Get compilation through for newmatch. Now onto testing.
This commit is contained in:
+1
-1
@@ -114,7 +114,7 @@ amg_c_prec_type.o: amg_c_onelev_mod.o
|
||||
amg_z_prec_type.o: amg_z_onelev_mod.o
|
||||
|
||||
amg_s_onelev_mod.o: amg_s_base_smoother_mod.o amg_s_dec_aggregator_mod.o amg_s_parmatch_aggregator_mod.o
|
||||
amg_d_onelev_mod.o: amg_d_base_smoother_mod.o amg_d_dec_aggregator_mod.o amg_d_parmatch_aggregator_mod.o
|
||||
amg_d_onelev_mod.o: amg_d_base_smoother_mod.o amg_d_dec_aggregator_mod.o amg_d_parmatch_aggregator_mod.o amg_d_newmatch_aggregator_mod.o
|
||||
amg_c_onelev_mod.o: amg_c_base_smoother_mod.o amg_c_dec_aggregator_mod.o
|
||||
amg_z_onelev_mod.o: amg_z_base_smoother_mod.o amg_z_dec_aggregator_mod.o
|
||||
|
||||
|
||||
@@ -283,6 +283,7 @@ module amg_base_prec_type
|
||||
integer(psb_ipk_), parameter :: amg_soc1_ = 1
|
||||
integer(psb_ipk_), parameter :: amg_soc2_ = 2
|
||||
integer(psb_ipk_), parameter :: amg_matchboxp_ = 3
|
||||
integer(psb_ipk_), parameter :: amg_newmatch_ = 4
|
||||
!
|
||||
! Legal values for entry: amg_aggr_prol_
|
||||
!
|
||||
@@ -371,9 +372,9 @@ module amg_base_prec_type
|
||||
character(len=15), parameter, private :: &
|
||||
& matrix_names(0:1)=(/'distributed ','replicated '/)
|
||||
character(len=18), parameter, private :: &
|
||||
& aggr_type_names(0:3)=(/'None ',&
|
||||
& aggr_type_names(0:4)=(/'None ',&
|
||||
& 'SOC measure 1 ', 'SOC Measure 2 ',&
|
||||
& 'Parallel Matching '/)
|
||||
& 'Parallel Matching ','Decoupled Matching'/)
|
||||
character(len=18), parameter, private :: &
|
||||
& par_aggr_alg_names(0:3)=(/&
|
||||
& 'decoupled aggr. ', 'sym. dec. aggr. ',&
|
||||
@@ -516,6 +517,8 @@ contains
|
||||
val = amg_soc2_
|
||||
case('SOC1')
|
||||
val = amg_soc1_
|
||||
case('NEWMATCH')
|
||||
val = amg_newmatch_
|
||||
case('MATCHBOXP','PARMATCH')
|
||||
val = amg_matchboxp_
|
||||
case('COUPLED','COUP')
|
||||
|
||||
@@ -281,6 +281,8 @@ contains
|
||||
!!$ ilaggr(k) = -2
|
||||
!!$ end if
|
||||
!!$ end if
|
||||
else
|
||||
write(0,*) 'Really? mate(k) > nr? ',mate(k),nr
|
||||
end if
|
||||
else
|
||||
if (abs(w(k))<epsilon(nrmagg)) then
|
||||
@@ -584,23 +586,23 @@ contains
|
||||
|
||||
9999 continue
|
||||
call psb_error(ictxt)
|
||||
contains
|
||||
subroutine fix_order(n,ja,val,iret)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: n
|
||||
integer(psb_lpk_), intent(inout) :: ja(:)
|
||||
real(psb_dpk_), intent(inout) :: val(:)
|
||||
integer(psb_ipk_),intent(out) :: iret
|
||||
integer(psb_lpk_), allocatable :: ix(:)
|
||||
real(psb_dpk_), allocatable :: tmp(:)
|
||||
|
||||
allocate(ix(n), tmp(n),stat=iret)
|
||||
if (iret /= 0) return
|
||||
call psb_msort(ja(1:n),ix=ix,dir=psb_sort_up_)
|
||||
tmp(1:n) = val(ix(1:n))
|
||||
val(1:n) = tmp(1:n)
|
||||
end subroutine fix_order
|
||||
!!$ contains
|
||||
!!$ subroutine fix_order(n,ja,val,iret)
|
||||
!!$ use psb_base_mod
|
||||
!!$ implicit none
|
||||
!!$ integer(psb_ipk_), intent(in) :: n
|
||||
!!$ integer(psb_lpk_), intent(inout) :: ja(:)
|
||||
!!$ real(psb_dpk_), intent(inout) :: val(:)
|
||||
!!$ integer(psb_ipk_),intent(out) :: iret
|
||||
!!$ integer(psb_lpk_), allocatable :: ix(:)
|
||||
!!$ real(psb_dpk_), allocatable :: tmp(:)
|
||||
!!$
|
||||
!!$ allocate(ix(n), tmp(n),stat=iret)
|
||||
!!$ if (iret /= 0) return
|
||||
!!$ call psb_msort(ja(1:n),ix=ix,dir=psb_sort_up_)
|
||||
!!$ tmp(1:n) = val(ix(1:n))
|
||||
!!$ val(1:n) = tmp(1:n)
|
||||
!!$ end subroutine fix_order
|
||||
|
||||
end subroutine amg_dbuild_decmatch
|
||||
|
||||
|
||||
@@ -57,6 +57,7 @@ module amg_d_onelev_mod
|
||||
use amg_d_base_smoother_mod
|
||||
use amg_d_dec_aggregator_mod
|
||||
use amg_d_parmatch_aggregator_mod
|
||||
use amg_d_newmatch_aggregator_mod
|
||||
|
||||
use psb_base_mod, only : psb_dspmat_type, psb_d_vect_type, &
|
||||
& psb_d_base_vect_type, psb_ldspmat_type, psb_dlinmap_type, psb_dpk_, &
|
||||
|
||||
@@ -99,8 +99,8 @@ 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 amg_d_inner_mod
|
||||
use amg_d_prec_type
|
||||
use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_aggregator_mat_bld
|
||||
use amg_d_prec_type, amg_protect_name => amg_d_newmatch_aggregator_mat_bld
|
||||
!use amg_d_newmatch_aggregator_mod, amg_protect_name => amg_d_newmatch_aggregator_mat_bld
|
||||
implicit none
|
||||
|
||||
class(amg_d_newmatch_aggregator_type), target, intent(inout) :: ag
|
||||
|
||||
@@ -43,6 +43,7 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
|
||||
use amg_d_dec_aggregator_mod
|
||||
use amg_d_symdec_aggregator_mod
|
||||
use amg_d_parmatch_aggregator_mod
|
||||
use amg_d_newmatch_aggregator_mod
|
||||
use amg_d_jac_smoother
|
||||
use amg_d_as_smoother
|
||||
use amg_d_diag_solver
|
||||
@@ -252,8 +253,6 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
|
||||
lv%parms%ml_cycle = amg_stringval(val)
|
||||
|
||||
case ('PAR_AGGR_ALG')
|
||||
ival = amg_stringval(val)
|
||||
lv%parms%par_aggr_alg = ival
|
||||
if (allocated(lv%aggr)) then
|
||||
call lv%aggr%free(info)
|
||||
if (info == 0) deallocate(lv%aggr,stat=info)
|
||||
@@ -263,6 +262,9 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
|
||||
end if
|
||||
end if
|
||||
|
||||
ival = amg_stringval(val)
|
||||
lv%parms%par_aggr_alg = ival
|
||||
|
||||
select case(val)
|
||||
case('DEC')
|
||||
allocate(amg_d_dec_aggregator_type :: lv%aggr, stat=info)
|
||||
@@ -270,9 +272,12 @@ subroutine amg_d_base_onelev_csetc(lv,what,val,info,pos,idx)
|
||||
allocate(amg_d_symdec_aggregator_type :: lv%aggr, stat=info)
|
||||
case('COUP','COUPLED')
|
||||
allocate(amg_d_parmatch_aggregator_type :: lv%aggr, stat=info)
|
||||
case('NEWMTC')
|
||||
allocate(amg_d_newmatch_aggregator_type :: lv%aggr, stat=info)
|
||||
case default
|
||||
info = psb_err_internal_error_
|
||||
end select
|
||||
|
||||
if (info == psb_success_) call lv%aggr%default()
|
||||
|
||||
case ('AGGR_ORD')
|
||||
|
||||
Reference in New Issue
Block a user