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.
stopcriterion
Salvatore Filippone 9 years ago
parent fa47b7fcbd
commit 831a622040

@ -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 !!$ write(0,*) 'Jacobi smoother with ',sweeps
!!$ 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) call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
!!$
!!$ if (info /= psb_success_) then if (info /= psb_success_) then
!!$ call psb_errpush(psb_err_internal_error_,& call psb_errpush(psb_err_internal_error_,&
!!$ & name,a_err='Error in sub_aply Jacobi Sweeps = 1') & name,a_err='Error in sub_aply Jacobi Sweeps = 1')
!!$ goto 9999 goto 9999
!!$ endif endif
!!$
!!$ else if (sweeps > 1) then
! Note: I had to take out the ==1 optimization for the sake of GS.
if (sweeps >= 1) then
else if (sweeps >= 1) then
! !
! !
! Apply multiple sweeps of a block-Jacobi solver ! Apply multiple sweeps of a block-Jacobi solver

@ -494,18 +494,18 @@ contains
write(iout,*) ' Smoother position: ',& write(iout,*) ' Smoother position: ',&
& smooth_pos_names(pm%smoother_pos) & smooth_pos_names(pm%smoother_pos)
if (pm%ml_type == mld_add_ml_) then if (pm%ml_type == mld_add_ml_) then
write(iout,*) ' Number of sweeps : ',& write(iout,*) ' Number of smoother sweeps : ',&
& pm%sweeps & pm%sweeps
else else
select case (pm%smoother_pos) select case (pm%smoother_pos)
case (mld_pre_smooth_) case (mld_pre_smooth_)
write(iout,*) ' Number of sweeps : ',& write(iout,*) ' Number of smoother sweeps : ',&
& pm%sweeps_pre & pm%sweeps_pre
case (mld_post_smooth_) case (mld_post_smooth_)
write(iout,*) ' Number of sweeps : ',& write(iout,*) ' Number of smoother sweeps : ',&
& pm%sweeps_post & pm%sweeps_post
case (mld_twoside_smooth_) case (mld_twoside_smooth_)
write(iout,*) ' Number of sweeps : pre: ',& write(iout,*) ' Number of smoother sweeps : pre: ',&
& pm%sweeps_pre ,& & pm%sweeps_pre ,&
& ' post: ',& & ' post: ',&
& pm%sweeps_post & pm%sweeps_post

@ -107,10 +107,12 @@ module mld_d_base_solver_mod
procedure, pass(sv) :: get_nzeros => d_base_solver_get_nzeros procedure, pass(sv) :: get_nzeros => d_base_solver_get_nzeros
procedure, nopass :: stringval => mld_stringval procedure, nopass :: stringval => mld_stringval
procedure, nopass :: get_fmt => d_base_solver_get_fmt 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 end type mld_d_base_solver_type
private :: d_base_solver_sizeof, d_base_solver_default,& 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 interface
@ -386,5 +388,15 @@ contains
val = "Base solver" val = "Base solver"
end function d_base_solver_get_fmt 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 end module mld_d_base_solver_mod

@ -71,6 +71,7 @@ module mld_d_gs_solver
procedure, pass(sv) :: sizeof => d_gs_solver_sizeof procedure, pass(sv) :: sizeof => d_gs_solver_sizeof
procedure, pass(sv) :: get_nzeros => d_gs_solver_get_nzeros procedure, pass(sv) :: get_nzeros => d_gs_solver_get_nzeros
procedure, nopass :: get_fmt => d_gs_solver_get_fmt 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 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_descr, d_gs_solver_sizeof, &
& d_gs_solver_default, d_gs_solver_dmp, & & d_gs_solver_default, d_gs_solver_dmp, &
& d_gs_solver_apply_vect, d_gs_solver_get_nzeros, & & 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 interface
@ -501,4 +503,16 @@ contains
val = "Gauss-Seidel solver" val = "Gauss-Seidel solver"
end function d_gs_solver_get_fmt 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 end module mld_d_gs_solver

@ -471,7 +471,7 @@ contains
call p%precv(1)%sm%descr(info,iout=iout_) call p%precv(1)%sm%descr(info,iout=iout_)
if (nlev == 1) then if (nlev == 1) then
if (p%precv(1)%parms%sweeps > 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 & p%precv(1)%parms%sweeps
end if end if
write(iout_,*) write(iout_,*)

Loading…
Cancel
Save