mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-20 04:42:10 +00:00
Added GS/FBGS for precs. Fixed 1-level application of twosided.
This commit is contained in:
+110
-14
@@ -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.
|
||||
|
||||
@@ -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
|
||||
|
||||
+110
-14
@@ -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.
|
||||
|
||||
@@ -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
|
||||
|
||||
+110
-14
@@ -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.
|
||||
|
||||
@@ -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
|
||||
|
||||
+110
-14
@@ -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.
|
||||
|
||||
@@ -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
|
||||
|
||||
+15
-16
@@ -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
|
||||
|
||||
+15
-16
@@ -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
|
||||
|
||||
+15
-16
@@ -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
|
||||
|
||||
+15
-16
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user