From a134c6659929e923bff6f9d74bdbbf02b4cfb622 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 8 Jan 2013 13:18:15 +0000 Subject: [PATCH] mld2p4-2: mlprec/impl/level/mld_c_base_onelev_setc.f90 mlprec/impl/level/mld_d_base_onelev_setc.f90 mlprec/impl/level/mld_s_base_onelev_setc.f90 mlprec/impl/level/mld_z_base_onelev_setc.f90 mlprec/impl/mld_cprecset.F90 mlprec/impl/mld_dprecset.F90 mlprec/impl/mld_sprecset.F90 mlprec/impl/mld_zprecset.F90 mlprec/impl/smoother/mld_c_as_smoother_setc.f90 mlprec/impl/smoother/mld_c_base_smoother_setc.f90 mlprec/impl/smoother/mld_d_as_smoother_setc.f90 mlprec/impl/smoother/mld_d_base_smoother_setc.f90 mlprec/impl/smoother/mld_s_as_smoother_setc.f90 mlprec/impl/smoother/mld_s_base_smoother_setc.f90 mlprec/impl/smoother/mld_z_as_smoother_setc.f90 mlprec/impl/smoother/mld_z_base_smoother_setc.f90 mlprec/impl/solver/mld_c_base_solver_setc.f90 mlprec/impl/solver/mld_d_base_solver_setc.f90 mlprec/impl/solver/mld_s_base_solver_setc.f90 mlprec/impl/solver/mld_z_base_solver_setc.f90 mlprec/mld_base_prec_type.F90 mlprec/mld_c_ilu_solver.f90 mlprec/mld_c_jac_smoother.f90 mlprec/mld_c_slu_solver.F90 mlprec/mld_c_sludist_solver.F90 mlprec/mld_c_umf_solver.F90 mlprec/mld_d_ilu_solver.f90 mlprec/mld_d_jac_smoother.f90 mlprec/mld_d_slu_solver.F90 mlprec/mld_d_sludist_solver.F90 mlprec/mld_d_umf_solver.F90 mlprec/mld_s_ilu_solver.f90 mlprec/mld_s_jac_smoother.f90 mlprec/mld_s_slu_solver.F90 mlprec/mld_s_sludist_solver.F90 mlprec/mld_s_umf_solver.F90 mlprec/mld_z_ilu_solver.f90 mlprec/mld_z_jac_smoother.f90 mlprec/mld_z_slu_solver.F90 mlprec/mld_z_sludist_solver.F90 mlprec/mld_z_umf_solver.F90 First step of reworking SET routines. --- mlprec/impl/level/mld_c_base_onelev_setc.f90 | 11 +++++++++-- mlprec/impl/level/mld_d_base_onelev_setc.f90 | 11 +++++++++-- mlprec/impl/level/mld_s_base_onelev_setc.f90 | 11 +++++++++-- mlprec/impl/level/mld_z_base_onelev_setc.f90 | 11 +++++++++-- mlprec/impl/mld_cprecset.F90 | 4 ++-- mlprec/impl/mld_dprecset.F90 | 4 ++-- mlprec/impl/mld_sprecset.F90 | 4 ++-- mlprec/impl/mld_zprecset.F90 | 5 ++--- mlprec/impl/smoother/mld_c_as_smoother_setc.f90 | 11 +++++++++-- mlprec/impl/smoother/mld_c_base_smoother_setc.f90 | 12 +++++++++--- mlprec/impl/smoother/mld_d_as_smoother_setc.f90 | 11 +++++++++-- mlprec/impl/smoother/mld_d_base_smoother_setc.f90 | 12 +++++++++--- mlprec/impl/smoother/mld_s_as_smoother_setc.f90 | 11 +++++++++-- mlprec/impl/smoother/mld_s_base_smoother_setc.f90 | 12 +++++++++--- mlprec/impl/smoother/mld_z_as_smoother_setc.f90 | 11 +++++++++-- mlprec/impl/smoother/mld_z_base_smoother_setc.f90 | 12 +++++++++--- mlprec/impl/solver/mld_c_base_solver_setc.f90 | 6 ++++-- mlprec/impl/solver/mld_d_base_solver_setc.f90 | 6 ++++-- mlprec/impl/solver/mld_s_base_solver_setc.f90 | 6 ++++-- mlprec/impl/solver/mld_z_base_solver_setc.f90 | 6 ++++-- mlprec/mld_base_prec_type.F90 | 15 ++++----------- mlprec/mld_c_ilu_solver.f90 | 7 +++++-- mlprec/mld_c_jac_smoother.f90 | 11 +++++++++-- mlprec/mld_c_slu_solver.F90 | 6 ++++-- mlprec/mld_c_sludist_solver.F90 | 6 ++++-- mlprec/mld_c_umf_solver.F90 | 6 ++++-- mlprec/mld_d_ilu_solver.f90 | 7 +++++-- mlprec/mld_d_jac_smoother.f90 | 11 +++++++++-- mlprec/mld_d_slu_solver.F90 | 7 ++++--- mlprec/mld_d_sludist_solver.F90 | 7 ++++--- mlprec/mld_d_umf_solver.F90 | 7 ++++--- mlprec/mld_s_ilu_solver.f90 | 7 +++++-- mlprec/mld_s_jac_smoother.f90 | 11 +++++++++-- mlprec/mld_s_slu_solver.F90 | 7 ++++--- mlprec/mld_s_sludist_solver.F90 | 7 ++++--- mlprec/mld_s_umf_solver.F90 | 7 ++++--- mlprec/mld_z_ilu_solver.f90 | 7 +++++-- mlprec/mld_z_jac_smoother.f90 | 11 +++++++++-- mlprec/mld_z_slu_solver.F90 | 7 ++++--- mlprec/mld_z_sludist_solver.F90 | 7 ++++--- mlprec/mld_z_umf_solver.F90 | 7 ++++--- 41 files changed, 240 insertions(+), 105 deletions(-) diff --git a/mlprec/impl/level/mld_c_base_onelev_setc.f90 b/mlprec/impl/level/mld_c_base_onelev_setc.f90 index bf0930ec..abc53594 100644 --- a/mlprec/impl/level/mld_c_base_onelev_setc.f90 +++ b/mlprec/impl/level/mld_c_base_onelev_setc.f90 @@ -56,8 +56,15 @@ subroutine mld_c_base_onelev_setc(lv,what,val,info) info = psb_success_ - call mld_stringval(val,ival,info) - if (info == psb_success_) call lv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >= 0) then + call lv%set(what,ival,info) + else + if (allocated(lv%sm)) then + call lv%sm%set(what,val,info) + end if + end if + if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/level/mld_d_base_onelev_setc.f90 b/mlprec/impl/level/mld_d_base_onelev_setc.f90 index 452f3cec..1b4ccc20 100644 --- a/mlprec/impl/level/mld_d_base_onelev_setc.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_setc.f90 @@ -56,8 +56,15 @@ subroutine mld_d_base_onelev_setc(lv,what,val,info) info = psb_success_ - call mld_stringval(val,ival,info) - if (info == psb_success_) call lv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >= 0) then + call lv%set(what,ival,info) + else + if (allocated(lv%sm)) then + call lv%sm%set(what,val,info) + end if + end if + if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/level/mld_s_base_onelev_setc.f90 b/mlprec/impl/level/mld_s_base_onelev_setc.f90 index 33e0779a..271d2de2 100644 --- a/mlprec/impl/level/mld_s_base_onelev_setc.f90 +++ b/mlprec/impl/level/mld_s_base_onelev_setc.f90 @@ -56,8 +56,15 @@ subroutine mld_s_base_onelev_setc(lv,what,val,info) info = psb_success_ - call mld_stringval(val,ival,info) - if (info == psb_success_) call lv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >= 0) then + call lv%set(what,ival,info) + else + if (allocated(lv%sm)) then + call lv%sm%set(what,val,info) + end if + end if + if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/level/mld_z_base_onelev_setc.f90 b/mlprec/impl/level/mld_z_base_onelev_setc.f90 index c3146d16..9048ad5d 100644 --- a/mlprec/impl/level/mld_z_base_onelev_setc.f90 +++ b/mlprec/impl/level/mld_z_base_onelev_setc.f90 @@ -56,8 +56,15 @@ subroutine mld_z_base_onelev_setc(lv,what,val,info) info = psb_success_ - call mld_stringval(val,ival,info) - if (info == psb_success_) call lv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >= 0) then + call lv%set(what,ival,info) + else + if (allocated(lv%sm)) then + call lv%sm%set(what,val,info) + end if + end if + if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/mld_cprecset.F90 b/mlprec/impl/mld_cprecset.F90 index 38fed9c6..c0dad3bd 100644 --- a/mlprec/impl/mld_cprecset.F90 +++ b/mlprec/impl/mld_cprecset.F90 @@ -776,8 +776,8 @@ subroutine mld_cprecsetc(p,what,string,info,ilev) return endif - call mld_stringval(string,val,info) - if (info == psb_success_) call mld_inner_precset(p,what,val,info,ilev=ilev) + val = mld_stringval(string) + if (val >=0) call mld_inner_precset(p,what,val,info,ilev=ilev) end subroutine mld_cprecsetc diff --git a/mlprec/impl/mld_dprecset.F90 b/mlprec/impl/mld_dprecset.F90 index eb8eda85..91ccf47f 100644 --- a/mlprec/impl/mld_dprecset.F90 +++ b/mlprec/impl/mld_dprecset.F90 @@ -776,8 +776,8 @@ subroutine mld_dprecsetc(p,what,string,info,ilev) return endif - call mld_stringval(string,val,info) - if (info == psb_success_) call mld_inner_precset(p,what,val,info,ilev=ilev) + val = mld_stringval(string) + if (val >=0) call mld_inner_precset(p,what,val,info,ilev=ilev) end subroutine mld_dprecsetc diff --git a/mlprec/impl/mld_sprecset.F90 b/mlprec/impl/mld_sprecset.F90 index 32daf90f..a4c00054 100644 --- a/mlprec/impl/mld_sprecset.F90 +++ b/mlprec/impl/mld_sprecset.F90 @@ -776,8 +776,8 @@ subroutine mld_sprecsetc(p,what,string,info,ilev) return endif - call mld_stringval(string,val,info) - if (info == psb_success_) call mld_inner_precset(p,what,val,info,ilev=ilev) + val = mld_stringval(string) + if (val >=0) call mld_inner_precset(p,what,val,info,ilev=ilev) end subroutine mld_sprecsetc diff --git a/mlprec/impl/mld_zprecset.F90 b/mlprec/impl/mld_zprecset.F90 index eecdeda7..7ad85d8e 100644 --- a/mlprec/impl/mld_zprecset.F90 +++ b/mlprec/impl/mld_zprecset.F90 @@ -776,9 +776,8 @@ subroutine mld_zprecsetc(p,what,string,info,ilev) return endif - call mld_stringval(string,val,info) - if (info == psb_success_) call mld_inner_precset(p,what,val,info,ilev=ilev) - + val = mld_stringval(string) + if (val >=0) call mld_inner_precset(p,what,val,info,ilev=ilev) end subroutine mld_zprecsetc diff --git a/mlprec/impl/smoother/mld_c_as_smoother_setc.f90 b/mlprec/impl/smoother/mld_c_as_smoother_setc.f90 index a6f7ae71..9c9fb302 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_setc.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_setc.f90 @@ -53,8 +53,15 @@ subroutine mld_c_as_smoother_setc(sm,what,val,info) call psb_erractionsave(err_act) - call mld_stringval(val,ival,info) - if (info == psb_success_) call sm%set(what,ival,info) + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + end if + if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/impl/smoother/mld_c_base_smoother_setc.f90 b/mlprec/impl/smoother/mld_c_base_smoother_setc.f90 index a5a8d33e..f8f59827 100644 --- a/mlprec/impl/smoother/mld_c_base_smoother_setc.f90 +++ b/mlprec/impl/smoother/mld_c_base_smoother_setc.f90 @@ -47,16 +47,22 @@ subroutine mld_c_base_smoother_setc(sm,what,val,info) integer(psb_ipk_), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: err_act, ival character(len=20) :: name='c_base_smoother_setc' call psb_erractionsave(err_act) info = psb_success_ - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if end if + if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) diff --git a/mlprec/impl/smoother/mld_d_as_smoother_setc.f90 b/mlprec/impl/smoother/mld_d_as_smoother_setc.f90 index 5204c52c..a6b04c59 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_setc.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_setc.f90 @@ -53,8 +53,15 @@ subroutine mld_d_as_smoother_setc(sm,what,val,info) call psb_erractionsave(err_act) - call mld_stringval(val,ival,info) - if (info == psb_success_) call sm%set(what,ival,info) + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + end if + if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/impl/smoother/mld_d_base_smoother_setc.f90 b/mlprec/impl/smoother/mld_d_base_smoother_setc.f90 index d9029a10..83bb75b8 100644 --- a/mlprec/impl/smoother/mld_d_base_smoother_setc.f90 +++ b/mlprec/impl/smoother/mld_d_base_smoother_setc.f90 @@ -47,16 +47,22 @@ subroutine mld_d_base_smoother_setc(sm,what,val,info) integer(psb_ipk_), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: err_act, ival character(len=20) :: name='d_base_smoother_setc' call psb_erractionsave(err_act) info = psb_success_ - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if end if + if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) diff --git a/mlprec/impl/smoother/mld_s_as_smoother_setc.f90 b/mlprec/impl/smoother/mld_s_as_smoother_setc.f90 index 200f1f91..c59d7002 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_setc.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_setc.f90 @@ -53,8 +53,15 @@ subroutine mld_s_as_smoother_setc(sm,what,val,info) call psb_erractionsave(err_act) - call mld_stringval(val,ival,info) - if (info == psb_success_) call sm%set(what,ival,info) + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + end if + if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/impl/smoother/mld_s_base_smoother_setc.f90 b/mlprec/impl/smoother/mld_s_base_smoother_setc.f90 index 88c53f61..4a3359ee 100644 --- a/mlprec/impl/smoother/mld_s_base_smoother_setc.f90 +++ b/mlprec/impl/smoother/mld_s_base_smoother_setc.f90 @@ -47,16 +47,22 @@ subroutine mld_s_base_smoother_setc(sm,what,val,info) integer(psb_ipk_), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: err_act, ival character(len=20) :: name='s_base_smoother_setc' call psb_erractionsave(err_act) info = psb_success_ - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if end if + if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) diff --git a/mlprec/impl/smoother/mld_z_as_smoother_setc.f90 b/mlprec/impl/smoother/mld_z_as_smoother_setc.f90 index 97cc59d6..a37467c0 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_setc.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_setc.f90 @@ -53,8 +53,15 @@ subroutine mld_z_as_smoother_setc(sm,what,val,info) call psb_erractionsave(err_act) - call mld_stringval(val,ival,info) - if (info == psb_success_) call sm%set(what,ival,info) + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + end if + if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/impl/smoother/mld_z_base_smoother_setc.f90 b/mlprec/impl/smoother/mld_z_base_smoother_setc.f90 index ef9adc86..8216e6a6 100644 --- a/mlprec/impl/smoother/mld_z_base_smoother_setc.f90 +++ b/mlprec/impl/smoother/mld_z_base_smoother_setc.f90 @@ -47,16 +47,22 @@ subroutine mld_z_base_smoother_setc(sm,what,val,info) integer(psb_ipk_), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: err_act, ival character(len=20) :: name='z_base_smoother_setc' call psb_erractionsave(err_act) info = psb_success_ - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if end if + if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) diff --git a/mlprec/impl/solver/mld_c_base_solver_setc.f90 b/mlprec/impl/solver/mld_c_base_solver_setc.f90 index 8b28de71..7bea2b8f 100644 --- a/mlprec/impl/solver/mld_c_base_solver_setc.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_setc.f90 @@ -53,8 +53,10 @@ subroutine mld_c_base_solver_setc(sv,what,val,info) info = psb_success_ - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/solver/mld_d_base_solver_setc.f90 b/mlprec/impl/solver/mld_d_base_solver_setc.f90 index 85fd63eb..7b827a72 100644 --- a/mlprec/impl/solver/mld_d_base_solver_setc.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_setc.f90 @@ -53,8 +53,10 @@ subroutine mld_d_base_solver_setc(sv,what,val,info) info = psb_success_ - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/solver/mld_s_base_solver_setc.f90 b/mlprec/impl/solver/mld_s_base_solver_setc.f90 index 42e56d6f..915c6b7f 100644 --- a/mlprec/impl/solver/mld_s_base_solver_setc.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_setc.f90 @@ -53,8 +53,10 @@ subroutine mld_s_base_solver_setc(sv,what,val,info) info = psb_success_ - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if if (info /= psb_success_) goto 9999 diff --git a/mlprec/impl/solver/mld_z_base_solver_setc.f90 b/mlprec/impl/solver/mld_z_base_solver_setc.f90 index 44a17e99..500dde36 100644 --- a/mlprec/impl/solver/mld_z_base_solver_setc.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_setc.f90 @@ -53,8 +53,10 @@ subroutine mld_z_base_solver_setc(sv,what,val,info) info = psb_success_ - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if if (info /= psb_success_) goto 9999 diff --git a/mlprec/mld_base_prec_type.F90 b/mlprec/mld_base_prec_type.F90 index c537e1e3..500f471e 100644 --- a/mlprec/mld_base_prec_type.F90 +++ b/mlprec/mld_base_prec_type.F90 @@ -332,7 +332,7 @@ module mld_base_prec_type contains ! - ! Subroutine: mld_stringval + ! Function: mld_stringval ! ! This routine converts the string contained into string into the corresponding ! integer value. @@ -342,17 +342,14 @@ contains ! The string to be converted. ! val - integer, output. ! The integer value corresponding to the string - ! info - integer, output. - ! Error code. ! - subroutine mld_stringval(string,val,info) + function mld_stringval(string) result(val) implicit none ! Arguments character(len=*), intent(in) :: string - integer(psb_ipk_), intent(out) :: val, info + integer(psb_ipk_) :: val character(len=*), parameter :: name='mld_stringval' - info = psb_success_ select case(psb_toupper(trim(string))) case('NONE') val = 0 @@ -432,12 +429,8 @@ contains val = mld_no_filter_mat_ case default val = -1 - info = -1 end select - if (info /= psb_success_) then - write(0,*) name,': Error: unknown request: "',trim(string),'"' - end if - end subroutine mld_stringval + end function mld_stringval diff --git a/mlprec/mld_c_ilu_solver.f90 b/mlprec/mld_c_ilu_solver.f90 index 48c7ae51..75b28d8e 100644 --- a/mlprec/mld_c_ilu_solver.f90 +++ b/mlprec/mld_c_ilu_solver.f90 @@ -260,8 +260,11 @@ contains call psb_erractionsave(err_act) - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >= 0) then + call sv%set(what,ival,info) + end if + if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_c_jac_smoother.f90 b/mlprec/mld_c_jac_smoother.f90 index d55816e3..6d2268f0 100644 --- a/mlprec/mld_c_jac_smoother.f90 +++ b/mlprec/mld_c_jac_smoother.f90 @@ -174,8 +174,15 @@ contains call psb_erractionsave(err_act) - call mld_stringval(val,ival,info) - if (info == psb_success_) call sm%set(what,ival,info) + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + end if + if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_c_slu_solver.F90 b/mlprec/mld_c_slu_solver.F90 index 57db8dcb..e636e0e0 100644 --- a/mlprec/mld_c_slu_solver.F90 +++ b/mlprec/mld_c_slu_solver.F90 @@ -323,8 +323,10 @@ contains call psb_erractionsave(err_act) - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_c_sludist_solver.F90 b/mlprec/mld_c_sludist_solver.F90 index 44167a11..bd936892 100644 --- a/mlprec/mld_c_sludist_solver.F90 +++ b/mlprec/mld_c_sludist_solver.F90 @@ -330,8 +330,10 @@ contains call psb_erractionsave(err_act) - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_c_umf_solver.F90 b/mlprec/mld_c_umf_solver.F90 index 66d7766e..2a5a41be 100644 --- a/mlprec/mld_c_umf_solver.F90 +++ b/mlprec/mld_c_umf_solver.F90 @@ -324,8 +324,10 @@ contains call psb_erractionsave(err_act) - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_d_ilu_solver.f90 b/mlprec/mld_d_ilu_solver.f90 index c706d350..3e1dffdf 100644 --- a/mlprec/mld_d_ilu_solver.f90 +++ b/mlprec/mld_d_ilu_solver.f90 @@ -260,8 +260,11 @@ contains call psb_erractionsave(err_act) - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >= 0) then + call sv%set(what,ival,info) + end if + if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_d_jac_smoother.f90 b/mlprec/mld_d_jac_smoother.f90 index c1021d0b..492a191e 100644 --- a/mlprec/mld_d_jac_smoother.f90 +++ b/mlprec/mld_d_jac_smoother.f90 @@ -174,8 +174,15 @@ contains call psb_erractionsave(err_act) - call mld_stringval(val,ival,info) - if (info == psb_success_) call sm%set(what,ival,info) + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + end if + if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_d_slu_solver.F90 b/mlprec/mld_d_slu_solver.F90 index f72f80ec..22abb0e8 100644 --- a/mlprec/mld_d_slu_solver.F90 +++ b/mlprec/mld_d_slu_solver.F90 @@ -322,9 +322,10 @@ contains info = psb_success_ call psb_erractionsave(err_act) - - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_d_sludist_solver.F90 b/mlprec/mld_d_sludist_solver.F90 index 40f168e4..7a93613f 100644 --- a/mlprec/mld_d_sludist_solver.F90 +++ b/mlprec/mld_d_sludist_solver.F90 @@ -327,9 +327,10 @@ contains info = psb_success_ call psb_erractionsave(err_act) - - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_d_umf_solver.F90 b/mlprec/mld_d_umf_solver.F90 index 07a12574..d240e156 100644 --- a/mlprec/mld_d_umf_solver.F90 +++ b/mlprec/mld_d_umf_solver.F90 @@ -323,9 +323,10 @@ contains info = psb_success_ call psb_erractionsave(err_act) - - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_s_ilu_solver.f90 b/mlprec/mld_s_ilu_solver.f90 index d70415d2..b34d6efc 100644 --- a/mlprec/mld_s_ilu_solver.f90 +++ b/mlprec/mld_s_ilu_solver.f90 @@ -260,8 +260,11 @@ contains call psb_erractionsave(err_act) - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >= 0) then + call sv%set(what,ival,info) + end if + if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_s_jac_smoother.f90 b/mlprec/mld_s_jac_smoother.f90 index 5492aa8f..8312c2b5 100644 --- a/mlprec/mld_s_jac_smoother.f90 +++ b/mlprec/mld_s_jac_smoother.f90 @@ -174,8 +174,15 @@ contains call psb_erractionsave(err_act) - call mld_stringval(val,ival,info) - if (info == psb_success_) call sm%set(what,ival,info) + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + end if + if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_s_slu_solver.F90 b/mlprec/mld_s_slu_solver.F90 index 57a0c790..92e89582 100644 --- a/mlprec/mld_s_slu_solver.F90 +++ b/mlprec/mld_s_slu_solver.F90 @@ -324,9 +324,10 @@ contains info = psb_success_ call psb_erractionsave(err_act) - - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_s_sludist_solver.F90 b/mlprec/mld_s_sludist_solver.F90 index 1ebc5b14..bbe9f0d4 100644 --- a/mlprec/mld_s_sludist_solver.F90 +++ b/mlprec/mld_s_sludist_solver.F90 @@ -327,9 +327,10 @@ contains info = psb_success_ call psb_erractionsave(err_act) - - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_s_umf_solver.F90 b/mlprec/mld_s_umf_solver.F90 index dcd824a9..ecf0272b 100644 --- a/mlprec/mld_s_umf_solver.F90 +++ b/mlprec/mld_s_umf_solver.F90 @@ -325,9 +325,10 @@ contains info = psb_success_ call psb_erractionsave(err_act) - - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_z_ilu_solver.f90 b/mlprec/mld_z_ilu_solver.f90 index 8a1e449d..2808bbce 100644 --- a/mlprec/mld_z_ilu_solver.f90 +++ b/mlprec/mld_z_ilu_solver.f90 @@ -260,8 +260,11 @@ contains call psb_erractionsave(err_act) - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >= 0) then + call sv%set(what,ival,info) + end if + if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_z_jac_smoother.f90 b/mlprec/mld_z_jac_smoother.f90 index 3b65df85..3692b596 100644 --- a/mlprec/mld_z_jac_smoother.f90 +++ b/mlprec/mld_z_jac_smoother.f90 @@ -174,8 +174,15 @@ contains call psb_erractionsave(err_act) - call mld_stringval(val,ival,info) - if (info == psb_success_) call sm%set(what,ival,info) + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + end if + if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_z_slu_solver.F90 b/mlprec/mld_z_slu_solver.F90 index 3d30665f..015f29ad 100644 --- a/mlprec/mld_z_slu_solver.F90 +++ b/mlprec/mld_z_slu_solver.F90 @@ -326,9 +326,10 @@ contains info = psb_success_ call psb_erractionsave(err_act) - - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_z_sludist_solver.F90 b/mlprec/mld_z_sludist_solver.F90 index e927e760..4ac9a972 100644 --- a/mlprec/mld_z_sludist_solver.F90 +++ b/mlprec/mld_z_sludist_solver.F90 @@ -328,9 +328,10 @@ contains info = psb_success_ call psb_erractionsave(err_act) - - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name) diff --git a/mlprec/mld_z_umf_solver.F90 b/mlprec/mld_z_umf_solver.F90 index 33d48d40..c1b81124 100644 --- a/mlprec/mld_z_umf_solver.F90 +++ b/mlprec/mld_z_umf_solver.F90 @@ -326,9 +326,10 @@ contains info = psb_success_ call psb_erractionsave(err_act) - - call mld_stringval(val,ival,info) - if (info == psb_success_) call sv%set(what,ival,info) + ival = mld_stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if if (info /= psb_success_) then info = psb_err_from_subroutine_ call psb_errpush(info, name)