From a67454ef5cde8c1269442a119fed777cc92a1c41 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Fri, 17 Nov 2023 16:01:52 +0100 Subject: [PATCH] Prepare for new variant. --- amgprec/amg_d_poly_coeff_mod.f90 | 36 +++++++++++++++++- amgprec/amg_d_poly_smoother.f90 | 1 + .../impl/smoother/amg_d_poly_smoother_bld.f90 | 38 +++++++++++++++---- 3 files changed, 65 insertions(+), 10 deletions(-) diff --git a/amgprec/amg_d_poly_coeff_mod.f90 b/amgprec/amg_d_poly_coeff_mod.f90 index 8a7d8ad3..69c56aba 100644 --- a/amgprec/amg_d_poly_coeff_mod.f90 +++ b/amgprec/amg_d_poly_coeff_mod.f90 @@ -52,7 +52,39 @@ module amg_d_poly_coeff_mod use psb_base_mod - real(psb_dpk_), parameter :: amg_d_beta_vect(900) = [ & + real(psb_dpk_), parameter :: amg_d_poly_a_vect(30) = [ & + & 0.3333333333333333_psb_dpk_, & + & 0.1805359927403007_psb_dpk_, & + & 0.1159278464862213_psb_dpk_, & + & 0.0820780659590383_psb_dpk_, & + & 0.0618496002413377_psb_dpk_, & + & 0.0486605823426062_psb_dpk_, & + & 0.0395132986024057_psb_dpk_, & + & 0.0328701017544880_psb_dpk_, & + & 0.0278702862721800_psb_dpk_, & + & 0.0239987409600620_psb_dpk_, & + & 0.0209304400432259_psb_dpk_, & + & 0.0184513099045066_psb_dpk_, & + & 0.0164152586042591_psb_dpk_, & + & 0.0147195638076874_psb_dpk_, & + & 0.0132901324757843_psb_dpk_, & + & 0.0120723317737698_psb_dpk_, & + & 0.0110250964606384_psb_dpk_, & + & 0.0101170330064859_psb_dpk_, & + & 0.0093237789039835_psb_dpk_, & + & 0.0086261728849515_psb_dpk_, & + & 0.0080089618703679_psb_dpk_, & + & 0.0074598709610601_psb_dpk_, & + & 0.0069689238144320_psb_dpk_, & + & 0.0065279387776372_psb_dpk_, & + & 0.0061301503808627_psb_dpk_, & + & 0.0057699215598864_psb_dpk_, & + & 0.0054425224281914_psb_dpk_, & + & 0.0051439584672521_psb_dpk_, & + & 0.0048708358327268_psb_dpk_, & + & 0.0046202548314912_psb_dpk_ ]; + + real(psb_dpk_), parameter :: amg_d_poly_beta_vect(900) = [ & & 1.1250000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, & & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, & & 0.0000000000000000_psb_dpk_, 0.0000000000000000_psb_dpk_, & @@ -511,6 +543,6 @@ module amg_d_poly_coeff_mod !!$ & 1.0238728757031315_psb_dpk_, 1.2640890537108553_psb_dpk_, 0.0_psb_dpk_,& !!$ & 1.0084254478202830_psb_dpk_, 1.0886783920873087_psb_dpk_, 1.3375312590961856_psb_dpk_] - real(psb_dpk_), parameter :: amg_d_beta_mat(30,30)=reshape(amg_d_beta_vect,[30,30]) + real(psb_dpk_), parameter :: amg_d_poly_beta_mat(30,30)=reshape(amg_d_poly_beta_vect,[30,30]) end module amg_d_poly_coeff_mod diff --git a/amgprec/amg_d_poly_smoother.f90 b/amgprec/amg_d_poly_smoother.f90 index 2d0ac1e1..5ba83c24 100644 --- a/amgprec/amg_d_poly_smoother.f90 +++ b/amgprec/amg_d_poly_smoother.f90 @@ -63,6 +63,7 @@ module amg_d_poly_smoother integer(psb_ipk_) :: rho_estimate_iterations=10 type(psb_dspmat_type), pointer :: pa => null() real(psb_dpk_), allocatable :: poly_beta(:) + real(psb_dpk_), allocatable :: poly_a(:) real(psb_dpk_) :: rho_ba = -done contains procedure, pass(sm) :: apply_v => amg_d_poly_smoother_apply_vect diff --git a/amgprec/impl/smoother/amg_d_poly_smoother_bld.f90 b/amgprec/impl/smoother/amg_d_poly_smoother_bld.f90 index d668bac0..4c587f4e 100644 --- a/amgprec/impl/smoother/amg_d_poly_smoother_bld.f90 +++ b/amgprec/impl/smoother/amg_d_poly_smoother_bld.f90 @@ -75,15 +75,37 @@ subroutine amg_d_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) nrow_a = a%get_nrows() nztota = a%get_nzeros() - if ((1<=sm%pdegree).and.(sm%pdegree<=30)) then - call psb_realloc(sm%pdegree,sm%poly_beta,info) - sm%poly_beta(1:sm%pdegree) = amg_d_beta_mat(1:sm%pdegree,sm%pdegree) - else + select case(sm%variant) + case(amg_poly_lottes_) + ! do nothing + case(amg_poly_lottes_beta_) + if ((1<=sm%pdegree).and.(sm%pdegree<=30)) then + call psb_realloc(sm%pdegree,sm%poly_beta,info) + sm%poly_beta(1:sm%pdegree) = amg_d_poly_beta_mat(1:sm%pdegree,sm%pdegree) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,& + & a_err='invalid sm%degree for poly_beta') + goto 9999 + end if + case(amg_poly_new_) + + if ((1<=sm%pdegree).and.(sm%pdegree<=6)) then + call psb_realloc(sm%pdegree,sm%poly_a,info) + sm%poly_a(1:sm%pdegree) = amg_d_poly_a_vect(1:sm%pdegree) + else + info = psb_err_internal_error_ + call psb_errpush(info,name,& + & a_err='invalid sm%degree for poly_a') + goto 9999 + end if + case default info = psb_err_internal_error_ call psb_errpush(info,name,& - & a_err='invalid sm%degree') + & a_err='invalid sm%variant') goto 9999 - end if + end select + sm%pa => a if (.not.allocated(sm%sv)) then info = psb_err_internal_error_ @@ -97,7 +119,7 @@ subroutine amg_d_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) & a_err='sv%build') goto 9999 end if - + !!$ if (.false.) then !!$ select type(ssv => sm%sv) !!$ class is(amg_d_l1_diag_solver_type) @@ -143,7 +165,7 @@ subroutine amg_d_poly_smoother_bld(a,desc_a,sm,info,amold,vmold,imold) sm%rho_ba = done end select end if - + if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),' end'