fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

mld2p4-smooth-2side:

Browse Source 
mlprec/impl/level/mld_d_base_onelev_csetc.f90
 mlprec/impl/level/mld_d_base_onelev_cseti.f90
 mlprec/impl/level/mld_d_base_onelev_csetr.f90
 mlprec/impl/level/mld_d_base_onelev_setc.f90
 mlprec/impl/level/mld_d_base_onelev_seti.f90
 mlprec/impl/level/mld_d_base_onelev_setr.f90
 mlprec/impl/mld_dcprecset.F90
 mlprec/impl/mld_dprecset.F90
 mlprec/mld_d_prec_mod.f90
 tests/pdegen/ppde3d-gs.f90
 tests/pdegen/runs/ppde.inp

SET now works; next step will be some refactoring.
Note: the symmetrized ML for CG with FW/BW Gauss-Seidel does not seem
to work right now.
stopcriterion
Salvatore Filippone 9 years ago
parent d747bc9aae
commit e08492cdaf
11 changed files with 640 additions and 359 deletions
Show Stats Download Patch File Download Diff File

27
mlprec/impl/level/mld_d_base_onelev_csetc.f90
Unescape Escape View File

@ -49,7 +49,8 @@ subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos)
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
integer(psb_ipk_) :: err_act ! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='d_base_onelev_csetc' character(len=20) :: name='d_base_onelev_csetc'
integer(psb_ipk_) :: ival integer(psb_ipk_) :: ival
@ -61,9 +62,33 @@ subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos)
if (ival >= 0) then if (ival >= 0) then
call lv%set(what,ival,info,pos=pos) call lv%set(what,ival,info,pos=pos)
else else
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
case('POST')
ipos_ = mld_post_smooth_
case default
ipos_ = mld_pre_smooth_
end select
else
ipos_ = mld_pre_smooth_
end if
select case(ipos_)
case(mld_pre_smooth_)
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info) call lv%sm%set(what,val,info)
end if end if
case (mld_post_smooth_)
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
case default
! Impossible!!
info = psb_err_internal_error_
end select
end if end if

27
mlprec/impl/level/mld_d_base_onelev_cseti.f90
Unescape Escape View File

@ -49,12 +49,26 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos)
integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
Integer(Psb_ipk_) :: err_act ! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='d_base_onelev_cseti' character(len=20) :: name='d_base_onelev_cseti'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
case('POST')
ipos_ = mld_post_smooth_
case default
ipos_ = mld_pre_smooth_
end select
else
ipos_ = mld_pre_smooth_
end if
select case (psb_toupper(what)) select case (psb_toupper(what))
case ('SMOOTHER_SWEEPS') case ('SMOOTHER_SWEEPS')
@ -99,9 +113,20 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos)
lv%parms%coarse_solve = val lv%parms%coarse_solve = val
case default case default
select case(ipos_)
case(mld_pre_smooth_)
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info) call lv%sm%set(what,val,info)
end if end if
case (mld_post_smooth_)
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
case default
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

26
mlprec/impl/level/mld_d_base_onelev_csetr.f90
Unescape Escape View File

@ -49,7 +49,8 @@ subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos)
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
integer(psb_ipk_) :: err_act ! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='d_base_onelev_csetr' character(len=20) :: name='d_base_onelev_csetr'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -69,9 +70,32 @@ subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos)
lv%parms%aggr_scale = val lv%parms%aggr_scale = val
case default case default
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
case('POST')
ipos_ = mld_post_smooth_
case default
ipos_ = mld_pre_smooth_
end select
else
ipos_ = mld_pre_smooth_
end if
select case(ipos_)
case(mld_pre_smooth_)
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info) call lv%sm%set(what,val,info)
end if end if
case (mld_post_smooth_)
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
case default
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

26
mlprec/impl/level/mld_d_base_onelev_setc.f90
Unescape Escape View File

@ -49,7 +49,8 @@ subroutine mld_d_base_onelev_setc(lv,what,val,info,pos)
character(len=*), intent(in) :: val character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
integer(psb_ipk_) :: err_act ! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='d_base_onelev_setc' character(len=20) :: name='d_base_onelev_setc'
integer(psb_ipk_) :: ival integer(psb_ipk_) :: ival
@ -61,9 +62,32 @@ subroutine mld_d_base_onelev_setc(lv,what,val,info,pos)
if (ival >= 0) then if (ival >= 0) then
call lv%set(what,ival,info,pos=pos) call lv%set(what,ival,info,pos=pos)
else else
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
case('POST')
ipos_ = mld_post_smooth_
case default
ipos_ = mld_pre_smooth_
end select
else
ipos_ = mld_pre_smooth_
end if
select case(ipos_)
case(mld_pre_smooth_)
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info) call lv%sm%set(what,val,info)
end if end if
case (mld_post_smooth_)
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
case default
! Impossible!!
info = psb_err_internal_error_
end select
end if end if

27
mlprec/impl/level/mld_d_base_onelev_seti.f90
Unescape Escape View File

@ -49,7 +49,8 @@ subroutine mld_d_base_onelev_seti(lv,what,val,info,pos)
integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
Integer(Psb_ipk_) :: err_act ! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='d_base_onelev_seti' character(len=20) :: name='d_base_onelev_seti'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -99,9 +100,33 @@ subroutine mld_d_base_onelev_seti(lv,what,val,info,pos)
lv%parms%coarse_solve = val lv%parms%coarse_solve = val
case default case default
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
case('POST')
ipos_ = mld_post_smooth_
case default
ipos_ = mld_pre_smooth_
end select
else
ipos_ = mld_pre_smooth_
end if
select case(ipos_)
case(mld_pre_smooth_)
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info) call lv%sm%set(what,val,info)
end if end if
case (mld_post_smooth_)
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
case default
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

26
mlprec/impl/level/mld_d_base_onelev_setr.f90
Unescape Escape View File

@ -49,7 +49,8 @@ subroutine mld_d_base_onelev_setr(lv,what,val,info,pos)
real(psb_dpk_), intent(in) :: val real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
integer(psb_ipk_) :: err_act ! Local
integer(psb_ipk_) :: ipos_, err_act
character(len=20) :: name='d_base_onelev_setr' character(len=20) :: name='d_base_onelev_setr'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -69,9 +70,32 @@ subroutine mld_d_base_onelev_setr(lv,what,val,info,pos)
lv%parms%aggr_scale = val lv%parms%aggr_scale = val
case default case default
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
case('POST')
ipos_ = mld_post_smooth_
case default
ipos_ = mld_pre_smooth_
end select
else
ipos_ = mld_pre_smooth_
end if
select case(ipos_)
case(mld_pre_smooth_)
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%set(what,val,info) call lv%sm%set(what,val,info)
end if end if
case (mld_post_smooth_)
if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info)
end if
case default
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

302
mlprec/impl/mld_dcprecset.F90
Unescape Escape View File

@ -367,91 +367,123 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,pos)
contains contains
subroutine onelev_set_smoother(level,val,info,pos) subroutine onelev_set_smoother(level,val,info,pos)
type(mld_d_onelev_type), intent(inout) :: level class(mld_d_onelev_type), intent(inout) :: level
integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
! Local
integer(psb_ipk_) :: ipos_
info = psb_success_ info = psb_success_
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
case('POST')
ipos_ = mld_post_smooth_
case default
ipos_ = mld_pre_smooth_
end select
else
ipos_ = mld_pre_smooth_
end if
select case(ipos_)
case(mld_pre_smooth_)
call inner_set_smoother(level%sm,val,info)
case (mld_post_smooth_)
call inner_set_smoother(level%sm2a,val,info)
case default
! Impossible!!
info = psb_err_internal_error_
end select
end subroutine onelev_set_smoother
subroutine inner_set_smoother(sm,val,info)
class(mld_d_base_smoother_type), allocatable, intent(inout) :: sm
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
! !
! This here requires a bit more attention. ! This here requires a bit more attention.
! !
select case (val) select case (val)
case (mld_noprec_) case (mld_noprec_)
if (allocated(level%sm)) then if (allocated(sm)) then
select type (sm => level%sm) select type (sms => sm)
type is (mld_d_base_smoother_type) type is (mld_d_base_smoother_type)
! do nothing ! do nothing
class default class default
call level%sm%free(info) call sm%free(info)
if (info == 0) deallocate(level%sm) if (info == 0) deallocate(sm)
if (info == 0) allocate(mld_d_base_smoother_type ::& if (info == 0) allocate(mld_d_base_smoother_type ::&
& level%sm, stat=info) & sm, stat=info)
if (info == 0) allocate(mld_d_id_solver_type ::& if (info == 0) allocate(mld_d_id_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_base_smoother_type ::& allocate(mld_d_base_smoother_type ::&
& level%sm, stat=info) & sm, stat=info)
if (info ==0) allocate(mld_d_id_solver_type ::& if (info ==0) allocate(mld_d_id_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
endif endif
case (mld_jac_) case (mld_jac_)
if (allocated(level%sm)) then if (allocated(sm)) then
select type (sm => level%sm) select type (sms => sm)
class is (mld_d_jac_smoother_type) class is (mld_d_jac_smoother_type)
! do nothing ! do nothing
class default class default
call level%sm%free(info) call sm%free(info)
if (info == 0) deallocate(level%sm) if (info == 0) deallocate(sm)
if (info == 0) allocate(mld_d_jac_smoother_type :: & if (info == 0) allocate(mld_d_jac_smoother_type :: &
& level%sm, stat=info) & sm, stat=info)
if (info == 0) allocate(mld_d_diag_solver_type :: & if (info == 0) allocate(mld_d_diag_solver_type :: &
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_jac_smoother_type :: level%sm, stat=info) allocate(mld_d_jac_smoother_type :: sm, stat=info)
if (info == 0) allocate(mld_d_diag_solver_type ::& if (info == 0) allocate(mld_d_diag_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
endif endif
case (mld_bjac_) case (mld_bjac_)
if (allocated(level%sm)) then if (allocated(sm)) then
select type (sm => level%sm) select type (sms => sm)
class is (mld_d_jac_smoother_type) class is (mld_d_jac_smoother_type)
! do nothing ! do nothing
class default class default
call level%sm%free(info) call sm%free(info)
if (info == 0) deallocate(level%sm) if (info == 0) deallocate(sm)
if (info == 0) allocate(mld_d_jac_smoother_type ::& if (info == 0) allocate(mld_d_jac_smoother_type ::&
& level%sm, stat=info) & sm, stat=info)
if (info == 0) allocate(mld_d_ilu_solver_type ::& if (info == 0) allocate(mld_d_ilu_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_jac_smoother_type :: level%sm, stat=info) allocate(mld_d_jac_smoother_type :: sm, stat=info)
if (info == 0) allocate(mld_d_ilu_solver_type ::& if (info == 0) allocate(mld_d_ilu_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
endif endif
case (mld_as_) case (mld_as_)
if (allocated(level%sm)) then if (allocated(sm)) then
select type (sm => level%sm) select type (sms => sm)
class is (mld_d_as_smoother_type) class is (mld_d_as_smoother_type)
! do nothing ! do nothing
class default class default
call level%sm%free(info) call sm%free(info)
if (info == 0) deallocate(level%sm) if (info == 0) deallocate(sm)
if (info == 0) allocate(mld_d_as_smoother_type ::& if (info == 0) allocate(mld_d_as_smoother_type ::&
& level%sm, stat=info) & sm, stat=info)
if (info == 0) allocate(mld_d_ilu_solver_type ::& if (info == 0) allocate(mld_d_ilu_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_as_smoother_type :: level%sm, stat=info) allocate(mld_d_as_smoother_type :: sm, stat=info)
if (info == 0) allocate(mld_d_ilu_solver_type ::& if (info == 0) allocate(mld_d_ilu_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
endif endif
case default case default
@ -459,40 +491,72 @@ contains
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
if (allocated(level%sm)) & if (allocated(sm)) &
& call level%sm%default() & call sm%default()
end subroutine inner_set_smoother
end subroutine onelev_set_smoother
subroutine onelev_set_solver(level,val,info,pos) subroutine onelev_set_solver(level,val,info,pos)
type(mld_d_onelev_type), intent(inout) :: level class(mld_d_onelev_type), intent(inout) :: level
integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
! Local
integer(psb_ipk_) :: ipos_
info = psb_success_ info = psb_success_
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
case('POST')
ipos_ = mld_post_smooth_
case default
ipos_ = mld_pre_smooth_
end select
else
ipos_ = mld_pre_smooth_
end if
select case(ipos_)
case(mld_pre_smooth_)
call inner_set_solver(level%sm,val,info)
case (mld_post_smooth_)
call inner_set_solver(level%sm2a,val,info)
case default
! Impossible!!
info = psb_err_internal_error_
end select
end subroutine onelev_set_solver
subroutine inner_set_solver(sm,val,info)
class(mld_d_base_smoother_type), allocatable, intent(inout) :: sm
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
! !
! This here requires a bit more attention. ! Yes, the first argument is a smoother, to catch the case where
! user is trying to set a solver on a not-yet-allocated smoother.
! !
select case (val) select case (val)
case (mld_f_none_) case (mld_f_none_)
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) then if (allocated(sm%sv)) then
select type (sv => level%sm%sv) select type (sv => sm%sv)
class is (mld_d_id_solver_type) class is (mld_d_id_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) if (info == 0) deallocate(sm%sv)
if (info == 0) allocate(mld_d_id_solver_type ::& if (info == 0) allocate(mld_d_id_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_id_solver_type :: level%sm%sv, stat=info) allocate(mld_d_id_solver_type :: sm%sv, stat=info)
endif endif
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) & if (allocated(sm%sv)) &
& call level%sm%sv%default() & call sm%sv%default()
end if end if
else else
write(0,*) 'Calling set_solver without a smoother?' write(0,*) 'Calling set_solver without a smoother?'
@ -500,23 +564,23 @@ contains
end if end if
case (mld_diag_scale_) case (mld_diag_scale_)
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) then if (allocated(sm%sv)) then
select type (sv => level%sm%sv) select type (sv => sm%sv)
class is (mld_d_diag_solver_type) class is (mld_d_diag_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) if (info == 0) deallocate(sm%sv)
if (info == 0) allocate(mld_d_diag_solver_type ::& if (info == 0) allocate(mld_d_diag_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_diag_solver_type :: level%sm%sv, stat=info) allocate(mld_d_diag_solver_type :: sm%sv, stat=info)
endif endif
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) & if (allocated(sm%sv)) &
& call level%sm%sv%default() & call sm%sv%default()
end if end if
else else
write(0,*) 'Calling set_solver without a smoother?' write(0,*) 'Calling set_solver without a smoother?'
@ -524,22 +588,22 @@ contains
end if end if
case (mld_gs_) case (mld_gs_)
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) then if (allocated(sm%sv)) then
select type (sv => level%sm%sv) select type (sv => sm%sv)
class is (mld_d_gs_solver_type) class is (mld_d_gs_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) if (info == 0) deallocate(sm%sv)
if (info == 0) allocate(mld_d_gs_solver_type ::& if (info == 0) allocate(mld_d_gs_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_gs_solver_type :: level%sm%sv, stat=info) allocate(mld_d_gs_solver_type :: sm%sv, stat=info)
endif endif
if (allocated(level%sm%sv)) then if (allocated(sm%sv)) then
call level%sm%sv%default() call sm%sv%default()
else else
endif endif
@ -549,25 +613,25 @@ contains
end if end if
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) then if (allocated(sm%sv)) then
select type (sv => level%sm%sv) select type (sv => sm%sv)
class is (mld_d_ilu_solver_type) class is (mld_d_ilu_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) if (info == 0) deallocate(sm%sv)
if (info == 0) allocate(mld_d_ilu_solver_type ::& if (info == 0) allocate(mld_d_ilu_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_ilu_solver_type :: level%sm%sv, stat=info) allocate(mld_d_ilu_solver_type :: sm%sv, stat=info)
endif endif
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) & if (allocated(sm%sv)) &
& call level%sm%sv%default() & call sm%sv%default()
end if end if
call level%sm%sv%set('SUB_SOLVE',val,info) call sm%sv%set('SUB_SOLVE',val,info)
else else
write(0,*) 'Calling set_solver without a smoother?' write(0,*) 'Calling set_solver without a smoother?'
info = -5 info = -5
@ -575,23 +639,23 @@ contains
#ifdef HAVE_SLU_ #ifdef HAVE_SLU_
case (mld_slu_) case (mld_slu_)
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) then if (allocated(sm%sv)) then
select type (sv => level%sm%sv) select type (sv => sm%sv)
class is (mld_d_slu_solver_type) class is (mld_d_slu_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) if (info == 0) deallocate(sm%sv)
if (info == 0) allocate(mld_d_slu_solver_type ::& if (info == 0) allocate(mld_d_slu_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_slu_solver_type :: level%sm%sv, stat=info) allocate(mld_d_slu_solver_type :: sm%sv, stat=info)
endif endif
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) & if (allocated(sm%sv)) &
& call level%sm%sv%default() & call sm%sv%default()
end if end if
else else
write(0,*) 'Calling set_solver without a smoother?' write(0,*) 'Calling set_solver without a smoother?'
@ -600,44 +664,44 @@ contains
#endif #endif
#ifdef HAVE_MUMPS_ #ifdef HAVE_MUMPS_
case (mld_mumps_) case (mld_mumps_)
if (allocated(level%sm%sv)) then if (allocated(sm%sv)) then
select type (sv => level%sm%sv) select type (sv => sm%sv)
class is (mld_d_mumps_solver_type) class is (mld_d_mumps_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) if (info == 0) deallocate(sm%sv)
if (info == 0) allocate(mld_d_mumps_solver_type ::& if (info == 0) allocate(mld_d_mumps_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_mumps_solver_type :: level%sm%sv, stat=info) allocate(mld_d_mumps_solver_type :: sm%sv, stat=info)
endif endif
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) & if (allocated(sm%sv)) &
& call level%sm%sv%default() & call sm%sv%default()
end if end if
#endif #endif
#ifdef HAVE_UMF_ #ifdef HAVE_UMF_
case (mld_umf_) case (mld_umf_)
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) then if (allocated(sm%sv)) then
select type (sv => level%sm%sv) select type (sv => sm%sv)
class is (mld_d_umf_solver_type) class is (mld_d_umf_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) if (info == 0) deallocate(sm%sv)
if (info == 0) allocate(mld_d_umf_solver_type ::& if (info == 0) allocate(mld_d_umf_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_umf_solver_type :: level%sm%sv, stat=info) allocate(mld_d_umf_solver_type :: sm%sv, stat=info)
endif endif
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) & if (allocated(sm%sv)) &
& call level%sm%sv%default() & call sm%sv%default()
end if end if
else else
write(0,*) 'Calling set_solver without a smoother?' write(0,*) 'Calling set_solver without a smoother?'
@ -646,23 +710,23 @@ contains
#endif #endif
#ifdef HAVE_SLUDIST_ #ifdef HAVE_SLUDIST_
case (mld_sludist_) case (mld_sludist_)
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) then if (allocated(sm%sv)) then
select type (sv => level%sm%sv) select type (sv => sm%sv)
class is (mld_d_sludist_solver_type) class is (mld_d_sludist_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) if (info == 0) deallocate(sm%sv)
if (info == 0) allocate(mld_d_sludist_solver_type ::& if (info == 0) allocate(mld_d_sludist_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_sludist_solver_type :: level%sm%sv, stat=info) allocate(mld_d_sludist_solver_type :: sm%sv, stat=info)
endif endif
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) & if (allocated(sm%sv)) &
& call level%sm%sv%default() & call sm%sv%default()
end if end if
else else
write(0,*) 'Calling set_solver without a smoother?' write(0,*) 'Calling set_solver without a smoother?'
@ -674,9 +738,7 @@ contains
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
end subroutine inner_set_solver
end subroutine onelev_set_solver
end subroutine mld_dcprecseti end subroutine mld_dcprecseti

364
mlprec/impl/mld_dprecset.F90
Unescape Escape View File

@ -360,91 +360,123 @@ subroutine mld_dprecseti(p,what,val,info,ilev,pos)
contains contains
subroutine onelev_set_smoother(level,val,info,pos) subroutine onelev_set_smoother(level,val,info,pos)
type(mld_d_onelev_type), intent(inout) :: level class(mld_d_onelev_type), intent(inout) :: level
integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
! Local
integer(psb_ipk_) :: ipos_
info = psb_success_ info = psb_success_
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
case('POST')
ipos_ = mld_post_smooth_
case default
ipos_ = mld_pre_smooth_
end select
else
ipos_ = mld_pre_smooth_
end if
select case(ipos_)
case(mld_pre_smooth_)
call inner_set_smoother(level%sm,val,info)
case (mld_post_smooth_)
call inner_set_smoother(level%sm2a,val,info)
case default
! Impossible!!
info = psb_err_internal_error_
end select
end subroutine onelev_set_smoother
subroutine inner_set_smoother(sm,val,info)
class(mld_d_base_smoother_type), allocatable, intent(inout) :: sm
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
! !
! This here requires a bit more attention. ! This here requires a bit more attention.
! !
select case (val) select case (val)
case (mld_noprec_) case (mld_noprec_)
if (allocated(level%sm)) then if (allocated(sm)) then
select type (sm => level%sm) select type (sms => sm)
type is (mld_d_base_smoother_type) type is (mld_d_base_smoother_type)
! do nothing ! do nothing
class default class default
call level%sm%free(info) call sm%free(info)
if (info == 0) deallocate(level%sm) if (info == 0) deallocate(sm)
if (info == 0) allocate(mld_d_base_smoother_type ::& if (info == 0) allocate(mld_d_base_smoother_type ::&
& level%sm, stat=info) & sm, stat=info)
if (info == 0) allocate(mld_d_id_solver_type ::& if (info == 0) allocate(mld_d_id_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_base_smoother_type ::& allocate(mld_d_base_smoother_type ::&
& level%sm, stat=info) & sm, stat=info)
if (info ==0) allocate(mld_d_id_solver_type ::& if (info ==0) allocate(mld_d_id_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
endif endif
case (mld_jac_) case (mld_jac_)
if (allocated(level%sm)) then if (allocated(sm)) then
select type (sm => level%sm) select type (sms => sm)
class is (mld_d_jac_smoother_type) class is (mld_d_jac_smoother_type)
! do nothing ! do nothing
class default class default
call level%sm%free(info) call sm%free(info)
if (info == 0) deallocate(level%sm) if (info == 0) deallocate(sm)
if (info == 0) allocate(mld_d_jac_smoother_type :: & if (info == 0) allocate(mld_d_jac_smoother_type :: &
& level%sm, stat=info) & sm, stat=info)
if (info == 0) allocate(mld_d_diag_solver_type :: & if (info == 0) allocate(mld_d_diag_solver_type :: &
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_jac_smoother_type :: level%sm, stat=info) allocate(mld_d_jac_smoother_type :: sm, stat=info)
if (info == 0) allocate(mld_d_diag_solver_type ::& if (info == 0) allocate(mld_d_diag_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
endif endif
case (mld_bjac_) case (mld_bjac_)
if (allocated(level%sm)) then if (allocated(sm)) then
select type (sm => level%sm) select type (sms => sm)
class is (mld_d_jac_smoother_type) class is (mld_d_jac_smoother_type)
! do nothing ! do nothing
class default class default
call level%sm%free(info) call sm%free(info)
if (info == 0) deallocate(level%sm) if (info == 0) deallocate(sm)
if (info == 0) allocate(mld_d_jac_smoother_type ::& if (info == 0) allocate(mld_d_jac_smoother_type ::&
& level%sm, stat=info) & sm, stat=info)
if (info == 0) allocate(mld_d_ilu_solver_type ::& if (info == 0) allocate(mld_d_ilu_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_jac_smoother_type :: level%sm, stat=info) allocate(mld_d_jac_smoother_type :: sm, stat=info)
if (info == 0) allocate(mld_d_ilu_solver_type ::& if (info == 0) allocate(mld_d_ilu_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
endif endif
case (mld_as_) case (mld_as_)
if (allocated(level%sm)) then if (allocated(sm)) then
select type (sm => level%sm) select type (sms => sm)
class is (mld_d_as_smoother_type) class is (mld_d_as_smoother_type)
! do nothing ! do nothing
class default class default
call level%sm%free(info) call sm%free(info)
if (info == 0) deallocate(level%sm) if (info == 0) deallocate(sm)
if (info == 0) allocate(mld_d_as_smoother_type ::& if (info == 0) allocate(mld_d_as_smoother_type ::&
& level%sm, stat=info) & sm, stat=info)
if (info == 0) allocate(mld_d_ilu_solver_type ::& if (info == 0) allocate(mld_d_ilu_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_as_smoother_type :: level%sm, stat=info) allocate(mld_d_as_smoother_type :: sm, stat=info)
if (info == 0) allocate(mld_d_ilu_solver_type ::& if (info == 0) allocate(mld_d_ilu_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
endif endif
case default case default
@ -452,65 +484,96 @@ contains
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
if (allocated(level%sm)) & if (allocated(sm)) &
& call level%sm%default() & call sm%default()
end subroutine inner_set_smoother
end subroutine onelev_set_smoother
subroutine onelev_set_solver(level,val,info,pos) subroutine onelev_set_solver(level,val,info,pos)
type(mld_d_onelev_type), intent(inout) :: level class(mld_d_onelev_type), intent(inout) :: level
integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
! Local
integer(psb_ipk_) :: ipos_
info = psb_success_ info = psb_success_
if (present(pos)) then
select case(psb_toupper(trim(pos)))
case('PRE')
ipos_ = mld_pre_smooth_
case('POST')
ipos_ = mld_post_smooth_
case default
ipos_ = mld_pre_smooth_
end select
else
ipos_ = mld_pre_smooth_
end if
select case(ipos_)
case(mld_pre_smooth_)
call inner_set_solver(level%sm,val,info)
case (mld_post_smooth_)
call inner_set_solver(level%sm2a,val,info)
case default
! Impossible!!
info = psb_err_internal_error_
end select
end subroutine onelev_set_solver
subroutine inner_set_solver(sm,val,info)
class(mld_d_base_smoother_type), allocatable, intent(inout) :: sm
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
! !
! This here requires a bit more attention. ! Yes, the first argument is a smoother, to catch the case where
! user is trying to set a solver on a not-yet-allocated smoother.
! !
select case (val) select case (val)
case (mld_f_none_) case (mld_f_none_)
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) then if (allocated(sm%sv)) then
select type (sv => level%sm%sv) select type (sv => sm%sv)
class is (mld_d_id_solver_type) class is (mld_d_id_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) if (info == 0) deallocate(sm%sv)
if (info == 0) allocate(mld_d_id_solver_type ::& if (info == 0) allocate(mld_d_id_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_id_solver_type :: level%sm%sv, stat=info) allocate(mld_d_id_solver_type :: sm%sv, stat=info)
endif endif
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) & if (allocated(sm%sv)) &
& call level%sm%sv%default() & call sm%sv%default()
end if end if
else else
write(0,*) 'Calling set_solver without a smoother?' write(0,*) 'Calling set_solver without a smoother?'
info = -5 info = -5
end if end if
case (mld_diag_scale_) case (mld_diag_scale_)
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) then if (allocated(sm%sv)) then
select type (sv => level%sm%sv) select type (sv => sm%sv)
class is (mld_d_diag_solver_type) class is (mld_d_diag_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) if (info == 0) deallocate(sm%sv)
if (info == 0) allocate(mld_d_diag_solver_type ::& if (info == 0) allocate(mld_d_diag_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_diag_solver_type :: level%sm%sv, stat=info) allocate(mld_d_diag_solver_type :: sm%sv, stat=info)
endif endif
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) & if (allocated(sm%sv)) &
& call level%sm%sv%default() & call sm%sv%default()
end if end if
else else
write(0,*) 'Calling set_solver without a smoother?' write(0,*) 'Calling set_solver without a smoother?'
@ -518,22 +581,23 @@ contains
end if end if
case (mld_gs_) case (mld_gs_)
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) then if (allocated(sm%sv)) then
select type (sv => level%sm%sv) select type (sv => sm%sv)
class is (mld_d_gs_solver_type) class is (mld_d_gs_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) if (info == 0) deallocate(sm%sv)
if (info == 0) allocate(mld_d_gs_solver_type ::& if (info == 0) allocate(mld_d_gs_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_gs_solver_type :: level%sm%sv, stat=info) allocate(mld_d_gs_solver_type :: sm%sv, stat=info)
endif endif
if (allocated(level%sm%sv)) then if (allocated(sm%sv)) then
call level%sm%sv%default() call sm%sv%default()
else
endif endif
else else
@ -542,123 +606,124 @@ contains
end if end if
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) then if (allocated(sm%sv)) then
select type (sv => level%sm%sv) select type (sv => sm%sv)
class is (mld_d_ilu_solver_type) class is (mld_d_ilu_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) if (info == 0) deallocate(sm%sv)
if (info == 0) allocate(mld_d_ilu_solver_type ::& if (info == 0) allocate(mld_d_ilu_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_ilu_solver_type :: level%sm%sv, stat=info) allocate(mld_d_ilu_solver_type :: sm%sv, stat=info)
endif endif
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) & if (allocated(sm%sv)) &
& call level%sm%sv%default() & call sm%sv%default()
end if end if
call level%sm%sv%set(mld_sub_solve_,val,info) call sm%sv%set('SUB_SOLVE',val,info)
else else
write(0,*) 'Calling set_solver without a smoother?' write(0,*) 'Calling set_solver without a smoother?'
info = -5 info = -5
end if end if
#ifdef HAVE_UMF_
case (mld_umf_) #ifdef HAVE_SLU_
if (allocated(level%sm)) then case (mld_slu_)
if (allocated(level%sm%sv)) then if (allocated(sm)) then
select type (sv => level%sm%sv) if (allocated(sm%sv)) then
class is (mld_d_umf_solver_type) select type (sv => sm%sv)
class is (mld_d_slu_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) if (info == 0) deallocate(sm%sv)
if (info == 0) allocate(mld_d_umf_solver_type ::& if (info == 0) allocate(mld_d_slu_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_umf_solver_type :: level%sm%sv, stat=info) allocate(mld_d_slu_solver_type :: sm%sv, stat=info)
endif endif
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) & if (allocated(sm%sv)) &
& call level%sm%sv%default() & call sm%sv%default()
end if end if
else else
write(0,*) 'Calling set_solver without a smoother?' write(0,*) 'Calling set_solver without a smoother?'
info = -5 info = -5
end if end if
#endif #endif
#ifdef HAVE_SLUDIST_ #ifdef HAVE_MUMPS_
case (mld_sludist_) case (mld_mumps_)
if (allocated(level%sm)) then if (allocated(sm%sv)) then
if (allocated(level%sm%sv)) then select type (sv => sm%sv)
select type (sv => level%sm%sv) class is (mld_d_mumps_solver_type)
class is (mld_d_sludist_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) if (info == 0) deallocate(sm%sv)
if (info == 0) allocate(mld_d_sludist_solver_type ::& if (info == 0) allocate(mld_d_mumps_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_sludist_solver_type :: level%sm%sv, stat=info) allocate(mld_d_mumps_solver_type :: sm%sv, stat=info)
endif
if (allocated(level%sm)) then
if (allocated(level%sm%sv)) &
& call level%sm%sv%default()
endif endif
else if (allocated(sm)) then
write(0,*) 'Calling set_solver without a smoother?' if (allocated(sm%sv)) &
info = -5 & call sm%sv%default()
end if end if
#endif #endif
#ifdef HAVE_SLU_
case (mld_slu_) #ifdef HAVE_UMF_
if (allocated(level%sm)) then case (mld_umf_)
if (allocated(level%sm%sv)) then if (allocated(sm)) then
select type (sv => level%sm%sv) if (allocated(sm%sv)) then
class is (mld_d_slu_solver_type) select type (sv => sm%sv)
class is (mld_d_umf_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) if (info == 0) deallocate(sm%sv)
if (info == 0) allocate(mld_d_slu_solver_type ::& if (info == 0) allocate(mld_d_umf_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_slu_solver_type :: level%sm%sv, stat=info) allocate(mld_d_umf_solver_type :: sm%sv, stat=info)
endif endif
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) & if (allocated(sm%sv)) &
& call level%sm%sv%default() & call sm%sv%default()
end if end if
else else
write(0,*) 'Calling set_solver without a smoother?' write(0,*) 'Calling set_solver without a smoother?'
info = -5 info = -5
end if end if
#endif #endif
#ifdef HAVE_MUMPS_ #ifdef HAVE_SLUDIST_
case (mld_mumps_) case (mld_sludist_)
if (allocated(level%sm%sv)) then if (allocated(sm)) then
select type (sv => level%sm%sv) if (allocated(sm%sv)) then
class is (mld_d_mumps_solver_type) select type (sv => sm%sv)
class is (mld_d_sludist_solver_type)
! do nothing ! do nothing
class default class default
call level%sm%sv%free(info) call sm%sv%free(info)
if (info == 0) deallocate(level%sm%sv) if (info == 0) deallocate(sm%sv)
if (info == 0) allocate(mld_d_mumps_solver_type ::& if (info == 0) allocate(mld_d_sludist_solver_type ::&
& level%sm%sv, stat=info) & sm%sv, stat=info)
end select end select
else else
allocate(mld_d_mumps_solver_type :: level%sm%sv, stat=info) allocate(mld_d_sludist_solver_type :: sm%sv, stat=info)
endif endif
if (allocated(level%sm)) then if (allocated(sm)) then
if (allocated(level%sm%sv)) then if (allocated(sm%sv)) &
call level%sm%sv%default() & call sm%sv%default()
end if end if
else
write(0,*) 'Calling set_solver without a smoother?'
info = -5
end if end if
#endif #endif
case default case default
@ -666,9 +731,7 @@ contains
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
end subroutine inner_set_solver
end subroutine onelev_set_solver
end subroutine mld_dprecseti end subroutine mld_dprecseti
@ -734,32 +797,35 @@ subroutine mld_dprecsetsm(p,val,info,ilev,pos)
case(mld_pre_smooth_) case(mld_pre_smooth_)
do ilev_ = ilmin, ilmax do ilev_ = ilmin, ilmax
if (allocated(p%precv(ilev_)%sm)) then if (allocated(p%precv(ilev_)%sm)) then
if (allocated(p%precv(ilev_)%sm%sv)) then if (.not.same_type_as(p%precv(ilev_)%sm,val)) then
deallocate(p%precv(ilev_)%sm%sv) call p%precv(ilev_)%sm%free(info)
deallocate(p%precv(ilev_)%sm, stat=info)
end if end if
deallocate(p%precv(ilev_)%sm)
endif endif
if (.not.allocated(p%precv(ilev_)%sm)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(p%precv(ilev_)%sm,mold=val) allocate(p%precv(ilev_)%sm,mold=val)
#else #else
allocate(p%precv(ilev_)%sm,source=val) allocate(p%precv(ilev_)%sm,source=val)
#endif #endif
end if
call p%precv(ilev_)%sm%default() call p%precv(ilev_)%sm%default()
p%precv(ilev_)%sm2 => p%precv(ilev_)%sm p%precv(ilev_)%sm2 => p%precv(ilev_)%sm
end do end do
case(mld_post_smooth_) case(mld_post_smooth_)
do ilev_ = ilmin, ilmax do ilev_ = ilmin, ilmax
if (allocated(p%precv(ilev_)%sm2a)) then if (allocated(p%precv(ilev_)%sm2a)) then
if (allocated(p%precv(ilev_)%sm2a%sv)) then if (.not.same_type_as(p%precv(ilev_)%sm2a,val)) then
deallocate(p%precv(ilev_)%sm2a%sv) call p%precv(ilev_)%sm2a%free(info)
endif deallocate(p%precv(ilev_)%sm2a, stat=info)
deallocate(p%precv(ilev_)%sm2a)
endif endif
if (.not.allocated(p%precv(ilev_)%sm2a)) then
#ifdef HAVE_MOLD #ifdef HAVE_MOLD
allocate(p%precv(ilev_)%sm2a,mold=val) allocate(p%precv(ilev_)%sm2a,mold=val)
#else #else
allocate(p%precv(ilev_)%sm2a,source=val) allocate(p%precv(ilev_)%sm2a,source=val)
#endif #endif
end if
call p%precv(ilev_)%sm2a%default() call p%precv(ilev_)%sm2a%default()
p%precv(ilev_)%sm2 => p%precv(ilev_)%sm2a p%precv(ilev_)%sm2 => p%precv(ilev_)%sm2a
end do end do
@ -834,6 +900,7 @@ subroutine mld_dprecsetsv(p,val,info,ilev,pos)
if (allocated(p%precv(ilev_)%sm)) then if (allocated(p%precv(ilev_)%sm)) then
if (allocated(p%precv(ilev_)%sm%sv)) then if (allocated(p%precv(ilev_)%sm%sv)) then
if (.not.same_type_as(p%precv(ilev_)%sm%sv,val)) then if (.not.same_type_as(p%precv(ilev_)%sm%sv,val)) then
call p%precv(ilev_)%sm%sv%free(info)
deallocate(p%precv(ilev_)%sm%sv,stat=info) deallocate(p%precv(ilev_)%sm%sv,stat=info)
if (info /= 0) then if (info /= 0) then
info = 3111 info = 3111
@ -870,6 +937,7 @@ subroutine mld_dprecsetsv(p,val,info,ilev,pos)
if (allocated(p%precv(ilev_)%sm2a)) then if (allocated(p%precv(ilev_)%sm2a)) then
if (allocated(p%precv(ilev_)%sm2a%sv)) then if (allocated(p%precv(ilev_)%sm2a%sv)) then
if (.not.same_type_as(p%precv(ilev_)%sm2a%sv,val)) then if (.not.same_type_as(p%precv(ilev_)%sm2a%sv,val)) then
call p%precv(ilev_)%sm2a%sv%free(info)
deallocate(p%precv(ilev_)%sm2a%sv,stat=info) deallocate(p%precv(ilev_)%sm2a%sv,stat=info)
if (info /= 0) then if (info /= 0) then
info = 3111 info = 3111

12
mlprec/mld_d_prec_mod.f90
Unescape Escape View File

@ -115,7 +115,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
call p%set(what,val,info) call p%set(what,val,info,pos=pos)
end subroutine mld_d_iprecseti end subroutine mld_d_iprecseti
subroutine mld_d_iprecsetr(p,what,val,info,pos) subroutine mld_d_iprecsetr(p,what,val,info,pos)
@ -125,7 +125,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
call p%set(what,val,info) call p%set(what,val,info,pos=pos)
end subroutine mld_d_iprecsetr end subroutine mld_d_iprecsetr
subroutine mld_d_iprecsetc(p,what,val,info,pos) subroutine mld_d_iprecsetc(p,what,val,info,pos)
@ -135,7 +135,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
call p%set(what,val,info) call p%set(what,val,info,pos=pos)
end subroutine mld_d_iprecsetc end subroutine mld_d_iprecsetc
subroutine mld_d_cprecseti(p,what,val,info,pos) subroutine mld_d_cprecseti(p,what,val,info,pos)
@ -145,7 +145,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
call p%set(what,val,info) call p%set(what,val,info,pos=pos)
end subroutine mld_d_cprecseti end subroutine mld_d_cprecseti
subroutine mld_d_cprecsetr(p,what,val,info,pos) subroutine mld_d_cprecsetr(p,what,val,info,pos)
@ -155,7 +155,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
call p%set(what,val,info) call p%set(what,val,info,pos=pos)
end subroutine mld_d_cprecsetr end subroutine mld_d_cprecsetr
subroutine mld_d_cprecsetc(p,what,val,info,pos) subroutine mld_d_cprecsetc(p,what,val,info,pos)
@ -165,7 +165,7 @@ contains
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
character(len=*), optional, intent(in) :: pos character(len=*), optional, intent(in) :: pos
call p%set(what,val,info) call p%set(what,val,info,pos=pos)
end subroutine mld_d_cprecsetc end subroutine mld_d_cprecsetc
end module mld_d_prec_mod end module mld_d_prec_mod

4
tests/pdegen/ppde3d-gs.f90
Unescape Escape View File

@ -270,6 +270,7 @@ program ppde3d
call mld_precset(prec,'coarse_aggr_size', prectype%csize, info) call mld_precset(prec,'coarse_aggr_size', prectype%csize, info)
call prec%set(dbsmth,info,pos='post') call prec%set(dbsmth,info,pos='post')
call prec%set(dbwgs,info,pos='post') call prec%set(dbwgs,info,pos='post')
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info, pos='post')
else else
nlv = 1 nlv = 1
call mld_precinit(prec,prectype%prec, info, nlev=nlv) call mld_precinit(prec,prectype%prec, info, nlev=nlv)
@ -281,6 +282,9 @@ program ppde3d
call mld_precset(prec,'sub_fillin', prectype%fill1, info) call mld_precset(prec,'sub_fillin', prectype%fill1, info)
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info) call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info)
call mld_precset(prec,'sub_iluthrs', prectype%thr1, info) call mld_precset(prec,'sub_iluthrs', prectype%thr1, info)
call prec%set(dbsmth,info,pos='post')
call prec%set(dbwgs,info,pos='post')
call mld_precset(prec,'solver_sweeps', prectype%svsweeps, info, pos='post')
end if end if
call psb_barrier(ictxt) call psb_barrier(ictxt)

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

@ -1,21 +1,21 @@
RGMRES ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTABL CG CG ! Iterative method: BiCGSTAB BiCG CGS RGMRES BiCGSTABL CG
CSR ! Storage format CSR COO JAD CSR ! Storage format CSR COO JAD
0030 ! IDIM; domain size is idim**3 0030 ! IDIM; domain size is idim**3
2 ! ISTOPC 2 ! ISTOPC
0100 ! ITMAX 0500 ! ITMAX
10 ! ITRACE 10 ! ITRACE
30 ! IRST (restart for RGMRES and BiCGSTABL) 30 ! IRST (restart for RGMRES and BiCGSTABL)
1.d-6 ! EPS 1.d-6 ! EPS
3L-MUL-RAS-BJAC4-ILU ! Descriptive name for preconditioner (up to 40 chars) 3L-MUL-RAS-BJAC4-ILU ! Descriptive name for preconditioner (up to 40 chars)
ML ! Preconditioner NONE JACOBI BJAC AS ML ML ! Preconditioner NONE JACOBI BJAC AS ML
1 ! Number of overlap layers for AS preconditioner at finest level 0 ! 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
GS ! Subdomain solver DSCALE ILU MILU ILUT UMF SLU GS ! Subdomain solver DSCALE ILU MILU ILUT UMF SLU
2 ! sweeps for GS 4 ! Solver sweeps for GS
0 ! Level-set N for ILU(N), and P for ILUT 0 ! Level-set N for ILU(N), and P for ILUT
1.d-4 ! Threshold T for ILU(T,P) 1.d-4 ! Threshold T for ILU(T,P)
1 ! Smoother/Jacobi sweeps 2 ! Smoother/Jacobi sweeps
BJAC ! Smoother type JACOBI BJAC AS; ignored for non-ML BJAC ! Smoother type JACOBI BJAC AS; ignored for non-ML
2 ! Number of levels in a multilevel preconditioner 2 ! Number of levels in a multilevel preconditioner
SMOOTHED ! Kind of aggregation: SMOOTHED, NONSMOOTHED, MINENERGY SMOOTHED ! Kind of aggregation: SMOOTHED, NONSMOOTHED, MINENERGY
@ -25,7 +25,7 @@ MULT ! Type of multilevel correction: ADD MULT
TWOSIDE ! Side of correction PRE POST TWOSIDE (ignored for ADD) TWOSIDE ! Side of correction PRE POST TWOSIDE (ignored for ADD)
DIST ! Coarse level: matrix distribution DIST REPL DIST ! Coarse level: matrix distribution DIST REPL
BJAC ! Coarse level: solver JACOBI BJAC UMF SLU SLUDIST MUMPS BJAC ! Coarse level: solver JACOBI BJAC UMF SLU SLUDIST MUMPS
GS ! Coarse level: subsolver DSCALE ILU UMF SLU SLUDIST MUMPS ILU ! Coarse level: subsolver DSCALE ILU UMF SLU SLUDIST MUMPS
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