mld2p4-2:

configure.ac
 configure
 mlprec/Makefile
 mlprec/impl/Makefile
 mlprec/impl/level/mld_c_base_onelev_build.f90
 mlprec/impl/level/mld_c_base_onelev_check.f90
 mlprec/impl/level/mld_c_base_onelev_csetc.f90
 mlprec/impl/level/mld_c_base_onelev_cseti.F90
 mlprec/impl/level/mld_c_base_onelev_csetr.f90
 mlprec/impl/level/mld_c_base_onelev_setc.f90
 mlprec/impl/level/mld_c_base_onelev_seti.F90
 mlprec/impl/level/mld_c_base_onelev_setr.f90
 mlprec/impl/level/mld_c_base_onelev_setsm.F90
 mlprec/impl/level/mld_c_base_onelev_setsv.F90
 mlprec/impl/level/mld_d_base_onelev_build.f90
 mlprec/impl/level/mld_d_base_onelev_check.f90
 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/level/mld_d_base_onelev_setsm.F90
 mlprec/impl/level/mld_d_base_onelev_setsv.F90
 mlprec/impl/level/mld_s_base_onelev_build.f90
 mlprec/impl/level/mld_s_base_onelev_check.f90
 mlprec/impl/level/mld_s_base_onelev_csetc.f90
 mlprec/impl/level/mld_s_base_onelev_cseti.F90
 mlprec/impl/level/mld_s_base_onelev_csetr.f90
 mlprec/impl/level/mld_s_base_onelev_setc.f90
 mlprec/impl/level/mld_s_base_onelev_seti.F90
 mlprec/impl/level/mld_s_base_onelev_setr.f90
 mlprec/impl/level/mld_s_base_onelev_setsm.F90
 mlprec/impl/level/mld_s_base_onelev_setsv.F90
 mlprec/impl/level/mld_z_base_onelev_build.f90
 mlprec/impl/level/mld_z_base_onelev_check.f90
 mlprec/impl/level/mld_z_base_onelev_csetc.f90
 mlprec/impl/level/mld_z_base_onelev_cseti.F90
 mlprec/impl/level/mld_z_base_onelev_csetr.f90
 mlprec/impl/level/mld_z_base_onelev_setc.f90
 mlprec/impl/level/mld_z_base_onelev_seti.F90
 mlprec/impl/level/mld_z_base_onelev_setr.f90
 mlprec/impl/level/mld_z_base_onelev_setsm.F90
 mlprec/impl/level/mld_z_base_onelev_setsv.F90
 mlprec/impl/mld_c_extprol_bld.f90
 mlprec/impl/mld_c_hierarchy_bld.f90
 mlprec/impl/mld_c_lev_aggrmap_bld.f90
 mlprec/impl/mld_c_lev_aggrmat_asb.f90
 mlprec/impl/mld_c_smoothers_bld.f90
 mlprec/impl/mld_caggrmat_asb.f90
 mlprec/impl/mld_caggrmat_biz_asb.f90
 mlprec/impl/mld_caggrmat_smth_asb.f90
 mlprec/impl/mld_ccprecset.F90
 mlprec/impl/mld_cmlprec_aply.f90
 mlprec/impl/mld_cmlprec_bld.f90
 mlprec/impl/mld_cprecaply.f90
 mlprec/impl/mld_cprecbld.f90
 mlprec/impl/mld_cprecinit.F90
 mlprec/impl/mld_cprecset.F90
 mlprec/impl/mld_cslud_interface.c
 mlprec/impl/mld_d_extprol_bld.f90
 mlprec/impl/mld_d_hierarchy_bld.f90
 mlprec/impl/mld_d_lev_aggrmap_bld.f90
 mlprec/impl/mld_d_lev_aggrmat_asb.f90
 mlprec/impl/mld_d_smoothers_bld.f90
 mlprec/impl/mld_daggrmat_asb.f90
 mlprec/impl/mld_daggrmat_biz_asb.f90
 mlprec/impl/mld_daggrmat_smth_asb.f90
 mlprec/impl/mld_dcprecset.F90
 mlprec/impl/mld_dmlprec_aply.f90
 mlprec/impl/mld_dmlprec_bld.f90
 mlprec/impl/mld_dprecaply.f90
 mlprec/impl/mld_dprecbld.f90
 mlprec/impl/mld_dprecinit.F90
 mlprec/impl/mld_dprecset.F90
 mlprec/impl/mld_s_extprol_bld.f90
 mlprec/impl/mld_s_hierarchy_bld.f90
 mlprec/impl/mld_s_lev_aggrmap_bld.f90
 mlprec/impl/mld_s_lev_aggrmat_asb.f90
 mlprec/impl/mld_s_smoothers_bld.f90
 mlprec/impl/mld_saggrmat_asb.f90
 mlprec/impl/mld_saggrmat_biz_asb.f90
 mlprec/impl/mld_saggrmat_smth_asb.f90
 mlprec/impl/mld_scprecset.F90
 mlprec/impl/mld_smlprec_aply.f90
 mlprec/impl/mld_smlprec_bld.f90
 mlprec/impl/mld_sprecaply.f90
 mlprec/impl/mld_sprecbld.f90
 mlprec/impl/mld_sprecinit.F90
 mlprec/impl/mld_sprecset.F90
 mlprec/impl/mld_sslud_interface.c
 mlprec/impl/mld_z_extprol_bld.f90
 mlprec/impl/mld_z_hierarchy_bld.f90
 mlprec/impl/mld_z_lev_aggrmap_bld.f90
 mlprec/impl/mld_z_lev_aggrmat_asb.f90
 mlprec/impl/mld_z_smoothers_bld.f90
 mlprec/impl/mld_zaggrmat_asb.f90
 mlprec/impl/mld_zaggrmat_biz_asb.f90
 mlprec/impl/mld_zaggrmat_smth_asb.f90
 mlprec/impl/mld_zcprecset.F90
 mlprec/impl/mld_zmlprec_aply.f90
 mlprec/impl/mld_zmlprec_bld.f90
 mlprec/impl/mld_zprecaply.f90
 mlprec/impl/mld_zprecbld.f90
 mlprec/impl/mld_zprecinit.F90
 mlprec/impl/mld_zprecset.F90
 mlprec/impl/smoother/mld_c_as_smoother_bld.f90
 mlprec/impl/smoother/mld_c_base_smoother_bld.f90
 mlprec/impl/smoother/mld_c_jac_smoother_bld.f90
 mlprec/impl/smoother/mld_d_as_smoother_bld.f90
 mlprec/impl/smoother/mld_d_base_smoother_bld.f90
 mlprec/impl/smoother/mld_d_jac_smoother_bld.f90
 mlprec/impl/smoother/mld_s_as_smoother_bld.f90
 mlprec/impl/smoother/mld_s_base_smoother_bld.f90
 mlprec/impl/smoother/mld_s_jac_smoother_bld.f90
 mlprec/impl/smoother/mld_z_as_smoother_bld.f90
 mlprec/impl/smoother/mld_z_base_smoother_bld.f90
 mlprec/impl/smoother/mld_z_jac_smoother_bld.f90
 mlprec/impl/solver/mld_c_base_solver_bld.f90
 mlprec/impl/solver/mld_c_bwgs_solver_bld.f90
 mlprec/impl/solver/mld_c_diag_solver_bld.f90
 mlprec/impl/solver/mld_c_gs_solver_bld.f90
 mlprec/impl/solver/mld_c_ilu_solver_bld.f90
 mlprec/impl/solver/mld_c_mumps_solver_bld.F90
 mlprec/impl/solver/mld_d_base_solver_bld.f90
 mlprec/impl/solver/mld_d_bwgs_solver_bld.f90
 mlprec/impl/solver/mld_d_diag_solver_bld.f90
 mlprec/impl/solver/mld_d_gs_solver_bld.f90
 mlprec/impl/solver/mld_d_ilu_solver_bld.f90
 mlprec/impl/solver/mld_d_mumps_solver_bld.F90
 mlprec/impl/solver/mld_s_base_solver_bld.f90
 mlprec/impl/solver/mld_s_bwgs_solver_bld.f90
 mlprec/impl/solver/mld_s_diag_solver_bld.f90
 mlprec/impl/solver/mld_s_gs_solver_bld.f90
 mlprec/impl/solver/mld_s_ilu_solver_bld.f90
 mlprec/impl/solver/mld_s_mumps_solver_bld.F90
 mlprec/impl/solver/mld_z_base_solver_bld.f90
 mlprec/impl/solver/mld_z_bwgs_solver_bld.f90
 mlprec/impl/solver/mld_z_diag_solver_bld.f90
 mlprec/impl/solver/mld_z_gs_solver_bld.f90
 mlprec/impl/solver/mld_z_ilu_solver_bld.f90
 mlprec/impl/solver/mld_z_mumps_solver_bld.F90
 mlprec/mld_base_prec_type.F90
 mlprec/mld_c_as_smoother.f90
 mlprec/mld_c_base_smoother_mod.f90
 mlprec/mld_c_base_solver_mod.f90
 mlprec/mld_c_diag_solver.f90
 mlprec/mld_c_gs_solver.f90
 mlprec/mld_c_id_solver.f90
 mlprec/mld_c_ilu_solver.f90
 mlprec/mld_c_jac_smoother.f90
 mlprec/mld_c_mumps_solver.F90
 mlprec/mld_c_onelev_mod.f90
 mlprec/mld_c_prec_type.f90
 mlprec/mld_c_slu_solver.F90
 mlprec/mld_c_sludist_solver.F90
 mlprec/mld_d_as_smoother.f90
 mlprec/mld_d_base_smoother_mod.f90
 mlprec/mld_d_base_solver_mod.f90
 mlprec/mld_d_diag_solver.f90
 mlprec/mld_d_gs_solver.f90
 mlprec/mld_d_id_solver.f90
 mlprec/mld_d_ilu_solver.f90
 mlprec/mld_d_jac_smoother.f90
 mlprec/mld_d_mumps_solver.F90
 mlprec/mld_d_onelev_mod.f90
 mlprec/mld_d_prec_type.f90
 mlprec/mld_d_slu_solver.F90
 mlprec/mld_d_sludist_solver.F90
 mlprec/mld_d_umf_solver.F90
 mlprec/mld_s_as_smoother.f90
 mlprec/mld_s_base_smoother_mod.f90
 mlprec/mld_s_base_solver_mod.f90
 mlprec/mld_s_diag_solver.f90
 mlprec/mld_s_gs_solver.f90
 mlprec/mld_s_id_solver.f90
 mlprec/mld_s_ilu_solver.f90
 mlprec/mld_s_jac_smoother.f90
 mlprec/mld_s_mumps_solver.F90
 mlprec/mld_s_onelev_mod.f90
 mlprec/mld_s_prec_type.f90
 mlprec/mld_s_slu_solver.F90
 mlprec/mld_s_sludist_solver.F90
 mlprec/mld_z_as_smoother.f90
 mlprec/mld_z_base_smoother_mod.f90
 mlprec/mld_z_base_solver_mod.f90
 mlprec/mld_z_diag_solver.f90
 mlprec/mld_z_gs_solver.f90
 mlprec/mld_z_id_solver.f90
 mlprec/mld_z_ilu_solver.f90
 mlprec/mld_z_jac_smoother.f90
 mlprec/mld_z_mumps_solver.F90
 mlprec/mld_z_onelev_mod.f90
 mlprec/mld_z_prec_type.f90
 mlprec/mld_z_slu_solver.F90
 mlprec/mld_z_sludist_solver.F90
 mlprec/mld_z_umf_solver.F90
 tests/pdegen/Makefile
 tests/pdegen/mld_d_pde2d.f90
 tests/pdegen/mld_d_pde3d.f90
 tests/pdegen/mld_s_pde2d.f90
 tests/pdegen/mld_s_pde3d.f90

Further merge changes from fixprec branch.
stopcriterion
Salvatore Filippone 8 years ago
parent 7cd509730b
commit a28f9ff872

9024
configure vendored

File diff suppressed because it is too large Load Diff

@ -672,7 +672,7 @@ if test "x$pac_cv_status_file" != "xNONE"; then
COMPILERULES=''; COMPILERULES='';
else else
COMPILERULES=' COMPILERULES='
FLINK=$(MPF90) FLINK=$(MPFC)
# These should be portable rules, arent they? # These should be portable rules, arent they?
.c.o: .c.o:

@ -14,7 +14,7 @@ DMODOBJS=mld_d_prec_type.o mld_d_ilu_fact_mod.o \
SMODOBJS=mld_s_prec_type.o mld_s_ilu_fact_mod.o \ SMODOBJS=mld_s_prec_type.o mld_s_ilu_fact_mod.o \
mld_s_inner_mod.o mld_s_ilu_solver.o mld_s_diag_solver.o mld_s_jac_smoother.o mld_s_as_smoother.o \ mld_s_inner_mod.o mld_s_ilu_solver.o mld_s_diag_solver.o mld_s_jac_smoother.o mld_s_as_smoother.o \
mld_s_slu_solver.o mld_s_sludist_solver.o mld_s_id_solver.o\ mld_s_slu_solver.o mld_s_id_solver.o\
mld_s_base_solver_mod.o mld_s_base_smoother_mod.o mld_s_onelev_mod.o \ mld_s_base_solver_mod.o mld_s_base_smoother_mod.o mld_s_onelev_mod.o \
mld_s_gs_solver.o mld_s_mumps_solver.o mld_s_gs_solver.o mld_s_mumps_solver.o
@ -26,7 +26,7 @@ ZMODOBJS=mld_z_prec_type.o mld_z_ilu_fact_mod.o \
CMODOBJS=mld_c_prec_type.o mld_c_ilu_fact_mod.o \ CMODOBJS=mld_c_prec_type.o mld_c_ilu_fact_mod.o \
mld_c_inner_mod.o mld_c_ilu_solver.o mld_c_diag_solver.o mld_c_jac_smoother.o mld_c_as_smoother.o \ mld_c_inner_mod.o mld_c_ilu_solver.o mld_c_diag_solver.o mld_c_jac_smoother.o mld_c_as_smoother.o \
mld_c_slu_solver.o mld_c_sludist_solver.o mld_c_id_solver.o\ mld_c_slu_solver.o mld_c_id_solver.o\
mld_c_base_solver_mod.o mld_c_base_smoother_mod.o mld_c_onelev_mod.o \ mld_c_base_solver_mod.o mld_c_base_smoother_mod.o mld_c_onelev_mod.o \
mld_c_gs_solver.o mld_c_mumps_solver.o mld_c_gs_solver.o mld_c_mumps_solver.o

@ -18,7 +18,7 @@ CMPFOBJS=mld_caggrmat_nosmth_asb.o mld_caggrmat_smth_asb.o mld_caggrmat_minnrg_a
MPFOBJS=$(SMPFOBJS) $(DMPFOBJS) $(CMPFOBJS) $(ZMPFOBJS) MPFOBJS=$(SMPFOBJS) $(DMPFOBJS) $(CMPFOBJS) $(ZMPFOBJS)
MPCOBJS=mld_sslud_interface.o mld_dslud_interface.o mld_cslud_interface.o mld_zslud_interface.o MPCOBJS=mld_dslud_interface.o mld_zslud_interface.o
DINNEROBJS= mld_dmlprec_bld.o \ DINNEROBJS= mld_dmlprec_bld.o \

@ -91,18 +91,16 @@ subroutine mld_c_base_onelev_build(lv,info,amold,vmold,imold)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Calling mlprcbld at level ',i & 'Calling mlprcbld at level ',i
call mld_check_def(lv%parms%sweeps,&
& 'Jacobi sweeps',izero,is_int_non_negative)
call mld_check_def(lv%parms%sweeps_pre,& call mld_check_def(lv%parms%sweeps_pre,&
& 'Jacobi sweeps',izero,is_int_non_negative) & 'Jacobi sweeps',izero,is_int_non_negative)
call mld_check_def(lv%parms%sweeps_post,& call mld_check_def(lv%parms%sweeps_post,&
& 'Jacobi sweeps',izero,is_int_non_negative) & 'Jacobi sweeps',izero,is_int_non_negative)
call lv%sm%build(lv%base_a,lv%base_desc,& call lv%sm%build(lv%base_a,lv%base_desc,&
& 'F',info,amold=amold,vmold=vmold,imold=imold) & info,amold=amold,vmold=vmold,imold=imold)
if (info == 0) then if (info == 0) then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%build(lv%base_a,lv%base_desc,'F',info,& call lv%sm2a%build(lv%base_a,lv%base_desc,info,&
& amold=amold,vmold=vmold,imold=imold) & amold=amold,vmold=vmold,imold=imold)
lv%sm2 => lv%sm2a lv%sm2 => lv%sm2a
else else

@ -53,14 +53,11 @@ subroutine mld_c_base_onelev_check(lv,info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
call mld_check_def(lv%parms%sweeps,&
& 'Jacobi sweeps',ione,is_int_non_negative)
call mld_check_def(lv%parms%sweeps_pre,& call mld_check_def(lv%parms%sweeps_pre,&
& 'Jacobi sweeps',ione,is_int_non_negative) & 'Jacobi sweeps',ione,is_int_non_negative)
call mld_check_def(lv%parms%sweeps_post,& call mld_check_def(lv%parms%sweeps_post,&
& 'Jacobi sweeps',ione,is_int_non_negative) & 'Jacobi sweeps',ione,is_int_non_negative)
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%check(info) call lv%sm%check(info)
else else
@ -69,6 +66,14 @@ subroutine mld_c_base_onelev_check(lv,info)
goto 9999 goto 9999
end if end if
if (allocated(lv%sm2a)) then
call lv%sm2a%check(info)
else
info=3111
call psb_errpush(info,name)
goto 9999
end if
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

@ -71,24 +71,23 @@ subroutine mld_c_base_onelev_csetc(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_)
case(mld_pre_smooth_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end if end if

@ -47,9 +47,6 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos)
use mld_c_ilu_solver use mld_c_ilu_solver
use mld_c_id_solver use mld_c_id_solver
use mld_c_gs_solver use mld_c_gs_solver
#if defined(HAVE_SLUDIST_)
use mld_c_sludist_solver
#endif
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
use mld_c_slu_solver use mld_c_slu_solver
#endif #endif
@ -76,9 +73,6 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos)
type(mld_c_id_solver_type) :: mld_c_id_solver_mold type(mld_c_id_solver_type) :: mld_c_id_solver_mold
type(mld_c_gs_solver_type) :: mld_c_gs_solver_mold type(mld_c_gs_solver_type) :: mld_c_gs_solver_mold
type(mld_c_bwgs_solver_type) :: mld_c_bwgs_solver_mold type(mld_c_bwgs_solver_type) :: mld_c_bwgs_solver_mold
#if defined(HAVE_SLUDIST_)
type(mld_c_sludist_solver_type) :: mld_c_sludist_solver_mold
#endif
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
type(mld_c_slu_solver_type) :: mld_c_slu_solver_mold type(mld_c_slu_solver_type) :: mld_c_slu_solver_mold
#endif #endif
@ -96,10 +90,10 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case (psb_toupper(what)) select case (psb_toupper(what))
@ -132,9 +126,10 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos)
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
if (ipos_==mld_pre_smooth_) then if ((ipos_==mld_pre_smooth_).or.(ipos_==mld_both_smooth_)) then
if (allocated(lv%sm)) call lv%sm%default() if (allocated(lv%sm)) call lv%sm%default()
else if (ipos_==mld_post_smooth_) then end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) then
if (allocated(lv%sm2a)) call lv%sm2a%default() if (allocated(lv%sm2a)) call lv%sm2a%default()
end if end if
@ -156,24 +151,17 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_c_ilu_solver_mold,info,pos=pos) call lv%set(mld_c_ilu_solver_mold,info,pos=pos)
if (info == 0) then if (info == 0) then
select case(ipos_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
case(mld_pre_smooth_)
call lv%sm%sv%set('SUB_SOLVE',val,info) call lv%sm%sv%set('SUB_SOLVE',val,info)
case (mld_post_smooth_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end if end if
#ifdef HAVE_SLU_ #ifdef HAVE_SLU_
case (mld_slu_) case (mld_slu_)
call lv%set(mld_c_slu_solver_mold,info,pos=pos) call lv%set(mld_c_slu_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
call lv%set(mld_c_sludist_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_MUMPS_ #ifdef HAVE_MUMPS_
case (mld_mumps_) case (mld_mumps_)
call lv%set(mld_c_mumps_solver_mold,info,pos=pos) call lv%set(mld_c_mumps_solver_mold,info,pos=pos)
@ -186,34 +174,29 @@ subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos)
case ('SMOOTHER_SWEEPS') case ('SMOOTHER_SWEEPS')
lv%parms%sweeps = val if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) &
lv%parms%sweeps_pre = val & lv%parms%sweeps_pre = val
lv%parms%sweeps_post = val if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) &
& lv%parms%sweeps_post = val
case ('SMOOTHER_SWEEPS_PRE')
lv%parms%sweeps_pre = val
case ('SMOOTHER_SWEEPS_POST')
lv%parms%sweeps_post = val
case ('ML_TYPE') case ('ML_CYCLE')
lv%parms%ml_type = val lv%parms%ml_cycle = val
case ('AGGR_ALG') case ('PAR_AGGR_ALG')
lv%parms%aggr_alg = val lv%parms%par_aggr_alg = val
case ('AGGR_ORD') case ('AGGR_ORD')
lv%parms%aggr_ord = val lv%parms%aggr_ord = val
case ('AGGR_KIND') case ('AGGR_TYPE')
lv%parms%aggr_kind = val lv%parms%aggr_type = val
case ('AGGR_PROL')
lv%parms%aggr_prol = val
case ('COARSE_MAT') case ('COARSE_MAT')
lv%parms%coarse_mat = val lv%parms%coarse_mat = val
case ('SMOOTHER_POS')
lv%parms%smoother_pos = val
case ('AGGR_OMEGA_ALG') case ('AGGR_OMEGA_ALG')
lv%parms%aggr_omega_alg= val lv%parms%aggr_omega_alg= val
@ -227,19 +210,16 @@ subroutine mld_c_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_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -67,9 +67,6 @@ subroutine mld_c_base_onelev_csetr(lv,what,val,info,pos)
case ('AGGR_THRESH') case ('AGGR_THRESH')
lv%parms%aggr_thresh = val lv%parms%aggr_thresh = val
case ('AGGR_SCALE')
lv%parms%aggr_scale = val
case default case default
if (present(pos)) then if (present(pos)) then
@ -79,24 +76,22 @@ subroutine mld_c_base_onelev_csetr(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_)
case(mld_pre_smooth_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -38,7 +38,7 @@
! !
! !
subroutine mld_c_base_onelev_setc(lv,what,val,info,pos) subroutine mld_c_base_onelev_setc(lv,what,val,info,pos)
use psb_base_mod use psb_base_mod
use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_setc use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_setc
@ -63,7 +63,7 @@ subroutine mld_c_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 if (present(pos)) then
select case(psb_toupper(trim(pos))) select case(psb_toupper(trim(pos)))
case('PRE') case('PRE')
@ -71,32 +71,31 @@ subroutine mld_c_base_onelev_setc(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_)
case(mld_pre_smooth_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end if end if
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine mld_c_base_onelev_setc end subroutine mld_c_base_onelev_setc

@ -47,9 +47,6 @@ subroutine mld_c_base_onelev_seti(lv,what,val,info,pos)
use mld_c_ilu_solver use mld_c_ilu_solver
use mld_c_id_solver use mld_c_id_solver
use mld_c_gs_solver use mld_c_gs_solver
#if defined(HAVE_SLUDIST_)
use mld_c_sludist_solver
#endif
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
use mld_c_slu_solver use mld_c_slu_solver
#endif #endif
@ -76,9 +73,6 @@ subroutine mld_c_base_onelev_seti(lv,what,val,info,pos)
type(mld_c_id_solver_type) :: mld_c_id_solver_mold type(mld_c_id_solver_type) :: mld_c_id_solver_mold
type(mld_c_gs_solver_type) :: mld_c_gs_solver_mold type(mld_c_gs_solver_type) :: mld_c_gs_solver_mold
type(mld_c_bwgs_solver_type) :: mld_c_bwgs_solver_mold type(mld_c_bwgs_solver_type) :: mld_c_bwgs_solver_mold
#if defined(HAVE_SLUDIST_)
type(mld_c_sludist_solver_type) :: mld_c_sludist_solver_mold
#endif
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
type(mld_c_slu_solver_type) :: mld_c_slu_solver_mold type(mld_c_slu_solver_type) :: mld_c_slu_solver_mold
#endif #endif
@ -95,10 +89,10 @@ subroutine mld_c_base_onelev_seti(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case (what) select case (what)
@ -133,9 +127,10 @@ subroutine mld_c_base_onelev_seti(lv,what,val,info,pos)
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
if (ipos_==mld_pre_smooth_) then if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if (allocated(lv%sm)) call lv%sm%default() if (allocated(lv%sm)) call lv%sm%default()
else if (ipos_==mld_post_smooth_) then end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) call lv%sm2a%default() if (allocated(lv%sm2a)) call lv%sm2a%default()
end if end if
@ -157,24 +152,17 @@ subroutine mld_c_base_onelev_seti(lv,what,val,info,pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_c_ilu_solver_mold,info,pos=pos) call lv%set(mld_c_ilu_solver_mold,info,pos=pos)
if (info == 0) then if (info == 0) then
select case(ipos_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
case(mld_pre_smooth_)
call lv%sm%sv%set('SUB_SOLVE',val,info) call lv%sm%sv%set('SUB_SOLVE',val,info)
case (mld_post_smooth_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end if end if
#ifdef HAVE_SLU_ #ifdef HAVE_SLU_
case (mld_slu_) case (mld_slu_)
call lv%set(mld_c_slu_solver_mold,info,pos=pos) call lv%set(mld_c_slu_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
call lv%set(mld_c_sludist_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_MUMPS_ #ifdef HAVE_MUMPS_
case (mld_mumps_) case (mld_mumps_)
call lv%set(mld_c_mumps_solver_mold,info,pos=pos) call lv%set(mld_c_mumps_solver_mold,info,pos=pos)
@ -186,34 +174,29 @@ subroutine mld_c_base_onelev_seti(lv,what,val,info,pos)
end select end select
case (mld_smoother_sweeps_) case (mld_smoother_sweeps_)
lv%parms%sweeps = val if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) &
lv%parms%sweeps_pre = val & lv%parms%sweeps_pre = val
lv%parms%sweeps_post = val if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) &
& lv%parms%sweeps_post = val
case (mld_smoother_sweeps_pre_)
lv%parms%sweeps_pre = val
case (mld_smoother_sweeps_post_)
lv%parms%sweeps_post = val
case (mld_ml_type_) case (mld_ml_cycle_)
lv%parms%ml_type = val lv%parms%ml_cycle = val
case (mld_aggr_alg_) case (mld_par_aggr_alg_)
lv%parms%aggr_alg = val lv%parms%par_aggr_alg = val
case (mld_aggr_ord_) case (mld_aggr_ord_)
lv%parms%aggr_ord = val lv%parms%aggr_ord = val
case (mld_aggr_kind_) case (mld_aggr_type_)
lv%parms%aggr_kind = val lv%parms%aggr_type = val
case (mld_aggr_prol_)
lv%parms%aggr_prol = val
case (mld_coarse_mat_) case (mld_coarse_mat_)
lv%parms%coarse_mat = val lv%parms%coarse_mat = val
case (mld_smoother_pos_)
lv%parms%smoother_pos = val
case (mld_aggr_omega_alg_) case (mld_aggr_omega_alg_)
lv%parms%aggr_omega_alg= val lv%parms%aggr_omega_alg= val
@ -228,19 +211,16 @@ subroutine mld_c_base_onelev_seti(lv,what,val,info,pos)
case default case default
select case(ipos_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -67,9 +67,6 @@ subroutine mld_c_base_onelev_setr(lv,what,val,info,pos)
case (mld_aggr_thresh_) case (mld_aggr_thresh_)
lv%parms%aggr_thresh = val lv%parms%aggr_thresh = val
case (mld_aggr_scale_)
lv%parms%aggr_scale = val
case default case default
if (present(pos)) then if (present(pos)) then
@ -79,24 +76,24 @@ subroutine mld_c_base_onelev_setr(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_)
case(mld_pre_smooth_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -63,14 +63,22 @@ subroutine mld_c_base_onelev_setsm(lev,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
if (ipos_ == mld_both_smooth_) then
if (allocated(lev%sm2a)) then
call lev%sm2a%free(info)
deallocate(lev%sm2a, stat=info)
lev%sm2 => null()
end if
end if
select case(ipos_) select case(ipos_)
case(mld_pre_smooth_) case(mld_pre_smooth_, mld_both_smooth_)
if (allocated(lev%sm)) then if (allocated(lev%sm)) then
if (.not.same_type_as(lev%sm,val)) then if (.not.same_type_as(lev%sm,val)) then
call lev%sm%free(info) call lev%sm%free(info)
@ -85,7 +93,7 @@ subroutine mld_c_base_onelev_setsm(lev,val,info,pos)
#endif #endif
end if end if
call lev%sm%default() call lev%sm%default()
lev%sm2 => lev%sm if (ipos_ == mld_both_smooth_) lev%sm2 => lev%sm
case(mld_post_smooth_) case(mld_post_smooth_)
if (allocated(lev%sm2a)) then if (allocated(lev%sm2a)) then
if (.not.same_type_as(lev%sm2a,val)) then if (.not.same_type_as(lev%sm2a,val)) then

@ -63,14 +63,13 @@ subroutine mld_c_base_onelev_setsv(lev,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_) if ((ipos_ == mld_pre_smooth_).or.(ipos_ == mld_both_smooth_)) then
case(mld_pre_smooth_)
if (allocated(lev%sm)) then if (allocated(lev%sm)) then
if (allocated(lev%sm%sv)) then if (allocated(lev%sm%sv)) then
if (.not.same_type_as(lev%sm%sv,val)) then if (.not.same_type_as(lev%sm%sv,val)) then
@ -103,8 +102,18 @@ subroutine mld_c_base_onelev_setsv(lev,val,info,pos)
return return
end if end if
end if
case(mld_post_smooth_)
!
! If POS was not specified and therefore we have mld_both_smooth_
! we need to update sm2a *only* if it was already allocated,
! otherwise it is not needed (since we have just fixed %sm in the
! pre section).
!
if ((ipos_ == mld_post_smooth_).or. &
((ipos_ == mld_both_smooth_).and.(allocated(lev%sm2a)))) then
if (allocated(lev%sm2a)) then if (allocated(lev%sm2a)) then
if (allocated(lev%sm2a%sv)) then if (allocated(lev%sm2a%sv)) then
@ -139,7 +148,7 @@ subroutine mld_c_base_onelev_setsv(lev,val,info,pos)
end if end if
end select end if
end subroutine mld_c_base_onelev_setsv end subroutine mld_c_base_onelev_setsv

@ -91,18 +91,16 @@ subroutine mld_d_base_onelev_build(lv,info,amold,vmold,imold)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Calling mlprcbld at level ',i & 'Calling mlprcbld at level ',i
call mld_check_def(lv%parms%sweeps,&
& 'Jacobi sweeps',izero,is_int_non_negative)
call mld_check_def(lv%parms%sweeps_pre,& call mld_check_def(lv%parms%sweeps_pre,&
& 'Jacobi sweeps',izero,is_int_non_negative) & 'Jacobi sweeps',izero,is_int_non_negative)
call mld_check_def(lv%parms%sweeps_post,& call mld_check_def(lv%parms%sweeps_post,&
& 'Jacobi sweeps',izero,is_int_non_negative) & 'Jacobi sweeps',izero,is_int_non_negative)
call lv%sm%build(lv%base_a,lv%base_desc,& call lv%sm%build(lv%base_a,lv%base_desc,&
& 'F',info,amold=amold,vmold=vmold,imold=imold) & info,amold=amold,vmold=vmold,imold=imold)
if (info == 0) then if (info == 0) then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%build(lv%base_a,lv%base_desc,'F',info,& call lv%sm2a%build(lv%base_a,lv%base_desc,info,&
& amold=amold,vmold=vmold,imold=imold) & amold=amold,vmold=vmold,imold=imold)
lv%sm2 => lv%sm2a lv%sm2 => lv%sm2a
else else

@ -53,14 +53,11 @@ subroutine mld_d_base_onelev_check(lv,info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
call mld_check_def(lv%parms%sweeps,&
& 'Jacobi sweeps',ione,is_int_non_negative)
call mld_check_def(lv%parms%sweeps_pre,& call mld_check_def(lv%parms%sweeps_pre,&
& 'Jacobi sweeps',ione,is_int_non_negative) & 'Jacobi sweeps',ione,is_int_non_negative)
call mld_check_def(lv%parms%sweeps_post,& call mld_check_def(lv%parms%sweeps_post,&
& 'Jacobi sweeps',ione,is_int_non_negative) & 'Jacobi sweeps',ione,is_int_non_negative)
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%check(info) call lv%sm%check(info)
else else
@ -69,6 +66,14 @@ subroutine mld_d_base_onelev_check(lv,info)
goto 9999 goto 9999
end if end if
if (allocated(lv%sm2a)) then
call lv%sm2a%check(info)
else
info=3111
call psb_errpush(info,name)
goto 9999
end if
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

@ -71,24 +71,23 @@ subroutine mld_d_base_onelev_csetc(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_)
case(mld_pre_smooth_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end if end if

@ -102,10 +102,10 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case (psb_toupper(what)) select case (psb_toupper(what))
@ -138,9 +138,10 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos)
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
if (ipos_==mld_pre_smooth_) then if ((ipos_==mld_pre_smooth_).or.(ipos_==mld_both_smooth_)) then
if (allocated(lv%sm)) call lv%sm%default() if (allocated(lv%sm)) call lv%sm%default()
else if (ipos_==mld_post_smooth_) then end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) then
if (allocated(lv%sm2a)) call lv%sm2a%default() if (allocated(lv%sm2a)) call lv%sm2a%default()
end if end if
@ -162,28 +163,25 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_d_ilu_solver_mold,info,pos=pos) call lv%set(mld_d_ilu_solver_mold,info,pos=pos)
if (info == 0) then if (info == 0) then
select case(ipos_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
case(mld_pre_smooth_)
call lv%sm%sv%set('SUB_SOLVE',val,info) call lv%sm%sv%set('SUB_SOLVE',val,info)
case (mld_post_smooth_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end if end if
#ifdef HAVE_SLU_ #ifdef HAVE_SLU_
case (mld_slu_) case (mld_slu_)
call lv%set(mld_d_slu_solver_mold,info,pos=pos) call lv%set(mld_d_slu_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
call lv%set(mld_d_sludist_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_MUMPS_ #ifdef HAVE_MUMPS_
case (mld_mumps_) case (mld_mumps_)
call lv%set(mld_d_mumps_solver_mold,info,pos=pos) call lv%set(mld_d_mumps_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
call lv%set(mld_d_sludist_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_UMF_ #ifdef HAVE_UMF_
case (mld_umf_) case (mld_umf_)
call lv%set(mld_d_umf_solver_mold,info,pos=pos) call lv%set(mld_d_umf_solver_mold,info,pos=pos)
@ -196,34 +194,29 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos)
case ('SMOOTHER_SWEEPS') case ('SMOOTHER_SWEEPS')
lv%parms%sweeps = val if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) &
lv%parms%sweeps_pre = val & lv%parms%sweeps_pre = val
lv%parms%sweeps_post = val if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) &
& lv%parms%sweeps_post = val
case ('SMOOTHER_SWEEPS_PRE')
lv%parms%sweeps_pre = val
case ('SMOOTHER_SWEEPS_POST')
lv%parms%sweeps_post = val
case ('ML_TYPE') case ('ML_CYCLE')
lv%parms%ml_type = val lv%parms%ml_cycle = val
case ('AGGR_ALG') case ('PAR_AGGR_ALG')
lv%parms%aggr_alg = val lv%parms%par_aggr_alg = val
case ('AGGR_ORD') case ('AGGR_ORD')
lv%parms%aggr_ord = val lv%parms%aggr_ord = val
case ('AGGR_KIND') case ('AGGR_TYPE')
lv%parms%aggr_kind = val lv%parms%aggr_type = val
case ('AGGR_PROL')
lv%parms%aggr_prol = val
case ('COARSE_MAT') case ('COARSE_MAT')
lv%parms%coarse_mat = val lv%parms%coarse_mat = val
case ('SMOOTHER_POS')
lv%parms%smoother_pos = val
case ('AGGR_OMEGA_ALG') case ('AGGR_OMEGA_ALG')
lv%parms%aggr_omega_alg= val lv%parms%aggr_omega_alg= val
@ -237,19 +230,16 @@ 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_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -67,9 +67,6 @@ subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos)
case ('AGGR_THRESH') case ('AGGR_THRESH')
lv%parms%aggr_thresh = val lv%parms%aggr_thresh = val
case ('AGGR_SCALE')
lv%parms%aggr_scale = val
case default case default
if (present(pos)) then if (present(pos)) then
@ -79,24 +76,22 @@ subroutine mld_d_base_onelev_csetr(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_)
case(mld_pre_smooth_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -38,7 +38,7 @@
! !
! !
subroutine mld_d_base_onelev_setc(lv,what,val,info,pos) subroutine mld_d_base_onelev_setc(lv,what,val,info,pos)
use psb_base_mod use psb_base_mod
use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_setc use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_setc
@ -63,7 +63,7 @@ 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 if (present(pos)) then
select case(psb_toupper(trim(pos))) select case(psb_toupper(trim(pos)))
case('PRE') case('PRE')
@ -71,32 +71,31 @@ subroutine mld_d_base_onelev_setc(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_)
case(mld_pre_smooth_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end if end if
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine mld_d_base_onelev_setc end subroutine mld_d_base_onelev_setc

@ -101,10 +101,10 @@ subroutine mld_d_base_onelev_seti(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case (what) select case (what)
@ -139,9 +139,10 @@ subroutine mld_d_base_onelev_seti(lv,what,val,info,pos)
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
if (ipos_==mld_pre_smooth_) then if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if (allocated(lv%sm)) call lv%sm%default() if (allocated(lv%sm)) call lv%sm%default()
else if (ipos_==mld_post_smooth_) then end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) call lv%sm2a%default() if (allocated(lv%sm2a)) call lv%sm2a%default()
end if end if
@ -163,28 +164,25 @@ subroutine mld_d_base_onelev_seti(lv,what,val,info,pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_d_ilu_solver_mold,info,pos=pos) call lv%set(mld_d_ilu_solver_mold,info,pos=pos)
if (info == 0) then if (info == 0) then
select case(ipos_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
case(mld_pre_smooth_)
call lv%sm%sv%set('SUB_SOLVE',val,info) call lv%sm%sv%set('SUB_SOLVE',val,info)
case (mld_post_smooth_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end if end if
#ifdef HAVE_SLU_ #ifdef HAVE_SLU_
case (mld_slu_) case (mld_slu_)
call lv%set(mld_d_slu_solver_mold,info,pos=pos) call lv%set(mld_d_slu_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
call lv%set(mld_d_sludist_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_MUMPS_ #ifdef HAVE_MUMPS_
case (mld_mumps_) case (mld_mumps_)
call lv%set(mld_d_mumps_solver_mold,info,pos=pos) call lv%set(mld_d_mumps_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
call lv%set(mld_d_sludist_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_UMF_ #ifdef HAVE_UMF_
case (mld_umf_) case (mld_umf_)
call lv%set(mld_d_umf_solver_mold,info,pos=pos) call lv%set(mld_d_umf_solver_mold,info,pos=pos)
@ -196,34 +194,29 @@ subroutine mld_d_base_onelev_seti(lv,what,val,info,pos)
end select end select
case (mld_smoother_sweeps_) case (mld_smoother_sweeps_)
lv%parms%sweeps = val if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) &
lv%parms%sweeps_pre = val & lv%parms%sweeps_pre = val
lv%parms%sweeps_post = val if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) &
& lv%parms%sweeps_post = val
case (mld_smoother_sweeps_pre_)
lv%parms%sweeps_pre = val
case (mld_smoother_sweeps_post_)
lv%parms%sweeps_post = val
case (mld_ml_type_) case (mld_ml_cycle_)
lv%parms%ml_type = val lv%parms%ml_cycle = val
case (mld_aggr_alg_) case (mld_par_aggr_alg_)
lv%parms%aggr_alg = val lv%parms%par_aggr_alg = val
case (mld_aggr_ord_) case (mld_aggr_ord_)
lv%parms%aggr_ord = val lv%parms%aggr_ord = val
case (mld_aggr_kind_) case (mld_aggr_type_)
lv%parms%aggr_kind = val lv%parms%aggr_type = val
case (mld_aggr_prol_)
lv%parms%aggr_prol = val
case (mld_coarse_mat_) case (mld_coarse_mat_)
lv%parms%coarse_mat = val lv%parms%coarse_mat = val
case (mld_smoother_pos_)
lv%parms%smoother_pos = val
case (mld_aggr_omega_alg_) case (mld_aggr_omega_alg_)
lv%parms%aggr_omega_alg= val lv%parms%aggr_omega_alg= val
@ -238,19 +231,16 @@ subroutine mld_d_base_onelev_seti(lv,what,val,info,pos)
case default case default
select case(ipos_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -67,9 +67,6 @@ subroutine mld_d_base_onelev_setr(lv,what,val,info,pos)
case (mld_aggr_thresh_) case (mld_aggr_thresh_)
lv%parms%aggr_thresh = val lv%parms%aggr_thresh = val
case (mld_aggr_scale_)
lv%parms%aggr_scale = val
case default case default
if (present(pos)) then if (present(pos)) then
@ -79,24 +76,24 @@ subroutine mld_d_base_onelev_setr(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_)
case(mld_pre_smooth_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -63,14 +63,22 @@ subroutine mld_d_base_onelev_setsm(lev,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
if (ipos_ == mld_both_smooth_) then
if (allocated(lev%sm2a)) then
call lev%sm2a%free(info)
deallocate(lev%sm2a, stat=info)
lev%sm2 => null()
end if
end if
select case(ipos_) select case(ipos_)
case(mld_pre_smooth_) case(mld_pre_smooth_, mld_both_smooth_)
if (allocated(lev%sm)) then if (allocated(lev%sm)) then
if (.not.same_type_as(lev%sm,val)) then if (.not.same_type_as(lev%sm,val)) then
call lev%sm%free(info) call lev%sm%free(info)
@ -85,7 +93,7 @@ subroutine mld_d_base_onelev_setsm(lev,val,info,pos)
#endif #endif
end if end if
call lev%sm%default() call lev%sm%default()
lev%sm2 => lev%sm if (ipos_ == mld_both_smooth_) lev%sm2 => lev%sm
case(mld_post_smooth_) case(mld_post_smooth_)
if (allocated(lev%sm2a)) then if (allocated(lev%sm2a)) then
if (.not.same_type_as(lev%sm2a,val)) then if (.not.same_type_as(lev%sm2a,val)) then

@ -63,14 +63,13 @@ subroutine mld_d_base_onelev_setsv(lev,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_) if ((ipos_ == mld_pre_smooth_).or.(ipos_ == mld_both_smooth_)) then
case(mld_pre_smooth_)
if (allocated(lev%sm)) then if (allocated(lev%sm)) then
if (allocated(lev%sm%sv)) then if (allocated(lev%sm%sv)) then
if (.not.same_type_as(lev%sm%sv,val)) then if (.not.same_type_as(lev%sm%sv,val)) then
@ -103,8 +102,18 @@ subroutine mld_d_base_onelev_setsv(lev,val,info,pos)
return return
end if end if
end if
case(mld_post_smooth_)
!
! If POS was not specified and therefore we have mld_both_smooth_
! we need to update sm2a *only* if it was already allocated,
! otherwise it is not needed (since we have just fixed %sm in the
! pre section).
!
if ((ipos_ == mld_post_smooth_).or. &
((ipos_ == mld_both_smooth_).and.(allocated(lev%sm2a)))) then
if (allocated(lev%sm2a)) then if (allocated(lev%sm2a)) then
if (allocated(lev%sm2a%sv)) then if (allocated(lev%sm2a%sv)) then
@ -139,7 +148,7 @@ subroutine mld_d_base_onelev_setsv(lev,val,info,pos)
end if end if
end select end if
end subroutine mld_d_base_onelev_setsv end subroutine mld_d_base_onelev_setsv

@ -91,18 +91,16 @@ subroutine mld_s_base_onelev_build(lv,info,amold,vmold,imold)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Calling mlprcbld at level ',i & 'Calling mlprcbld at level ',i
call mld_check_def(lv%parms%sweeps,&
& 'Jacobi sweeps',izero,is_int_non_negative)
call mld_check_def(lv%parms%sweeps_pre,& call mld_check_def(lv%parms%sweeps_pre,&
& 'Jacobi sweeps',izero,is_int_non_negative) & 'Jacobi sweeps',izero,is_int_non_negative)
call mld_check_def(lv%parms%sweeps_post,& call mld_check_def(lv%parms%sweeps_post,&
& 'Jacobi sweeps',izero,is_int_non_negative) & 'Jacobi sweeps',izero,is_int_non_negative)
call lv%sm%build(lv%base_a,lv%base_desc,& call lv%sm%build(lv%base_a,lv%base_desc,&
& 'F',info,amold=amold,vmold=vmold,imold=imold) & info,amold=amold,vmold=vmold,imold=imold)
if (info == 0) then if (info == 0) then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%build(lv%base_a,lv%base_desc,'F',info,& call lv%sm2a%build(lv%base_a,lv%base_desc,info,&
& amold=amold,vmold=vmold,imold=imold) & amold=amold,vmold=vmold,imold=imold)
lv%sm2 => lv%sm2a lv%sm2 => lv%sm2a
else else

@ -53,14 +53,11 @@ subroutine mld_s_base_onelev_check(lv,info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
call mld_check_def(lv%parms%sweeps,&
& 'Jacobi sweeps',ione,is_int_non_negative)
call mld_check_def(lv%parms%sweeps_pre,& call mld_check_def(lv%parms%sweeps_pre,&
& 'Jacobi sweeps',ione,is_int_non_negative) & 'Jacobi sweeps',ione,is_int_non_negative)
call mld_check_def(lv%parms%sweeps_post,& call mld_check_def(lv%parms%sweeps_post,&
& 'Jacobi sweeps',ione,is_int_non_negative) & 'Jacobi sweeps',ione,is_int_non_negative)
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%check(info) call lv%sm%check(info)
else else
@ -69,6 +66,14 @@ subroutine mld_s_base_onelev_check(lv,info)
goto 9999 goto 9999
end if end if
if (allocated(lv%sm2a)) then
call lv%sm2a%check(info)
else
info=3111
call psb_errpush(info,name)
goto 9999
end if
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

@ -71,24 +71,23 @@ subroutine mld_s_base_onelev_csetc(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_)
case(mld_pre_smooth_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end if end if

@ -47,9 +47,6 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos)
use mld_s_ilu_solver use mld_s_ilu_solver
use mld_s_id_solver use mld_s_id_solver
use mld_s_gs_solver use mld_s_gs_solver
#if defined(HAVE_SLUDIST_)
use mld_s_sludist_solver
#endif
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
use mld_s_slu_solver use mld_s_slu_solver
#endif #endif
@ -76,9 +73,6 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos)
type(mld_s_id_solver_type) :: mld_s_id_solver_mold type(mld_s_id_solver_type) :: mld_s_id_solver_mold
type(mld_s_gs_solver_type) :: mld_s_gs_solver_mold type(mld_s_gs_solver_type) :: mld_s_gs_solver_mold
type(mld_s_bwgs_solver_type) :: mld_s_bwgs_solver_mold type(mld_s_bwgs_solver_type) :: mld_s_bwgs_solver_mold
#if defined(HAVE_SLUDIST_)
type(mld_s_sludist_solver_type) :: mld_s_sludist_solver_mold
#endif
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
type(mld_s_slu_solver_type) :: mld_s_slu_solver_mold type(mld_s_slu_solver_type) :: mld_s_slu_solver_mold
#endif #endif
@ -96,10 +90,10 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case (psb_toupper(what)) select case (psb_toupper(what))
@ -132,9 +126,10 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos)
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
if (ipos_==mld_pre_smooth_) then if ((ipos_==mld_pre_smooth_).or.(ipos_==mld_both_smooth_)) then
if (allocated(lv%sm)) call lv%sm%default() if (allocated(lv%sm)) call lv%sm%default()
else if (ipos_==mld_post_smooth_) then end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) then
if (allocated(lv%sm2a)) call lv%sm2a%default() if (allocated(lv%sm2a)) call lv%sm2a%default()
end if end if
@ -156,24 +151,17 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_s_ilu_solver_mold,info,pos=pos) call lv%set(mld_s_ilu_solver_mold,info,pos=pos)
if (info == 0) then if (info == 0) then
select case(ipos_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
case(mld_pre_smooth_)
call lv%sm%sv%set('SUB_SOLVE',val,info) call lv%sm%sv%set('SUB_SOLVE',val,info)
case (mld_post_smooth_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end if end if
#ifdef HAVE_SLU_ #ifdef HAVE_SLU_
case (mld_slu_) case (mld_slu_)
call lv%set(mld_s_slu_solver_mold,info,pos=pos) call lv%set(mld_s_slu_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
call lv%set(mld_s_sludist_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_MUMPS_ #ifdef HAVE_MUMPS_
case (mld_mumps_) case (mld_mumps_)
call lv%set(mld_s_mumps_solver_mold,info,pos=pos) call lv%set(mld_s_mumps_solver_mold,info,pos=pos)
@ -186,34 +174,29 @@ subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos)
case ('SMOOTHER_SWEEPS') case ('SMOOTHER_SWEEPS')
lv%parms%sweeps = val if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) &
lv%parms%sweeps_pre = val & lv%parms%sweeps_pre = val
lv%parms%sweeps_post = val if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) &
& lv%parms%sweeps_post = val
case ('SMOOTHER_SWEEPS_PRE')
lv%parms%sweeps_pre = val
case ('SMOOTHER_SWEEPS_POST')
lv%parms%sweeps_post = val
case ('ML_TYPE') case ('ML_CYCLE')
lv%parms%ml_type = val lv%parms%ml_cycle = val
case ('AGGR_ALG') case ('PAR_AGGR_ALG')
lv%parms%aggr_alg = val lv%parms%par_aggr_alg = val
case ('AGGR_ORD') case ('AGGR_ORD')
lv%parms%aggr_ord = val lv%parms%aggr_ord = val
case ('AGGR_KIND') case ('AGGR_TYPE')
lv%parms%aggr_kind = val lv%parms%aggr_type = val
case ('AGGR_PROL')
lv%parms%aggr_prol = val
case ('COARSE_MAT') case ('COARSE_MAT')
lv%parms%coarse_mat = val lv%parms%coarse_mat = val
case ('SMOOTHER_POS')
lv%parms%smoother_pos = val
case ('AGGR_OMEGA_ALG') case ('AGGR_OMEGA_ALG')
lv%parms%aggr_omega_alg= val lv%parms%aggr_omega_alg= val
@ -227,19 +210,16 @@ subroutine mld_s_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_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -67,9 +67,6 @@ subroutine mld_s_base_onelev_csetr(lv,what,val,info,pos)
case ('AGGR_THRESH') case ('AGGR_THRESH')
lv%parms%aggr_thresh = val lv%parms%aggr_thresh = val
case ('AGGR_SCALE')
lv%parms%aggr_scale = val
case default case default
if (present(pos)) then if (present(pos)) then
@ -79,24 +76,22 @@ subroutine mld_s_base_onelev_csetr(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_)
case(mld_pre_smooth_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -38,7 +38,7 @@
! !
! !
subroutine mld_s_base_onelev_setc(lv,what,val,info,pos) subroutine mld_s_base_onelev_setc(lv,what,val,info,pos)
use psb_base_mod use psb_base_mod
use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_setc use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_setc
@ -63,7 +63,7 @@ subroutine mld_s_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 if (present(pos)) then
select case(psb_toupper(trim(pos))) select case(psb_toupper(trim(pos)))
case('PRE') case('PRE')
@ -71,32 +71,31 @@ subroutine mld_s_base_onelev_setc(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_)
case(mld_pre_smooth_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end if end if
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine mld_s_base_onelev_setc end subroutine mld_s_base_onelev_setc

@ -47,9 +47,6 @@ subroutine mld_s_base_onelev_seti(lv,what,val,info,pos)
use mld_s_ilu_solver use mld_s_ilu_solver
use mld_s_id_solver use mld_s_id_solver
use mld_s_gs_solver use mld_s_gs_solver
#if defined(HAVE_SLUDIST_)
use mld_s_sludist_solver
#endif
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
use mld_s_slu_solver use mld_s_slu_solver
#endif #endif
@ -76,9 +73,6 @@ subroutine mld_s_base_onelev_seti(lv,what,val,info,pos)
type(mld_s_id_solver_type) :: mld_s_id_solver_mold type(mld_s_id_solver_type) :: mld_s_id_solver_mold
type(mld_s_gs_solver_type) :: mld_s_gs_solver_mold type(mld_s_gs_solver_type) :: mld_s_gs_solver_mold
type(mld_s_bwgs_solver_type) :: mld_s_bwgs_solver_mold type(mld_s_bwgs_solver_type) :: mld_s_bwgs_solver_mold
#if defined(HAVE_SLUDIST_)
type(mld_s_sludist_solver_type) :: mld_s_sludist_solver_mold
#endif
#if defined(HAVE_SLU_) #if defined(HAVE_SLU_)
type(mld_s_slu_solver_type) :: mld_s_slu_solver_mold type(mld_s_slu_solver_type) :: mld_s_slu_solver_mold
#endif #endif
@ -95,10 +89,10 @@ subroutine mld_s_base_onelev_seti(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case (what) select case (what)
@ -133,9 +127,10 @@ subroutine mld_s_base_onelev_seti(lv,what,val,info,pos)
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
if (ipos_==mld_pre_smooth_) then if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if (allocated(lv%sm)) call lv%sm%default() if (allocated(lv%sm)) call lv%sm%default()
else if (ipos_==mld_post_smooth_) then end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) call lv%sm2a%default() if (allocated(lv%sm2a)) call lv%sm2a%default()
end if end if
@ -157,24 +152,17 @@ subroutine mld_s_base_onelev_seti(lv,what,val,info,pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_s_ilu_solver_mold,info,pos=pos) call lv%set(mld_s_ilu_solver_mold,info,pos=pos)
if (info == 0) then if (info == 0) then
select case(ipos_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
case(mld_pre_smooth_)
call lv%sm%sv%set('SUB_SOLVE',val,info) call lv%sm%sv%set('SUB_SOLVE',val,info)
case (mld_post_smooth_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end if end if
#ifdef HAVE_SLU_ #ifdef HAVE_SLU_
case (mld_slu_) case (mld_slu_)
call lv%set(mld_s_slu_solver_mold,info,pos=pos) call lv%set(mld_s_slu_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
call lv%set(mld_s_sludist_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_MUMPS_ #ifdef HAVE_MUMPS_
case (mld_mumps_) case (mld_mumps_)
call lv%set(mld_s_mumps_solver_mold,info,pos=pos) call lv%set(mld_s_mumps_solver_mold,info,pos=pos)
@ -186,34 +174,29 @@ subroutine mld_s_base_onelev_seti(lv,what,val,info,pos)
end select end select
case (mld_smoother_sweeps_) case (mld_smoother_sweeps_)
lv%parms%sweeps = val if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) &
lv%parms%sweeps_pre = val & lv%parms%sweeps_pre = val
lv%parms%sweeps_post = val if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) &
& lv%parms%sweeps_post = val
case (mld_smoother_sweeps_pre_)
lv%parms%sweeps_pre = val
case (mld_smoother_sweeps_post_)
lv%parms%sweeps_post = val
case (mld_ml_type_) case (mld_ml_cycle_)
lv%parms%ml_type = val lv%parms%ml_cycle = val
case (mld_aggr_alg_) case (mld_par_aggr_alg_)
lv%parms%aggr_alg = val lv%parms%par_aggr_alg = val
case (mld_aggr_ord_) case (mld_aggr_ord_)
lv%parms%aggr_ord = val lv%parms%aggr_ord = val
case (mld_aggr_kind_) case (mld_aggr_type_)
lv%parms%aggr_kind = val lv%parms%aggr_type = val
case (mld_aggr_prol_)
lv%parms%aggr_prol = val
case (mld_coarse_mat_) case (mld_coarse_mat_)
lv%parms%coarse_mat = val lv%parms%coarse_mat = val
case (mld_smoother_pos_)
lv%parms%smoother_pos = val
case (mld_aggr_omega_alg_) case (mld_aggr_omega_alg_)
lv%parms%aggr_omega_alg= val lv%parms%aggr_omega_alg= val
@ -228,19 +211,16 @@ subroutine mld_s_base_onelev_seti(lv,what,val,info,pos)
case default case default
select case(ipos_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -67,9 +67,6 @@ subroutine mld_s_base_onelev_setr(lv,what,val,info,pos)
case (mld_aggr_thresh_) case (mld_aggr_thresh_)
lv%parms%aggr_thresh = val lv%parms%aggr_thresh = val
case (mld_aggr_scale_)
lv%parms%aggr_scale = val
case default case default
if (present(pos)) then if (present(pos)) then
@ -79,24 +76,24 @@ subroutine mld_s_base_onelev_setr(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_)
case(mld_pre_smooth_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -63,14 +63,22 @@ subroutine mld_s_base_onelev_setsm(lev,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
if (ipos_ == mld_both_smooth_) then
if (allocated(lev%sm2a)) then
call lev%sm2a%free(info)
deallocate(lev%sm2a, stat=info)
lev%sm2 => null()
end if
end if
select case(ipos_) select case(ipos_)
case(mld_pre_smooth_) case(mld_pre_smooth_, mld_both_smooth_)
if (allocated(lev%sm)) then if (allocated(lev%sm)) then
if (.not.same_type_as(lev%sm,val)) then if (.not.same_type_as(lev%sm,val)) then
call lev%sm%free(info) call lev%sm%free(info)
@ -85,7 +93,7 @@ subroutine mld_s_base_onelev_setsm(lev,val,info,pos)
#endif #endif
end if end if
call lev%sm%default() call lev%sm%default()
lev%sm2 => lev%sm if (ipos_ == mld_both_smooth_) lev%sm2 => lev%sm
case(mld_post_smooth_) case(mld_post_smooth_)
if (allocated(lev%sm2a)) then if (allocated(lev%sm2a)) then
if (.not.same_type_as(lev%sm2a,val)) then if (.not.same_type_as(lev%sm2a,val)) then

@ -63,14 +63,13 @@ subroutine mld_s_base_onelev_setsv(lev,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_) if ((ipos_ == mld_pre_smooth_).or.(ipos_ == mld_both_smooth_)) then
case(mld_pre_smooth_)
if (allocated(lev%sm)) then if (allocated(lev%sm)) then
if (allocated(lev%sm%sv)) then if (allocated(lev%sm%sv)) then
if (.not.same_type_as(lev%sm%sv,val)) then if (.not.same_type_as(lev%sm%sv,val)) then
@ -103,8 +102,18 @@ subroutine mld_s_base_onelev_setsv(lev,val,info,pos)
return return
end if end if
end if
case(mld_post_smooth_)
!
! If POS was not specified and therefore we have mld_both_smooth_
! we need to update sm2a *only* if it was already allocated,
! otherwise it is not needed (since we have just fixed %sm in the
! pre section).
!
if ((ipos_ == mld_post_smooth_).or. &
((ipos_ == mld_both_smooth_).and.(allocated(lev%sm2a)))) then
if (allocated(lev%sm2a)) then if (allocated(lev%sm2a)) then
if (allocated(lev%sm2a%sv)) then if (allocated(lev%sm2a%sv)) then
@ -139,7 +148,7 @@ subroutine mld_s_base_onelev_setsv(lev,val,info,pos)
end if end if
end select end if
end subroutine mld_s_base_onelev_setsv end subroutine mld_s_base_onelev_setsv

@ -91,18 +91,16 @@ subroutine mld_z_base_onelev_build(lv,info,amold,vmold,imold)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Calling mlprcbld at level ',i & 'Calling mlprcbld at level ',i
call mld_check_def(lv%parms%sweeps,&
& 'Jacobi sweeps',izero,is_int_non_negative)
call mld_check_def(lv%parms%sweeps_pre,& call mld_check_def(lv%parms%sweeps_pre,&
& 'Jacobi sweeps',izero,is_int_non_negative) & 'Jacobi sweeps',izero,is_int_non_negative)
call mld_check_def(lv%parms%sweeps_post,& call mld_check_def(lv%parms%sweeps_post,&
& 'Jacobi sweeps',izero,is_int_non_negative) & 'Jacobi sweeps',izero,is_int_non_negative)
call lv%sm%build(lv%base_a,lv%base_desc,& call lv%sm%build(lv%base_a,lv%base_desc,&
& 'F',info,amold=amold,vmold=vmold,imold=imold) & info,amold=amold,vmold=vmold,imold=imold)
if (info == 0) then if (info == 0) then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%build(lv%base_a,lv%base_desc,'F',info,& call lv%sm2a%build(lv%base_a,lv%base_desc,info,&
& amold=amold,vmold=vmold,imold=imold) & amold=amold,vmold=vmold,imold=imold)
lv%sm2 => lv%sm2a lv%sm2 => lv%sm2a
else else

@ -53,14 +53,11 @@ subroutine mld_z_base_onelev_check(lv,info)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
call mld_check_def(lv%parms%sweeps,&
& 'Jacobi sweeps',ione,is_int_non_negative)
call mld_check_def(lv%parms%sweeps_pre,& call mld_check_def(lv%parms%sweeps_pre,&
& 'Jacobi sweeps',ione,is_int_non_negative) & 'Jacobi sweeps',ione,is_int_non_negative)
call mld_check_def(lv%parms%sweeps_post,& call mld_check_def(lv%parms%sweeps_post,&
& 'Jacobi sweeps',ione,is_int_non_negative) & 'Jacobi sweeps',ione,is_int_non_negative)
if (allocated(lv%sm)) then if (allocated(lv%sm)) then
call lv%sm%check(info) call lv%sm%check(info)
else else
@ -69,6 +66,14 @@ subroutine mld_z_base_onelev_check(lv,info)
goto 9999 goto 9999
end if end if
if (allocated(lv%sm2a)) then
call lv%sm2a%check(info)
else
info=3111
call psb_errpush(info,name)
goto 9999
end if
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

@ -71,24 +71,23 @@ subroutine mld_z_base_onelev_csetc(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_)
case(mld_pre_smooth_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end if end if

@ -102,10 +102,10 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case (psb_toupper(what)) select case (psb_toupper(what))
@ -138,9 +138,10 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos)
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
if (ipos_==mld_pre_smooth_) then if ((ipos_==mld_pre_smooth_).or.(ipos_==mld_both_smooth_)) then
if (allocated(lv%sm)) call lv%sm%default() if (allocated(lv%sm)) call lv%sm%default()
else if (ipos_==mld_post_smooth_) then end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) then
if (allocated(lv%sm2a)) call lv%sm2a%default() if (allocated(lv%sm2a)) call lv%sm2a%default()
end if end if
@ -162,28 +163,25 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_z_ilu_solver_mold,info,pos=pos) call lv%set(mld_z_ilu_solver_mold,info,pos=pos)
if (info == 0) then if (info == 0) then
select case(ipos_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
case(mld_pre_smooth_)
call lv%sm%sv%set('SUB_SOLVE',val,info) call lv%sm%sv%set('SUB_SOLVE',val,info)
case (mld_post_smooth_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end if end if
#ifdef HAVE_SLU_ #ifdef HAVE_SLU_
case (mld_slu_) case (mld_slu_)
call lv%set(mld_z_slu_solver_mold,info,pos=pos) call lv%set(mld_z_slu_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
call lv%set(mld_z_sludist_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_MUMPS_ #ifdef HAVE_MUMPS_
case (mld_mumps_) case (mld_mumps_)
call lv%set(mld_z_mumps_solver_mold,info,pos=pos) call lv%set(mld_z_mumps_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
call lv%set(mld_z_sludist_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_UMF_ #ifdef HAVE_UMF_
case (mld_umf_) case (mld_umf_)
call lv%set(mld_z_umf_solver_mold,info,pos=pos) call lv%set(mld_z_umf_solver_mold,info,pos=pos)
@ -196,34 +194,29 @@ subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos)
case ('SMOOTHER_SWEEPS') case ('SMOOTHER_SWEEPS')
lv%parms%sweeps = val if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) &
lv%parms%sweeps_pre = val & lv%parms%sweeps_pre = val
lv%parms%sweeps_post = val if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) &
& lv%parms%sweeps_post = val
case ('SMOOTHER_SWEEPS_PRE')
lv%parms%sweeps_pre = val
case ('SMOOTHER_SWEEPS_POST')
lv%parms%sweeps_post = val
case ('ML_TYPE') case ('ML_CYCLE')
lv%parms%ml_type = val lv%parms%ml_cycle = val
case ('AGGR_ALG') case ('PAR_AGGR_ALG')
lv%parms%aggr_alg = val lv%parms%par_aggr_alg = val
case ('AGGR_ORD') case ('AGGR_ORD')
lv%parms%aggr_ord = val lv%parms%aggr_ord = val
case ('AGGR_KIND') case ('AGGR_TYPE')
lv%parms%aggr_kind = val lv%parms%aggr_type = val
case ('AGGR_PROL')
lv%parms%aggr_prol = val
case ('COARSE_MAT') case ('COARSE_MAT')
lv%parms%coarse_mat = val lv%parms%coarse_mat = val
case ('SMOOTHER_POS')
lv%parms%smoother_pos = val
case ('AGGR_OMEGA_ALG') case ('AGGR_OMEGA_ALG')
lv%parms%aggr_omega_alg= val lv%parms%aggr_omega_alg= val
@ -237,19 +230,16 @@ subroutine mld_z_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_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -67,9 +67,6 @@ subroutine mld_z_base_onelev_csetr(lv,what,val,info,pos)
case ('AGGR_THRESH') case ('AGGR_THRESH')
lv%parms%aggr_thresh = val lv%parms%aggr_thresh = val
case ('AGGR_SCALE')
lv%parms%aggr_scale = val
case default case default
if (present(pos)) then if (present(pos)) then
@ -79,24 +76,22 @@ subroutine mld_z_base_onelev_csetr(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_)
case(mld_pre_smooth_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -38,7 +38,7 @@
! !
! !
subroutine mld_z_base_onelev_setc(lv,what,val,info,pos) subroutine mld_z_base_onelev_setc(lv,what,val,info,pos)
use psb_base_mod use psb_base_mod
use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_setc use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_setc
@ -63,7 +63,7 @@ subroutine mld_z_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 if (present(pos)) then
select case(psb_toupper(trim(pos))) select case(psb_toupper(trim(pos)))
case('PRE') case('PRE')
@ -71,32 +71,31 @@ subroutine mld_z_base_onelev_setc(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_)
case(mld_pre_smooth_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end if end if
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(err_act) 9999 call psb_error_handler(err_act)
return return
end subroutine mld_z_base_onelev_setc end subroutine mld_z_base_onelev_setc

@ -101,10 +101,10 @@ subroutine mld_z_base_onelev_seti(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case (what) select case (what)
@ -139,9 +139,10 @@ subroutine mld_z_base_onelev_seti(lv,what,val,info,pos)
! Do nothing and hope for the best :) ! Do nothing and hope for the best :)
! !
end select end select
if (ipos_==mld_pre_smooth_) then if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
if (allocated(lv%sm)) call lv%sm%default() if (allocated(lv%sm)) call lv%sm%default()
else if (ipos_==mld_post_smooth_) then end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) call lv%sm2a%default() if (allocated(lv%sm2a)) call lv%sm2a%default()
end if end if
@ -163,28 +164,25 @@ subroutine mld_z_base_onelev_seti(lv,what,val,info,pos)
case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_)
call lv%set(mld_z_ilu_solver_mold,info,pos=pos) call lv%set(mld_z_ilu_solver_mold,info,pos=pos)
if (info == 0) then if (info == 0) then
select case(ipos_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
case(mld_pre_smooth_)
call lv%sm%sv%set('SUB_SOLVE',val,info) call lv%sm%sv%set('SUB_SOLVE',val,info)
case (mld_post_smooth_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info)
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end if end if
#ifdef HAVE_SLU_ #ifdef HAVE_SLU_
case (mld_slu_) case (mld_slu_)
call lv%set(mld_z_slu_solver_mold,info,pos=pos) call lv%set(mld_z_slu_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
call lv%set(mld_z_sludist_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_MUMPS_ #ifdef HAVE_MUMPS_
case (mld_mumps_) case (mld_mumps_)
call lv%set(mld_z_mumps_solver_mold,info,pos=pos) call lv%set(mld_z_mumps_solver_mold,info,pos=pos)
#endif #endif
#ifdef HAVE_SLUDIST_
case (mld_sludist_)
call lv%set(mld_z_sludist_solver_mold,info,pos=pos)
#endif
#ifdef HAVE_UMF_ #ifdef HAVE_UMF_
case (mld_umf_) case (mld_umf_)
call lv%set(mld_z_umf_solver_mold,info,pos=pos) call lv%set(mld_z_umf_solver_mold,info,pos=pos)
@ -196,34 +194,29 @@ subroutine mld_z_base_onelev_seti(lv,what,val,info,pos)
end select end select
case (mld_smoother_sweeps_) case (mld_smoother_sweeps_)
lv%parms%sweeps = val if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) &
lv%parms%sweeps_pre = val & lv%parms%sweeps_pre = val
lv%parms%sweeps_post = val if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_)) &
& lv%parms%sweeps_post = val
case (mld_smoother_sweeps_pre_)
lv%parms%sweeps_pre = val
case (mld_smoother_sweeps_post_)
lv%parms%sweeps_post = val
case (mld_ml_type_) case (mld_ml_cycle_)
lv%parms%ml_type = val lv%parms%ml_cycle = val
case (mld_aggr_alg_) case (mld_par_aggr_alg_)
lv%parms%aggr_alg = val lv%parms%par_aggr_alg = val
case (mld_aggr_ord_) case (mld_aggr_ord_)
lv%parms%aggr_ord = val lv%parms%aggr_ord = val
case (mld_aggr_kind_) case (mld_aggr_type_)
lv%parms%aggr_kind = val lv%parms%aggr_type = val
case (mld_aggr_prol_)
lv%parms%aggr_prol = val
case (mld_coarse_mat_) case (mld_coarse_mat_)
lv%parms%coarse_mat = val lv%parms%coarse_mat = val
case (mld_smoother_pos_)
lv%parms%smoother_pos = val
case (mld_aggr_omega_alg_) case (mld_aggr_omega_alg_)
lv%parms%aggr_omega_alg= val lv%parms%aggr_omega_alg= val
@ -238,19 +231,16 @@ subroutine mld_z_base_onelev_seti(lv,what,val,info,pos)
case default case default
select case(ipos_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -67,9 +67,6 @@ subroutine mld_z_base_onelev_setr(lv,what,val,info,pos)
case (mld_aggr_thresh_) case (mld_aggr_thresh_)
lv%parms%aggr_thresh = val lv%parms%aggr_thresh = val
case (mld_aggr_scale_)
lv%parms%aggr_scale = val
case default case default
if (present(pos)) then if (present(pos)) then
@ -79,24 +76,24 @@ subroutine mld_z_base_onelev_setr(lv,what,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_)
case(mld_pre_smooth_) if ((ipos_==mld_pre_smooth_) .or.(ipos_==mld_both_smooth_)) then
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_) end if
if ((ipos_==mld_post_smooth_).or.(ipos_==mld_both_smooth_))then
if (allocated(lv%sm2a)) then if (allocated(lv%sm2a)) then
call lv%sm2a%set(what,val,info) call lv%sm2a%set(what,val,info)
end if end if
case default end if
! Impossible!!
info = psb_err_internal_error_
end select
end select end select
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999

@ -63,14 +63,22 @@ subroutine mld_z_base_onelev_setsm(lev,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
if (ipos_ == mld_both_smooth_) then
if (allocated(lev%sm2a)) then
call lev%sm2a%free(info)
deallocate(lev%sm2a, stat=info)
lev%sm2 => null()
end if
end if
select case(ipos_) select case(ipos_)
case(mld_pre_smooth_) case(mld_pre_smooth_, mld_both_smooth_)
if (allocated(lev%sm)) then if (allocated(lev%sm)) then
if (.not.same_type_as(lev%sm,val)) then if (.not.same_type_as(lev%sm,val)) then
call lev%sm%free(info) call lev%sm%free(info)
@ -85,7 +93,7 @@ subroutine mld_z_base_onelev_setsm(lev,val,info,pos)
#endif #endif
end if end if
call lev%sm%default() call lev%sm%default()
lev%sm2 => lev%sm if (ipos_ == mld_both_smooth_) lev%sm2 => lev%sm
case(mld_post_smooth_) case(mld_post_smooth_)
if (allocated(lev%sm2a)) then if (allocated(lev%sm2a)) then
if (.not.same_type_as(lev%sm2a,val)) then if (.not.same_type_as(lev%sm2a,val)) then

@ -63,14 +63,13 @@ subroutine mld_z_base_onelev_setsv(lev,val,info,pos)
case('POST') case('POST')
ipos_ = mld_post_smooth_ ipos_ = mld_post_smooth_
case default case default
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end select end select
else else
ipos_ = mld_pre_smooth_ ipos_ = mld_both_smooth_
end if end if
select case(ipos_) if ((ipos_ == mld_pre_smooth_).or.(ipos_ == mld_both_smooth_)) then
case(mld_pre_smooth_)
if (allocated(lev%sm)) then if (allocated(lev%sm)) then
if (allocated(lev%sm%sv)) then if (allocated(lev%sm%sv)) then
if (.not.same_type_as(lev%sm%sv,val)) then if (.not.same_type_as(lev%sm%sv,val)) then
@ -103,8 +102,18 @@ subroutine mld_z_base_onelev_setsv(lev,val,info,pos)
return return
end if end if
end if
case(mld_post_smooth_)
!
! If POS was not specified and therefore we have mld_both_smooth_
! we need to update sm2a *only* if it was already allocated,
! otherwise it is not needed (since we have just fixed %sm in the
! pre section).
!
if ((ipos_ == mld_post_smooth_).or. &
((ipos_ == mld_both_smooth_).and.(allocated(lev%sm2a)))) then
if (allocated(lev%sm2a)) then if (allocated(lev%sm2a)) then
if (allocated(lev%sm2a%sv)) then if (allocated(lev%sm2a%sv)) then
@ -139,7 +148,7 @@ subroutine mld_z_base_onelev_setsv(lev,val,info,pos)
end if end if
end select end if
end subroutine mld_z_base_onelev_setsv end subroutine mld_z_base_onelev_setsv

@ -154,10 +154,9 @@ subroutine mld_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
! Check to ensure all procs have the same ! Check to ensure all procs have the same
! !
newsz = -1 newsz = -1
casize = p%coarse_aggr_size mxplevs = p%max_levs
mxplevs = p%max_prec_levs mnaggratio = p%min_cr_ratio
mnaggratio = p%min_aggr_ratio casize = p%min_coarse_size
casize = p%coarse_aggr_size
iszv = size(p%precv) iszv = size(p%precv)
nprolv = size(prolv) nprolv = size(prolv)
nrestrv = size(restrv) nrestrv = size(restrv)
@ -167,19 +166,19 @@ subroutine mld_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ictxt,mnaggratio)
call psb_bcast(ictxt,nprolv) call psb_bcast(ictxt,nprolv)
call psb_bcast(ictxt,nrestrv) call psb_bcast(ictxt,nrestrv)
if (casize /= p%coarse_aggr_size) then if (casize /= p%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
goto 9999 goto 9999
end if end if
if (mxplevs /= p%max_prec_levs) then if (mxplevs /= p%max_levs) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs') call psb_errpush(info,name,a_err='Inconsistent max_levs')
goto 9999 goto 9999
end if end if
if (mnaggratio /= p%min_aggr_ratio) then if (mnaggratio /= p%min_cr_ratio) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio') call psb_errpush(info,name,a_err='Inconsistent min_cr_ratio')
goto 9999 goto 9999
end if end if
if (iszv /= size(p%precv)) then if (iszv /= size(p%precv)) then
@ -220,8 +219,8 @@ subroutine mld_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
endif endif
! !
nplevs = nrestrv + 1 nplevs = nrestrv + 1
p%max_prec_levs = nplevs p%max_levs = nplevs
! !
! Fixed number of levels. ! Fixed number of levels.
@ -366,9 +365,9 @@ contains
allocate(nlaggr(np),ilaggr(1)) allocate(nlaggr(np),ilaggr(1))
nlaggr = 0 nlaggr = 0
ilaggr = 0 ilaggr = 0
p%parms%aggr_alg = mld_ext_aggr_ p%parms%par_aggr_alg = mld_ext_aggr_
call mld_check_def(p%parms%ml_type,'Multilevel type',& call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',&
& mld_mult_ml_,is_legal_ml_type) & mld_mult_ml_,is_legal_ml_cycle)
call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& call mld_check_def(p%parms%coarse_mat,'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat) & mld_distr_mat_,is_legal_ml_coarse_mat)

@ -78,19 +78,19 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
class(mld_cprec_type),intent(inout),target :: prec class(mld_cprec_type),intent(inout),target :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
!!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs, iaggsize integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize,&
real(psb_spk_) :: mnaggratio, sizeratio, athresh, ascale, aomega & nplevs, mxplevs, iaggsize
class(mld_c_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, base_sm2, med_sm2, coarse_sm2 real(psb_spk_) :: mnaggratio, sizeratio, athresh, aomega
class(mld_c_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, &
& base_sm2, med_sm2, coarse_sm2
type(mld_sml_parms) :: baseparms, medparms, coarseparms type(mld_sml_parms) :: baseparms, medparms, coarseparms
integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:)
type(psb_cspmat_type) :: op_prol type(psb_cspmat_type) :: op_prol
type(mld_c_onelev_type), allocatable :: tprecv(:) type(mld_c_onelev_type), allocatable :: tprecv(:)
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -111,21 +111,6 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
! !
! For the time being we are commenting out the UPDATE argument
! we plan to resurrect it later.
! !$ if (present(upd)) then
! !$ if (debug_level >= psb_debug_outer_) &
! !$ & write(debug_unit,*) me,' ',trim(name),'UPD ', upd
! !$
! !$ if ((psb_toupper(upd).eq.'F').or.(psb_toupper(upd).eq.'T')) then
! !$ upd_=psb_toupper(upd)
! !$ else
! !$ upd_='F'
! !$ endif
! !$ else
! !$ upd_='F'
! !$ endif
upd_ = 'F'
if (.not.allocated(prec%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_cprecinit !! Error: should have called mld_cprecinit
@ -138,28 +123,27 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
! Check to ensure all procs have the same ! Check to ensure all procs have the same
! !
newsz = -1 newsz = -1
casize = prec%coarse_aggr_size mxplevs = prec%max_levs
mxplevs = prec%max_prec_levs mnaggratio = prec%min_cr_ratio
mnaggratio = prec%min_aggr_ratio casize = prec%min_coarse_size
casize = prec%coarse_aggr_size
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize) call psb_bcast(ictxt,casize)
call psb_bcast(ictxt,mxplevs) call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ictxt,mnaggratio)
if (casize /= prec%coarse_aggr_size) then if (casize /= prec%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
goto 9999 goto 9999
end if end if
if (mxplevs /= prec%max_prec_levs) then if (mxplevs /= prec%max_levs) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs') call psb_errpush(info,name,a_err='Inconsistent max_levs')
goto 9999 goto 9999
end if end if
if (mnaggratio /= prec%min_aggr_ratio) then if (mnaggratio /= prec%min_cr_ratio) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio') call psb_errpush(info,name,a_err='Inconsistent min_cr_ratio')
goto 9999 goto 9999
end if end if
if (iszv /= size(prec%precv)) then if (iszv /= size(prec%precv)) then
@ -198,18 +182,20 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
! 3. If the size of the array is different from target number of levels, ! 3. If the size of the array is different from target number of levels,
! reallocate; ! reallocate;
! 4. Build the matrix hierarchy, stopping early if either the target ! 4. Build the matrix hierarchy, stopping early if either the target
! coarse size is hit, or the gain falls below the min_aggr_ratio ! coarse size is hit, or the gain falls below the min_cr_ratio
! threshold. ! threshold.
! !
if (casize <=0) then if (casize < 0) then
! !
! Default to the cubic root of the size at base level. ! Default to the cubic root of the size at base level.
! !
casize = desc_a%get_global_rows() casize = desc_a%get_global_rows()
casize = int((sone*casize)**(sone/(sone*3)),psb_ipk_) casize = int((sone*casize)**(sone/(sone*3)),psb_ipk_)
casize = max(casize,ione) casize = max(casize,ione)
casize = casize*40_psb_ipk_ casize = casize*40_psb_ipk_
call psb_bcast(ictxt,casize)
prec%min_coarse_size = casize
end if end if
nplevs = max(itwo,mxplevs) nplevs = max(itwo,mxplevs)
@ -357,11 +343,9 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
! of distr/repl matrix at coarse level. Should be rethought. ! of distr/repl matrix at coarse level. Should be rethought.
! !
athresh = prec%precv(newsz)%parms%aggr_thresh athresh = prec%precv(newsz)%parms%aggr_thresh
ascale = prec%precv(newsz)%parms%aggr_scale
aomega = prec%precv(newsz)%parms%aggr_omega_val aomega = prec%precv(newsz)%parms%aggr_omega_val
if (info == 0) prec%precv(newsz)%parms = coarseparms if (info == 0) prec%precv(newsz)%parms = coarseparms
prec%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_thresh = athresh
prec%precv(newsz)%parms%aggr_scale = ascale
prec%precv(newsz)%parms%aggr_omega_val = aomega prec%precv(newsz)%parms%aggr_omega_val = aomega
if (info == 0) call restore_smoothers(prec%precv(newsz),coarse_sm,coarse_sm2,info) if (info == 0) call restore_smoothers(prec%precv(newsz),coarse_sm,coarse_sm2,info)

@ -108,15 +108,15 @@ subroutine mld_c_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
call mld_check_def(p%parms%ml_type,'Multilevel type',& call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',&
& mld_mult_ml_,is_legal_ml_type) & mld_mult_ml_,is_legal_ml_cycle)
call mld_check_def(p%parms%aggr_alg,'Aggregation',& call mld_check_def(p%parms%par_aggr_alg,'Aggregation',&
& mld_dec_aggr_,is_legal_ml_aggr_alg) & mld_dec_aggr_,is_legal_ml_par_aggr_alg)
call mld_check_def(p%parms%aggr_ord,'Ordering',& call mld_check_def(p%parms%aggr_ord,'Ordering',&
& mld_aggr_ord_nat_,is_legal_ml_aggr_ord) & mld_aggr_ord_nat_,is_legal_ml_aggr_ord)
call mld_check_def(p%parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs) call mld_check_def(p%parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)
select case(p%parms%aggr_alg) select case(p%parms%par_aggr_alg)
case (mld_dec_aggr_, mld_sym_dec_aggr_) case (mld_dec_aggr_, mld_sym_dec_aggr_)
! !
@ -125,7 +125,7 @@ subroutine mld_c_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
! aggregation algorithm. This also defines a tentative prolongator from ! aggregation algorithm. This also defines a tentative prolongator from
! the coarse to the fine level. ! the coarse to the fine level.
! !
call mld_aggrmap_bld(p%parms%aggr_alg,p%parms%aggr_ord,p%parms%aggr_thresh,& call mld_aggrmap_bld(p%parms%par_aggr_alg,p%parms%aggr_ord,p%parms%aggr_thresh,&
& a,desc_a,ilaggr,nlaggr,op_prol,info) & a,desc_a,ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -137,14 +137,14 @@ subroutine mld_c_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
write(0,*) 'Matching is not implemented yet ' write(0,*) 'Matching is not implemented yet '
info = -1111 info = -1111
call psb_errpush(psb_err_input_value_invalid_i_,name,& call psb_errpush(psb_err_input_value_invalid_i_,name,&
& i_err=(/ione,p%parms%aggr_alg,izero,izero,izero/)) & i_err=(/ione,p%parms%par_aggr_alg,izero,izero,izero/))
goto 9999 goto 9999
case default case default
info = -1 info = -1
call psb_errpush(psb_err_input_value_invalid_i_,name,& call psb_errpush(psb_err_input_value_invalid_i_,name,&
& i_err=(/ione,p%parms%aggr_alg,izero,izero,izero/)) & i_err=(/ione,p%parms%par_aggr_alg,izero,izero,izero/))
goto 9999 goto 9999
end select end select

@ -121,14 +121,12 @@ subroutine mld_c_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
call mld_check_def(p%parms%aggr_kind,'Smoother',& call mld_check_def(p%parms%aggr_prol,'Smoother',&
& mld_smooth_prol_,is_legal_ml_aggr_kind) & mld_smooth_prol_,is_legal_ml_aggr_prol)
call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& call mld_check_def(p%parms%coarse_mat,'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat) & mld_distr_mat_,is_legal_ml_coarse_mat)
call mld_check_def(p%parms%aggr_filter,'Use filtered matrix',& call mld_check_def(p%parms%aggr_filter,'Use filtered matrix',&
& mld_no_filter_mat_,is_legal_aggr_filter) & mld_no_filter_mat_,is_legal_aggr_filter)
call mld_check_def(p%parms%smoother_pos,'smooth_pos',&
& mld_pre_smooth_,is_legal_ml_smooth_pos)
call mld_check_def(p%parms%aggr_omega_alg,'Omega Alg.',& call mld_check_def(p%parms%aggr_omega_alg,'Omega Alg.',&
& mld_eig_est_,is_legal_ml_aggr_omega_alg) & mld_eig_est_,is_legal_ml_aggr_omega_alg)
call mld_check_def(p%parms%aggr_eig,'Eigenvalue estimate',& call mld_check_def(p%parms%aggr_eig,'Eigenvalue estimate',&
@ -139,7 +137,7 @@ subroutine mld_c_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
! !
! Build the coarse-level matrix from the fine-level one, starting from ! Build the coarse-level matrix from the fine-level one, starting from
! the mapping defined by mld_aggrmap_bld and applying the aggregation ! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by p%iprcparm(mld_aggr_kind_) ! algorithm specified by p%iprcparm(mld_aggr_prol_)
! !
call mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,p%parms,ac,op_prol,op_restr,info) call mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,p%parms,ac,op_prol,op_restr,info)

@ -1,3 +1,5 @@
! !
! !
! MLD2P4 version 2.1 ! MLD2P4 version 2.1
@ -95,15 +97,13 @@ subroutine mld_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
real(psb_spk_) :: mnaggratio real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: ipv(mld_ifpsz_), val, coarse_solve_id
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -124,22 +124,6 @@ subroutine mld_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
! !
! For the time being we are commenting out the UPDATE argument
! we plan to resurrect it later.
! !$ if (present(upd)) then
! !$ if (debug_level >= psb_debug_outer_) &
! !$ & write(debug_unit,*) me,' ',trim(name),'UPD ', upd
! !$
! !$ if ((psb_toupper(upd).eq.'F').or.(psb_toupper(upd).eq.'T')) then
! !$ upd_=psb_toupper(upd)
! !$ else
! !$ upd_='F'
! !$ endif
! !$ else
! !$ upd_='F'
! !$ endif
upd_ = 'F'
if (.not.allocated(prec%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_cprecinit !! Error: should have called mld_cprecinit
info=3111 info=3111
@ -165,7 +149,7 @@ subroutine mld_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
endif endif
! !
! Now do the real build. ! Now do the real build.
! !
@ -184,7 +168,97 @@ subroutine mld_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
endif endif
end do end do
!
! Issue a warning for inconsistent changes to COARSE_SOLVE
!
if (me == psb_root_) then
coarse_solve_id = prec%precv(iszv)%parms%coarse_solve
select case (coarse_solve_id)
case(mld_umf_,mld_slu_)
if (prec%precv(iszv)%sm%sv%get_id() /= coarse_solve_id) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id)
write(psb_err_unit,*) ' but I am building ',&
& mld_fact_names(prec%precv(iszv)%sm%sv%get_id())
write(psb_err_unit,*) 'This may happen if: '
write(psb_err_unit,*) ' 1. coarse_subsolve has been reset, or '
write(psb_err_unit,*) ' 2. the solver ', mld_fact_names(coarse_solve_id),&
& ' was not configured at MLD2P4 build time, or'
write(psb_err_unit,*) ' 3. an unsupported solver setup was specified.'
end if
if (prec%precv(iszv)%parms%coarse_mat /= mld_repl_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id),&
& ' but the coarse matrix has been changed to distributed'
end if
case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
if (prec%precv(iszv)%sm%sv%get_id() /= mld_ilu_n_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id)
write(psb_err_unit,*) ' but I am building ',&
& mld_fact_names(prec%precv(iszv)%sm%sv%get_id())
write(psb_err_unit,*) &
&'This may happen if coarse_subsolve has been reset'
end if
if (prec%precv(iszv)%parms%coarse_mat /= mld_repl_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id),&
& ' but the coarse matrix has been changed to distributed'
end if
case(mld_mumps_)
if (prec%precv(iszv)%sm%sv%get_id() /= mld_mumps_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id)
write(psb_err_unit,*) ' but I am building ',&
& mld_fact_names(prec%precv(iszv)%sm%sv%get_id())
write(psb_err_unit,*) &
&'This may happen if coarse_subsolve has been reset'
end if
case(mld_sludist_)
if (prec%precv(iszv)%sm%sv%get_id() /= coarse_solve_id) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id)
write(psb_err_unit,*) ' but I am building ',&
& mld_fact_names(prec%precv(iszv)%sm%sv%get_id())
write(psb_err_unit,*) 'This may happen if: '
write(psb_err_unit,*) ' 1. coarse_subsolve has been reset, or '
write(psb_err_unit,*) ' 2. the solver ', mld_fact_names(coarse_solve_id), &
& ' was not configured at MLD2P4 build time, or'
write(psb_err_unit,*) ' 3. an unsupported solver setup was specified.'
end if
if (prec%precv(iszv)%parms%coarse_mat /= mld_distr_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id),&
& ' but the coarse matrix has been changed to replicated'
end if
case(mld_bjac_)
if (prec%precv(iszv)%parms%coarse_mat /= mld_distr_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id),&
& ' but the coarse matrix has been changed to replicated'
end if
case default
! We should never get here.
info=psb_err_from_subroutine_
ch_err='unkn coarse_solve'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end select
end if
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Exiting with',iszv,' levels' & 'Exiting with',iszv,' levels'

@ -52,7 +52,7 @@
! A mapping from the nodes of the adjacency graph of A to the nodes of the ! A mapping from the nodes of the adjacency graph of A to the nodes of the
! adjacency graph of A_C has been computed by the mld_aggrmap_bld subroutine. ! adjacency graph of A_C has been computed by the mld_aggrmap_bld subroutine.
! The prolongator P_C is built here from this mapping, according to the ! The prolongator P_C is built here from this mapping, according to the
! value of p%iprcparm(mld_aggr_kind_), specified by the user through ! value of p%iprcparm(mld_aggr_prol_), specified by the user through
! mld_cprecinit and mld_zprecset. ! mld_cprecinit and mld_zprecset.
! On output from this routine the entries of AC, op_prol, op_restr ! On output from this routine the entries of AC, op_prol, op_restr
! are still in "global numbering" mode; this is fixed in the calling routine ! are still in "global numbering" mode; this is fixed in the calling routine
@ -153,7 +153,7 @@ subroutine mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,inf
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
select case (parms%aggr_kind) select case (parms%aggr_prol)
case (mld_no_smooth_) case (mld_no_smooth_)
call mld_caggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,& call mld_caggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,&

@ -342,7 +342,7 @@ subroutine mld_caggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
call psb_numbmm(a,tmp_prol,am3) call psb_numbmm(a,tmp_prol,am3)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2',parms%aggr_kind, mld_smooth_prol_ & 'Done NUMBMM 2',parms%aggr_prol, mld_smooth_prol_
call tmp_prol%transp(op_restr) call tmp_prol%transp(op_restr)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &

@ -352,7 +352,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_ & 'Done SPSPMM 2',parms%aggr_prol, mld_smooth_prol_
call tmp_prol%cp_to(tmpcoo) call tmp_prol%cp_to(tmpcoo)
call tmpcoo%transp() call tmpcoo%transp()

@ -135,11 +135,11 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos)
select case(psb_toupper(what)) select case(psb_toupper(what))
case ('COARSE_AGGR_SIZE') case ('MIN_COARSE_SIZE')
p%coarse_aggr_size = max(val,-1) p%min_coarse_size = max(val,-1)
return return
case('MAX_PREC_LEVS') case('MAX_LEVS')
p%max_prec_levs = max(val,1) p%max_levs = max(val,1)
return return
case ('OUTER_SWEEPS') case ('OUTER_SWEEPS')
p%outer_sweeps = max(val,1) p%outer_sweeps = max(val,1)
@ -162,11 +162,9 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos)
select case(psb_toupper(what)) select case(psb_toupper(what))
case('SMOOTHER_TYPE','SUB_SOLVE','SMOOTHER_SWEEPS',& case('SMOOTHER_TYPE','SUB_SOLVE','SMOOTHER_SWEEPS',&
& 'ML_TYPE','AGGR_ALG','AGGR_ORD',& & 'ML_CYCLE','PAR_AGGR_ALG','AGGR_ORD',&
& 'AGGR_KIND','SMOOTHER_POS','AGGR_OMEGA_ALG',& & 'AGGR_TYPE','AGGR_PROL','AGGR_OMEGA_ALG',&
& 'AGGR_EIG','SMOOTHER_SWEEPS_PRE',& & 'AGGR_EIG','SUB_RESTR','SUB_PROL', &
& 'SMOOTHER_SWEEPS_POST',&
& 'SUB_RESTR','SUB_PROL', &
& 'SUB_REN','SUB_OVR','SUB_FILLIN',& & 'SUB_REN','SUB_OVR','SUB_FILLIN',&
& 'COARSE_MAT') & 'COARSE_MAT')
call p%precv(ilev_)%set(what,val,info,pos=pos) call p%precv(ilev_)%set(what,val,info,pos=pos)
@ -200,11 +198,11 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos)
call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
#endif #endif
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info) call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_) case(mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos) call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
case(mld_sludist_,mld_mumps_) case(mld_mumps_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
@ -253,10 +251,8 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos)
if (info /= 0) return if (info /= 0) return
end do end do
case('ML_TYPE','AGGR_ALG','AGGR_ORD','AGGR_KIND',& case('ML_CYCLE','PAR_AGGR_ALG','AGGR_ORD','AGGR_PROL','AGGR_TYPE',&
& 'SMOOTHER_SWEEPS_PRE','SMOOTHER_SWEEPS_POST',& & 'AGGR_OMEGA_ALG','AGGR_EIG','AGGR_FILTER')
& 'SMOOTHER_POS','AGGR_OMEGA_ALG',&
& 'AGGR_EIG','AGGR_FILTER')
do ilev_=1,nlev_ do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos) call p%precv(ilev_)%set(what,val,info,pos=pos)
if (info /= 0) return if (info /= 0) return
@ -281,11 +277,11 @@ subroutine mld_ccprecseti(p,what,val,info,ilev,ilmax,pos)
call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
#endif #endif
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info) call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_) case(mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos) call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
case(mld_sludist_,mld_mumps_) case(mld_mumps_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
@ -478,8 +474,8 @@ subroutine mld_ccprecsetr(p,what,val,info,ilev,ilmax,pos)
end if end if
select case(psb_toupper(what)) select case(psb_toupper(what))
case ('MIN_AGGR_RATIO') case ('MIN_CR_RATIO')
p%min_aggr_ratio = max(sone,val) p%min_cr_ratio = max(sone,val)
return return
end select end select
@ -517,18 +513,6 @@ subroutine mld_ccprecsetr(p,what,val,info,ilev,ilmax,pos)
ilev_=nlev_ ilev_=nlev_
call p%precv(ilev_)%set('SUB_ILUTHRS',val,info,pos=pos) call p%precv(ilev_)%set('SUB_ILUTHRS',val,info,pos=pos)
case('AGGR_SCALE')
do ilev_ = 2, nlev_
call p%precv(ilev_)%set('AGGR_SCALE',val,info,pos=pos)
end do
case('AGGR_THRESH')
thr = val
do ilev_ = 2, nlev_
call p%precv(ilev_)%set('AGGR_THRESH',thr,info,pos=pos)
thr = thr * p%precv(ilev_)%parms%aggr_scale
end do
case default case default
do ilev_=1,nlev_ do ilev_=1,nlev_

@ -518,7 +518,7 @@ contains
write(debug_unit,*) me,' Start inner_ml_aply at level ',level write(debug_unit,*) me,' Start inner_ml_aply at level ',level
end if end if
select case(p%precv(level)%parms%ml_type) select case(p%precv(level)%parms%ml_cycle)
case(mld_no_ml_) case(mld_no_ml_)
! !
@ -532,39 +532,7 @@ contains
call mld_c_inner_add(p, mlprec_wrk, level, trans, work) call mld_c_inner_add(p, mlprec_wrk, level, trans, work)
case(mld_mult_ml_,mld_vcycle_ml_, mld_wcycle_ml_)
case(mld_mult_ml_)
!
! Multiplicative multilevel (multiplicative among the levels, additive inside
! each level)
!
! Pre/post-smoothing versions.
! Note that the transpose switches pre <-> post.
!
select case(p%precv(level)%parms%smoother_pos)
case(mld_post_smooth_)
p%precv(level)%parms%sweeps_pre = 0
call mld_c_inner_mult(p, mlprec_wrk, level, trans, work)
case(mld_pre_smooth_)
p%precv(level)%parms%sweeps_post = 0
call mld_c_inner_mult(p, mlprec_wrk, level, trans, work)
case(mld_twoside_smooth_)
call mld_c_inner_mult(p, mlprec_wrk, level, trans, work)
case default
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='invalid smooth_pos',&
& i_Err=(/p%precv(level)%parms%smoother_pos,izero,izero,izero,izero/))
goto 9999
end select
case(mld_vcycle_ml_, mld_wcycle_ml_)
call mld_c_inner_mult(p, mlprec_wrk, level, trans, work) call mld_c_inner_mult(p, mlprec_wrk, level, trans, work)
@ -574,8 +542,8 @@ contains
case default case default
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='invalid mltype',& call psb_errpush(info,name,a_err='invalid ml_cycle',&
& i_Err=(/p%precv(level)%parms%ml_type,izero,izero,izero,izero/)) & i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/))
goto 9999 goto 9999
end select end select
@ -643,7 +611,7 @@ contains
goto 9999 goto 9999
end if end if
sweeps = p%precv(level)%parms%sweeps sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(cone,& call p%precv(level)%sm%apply(cone,&
& mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,& & mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
@ -821,7 +789,7 @@ contains
goto 9999 goto 9999
end if end if
if (p%precv(level)%parms%ml_type == mld_wcycle_ml_) then if (p%precv(level)%parms%ml_cycle == mld_wcycle_ml_) then
call psb_geaxpby(cone,mlprec_wrk(level)%vx2l,& call psb_geaxpby(cone,mlprec_wrk(level)%vx2l,&
& czero,mlprec_wrk(level)%vty,& & czero,mlprec_wrk(level)%vty,&
@ -894,7 +862,7 @@ contains
else if (level == nlev) then else if (level == nlev) then
sweeps = p%precv(level)%parms%sweeps sweeps = p%precv(level)%parms%sweeps_pre
if (info == psb_success_) call p%precv(level)%sm%apply(cone,& if (info == psb_success_) call p%precv(level)%sm%apply(cone,&
& mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,& & mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
@ -976,7 +944,7 @@ contains
! !
! Apply smoother ! Apply smoother
! !
sweeps = p%precv(level)%parms%sweeps sweeps = p%precv(level)%parms%sweeps_pre
if (info == psb_success_) call p%precv(level)%sm%apply(cone,& if (info == psb_success_) call p%precv(level)%sm%apply(cone,&
& mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,& & mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
@ -1036,13 +1004,13 @@ contains
!Set the preconditioner !Set the preconditioner
if (level <= nlev - 2 ) then if (level <= nlev - 2 ) then
if (p%precv(level)%parms%ml_type == mld_kcyclesym_ml_) then if (p%precv(level)%parms%ml_cycle == mld_kcyclesym_ml_) then
call mld_cinneritkcycle(p, mlprec_wrk, level + 1, trans, work, 'FCG') call mld_cinneritkcycle(p, mlprec_wrk, level + 1, trans, work, 'FCG')
elseif (p%precv(level)%parms%ml_type == mld_kcycle_ml_) then elseif (p%precv(level)%parms%ml_cycle == mld_kcycle_ml_) then
call mld_cinneritkcycle(p, mlprec_wrk, level + 1, trans, work, 'GCR') call mld_cinneritkcycle(p, mlprec_wrk, level + 1, trans, work, 'GCR')
else else
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Bad value for ml_type') & a_err='Bad value for ml_cycle')
goto 9999 goto 9999
endif endif
else else
@ -1466,7 +1434,7 @@ contains
write(debug_unit,*) me,' inner_ml_aply at level ',level write(debug_unit,*) me,' inner_ml_aply at level ',level
end if end if
select case(p%precv(level)%parms%ml_type) select case(p%precv(level)%parms%ml_cycle)
case(mld_no_ml_) case(mld_no_ml_)
! !
@ -1480,39 +1448,7 @@ contains
call mld_c_inner_add(p, mlprec_wrk, level, trans, work) call mld_c_inner_add(p, mlprec_wrk, level, trans, work)
case(mld_mult_ml_, mld_vcycle_ml_, mld_wcycle_ml_)
case(mld_mult_ml_)
!
! Multiplicative multilevel (multiplicative among the levels, additive inside
! each level)
!
! Pre/post-smoothing versions.
! Note that the transpose switches pre <-> post.
!
select case(p%precv(level)%parms%smoother_pos)
case(mld_post_smooth_)
p%precv(level)%parms%sweeps_pre = 0
call mld_c_inner_mult(p, mlprec_wrk, level, trans, work)
case(mld_pre_smooth_)
p%precv(level)%parms%sweeps_post = 0
call mld_c_inner_mult(p, mlprec_wrk, level, trans, work)
case(mld_twoside_smooth_)
call mld_c_inner_mult(p, mlprec_wrk, level, trans, work)
case default
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='invalid smooth_pos',&
& i_Err=(/p%precv(level)%parms%smoother_pos,izero,izero,izero,izero/))
goto 9999
end select
case(mld_vcycle_ml_, mld_wcycle_ml_)
call mld_c_inner_mult(p, mlprec_wrk, level, trans, work) call mld_c_inner_mult(p, mlprec_wrk, level, trans, work)
@ -1522,8 +1458,8 @@ contains
case default case default
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='invalid mltype',& call psb_errpush(info,name,a_err='invalid ml_cycle',&
& i_Err=(/p%precv(level)%parms%ml_type,izero,izero,izero,izero/)) & i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/))
goto 9999 goto 9999
end select end select
@ -1588,7 +1524,7 @@ contains
goto 9999 goto 9999
end if end if
sweeps = p%precv(level)%parms%sweeps sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(cone,& call p%precv(level)%sm%apply(cone,&
& mlprec_wrk(level)%x2l,czero,mlprec_wrk(level)%y2l,& & mlprec_wrk(level)%x2l,czero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
@ -1766,7 +1702,7 @@ contains
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (p%precv(level)%parms%ml_type == mld_wcycle_ml_) then if (p%precv(level)%parms%ml_cycle == mld_wcycle_ml_) then
! On second call will use output y2l as initial guess ! On second call will use output y2l as initial guess
if (info == psb_success_) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info == psb_success_) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
endif endif
@ -1832,7 +1768,7 @@ contains
else if (level == nlev) then else if (level == nlev) then
sweeps = p%precv(level)%parms%sweeps sweeps = p%precv(level)%parms%sweeps_pre
if (info == psb_success_) call p%precv(level)%sm%apply(cone,& if (info == psb_success_) call p%precv(level)%sm%apply(cone,&
& mlprec_wrk(level)%x2l,czero,mlprec_wrk(level)%y2l,& & mlprec_wrk(level)%x2l,czero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&

@ -94,7 +94,6 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: ictxt, me,np
@ -102,7 +101,6 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
real(psb_spk_) :: mnaggratio real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err

@ -144,7 +144,8 @@ subroutine mld_cprecaply(prec,x,y,desc_data,info,trans,work)
! Number of levels = 1: apply the base preconditioner ! Number of levels = 1: apply the base preconditioner
! !
call prec%precv(1)%sm%apply(cone,x,czero,y,desc_data,trans_,& call prec%precv(1)%sm%apply(cone,x,czero,y,desc_data,trans_,&
& prec%precv(1)%parms%sweeps, work_,info) & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post), &
& work_,info)
else else
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',& call psb_errpush(info,name,a_err='Invalid size of precv',&
@ -336,7 +337,8 @@ subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
! Number of levels = 1: apply the base preconditioner ! Number of levels = 1: apply the base preconditioner
! !
call prec%precv(1)%sm%apply(cone,x,czero,y,desc_data,trans_,& call prec%precv(1)%sm%apply(cone,x,czero,y,desc_data,trans_,&
& prec%precv(1)%parms%sweeps, work_,info) & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),&
& work_,info)
else else
@ -438,7 +440,8 @@ subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work)
! Number of levels = 1: apply the base preconditioner ! Number of levels = 1: apply the base preconditioner
! !
call prec%precv(1)%sm%apply(cone,x,czero,ww,desc_data,trans_,& call prec%precv(1)%sm%apply(cone,x,czero,ww,desc_data,trans_,&
& prec%precv(1)%parms%sweeps, work_,info) & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),&
& work_,info)
else else

@ -74,7 +74,6 @@ subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
type(mld_cprec_type) :: t_prec type(mld_cprec_type) :: t_prec
@ -82,7 +81,6 @@ subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz
integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_
type(mld_dml_parms) :: prm type(mld_dml_parms) :: prm
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -105,21 +103,6 @@ subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
! !
! For the time being we are commenting out the UPDATE argument
! we plan to resurrect it later.
!!$ if (present(upd)) then
!!$ if (debug_level >= psb_debug_outer_) &
!!$ & write(debug_unit,*) me,' ',trim(name),'UPD ', upd
!!$
!!$ if ((psb_toupper(upd).eq.'F').or.(psb_toupper(upd).eq.'T')) then
!!$ upd_=psb_toupper(upd)
!!$ else
!!$ upd_='F'
!!$ endif
!!$ else
!!$ upd_='F'
!!$ endif
upd_ = 'F'
if (.not.allocated(prec%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_cprecinit !! Error: should have called mld_cprecinit
@ -174,7 +157,7 @@ subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
goto 9999 goto 9999
endif endif
call prec%precv(1)%sm%build(a,desc_a,upd_,info,& call prec%precv(1)%sm%build(a,desc_a,info,&
& amold=amold,vmold=vmold,imold=imold) & amold=amold,vmold=vmold,imold=imold)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&

@ -108,7 +108,7 @@ subroutine mld_cprecinit(prec,ptype,info)
! Local variables ! Local variables
integer(psb_ipk_) :: nlev_, ilev_ integer(psb_ipk_) :: nlev_, ilev_
real(psb_spk_) :: thr, scale real(psb_spk_) :: thr
character(len=*), parameter :: name='mld_precinit' character(len=*), parameter :: name='mld_precinit'
info = psb_success_ info = psb_success_
@ -118,7 +118,7 @@ subroutine mld_cprecinit(prec,ptype,info)
! Do we want to do something? ! Do we want to do something?
endif endif
endif endif
prec%coarse_aggr_size = -1 prec%min_coarse_size = -1
select case(psb_toupper(ptype(1:len_trim(ptype)))) select case(psb_toupper(ptype(1:len_trim(ptype))))
case ('NOPREC','NONE') case ('NOPREC','NONE')
@ -160,9 +160,26 @@ subroutine mld_cprecinit(prec,ptype,info)
case ('ML') case ('ML')
nlev_ = prec%max_prec_levs nlev_ = prec%max_levs
ilev_ = 1 ilev_ = 1
allocate(prec%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
#if 1
do ilev_ = 1, nlev_
call prec%precv(ilev_)%default()
end do
call prec%set('ML_CYCLE','VCYCLE',info)
call prec%set('SMOOTHER_TYPE','FBGS',info)
#if defined(HAVE_MUMPS_)
call prec%set('COARSE_SOLVE','MUMPS',info)
#elif defined(HAVE_SLU_)
call prec%set('COARSE_SOLVE','SLU',info)
#else
call prec%set('COARSE_SOLVE','ILU',info)
#endif
!call prec%precv(nlev_)%default()
#else
allocate(mld_c_as_smoother_type :: prec%precv(ilev_)%sm, stat=info) allocate(mld_c_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
if (info /= psb_success_) return if (info /= psb_success_) return
allocate(mld_c_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) allocate(mld_c_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
@ -193,13 +210,11 @@ subroutine mld_cprecinit(prec,ptype,info)
call prec%precv(ilev_)%set(mld_sub_ovr_,izero,info) call prec%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.05_psb_spk_ thr = 0.05_psb_spk_
scale = 1.0_psb_spk_
do ilev_=1,nlev_ do ilev_=1,nlev_
call prec%precv(ilev_)%set(mld_aggr_thresh_,thr,info) call prec%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
call prec%precv(ilev_)%set(mld_aggr_scale_,scale,info)
call prec%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info) call prec%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info)
end do end do
#endif
case default case default
write(psb_err_unit,*) name,& write(psb_err_unit,*) name,&
&': Warning: Unknown preconditioner type request "',ptype,'"' &': Warning: Unknown preconditioner type request "',ptype,'"'

@ -134,11 +134,11 @@ subroutine mld_cprecseti(p,what,val,info,ilev,ilmax,pos)
select case(what) select case(what)
case (mld_coarse_aggr_size_) case (mld_min_coarse_size_)
p%coarse_aggr_size = max(val,-1) p%min_coarse_size = max(val,-1)
return return
case(mld_max_prec_levs_) case(mld_max_levs_)
p%max_prec_levs = max(val,1) p%max_levs = max(val,1)
return return
case(mld_outer_sweeps_) case(mld_outer_sweeps_)
p%outer_sweeps = max(val,1) p%outer_sweeps = max(val,1)
@ -158,10 +158,8 @@ subroutine mld_cprecseti(p,what,val,info,ilev,ilmax,pos)
select case(what) select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,& case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,&
& mld_ml_type_,mld_aggr_alg_,mld_aggr_ord_,& & mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,&
& mld_aggr_kind_,mld_smoother_pos_,& & mld_aggr_prol_, mld_aggr_omega_alg_,mld_aggr_eig_,&
& mld_aggr_omega_alg_,mld_aggr_eig_,&
& mld_smoother_sweeps_pre_,mld_smoother_sweeps_post_,&
& mld_sub_restr_,mld_sub_prol_, & & 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_coarse_mat_) & mld_coarse_mat_)
@ -196,11 +194,11 @@ subroutine mld_cprecseti(p,what,val,info,ilev,ilmax,pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
#endif #endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_) case(mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_sludist_,mld_mumps_) case(mld_mumps_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
@ -248,9 +246,7 @@ subroutine mld_cprecseti(p,what,val,info,ilev,ilmax,pos)
if (info /= 0) return if (info /= 0) return
end do end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_ord_,mld_aggr_kind_,& case(mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,mld_aggr_prol_,&
& mld_smoother_sweeps_pre_,mld_smoother_sweeps_post_,&
& mld_smoother_pos_,mld_aggr_omega_alg_,&
& mld_aggr_eig_,mld_aggr_filter_) & mld_aggr_eig_,mld_aggr_filter_)
do ilev_=1,nlev_ do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos) call p%precv(ilev_)%set(what,val,info,pos=pos)
@ -274,14 +270,10 @@ subroutine mld_cprecseti(p,what,val,info,ilev,ilmax,pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
#endif #endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_) case(mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_sludist_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_mumps_) case(mld_mumps_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
@ -574,8 +566,8 @@ subroutine mld_cprecsetr(p,what,val,info,ilev,ilmax,pos)
info = psb_success_ info = psb_success_
select case(what) select case(what)
case (mld_min_aggr_ratio_) case (mld_min_cr_ratio_)
p%min_aggr_ratio = max(sone,val) p%min_cr_ratio = max(sone,val)
return return
end select end select
@ -619,18 +611,6 @@ subroutine mld_cprecsetr(p,what,val,info,ilev,ilmax,pos)
ilev_=nlev_ ilev_=nlev_
call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos) call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos)
case(mld_aggr_scale_)
do ilev_ = 2, nlev_
call p%precv(ilev_)%set(mld_aggr_scale_,val,info,pos=pos)
end do
case(mld_aggr_thresh_)
thr = val
do ilev_ = 2, nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info,pos=pos)
thr = thr * p%precv(ilev_)%parms%aggr_scale
end do
case default case default
do ilev_=1,nlev_ do ilev_=1,nlev_

@ -1,356 +0,0 @@
/*
*
* MLD2P4 version 2.0
* MultiLevel Domain Decomposition Parallel Preconditioners Package
* based on PSBLAS (Parallel Sparse BLAS version 3.3)
*
* (C) Copyright 2008, 2010, 2012, 2015, 2017
*
* Salvatore Filippone Cranfield University
* Ambra Abdullahi Hassan University of Rome Tor Vergata
* Alfredo Buttari CNRS-IRIT, Toulouse
* Pasqua D'Ambra ICAR-CNR, Naples
* Daniela di Serafino University of Campania "L. Vanvitelli", Caserta
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions, and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. The name of the MLD2P4 group or the names of its contributors may
* not be used to endorse or promote products derived from this
* software without specific written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
* TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
* BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
* INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
* CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*
*
* File: mld_cslud_interface.c
*
* Functions: mld_csludist_fact, mld_csludist_solve, mld_csludist_free.
*
* This file is an interface to the SuperLU_dist routines for sparse factorization and
* solve. It was obtained by modifying the c_fortran_zgssv.c file from the SuperLU_dist
* source distribution; original copyright terms are reproduced below.
*
*/
/* =====================
Copyright (c) 2003, The Regents of the University of California, through
Lawrence Berkeley National Laboratory (subject to receipt of any required
approvals from U.S. Dept. of Energy)
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
(1) Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
(2) Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
(3) Neither the name of Lawrence Berkeley National Laboratory, U.S. Dept. of
Energy nor the names of its contributors may be used to endorse or promote
products derived from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
/*
* -- Distributed SuperLU routine (version 2.0) --
* Lawrence Berkeley National Lab, Univ. of California Berkeley.
* March 15, 2003
*
*/
/* as of v 3.3 SLUDist does not have a single precision interface */
#ifdef Have_SLUDist_
#undef Have_SLUDist_
#endif
#ifdef Have_SLUDist_
#include <math.h>
#include "superlu_zdefs.h"
#define HANDLE_SIZE 8
typedef struct {
SuperMatrix *A;
LUstruct_t *LUstruct;
gridinfo_t *grid;
ScalePermstruct_t *ScalePermstruct;
} factors_t;
#else
#include <stdio.h>
#endif
int mld_csludist_fact(int n, int nl, int nnzl, int ffstr,
#ifdef Have_SLUDist_
complex *values, int *rowptr, int *colind,
void **f_factors,
#else
void *values, int *rowptr, int *colind,
void **f_factors,
#endif
int nprow, int npcol)
{
/*
* This routine can be called from Fortran.
* performs LU decomposition.
*
* f_factors (input/output) void**
* On output contains the pointer pointing to
* the structure of the factored matrices.
*
*/
#ifdef Have_SLUDist_
SuperMatrix *A;
NRformat_loc *Astore;
ScalePermstruct_t *ScalePermstruct;
LUstruct_t *LUstruct;
SOLVEstruct_t SOLVEstruct;
gridinfo_t *grid;
int i, panel_size, permc_spec, relax, info;
trans_t trans;
float drop_tol = 0.0,berr[1];
mem_usage_t mem_usage;
superlu_options_t options;
SuperLUStat_t stat;
factors_t *LUfactors;
int fst_row;
int *icol,*irpt;
complex *ival,b[1];
trans = NOTRANS;
grid = (gridinfo_t *) SUPERLU_MALLOC(sizeof(gridinfo_t));
superlu_gridinit(MPI_COMM_WORLD, nprow, npcol, grid);
/* Initialize the statistics variables. */
PStatInit(&stat);
fst_row = (ffstr);
A = (SuperMatrix *) malloc(sizeof(SuperMatrix));
zCreate_CompRowLoc_Matrix_dist(A, n, n, nnzl, nl, fst_row,
values, colind, rowptr,
SLU_NR_loc, SLU_Z, SLU_GE);
/* Initialize ScalePermstruct and LUstruct. */
ScalePermstruct = (ScalePermstruct_t *) SUPERLU_MALLOC(sizeof(ScalePermstruct_t));
LUstruct = (LUstruct_t *) SUPERLU_MALLOC(sizeof(LUstruct_t));
ScalePermstructInit(n,n, ScalePermstruct);
#if defined(SLUD_VERSION_4)
LUstructInit(n, LUstruct);
#elif defined(SLUD_VERSION_3)
LUstructInit(n,n, LUstruct);
#else
choke_on_me;
#endif
/* Set the default input options. */
set_default_options_dist(&options);
options.IterRefine=NO;
options.PrintStat=NO;
pzgssvx(&options, A, ScalePermstruct, b, nl, 0,
grid, LUstruct, &SOLVEstruct, berr, &stat, &info);
if ( info == 0 ) {
;
} else {
printf("pzgssvx() error returns INFO= %d\n", info);
if ( info <= n ) { /* factorization completes */
;
}
}
if (options.SolveInitialized) {
zSolveFinalize(&options,&SOLVEstruct);
}
/* Save the LU factors in the factors handle */
LUfactors = (factors_t *) SUPERLU_MALLOC(sizeof(factors_t));
LUfactors->LUstruct = LUstruct;
LUfactors->grid = grid;
LUfactors->A = A;
LUfactors->ScalePermstruct = ScalePermstruct;
/* fprintf(stderr,"slud factor: LUFactors %p \n",LUfactors); */
/* fprintf(stderr,"slud factor: A %p %p\n",A,LUfactors->A); */
/* fprintf(stderr,"slud factor: grid %p %p\n",grid,LUfactors->grid); */
/* fprintf(stderr,"slud factor: LUstruct %p %p\n",LUstruct,LUfactors->LUstruct); */
*f_factors = (void *) LUfactors;
PStatFree(&stat);
return(info);
#else
fprintf(stderr," SLUDist does not have single precision, sorry.\n");
return(-1);
#endif
}
int mld_csludist_solve(int itrans, int n, int nrhs,
#ifdef Have_SLUDist_
complex *b,
#else
void *b,
#endif
int ldb, void *f_factors)
{
/*
* This routine can be called from Fortran.
* performs triangular solve
*
*/
#ifdef Have_SLUDist_
SuperMatrix *A;
ScalePermstruct_t *ScalePermstruct;
LUstruct_t *LUstruct;
SOLVEstruct_t SOLVEstruct;
gridinfo_t *grid;
int i, panel_size, permc_spec, relax, info;
trans_t trans;
float drop_tol = 0.0;
float *berr;
mem_usage_t mem_usage;
superlu_options_t options;
SuperLUStat_t stat;
factors_t *LUfactors;
LUfactors = (factors_t *) f_factors ;
A = LUfactors->A ;
LUstruct = LUfactors->LUstruct ;
grid = LUfactors->grid ;
ScalePermstruct = LUfactors->ScalePermstruct;
/* fprintf(stderr,"slud solve: LUFactors %p \n",LUfactors); */
/* fprintf(stderr,"slud solve: A %p %p\n",A,LUfactors->A); */
/* fprintf(stderr,"slud solve: grid %p %p\n",grid,LUfactors->grid); */
/* fprintf(stderr,"slud solve: LUstruct %p %p\n",LUstruct,LUfactors->LUstruct); */
if (itrans == 0) {
trans = NOTRANS;
} else if (itrans ==1) {
trans = TRANS;
} else if (itrans ==2) {
trans = CONJ;
} else {
trans = NOTRANS;
}
/* fprintf(stderr,"Entry to sludist_solve\n"); */
berr = (float *) malloc((nrhs) *sizeof(float));
/* Initialize the statistics variables. */
PStatInit(&stat);
/* Set the default input options. */
set_default_options_dist(&options);
options.IterRefine = NO;
options.Fact = FACTORED;
options.PrintStat = NO;
pzgssvx(&options, A, ScalePermstruct, b, ldb, nrhs,
grid, LUstruct, &SOLVEstruct, berr, &stat, &info);
/* fprintf(stderr,"Float check: after solve %d %lf\n",*info,berr[0]); */
if (options.SolveInitialized) {
zSolveFinalize(&options,&SOLVEstruct);
}
PStatFree(&stat);
free(berr);
return(info);
#else
fprintf(stderr," SLUDist does not have single precision, sorry.\n");
return(-1);
#endif
}
int mld_csludist_free(void *f_factors)
{
/*
* This routine can be called from Fortran.
*
* free all storage in the end
*
*/
#ifdef Have_SLUDist_
SuperMatrix *A;
ScalePermstruct_t *ScalePermstruct;
LUstruct_t *LUstruct;
SOLVEstruct_t SOLVEstruct;
gridinfo_t *grid;
int i, panel_size, permc_spec, relax;
trans_t trans;
float drop_tol = 0.0;
float *berr;
mem_usage_t mem_usage;
superlu_options_t options;
SuperLUStat_t stat;
factors_t *LUfactors;
if (f_factors == NULL)
return(0);
LUfactors = (factors_t *) f_factors ;
A = LUfactors->A ;
LUstruct = LUfactors->LUstruct ;
grid = LUfactors->grid ;
ScalePermstruct = LUfactors->ScalePermstruct;
// Memory leak: with SuperLU_Dist 3.3
// we either have a leak or a segfault here.
// To be investigated further.
//Destroy_CompRowLoc_Matrix_dist(A);
ScalePermstructFree(ScalePermstruct);
LUstructFree(LUstruct);
superlu_gridexit(grid);
free(grid);
free(LUstruct);
free(LUfactors);
return(0);
#else
fprintf(stderr," SLUDist does not have single precision, sorry.\n");
return(-1);
#endif
}

@ -154,10 +154,9 @@ subroutine mld_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
! Check to ensure all procs have the same ! Check to ensure all procs have the same
! !
newsz = -1 newsz = -1
casize = p%coarse_aggr_size mxplevs = p%max_levs
mxplevs = p%max_prec_levs mnaggratio = p%min_cr_ratio
mnaggratio = p%min_aggr_ratio casize = p%min_coarse_size
casize = p%coarse_aggr_size
iszv = size(p%precv) iszv = size(p%precv)
nprolv = size(prolv) nprolv = size(prolv)
nrestrv = size(restrv) nrestrv = size(restrv)
@ -167,19 +166,19 @@ subroutine mld_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ictxt,mnaggratio)
call psb_bcast(ictxt,nprolv) call psb_bcast(ictxt,nprolv)
call psb_bcast(ictxt,nrestrv) call psb_bcast(ictxt,nrestrv)
if (casize /= p%coarse_aggr_size) then if (casize /= p%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
goto 9999 goto 9999
end if end if
if (mxplevs /= p%max_prec_levs) then if (mxplevs /= p%max_levs) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs') call psb_errpush(info,name,a_err='Inconsistent max_levs')
goto 9999 goto 9999
end if end if
if (mnaggratio /= p%min_aggr_ratio) then if (mnaggratio /= p%min_cr_ratio) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio') call psb_errpush(info,name,a_err='Inconsistent min_cr_ratio')
goto 9999 goto 9999
end if end if
if (iszv /= size(p%precv)) then if (iszv /= size(p%precv)) then
@ -220,8 +219,8 @@ subroutine mld_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
endif endif
! !
nplevs = nrestrv + 1 nplevs = nrestrv + 1
p%max_prec_levs = nplevs p%max_levs = nplevs
! !
! Fixed number of levels. ! Fixed number of levels.
@ -366,9 +365,9 @@ contains
allocate(nlaggr(np),ilaggr(1)) allocate(nlaggr(np),ilaggr(1))
nlaggr = 0 nlaggr = 0
ilaggr = 0 ilaggr = 0
p%parms%aggr_alg = mld_ext_aggr_ p%parms%par_aggr_alg = mld_ext_aggr_
call mld_check_def(p%parms%ml_type,'Multilevel type',& call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',&
& mld_mult_ml_,is_legal_ml_type) & mld_mult_ml_,is_legal_ml_cycle)
call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& call mld_check_def(p%parms%coarse_mat,'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat) & mld_distr_mat_,is_legal_ml_coarse_mat)

@ -78,19 +78,19 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
class(mld_dprec_type),intent(inout),target :: prec class(mld_dprec_type),intent(inout),target :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
!!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs, iaggsize integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize,&
real(psb_dpk_) :: mnaggratio, sizeratio, athresh, ascale, aomega & nplevs, mxplevs, iaggsize
class(mld_d_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, base_sm2, med_sm2, coarse_sm2 real(psb_dpk_) :: mnaggratio, sizeratio, athresh, aomega
class(mld_d_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, &
& base_sm2, med_sm2, coarse_sm2
type(mld_dml_parms) :: baseparms, medparms, coarseparms type(mld_dml_parms) :: baseparms, medparms, coarseparms
integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:)
type(psb_dspmat_type) :: op_prol type(psb_dspmat_type) :: op_prol
type(mld_d_onelev_type), allocatable :: tprecv(:) type(mld_d_onelev_type), allocatable :: tprecv(:)
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -111,21 +111,6 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
! !
! For the time being we are commenting out the UPDATE argument
! we plan to resurrect it later.
! !$ if (present(upd)) then
! !$ if (debug_level >= psb_debug_outer_) &
! !$ & write(debug_unit,*) me,' ',trim(name),'UPD ', upd
! !$
! !$ if ((psb_toupper(upd).eq.'F').or.(psb_toupper(upd).eq.'T')) then
! !$ upd_=psb_toupper(upd)
! !$ else
! !$ upd_='F'
! !$ endif
! !$ else
! !$ upd_='F'
! !$ endif
upd_ = 'F'
if (.not.allocated(prec%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_dprecinit !! Error: should have called mld_dprecinit
@ -138,28 +123,27 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
! Check to ensure all procs have the same ! Check to ensure all procs have the same
! !
newsz = -1 newsz = -1
casize = prec%coarse_aggr_size mxplevs = prec%max_levs
mxplevs = prec%max_prec_levs mnaggratio = prec%min_cr_ratio
mnaggratio = prec%min_aggr_ratio casize = prec%min_coarse_size
casize = prec%coarse_aggr_size
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize) call psb_bcast(ictxt,casize)
call psb_bcast(ictxt,mxplevs) call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ictxt,mnaggratio)
if (casize /= prec%coarse_aggr_size) then if (casize /= prec%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
goto 9999 goto 9999
end if end if
if (mxplevs /= prec%max_prec_levs) then if (mxplevs /= prec%max_levs) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs') call psb_errpush(info,name,a_err='Inconsistent max_levs')
goto 9999 goto 9999
end if end if
if (mnaggratio /= prec%min_aggr_ratio) then if (mnaggratio /= prec%min_cr_ratio) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio') call psb_errpush(info,name,a_err='Inconsistent min_cr_ratio')
goto 9999 goto 9999
end if end if
if (iszv /= size(prec%precv)) then if (iszv /= size(prec%precv)) then
@ -198,18 +182,20 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
! 3. If the size of the array is different from target number of levels, ! 3. If the size of the array is different from target number of levels,
! reallocate; ! reallocate;
! 4. Build the matrix hierarchy, stopping early if either the target ! 4. Build the matrix hierarchy, stopping early if either the target
! coarse size is hit, or the gain falls below the min_aggr_ratio ! coarse size is hit, or the gain falls below the min_cr_ratio
! threshold. ! threshold.
! !
if (casize <=0) then if (casize < 0) then
! !
! Default to the cubic root of the size at base level. ! Default to the cubic root of the size at base level.
! !
casize = desc_a%get_global_rows() casize = desc_a%get_global_rows()
casize = int((done*casize)**(done/(done*3)),psb_ipk_) casize = int((done*casize)**(done/(done*3)),psb_ipk_)
casize = max(casize,ione) casize = max(casize,ione)
casize = casize*40_psb_ipk_ casize = casize*40_psb_ipk_
call psb_bcast(ictxt,casize)
prec%min_coarse_size = casize
end if end if
nplevs = max(itwo,mxplevs) nplevs = max(itwo,mxplevs)
@ -357,11 +343,9 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
! of distr/repl matrix at coarse level. Should be rethought. ! of distr/repl matrix at coarse level. Should be rethought.
! !
athresh = prec%precv(newsz)%parms%aggr_thresh athresh = prec%precv(newsz)%parms%aggr_thresh
ascale = prec%precv(newsz)%parms%aggr_scale
aomega = prec%precv(newsz)%parms%aggr_omega_val aomega = prec%precv(newsz)%parms%aggr_omega_val
if (info == 0) prec%precv(newsz)%parms = coarseparms if (info == 0) prec%precv(newsz)%parms = coarseparms
prec%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_thresh = athresh
prec%precv(newsz)%parms%aggr_scale = ascale
prec%precv(newsz)%parms%aggr_omega_val = aomega prec%precv(newsz)%parms%aggr_omega_val = aomega
if (info == 0) call restore_smoothers(prec%precv(newsz),coarse_sm,coarse_sm2,info) if (info == 0) call restore_smoothers(prec%precv(newsz),coarse_sm,coarse_sm2,info)

@ -108,15 +108,15 @@ subroutine mld_d_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
call mld_check_def(p%parms%ml_type,'Multilevel type',& call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',&
& mld_mult_ml_,is_legal_ml_type) & mld_mult_ml_,is_legal_ml_cycle)
call mld_check_def(p%parms%aggr_alg,'Aggregation',& call mld_check_def(p%parms%par_aggr_alg,'Aggregation',&
& mld_dec_aggr_,is_legal_ml_aggr_alg) & mld_dec_aggr_,is_legal_ml_par_aggr_alg)
call mld_check_def(p%parms%aggr_ord,'Ordering',& call mld_check_def(p%parms%aggr_ord,'Ordering',&
& mld_aggr_ord_nat_,is_legal_ml_aggr_ord) & mld_aggr_ord_nat_,is_legal_ml_aggr_ord)
call mld_check_def(p%parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs) call mld_check_def(p%parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)
select case(p%parms%aggr_alg) select case(p%parms%par_aggr_alg)
case (mld_dec_aggr_, mld_sym_dec_aggr_) case (mld_dec_aggr_, mld_sym_dec_aggr_)
! !
@ -125,7 +125,7 @@ subroutine mld_d_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
! aggregation algorithm. This also defines a tentative prolongator from ! aggregation algorithm. This also defines a tentative prolongator from
! the coarse to the fine level. ! the coarse to the fine level.
! !
call mld_aggrmap_bld(p%parms%aggr_alg,p%parms%aggr_ord,p%parms%aggr_thresh,& call mld_aggrmap_bld(p%parms%par_aggr_alg,p%parms%aggr_ord,p%parms%aggr_thresh,&
& a,desc_a,ilaggr,nlaggr,op_prol,info) & a,desc_a,ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -137,14 +137,14 @@ subroutine mld_d_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
write(0,*) 'Matching is not implemented yet ' write(0,*) 'Matching is not implemented yet '
info = -1111 info = -1111
call psb_errpush(psb_err_input_value_invalid_i_,name,& call psb_errpush(psb_err_input_value_invalid_i_,name,&
& i_err=(/ione,p%parms%aggr_alg,izero,izero,izero/)) & i_err=(/ione,p%parms%par_aggr_alg,izero,izero,izero/))
goto 9999 goto 9999
case default case default
info = -1 info = -1
call psb_errpush(psb_err_input_value_invalid_i_,name,& call psb_errpush(psb_err_input_value_invalid_i_,name,&
& i_err=(/ione,p%parms%aggr_alg,izero,izero,izero/)) & i_err=(/ione,p%parms%par_aggr_alg,izero,izero,izero/))
goto 9999 goto 9999
end select end select

@ -121,14 +121,12 @@ subroutine mld_d_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
call mld_check_def(p%parms%aggr_kind,'Smoother',& call mld_check_def(p%parms%aggr_prol,'Smoother',&
& mld_smooth_prol_,is_legal_ml_aggr_kind) & mld_smooth_prol_,is_legal_ml_aggr_prol)
call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& call mld_check_def(p%parms%coarse_mat,'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat) & mld_distr_mat_,is_legal_ml_coarse_mat)
call mld_check_def(p%parms%aggr_filter,'Use filtered matrix',& call mld_check_def(p%parms%aggr_filter,'Use filtered matrix',&
& mld_no_filter_mat_,is_legal_aggr_filter) & mld_no_filter_mat_,is_legal_aggr_filter)
call mld_check_def(p%parms%smoother_pos,'smooth_pos',&
& mld_pre_smooth_,is_legal_ml_smooth_pos)
call mld_check_def(p%parms%aggr_omega_alg,'Omega Alg.',& call mld_check_def(p%parms%aggr_omega_alg,'Omega Alg.',&
& mld_eig_est_,is_legal_ml_aggr_omega_alg) & mld_eig_est_,is_legal_ml_aggr_omega_alg)
call mld_check_def(p%parms%aggr_eig,'Eigenvalue estimate',& call mld_check_def(p%parms%aggr_eig,'Eigenvalue estimate',&
@ -139,7 +137,7 @@ subroutine mld_d_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
! !
! Build the coarse-level matrix from the fine-level one, starting from ! Build the coarse-level matrix from the fine-level one, starting from
! the mapping defined by mld_aggrmap_bld and applying the aggregation ! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by p%iprcparm(mld_aggr_kind_) ! algorithm specified by p%iprcparm(mld_aggr_prol_)
! !
call mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,p%parms,ac,op_prol,op_restr,info) call mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,p%parms,ac,op_prol,op_restr,info)

@ -1,3 +1,5 @@
! !
! !
! MLD2P4 version 2.1 ! MLD2P4 version 2.1
@ -95,15 +97,13 @@ subroutine mld_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
real(psb_dpk_) :: mnaggratio real(psb_dpk_) :: mnaggratio
integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: ipv(mld_ifpsz_), val, coarse_solve_id
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -124,22 +124,6 @@ subroutine mld_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
! !
! For the time being we are commenting out the UPDATE argument
! we plan to resurrect it later.
! !$ if (present(upd)) then
! !$ if (debug_level >= psb_debug_outer_) &
! !$ & write(debug_unit,*) me,' ',trim(name),'UPD ', upd
! !$
! !$ if ((psb_toupper(upd).eq.'F').or.(psb_toupper(upd).eq.'T')) then
! !$ upd_=psb_toupper(upd)
! !$ else
! !$ upd_='F'
! !$ endif
! !$ else
! !$ upd_='F'
! !$ endif
upd_ = 'F'
if (.not.allocated(prec%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_dprecinit !! Error: should have called mld_dprecinit
info=3111 info=3111
@ -165,7 +149,7 @@ subroutine mld_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
endif endif
! !
! Now do the real build. ! Now do the real build.
! !
@ -184,7 +168,97 @@ subroutine mld_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
endif endif
end do end do
!
! Issue a warning for inconsistent changes to COARSE_SOLVE
!
if (me == psb_root_) then
coarse_solve_id = prec%precv(iszv)%parms%coarse_solve
select case (coarse_solve_id)
case(mld_umf_,mld_slu_)
if (prec%precv(iszv)%sm%sv%get_id() /= coarse_solve_id) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id)
write(psb_err_unit,*) ' but I am building ',&
& mld_fact_names(prec%precv(iszv)%sm%sv%get_id())
write(psb_err_unit,*) 'This may happen if: '
write(psb_err_unit,*) ' 1. coarse_subsolve has been reset, or '
write(psb_err_unit,*) ' 2. the solver ', mld_fact_names(coarse_solve_id),&
& ' was not configured at MLD2P4 build time, or'
write(psb_err_unit,*) ' 3. an unsupported solver setup was specified.'
end if
if (prec%precv(iszv)%parms%coarse_mat /= mld_repl_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id),&
& ' but the coarse matrix has been changed to distributed'
end if
case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
if (prec%precv(iszv)%sm%sv%get_id() /= mld_ilu_n_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id)
write(psb_err_unit,*) ' but I am building ',&
& mld_fact_names(prec%precv(iszv)%sm%sv%get_id())
write(psb_err_unit,*) &
&'This may happen if coarse_subsolve has been reset'
end if
if (prec%precv(iszv)%parms%coarse_mat /= mld_repl_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id),&
& ' but the coarse matrix has been changed to distributed'
end if
case(mld_mumps_)
if (prec%precv(iszv)%sm%sv%get_id() /= mld_mumps_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id)
write(psb_err_unit,*) ' but I am building ',&
& mld_fact_names(prec%precv(iszv)%sm%sv%get_id())
write(psb_err_unit,*) &
&'This may happen if coarse_subsolve has been reset'
end if
case(mld_sludist_)
if (prec%precv(iszv)%sm%sv%get_id() /= coarse_solve_id) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id)
write(psb_err_unit,*) ' but I am building ',&
& mld_fact_names(prec%precv(iszv)%sm%sv%get_id())
write(psb_err_unit,*) 'This may happen if: '
write(psb_err_unit,*) ' 1. coarse_subsolve has been reset, or '
write(psb_err_unit,*) ' 2. the solver ', mld_fact_names(coarse_solve_id), &
& ' was not configured at MLD2P4 build time, or'
write(psb_err_unit,*) ' 3. an unsupported solver setup was specified.'
end if
if (prec%precv(iszv)%parms%coarse_mat /= mld_distr_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id),&
& ' but the coarse matrix has been changed to replicated'
end if
case(mld_bjac_)
if (prec%precv(iszv)%parms%coarse_mat /= mld_distr_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id),&
& ' but the coarse matrix has been changed to replicated'
end if
case default
! We should never get here.
info=psb_err_from_subroutine_
ch_err='unkn coarse_solve'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end select
end if
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Exiting with',iszv,' levels' & 'Exiting with',iszv,' levels'

@ -52,7 +52,7 @@
! A mapping from the nodes of the adjacency graph of A to the nodes of the ! A mapping from the nodes of the adjacency graph of A to the nodes of the
! adjacency graph of A_C has been computed by the mld_aggrmap_bld subroutine. ! adjacency graph of A_C has been computed by the mld_aggrmap_bld subroutine.
! The prolongator P_C is built here from this mapping, according to the ! The prolongator P_C is built here from this mapping, according to the
! value of p%iprcparm(mld_aggr_kind_), specified by the user through ! value of p%iprcparm(mld_aggr_prol_), specified by the user through
! mld_dprecinit and mld_zprecset. ! mld_dprecinit and mld_zprecset.
! On output from this routine the entries of AC, op_prol, op_restr ! On output from this routine the entries of AC, op_prol, op_restr
! are still in "global numbering" mode; this is fixed in the calling routine ! are still in "global numbering" mode; this is fixed in the calling routine
@ -153,7 +153,7 @@ subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,inf
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
select case (parms%aggr_kind) select case (parms%aggr_prol)
case (mld_no_smooth_) case (mld_no_smooth_)
call mld_daggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,& call mld_daggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,&

@ -342,7 +342,7 @@ subroutine mld_daggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
call psb_numbmm(a,tmp_prol,am3) call psb_numbmm(a,tmp_prol,am3)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2',parms%aggr_kind, mld_smooth_prol_ & 'Done NUMBMM 2',parms%aggr_prol, mld_smooth_prol_
call tmp_prol%transp(op_restr) call tmp_prol%transp(op_restr)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &

@ -352,7 +352,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_ & 'Done SPSPMM 2',parms%aggr_prol, mld_smooth_prol_
call tmp_prol%cp_to(tmpcoo) call tmp_prol%cp_to(tmpcoo)
call tmpcoo%transp() call tmpcoo%transp()

@ -141,11 +141,11 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos)
select case(psb_toupper(what)) select case(psb_toupper(what))
case ('COARSE_AGGR_SIZE') case ('MIN_COARSE_SIZE')
p%coarse_aggr_size = max(val,-1) p%min_coarse_size = max(val,-1)
return return
case('MAX_PREC_LEVS') case('MAX_LEVS')
p%max_prec_levs = max(val,1) p%max_levs = max(val,1)
return return
case ('OUTER_SWEEPS') case ('OUTER_SWEEPS')
p%outer_sweeps = max(val,1) p%outer_sweeps = max(val,1)
@ -168,11 +168,9 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos)
select case(psb_toupper(what)) select case(psb_toupper(what))
case('SMOOTHER_TYPE','SUB_SOLVE','SMOOTHER_SWEEPS',& case('SMOOTHER_TYPE','SUB_SOLVE','SMOOTHER_SWEEPS',&
& 'ML_TYPE','AGGR_ALG','AGGR_ORD',& & 'ML_CYCLE','PAR_AGGR_ALG','AGGR_ORD',&
& 'AGGR_KIND','SMOOTHER_POS','AGGR_OMEGA_ALG',& & 'AGGR_TYPE','AGGR_PROL','AGGR_OMEGA_ALG',&
& 'AGGR_EIG','SMOOTHER_SWEEPS_PRE',& & 'AGGR_EIG','SUB_RESTR','SUB_PROL', &
& 'SMOOTHER_SWEEPS_POST',&
& 'SUB_RESTR','SUB_PROL', &
& 'SUB_REN','SUB_OVR','SUB_FILLIN',& & 'SUB_REN','SUB_OVR','SUB_FILLIN',&
& 'COARSE_MAT') & 'COARSE_MAT')
call p%precv(ilev_)%set(what,val,info,pos=pos) call p%precv(ilev_)%set(what,val,info,pos=pos)
@ -208,11 +206,19 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos)
call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
#endif #endif
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info) call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_) case(mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos) call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
case(mld_sludist_,mld_mumps_) case(mld_mumps_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
case(mld_umf_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
case(mld_sludist_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
@ -261,10 +267,8 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos)
if (info /= 0) return if (info /= 0) return
end do end do
case('ML_TYPE','AGGR_ALG','AGGR_ORD','AGGR_KIND',& case('ML_CYCLE','PAR_AGGR_ALG','AGGR_ORD','AGGR_PROL','AGGR_TYPE',&
& 'SMOOTHER_SWEEPS_PRE','SMOOTHER_SWEEPS_POST',& & 'AGGR_OMEGA_ALG','AGGR_EIG','AGGR_FILTER')
& 'SMOOTHER_POS','AGGR_OMEGA_ALG',&
& 'AGGR_EIG','AGGR_FILTER')
do ilev_=1,nlev_ do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos) call p%precv(ilev_)%set(what,val,info,pos=pos)
if (info /= 0) return if (info /= 0) return
@ -291,11 +295,19 @@ subroutine mld_dcprecseti(p,what,val,info,ilev,ilmax,pos)
call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
#endif #endif
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info) call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_) case(mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
case(mld_mumps_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
case(mld_umf_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos) call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
case(mld_sludist_,mld_mumps_) case(mld_sludist_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
@ -488,8 +500,8 @@ subroutine mld_dcprecsetr(p,what,val,info,ilev,ilmax,pos)
end if end if
select case(psb_toupper(what)) select case(psb_toupper(what))
case ('MIN_AGGR_RATIO') case ('MIN_CR_RATIO')
p%min_aggr_ratio = max(done,val) p%min_cr_ratio = max(done,val)
return return
end select end select
@ -527,18 +539,6 @@ subroutine mld_dcprecsetr(p,what,val,info,ilev,ilmax,pos)
ilev_=nlev_ ilev_=nlev_
call p%precv(ilev_)%set('SUB_ILUTHRS',val,info,pos=pos) call p%precv(ilev_)%set('SUB_ILUTHRS',val,info,pos=pos)
case('AGGR_SCALE')
do ilev_ = 2, nlev_
call p%precv(ilev_)%set('AGGR_SCALE',val,info,pos=pos)
end do
case('AGGR_THRESH')
thr = val
do ilev_ = 2, nlev_
call p%precv(ilev_)%set('AGGR_THRESH',thr,info,pos=pos)
thr = thr * p%precv(ilev_)%parms%aggr_scale
end do
case default case default
do ilev_=1,nlev_ do ilev_=1,nlev_

@ -518,7 +518,7 @@ contains
write(debug_unit,*) me,' Start inner_ml_aply at level ',level write(debug_unit,*) me,' Start inner_ml_aply at level ',level
end if end if
select case(p%precv(level)%parms%ml_type) select case(p%precv(level)%parms%ml_cycle)
case(mld_no_ml_) case(mld_no_ml_)
! !
@ -532,39 +532,7 @@ contains
call mld_d_inner_add(p, mlprec_wrk, level, trans, work) call mld_d_inner_add(p, mlprec_wrk, level, trans, work)
case(mld_mult_ml_,mld_vcycle_ml_, mld_wcycle_ml_)
case(mld_mult_ml_)
!
! Multiplicative multilevel (multiplicative among the levels, additive inside
! each level)
!
! Pre/post-smoothing versions.
! Note that the transpose switches pre <-> post.
!
select case(p%precv(level)%parms%smoother_pos)
case(mld_post_smooth_)
p%precv(level)%parms%sweeps_pre = 0
call mld_d_inner_mult(p, mlprec_wrk, level, trans, work)
case(mld_pre_smooth_)
p%precv(level)%parms%sweeps_post = 0
call mld_d_inner_mult(p, mlprec_wrk, level, trans, work)
case(mld_twoside_smooth_)
call mld_d_inner_mult(p, mlprec_wrk, level, trans, work)
case default
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='invalid smooth_pos',&
& i_Err=(/p%precv(level)%parms%smoother_pos,izero,izero,izero,izero/))
goto 9999
end select
case(mld_vcycle_ml_, mld_wcycle_ml_)
call mld_d_inner_mult(p, mlprec_wrk, level, trans, work) call mld_d_inner_mult(p, mlprec_wrk, level, trans, work)
@ -574,8 +542,8 @@ contains
case default case default
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='invalid mltype',& call psb_errpush(info,name,a_err='invalid ml_cycle',&
& i_Err=(/p%precv(level)%parms%ml_type,izero,izero,izero,izero/)) & i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/))
goto 9999 goto 9999
end select end select
@ -643,7 +611,7 @@ contains
goto 9999 goto 9999
end if end if
sweeps = p%precv(level)%parms%sweeps sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(done,& call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,& & mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
@ -821,7 +789,7 @@ contains
goto 9999 goto 9999
end if end if
if (p%precv(level)%parms%ml_type == mld_wcycle_ml_) then if (p%precv(level)%parms%ml_cycle == mld_wcycle_ml_) then
call psb_geaxpby(done,mlprec_wrk(level)%vx2l,& call psb_geaxpby(done,mlprec_wrk(level)%vx2l,&
& dzero,mlprec_wrk(level)%vty,& & dzero,mlprec_wrk(level)%vty,&
@ -894,7 +862,7 @@ contains
else if (level == nlev) then else if (level == nlev) then
sweeps = p%precv(level)%parms%sweeps sweeps = p%precv(level)%parms%sweeps_pre
if (info == psb_success_) call p%precv(level)%sm%apply(done,& if (info == psb_success_) call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,& & mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
@ -976,7 +944,7 @@ contains
! !
! Apply smoother ! Apply smoother
! !
sweeps = p%precv(level)%parms%sweeps sweeps = p%precv(level)%parms%sweeps_pre
if (info == psb_success_) call p%precv(level)%sm%apply(done,& if (info == psb_success_) call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,& & mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
@ -1036,13 +1004,13 @@ contains
!Set the preconditioner !Set the preconditioner
if (level <= nlev - 2 ) then if (level <= nlev - 2 ) then
if (p%precv(level)%parms%ml_type == mld_kcyclesym_ml_) then if (p%precv(level)%parms%ml_cycle == mld_kcyclesym_ml_) then
call mld_dinneritkcycle(p, mlprec_wrk, level + 1, trans, work, 'FCG') call mld_dinneritkcycle(p, mlprec_wrk, level + 1, trans, work, 'FCG')
elseif (p%precv(level)%parms%ml_type == mld_kcycle_ml_) then elseif (p%precv(level)%parms%ml_cycle == mld_kcycle_ml_) then
call mld_dinneritkcycle(p, mlprec_wrk, level + 1, trans, work, 'GCR') call mld_dinneritkcycle(p, mlprec_wrk, level + 1, trans, work, 'GCR')
else else
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Bad value for ml_type') & a_err='Bad value for ml_cycle')
goto 9999 goto 9999
endif endif
else else
@ -1466,7 +1434,7 @@ contains
write(debug_unit,*) me,' inner_ml_aply at level ',level write(debug_unit,*) me,' inner_ml_aply at level ',level
end if end if
select case(p%precv(level)%parms%ml_type) select case(p%precv(level)%parms%ml_cycle)
case(mld_no_ml_) case(mld_no_ml_)
! !
@ -1480,39 +1448,7 @@ contains
call mld_d_inner_add(p, mlprec_wrk, level, trans, work) call mld_d_inner_add(p, mlprec_wrk, level, trans, work)
case(mld_mult_ml_, mld_vcycle_ml_, mld_wcycle_ml_)
case(mld_mult_ml_)
!
! Multiplicative multilevel (multiplicative among the levels, additive inside
! each level)
!
! Pre/post-smoothing versions.
! Note that the transpose switches pre <-> post.
!
select case(p%precv(level)%parms%smoother_pos)
case(mld_post_smooth_)
p%precv(level)%parms%sweeps_pre = 0
call mld_d_inner_mult(p, mlprec_wrk, level, trans, work)
case(mld_pre_smooth_)
p%precv(level)%parms%sweeps_post = 0
call mld_d_inner_mult(p, mlprec_wrk, level, trans, work)
case(mld_twoside_smooth_)
call mld_d_inner_mult(p, mlprec_wrk, level, trans, work)
case default
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='invalid smooth_pos',&
& i_Err=(/p%precv(level)%parms%smoother_pos,izero,izero,izero,izero/))
goto 9999
end select
case(mld_vcycle_ml_, mld_wcycle_ml_)
call mld_d_inner_mult(p, mlprec_wrk, level, trans, work) call mld_d_inner_mult(p, mlprec_wrk, level, trans, work)
@ -1522,8 +1458,8 @@ contains
case default case default
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='invalid mltype',& call psb_errpush(info,name,a_err='invalid ml_cycle',&
& i_Err=(/p%precv(level)%parms%ml_type,izero,izero,izero,izero/)) & i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/))
goto 9999 goto 9999
end select end select
@ -1588,7 +1524,7 @@ contains
goto 9999 goto 9999
end if end if
sweeps = p%precv(level)%parms%sweeps sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(done,& call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,& & mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
@ -1766,7 +1702,7 @@ contains
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (p%precv(level)%parms%ml_type == mld_wcycle_ml_) then if (p%precv(level)%parms%ml_cycle == mld_wcycle_ml_) then
! On second call will use output y2l as initial guess ! On second call will use output y2l as initial guess
if (info == psb_success_) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info == psb_success_) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
endif endif
@ -1832,7 +1768,7 @@ contains
else if (level == nlev) then else if (level == nlev) then
sweeps = p%precv(level)%parms%sweeps sweeps = p%precv(level)%parms%sweeps_pre
if (info == psb_success_) call p%precv(level)%sm%apply(done,& if (info == psb_success_) call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,& & mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&

@ -94,7 +94,6 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: ictxt, me,np
@ -102,7 +101,6 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
real(psb_dpk_) :: mnaggratio real(psb_dpk_) :: mnaggratio
integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err

@ -144,7 +144,8 @@ subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work)
! Number of levels = 1: apply the base preconditioner ! Number of levels = 1: apply the base preconditioner
! !
call prec%precv(1)%sm%apply(done,x,dzero,y,desc_data,trans_,& call prec%precv(1)%sm%apply(done,x,dzero,y,desc_data,trans_,&
& prec%precv(1)%parms%sweeps, work_,info) & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post), &
& work_,info)
else else
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',& call psb_errpush(info,name,a_err='Invalid size of precv',&
@ -336,7 +337,8 @@ subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
! Number of levels = 1: apply the base preconditioner ! Number of levels = 1: apply the base preconditioner
! !
call prec%precv(1)%sm%apply(done,x,dzero,y,desc_data,trans_,& call prec%precv(1)%sm%apply(done,x,dzero,y,desc_data,trans_,&
& prec%precv(1)%parms%sweeps, work_,info) & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),&
& work_,info)
else else
@ -438,7 +440,8 @@ subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work)
! Number of levels = 1: apply the base preconditioner ! Number of levels = 1: apply the base preconditioner
! !
call prec%precv(1)%sm%apply(done,x,dzero,ww,desc_data,trans_,& call prec%precv(1)%sm%apply(done,x,dzero,ww,desc_data,trans_,&
& prec%precv(1)%parms%sweeps, work_,info) & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),&
& work_,info)
else else

@ -74,7 +74,6 @@ subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
type(mld_dprec_type) :: t_prec type(mld_dprec_type) :: t_prec
@ -82,7 +81,6 @@ subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz
integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_
type(mld_dml_parms) :: prm type(mld_dml_parms) :: prm
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -105,21 +103,6 @@ subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
! !
! For the time being we are commenting out the UPDATE argument
! we plan to resurrect it later.
!!$ if (present(upd)) then
!!$ if (debug_level >= psb_debug_outer_) &
!!$ & write(debug_unit,*) me,' ',trim(name),'UPD ', upd
!!$
!!$ if ((psb_toupper(upd).eq.'F').or.(psb_toupper(upd).eq.'T')) then
!!$ upd_=psb_toupper(upd)
!!$ else
!!$ upd_='F'
!!$ endif
!!$ else
!!$ upd_='F'
!!$ endif
upd_ = 'F'
if (.not.allocated(prec%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_dprecinit !! Error: should have called mld_dprecinit
@ -174,7 +157,7 @@ subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
goto 9999 goto 9999
endif endif
call prec%precv(1)%sm%build(a,desc_a,upd_,info,& call prec%precv(1)%sm%build(a,desc_a,info,&
& amold=amold,vmold=vmold,imold=imold) & amold=amold,vmold=vmold,imold=imold)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&

@ -111,7 +111,7 @@ subroutine mld_dprecinit(prec,ptype,info)
! Local variables ! Local variables
integer(psb_ipk_) :: nlev_, ilev_ integer(psb_ipk_) :: nlev_, ilev_
real(psb_dpk_) :: thr, scale real(psb_dpk_) :: thr
character(len=*), parameter :: name='mld_precinit' character(len=*), parameter :: name='mld_precinit'
info = psb_success_ info = psb_success_
@ -121,7 +121,7 @@ subroutine mld_dprecinit(prec,ptype,info)
! Do we want to do something? ! Do we want to do something?
endif endif
endif endif
prec%coarse_aggr_size = -1 prec%min_coarse_size = -1
select case(psb_toupper(ptype(1:len_trim(ptype)))) select case(psb_toupper(ptype(1:len_trim(ptype))))
case ('NOPREC','NONE') case ('NOPREC','NONE')
@ -163,9 +163,28 @@ subroutine mld_dprecinit(prec,ptype,info)
case ('ML') case ('ML')
nlev_ = prec%max_prec_levs nlev_ = prec%max_levs
ilev_ = 1 ilev_ = 1
allocate(prec%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
#if 1
do ilev_ = 1, nlev_
call prec%precv(ilev_)%default()
end do
call prec%set('ML_CYCLE','VCYCLE',info)
call prec%set('SMOOTHER_TYPE','FBGS',info)
#if defined(HAVE_UMF_)
call prec%set('COARSE_SOLVE','UMF',info)
#elif defined(HAVE_MUMPS_)
call prec%set('COARSE_SOLVE','MUMPS',info)
#elif defined(HAVE_SLU_)
call prec%set('COARSE_SOLVE','SLU',info)
#else
call prec%set('COARSE_SOLVE','ILU',info)
#endif
!call prec%precv(nlev_)%default()
#else
allocate(mld_d_as_smoother_type :: prec%precv(ilev_)%sm, stat=info) allocate(mld_d_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
if (info /= psb_success_) return if (info /= psb_success_) return
allocate(mld_d_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) allocate(mld_d_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
@ -198,13 +217,11 @@ subroutine mld_dprecinit(prec,ptype,info)
call prec%precv(ilev_)%set(mld_sub_ovr_,izero,info) call prec%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.05_psb_dpk_ thr = 0.05_psb_dpk_
scale = 1.0_psb_dpk_
do ilev_=1,nlev_ do ilev_=1,nlev_
call prec%precv(ilev_)%set(mld_aggr_thresh_,thr,info) call prec%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
call prec%precv(ilev_)%set(mld_aggr_scale_,scale,info)
call prec%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info) call prec%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info)
end do end do
#endif
case default case default
write(psb_err_unit,*) name,& write(psb_err_unit,*) name,&
&': Warning: Unknown preconditioner type request "',ptype,'"' &': Warning: Unknown preconditioner type request "',ptype,'"'

@ -140,11 +140,11 @@ subroutine mld_dprecseti(p,what,val,info,ilev,ilmax,pos)
select case(what) select case(what)
case (mld_coarse_aggr_size_) case (mld_min_coarse_size_)
p%coarse_aggr_size = max(val,-1) p%min_coarse_size = max(val,-1)
return return
case(mld_max_prec_levs_) case(mld_max_levs_)
p%max_prec_levs = max(val,1) p%max_levs = max(val,1)
return return
case(mld_outer_sweeps_) case(mld_outer_sweeps_)
p%outer_sweeps = max(val,1) p%outer_sweeps = max(val,1)
@ -164,10 +164,8 @@ subroutine mld_dprecseti(p,what,val,info,ilev,ilmax,pos)
select case(what) select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,& case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,&
& mld_ml_type_,mld_aggr_alg_,mld_aggr_ord_,& & mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,&
& mld_aggr_kind_,mld_smoother_pos_,& & mld_aggr_prol_, mld_aggr_omega_alg_,mld_aggr_eig_,&
& mld_aggr_omega_alg_,mld_aggr_eig_,&
& mld_smoother_sweeps_pre_,mld_smoother_sweeps_post_,&
& mld_sub_restr_,mld_sub_prol_, & & 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_coarse_mat_) & mld_coarse_mat_)
@ -204,11 +202,19 @@ subroutine mld_dprecseti(p,what,val,info,ilev,ilmax,pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
#endif #endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_) case(mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_sludist_,mld_mumps_) case(mld_mumps_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_umf_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_sludist_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
@ -256,9 +262,7 @@ subroutine mld_dprecseti(p,what,val,info,ilev,ilmax,pos)
if (info /= 0) return if (info /= 0) return
end do end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_ord_,mld_aggr_kind_,& case(mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,mld_aggr_prol_,&
& mld_smoother_sweeps_pre_,mld_smoother_sweeps_post_,&
& mld_smoother_pos_,mld_aggr_omega_alg_,&
& mld_aggr_eig_,mld_aggr_filter_) & mld_aggr_eig_,mld_aggr_filter_)
do ilev_=1,nlev_ do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos) call p%precv(ilev_)%set(what,val,info,pos=pos)
@ -284,15 +288,19 @@ subroutine mld_dprecseti(p,what,val,info,ilev,ilmax,pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
#endif #endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_) case(mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_sludist_) case(mld_mumps_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_mumps_) case(mld_umf_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_sludist_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
@ -584,8 +592,8 @@ subroutine mld_dprecsetr(p,what,val,info,ilev,ilmax,pos)
info = psb_success_ info = psb_success_
select case(what) select case(what)
case (mld_min_aggr_ratio_) case (mld_min_cr_ratio_)
p%min_aggr_ratio = max(done,val) p%min_cr_ratio = max(done,val)
return return
end select end select
@ -629,18 +637,6 @@ subroutine mld_dprecsetr(p,what,val,info,ilev,ilmax,pos)
ilev_=nlev_ ilev_=nlev_
call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos) call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos)
case(mld_aggr_scale_)
do ilev_ = 2, nlev_
call p%precv(ilev_)%set(mld_aggr_scale_,val,info,pos=pos)
end do
case(mld_aggr_thresh_)
thr = val
do ilev_ = 2, nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info,pos=pos)
thr = thr * p%precv(ilev_)%parms%aggr_scale
end do
case default case default
do ilev_=1,nlev_ do ilev_=1,nlev_

@ -154,10 +154,9 @@ subroutine mld_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
! Check to ensure all procs have the same ! Check to ensure all procs have the same
! !
newsz = -1 newsz = -1
casize = p%coarse_aggr_size mxplevs = p%max_levs
mxplevs = p%max_prec_levs mnaggratio = p%min_cr_ratio
mnaggratio = p%min_aggr_ratio casize = p%min_coarse_size
casize = p%coarse_aggr_size
iszv = size(p%precv) iszv = size(p%precv)
nprolv = size(prolv) nprolv = size(prolv)
nrestrv = size(restrv) nrestrv = size(restrv)
@ -167,19 +166,19 @@ subroutine mld_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ictxt,mnaggratio)
call psb_bcast(ictxt,nprolv) call psb_bcast(ictxt,nprolv)
call psb_bcast(ictxt,nrestrv) call psb_bcast(ictxt,nrestrv)
if (casize /= p%coarse_aggr_size) then if (casize /= p%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
goto 9999 goto 9999
end if end if
if (mxplevs /= p%max_prec_levs) then if (mxplevs /= p%max_levs) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs') call psb_errpush(info,name,a_err='Inconsistent max_levs')
goto 9999 goto 9999
end if end if
if (mnaggratio /= p%min_aggr_ratio) then if (mnaggratio /= p%min_cr_ratio) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio') call psb_errpush(info,name,a_err='Inconsistent min_cr_ratio')
goto 9999 goto 9999
end if end if
if (iszv /= size(p%precv)) then if (iszv /= size(p%precv)) then
@ -220,8 +219,8 @@ subroutine mld_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
endif endif
! !
nplevs = nrestrv + 1 nplevs = nrestrv + 1
p%max_prec_levs = nplevs p%max_levs = nplevs
! !
! Fixed number of levels. ! Fixed number of levels.
@ -366,9 +365,9 @@ contains
allocate(nlaggr(np),ilaggr(1)) allocate(nlaggr(np),ilaggr(1))
nlaggr = 0 nlaggr = 0
ilaggr = 0 ilaggr = 0
p%parms%aggr_alg = mld_ext_aggr_ p%parms%par_aggr_alg = mld_ext_aggr_
call mld_check_def(p%parms%ml_type,'Multilevel type',& call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',&
& mld_mult_ml_,is_legal_ml_type) & mld_mult_ml_,is_legal_ml_cycle)
call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& call mld_check_def(p%parms%coarse_mat,'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat) & mld_distr_mat_,is_legal_ml_coarse_mat)

@ -78,19 +78,19 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
class(mld_sprec_type),intent(inout),target :: prec class(mld_sprec_type),intent(inout),target :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
!!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs, iaggsize integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize,&
real(psb_spk_) :: mnaggratio, sizeratio, athresh, ascale, aomega & nplevs, mxplevs, iaggsize
class(mld_s_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, base_sm2, med_sm2, coarse_sm2 real(psb_spk_) :: mnaggratio, sizeratio, athresh, aomega
class(mld_s_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, &
& base_sm2, med_sm2, coarse_sm2
type(mld_sml_parms) :: baseparms, medparms, coarseparms type(mld_sml_parms) :: baseparms, medparms, coarseparms
integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:)
type(psb_sspmat_type) :: op_prol type(psb_sspmat_type) :: op_prol
type(mld_s_onelev_type), allocatable :: tprecv(:) type(mld_s_onelev_type), allocatable :: tprecv(:)
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -111,21 +111,6 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
! !
! For the time being we are commenting out the UPDATE argument
! we plan to resurrect it later.
! !$ if (present(upd)) then
! !$ if (debug_level >= psb_debug_outer_) &
! !$ & write(debug_unit,*) me,' ',trim(name),'UPD ', upd
! !$
! !$ if ((psb_toupper(upd).eq.'F').or.(psb_toupper(upd).eq.'T')) then
! !$ upd_=psb_toupper(upd)
! !$ else
! !$ upd_='F'
! !$ endif
! !$ else
! !$ upd_='F'
! !$ endif
upd_ = 'F'
if (.not.allocated(prec%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_sprecinit !! Error: should have called mld_sprecinit
@ -138,28 +123,27 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
! Check to ensure all procs have the same ! Check to ensure all procs have the same
! !
newsz = -1 newsz = -1
casize = prec%coarse_aggr_size mxplevs = prec%max_levs
mxplevs = prec%max_prec_levs mnaggratio = prec%min_cr_ratio
mnaggratio = prec%min_aggr_ratio casize = prec%min_coarse_size
casize = prec%coarse_aggr_size
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize) call psb_bcast(ictxt,casize)
call psb_bcast(ictxt,mxplevs) call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ictxt,mnaggratio)
if (casize /= prec%coarse_aggr_size) then if (casize /= prec%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
goto 9999 goto 9999
end if end if
if (mxplevs /= prec%max_prec_levs) then if (mxplevs /= prec%max_levs) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs') call psb_errpush(info,name,a_err='Inconsistent max_levs')
goto 9999 goto 9999
end if end if
if (mnaggratio /= prec%min_aggr_ratio) then if (mnaggratio /= prec%min_cr_ratio) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio') call psb_errpush(info,name,a_err='Inconsistent min_cr_ratio')
goto 9999 goto 9999
end if end if
if (iszv /= size(prec%precv)) then if (iszv /= size(prec%precv)) then
@ -198,18 +182,20 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
! 3. If the size of the array is different from target number of levels, ! 3. If the size of the array is different from target number of levels,
! reallocate; ! reallocate;
! 4. Build the matrix hierarchy, stopping early if either the target ! 4. Build the matrix hierarchy, stopping early if either the target
! coarse size is hit, or the gain falls below the min_aggr_ratio ! coarse size is hit, or the gain falls below the min_cr_ratio
! threshold. ! threshold.
! !
if (casize <=0) then if (casize < 0) then
! !
! Default to the cubic root of the size at base level. ! Default to the cubic root of the size at base level.
! !
casize = desc_a%get_global_rows() casize = desc_a%get_global_rows()
casize = int((sone*casize)**(sone/(sone*3)),psb_ipk_) casize = int((sone*casize)**(sone/(sone*3)),psb_ipk_)
casize = max(casize,ione) casize = max(casize,ione)
casize = casize*40_psb_ipk_ casize = casize*40_psb_ipk_
call psb_bcast(ictxt,casize)
prec%min_coarse_size = casize
end if end if
nplevs = max(itwo,mxplevs) nplevs = max(itwo,mxplevs)
@ -357,11 +343,9 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
! of distr/repl matrix at coarse level. Should be rethought. ! of distr/repl matrix at coarse level. Should be rethought.
! !
athresh = prec%precv(newsz)%parms%aggr_thresh athresh = prec%precv(newsz)%parms%aggr_thresh
ascale = prec%precv(newsz)%parms%aggr_scale
aomega = prec%precv(newsz)%parms%aggr_omega_val aomega = prec%precv(newsz)%parms%aggr_omega_val
if (info == 0) prec%precv(newsz)%parms = coarseparms if (info == 0) prec%precv(newsz)%parms = coarseparms
prec%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_thresh = athresh
prec%precv(newsz)%parms%aggr_scale = ascale
prec%precv(newsz)%parms%aggr_omega_val = aomega prec%precv(newsz)%parms%aggr_omega_val = aomega
if (info == 0) call restore_smoothers(prec%precv(newsz),coarse_sm,coarse_sm2,info) if (info == 0) call restore_smoothers(prec%precv(newsz),coarse_sm,coarse_sm2,info)

@ -108,15 +108,15 @@ subroutine mld_s_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
call mld_check_def(p%parms%ml_type,'Multilevel type',& call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',&
& mld_mult_ml_,is_legal_ml_type) & mld_mult_ml_,is_legal_ml_cycle)
call mld_check_def(p%parms%aggr_alg,'Aggregation',& call mld_check_def(p%parms%par_aggr_alg,'Aggregation',&
& mld_dec_aggr_,is_legal_ml_aggr_alg) & mld_dec_aggr_,is_legal_ml_par_aggr_alg)
call mld_check_def(p%parms%aggr_ord,'Ordering',& call mld_check_def(p%parms%aggr_ord,'Ordering',&
& mld_aggr_ord_nat_,is_legal_ml_aggr_ord) & mld_aggr_ord_nat_,is_legal_ml_aggr_ord)
call mld_check_def(p%parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs) call mld_check_def(p%parms%aggr_thresh,'Aggr_Thresh',szero,is_legal_s_aggr_thrs)
select case(p%parms%aggr_alg) select case(p%parms%par_aggr_alg)
case (mld_dec_aggr_, mld_sym_dec_aggr_) case (mld_dec_aggr_, mld_sym_dec_aggr_)
! !
@ -125,7 +125,7 @@ subroutine mld_s_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
! aggregation algorithm. This also defines a tentative prolongator from ! aggregation algorithm. This also defines a tentative prolongator from
! the coarse to the fine level. ! the coarse to the fine level.
! !
call mld_aggrmap_bld(p%parms%aggr_alg,p%parms%aggr_ord,p%parms%aggr_thresh,& call mld_aggrmap_bld(p%parms%par_aggr_alg,p%parms%aggr_ord,p%parms%aggr_thresh,&
& a,desc_a,ilaggr,nlaggr,op_prol,info) & a,desc_a,ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -137,14 +137,14 @@ subroutine mld_s_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
write(0,*) 'Matching is not implemented yet ' write(0,*) 'Matching is not implemented yet '
info = -1111 info = -1111
call psb_errpush(psb_err_input_value_invalid_i_,name,& call psb_errpush(psb_err_input_value_invalid_i_,name,&
& i_err=(/ione,p%parms%aggr_alg,izero,izero,izero/)) & i_err=(/ione,p%parms%par_aggr_alg,izero,izero,izero/))
goto 9999 goto 9999
case default case default
info = -1 info = -1
call psb_errpush(psb_err_input_value_invalid_i_,name,& call psb_errpush(psb_err_input_value_invalid_i_,name,&
& i_err=(/ione,p%parms%aggr_alg,izero,izero,izero/)) & i_err=(/ione,p%parms%par_aggr_alg,izero,izero,izero/))
goto 9999 goto 9999
end select end select

@ -121,14 +121,12 @@ subroutine mld_s_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
call mld_check_def(p%parms%aggr_kind,'Smoother',& call mld_check_def(p%parms%aggr_prol,'Smoother',&
& mld_smooth_prol_,is_legal_ml_aggr_kind) & mld_smooth_prol_,is_legal_ml_aggr_prol)
call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& call mld_check_def(p%parms%coarse_mat,'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat) & mld_distr_mat_,is_legal_ml_coarse_mat)
call mld_check_def(p%parms%aggr_filter,'Use filtered matrix',& call mld_check_def(p%parms%aggr_filter,'Use filtered matrix',&
& mld_no_filter_mat_,is_legal_aggr_filter) & mld_no_filter_mat_,is_legal_aggr_filter)
call mld_check_def(p%parms%smoother_pos,'smooth_pos',&
& mld_pre_smooth_,is_legal_ml_smooth_pos)
call mld_check_def(p%parms%aggr_omega_alg,'Omega Alg.',& call mld_check_def(p%parms%aggr_omega_alg,'Omega Alg.',&
& mld_eig_est_,is_legal_ml_aggr_omega_alg) & mld_eig_est_,is_legal_ml_aggr_omega_alg)
call mld_check_def(p%parms%aggr_eig,'Eigenvalue estimate',& call mld_check_def(p%parms%aggr_eig,'Eigenvalue estimate',&
@ -139,7 +137,7 @@ subroutine mld_s_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
! !
! Build the coarse-level matrix from the fine-level one, starting from ! Build the coarse-level matrix from the fine-level one, starting from
! the mapping defined by mld_aggrmap_bld and applying the aggregation ! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by p%iprcparm(mld_aggr_kind_) ! algorithm specified by p%iprcparm(mld_aggr_prol_)
! !
call mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,p%parms,ac,op_prol,op_restr,info) call mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,p%parms,ac,op_prol,op_restr,info)

@ -1,3 +1,5 @@
! !
! !
! MLD2P4 version 2.1 ! MLD2P4 version 2.1
@ -95,15 +97,13 @@ subroutine mld_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
real(psb_spk_) :: mnaggratio real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: ipv(mld_ifpsz_), val, coarse_solve_id
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -124,22 +124,6 @@ subroutine mld_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
! !
! For the time being we are commenting out the UPDATE argument
! we plan to resurrect it later.
! !$ if (present(upd)) then
! !$ if (debug_level >= psb_debug_outer_) &
! !$ & write(debug_unit,*) me,' ',trim(name),'UPD ', upd
! !$
! !$ if ((psb_toupper(upd).eq.'F').or.(psb_toupper(upd).eq.'T')) then
! !$ upd_=psb_toupper(upd)
! !$ else
! !$ upd_='F'
! !$ endif
! !$ else
! !$ upd_='F'
! !$ endif
upd_ = 'F'
if (.not.allocated(prec%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_sprecinit !! Error: should have called mld_sprecinit
info=3111 info=3111
@ -165,7 +149,7 @@ subroutine mld_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
endif endif
! !
! Now do the real build. ! Now do the real build.
! !
@ -184,7 +168,97 @@ subroutine mld_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
endif endif
end do end do
!
! Issue a warning for inconsistent changes to COARSE_SOLVE
!
if (me == psb_root_) then
coarse_solve_id = prec%precv(iszv)%parms%coarse_solve
select case (coarse_solve_id)
case(mld_umf_,mld_slu_)
if (prec%precv(iszv)%sm%sv%get_id() /= coarse_solve_id) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id)
write(psb_err_unit,*) ' but I am building ',&
& mld_fact_names(prec%precv(iszv)%sm%sv%get_id())
write(psb_err_unit,*) 'This may happen if: '
write(psb_err_unit,*) ' 1. coarse_subsolve has been reset, or '
write(psb_err_unit,*) ' 2. the solver ', mld_fact_names(coarse_solve_id),&
& ' was not configured at MLD2P4 build time, or'
write(psb_err_unit,*) ' 3. an unsupported solver setup was specified.'
end if
if (prec%precv(iszv)%parms%coarse_mat /= mld_repl_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id),&
& ' but the coarse matrix has been changed to distributed'
end if
case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
if (prec%precv(iszv)%sm%sv%get_id() /= mld_ilu_n_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id)
write(psb_err_unit,*) ' but I am building ',&
& mld_fact_names(prec%precv(iszv)%sm%sv%get_id())
write(psb_err_unit,*) &
&'This may happen if coarse_subsolve has been reset'
end if
if (prec%precv(iszv)%parms%coarse_mat /= mld_repl_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id),&
& ' but the coarse matrix has been changed to distributed'
end if
case(mld_mumps_)
if (prec%precv(iszv)%sm%sv%get_id() /= mld_mumps_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id)
write(psb_err_unit,*) ' but I am building ',&
& mld_fact_names(prec%precv(iszv)%sm%sv%get_id())
write(psb_err_unit,*) &
&'This may happen if coarse_subsolve has been reset'
end if
case(mld_sludist_)
if (prec%precv(iszv)%sm%sv%get_id() /= coarse_solve_id) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id)
write(psb_err_unit,*) ' but I am building ',&
& mld_fact_names(prec%precv(iszv)%sm%sv%get_id())
write(psb_err_unit,*) 'This may happen if: '
write(psb_err_unit,*) ' 1. coarse_subsolve has been reset, or '
write(psb_err_unit,*) ' 2. the solver ', mld_fact_names(coarse_solve_id), &
& ' was not configured at MLD2P4 build time, or'
write(psb_err_unit,*) ' 3. an unsupported solver setup was specified.'
end if
if (prec%precv(iszv)%parms%coarse_mat /= mld_distr_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id),&
& ' but the coarse matrix has been changed to replicated'
end if
case(mld_bjac_)
if (prec%precv(iszv)%parms%coarse_mat /= mld_distr_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id),&
& ' but the coarse matrix has been changed to replicated'
end if
case default
! We should never get here.
info=psb_err_from_subroutine_
ch_err='unkn coarse_solve'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end select
end if
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Exiting with',iszv,' levels' & 'Exiting with',iszv,' levels'

@ -52,7 +52,7 @@
! A mapping from the nodes of the adjacency graph of A to the nodes of the ! A mapping from the nodes of the adjacency graph of A to the nodes of the
! adjacency graph of A_C has been computed by the mld_aggrmap_bld subroutine. ! adjacency graph of A_C has been computed by the mld_aggrmap_bld subroutine.
! The prolongator P_C is built here from this mapping, according to the ! The prolongator P_C is built here from this mapping, according to the
! value of p%iprcparm(mld_aggr_kind_), specified by the user through ! value of p%iprcparm(mld_aggr_prol_), specified by the user through
! mld_sprecinit and mld_zprecset. ! mld_sprecinit and mld_zprecset.
! On output from this routine the entries of AC, op_prol, op_restr ! On output from this routine the entries of AC, op_prol, op_restr
! are still in "global numbering" mode; this is fixed in the calling routine ! are still in "global numbering" mode; this is fixed in the calling routine
@ -153,7 +153,7 @@ subroutine mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,inf
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
select case (parms%aggr_kind) select case (parms%aggr_prol)
case (mld_no_smooth_) case (mld_no_smooth_)
call mld_saggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,& call mld_saggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,&

@ -342,7 +342,7 @@ subroutine mld_saggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
call psb_numbmm(a,tmp_prol,am3) call psb_numbmm(a,tmp_prol,am3)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2',parms%aggr_kind, mld_smooth_prol_ & 'Done NUMBMM 2',parms%aggr_prol, mld_smooth_prol_
call tmp_prol%transp(op_restr) call tmp_prol%transp(op_restr)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &

@ -352,7 +352,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_ & 'Done SPSPMM 2',parms%aggr_prol, mld_smooth_prol_
call tmp_prol%cp_to(tmpcoo) call tmp_prol%cp_to(tmpcoo)
call tmpcoo%transp() call tmpcoo%transp()

@ -135,11 +135,11 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos)
select case(psb_toupper(what)) select case(psb_toupper(what))
case ('COARSE_AGGR_SIZE') case ('MIN_COARSE_SIZE')
p%coarse_aggr_size = max(val,-1) p%min_coarse_size = max(val,-1)
return return
case('MAX_PREC_LEVS') case('MAX_LEVS')
p%max_prec_levs = max(val,1) p%max_levs = max(val,1)
return return
case ('OUTER_SWEEPS') case ('OUTER_SWEEPS')
p%outer_sweeps = max(val,1) p%outer_sweeps = max(val,1)
@ -162,11 +162,9 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos)
select case(psb_toupper(what)) select case(psb_toupper(what))
case('SMOOTHER_TYPE','SUB_SOLVE','SMOOTHER_SWEEPS',& case('SMOOTHER_TYPE','SUB_SOLVE','SMOOTHER_SWEEPS',&
& 'ML_TYPE','AGGR_ALG','AGGR_ORD',& & 'ML_CYCLE','PAR_AGGR_ALG','AGGR_ORD',&
& 'AGGR_KIND','SMOOTHER_POS','AGGR_OMEGA_ALG',& & 'AGGR_TYPE','AGGR_PROL','AGGR_OMEGA_ALG',&
& 'AGGR_EIG','SMOOTHER_SWEEPS_PRE',& & 'AGGR_EIG','SUB_RESTR','SUB_PROL', &
& 'SMOOTHER_SWEEPS_POST',&
& 'SUB_RESTR','SUB_PROL', &
& 'SUB_REN','SUB_OVR','SUB_FILLIN',& & 'SUB_REN','SUB_OVR','SUB_FILLIN',&
& 'COARSE_MAT') & 'COARSE_MAT')
call p%precv(ilev_)%set(what,val,info,pos=pos) call p%precv(ilev_)%set(what,val,info,pos=pos)
@ -200,11 +198,11 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos)
call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
#endif #endif
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info) call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_) case(mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos) call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
case(mld_sludist_,mld_mumps_) case(mld_mumps_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
@ -253,10 +251,8 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos)
if (info /= 0) return if (info /= 0) return
end do end do
case('ML_TYPE','AGGR_ALG','AGGR_ORD','AGGR_KIND',& case('ML_CYCLE','PAR_AGGR_ALG','AGGR_ORD','AGGR_PROL','AGGR_TYPE',&
& 'SMOOTHER_SWEEPS_PRE','SMOOTHER_SWEEPS_POST',& & 'AGGR_OMEGA_ALG','AGGR_EIG','AGGR_FILTER')
& 'SMOOTHER_POS','AGGR_OMEGA_ALG',&
& 'AGGR_EIG','AGGR_FILTER')
do ilev_=1,nlev_ do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos) call p%precv(ilev_)%set(what,val,info,pos=pos)
if (info /= 0) return if (info /= 0) return
@ -281,11 +277,11 @@ subroutine mld_scprecseti(p,what,val,info,ilev,ilmax,pos)
call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
#endif #endif
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info) call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_) case(mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos) call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
case(mld_sludist_,mld_mumps_) case(mld_mumps_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
@ -478,8 +474,8 @@ subroutine mld_scprecsetr(p,what,val,info,ilev,ilmax,pos)
end if end if
select case(psb_toupper(what)) select case(psb_toupper(what))
case ('MIN_AGGR_RATIO') case ('MIN_CR_RATIO')
p%min_aggr_ratio = max(sone,val) p%min_cr_ratio = max(sone,val)
return return
end select end select
@ -517,18 +513,6 @@ subroutine mld_scprecsetr(p,what,val,info,ilev,ilmax,pos)
ilev_=nlev_ ilev_=nlev_
call p%precv(ilev_)%set('SUB_ILUTHRS',val,info,pos=pos) call p%precv(ilev_)%set('SUB_ILUTHRS',val,info,pos=pos)
case('AGGR_SCALE')
do ilev_ = 2, nlev_
call p%precv(ilev_)%set('AGGR_SCALE',val,info,pos=pos)
end do
case('AGGR_THRESH')
thr = val
do ilev_ = 2, nlev_
call p%precv(ilev_)%set('AGGR_THRESH',thr,info,pos=pos)
thr = thr * p%precv(ilev_)%parms%aggr_scale
end do
case default case default
do ilev_=1,nlev_ do ilev_=1,nlev_

@ -518,7 +518,7 @@ contains
write(debug_unit,*) me,' Start inner_ml_aply at level ',level write(debug_unit,*) me,' Start inner_ml_aply at level ',level
end if end if
select case(p%precv(level)%parms%ml_type) select case(p%precv(level)%parms%ml_cycle)
case(mld_no_ml_) case(mld_no_ml_)
! !
@ -532,39 +532,7 @@ contains
call mld_s_inner_add(p, mlprec_wrk, level, trans, work) call mld_s_inner_add(p, mlprec_wrk, level, trans, work)
case(mld_mult_ml_,mld_vcycle_ml_, mld_wcycle_ml_)
case(mld_mult_ml_)
!
! Multiplicative multilevel (multiplicative among the levels, additive inside
! each level)
!
! Pre/post-smoothing versions.
! Note that the transpose switches pre <-> post.
!
select case(p%precv(level)%parms%smoother_pos)
case(mld_post_smooth_)
p%precv(level)%parms%sweeps_pre = 0
call mld_s_inner_mult(p, mlprec_wrk, level, trans, work)
case(mld_pre_smooth_)
p%precv(level)%parms%sweeps_post = 0
call mld_s_inner_mult(p, mlprec_wrk, level, trans, work)
case(mld_twoside_smooth_)
call mld_s_inner_mult(p, mlprec_wrk, level, trans, work)
case default
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='invalid smooth_pos',&
& i_Err=(/p%precv(level)%parms%smoother_pos,izero,izero,izero,izero/))
goto 9999
end select
case(mld_vcycle_ml_, mld_wcycle_ml_)
call mld_s_inner_mult(p, mlprec_wrk, level, trans, work) call mld_s_inner_mult(p, mlprec_wrk, level, trans, work)
@ -574,8 +542,8 @@ contains
case default case default
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='invalid mltype',& call psb_errpush(info,name,a_err='invalid ml_cycle',&
& i_Err=(/p%precv(level)%parms%ml_type,izero,izero,izero,izero/)) & i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/))
goto 9999 goto 9999
end select end select
@ -643,7 +611,7 @@ contains
goto 9999 goto 9999
end if end if
sweeps = p%precv(level)%parms%sweeps sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(sone,& call p%precv(level)%sm%apply(sone,&
& mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,& & mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
@ -821,7 +789,7 @@ contains
goto 9999 goto 9999
end if end if
if (p%precv(level)%parms%ml_type == mld_wcycle_ml_) then if (p%precv(level)%parms%ml_cycle == mld_wcycle_ml_) then
call psb_geaxpby(sone,mlprec_wrk(level)%vx2l,& call psb_geaxpby(sone,mlprec_wrk(level)%vx2l,&
& szero,mlprec_wrk(level)%vty,& & szero,mlprec_wrk(level)%vty,&
@ -894,7 +862,7 @@ contains
else if (level == nlev) then else if (level == nlev) then
sweeps = p%precv(level)%parms%sweeps sweeps = p%precv(level)%parms%sweeps_pre
if (info == psb_success_) call p%precv(level)%sm%apply(sone,& if (info == psb_success_) call p%precv(level)%sm%apply(sone,&
& mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,& & mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
@ -976,7 +944,7 @@ contains
! !
! Apply smoother ! Apply smoother
! !
sweeps = p%precv(level)%parms%sweeps sweeps = p%precv(level)%parms%sweeps_pre
if (info == psb_success_) call p%precv(level)%sm%apply(sone,& if (info == psb_success_) call p%precv(level)%sm%apply(sone,&
& mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,& & mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
@ -1036,13 +1004,13 @@ contains
!Set the preconditioner !Set the preconditioner
if (level <= nlev - 2 ) then if (level <= nlev - 2 ) then
if (p%precv(level)%parms%ml_type == mld_kcyclesym_ml_) then if (p%precv(level)%parms%ml_cycle == mld_kcyclesym_ml_) then
call mld_sinneritkcycle(p, mlprec_wrk, level + 1, trans, work, 'FCG') call mld_sinneritkcycle(p, mlprec_wrk, level + 1, trans, work, 'FCG')
elseif (p%precv(level)%parms%ml_type == mld_kcycle_ml_) then elseif (p%precv(level)%parms%ml_cycle == mld_kcycle_ml_) then
call mld_sinneritkcycle(p, mlprec_wrk, level + 1, trans, work, 'GCR') call mld_sinneritkcycle(p, mlprec_wrk, level + 1, trans, work, 'GCR')
else else
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Bad value for ml_type') & a_err='Bad value for ml_cycle')
goto 9999 goto 9999
endif endif
else else
@ -1466,7 +1434,7 @@ contains
write(debug_unit,*) me,' inner_ml_aply at level ',level write(debug_unit,*) me,' inner_ml_aply at level ',level
end if end if
select case(p%precv(level)%parms%ml_type) select case(p%precv(level)%parms%ml_cycle)
case(mld_no_ml_) case(mld_no_ml_)
! !
@ -1480,39 +1448,7 @@ contains
call mld_s_inner_add(p, mlprec_wrk, level, trans, work) call mld_s_inner_add(p, mlprec_wrk, level, trans, work)
case(mld_mult_ml_, mld_vcycle_ml_, mld_wcycle_ml_)
case(mld_mult_ml_)
!
! Multiplicative multilevel (multiplicative among the levels, additive inside
! each level)
!
! Pre/post-smoothing versions.
! Note that the transpose switches pre <-> post.
!
select case(p%precv(level)%parms%smoother_pos)
case(mld_post_smooth_)
p%precv(level)%parms%sweeps_pre = 0
call mld_s_inner_mult(p, mlprec_wrk, level, trans, work)
case(mld_pre_smooth_)
p%precv(level)%parms%sweeps_post = 0
call mld_s_inner_mult(p, mlprec_wrk, level, trans, work)
case(mld_twoside_smooth_)
call mld_s_inner_mult(p, mlprec_wrk, level, trans, work)
case default
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='invalid smooth_pos',&
& i_Err=(/p%precv(level)%parms%smoother_pos,izero,izero,izero,izero/))
goto 9999
end select
case(mld_vcycle_ml_, mld_wcycle_ml_)
call mld_s_inner_mult(p, mlprec_wrk, level, trans, work) call mld_s_inner_mult(p, mlprec_wrk, level, trans, work)
@ -1522,8 +1458,8 @@ contains
case default case default
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='invalid mltype',& call psb_errpush(info,name,a_err='invalid ml_cycle',&
& i_Err=(/p%precv(level)%parms%ml_type,izero,izero,izero,izero/)) & i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/))
goto 9999 goto 9999
end select end select
@ -1588,7 +1524,7 @@ contains
goto 9999 goto 9999
end if end if
sweeps = p%precv(level)%parms%sweeps sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(sone,& call p%precv(level)%sm%apply(sone,&
& mlprec_wrk(level)%x2l,szero,mlprec_wrk(level)%y2l,& & mlprec_wrk(level)%x2l,szero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&
@ -1766,7 +1702,7 @@ contains
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (p%precv(level)%parms%ml_type == mld_wcycle_ml_) then if (p%precv(level)%parms%ml_cycle == mld_wcycle_ml_) then
! On second call will use output y2l as initial guess ! On second call will use output y2l as initial guess
if (info == psb_success_) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) if (info == psb_success_) call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
endif endif
@ -1832,7 +1768,7 @@ contains
else if (level == nlev) then else if (level == nlev) then
sweeps = p%precv(level)%parms%sweeps sweeps = p%precv(level)%parms%sweeps_pre
if (info == psb_success_) call p%precv(level)%sm%apply(sone,& if (info == psb_success_) call p%precv(level)%sm%apply(sone,&
& mlprec_wrk(level)%x2l,szero,mlprec_wrk(level)%y2l,& & mlprec_wrk(level)%x2l,szero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,& & p%precv(level)%base_desc, trans,&

@ -94,7 +94,6 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: ictxt, me,np
@ -102,7 +101,6 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
real(psb_spk_) :: mnaggratio real(psb_spk_) :: mnaggratio
integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err

@ -144,7 +144,8 @@ subroutine mld_sprecaply(prec,x,y,desc_data,info,trans,work)
! Number of levels = 1: apply the base preconditioner ! Number of levels = 1: apply the base preconditioner
! !
call prec%precv(1)%sm%apply(sone,x,szero,y,desc_data,trans_,& call prec%precv(1)%sm%apply(sone,x,szero,y,desc_data,trans_,&
& prec%precv(1)%parms%sweeps, work_,info) & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post), &
& work_,info)
else else
info = psb_err_from_subroutine_ai_ info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',& call psb_errpush(info,name,a_err='Invalid size of precv',&
@ -336,7 +337,8 @@ subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
! Number of levels = 1: apply the base preconditioner ! Number of levels = 1: apply the base preconditioner
! !
call prec%precv(1)%sm%apply(sone,x,szero,y,desc_data,trans_,& call prec%precv(1)%sm%apply(sone,x,szero,y,desc_data,trans_,&
& prec%precv(1)%parms%sweeps, work_,info) & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),&
& work_,info)
else else
@ -438,7 +440,8 @@ subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work)
! Number of levels = 1: apply the base preconditioner ! Number of levels = 1: apply the base preconditioner
! !
call prec%precv(1)%sm%apply(sone,x,szero,ww,desc_data,trans_,& call prec%precv(1)%sm%apply(sone,x,szero,ww,desc_data,trans_,&
& prec%precv(1)%parms%sweeps, work_,info) & max(prec%precv(1)%parms%sweeps_pre,prec%precv(1)%parms%sweeps_post),&
& work_,info)
else else

@ -74,7 +74,6 @@ subroutine mld_sprecbld(a,desc_a,prec,info,amold,vmold,imold)
class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
type(mld_sprec_type) :: t_prec type(mld_sprec_type) :: t_prec
@ -82,7 +81,6 @@ subroutine mld_sprecbld(a,desc_a,prec,info,amold,vmold,imold)
integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz
integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_
type(mld_dml_parms) :: prm type(mld_dml_parms) :: prm
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -105,21 +103,6 @@ subroutine mld_sprecbld(a,desc_a,prec,info,amold,vmold,imold)
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
! !
! For the time being we are commenting out the UPDATE argument
! we plan to resurrect it later.
!!$ if (present(upd)) then
!!$ if (debug_level >= psb_debug_outer_) &
!!$ & write(debug_unit,*) me,' ',trim(name),'UPD ', upd
!!$
!!$ if ((psb_toupper(upd).eq.'F').or.(psb_toupper(upd).eq.'T')) then
!!$ upd_=psb_toupper(upd)
!!$ else
!!$ upd_='F'
!!$ endif
!!$ else
!!$ upd_='F'
!!$ endif
upd_ = 'F'
if (.not.allocated(prec%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_sprecinit !! Error: should have called mld_sprecinit
@ -174,7 +157,7 @@ subroutine mld_sprecbld(a,desc_a,prec,info,amold,vmold,imold)
goto 9999 goto 9999
endif endif
call prec%precv(1)%sm%build(a,desc_a,upd_,info,& call prec%precv(1)%sm%build(a,desc_a,info,&
& amold=amold,vmold=vmold,imold=imold) & amold=amold,vmold=vmold,imold=imold)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&

@ -108,7 +108,7 @@ subroutine mld_sprecinit(prec,ptype,info)
! Local variables ! Local variables
integer(psb_ipk_) :: nlev_, ilev_ integer(psb_ipk_) :: nlev_, ilev_
real(psb_spk_) :: thr, scale real(psb_spk_) :: thr
character(len=*), parameter :: name='mld_precinit' character(len=*), parameter :: name='mld_precinit'
info = psb_success_ info = psb_success_
@ -118,7 +118,7 @@ subroutine mld_sprecinit(prec,ptype,info)
! Do we want to do something? ! Do we want to do something?
endif endif
endif endif
prec%coarse_aggr_size = -1 prec%min_coarse_size = -1
select case(psb_toupper(ptype(1:len_trim(ptype)))) select case(psb_toupper(ptype(1:len_trim(ptype))))
case ('NOPREC','NONE') case ('NOPREC','NONE')
@ -160,9 +160,26 @@ subroutine mld_sprecinit(prec,ptype,info)
case ('ML') case ('ML')
nlev_ = prec%max_prec_levs nlev_ = prec%max_levs
ilev_ = 1 ilev_ = 1
allocate(prec%precv(nlev_),stat=info) allocate(prec%precv(nlev_),stat=info)
#if 1
do ilev_ = 1, nlev_
call prec%precv(ilev_)%default()
end do
call prec%set('ML_CYCLE','VCYCLE',info)
call prec%set('SMOOTHER_TYPE','FBGS',info)
#if defined(HAVE_MUMPS_)
call prec%set('COARSE_SOLVE','MUMPS',info)
#elif defined(HAVE_SLU_)
call prec%set('COARSE_SOLVE','SLU',info)
#else
call prec%set('COARSE_SOLVE','ILU',info)
#endif
!call prec%precv(nlev_)%default()
#else
allocate(mld_s_as_smoother_type :: prec%precv(ilev_)%sm, stat=info) allocate(mld_s_as_smoother_type :: prec%precv(ilev_)%sm, stat=info)
if (info /= psb_success_) return if (info /= psb_success_) return
allocate(mld_s_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info) allocate(mld_s_ilu_solver_type :: prec%precv(ilev_)%sm%sv, stat=info)
@ -193,13 +210,11 @@ subroutine mld_sprecinit(prec,ptype,info)
call prec%precv(ilev_)%set(mld_sub_ovr_,izero,info) call prec%precv(ilev_)%set(mld_sub_ovr_,izero,info)
thr = 0.05_psb_spk_ thr = 0.05_psb_spk_
scale = 1.0_psb_spk_
do ilev_=1,nlev_ do ilev_=1,nlev_
call prec%precv(ilev_)%set(mld_aggr_thresh_,thr,info) call prec%precv(ilev_)%set(mld_aggr_thresh_,thr,info)
call prec%precv(ilev_)%set(mld_aggr_scale_,scale,info)
call prec%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info) call prec%precv(ilev_)%set(mld_aggr_filter_,mld_filter_mat_,info)
end do end do
#endif
case default case default
write(psb_err_unit,*) name,& write(psb_err_unit,*) name,&
&': Warning: Unknown preconditioner type request "',ptype,'"' &': Warning: Unknown preconditioner type request "',ptype,'"'

@ -134,11 +134,11 @@ subroutine mld_sprecseti(p,what,val,info,ilev,ilmax,pos)
select case(what) select case(what)
case (mld_coarse_aggr_size_) case (mld_min_coarse_size_)
p%coarse_aggr_size = max(val,-1) p%min_coarse_size = max(val,-1)
return return
case(mld_max_prec_levs_) case(mld_max_levs_)
p%max_prec_levs = max(val,1) p%max_levs = max(val,1)
return return
case(mld_outer_sweeps_) case(mld_outer_sweeps_)
p%outer_sweeps = max(val,1) p%outer_sweeps = max(val,1)
@ -158,10 +158,8 @@ subroutine mld_sprecseti(p,what,val,info,ilev,ilmax,pos)
select case(what) select case(what)
case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,& case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,&
& mld_ml_type_,mld_aggr_alg_,mld_aggr_ord_,& & mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,&
& mld_aggr_kind_,mld_smoother_pos_,& & mld_aggr_prol_, mld_aggr_omega_alg_,mld_aggr_eig_,&
& mld_aggr_omega_alg_,mld_aggr_eig_,&
& mld_smoother_sweeps_pre_,mld_smoother_sweeps_post_,&
& mld_sub_restr_,mld_sub_prol_, & & 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_coarse_mat_) & mld_coarse_mat_)
@ -196,11 +194,11 @@ subroutine mld_sprecseti(p,what,val,info,ilev,ilmax,pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
#endif #endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_) case(mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_sludist_,mld_mumps_) case(mld_mumps_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
@ -248,9 +246,7 @@ subroutine mld_sprecseti(p,what,val,info,ilev,ilmax,pos)
if (info /= 0) return if (info /= 0) return
end do end do
case(mld_ml_type_,mld_aggr_alg_,mld_aggr_ord_,mld_aggr_kind_,& case(mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,mld_aggr_prol_,&
& mld_smoother_sweeps_pre_,mld_smoother_sweeps_post_,&
& mld_smoother_pos_,mld_aggr_omega_alg_,&
& mld_aggr_eig_,mld_aggr_filter_) & mld_aggr_eig_,mld_aggr_filter_)
do ilev_=1,nlev_ do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos) call p%precv(ilev_)%set(what,val,info,pos=pos)
@ -274,14 +270,10 @@ subroutine mld_sprecseti(p,what,val,info,ilev,ilmax,pos)
call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos)
#endif #endif
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_) case(mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos)
case(mld_sludist_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos)
case(mld_mumps_) case(mld_mumps_)
call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos)
@ -574,8 +566,8 @@ subroutine mld_sprecsetr(p,what,val,info,ilev,ilmax,pos)
info = psb_success_ info = psb_success_
select case(what) select case(what)
case (mld_min_aggr_ratio_) case (mld_min_cr_ratio_)
p%min_aggr_ratio = max(sone,val) p%min_cr_ratio = max(sone,val)
return return
end select end select
@ -619,18 +611,6 @@ subroutine mld_sprecsetr(p,what,val,info,ilev,ilmax,pos)
ilev_=nlev_ ilev_=nlev_
call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos) call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos)
case(mld_aggr_scale_)
do ilev_ = 2, nlev_
call p%precv(ilev_)%set(mld_aggr_scale_,val,info,pos=pos)
end do
case(mld_aggr_thresh_)
thr = val
do ilev_ = 2, nlev_
call p%precv(ilev_)%set(mld_aggr_thresh_,thr,info,pos=pos)
thr = thr * p%precv(ilev_)%parms%aggr_scale
end do
case default case default
do ilev_=1,nlev_ do ilev_=1,nlev_

@ -1,345 +0,0 @@
/*
*
* MLD2P4 version 2.0
* MultiLevel Domain Decomposition Parallel Preconditioners Package
* based on PSBLAS (Parallel Sparse BLAS version 3.3)
*
* (C) Copyright 2008, 2010, 2012, 2015, 2017
*
* Salvatore Filippone Cranfield University
* Ambra Abdullahi Hassan University of Rome Tor Vergata
* Alfredo Buttari CNRS-IRIT, Toulouse
* Pasqua D'Ambra ICAR-CNR, Naples
* Daniela di Serafino University of Campania "L. Vanvitelli", Caserta
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions, and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. The name of the MLD2P4 group or the names of its contributors may
* not be used to endorse or promote products derived from this
* software without specific written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
* TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
* BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
* INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
* CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*
*
* File: mld_slud_interface.c
*
* Functions: mld_ssludist_fact, mld_ssludist_solve, mld_ssludist_free.
*
* This file is an interface to the SuperLU_dist routines for sparse factorization and
* solve. It was obtained by modifying the c_fortran_dgssv.c file from the SuperLU_dist
* source distribution; original copyright terms are reproduced below.
*
*/
/* =====================
Copyright (c) 2003, The Regents of the University of California, through
Lawrence Berkeley National Laboratory (subject to receipt of any required
approvals from U.S. Dept. of Energy)
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
(1) Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
(2) Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
(3) Neither the name of Lawrence Berkeley National Laboratory, U.S. Dept. of
Energy nor the names of its contributors may be used to endorse or promote
products derived from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
/*
* -- Distributed SuperLU routine (version 2.0) --
* Lawrence Berkeley National Lab, Univ. of California Berkeley.
* March 15, 2003
*
*/
/* as of v 3.3 SLUDist does not have a single precision interface */
#ifdef Have_SLUDist_
#undef Have_SLUDist_
#endif
#ifdef Have_SLUDist_
#include <math.h>
#include "superlu_sdefs.h"
#define HANDLE_SIZE 8
typedef struct {
SuperMatrix *A;
LUstruct_t *LUstruct;
gridinfo_t *grid;
ScalePermstruct_t *ScalePermstruct;
} factors_t;
#else
#include <stdio.h>
#endif
int mld_ssludist_fact(int n, int nl, int nnzl, int ffstr,
float *values, int *rowptr, int *colind,
void **f_factors, int nprow, int npcol)
{
/*
* This routine can be called from Fortran.
* performs LU decomposition.
*
* f_factors (input/output) void**
* On output contains the pointer pointing to
* the structure of the factored matrices.
*
*/
#ifdef Have_SLUDist_
SuperMatrix *A;
NRformat_loc *Astore;
ScalePermstruct_t *ScalePermstruct;
LUstruct_t *LUstruct;
SOLVEstruct_t SOLVEstruct;
gridinfo_t *grid;
int i, panel_size, permc_spec, relax, info;
trans_t trans;
float drop_tol = 0.0, b[1], berr[1];
mem_usage_t mem_usage;
superlu_options_t options;
SuperLUStat_t stat;
factors_t *LUfactors;
int fst_row;
int *icol,*irpt;
float *ival;
trans = NOTRANS;
grid = (gridinfo_t *) SUPERLU_MALLOC(sizeof(gridinfo_t));
superlu_gridinit(MPI_COMM_WORLD, nprow, npcol, grid);
/* Initialize the statistics variables. */
PStatInit(&stat);
fst_row = (ffstr);
A = (SuperMatrix *) malloc(sizeof(SuperMatrix));
dCreate_CompRowLoc_Matrix_dist(A, n, n, nnzl, nl, fst_row,
values, colind, rowptr,
SLU_NR_loc, SLU_D, SLU_GE);
/* Initialize ScalePermstruct and LUstruct. */
ScalePermstruct = (ScalePermstruct_t *) SUPERLU_MALLOC(sizeof(ScalePermstruct_t));
LUstruct = (LUstruct_t *) SUPERLU_MALLOC(sizeof(LUstruct_t));
ScalePermstructInit(n,n, ScalePermstruct);
#if defined(SLUD_VERSION_4)
LUstructInit(n, LUstruct);
#elif defined(SLUD_VERSION_3)
LUstructInit(n,n, LUstruct);
#else
choke_on_me;
#endif
/* Set the default input options. */
set_default_options_dist(&options);
options.IterRefine=NO;
options.PrintStat=NO;
pdgssvx(&options, A, ScalePermstruct, b, nl, 0,
grid, LUstruct, &SOLVEstruct, berr, &stat, &info);
if ( info == 0 ) {
;
} else {
printf("pdgssvx() error returns INFO= %d\n", info);
if ( info <= n ) { /* factorization completes */
;
}
}
if (options.SolveInitialized) {
dSolveFinalize(&options,&SOLVEstruct);
}
/* Save the LU factors in the factors handle */
LUfactors = (factors_t *) SUPERLU_MALLOC(sizeof(factors_t));
LUfactors->LUstruct = LUstruct;
LUfactors->grid = grid;
LUfactors->A = A;
LUfactors->ScalePermstruct = ScalePermstruct;
/* fprintf(stderr,"slud factor: LUFactors %p \n",LUfactors); */
/* fprintf(stderr,"slud factor: A %p %p\n",A,LUfactors->A); */
/* fprintf(stderr,"slud factor: grid %p %p\n",grid,LUfactors->grid); */
/* fprintf(stderr,"slud factor: LUstruct %p %p\n",LUstruct,LUfactors->LUstruct); */
*f_factors = (void *) LUfactors;
PStatFree(&stat);
return(info);
#else
fprintf(stderr," SLUDist does not have single precision, sorry.\n");
return(-1);
#endif
}
int mld_ssludist_solve(int itrans, int n, int nrhs,
float *b, int ldb, void *f_factors)
{
/*
* This routine can be called from Fortran.
* performs triangular solve
*
*/
#ifdef Have_SLUDist_
SuperMatrix *A;
ScalePermstruct_t *ScalePermstruct;
LUstruct_t *LUstruct;
SOLVEstruct_t SOLVEstruct;
gridinfo_t *grid;
int i, panel_size, permc_spec, relax, info;
trans_t trans;
float drop_tol = 0.0;
float *berr;
mem_usage_t mem_usage;
superlu_options_t options;
SuperLUStat_t stat;
factors_t *LUfactors;
LUfactors = (factors_t *) f_factors ;
A = LUfactors->A ;
LUstruct = LUfactors->LUstruct ;
grid = LUfactors->grid ;
ScalePermstruct = LUfactors->ScalePermstruct;
fprintf(stderr,"slud solve: ldb %d n %d \n",ldb,n);
/* fprintf(stderr,"slud solve: LUFactors %p \n",LUfactors); */
/* fprintf(stderr,"slud solve: A %p %p\n",A,LUfactors->A); */
/* fprintf(stderr,"slud solve: grid %p %p\n",grid,LUfactors->grid); */
/* fprintf(stderr,"slud solve: LUstruct %p %p\n",LUstruct,LUfactors->LUstruct); */
if (itrans == 0) {
trans = NOTRANS;
} else if (itrans ==1) {
trans = TRANS;
} else if (itrans ==2) {
trans = CONJ;
} else {
trans = NOTRANS;
}
/* fprintf(stderr,"Entry to sludist_solve\n"); */
berr = (float *) malloc((nrhs) *sizeof(float));
/* Initialize the statistics variables. */
PStatInit(&stat);
/* Set the default input options. */
set_default_options_dist(&options);
options.IterRefine = NO;
options.Fact = FACTORED;
options.PrintStat = NO;
pdgssvx(&options, A, ScalePermstruct, b, ldb, nrhs,
grid, LUstruct, &SOLVEstruct, berr, &stat, &info);
/* fprintf(stderr,"Float check: after solve %d %lf\n",*info,berr[0]); */
if (options.SolveInitialized) {
dSolveFinalize(&options,&SOLVEstruct);
}
PStatFree(&stat);
free(berr);
return(info);
#else
fprintf(stderr," SLUDist does not have single precision, sorry.\n");
return(-1);
#endif
}
int mld_ssludist_free(void *f_factors)
{
/*
* This routine can be called from Fortran.
*
* free all storage in the end
*
*/
#ifdef Have_SLUDist_
SuperMatrix *A;
ScalePermstruct_t *ScalePermstruct;
LUstruct_t *LUstruct;
SOLVEstruct_t SOLVEstruct;
gridinfo_t *grid;
int i, panel_size, permc_spec, relax;
trans_t trans;
float drop_tol = 0.0;
float *berr;
mem_usage_t mem_usage;
superlu_options_t options;
SuperLUStat_t stat;
factors_t *LUfactors;
if (f_factors == NULL)
return(0);
LUfactors = (factors_t *) f_factors ;
A = LUfactors->A ;
LUstruct = LUfactors->LUstruct ;
grid = LUfactors->grid ;
ScalePermstruct = LUfactors->ScalePermstruct;
// Memory leak: with SuperLU_Dist 3.3
// we either have a leak or a segfault here.
// To be investigated further.
//Destroy_CompRowLoc_Matrix_dist(A);
ScalePermstructFree(ScalePermstruct);
LUstructFree(LUstruct);
superlu_gridexit(grid);
free(grid);
free(LUstruct);
free(LUfactors);
return(0);
#else
fprintf(stderr," SLUDist does not have single precision, sorry.\n");
return(-1);
#endif
}

@ -154,10 +154,9 @@ subroutine mld_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
! Check to ensure all procs have the same ! Check to ensure all procs have the same
! !
newsz = -1 newsz = -1
casize = p%coarse_aggr_size mxplevs = p%max_levs
mxplevs = p%max_prec_levs mnaggratio = p%min_cr_ratio
mnaggratio = p%min_aggr_ratio casize = p%min_coarse_size
casize = p%coarse_aggr_size
iszv = size(p%precv) iszv = size(p%precv)
nprolv = size(prolv) nprolv = size(prolv)
nrestrv = size(restrv) nrestrv = size(restrv)
@ -167,19 +166,19 @@ subroutine mld_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ictxt,mnaggratio)
call psb_bcast(ictxt,nprolv) call psb_bcast(ictxt,nprolv)
call psb_bcast(ictxt,nrestrv) call psb_bcast(ictxt,nrestrv)
if (casize /= p%coarse_aggr_size) then if (casize /= p%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
goto 9999 goto 9999
end if end if
if (mxplevs /= p%max_prec_levs) then if (mxplevs /= p%max_levs) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs') call psb_errpush(info,name,a_err='Inconsistent max_levs')
goto 9999 goto 9999
end if end if
if (mnaggratio /= p%min_aggr_ratio) then if (mnaggratio /= p%min_cr_ratio) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio') call psb_errpush(info,name,a_err='Inconsistent min_cr_ratio')
goto 9999 goto 9999
end if end if
if (iszv /= size(p%precv)) then if (iszv /= size(p%precv)) then
@ -220,8 +219,8 @@ subroutine mld_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
endif endif
! !
nplevs = nrestrv + 1 nplevs = nrestrv + 1
p%max_prec_levs = nplevs p%max_levs = nplevs
! !
! Fixed number of levels. ! Fixed number of levels.
@ -366,9 +365,9 @@ contains
allocate(nlaggr(np),ilaggr(1)) allocate(nlaggr(np),ilaggr(1))
nlaggr = 0 nlaggr = 0
ilaggr = 0 ilaggr = 0
p%parms%aggr_alg = mld_ext_aggr_ p%parms%par_aggr_alg = mld_ext_aggr_
call mld_check_def(p%parms%ml_type,'Multilevel type',& call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',&
& mld_mult_ml_,is_legal_ml_type) & mld_mult_ml_,is_legal_ml_cycle)
call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& call mld_check_def(p%parms%coarse_mat,'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat) & mld_distr_mat_,is_legal_ml_coarse_mat)

@ -78,19 +78,19 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
type(psb_desc_type), intent(inout), target :: desc_a type(psb_desc_type), intent(inout), target :: desc_a
class(mld_zprec_type),intent(inout),target :: prec class(mld_zprec_type),intent(inout),target :: prec
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
!!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs, iaggsize integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize,&
real(psb_dpk_) :: mnaggratio, sizeratio, athresh, ascale, aomega & nplevs, mxplevs, iaggsize
class(mld_z_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, base_sm2, med_sm2, coarse_sm2 real(psb_dpk_) :: mnaggratio, sizeratio, athresh, aomega
class(mld_z_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, &
& base_sm2, med_sm2, coarse_sm2
type(mld_dml_parms) :: baseparms, medparms, coarseparms type(mld_dml_parms) :: baseparms, medparms, coarseparms
integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:) integer(psb_ipk_), allocatable :: ilaggr(:), nlaggr(:)
type(psb_zspmat_type) :: op_prol type(psb_zspmat_type) :: op_prol
type(mld_z_onelev_type), allocatable :: tprecv(:) type(mld_z_onelev_type), allocatable :: tprecv(:)
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -111,21 +111,6 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
! !
! For the time being we are commenting out the UPDATE argument
! we plan to resurrect it later.
! !$ if (present(upd)) then
! !$ if (debug_level >= psb_debug_outer_) &
! !$ & write(debug_unit,*) me,' ',trim(name),'UPD ', upd
! !$
! !$ if ((psb_toupper(upd).eq.'F').or.(psb_toupper(upd).eq.'T')) then
! !$ upd_=psb_toupper(upd)
! !$ else
! !$ upd_='F'
! !$ endif
! !$ else
! !$ upd_='F'
! !$ endif
upd_ = 'F'
if (.not.allocated(prec%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_zprecinit !! Error: should have called mld_zprecinit
@ -138,28 +123,27 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
! Check to ensure all procs have the same ! Check to ensure all procs have the same
! !
newsz = -1 newsz = -1
casize = prec%coarse_aggr_size mxplevs = prec%max_levs
mxplevs = prec%max_prec_levs mnaggratio = prec%min_cr_ratio
mnaggratio = prec%min_aggr_ratio casize = prec%min_coarse_size
casize = prec%coarse_aggr_size
iszv = size(prec%precv) iszv = size(prec%precv)
call psb_bcast(ictxt,iszv) call psb_bcast(ictxt,iszv)
call psb_bcast(ictxt,casize) call psb_bcast(ictxt,casize)
call psb_bcast(ictxt,mxplevs) call psb_bcast(ictxt,mxplevs)
call psb_bcast(ictxt,mnaggratio) call psb_bcast(ictxt,mnaggratio)
if (casize /= prec%coarse_aggr_size) then if (casize /= prec%min_coarse_size) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent coarse_aggr_size') call psb_errpush(info,name,a_err='Inconsistent min_coarse_size')
goto 9999 goto 9999
end if end if
if (mxplevs /= prec%max_prec_levs) then if (mxplevs /= prec%max_levs) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent max_prec_levs') call psb_errpush(info,name,a_err='Inconsistent max_levs')
goto 9999 goto 9999
end if end if
if (mnaggratio /= prec%min_aggr_ratio) then if (mnaggratio /= prec%min_cr_ratio) then
info=psb_err_internal_error_ info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Inconsistent min_aggr_ratio') call psb_errpush(info,name,a_err='Inconsistent min_cr_ratio')
goto 9999 goto 9999
end if end if
if (iszv /= size(prec%precv)) then if (iszv /= size(prec%precv)) then
@ -198,18 +182,20 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
! 3. If the size of the array is different from target number of levels, ! 3. If the size of the array is different from target number of levels,
! reallocate; ! reallocate;
! 4. Build the matrix hierarchy, stopping early if either the target ! 4. Build the matrix hierarchy, stopping early if either the target
! coarse size is hit, or the gain falls below the min_aggr_ratio ! coarse size is hit, or the gain falls below the min_cr_ratio
! threshold. ! threshold.
! !
if (casize <=0) then if (casize < 0) then
! !
! Default to the cubic root of the size at base level. ! Default to the cubic root of the size at base level.
! !
casize = desc_a%get_global_rows() casize = desc_a%get_global_rows()
casize = int((done*casize)**(done/(done*3)),psb_ipk_) casize = int((done*casize)**(done/(done*3)),psb_ipk_)
casize = max(casize,ione) casize = max(casize,ione)
casize = casize*40_psb_ipk_ casize = casize*40_psb_ipk_
call psb_bcast(ictxt,casize)
prec%min_coarse_size = casize
end if end if
nplevs = max(itwo,mxplevs) nplevs = max(itwo,mxplevs)
@ -357,11 +343,9 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
! of distr/repl matrix at coarse level. Should be rethought. ! of distr/repl matrix at coarse level. Should be rethought.
! !
athresh = prec%precv(newsz)%parms%aggr_thresh athresh = prec%precv(newsz)%parms%aggr_thresh
ascale = prec%precv(newsz)%parms%aggr_scale
aomega = prec%precv(newsz)%parms%aggr_omega_val aomega = prec%precv(newsz)%parms%aggr_omega_val
if (info == 0) prec%precv(newsz)%parms = coarseparms if (info == 0) prec%precv(newsz)%parms = coarseparms
prec%precv(newsz)%parms%aggr_thresh = athresh prec%precv(newsz)%parms%aggr_thresh = athresh
prec%precv(newsz)%parms%aggr_scale = ascale
prec%precv(newsz)%parms%aggr_omega_val = aomega prec%precv(newsz)%parms%aggr_omega_val = aomega
if (info == 0) call restore_smoothers(prec%precv(newsz),coarse_sm,coarse_sm2,info) if (info == 0) call restore_smoothers(prec%precv(newsz),coarse_sm,coarse_sm2,info)

@ -108,15 +108,15 @@ subroutine mld_z_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
call mld_check_def(p%parms%ml_type,'Multilevel type',& call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',&
& mld_mult_ml_,is_legal_ml_type) & mld_mult_ml_,is_legal_ml_cycle)
call mld_check_def(p%parms%aggr_alg,'Aggregation',& call mld_check_def(p%parms%par_aggr_alg,'Aggregation',&
& mld_dec_aggr_,is_legal_ml_aggr_alg) & mld_dec_aggr_,is_legal_ml_par_aggr_alg)
call mld_check_def(p%parms%aggr_ord,'Ordering',& call mld_check_def(p%parms%aggr_ord,'Ordering',&
& mld_aggr_ord_nat_,is_legal_ml_aggr_ord) & mld_aggr_ord_nat_,is_legal_ml_aggr_ord)
call mld_check_def(p%parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs) call mld_check_def(p%parms%aggr_thresh,'Aggr_Thresh',dzero,is_legal_d_aggr_thrs)
select case(p%parms%aggr_alg) select case(p%parms%par_aggr_alg)
case (mld_dec_aggr_, mld_sym_dec_aggr_) case (mld_dec_aggr_, mld_sym_dec_aggr_)
! !
@ -125,7 +125,7 @@ subroutine mld_z_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
! aggregation algorithm. This also defines a tentative prolongator from ! aggregation algorithm. This also defines a tentative prolongator from
! the coarse to the fine level. ! the coarse to the fine level.
! !
call mld_aggrmap_bld(p%parms%aggr_alg,p%parms%aggr_ord,p%parms%aggr_thresh,& call mld_aggrmap_bld(p%parms%par_aggr_alg,p%parms%aggr_ord,p%parms%aggr_thresh,&
& a,desc_a,ilaggr,nlaggr,op_prol,info) & a,desc_a,ilaggr,nlaggr,op_prol,info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -137,14 +137,14 @@ subroutine mld_z_lev_aggrmap_bld(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
write(0,*) 'Matching is not implemented yet ' write(0,*) 'Matching is not implemented yet '
info = -1111 info = -1111
call psb_errpush(psb_err_input_value_invalid_i_,name,& call psb_errpush(psb_err_input_value_invalid_i_,name,&
& i_err=(/ione,p%parms%aggr_alg,izero,izero,izero/)) & i_err=(/ione,p%parms%par_aggr_alg,izero,izero,izero/))
goto 9999 goto 9999
case default case default
info = -1 info = -1
call psb_errpush(psb_err_input_value_invalid_i_,name,& call psb_errpush(psb_err_input_value_invalid_i_,name,&
& i_err=(/ione,p%parms%aggr_alg,izero,izero,izero/)) & i_err=(/ione,p%parms%par_aggr_alg,izero,izero,izero/))
goto 9999 goto 9999
end select end select

@ -121,14 +121,12 @@ subroutine mld_z_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
call mld_check_def(p%parms%aggr_kind,'Smoother',& call mld_check_def(p%parms%aggr_prol,'Smoother',&
& mld_smooth_prol_,is_legal_ml_aggr_kind) & mld_smooth_prol_,is_legal_ml_aggr_prol)
call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& call mld_check_def(p%parms%coarse_mat,'Coarse matrix',&
& mld_distr_mat_,is_legal_ml_coarse_mat) & mld_distr_mat_,is_legal_ml_coarse_mat)
call mld_check_def(p%parms%aggr_filter,'Use filtered matrix',& call mld_check_def(p%parms%aggr_filter,'Use filtered matrix',&
& mld_no_filter_mat_,is_legal_aggr_filter) & mld_no_filter_mat_,is_legal_aggr_filter)
call mld_check_def(p%parms%smoother_pos,'smooth_pos',&
& mld_pre_smooth_,is_legal_ml_smooth_pos)
call mld_check_def(p%parms%aggr_omega_alg,'Omega Alg.',& call mld_check_def(p%parms%aggr_omega_alg,'Omega Alg.',&
& mld_eig_est_,is_legal_ml_aggr_omega_alg) & mld_eig_est_,is_legal_ml_aggr_omega_alg)
call mld_check_def(p%parms%aggr_eig,'Eigenvalue estimate',& call mld_check_def(p%parms%aggr_eig,'Eigenvalue estimate',&
@ -139,7 +137,7 @@ subroutine mld_z_lev_aggrmat_asb(p,a,desc_a,ilaggr,nlaggr,op_prol,info)
! !
! Build the coarse-level matrix from the fine-level one, starting from ! Build the coarse-level matrix from the fine-level one, starting from
! the mapping defined by mld_aggrmap_bld and applying the aggregation ! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by p%iprcparm(mld_aggr_kind_) ! algorithm specified by p%iprcparm(mld_aggr_prol_)
! !
call mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,p%parms,ac,op_prol,op_restr,info) call mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,p%parms,ac,op_prol,op_restr,info)

@ -1,3 +1,5 @@
! !
! !
! MLD2P4 version 2.1 ! MLD2P4 version 2.1
@ -95,15 +97,13 @@ subroutine mld_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold class(psb_z_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold class(psb_i_base_vect_type), intent(in), optional :: imold
!!$ character, intent(in), optional :: upd
! Local Variables ! Local Variables
integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: ictxt, me,np
integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize, nplevs, mxplevs
real(psb_dpk_) :: mnaggratio real(psb_dpk_) :: mnaggratio
integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: ipv(mld_ifpsz_), val, coarse_solve_id
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -124,22 +124,6 @@ subroutine mld_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Entering ' & 'Entering '
! !
! For the time being we are commenting out the UPDATE argument
! we plan to resurrect it later.
! !$ if (present(upd)) then
! !$ if (debug_level >= psb_debug_outer_) &
! !$ & write(debug_unit,*) me,' ',trim(name),'UPD ', upd
! !$
! !$ if ((psb_toupper(upd).eq.'F').or.(psb_toupper(upd).eq.'T')) then
! !$ upd_=psb_toupper(upd)
! !$ else
! !$ upd_='F'
! !$ endif
! !$ else
! !$ upd_='F'
! !$ endif
upd_ = 'F'
if (.not.allocated(prec%precv)) then if (.not.allocated(prec%precv)) then
!! Error: should have called mld_zprecinit !! Error: should have called mld_zprecinit
info=3111 info=3111
@ -165,7 +149,7 @@ subroutine mld_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
endif endif
! !
! Now do the real build. ! Now do the real build.
! !
@ -184,7 +168,97 @@ subroutine mld_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
endif endif
end do end do
!
! Issue a warning for inconsistent changes to COARSE_SOLVE
!
if (me == psb_root_) then
coarse_solve_id = prec%precv(iszv)%parms%coarse_solve
select case (coarse_solve_id)
case(mld_umf_,mld_slu_)
if (prec%precv(iszv)%sm%sv%get_id() /= coarse_solve_id) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id)
write(psb_err_unit,*) ' but I am building ',&
& mld_fact_names(prec%precv(iszv)%sm%sv%get_id())
write(psb_err_unit,*) 'This may happen if: '
write(psb_err_unit,*) ' 1. coarse_subsolve has been reset, or '
write(psb_err_unit,*) ' 2. the solver ', mld_fact_names(coarse_solve_id),&
& ' was not configured at MLD2P4 build time, or'
write(psb_err_unit,*) ' 3. an unsupported solver setup was specified.'
end if
if (prec%precv(iszv)%parms%coarse_mat /= mld_repl_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id),&
& ' but the coarse matrix has been changed to distributed'
end if
case(mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
if (prec%precv(iszv)%sm%sv%get_id() /= mld_ilu_n_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id)
write(psb_err_unit,*) ' but I am building ',&
& mld_fact_names(prec%precv(iszv)%sm%sv%get_id())
write(psb_err_unit,*) &
&'This may happen if coarse_subsolve has been reset'
end if
if (prec%precv(iszv)%parms%coarse_mat /= mld_repl_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id),&
& ' but the coarse matrix has been changed to distributed'
end if
case(mld_mumps_)
if (prec%precv(iszv)%sm%sv%get_id() /= mld_mumps_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id)
write(psb_err_unit,*) ' but I am building ',&
& mld_fact_names(prec%precv(iszv)%sm%sv%get_id())
write(psb_err_unit,*) &
&'This may happen if coarse_subsolve has been reset'
end if
case(mld_sludist_)
if (prec%precv(iszv)%sm%sv%get_id() /= coarse_solve_id) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id)
write(psb_err_unit,*) ' but I am building ',&
& mld_fact_names(prec%precv(iszv)%sm%sv%get_id())
write(psb_err_unit,*) 'This may happen if: '
write(psb_err_unit,*) ' 1. coarse_subsolve has been reset, or '
write(psb_err_unit,*) ' 2. the solver ', mld_fact_names(coarse_solve_id), &
& ' was not configured at MLD2P4 build time, or'
write(psb_err_unit,*) ' 3. an unsupported solver setup was specified.'
end if
if (prec%precv(iszv)%parms%coarse_mat /= mld_distr_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id),&
& ' but the coarse matrix has been changed to replicated'
end if
case(mld_bjac_)
if (prec%precv(iszv)%parms%coarse_mat /= mld_distr_mat_) then
write(psb_err_unit,*) &
& 'MLD2P4: Warning: original coarse solver was requested as ',&
& mld_fact_names(coarse_solve_id),&
& ' but the coarse matrix has been changed to replicated'
end if
case default
! We should never get here.
info=psb_err_from_subroutine_
ch_err='unkn coarse_solve'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end select
end if
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Exiting with',iszv,' levels' & 'Exiting with',iszv,' levels'

@ -52,7 +52,7 @@
! A mapping from the nodes of the adjacency graph of A to the nodes of the ! A mapping from the nodes of the adjacency graph of A to the nodes of the
! adjacency graph of A_C has been computed by the mld_aggrmap_bld subroutine. ! adjacency graph of A_C has been computed by the mld_aggrmap_bld subroutine.
! The prolongator P_C is built here from this mapping, according to the ! The prolongator P_C is built here from this mapping, according to the
! value of p%iprcparm(mld_aggr_kind_), specified by the user through ! value of p%iprcparm(mld_aggr_prol_), specified by the user through
! mld_zprecinit and mld_zprecset. ! mld_zprecinit and mld_zprecset.
! On output from this routine the entries of AC, op_prol, op_restr ! On output from this routine the entries of AC, op_prol, op_restr
! are still in "global numbering" mode; this is fixed in the calling routine ! are still in "global numbering" mode; this is fixed in the calling routine
@ -153,7 +153,7 @@ subroutine mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr,inf
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
select case (parms%aggr_kind) select case (parms%aggr_prol)
case (mld_no_smooth_) case (mld_no_smooth_)
call mld_zaggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,& call mld_zaggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,&

@ -342,7 +342,7 @@ subroutine mld_zaggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
call psb_numbmm(a,tmp_prol,am3) call psb_numbmm(a,tmp_prol,am3)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done NUMBMM 2',parms%aggr_kind, mld_smooth_prol_ & 'Done NUMBMM 2',parms%aggr_prol, mld_smooth_prol_
call tmp_prol%transp(op_restr) call tmp_prol%transp(op_restr)
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &

@ -352,7 +352,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest
if (debug_level >= psb_debug_outer_) & if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),& & write(debug_unit,*) me,' ',trim(name),&
& 'Done SPSPMM 2',parms%aggr_kind, mld_smooth_prol_ & 'Done SPSPMM 2',parms%aggr_prol, mld_smooth_prol_
call tmp_prol%cp_to(tmpcoo) call tmp_prol%cp_to(tmpcoo)
call tmpcoo%transp() call tmpcoo%transp()

@ -141,11 +141,11 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos)
select case(psb_toupper(what)) select case(psb_toupper(what))
case ('COARSE_AGGR_SIZE') case ('MIN_COARSE_SIZE')
p%coarse_aggr_size = max(val,-1) p%min_coarse_size = max(val,-1)
return return
case('MAX_PREC_LEVS') case('MAX_LEVS')
p%max_prec_levs = max(val,1) p%max_levs = max(val,1)
return return
case ('OUTER_SWEEPS') case ('OUTER_SWEEPS')
p%outer_sweeps = max(val,1) p%outer_sweeps = max(val,1)
@ -168,11 +168,9 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos)
select case(psb_toupper(what)) select case(psb_toupper(what))
case('SMOOTHER_TYPE','SUB_SOLVE','SMOOTHER_SWEEPS',& case('SMOOTHER_TYPE','SUB_SOLVE','SMOOTHER_SWEEPS',&
& 'ML_TYPE','AGGR_ALG','AGGR_ORD',& & 'ML_CYCLE','PAR_AGGR_ALG','AGGR_ORD',&
& 'AGGR_KIND','SMOOTHER_POS','AGGR_OMEGA_ALG',& & 'AGGR_TYPE','AGGR_PROL','AGGR_OMEGA_ALG',&
& 'AGGR_EIG','SMOOTHER_SWEEPS_PRE',& & 'AGGR_EIG','SUB_RESTR','SUB_PROL', &
& 'SMOOTHER_SWEEPS_POST',&
& 'SUB_RESTR','SUB_PROL', &
& 'SUB_REN','SUB_OVR','SUB_FILLIN',& & 'SUB_REN','SUB_OVR','SUB_FILLIN',&
& 'COARSE_MAT') & 'COARSE_MAT')
call p%precv(ilev_)%set(what,val,info,pos=pos) call p%precv(ilev_)%set(what,val,info,pos=pos)
@ -208,11 +206,19 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos)
call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
#endif #endif
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info) call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_) case(mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos) call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
case(mld_sludist_,mld_mumps_) case(mld_mumps_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
case(mld_umf_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
case(mld_sludist_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
@ -261,10 +267,8 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos)
if (info /= 0) return if (info /= 0) return
end do end do
case('ML_TYPE','AGGR_ALG','AGGR_ORD','AGGR_KIND',& case('ML_CYCLE','PAR_AGGR_ALG','AGGR_ORD','AGGR_PROL','AGGR_TYPE',&
& 'SMOOTHER_SWEEPS_PRE','SMOOTHER_SWEEPS_POST',& & 'AGGR_OMEGA_ALG','AGGR_EIG','AGGR_FILTER')
& 'SMOOTHER_POS','AGGR_OMEGA_ALG',&
& 'AGGR_EIG','AGGR_FILTER')
do ilev_=1,nlev_ do ilev_=1,nlev_
call p%precv(ilev_)%set(what,val,info,pos=pos) call p%precv(ilev_)%set(what,val,info,pos=pos)
if (info /= 0) return if (info /= 0) return
@ -291,11 +295,19 @@ subroutine mld_zcprecseti(p,what,val,info,ilev,ilmax,pos)
call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',mld_ilu_n_,info,pos=pos)
#endif #endif
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info) call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info)
case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_) case(mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
case(mld_mumps_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
case(mld_umf_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos) call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info,pos=pos)
case(mld_sludist_,mld_mumps_) case(mld_sludist_)
call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos) call p%precv(nlev_)%set('SMOOTHER_TYPE',mld_bjac_,info,pos=pos)
call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos) call p%precv(nlev_)%set('SUB_SOLVE',val,info,pos=pos)
call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos) call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info,pos=pos)
@ -488,8 +500,8 @@ subroutine mld_zcprecsetr(p,what,val,info,ilev,ilmax,pos)
end if end if
select case(psb_toupper(what)) select case(psb_toupper(what))
case ('MIN_AGGR_RATIO') case ('MIN_CR_RATIO')
p%min_aggr_ratio = max(done,val) p%min_cr_ratio = max(done,val)
return return
end select end select
@ -527,18 +539,6 @@ subroutine mld_zcprecsetr(p,what,val,info,ilev,ilmax,pos)
ilev_=nlev_ ilev_=nlev_
call p%precv(ilev_)%set('SUB_ILUTHRS',val,info,pos=pos) call p%precv(ilev_)%set('SUB_ILUTHRS',val,info,pos=pos)
case('AGGR_SCALE')
do ilev_ = 2, nlev_
call p%precv(ilev_)%set('AGGR_SCALE',val,info,pos=pos)
end do
case('AGGR_THRESH')
thr = val
do ilev_ = 2, nlev_
call p%precv(ilev_)%set('AGGR_THRESH',thr,info,pos=pos)
thr = thr * p%precv(ilev_)%parms%aggr_scale
end do
case default case default
do ilev_=1,nlev_ do ilev_=1,nlev_

Some files were not shown because too many files have changed in this diff Show More

Loading…
Cancel
Save