fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
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.
stopcriterion
Salvatore Filippone 15 years ago
parent 4cef244c64
commit e113012910
6 changed files with 370 additions and 1258 deletions
Show Stats Download Patch File Download Diff File

1397
mlprec/mld_dmlprec_aply.f90
View File

File diff suppressed because it is too large Load Diff

60
mlprec/mld_dmlprec_bld.f90
Unescape Escape View File

@ -69,6 +69,10 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info)
use psb_base_mod use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_dmlprec_bld use mld_inner_mod, mld_protect_name => mld_dmlprec_bld
use mld_prec_mod 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 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_),& call mld_check_def(p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),&
& 'Jacobi sweeps',1,is_legal_jac_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 if (info /= 0) then
call psb_errpush(4001,name,a_err='One level preconditioner build.') call psb_errpush(4001,name,a_err='One level preconditioner build.')

32
mlprec/mld_dprecset.f90
Unescape Escape View File

@ -140,7 +140,10 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
! Rules for fine level are slightly different. ! Rules for fine level are slightly different.
! !
select case(what) 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_) & mld_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,mld_smoother_sweeps_)
p%precv(ilev_)%prec%iprcparm(what) = val p%precv(ilev_)%prec%iprcparm(what) = val
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,& 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 else if (ilev_ > 1) then
select case(what) 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_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smoother_sweeps_) & mld_smoother_sweeps_)
p%precv(ilev_)%prec%iprcparm(what) = val p%precv(ilev_)%prec%iprcparm(what) = val
@ -220,21 +226,32 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
! levels ! levels
! !
select case(what) 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_sub_ren_,mld_sub_ovr_,mld_sub_fillin_,&
& mld_smoother_sweeps_) & mld_smoother_sweeps_)
do ilev_=1,max(1,nlev_-1) do ilev_=1,max(1,nlev_-1)
if (.not.allocated(p%precv(ilev_)%iprcparm)) then if (.not.allocated(p%precv(ilev_)%iprcparm)) then
write(0,*) name,& write(0,*) name,&
&': Error: uninitialized preconditioner component,',& &': Error: uninitialized preconditioner component, should call MLD_PRECINIT'
&' should call MLD_PRECINIT'
info = -1 info = -1
return return
endif 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 p%precv(ilev_)%prec%iprcparm(what) = val
end do end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_kind_,& 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_ do ilev_=1,nlev_
if (.not.allocated(p%precv(ilev_)%iprcparm)) then if (.not.allocated(p%precv(ilev_)%iprcparm)) then
write(0,*) name,& write(0,*) name,&
@ -274,6 +291,9 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
p%precv(nlev_)%prec%iprcparm(mld_sub_solve_) = val p%precv(nlev_)%prec%iprcparm(mld_sub_solve_) = val
case(mld_sludist_) case(mld_sludist_)
p%precv(nlev_)%prec%iprcparm(mld_sub_solve_) = val 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 end select
endif endif
case(mld_coarse_subsolve_) case(mld_coarse_subsolve_)

0
mlprec/mld_move_alloc.f90 → mlprec/mld_move_alloc_mod.f90
Unescape Escape View File

39
tests/pdegen/ppde.f90
Unescape Escape View File

@ -104,11 +104,13 @@ program ppde
character(len=20) :: descr ! verbose description of the prec character(len=20) :: descr ! verbose description of the prec
character(len=10) :: prec ! overall prectype character(len=10) :: prec ! overall prectype
integer :: novr ! number of overlap layers integer :: novr ! number of overlap layers
integer :: jsweeps ! Jacobi/smoother sweeps
character(len=16) :: restr ! restriction over application of as character(len=16) :: restr ! restriction over application of as
character(len=16) :: prol ! prolongation 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 integer :: fill1 ! Fill-in for factorization 1
real(psb_dpk_) :: thr1 ! Threshold for fact. 1 ILU(T) real(psb_dpk_) :: thr1 ! Threshold for fact. 1 ILU(T)
character(len=16) :: smther ! Smoother
integer :: nlev ! Number of levels in multilevel prec. integer :: nlev ! Number of levels in multilevel prec.
character(len=16) :: aggrkind ! smoothed/raw aggregatin character(len=16) :: aggrkind ! smoothed/raw aggregatin
character(len=16) :: aggr_alg ! local or global aggregation character(len=16) :: aggr_alg ! local or global aggregation
@ -171,17 +173,15 @@ program ppde
if (psb_toupper(prectype%prec) =='ML') then if (psb_toupper(prectype%prec) =='ML') then
nlv = prectype%nlev nlv = prectype%nlev
else call mld_precinit(prec,prectype%prec, info, nlev=nlv)
nlv = 1 call mld_precset(prec,mld_smoother_type_, prectype%smther, info)
end if call mld_precset(prec,mld_smoother_sweeps_, prectype%jsweeps, info)
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_ovr_,prectype%novr,info) call mld_precset(prec,mld_sub_restr_, prectype%restr, 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_prol_,prectype%prol,info) call mld_precset(prec,mld_sub_solve_, prectype%solve, 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_fillin_,prectype%fill1,info) call mld_precset(prec,mld_sub_iluthrs_, prectype%thr1, info)
call mld_precset(prec,mld_sub_iluthrs_,prectype%thr1,info)
if (psb_toupper(prectype%prec) =='ML') then
call mld_precset(prec,mld_aggr_kind_, prectype%aggrkind,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_aggr_alg_, prectype%aggr_alg,info)
call mld_precset(prec,mld_ml_type_, prectype%mltype, 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_fillin_, prectype%cfill, info)
call mld_precset(prec,mld_coarse_iluthrs_, prectype%cthres, info) call mld_precset(prec,mld_coarse_iluthrs_, prectype%cthres, info)
call mld_precset(prec,mld_coarse_sweeps_, prectype%cjswp, info) call mld_precset(prec,mld_coarse_sweeps_, prectype%cjswp, info)
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 end if
call psb_barrier(ictxt) call psb_barrier(ictxt)
t1 = psb_wtime() t1 = psb_wtime()
call mld_precbld(a,desc_a,prec,info) 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%solve,5) ! Factorization type: ILU, SuperLU, UMFPACK.
call read_data(prectype%fill1,5) ! Fill-in for factorization 1 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%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 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%nlev,5) ! Number of levels in multilevel prec.
call read_data(prectype%aggrkind,5) ! smoothed/raw aggregatin call read_data(prectype%aggrkind,5) ! smoothed/raw aggregatin
call read_data(prectype%aggr_alg,5) ! local or global aggregation 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%solve) ! Factorization type: ILU, SuperLU, UMFPACK.
call psb_bcast(ictxt,prectype%fill1) ! Fill-in for factorization 1 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%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 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%nlev) ! Number of levels in multilevel prec.
call psb_bcast(ictxt,prectype%aggrkind) ! smoothed/raw aggregatin call psb_bcast(ictxt,prectype%aggrkind) ! smoothed/raw aggregatin
call psb_bcast(ictxt,prectype%aggr_alg) ! local or global aggregation call psb_bcast(ictxt,prectype%aggr_alg) ! local or global aggregation

24
tests/pdegen/runs/ppde.inp
Unescape Escape View File

@ -2,26 +2,28 @@ BICGSTAB ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTA
CSR ! Storage format CSR COO JAD CSR ! Storage format CSR COO JAD
40 ! IDIM; domain size is idim**3 40 ! IDIM; domain size is idim**3
2 ! ISTOPC 2 ! ISTOPC
00100 ! ITMAX 0010 ! ITMAX
01 ! ITRACE 01 ! ITRACE
30 ! IRST (restart for RGMRES and BiCGSTABL) 30 ! IRST (restart for RGMRES and BiCGSTABL)
1.d-7 ! EPS 1.d-6 ! EPS
RAS ! Longer descriptive name for preconditioner (up to 20 chars) 3L-M-RAS-I-D4 ! Longer descriptive name for preconditioner (up to 20 chars)
AS ! Preconditioner NONE DIAG BJAC AS ML ML ! Preconditioner NONE JACOBI BJAC AS ML
0 ! Number of overlap layers for AS preconditioner at finest level 1 ! Number of overlap layers for AS preconditioner at finest level
HALO ! Restriction operator NONE HALO HALO ! Restriction operator NONE HALO
NONE ! Prolongation operator NONE SUM AVG NONE ! Prolongation operator NONE SUM AVG
ILU ! Subdomain solver ILU MILU ILUT UMF SLU ILU ! Subdomain solver DSCALE ILU MILU ILUT UMF SLU
1 ! Level-set N for ILU(N) 0 ! Level-set N for ILU(N)
1.d-4 ! Threshold T for ILU(T,P) 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 3 ! Number of levels in a multilevel preconditioner
SMOOTHED ! Kind of aggregation: SMOOTHED, NONSMOOTHED, MINENERGY SMOOTHED ! Kind of aggregation: SMOOTHED, NONSMOOTHED, MINENERGY
DEC ! Type of aggregation DEC SYMDEC GLB DEC ! Type of aggregation DEC SYMDEC GLB
MULT ! Type of multilevel correction: ADD MULT MULT ! Type of multilevel correction: ADD MULT
TWOSIDE ! Side of mult. correction PRE POST TWOSIDE (ignored for ADD) POST ! Side of multiplicative correction PRE POST TWOSIDE (ignored for ADD)
REPL ! Coarse level: matrix distribution DIST REPL DIST ! Coarse level: matrix distribution DIST REPL
BJAC ! Coarse level: solver BJAC UMF SLU SLUDIST BJAC ! Coarse level: solver JACOBI BJAC UMF SLU SLUDIST
ILUT ! Coarse level: subsolver ILU UMF SLU SLUDIST ILU ! Coarse level: subsolver DSCALE ILU UMF SLU SLUDIST
1 ! Coarse level: Level-set N for ILU(N) 1 ! Coarse level: Level-set N for ILU(N)
1.d-4 ! Coarse level: Threshold T for ILU(T,P) 1.d-4 ! Coarse level: Threshold T for ILU(T,P)
4 ! Coarse level: Number of Jacobi sweeps 4 ! Coarse level: Number of Jacobi sweeps

Write Preview
Loading…
Cancel
Save