fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 14:44:55 +00:00
Code Issues Packages Projects Releases Wiki Activity

mld2p4-2:

Browse Source 
mlprec/mld_dmlprec_aply.f90
 mlprec/mld_dmlprec_bld.f90
 mlprec/mld_dprecset.f90
 mlprec/mld_move_alloc.f90
 mlprec/mld_move_alloc_mod.f90
 tests/pdegen/ppde.f90
 tests/pdegen/runs/ppde.inp

First working version of multilevel. Further testing to be performed
yet.
This commit is contained in:
Salvatore Filippone
2009-12-11 15:38:54 +00:00
parent 4cef244c64
commit e113012910
6 changed files with 369 additions and 1257 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/mld_dmlprec_aply.f90
+241 -1220
View File
File diff suppressed because it is too large Load Diff
mlprec/mld_dmlprec_bld.f90
+58 -2
View File
@@ -69,6 +69,10 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_dmlprec_bld
use mld_prec_mod
use mld_d_jac_smoother
use mld_d_as_smoother
use mld_d_diag_solver
use mld_d_ilu_solver
Implicit None
@@ -306,8 +310,60 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
call mld_check_def(p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),&
& 'Jacobi sweeps',1,is_legal_jac_sweeps)
call mld_baseprec_bld(p%precv(i)%base_a,p%precv(i)%base_desc,&
& p%precv(i)%prec,info)
!
! Test version for beginning of OO stuff.
!
if (allocated(p%precv(i)%sm)) then
call p%precv(i)%sm%free(info)
if (info ==0) deallocate(p%precv(i)%sm,stat=info)
if (info /= 0) then
call psb_errpush(4000,name,a_err='One level preconditioner build.')
goto 9999
endif
end if
select case (p%precv(i)%prec%iprcparm(mld_smoother_type_))
case(mld_diag_, mld_bjac_, mld_pjac_)
allocate(mld_d_jac_smoother_type :: p%precv(i)%sm, stat=info)
case(mld_as_)
allocate(mld_d_as_smoother_type :: p%precv(i)%sm, stat=info)
case default
info = -1
end select
if (info /= 0) then
write(0,*) ' Smoother allocation error',info,&
& p%precv(i)%prec%iprcparm(mld_smoother_type_)
call psb_errpush(4001,name,a_err='One level preconditioner build.')
goto 9999
endif
call p%precv(i)%sm%set(mld_sub_restr_,p%precv(i)%prec%iprcparm(mld_sub_restr_),info)
call p%precv(i)%sm%set(mld_sub_prol_,p%precv(i)%prec%iprcparm(mld_sub_prol_),info)
call p%precv(i)%sm%set(mld_sub_ovr_,p%precv(i)%prec%iprcparm(mld_sub_ovr_),info)
call p%precv(i)%sm%set(mld_smoother_sweeps_,&
& p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),info)
select case (p%precv(i)%prec%iprcparm(mld_sub_solve_))
case(mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
allocate(mld_d_ilu_solver_type :: p%precv(i)%sm%sv, stat=info)
if (info == 0) call p%precv(i)%sm%sv%set(mld_sub_solve_,&
& p%precv(i)%prec%iprcparm(mld_sub_solve_),info)
if (info == 0) call p%precv(i)%sm%sv%set(mld_sub_fillin_,&
& p%precv(i)%prec%iprcparm(mld_sub_fillin_),info)
if (info == 0) call p%precv(i)%sm%sv%set(mld_sub_iluthrs_,&
& p%precv(i)%prec%rprcparm(mld_sub_iluthrs_),info)
case(mld_diag_scale_)
allocate(mld_d_diag_solver_type :: p%precv(i)%sm%sv, stat=info)
case default
info = -1
end select
if (info /= 0) then
write(0,*) ' Solver allocation error',info,&
& p%precv(i)%prec%iprcparm(mld_sub_solve_)
call psb_errpush(4001,name,a_err='One level preconditioner build.')
goto 9999
endif
call p%precv(i)%sm%build(p%precv(i)%base_a,p%precv(i)%base_desc,'F',info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='One level preconditioner build.')
mlprec/mld_dprecset.f90
+29 -9
View File
@@ -140,7 +140,10 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
! Rules for fine level are slightly different.
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
case(mld_smoother_type_)
p%precv(ilev_)%iprcparm(what) = val
p%precv(ilev_)%prec%iprcparm(what) = val
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,mld_smoother_sweeps_)
p%precv(ilev_)%prec%iprcparm(what) = val
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
@@ -153,7 +156,10 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
else if (ilev_ > 1) then
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
case(mld_smoother_type_)
p%precv(ilev_)%iprcparm(what) = val
p%precv(ilev_)%prec%iprcparm(what) = val
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smoother_sweeps_)
p%precv(ilev_)%prec%iprcparm(what) = val
@@ -220,21 +226,32 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
! levels
!
select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,&
& mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smoother_sweeps_)
do ilev_=1,max(1,nlev_-1)
if (.not.allocated(p%precv(ilev_)%iprcparm)) then
write(0,*) name,&
&': Error: uninitialized preconditioner component,',&
&' should call MLD_PRECINIT'
&': Error: uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%precv(ilev_)%iprcparm(what) = val
p%precv(ilev_)%prec%iprcparm(what) = val
end do
case(mld_smoother_type_)
do ilev_=1,nlev_
if (.not.allocated(p%precv(ilev_)%iprcparm)) then
write(0,*) name,&
&': Error: uninitialized preconditioner component, should call MLD_PRECINIT'
info = -1
return
endif
p%precv(ilev_)%iprcparm(what) = val
p%precv(ilev_)%prec%iprcparm(what) = val
end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,&
& mld_smoother_pos_,mld_aggr_omega_alg_,mld_aggr_eig_)
& mld_smoother_pos_,mld_aggr_omega_alg_,mld_aggr_eig_,mld_aggr_filter_)
do ilev_=1,nlev_
if (.not.allocated(p%precv(ilev_)%iprcparm)) then
write(0,*) name,&
@@ -265,15 +282,18 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
endif
if (nlev_ > 1) then
p%precv(nlev_)%iprcparm(mld_coarse_solve_) = val
p%precv(nlev_)%iprcparm(mld_coarse_solve_) = val
p%precv(nlev_)%prec%iprcparm(mld_smoother_type_) = mld_bjac_
p%precv(nlev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
p%precv(nlev_)%iprcparm(mld_coarse_mat_) = mld_distr_mat_
select case (val)
case(mld_umf_, mld_slu_)
p%precv(nlev_)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
p%precv(nlev_)%iprcparm(mld_coarse_mat_) = mld_repl_mat_
p%precv(nlev_)%prec%iprcparm(mld_sub_solve_) = val
case(mld_sludist_)
p%precv(nlev_)%prec%iprcparm(mld_sub_solve_) = val
!!$ case(mld_jac_)
!!$ p%precv(nlev_)%prec%iprcparm(mld_smoother_type_) = mld_jac_
!!$ p%precv(nlev_)%prec%iprcparm(mld_sub_solve_) = mld_diag_scale_
end select
endif
case(mld_coarse_subsolve_)
mlprec/mld_move_alloc.f90 → mlprec/mld_move_alloc_mod.f90
View File
tests/pdegen/ppde.f90
+28 -15
View File
@@ -104,11 +104,13 @@ program ppde
character(len=20) :: descr ! verbose description of the prec
character(len=10) :: prec ! overall prectype
integer :: novr ! number of overlap layers
integer :: jsweeps ! Jacobi/smoother sweeps
character(len=16) :: restr ! restriction over application of as
character(len=16) :: prol ! prolongation over application of as
character(len=16) :: solve ! Factorization type: ILU, SuperLU, UMFPACK.
character(len=16) :: solve ! Solver type: ILU, SuperLU, UMFPACK.
integer :: fill1 ! Fill-in for factorization 1
real(psb_dpk_) :: thr1 ! Threshold for fact. 1 ILU(T)
character(len=16) :: smther ! Smoother
integer :: nlev ! Number of levels in multilevel prec.
character(len=16) :: aggrkind ! smoothed/raw aggregatin
character(len=16) :: aggr_alg ! local or global aggregation
@@ -171,17 +173,15 @@ program ppde
if (psb_toupper(prectype%prec) =='ML') then
nlv = prectype%nlev
else
nlv = 1
end if
call mld_precinit(prec,prectype%prec,info,nlev=nlv)
call mld_precset(prec,mld_sub_ovr_,prectype%novr,info)
call mld_precset(prec,mld_sub_restr_,prectype%restr,info)
call mld_precset(prec,mld_sub_prol_,prectype%prol,info)
call mld_precset(prec,mld_sub_solve_,prectype%solve,info)
call mld_precset(prec,mld_sub_fillin_,prectype%fill1,info)
call mld_precset(prec,mld_sub_iluthrs_,prectype%thr1,info)
if (psb_toupper(prectype%prec) =='ML') then
call mld_precinit(prec,prectype%prec, info, nlev=nlv)
call mld_precset(prec,mld_smoother_type_, prectype%smther, info)
call mld_precset(prec,mld_smoother_sweeps_, prectype%jsweeps, info)
call mld_precset(prec,mld_sub_ovr_, prectype%novr, info)
call mld_precset(prec,mld_sub_restr_, prectype%restr, info)
call mld_precset(prec,mld_sub_prol_, prectype%prol, info)
call mld_precset(prec,mld_sub_solve_, prectype%solve, info)
call mld_precset(prec,mld_sub_fillin_, prectype%fill1, info)
call mld_precset(prec,mld_sub_iluthrs_, prectype%thr1, info)
call mld_precset(prec,mld_aggr_kind_, prectype%aggrkind,info)
call mld_precset(prec,mld_aggr_alg_, prectype%aggr_alg,info)
call mld_precset(prec,mld_ml_type_, prectype%mltype, info)
@@ -193,8 +193,17 @@ program ppde
call mld_precset(prec,mld_coarse_fillin_, prectype%cfill, info)
call mld_precset(prec,mld_coarse_iluthrs_, prectype%cthres, info)
call mld_precset(prec,mld_coarse_sweeps_, prectype%cjswp, info)
end if
else
nlv = 1
call mld_precinit(prec,prectype%prec, info, nlev=nlv)
call mld_precset(prec,mld_smoother_sweeps_, prectype%jsweeps, info)
call mld_precset(prec,mld_sub_ovr_, prectype%novr, info)
call mld_precset(prec,mld_sub_restr_, prectype%restr, info)
call mld_precset(prec,mld_sub_prol_, prectype%prol, info)
call mld_precset(prec,mld_sub_solve_, prectype%solve, info)
call mld_precset(prec,mld_sub_fillin_, prectype%fill1, info)
call mld_precset(prec,mld_sub_iluthrs_, prectype%thr1, info)
end if
call psb_barrier(ictxt)
t1 = psb_wtime()
call mld_precbld(a,desc_a,prec,info)
@@ -305,7 +314,9 @@ contains
call read_data(prectype%solve,5) ! Factorization type: ILU, SuperLU, UMFPACK.
call read_data(prectype%fill1,5) ! Fill-in for factorization 1
call read_data(prectype%thr1,5) ! Threshold for fact. 1 ILU(T)
call read_data(prectype%jsweeps,5) ! Jacobi sweeps for PJAC
if (psb_toupper(prectype%prec) == 'ML') then
call read_data(prectype%smther,5) ! Smoother type.
call read_data(prectype%nlev,5) ! Number of levels in multilevel prec.
call read_data(prectype%aggrkind,5) ! smoothed/raw aggregatin
call read_data(prectype%aggr_alg,5) ! local or global aggregation
@@ -340,7 +351,9 @@ contains
call psb_bcast(ictxt,prectype%solve) ! Factorization type: ILU, SuperLU, UMFPACK.
call psb_bcast(ictxt,prectype%fill1) ! Fill-in for factorization 1
call psb_bcast(ictxt,prectype%thr1) ! Threshold for fact. 1 ILU(T)
call psb_bcast(ictxt,prectype%jsweeps) ! Threshold for fact. 1 ILU(T)
if (psb_toupper(prectype%prec) == 'ML') then
call psb_bcast(ictxt,prectype%smther) ! Smoother type.
call psb_bcast(ictxt,prectype%nlev) ! Number of levels in multilevel prec.
call psb_bcast(ictxt,prectype%aggrkind) ! smoothed/raw aggregatin
call psb_bcast(ictxt,prectype%aggr_alg) ! local or global aggregation
@@ -352,7 +365,7 @@ contains
call psb_bcast(ictxt,prectype%cfill) ! Fill-in for factorization 1
call psb_bcast(ictxt,prectype%cthres) ! Threshold for fact. 1 ILU(T)
call psb_bcast(ictxt,prectype%cjswp) ! Jacobi sweeps
call psb_bcast(ictxt,prectype%athres) ! smoother aggr thresh
call psb_bcast(ictxt,prectype%athres) ! smoother aggr thresh
end if
if (iam==psb_root_) then
tests/pdegen/runs/ppde.inp
+13 -11
View File
@@ -2,26 +2,28 @@ BICGSTAB ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTA
CSR ! Storage format CSR COO JAD
40 ! IDIM; domain size is idim**3
2 ! ISTOPC
00100 ! ITMAX
0010 ! ITMAX
01 ! ITRACE
30 ! IRST (restart for RGMRES and BiCGSTABL)
1.d-7 ! EPS
RAS ! Longer descriptive name for preconditioner (up to 20 chars)
AS ! Preconditioner NONE DIAG BJAC AS ML
0 ! Number of overlap layers for AS preconditioner at finest level
1.d-6 ! EPS
3L-M-RAS-I-D4 ! Longer descriptive name for preconditioner (up to 20 chars)
ML ! Preconditioner NONE JACOBI BJAC AS ML
1 ! Number of overlap layers for AS preconditioner at finest level
HALO ! Restriction operator NONE HALO
NONE ! Prolongation operator NONE SUM AVG
ILU ! Subdomain solver ILU MILU ILUT UMF SLU
1 ! Level-set N for ILU(N)
ILU ! Subdomain solver DSCALE ILU MILU ILUT UMF SLU
0 ! Level-set N for ILU(N)
1.d-4 ! Threshold T for ILU(T,P)
1 ! Smoother/Jacobi sweeps
AS ! Smoother type JACOBI BJAC AS ignored for non-ML
3 ! Number of levels in a multilevel preconditioner
SMOOTHED ! Kind of aggregation: SMOOTHED, NONSMOOTHED, MINENERGY
DEC ! Type of aggregation DEC SYMDEC GLB
MULT ! Type of multilevel correction: ADD MULT
TWOSIDE ! Side of mult. correction PRE POST TWOSIDE (ignored for ADD)
REPL ! Coarse level: matrix distribution DIST REPL
BJAC ! Coarse level: solver BJAC UMF SLU SLUDIST
ILUT ! Coarse level: subsolver ILU UMF SLU SLUDIST
POST ! Side of multiplicative correction PRE POST TWOSIDE (ignored for ADD)
DIST ! Coarse level: matrix distribution DIST REPL
BJAC ! Coarse level: solver JACOBI BJAC UMF SLU SLUDIST
ILU ! Coarse level: subsolver DSCALE ILU UMF SLU SLUDIST
1 ! Coarse level: Level-set N for ILU(N)
1.d-4 ! Coarse level: Threshold T for ILU(T,P)
4 ! Coarse level: Number of Jacobi sweeps