diff --git a/mlprec/impl/mld_cprecaply.f90 b/mlprec/impl/mld_cprecaply.f90 index 132c5ac6..81c75254 100644 --- a/mlprec/impl/mld_cprecaply.f90 +++ b/mlprec/impl/mld_cprecaply.f90 @@ -89,6 +89,8 @@ subroutine mld_cprecaply(prec,x,y,desc_data,info,trans,work) ! Local variables character :: trans_ complex(psb_spk_), pointer :: work_(:) + complex(psb_spk_), allocatable :: ww(:) + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act,iwsz character(len=20) :: name @@ -141,9 +143,43 @@ subroutine mld_cprecaply(prec,x,y,desc_data,info,trans,work) ! ! Number of levels = 1: apply the base preconditioner ! - call prec%precv(1)%sm%apply(cone,x,czero,y,desc_data,trans_,& - & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post), & - & work_,info) + ! + ! Number of levels = 1: apply the base preconditioner + ! + if (allocated(prec%precv(1)%sm2a)) then + ! + ! This is a kludge for handling the symmetrized GS case. + ! Will need some rethinking. + ! + allocate(ww(size(x))) + + select case(trans_) + case ('N') + call prec%precv(1)%sm%apply(cone,x,czero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm2a%apply(cone,ww,czero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case('T','C') + call prec%precv(1)%sm2a%apply(cone,x,czero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm%apply(cone,ww,czero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case default + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Invalid trans') + goto 9999 + end select + deallocate(ww) + + else + call prec%precv(1)%sm%apply(cone,x,czero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post), & + & work_,info) + end if else info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='Invalid size of precv',& @@ -334,10 +370,43 @@ subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work) ! ! Number of levels = 1: apply the base preconditioner ! - call prec%precv(1)%sm%apply(cone,x,czero,y,desc_data,trans_,& - & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& - & work_,info) - + if (allocated(prec%precv(1)%sm2a)) then + ! + ! This is a kludge for handling the symmetrized GS case. + ! Will need some rethinking. + ! + twoside: block + type(psb_c_vect_type) :: ww + call psb_geasb(ww,desc_data,info,mold=x%v,scratch=.true.) + + select case(trans_) + case ('N') + call prec%precv(1)%sm%apply(cone,x,czero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm2a%apply(cone,ww,czero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case('T','C') + call prec%precv(1)%sm2a%apply(cone,x,czero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm%apply(cone,ww,czero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case default + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Invalid trans') + goto 9999 + end select + call psb_gefree(ww,desc_data,info) + end block twoside + + else + call prec%precv(1)%sm%apply(cone,x,czero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + end if else info = psb_err_from_subroutine_ai_ @@ -369,9 +438,9 @@ subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work) use psb_base_mod use mld_c_inner_mod!, mld_protect_name => mld_cprecaply1_vect - + implicit none - + ! Arguments type(psb_desc_type),intent(in) :: desc_data type(mld_cprec_type), intent(inout) :: prec @@ -427,7 +496,7 @@ subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work) ! Number of levels > 1: apply the multilevel preconditioner ! call mld_mlprec_aply(cone,prec,x,czero,ww,desc_data,trans_,work_,info) - + if (info == 0) call psb_geaxpby(cone,ww,czero,x,desc_data,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_cmlprec_aply') goto 9999 @@ -437,10 +506,38 @@ subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work) ! ! Number of levels = 1: apply the base preconditioner ! - call prec%precv(1)%sm%apply(cone,x,czero,ww,desc_data,trans_,& - & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& - & work_,info) - + if (allocated(prec%precv(1)%sm2a)) then + ! + ! This is a kludge for handling the symmetrized GS case. + ! Will need some rethinking. + ! + select case(trans_) + case ('N') + call prec%precv(1)%sm%apply(cone,x,czero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm2a%apply(cone,ww,czero,x,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case('T','C') + call prec%precv(1)%sm2a%apply(cone,x,czero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm%apply(cone,ww,czero,x,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case default + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Invalid trans') + goto 9999 + end select + + else + call prec%precv(1)%sm%apply(cone,x,czero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + if (info == 0) call psb_geaxpby(cone,ww,czero,x,desc_data,info) + end if else info = psb_err_from_subroutine_ai_ @@ -449,7 +546,6 @@ subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work) goto 9999 endif - if (info == 0) call psb_geaxpby(cone,ww,czero,x,desc_data,info) if (info == 0) call psb_gefree(ww,desc_data,info) ! If the original distribution has an overlap we should fix that. diff --git a/mlprec/impl/mld_cprecinit.F90 b/mlprec/impl/mld_cprecinit.F90 index 3978c38c..dae06f2c 100644 --- a/mlprec/impl/mld_cprecinit.F90 +++ b/mlprec/impl/mld_cprecinit.F90 @@ -48,9 +48,9 @@ ! ! 'NOPREC' - no preconditioner ! -! 'DIAG' - diagonal preconditioner +! 'DIAG', 'JACOBI' - diagonal/Jacobi ! -! 'PJAC' - point Jacobi preconditioner +! 'GS', 'FBGS' - Hybrid Gauss-Seidel, also symmetrized ! ! 'BJAC' - block Jacobi preconditioner, with ILU(0) ! on the local blocks @@ -92,6 +92,7 @@ subroutine mld_cprecinit(prec,ptype,info) use mld_c_id_solver use mld_c_diag_solver use mld_c_ilu_solver + use mld_c_gs_solver #if defined(HAVE_SLU_) use mld_c_slu_solver #endif @@ -137,6 +138,41 @@ subroutine mld_cprecinit(prec,ptype,info) allocate(mld_c_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) call prec%precv(ilev_)%default() + case ('GS','FWGS') + nlev_ = 1 + ilev_ = 1 + allocate(prec%precv(nlev_),stat=info) + allocate(mld_c_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) + if (info /= psb_success_) return + allocate(mld_c_gs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) + call prec%precv(ilev_)%default() + + case ('BWGS') + nlev_ = 1 + ilev_ = 1 + allocate(prec%precv(nlev_),stat=info) + allocate(mld_c_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) + if (info /= psb_success_) return + allocate(mld_c_bwgs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) + call prec%precv(ilev_)%default() + + case ('FBGS') + nlev_ = 1 + ilev_ = 1 + allocate(prec%precv(nlev_),stat=info) + call prec%set('SMOOTHER_TYPE','FBGS',info) +!!$ +!!$ fbgs: block +!!$ type(mld_c_jac_smoother_type) :: mld_c_jac_smoother_mold +!!$ type(mld_c_gs_solver_type) :: mld_c_gs_solver_mold +!!$ type(mld_c_bwgs_solver_type) :: mld_c_bwgs_solver_mold +!!$ call prec%precv(nlev_)%set(mld_c_jac_smoother_mold,info,pos='pre') +!!$ if (info == 0) call prec%precv(nlev_)%set(mld_c_gs_solver_mold,info,pos='pre') +!!$ if (info == 0) call prec%precv(nlev_)%set(mld_c_jac_smoother_mold,info,pos='post') +!!$ if (info == 0) call prec%precv(nlev_)%set(mld_c_bwgs_solver_mold,info,pos='post') +!!$ end block fbgs + call prec%precv(ilev_)%default() + case ('BJAC') nlev_ = 1 ilev_ = 1 diff --git a/mlprec/impl/mld_dprecaply.f90 b/mlprec/impl/mld_dprecaply.f90 index 39b3d013..cdec46b6 100644 --- a/mlprec/impl/mld_dprecaply.f90 +++ b/mlprec/impl/mld_dprecaply.f90 @@ -89,6 +89,8 @@ subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work) ! Local variables character :: trans_ real(psb_dpk_), pointer :: work_(:) + real(psb_dpk_), allocatable :: ww(:) + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act,iwsz character(len=20) :: name @@ -141,9 +143,43 @@ subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work) ! ! Number of levels = 1: apply the base preconditioner ! - call prec%precv(1)%sm%apply(done,x,dzero,y,desc_data,trans_,& - & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post), & - & work_,info) + ! + ! Number of levels = 1: apply the base preconditioner + ! + if (allocated(prec%precv(1)%sm2a)) then + ! + ! This is a kludge for handling the symmetrized GS case. + ! Will need some rethinking. + ! + allocate(ww(size(x))) + + select case(trans_) + case ('N') + call prec%precv(1)%sm%apply(done,x,dzero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm2a%apply(done,ww,dzero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case('T','C') + call prec%precv(1)%sm2a%apply(done,x,dzero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm%apply(done,ww,dzero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case default + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Invalid trans') + goto 9999 + end select + deallocate(ww) + + else + call prec%precv(1)%sm%apply(done,x,dzero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post), & + & work_,info) + end if else info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='Invalid size of precv',& @@ -334,10 +370,43 @@ subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work) ! ! Number of levels = 1: apply the base preconditioner ! - call prec%precv(1)%sm%apply(done,x,dzero,y,desc_data,trans_,& - & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& - & work_,info) - + if (allocated(prec%precv(1)%sm2a)) then + ! + ! This is a kludge for handling the symmetrized GS case. + ! Will need some rethinking. + ! + twoside: block + type(psb_d_vect_type) :: ww + call psb_geasb(ww,desc_data,info,mold=x%v,scratch=.true.) + + select case(trans_) + case ('N') + call prec%precv(1)%sm%apply(done,x,dzero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm2a%apply(done,ww,dzero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case('T','C') + call prec%precv(1)%sm2a%apply(done,x,dzero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm%apply(done,ww,dzero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case default + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Invalid trans') + goto 9999 + end select + call psb_gefree(ww,desc_data,info) + end block twoside + + else + call prec%precv(1)%sm%apply(done,x,dzero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + end if else info = psb_err_from_subroutine_ai_ @@ -369,9 +438,9 @@ subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work) use psb_base_mod use mld_d_inner_mod!, mld_protect_name => mld_dprecaply1_vect - + implicit none - + ! Arguments type(psb_desc_type),intent(in) :: desc_data type(mld_dprec_type), intent(inout) :: prec @@ -427,7 +496,7 @@ subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work) ! Number of levels > 1: apply the multilevel preconditioner ! call mld_mlprec_aply(done,prec,x,dzero,ww,desc_data,trans_,work_,info) - + if (info == 0) call psb_geaxpby(done,ww,dzero,x,desc_data,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_dmlprec_aply') goto 9999 @@ -437,10 +506,38 @@ subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work) ! ! Number of levels = 1: apply the base preconditioner ! - call prec%precv(1)%sm%apply(done,x,dzero,ww,desc_data,trans_,& - & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& - & work_,info) - + if (allocated(prec%precv(1)%sm2a)) then + ! + ! This is a kludge for handling the symmetrized GS case. + ! Will need some rethinking. + ! + select case(trans_) + case ('N') + call prec%precv(1)%sm%apply(done,x,dzero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm2a%apply(done,ww,dzero,x,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case('T','C') + call prec%precv(1)%sm2a%apply(done,x,dzero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm%apply(done,ww,dzero,x,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case default + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Invalid trans') + goto 9999 + end select + + else + call prec%precv(1)%sm%apply(done,x,dzero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + if (info == 0) call psb_geaxpby(done,ww,dzero,x,desc_data,info) + end if else info = psb_err_from_subroutine_ai_ @@ -449,7 +546,6 @@ subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work) goto 9999 endif - if (info == 0) call psb_geaxpby(done,ww,dzero,x,desc_data,info) if (info == 0) call psb_gefree(ww,desc_data,info) ! If the original distribution has an overlap we should fix that. diff --git a/mlprec/impl/mld_dprecinit.F90 b/mlprec/impl/mld_dprecinit.F90 index 783c64cf..ddd9700d 100644 --- a/mlprec/impl/mld_dprecinit.F90 +++ b/mlprec/impl/mld_dprecinit.F90 @@ -48,9 +48,9 @@ ! ! 'NOPREC' - no preconditioner ! -! 'DIAG' - diagonal preconditioner +! 'DIAG', 'JACOBI' - diagonal/Jacobi ! -! 'PJAC' - point Jacobi preconditioner +! 'GS', 'FBGS' - Hybrid Gauss-Seidel, also symmetrized ! ! 'BJAC' - block Jacobi preconditioner, with ILU(0) ! on the local blocks @@ -92,6 +92,7 @@ subroutine mld_dprecinit(prec,ptype,info) use mld_d_id_solver use mld_d_diag_solver use mld_d_ilu_solver + use mld_d_gs_solver #if defined(HAVE_UMF_) use mld_d_umf_solver #endif @@ -140,6 +141,41 @@ subroutine mld_dprecinit(prec,ptype,info) allocate(mld_d_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) call prec%precv(ilev_)%default() + case ('GS','FWGS') + nlev_ = 1 + ilev_ = 1 + allocate(prec%precv(nlev_),stat=info) + allocate(mld_d_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) + if (info /= psb_success_) return + allocate(mld_d_gs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) + call prec%precv(ilev_)%default() + + case ('BWGS') + nlev_ = 1 + ilev_ = 1 + allocate(prec%precv(nlev_),stat=info) + allocate(mld_d_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) + if (info /= psb_success_) return + allocate(mld_d_bwgs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) + call prec%precv(ilev_)%default() + + case ('FBGS') + nlev_ = 1 + ilev_ = 1 + allocate(prec%precv(nlev_),stat=info) + call prec%set('SMOOTHER_TYPE','FBGS',info) +!!$ +!!$ fbgs: block +!!$ type(mld_d_jac_smoother_type) :: mld_d_jac_smoother_mold +!!$ type(mld_d_gs_solver_type) :: mld_d_gs_solver_mold +!!$ type(mld_d_bwgs_solver_type) :: mld_d_bwgs_solver_mold +!!$ call prec%precv(nlev_)%set(mld_d_jac_smoother_mold,info,pos='pre') +!!$ if (info == 0) call prec%precv(nlev_)%set(mld_d_gs_solver_mold,info,pos='pre') +!!$ if (info == 0) call prec%precv(nlev_)%set(mld_d_jac_smoother_mold,info,pos='post') +!!$ if (info == 0) call prec%precv(nlev_)%set(mld_d_bwgs_solver_mold,info,pos='post') +!!$ end block fbgs + call prec%precv(ilev_)%default() + case ('BJAC') nlev_ = 1 ilev_ = 1 diff --git a/mlprec/impl/mld_sprecaply.f90 b/mlprec/impl/mld_sprecaply.f90 index d8c004cc..a9c2da27 100644 --- a/mlprec/impl/mld_sprecaply.f90 +++ b/mlprec/impl/mld_sprecaply.f90 @@ -89,6 +89,8 @@ subroutine mld_sprecaply(prec,x,y,desc_data,info,trans,work) ! Local variables character :: trans_ real(psb_spk_), pointer :: work_(:) + real(psb_spk_), allocatable :: ww(:) + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act,iwsz character(len=20) :: name @@ -141,9 +143,43 @@ subroutine mld_sprecaply(prec,x,y,desc_data,info,trans,work) ! ! Number of levels = 1: apply the base preconditioner ! - call prec%precv(1)%sm%apply(sone,x,szero,y,desc_data,trans_,& - & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post), & - & work_,info) + ! + ! Number of levels = 1: apply the base preconditioner + ! + if (allocated(prec%precv(1)%sm2a)) then + ! + ! This is a kludge for handling the symmetrized GS case. + ! Will need some rethinking. + ! + allocate(ww(size(x))) + + select case(trans_) + case ('N') + call prec%precv(1)%sm%apply(sone,x,szero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm2a%apply(sone,ww,szero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case('T','C') + call prec%precv(1)%sm2a%apply(sone,x,szero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm%apply(sone,ww,szero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case default + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Invalid trans') + goto 9999 + end select + deallocate(ww) + + else + call prec%precv(1)%sm%apply(sone,x,szero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post), & + & work_,info) + end if else info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='Invalid size of precv',& @@ -334,10 +370,43 @@ subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work) ! ! Number of levels = 1: apply the base preconditioner ! - call prec%precv(1)%sm%apply(sone,x,szero,y,desc_data,trans_,& - & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& - & work_,info) - + if (allocated(prec%precv(1)%sm2a)) then + ! + ! This is a kludge for handling the symmetrized GS case. + ! Will need some rethinking. + ! + twoside: block + type(psb_s_vect_type) :: ww + call psb_geasb(ww,desc_data,info,mold=x%v,scratch=.true.) + + select case(trans_) + case ('N') + call prec%precv(1)%sm%apply(sone,x,szero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm2a%apply(sone,ww,szero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case('T','C') + call prec%precv(1)%sm2a%apply(sone,x,szero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm%apply(sone,ww,szero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case default + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Invalid trans') + goto 9999 + end select + call psb_gefree(ww,desc_data,info) + end block twoside + + else + call prec%precv(1)%sm%apply(sone,x,szero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + end if else info = psb_err_from_subroutine_ai_ @@ -369,9 +438,9 @@ subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work) use psb_base_mod use mld_s_inner_mod!, mld_protect_name => mld_sprecaply1_vect - + implicit none - + ! Arguments type(psb_desc_type),intent(in) :: desc_data type(mld_sprec_type), intent(inout) :: prec @@ -427,7 +496,7 @@ subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work) ! Number of levels > 1: apply the multilevel preconditioner ! call mld_mlprec_aply(sone,prec,x,szero,ww,desc_data,trans_,work_,info) - + if (info == 0) call psb_geaxpby(sone,ww,szero,x,desc_data,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_smlprec_aply') goto 9999 @@ -437,10 +506,38 @@ subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work) ! ! Number of levels = 1: apply the base preconditioner ! - call prec%precv(1)%sm%apply(sone,x,szero,ww,desc_data,trans_,& - & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& - & work_,info) - + if (allocated(prec%precv(1)%sm2a)) then + ! + ! This is a kludge for handling the symmetrized GS case. + ! Will need some rethinking. + ! + select case(trans_) + case ('N') + call prec%precv(1)%sm%apply(sone,x,szero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm2a%apply(sone,ww,szero,x,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case('T','C') + call prec%precv(1)%sm2a%apply(sone,x,szero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm%apply(sone,ww,szero,x,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case default + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Invalid trans') + goto 9999 + end select + + else + call prec%precv(1)%sm%apply(sone,x,szero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + if (info == 0) call psb_geaxpby(sone,ww,szero,x,desc_data,info) + end if else info = psb_err_from_subroutine_ai_ @@ -449,7 +546,6 @@ subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work) goto 9999 endif - if (info == 0) call psb_geaxpby(sone,ww,szero,x,desc_data,info) if (info == 0) call psb_gefree(ww,desc_data,info) ! If the original distribution has an overlap we should fix that. diff --git a/mlprec/impl/mld_sprecinit.F90 b/mlprec/impl/mld_sprecinit.F90 index 2ed599d0..ee53dd82 100644 --- a/mlprec/impl/mld_sprecinit.F90 +++ b/mlprec/impl/mld_sprecinit.F90 @@ -48,9 +48,9 @@ ! ! 'NOPREC' - no preconditioner ! -! 'DIAG' - diagonal preconditioner +! 'DIAG', 'JACOBI' - diagonal/Jacobi ! -! 'PJAC' - point Jacobi preconditioner +! 'GS', 'FBGS' - Hybrid Gauss-Seidel, also symmetrized ! ! 'BJAC' - block Jacobi preconditioner, with ILU(0) ! on the local blocks @@ -92,6 +92,7 @@ subroutine mld_sprecinit(prec,ptype,info) use mld_s_id_solver use mld_s_diag_solver use mld_s_ilu_solver + use mld_s_gs_solver #if defined(HAVE_SLU_) use mld_s_slu_solver #endif @@ -137,6 +138,41 @@ subroutine mld_sprecinit(prec,ptype,info) allocate(mld_s_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) call prec%precv(ilev_)%default() + case ('GS','FWGS') + nlev_ = 1 + ilev_ = 1 + allocate(prec%precv(nlev_),stat=info) + allocate(mld_s_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) + if (info /= psb_success_) return + allocate(mld_s_gs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) + call prec%precv(ilev_)%default() + + case ('BWGS') + nlev_ = 1 + ilev_ = 1 + allocate(prec%precv(nlev_),stat=info) + allocate(mld_s_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) + if (info /= psb_success_) return + allocate(mld_s_bwgs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) + call prec%precv(ilev_)%default() + + case ('FBGS') + nlev_ = 1 + ilev_ = 1 + allocate(prec%precv(nlev_),stat=info) + call prec%set('SMOOTHER_TYPE','FBGS',info) +!!$ +!!$ fbgs: block +!!$ type(mld_s_jac_smoother_type) :: mld_s_jac_smoother_mold +!!$ type(mld_s_gs_solver_type) :: mld_s_gs_solver_mold +!!$ type(mld_s_bwgs_solver_type) :: mld_s_bwgs_solver_mold +!!$ call prec%precv(nlev_)%set(mld_s_jac_smoother_mold,info,pos='pre') +!!$ if (info == 0) call prec%precv(nlev_)%set(mld_s_gs_solver_mold,info,pos='pre') +!!$ if (info == 0) call prec%precv(nlev_)%set(mld_s_jac_smoother_mold,info,pos='post') +!!$ if (info == 0) call prec%precv(nlev_)%set(mld_s_bwgs_solver_mold,info,pos='post') +!!$ end block fbgs + call prec%precv(ilev_)%default() + case ('BJAC') nlev_ = 1 ilev_ = 1 diff --git a/mlprec/impl/mld_zprecaply.f90 b/mlprec/impl/mld_zprecaply.f90 index 8ec4cc79..ee417635 100644 --- a/mlprec/impl/mld_zprecaply.f90 +++ b/mlprec/impl/mld_zprecaply.f90 @@ -89,6 +89,8 @@ subroutine mld_zprecaply(prec,x,y,desc_data,info,trans,work) ! Local variables character :: trans_ complex(psb_dpk_), pointer :: work_(:) + complex(psb_dpk_), allocatable :: ww(:) + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act,iwsz character(len=20) :: name @@ -141,9 +143,43 @@ subroutine mld_zprecaply(prec,x,y,desc_data,info,trans,work) ! ! Number of levels = 1: apply the base preconditioner ! - call prec%precv(1)%sm%apply(zone,x,zzero,y,desc_data,trans_,& - & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post), & - & work_,info) + ! + ! Number of levels = 1: apply the base preconditioner + ! + if (allocated(prec%precv(1)%sm2a)) then + ! + ! This is a kludge for handling the symmetrized GS case. + ! Will need some rethinking. + ! + allocate(ww(size(x))) + + select case(trans_) + case ('N') + call prec%precv(1)%sm%apply(zone,x,zzero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm2a%apply(zone,ww,zzero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case('T','C') + call prec%precv(1)%sm2a%apply(zone,x,zzero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm%apply(zone,ww,zzero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case default + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Invalid trans') + goto 9999 + end select + deallocate(ww) + + else + call prec%precv(1)%sm%apply(zone,x,zzero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post), & + & work_,info) + end if else info = psb_err_from_subroutine_ai_ call psb_errpush(info,name,a_err='Invalid size of precv',& @@ -334,10 +370,43 @@ subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work) ! ! Number of levels = 1: apply the base preconditioner ! - call prec%precv(1)%sm%apply(zone,x,zzero,y,desc_data,trans_,& - & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& - & work_,info) - + if (allocated(prec%precv(1)%sm2a)) then + ! + ! This is a kludge for handling the symmetrized GS case. + ! Will need some rethinking. + ! + twoside: block + type(psb_z_vect_type) :: ww + call psb_geasb(ww,desc_data,info,mold=x%v,scratch=.true.) + + select case(trans_) + case ('N') + call prec%precv(1)%sm%apply(zone,x,zzero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm2a%apply(zone,ww,zzero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case('T','C') + call prec%precv(1)%sm2a%apply(zone,x,zzero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm%apply(zone,ww,zzero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case default + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Invalid trans') + goto 9999 + end select + call psb_gefree(ww,desc_data,info) + end block twoside + + else + call prec%precv(1)%sm%apply(zone,x,zzero,y,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + end if else info = psb_err_from_subroutine_ai_ @@ -369,9 +438,9 @@ subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work) use psb_base_mod use mld_z_inner_mod!, mld_protect_name => mld_zprecaply1_vect - + implicit none - + ! Arguments type(psb_desc_type),intent(in) :: desc_data type(mld_zprec_type), intent(inout) :: prec @@ -427,7 +496,7 @@ subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work) ! Number of levels > 1: apply the multilevel preconditioner ! call mld_mlprec_aply(zone,prec,x,zzero,ww,desc_data,trans_,work_,info) - + if (info == 0) call psb_geaxpby(zone,ww,zzero,x,desc_data,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_zmlprec_aply') goto 9999 @@ -437,10 +506,38 @@ subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work) ! ! Number of levels = 1: apply the base preconditioner ! - call prec%precv(1)%sm%apply(zone,x,zzero,ww,desc_data,trans_,& - & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& - & work_,info) - + if (allocated(prec%precv(1)%sm2a)) then + ! + ! This is a kludge for handling the symmetrized GS case. + ! Will need some rethinking. + ! + select case(trans_) + case ('N') + call prec%precv(1)%sm%apply(zone,x,zzero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm2a%apply(zone,ww,zzero,x,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case('T','C') + call prec%precv(1)%sm2a%apply(zone,x,zzero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + call prec%precv(1)%sm%apply(zone,ww,zzero,x,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + case default + info = psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='Invalid trans') + goto 9999 + end select + + else + call prec%precv(1)%sm%apply(zone,x,zzero,ww,desc_data,trans_,& + & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),& + & work_,info) + if (info == 0) call psb_geaxpby(zone,ww,zzero,x,desc_data,info) + end if else info = psb_err_from_subroutine_ai_ @@ -449,7 +546,6 @@ subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work) goto 9999 endif - if (info == 0) call psb_geaxpby(zone,ww,zzero,x,desc_data,info) if (info == 0) call psb_gefree(ww,desc_data,info) ! If the original distribution has an overlap we should fix that. diff --git a/mlprec/impl/mld_zprecinit.F90 b/mlprec/impl/mld_zprecinit.F90 index 60078267..5ce5b158 100644 --- a/mlprec/impl/mld_zprecinit.F90 +++ b/mlprec/impl/mld_zprecinit.F90 @@ -48,9 +48,9 @@ ! ! 'NOPREC' - no preconditioner ! -! 'DIAG' - diagonal preconditioner +! 'DIAG', 'JACOBI' - diagonal/Jacobi ! -! 'PJAC' - point Jacobi preconditioner +! 'GS', 'FBGS' - Hybrid Gauss-Seidel, also symmetrized ! ! 'BJAC' - block Jacobi preconditioner, with ILU(0) ! on the local blocks @@ -92,6 +92,7 @@ subroutine mld_zprecinit(prec,ptype,info) use mld_z_id_solver use mld_z_diag_solver use mld_z_ilu_solver + use mld_z_gs_solver #if defined(HAVE_UMF_) use mld_z_umf_solver #endif @@ -140,6 +141,41 @@ subroutine mld_zprecinit(prec,ptype,info) allocate(mld_z_diag_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) call prec%precv(ilev_)%default() + case ('GS','FWGS') + nlev_ = 1 + ilev_ = 1 + allocate(prec%precv(nlev_),stat=info) + allocate(mld_z_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) + if (info /= psb_success_) return + allocate(mld_z_gs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) + call prec%precv(ilev_)%default() + + case ('BWGS') + nlev_ = 1 + ilev_ = 1 + allocate(prec%precv(nlev_),stat=info) + allocate(mld_z_jac_smoother_type :: prec%precv(ilev_)%sm, stat=info) + if (info /= psb_success_) return + allocate(mld_z_bwgs_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) + call prec%precv(ilev_)%default() + + case ('FBGS') + nlev_ = 1 + ilev_ = 1 + allocate(prec%precv(nlev_),stat=info) + call prec%set('SMOOTHER_TYPE','FBGS',info) +!!$ +!!$ fbgs: block +!!$ type(mld_z_jac_smoother_type) :: mld_z_jac_smoother_mold +!!$ type(mld_z_gs_solver_type) :: mld_z_gs_solver_mold +!!$ type(mld_z_bwgs_solver_type) :: mld_z_bwgs_solver_mold +!!$ call prec%precv(nlev_)%set(mld_z_jac_smoother_mold,info,pos='pre') +!!$ if (info == 0) call prec%precv(nlev_)%set(mld_z_gs_solver_mold,info,pos='pre') +!!$ if (info == 0) call prec%precv(nlev_)%set(mld_z_jac_smoother_mold,info,pos='post') +!!$ if (info == 0) call prec%precv(nlev_)%set(mld_z_bwgs_solver_mold,info,pos='post') +!!$ end block fbgs + call prec%precv(ilev_)%default() + case ('BJAC') nlev_ = 1 ilev_ = 1 diff --git a/mlprec/mld_c_prec_type.f90 b/mlprec/mld_c_prec_type.f90 index 1c2edfec..cb0dbb8b 100644 --- a/mlprec/mld_c_prec_type.f90 +++ b/mlprec/mld_c_prec_type.f90 @@ -580,7 +580,6 @@ contains & prec%precv(1)%parms%sweeps_pre end if write(iout_,*) - return end if if (allocated(prec%precv(1)%sm2a)) then write(iout_,*) 'Post smoother details' @@ -591,25 +590,25 @@ contains & prec%precv(1)%parms%sweeps_post end if write(iout_,*) - return end if end if end if - ! - ! Print multilevel details - ! - write(iout_,*) - write(iout_,*) 'Multilevel details' - write(iout_,*) ' Number of levels : ',nlev - write(iout_,*) ' Operator complexity: ',prec%get_complexity() - ilmin = 2 - if (nlev == 2) ilmin=1 - do ilev=ilmin,nlev - call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_) - end do - write(iout_,*) - + if (nlev > 1) then + ! + ! Print multilevel details + ! + write(iout_,*) + write(iout_,*) 'Multilevel details' + write(iout_,*) ' Number of levels : ',nlev + write(iout_,*) ' Operator complexity: ',prec%get_complexity() + ilmin = 2 + if (nlev == 2) ilmin=1 + do ilev=ilmin,nlev + call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_) + end do + write(iout_,*) + end if end if else diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index bdf2922b..bc489f7c 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -580,7 +580,6 @@ contains & prec%precv(1)%parms%sweeps_pre end if write(iout_,*) - return end if if (allocated(prec%precv(1)%sm2a)) then write(iout_,*) 'Post smoother details' @@ -591,25 +590,25 @@ contains & prec%precv(1)%parms%sweeps_post end if write(iout_,*) - return end if end if end if - ! - ! Print multilevel details - ! - write(iout_,*) - write(iout_,*) 'Multilevel details' - write(iout_,*) ' Number of levels : ',nlev - write(iout_,*) ' Operator complexity: ',prec%get_complexity() - ilmin = 2 - if (nlev == 2) ilmin=1 - do ilev=ilmin,nlev - call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_) - end do - write(iout_,*) - + if (nlev > 1) then + ! + ! Print multilevel details + ! + write(iout_,*) + write(iout_,*) 'Multilevel details' + write(iout_,*) ' Number of levels : ',nlev + write(iout_,*) ' Operator complexity: ',prec%get_complexity() + ilmin = 2 + if (nlev == 2) ilmin=1 + do ilev=ilmin,nlev + call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_) + end do + write(iout_,*) + end if end if else diff --git a/mlprec/mld_s_prec_type.f90 b/mlprec/mld_s_prec_type.f90 index 57a1a9bb..cc1160a5 100644 --- a/mlprec/mld_s_prec_type.f90 +++ b/mlprec/mld_s_prec_type.f90 @@ -580,7 +580,6 @@ contains & prec%precv(1)%parms%sweeps_pre end if write(iout_,*) - return end if if (allocated(prec%precv(1)%sm2a)) then write(iout_,*) 'Post smoother details' @@ -591,25 +590,25 @@ contains & prec%precv(1)%parms%sweeps_post end if write(iout_,*) - return end if end if end if - ! - ! Print multilevel details - ! - write(iout_,*) - write(iout_,*) 'Multilevel details' - write(iout_,*) ' Number of levels : ',nlev - write(iout_,*) ' Operator complexity: ',prec%get_complexity() - ilmin = 2 - if (nlev == 2) ilmin=1 - do ilev=ilmin,nlev - call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_) - end do - write(iout_,*) - + if (nlev > 1) then + ! + ! Print multilevel details + ! + write(iout_,*) + write(iout_,*) 'Multilevel details' + write(iout_,*) ' Number of levels : ',nlev + write(iout_,*) ' Operator complexity: ',prec%get_complexity() + ilmin = 2 + if (nlev == 2) ilmin=1 + do ilev=ilmin,nlev + call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_) + end do + write(iout_,*) + end if end if else diff --git a/mlprec/mld_z_prec_type.f90 b/mlprec/mld_z_prec_type.f90 index 84a72967..1f8e9442 100644 --- a/mlprec/mld_z_prec_type.f90 +++ b/mlprec/mld_z_prec_type.f90 @@ -580,7 +580,6 @@ contains & prec%precv(1)%parms%sweeps_pre end if write(iout_,*) - return end if if (allocated(prec%precv(1)%sm2a)) then write(iout_,*) 'Post smoother details' @@ -591,25 +590,25 @@ contains & prec%precv(1)%parms%sweeps_post end if write(iout_,*) - return end if end if end if - ! - ! Print multilevel details - ! - write(iout_,*) - write(iout_,*) 'Multilevel details' - write(iout_,*) ' Number of levels : ',nlev - write(iout_,*) ' Operator complexity: ',prec%get_complexity() - ilmin = 2 - if (nlev == 2) ilmin=1 - do ilev=ilmin,nlev - call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_) - end do - write(iout_,*) - + if (nlev > 1) then + ! + ! Print multilevel details + ! + write(iout_,*) + write(iout_,*) 'Multilevel details' + write(iout_,*) ' Number of levels : ',nlev + write(iout_,*) ' Operator complexity: ',prec%get_complexity() + ilmin = 2 + if (nlev == 2) ilmin=1 + do ilev=ilmin,nlev + call prec%precv(ilev)%descr(ilev,nlev,ilmin,info,iout=iout_) + end do + write(iout_,*) + end if end if else diff --git a/tests/fileread/mld_cf_sample.f90 b/tests/fileread/mld_cf_sample.f90 index ecf8df62..f4703158 100644 --- a/tests/fileread/mld_cf_sample.f90 +++ b/tests/fileread/mld_cf_sample.f90 @@ -67,9 +67,10 @@ program mld_cf_sample character(len=40) :: descr ! verbose description of the prec character(len=10) :: ptype ! preconditioner type + integer(psb_ipk_) :: outer_sweeps ! number of outer sweeps: sweeps for 1-level, + ! AMG cycles for ML ! general AMG data character(len=16) :: mlcycle ! AMG cycle type - integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner ! AMG aggregation @@ -362,8 +363,12 @@ program mld_cf_sample ! call prec%init(p_choice%ptype,info) select case(trim(psb_toupper(p_choice%ptype))) - case ('NONE','NOPREC','JACOBI') + case ('NONE','NOPREC') ! Do nothing, keep defaults + + case ('JACOBI','GS','FWGS','FBGS') + ! 1-level sweeps from "outer_sweeps" + call prec%set('smoother_sweeps', p_choice%outer_sweeps, info) case ('BJAC') call prec%set('smoother_sweeps', p_choice%jsweeps, info) @@ -384,7 +389,7 @@ program mld_cf_sample ! multilevel preconditioner call prec%set('ml_cycle', p_choice%mlcycle, info) - call prec%set('outer_sweeps', p_choice%otr_sweeps,info) + call prec%set('outer_sweeps', p_choice%outer_sweeps,info) if (p_choice%csize>0)& & call prec%set('min_coarse_size', p_choice%csize, info) if (p_choice%mncrratio>1)& @@ -404,6 +409,7 @@ program mld_cf_sample call prec%set('aggr_ord', p_choice%aggr_ord, info) call prec%set('aggr_filter', p_choice%aggr_filter,info) + call prec%set('smoother_type', p_choice%smther, info) call prec%set('smoother_sweeps', p_choice%jsweeps, info) call prec%set('sub_ovr', p_choice%novr, info) @@ -613,9 +619,9 @@ contains ! preconditioner type call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec call read_data(prec%ptype,psb_inp_unit) ! preconditioner type + call read_data(prec%outer_sweeps,psb_inp_unit) ! number of 1lev/outer sweeps ! general AMG data call read_data(prec%mlcycle,psb_inp_unit) ! AMG cycle type - call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat ! aggregation @@ -691,7 +697,7 @@ contains if (psb_toupper(prec%ptype) == 'ML') then call psb_bcast(icontxt,prec%mlcycle) - call psb_bcast(icontxt,prec%otr_sweeps) + call psb_bcast(icontxt,prec%outer_sweeps) call psb_bcast(icontxt,prec%maxlevs) call psb_bcast(icontxt,prec%smther2) diff --git a/tests/fileread/mld_df_sample.f90 b/tests/fileread/mld_df_sample.f90 index 190b20b1..bc5fd916 100644 --- a/tests/fileread/mld_df_sample.f90 +++ b/tests/fileread/mld_df_sample.f90 @@ -67,9 +67,10 @@ program mld_df_sample character(len=40) :: descr ! verbose description of the prec character(len=10) :: ptype ! preconditioner type + integer(psb_ipk_) :: outer_sweeps ! number of outer sweeps: sweeps for 1-level, + ! AMG cycles for ML ! general AMG data character(len=16) :: mlcycle ! AMG cycle type - integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner ! AMG aggregation @@ -362,8 +363,12 @@ program mld_df_sample ! call prec%init(p_choice%ptype,info) select case(trim(psb_toupper(p_choice%ptype))) - case ('NONE','NOPREC','JACOBI') + case ('NONE','NOPREC') ! Do nothing, keep defaults + + case ('JACOBI','GS','FWGS','FBGS') + ! 1-level sweeps from "outer_sweeps" + call prec%set('smoother_sweeps', p_choice%outer_sweeps, info) case ('BJAC') call prec%set('smoother_sweeps', p_choice%jsweeps, info) @@ -384,7 +389,7 @@ program mld_df_sample ! multilevel preconditioner call prec%set('ml_cycle', p_choice%mlcycle, info) - call prec%set('outer_sweeps', p_choice%otr_sweeps,info) + call prec%set('outer_sweeps', p_choice%outer_sweeps,info) if (p_choice%csize>0)& & call prec%set('min_coarse_size', p_choice%csize, info) if (p_choice%mncrratio>1)& @@ -404,6 +409,7 @@ program mld_df_sample call prec%set('aggr_ord', p_choice%aggr_ord, info) call prec%set('aggr_filter', p_choice%aggr_filter,info) + call prec%set('smoother_type', p_choice%smther, info) call prec%set('smoother_sweeps', p_choice%jsweeps, info) call prec%set('sub_ovr', p_choice%novr, info) @@ -613,9 +619,9 @@ contains ! preconditioner type call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec call read_data(prec%ptype,psb_inp_unit) ! preconditioner type + call read_data(prec%outer_sweeps,psb_inp_unit) ! number of 1lev/outer sweeps ! general AMG data call read_data(prec%mlcycle,psb_inp_unit) ! AMG cycle type - call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat ! aggregation @@ -691,7 +697,7 @@ contains if (psb_toupper(prec%ptype) == 'ML') then call psb_bcast(icontxt,prec%mlcycle) - call psb_bcast(icontxt,prec%otr_sweeps) + call psb_bcast(icontxt,prec%outer_sweeps) call psb_bcast(icontxt,prec%maxlevs) call psb_bcast(icontxt,prec%smther2) diff --git a/tests/fileread/mld_sf_sample.f90 b/tests/fileread/mld_sf_sample.f90 index a935cacd..15f071c6 100644 --- a/tests/fileread/mld_sf_sample.f90 +++ b/tests/fileread/mld_sf_sample.f90 @@ -67,9 +67,10 @@ program mld_sf_sample character(len=40) :: descr ! verbose description of the prec character(len=10) :: ptype ! preconditioner type + integer(psb_ipk_) :: outer_sweeps ! number of outer sweeps: sweeps for 1-level, + ! AMG cycles for ML ! general AMG data character(len=16) :: mlcycle ! AMG cycle type - integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner ! AMG aggregation @@ -362,8 +363,12 @@ program mld_sf_sample ! call prec%init(p_choice%ptype,info) select case(trim(psb_toupper(p_choice%ptype))) - case ('NONE','NOPREC','JACOBI') + case ('NONE','NOPREC') ! Do nothing, keep defaults + + case ('JACOBI','GS','FWGS','FBGS') + ! 1-level sweeps from "outer_sweeps" + call prec%set('smoother_sweeps', p_choice%outer_sweeps, info) case ('BJAC') call prec%set('smoother_sweeps', p_choice%jsweeps, info) @@ -384,7 +389,7 @@ program mld_sf_sample ! multilevel preconditioner call prec%set('ml_cycle', p_choice%mlcycle, info) - call prec%set('outer_sweeps', p_choice%otr_sweeps,info) + call prec%set('outer_sweeps', p_choice%outer_sweeps,info) if (p_choice%csize>0)& & call prec%set('min_coarse_size', p_choice%csize, info) if (p_choice%mncrratio>1)& @@ -404,6 +409,7 @@ program mld_sf_sample call prec%set('aggr_ord', p_choice%aggr_ord, info) call prec%set('aggr_filter', p_choice%aggr_filter,info) + call prec%set('smoother_type', p_choice%smther, info) call prec%set('smoother_sweeps', p_choice%jsweeps, info) call prec%set('sub_ovr', p_choice%novr, info) @@ -613,9 +619,9 @@ contains ! preconditioner type call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec call read_data(prec%ptype,psb_inp_unit) ! preconditioner type + call read_data(prec%outer_sweeps,psb_inp_unit) ! number of 1lev/outer sweeps ! general AMG data call read_data(prec%mlcycle,psb_inp_unit) ! AMG cycle type - call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat ! aggregation @@ -691,7 +697,7 @@ contains if (psb_toupper(prec%ptype) == 'ML') then call psb_bcast(icontxt,prec%mlcycle) - call psb_bcast(icontxt,prec%otr_sweeps) + call psb_bcast(icontxt,prec%outer_sweeps) call psb_bcast(icontxt,prec%maxlevs) call psb_bcast(icontxt,prec%smther2) diff --git a/tests/fileread/mld_zf_sample.f90 b/tests/fileread/mld_zf_sample.f90 index e853574a..4d5402b7 100644 --- a/tests/fileread/mld_zf_sample.f90 +++ b/tests/fileread/mld_zf_sample.f90 @@ -67,9 +67,10 @@ program mld_zf_sample character(len=40) :: descr ! verbose description of the prec character(len=10) :: ptype ! preconditioner type + integer(psb_ipk_) :: outer_sweeps ! number of outer sweeps: sweeps for 1-level, + ! AMG cycles for ML ! general AMG data character(len=16) :: mlcycle ! AMG cycle type - integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner ! AMG aggregation @@ -362,8 +363,12 @@ program mld_zf_sample ! call prec%init(p_choice%ptype,info) select case(trim(psb_toupper(p_choice%ptype))) - case ('NONE','NOPREC','JACOBI') + case ('NONE','NOPREC') ! Do nothing, keep defaults + + case ('JACOBI','GS','FWGS','FBGS') + ! 1-level sweeps from "outer_sweeps" + call prec%set('smoother_sweeps', p_choice%outer_sweeps, info) case ('BJAC') call prec%set('smoother_sweeps', p_choice%jsweeps, info) @@ -384,7 +389,7 @@ program mld_zf_sample ! multilevel preconditioner call prec%set('ml_cycle', p_choice%mlcycle, info) - call prec%set('outer_sweeps', p_choice%otr_sweeps,info) + call prec%set('outer_sweeps', p_choice%outer_sweeps,info) if (p_choice%csize>0)& & call prec%set('min_coarse_size', p_choice%csize, info) if (p_choice%mncrratio>1)& @@ -404,6 +409,7 @@ program mld_zf_sample call prec%set('aggr_ord', p_choice%aggr_ord, info) call prec%set('aggr_filter', p_choice%aggr_filter,info) + call prec%set('smoother_type', p_choice%smther, info) call prec%set('smoother_sweeps', p_choice%jsweeps, info) call prec%set('sub_ovr', p_choice%novr, info) @@ -613,9 +619,9 @@ contains ! preconditioner type call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec call read_data(prec%ptype,psb_inp_unit) ! preconditioner type + call read_data(prec%outer_sweeps,psb_inp_unit) ! number of 1lev/outer sweeps ! general AMG data call read_data(prec%mlcycle,psb_inp_unit) ! AMG cycle type - call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat ! aggregation @@ -691,7 +697,7 @@ contains if (psb_toupper(prec%ptype) == 'ML') then call psb_bcast(icontxt,prec%mlcycle) - call psb_bcast(icontxt,prec%otr_sweeps) + call psb_bcast(icontxt,prec%outer_sweeps) call psb_bcast(icontxt,prec%maxlevs) call psb_bcast(icontxt,prec%smther2) diff --git a/tests/fileread/runs/cfs.inp b/tests/fileread/runs/cfs.inp index 15db4540..87bba386 100644 --- a/tests/fileread/runs/cfs.inp +++ b/tests/fileread/runs/cfs.inp @@ -13,8 +13,8 @@ CG ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS F 1.d-6 ! EPS ML-VCYCLE-FBGS-R-UMF ! Longer descriptive name for preconditioner (up to 20 chars) ML ! Preconditioner type: NONE JACOBI BJAC AS ML +1 ! Number of sweeps for 1-level, outer sweeps for ML; lines below ignored for non-ML VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MULT ADD -1 ! Number of outer sweeps -3 ! Max Number of levels in a multilevel preconditioner; if <0, lib default -3 ! Target coarse matrix size; if <0, lib default SMOOTHED ! Type of aggregation: SMOOTHED NONSMOOTHED diff --git a/tests/fileread/runs/dfs.inp b/tests/fileread/runs/dfs.inp index 40112477..ccc6fe21 100644 --- a/tests/fileread/runs/dfs.inp +++ b/tests/fileread/runs/dfs.inp @@ -13,8 +13,8 @@ BICGSTAB ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS FC 1.d-6 ! EPS ML-VCYCLE-FBGS-R-UMF ! Longer descriptive name for preconditioner (up to 20 chars) ML ! Preconditioner type: NONE JACOBI BJAC AS ML +1 ! Number of sweeps for 1-level, outer sweeps for ML; lines below ignored for non-ML WCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MULT ADD -1 ! Number of outer sweeps -3 ! Max Number of levels in a multilevel preconditioner; if <0, lib default -3 ! Target coarse matrix size; if <0, lib default SMOOTHED ! Type of aggregation: SMOOTHED NONSMOOTHED diff --git a/tests/fileread/runs/sfs.inp b/tests/fileread/runs/sfs.inp index a2624d30..57725080 100644 --- a/tests/fileread/runs/sfs.inp +++ b/tests/fileread/runs/sfs.inp @@ -13,8 +13,8 @@ CG ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS F 1.d-6 ! EPS ML-VCYCLE-FBGS-R-UMF ! Longer descriptive name for preconditioner (up to 20 chars) ML ! Preconditioner type: NONE JACOBI BJAC AS ML +1 ! Number of sweeps for 1-level, outer sweeps for ML; lines below ignored for non-ML VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MULT ADD -1 ! Number of outer sweeps -3 ! Max Number of levels in a multilevel preconditioner; if <0, lib default -3 ! Target coarse matrix size; if <0, lib default SMOOTHED ! Type of aggregation: SMOOTHED NONSMOOTHED diff --git a/tests/fileread/runs/zfs.inp b/tests/fileread/runs/zfs.inp index 43567422..a748bc1d 100644 --- a/tests/fileread/runs/zfs.inp +++ b/tests/fileread/runs/zfs.inp @@ -13,8 +13,8 @@ CG ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS F 1.d-6 ! EPS ML-VCYCLE-FBGS-R-UMF ! Longer descriptive name for preconditioner (up to 20 chars) ML ! Preconditioner type: NONE JACOBI BJAC AS ML +1 ! Number of sweeps for 1-level, outer sweeps for ML; lines below ignored for non-ML VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MULT ADD -1 ! Number of outer sweeps -3 ! Max Number of levels in a multilevel preconditioner; if <0, lib default -3 ! Target coarse matrix size; if <0, lib default SMOOTHED ! Type of aggregation: SMOOTHED NONSMOOTHED diff --git a/tests/pdegen/mld_d_pde2d.f90 b/tests/pdegen/mld_d_pde2d.f90 index 18d0a532..2e2074b6 100644 --- a/tests/pdegen/mld_d_pde2d.f90 +++ b/tests/pdegen/mld_d_pde2d.f90 @@ -160,9 +160,10 @@ program mld_d_pde2d character(len=40) :: descr ! verbose description of the prec character(len=10) :: ptype ! preconditioner type + integer(psb_ipk_) :: outer_sweeps ! number of outer sweeps: sweeps for 1-level, + ! AMG cycles for ML ! general AMG data character(len=16) :: mlcycle ! AMG cycle type - integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner ! AMG aggregation @@ -268,8 +269,12 @@ program mld_d_pde2d ! call prec%init(p_choice%ptype,info) select case(trim(psb_toupper(p_choice%ptype))) - case ('NONE','NOPREC','JACOBI') + case ('NONE','NOPREC') ! Do nothing, keep defaults + + case ('JACOBI','GS','FWGS','FBGS') + ! 1-level sweeps from "outer_sweeps" + call prec%set('smoother_sweeps', p_choice%outer_sweeps, info) case ('BJAC') call prec%set('smoother_sweeps', p_choice%jsweeps, info) @@ -290,7 +295,7 @@ program mld_d_pde2d ! multilevel preconditioner call prec%set('ml_cycle', p_choice%mlcycle, info) - call prec%set('outer_sweeps', p_choice%otr_sweeps,info) + call prec%set('outer_sweeps', p_choice%outer_sweeps,info) if (p_choice%csize>0)& & call prec%set('min_coarse_size', p_choice%csize, info) if (p_choice%mncrratio>1)& @@ -489,9 +494,9 @@ contains ! preconditioner type call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec call read_data(prec%ptype,psb_inp_unit) ! preconditioner type + call read_data(prec%outer_sweeps,psb_inp_unit) ! number of 1lev/outer sweeps ! general AMG data call read_data(prec%mlcycle,psb_inp_unit) ! AMG cycle type - call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat ! aggregation @@ -562,7 +567,7 @@ contains if (psb_toupper(prec%ptype) == 'ML') then call psb_bcast(icontxt,prec%mlcycle) - call psb_bcast(icontxt,prec%otr_sweeps) + call psb_bcast(icontxt,prec%outer_sweeps) call psb_bcast(icontxt,prec%maxlevs) call psb_bcast(icontxt,prec%smther2) diff --git a/tests/pdegen/mld_d_pde3d.f90 b/tests/pdegen/mld_d_pde3d.f90 index 06d0b22c..1c63fcd2 100644 --- a/tests/pdegen/mld_d_pde3d.f90 +++ b/tests/pdegen/mld_d_pde3d.f90 @@ -172,9 +172,10 @@ program mld_d_pde3d character(len=40) :: descr ! verbose description of the prec character(len=10) :: ptype ! preconditioner type + integer(psb_ipk_) :: outer_sweeps ! number of outer sweeps: sweeps for 1-level, + ! AMG cycles for ML ! general AMG data character(len=16) :: mlcycle ! AMG cycle type - integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner ! AMG aggregation @@ -281,8 +282,12 @@ program mld_d_pde3d ! call prec%init(p_choice%ptype,info) select case(trim(psb_toupper(p_choice%ptype))) - case ('NONE','NOPREC','JACOBI') + case ('NONE','NOPREC') ! Do nothing, keep defaults + + case ('JACOBI','GS','FWGS','FBGS') + ! 1-level sweeps from "outer_sweeps" + call prec%set('smoother_sweeps', p_choice%outer_sweeps, info) case ('BJAC') call prec%set('smoother_sweeps', p_choice%jsweeps, info) @@ -303,7 +308,7 @@ program mld_d_pde3d ! multilevel preconditioner call prec%set('ml_cycle', p_choice%mlcycle, info) - call prec%set('outer_sweeps', p_choice%otr_sweeps,info) + call prec%set('outer_sweeps', p_choice%outer_sweeps,info) if (p_choice%csize>0)& & call prec%set('min_coarse_size', p_choice%csize, info) if (p_choice%mncrratio>1)& @@ -502,9 +507,9 @@ contains ! preconditioner type call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec call read_data(prec%ptype,psb_inp_unit) ! preconditioner type + call read_data(prec%outer_sweeps,psb_inp_unit) ! number of 1lev/outer sweeps ! general AMG data call read_data(prec%mlcycle,psb_inp_unit) ! AMG cycle type - call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat ! aggregation @@ -575,7 +580,7 @@ contains if (psb_toupper(prec%ptype) == 'ML') then call psb_bcast(icontxt,prec%mlcycle) - call psb_bcast(icontxt,prec%otr_sweeps) + call psb_bcast(icontxt,prec%outer_sweeps) call psb_bcast(icontxt,prec%maxlevs) call psb_bcast(icontxt,prec%smther2) diff --git a/tests/pdegen/mld_s_pde2d.f90 b/tests/pdegen/mld_s_pde2d.f90 index d0bade35..960cc129 100644 --- a/tests/pdegen/mld_s_pde2d.f90 +++ b/tests/pdegen/mld_s_pde2d.f90 @@ -160,9 +160,10 @@ program mld_s_pde2d character(len=40) :: descr ! verbose description of the prec character(len=10) :: ptype ! preconditioner type + integer(psb_ipk_) :: outer_sweeps ! number of outer sweeps: sweeps for 1-level, + ! AMG cycles for ML ! general AMG data character(len=16) :: mlcycle ! AMG cycle type - integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner ! AMG aggregation @@ -268,8 +269,12 @@ program mld_s_pde2d ! call prec%init(p_choice%ptype,info) select case(trim(psb_toupper(p_choice%ptype))) - case ('NONE','NOPREC','JACOBI') + case ('NONE','NOPREC') ! Do nothing, keep defaults + + case ('JACOBI','GS','FWGS','FBGS') + ! 1-level sweeps from "outer_sweeps" + call prec%set('smoother_sweeps', p_choice%outer_sweeps, info) case ('BJAC') call prec%set('smoother_sweeps', p_choice%jsweeps, info) @@ -290,7 +295,7 @@ program mld_s_pde2d ! multilevel preconditioner call prec%set('ml_cycle', p_choice%mlcycle, info) - call prec%set('outer_sweeps', p_choice%otr_sweeps,info) + call prec%set('outer_sweeps', p_choice%outer_sweeps,info) if (p_choice%csize>0)& & call prec%set('min_coarse_size', p_choice%csize, info) if (p_choice%mncrratio>1)& @@ -489,9 +494,9 @@ contains ! preconditioner type call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec call read_data(prec%ptype,psb_inp_unit) ! preconditioner type + call read_data(prec%outer_sweeps,psb_inp_unit) ! number of 1lev/outer sweeps ! general AMG data call read_data(prec%mlcycle,psb_inp_unit) ! AMG cycle type - call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat ! aggregation @@ -562,7 +567,7 @@ contains if (psb_toupper(prec%ptype) == 'ML') then call psb_bcast(icontxt,prec%mlcycle) - call psb_bcast(icontxt,prec%otr_sweeps) + call psb_bcast(icontxt,prec%outer_sweeps) call psb_bcast(icontxt,prec%maxlevs) call psb_bcast(icontxt,prec%smther2) diff --git a/tests/pdegen/mld_s_pde3d.f90 b/tests/pdegen/mld_s_pde3d.f90 index 24061045..4102f46f 100644 --- a/tests/pdegen/mld_s_pde3d.f90 +++ b/tests/pdegen/mld_s_pde3d.f90 @@ -172,9 +172,10 @@ program mld_s_pde3d character(len=40) :: descr ! verbose description of the prec character(len=10) :: ptype ! preconditioner type + integer(psb_ipk_) :: outer_sweeps ! number of outer sweeps: sweeps for 1-level, + ! AMG cycles for ML ! general AMG data character(len=16) :: mlcycle ! AMG cycle type - integer(psb_ipk_) :: otr_sweeps ! number of AMG cycles integer(psb_ipk_) :: maxlevs ! maximum number of levels in AMG preconditioner ! AMG aggregation @@ -281,8 +282,12 @@ program mld_s_pde3d ! call prec%init(p_choice%ptype,info) select case(trim(psb_toupper(p_choice%ptype))) - case ('NONE','NOPREC','JACOBI') + case ('NONE','NOPREC') ! Do nothing, keep defaults + + case ('JACOBI','GS','FWGS','FBGS') + ! 1-level sweeps from "outer_sweeps" + call prec%set('smoother_sweeps', p_choice%outer_sweeps, info) case ('BJAC') call prec%set('smoother_sweeps', p_choice%jsweeps, info) @@ -303,7 +308,7 @@ program mld_s_pde3d ! multilevel preconditioner call prec%set('ml_cycle', p_choice%mlcycle, info) - call prec%set('outer_sweeps', p_choice%otr_sweeps,info) + call prec%set('outer_sweeps', p_choice%outer_sweeps,info) if (p_choice%csize>0)& & call prec%set('min_coarse_size', p_choice%csize, info) if (p_choice%mncrratio>1)& @@ -502,9 +507,9 @@ contains ! preconditioner type call read_data(prec%descr,psb_inp_unit) ! verbose description of the prec call read_data(prec%ptype,psb_inp_unit) ! preconditioner type + call read_data(prec%outer_sweeps,psb_inp_unit) ! number of 1lev/outer sweeps ! general AMG data call read_data(prec%mlcycle,psb_inp_unit) ! AMG cycle type - call read_data(prec%otr_sweeps,psb_inp_unit) ! number of AMG cycles call read_data(prec%maxlevs,psb_inp_unit) ! max number of levels in AMG prec call read_data(prec%csize,psb_inp_unit) ! min size coarsest mat ! aggregation @@ -575,7 +580,7 @@ contains if (psb_toupper(prec%ptype) == 'ML') then call psb_bcast(icontxt,prec%mlcycle) - call psb_bcast(icontxt,prec%otr_sweeps) + call psb_bcast(icontxt,prec%outer_sweeps) call psb_bcast(icontxt,prec%maxlevs) call psb_bcast(icontxt,prec%smther2) diff --git a/tests/pdegen/runs/mld_pde2d.inp b/tests/pdegen/runs/mld_pde2d.inp index 7d291fb1..c9b43b57 100644 --- a/tests/pdegen/runs/mld_pde2d.inp +++ b/tests/pdegen/runs/mld_pde2d.inp @@ -7,9 +7,9 @@ CG ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS F 30 ! IRST (restart for RGMRES and BiCGSTABL) 1.d-6 ! EPS ML-VCYCLE-FBGS-R-UMF ! Longer descriptive name for preconditioner (up to 20 chars) -ML ! Preconditioner type: NONE JACOBI BJAC AS ML -VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE KCYCLESYM MULT ADD -1 ! Number of outer sweeps +FBGS ! Preconditioner type: NONE JACOBI GS FBGS BJAC AS ML +4 ! Number of sweeps for 1-level, outer sweeps for ML; lines below ignored for non-ML +VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MULT ADD -3 ! Max Number of levels in a multilevel preconditioner; if <0, lib default -3 ! Target coarse matrix size; if <0, lib default SMOOTHED ! Type of aggregation: SMOOTHED NONSMOOTHED diff --git a/tests/pdegen/runs/mld_pde3d.inp b/tests/pdegen/runs/mld_pde3d.inp index fcda079b..cc34d086 100644 --- a/tests/pdegen/runs/mld_pde3d.inp +++ b/tests/pdegen/runs/mld_pde3d.inp @@ -7,9 +7,9 @@ CG ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS F 30 ! IRST (restart for RGMRES and BiCGSTABL) 1.d-6 ! EPS ML-VCYCLE-FBGS-R-UMF ! Longer descriptive name for preconditioner (up to 20 chars) -ML ! Preconditioner type: NONE JACOBI BJAC AS ML +ML ! Preconditioner type: NONE JACOBI GS FBGS BJAC AS ML +4 ! Number of sweeps for 1-level, outer sweeps for ML; lines below ignored for non-ML VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MULT ADD -1 ! Number of outer sweeps -3 ! Max Number of levels in a multilevel preconditioner; if <0, lib default -3 ! Target coarse matrix size; if <0, lib default SMOOTHED ! Type of aggregation: SMOOTHED NONSMOOTHED @@ -21,7 +21,7 @@ NOFILTER ! Filtering of matrix ? FILTER NOFILTER 0.05 0.025 ! Thresholds 0.0100d0 ! Smoothed aggregation threshold: >= 0.0 FBGS ! Smoother type JACOBI FBGS GS BGS BJAC AS; ignored for non-ML -1 ! Number of sweeps for (pre) smoother +2 ! Number of sweeps for (pre) smoother 0 ! Number of overlap layers for AS preconditioner HALO ! AS restriction operator: NONE HALO NONE ! AS prolongation operator: NONE SUM AVG