From 831a6220401551e93d7319d9f59e07d83e14aacf Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 27 Feb 2016 19:01:57 +0000 Subject: [PATCH] mld2p4-2: mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90 mlprec/mld_base_prec_type.F90 mlprec/mld_d_base_solver_mod.f90 mlprec/mld_d_gs_solver.f90 mlprec/mld_d_prec_type.f90 Now GS seems to be working properly. --- .../mld_d_jac_smoother_apply_vect.f90 | 23 ++++++++----------- mlprec/mld_base_prec_type.F90 | 8 +++---- mlprec/mld_d_base_solver_mod.f90 | 14 ++++++++++- mlprec/mld_d_gs_solver.f90 | 16 ++++++++++++- mlprec/mld_d_prec_type.f90 | 2 +- 5 files changed, 43 insertions(+), 20 deletions(-) diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90 index cc2ae2c8..06664099 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90 @@ -109,20 +109,17 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& !!$ write(0,*) 'Jacobi smoother with ',sweeps -!!$ if (sweeps == 1) then -!!$ -!!$ call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info) -!!$ -!!$ if (info /= psb_success_) then -!!$ call psb_errpush(psb_err_internal_error_,& -!!$ & name,a_err='Error in sub_aply Jacobi Sweeps = 1') -!!$ goto 9999 -!!$ endif -!!$ -!!$ else if (sweeps > 1) then - ! Note: I had to take out the ==1 optimization for the sake of GS. - if (sweeps >= 1) then + if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then + + call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info) + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,& + & name,a_err='Error in sub_aply Jacobi Sweeps = 1') + goto 9999 + endif + else if (sweeps >= 1) then ! ! ! Apply multiple sweeps of a block-Jacobi solver diff --git a/mlprec/mld_base_prec_type.F90 b/mlprec/mld_base_prec_type.F90 index 635be97e..643b00b3 100644 --- a/mlprec/mld_base_prec_type.F90 +++ b/mlprec/mld_base_prec_type.F90 @@ -494,18 +494,18 @@ contains write(iout,*) ' Smoother position: ',& & smooth_pos_names(pm%smoother_pos) if (pm%ml_type == mld_add_ml_) then - write(iout,*) ' Number of sweeps : ',& + write(iout,*) ' Number of smoother sweeps : ',& & pm%sweeps else select case (pm%smoother_pos) case (mld_pre_smooth_) - write(iout,*) ' Number of sweeps : ',& + write(iout,*) ' Number of smoother sweeps : ',& & pm%sweeps_pre case (mld_post_smooth_) - write(iout,*) ' Number of sweeps : ',& + write(iout,*) ' Number of smoother sweeps : ',& & pm%sweeps_post case (mld_twoside_smooth_) - write(iout,*) ' Number of sweeps : pre: ',& + write(iout,*) ' Number of smoother sweeps : pre: ',& & pm%sweeps_pre ,& & ' post: ',& & pm%sweeps_post diff --git a/mlprec/mld_d_base_solver_mod.f90 b/mlprec/mld_d_base_solver_mod.f90 index 38af14da..be2c1b0c 100644 --- a/mlprec/mld_d_base_solver_mod.f90 +++ b/mlprec/mld_d_base_solver_mod.f90 @@ -107,10 +107,12 @@ module mld_d_base_solver_mod procedure, pass(sv) :: get_nzeros => d_base_solver_get_nzeros procedure, nopass :: stringval => mld_stringval procedure, nopass :: get_fmt => d_base_solver_get_fmt + procedure, nopass :: is_iterative => d_base_solver_is_iterative end type mld_d_base_solver_type private :: d_base_solver_sizeof, d_base_solver_default,& - & d_base_solver_get_nzeros, d_base_solver_get_fmt + & d_base_solver_get_nzeros, d_base_solver_get_fmt, & + & d_base_solver_is_iterative interface @@ -386,5 +388,15 @@ contains val = "Base solver" end function d_base_solver_get_fmt + ! + ! If this is true, then the solver needs a starting + ! guess. Currently only handled in JAC smoother. + ! + function d_base_solver_is_iterative() result(val) + implicit none + logical :: val + + val = .false. + end function d_base_solver_is_iterative end module mld_d_base_solver_mod diff --git a/mlprec/mld_d_gs_solver.f90 b/mlprec/mld_d_gs_solver.f90 index 8db34c51..16e884b2 100644 --- a/mlprec/mld_d_gs_solver.f90 +++ b/mlprec/mld_d_gs_solver.f90 @@ -71,6 +71,7 @@ module mld_d_gs_solver procedure, pass(sv) :: sizeof => d_gs_solver_sizeof procedure, pass(sv) :: get_nzeros => d_gs_solver_get_nzeros procedure, nopass :: get_fmt => d_gs_solver_get_fmt + procedure, nopass :: is_iterative => d_gs_solver_is_iterative end type mld_d_gs_solver_type @@ -80,7 +81,8 @@ module mld_d_gs_solver & d_gs_solver_descr, d_gs_solver_sizeof, & & d_gs_solver_default, d_gs_solver_dmp, & & d_gs_solver_apply_vect, d_gs_solver_get_nzeros, & - & d_gs_solver_get_fmt, d_gs_solver_check + & d_gs_solver_get_fmt, d_gs_solver_check,& + & d_gs_solver_is_iterative interface @@ -501,4 +503,16 @@ contains val = "Gauss-Seidel solver" end function d_gs_solver_get_fmt + + ! + ! If this is true, then the solver needs a starting + ! guess. Currently only handled in JAC smoother. + ! + function d_gs_solver_is_iterative() result(val) + implicit none + logical :: val + + val = .true. + end function d_gs_solver_is_iterative + end module mld_d_gs_solver diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index 73b61b9e..134baa15 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -471,7 +471,7 @@ contains call p%precv(1)%sm%descr(info,iout=iout_) if (nlev == 1) then if (p%precv(1)%parms%sweeps > 1) then - write(iout_,*) ' Number of sweeps : ',& + write(iout_,*) ' Number of smoother sweeps : ',& & p%precv(1)%parms%sweeps end if write(iout_,*)