mld2p4-2:

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

File diff suppressed because it is too large Load Diff

@ -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.')

@ -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_)

@ -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
nlv = 1
end if
call mld_precinit(prec,prectype%prec, info, nlev=nlv) 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_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

@ -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

Loading…
Cancel
Save