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

@ -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,&
@ -274,6 +291,9 @@ subroutine mld_dprecseti(p,what,val,info,ilev)
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_)

@ -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_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)
if (psb_toupper(prectype%prec) =='ML') then
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)
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

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

Loading…
Cancel
Save