diff --git a/mlprec/impl/level/Makefile b/mlprec/impl/level/Makefile index 9cb12928..8ce9264f 100644 --- a/mlprec/impl/level/Makefile +++ b/mlprec/impl/level/Makefile @@ -19,9 +19,6 @@ mld_c_base_onelev_dump.o \ mld_c_base_onelev_free.o \ mld_c_base_onelev_mat_asb.o \ mld_c_base_onelev_setag.o \ -mld_c_base_onelev_setc.o \ -mld_c_base_onelev_seti.o \ -mld_c_base_onelev_setr.o \ mld_c_base_onelev_setsm.o \ mld_c_base_onelev_setsv.o \ mld_d_base_onelev_build.o \ @@ -35,9 +32,6 @@ mld_d_base_onelev_dump.o \ mld_d_base_onelev_free.o \ mld_d_base_onelev_mat_asb.o \ mld_d_base_onelev_setag.o \ -mld_d_base_onelev_setc.o \ -mld_d_base_onelev_seti.o \ -mld_d_base_onelev_setr.o \ mld_d_base_onelev_setsm.o \ mld_d_base_onelev_setsv.o \ mld_s_base_onelev_build.o \ @@ -51,9 +45,6 @@ mld_s_base_onelev_dump.o \ mld_s_base_onelev_free.o \ mld_s_base_onelev_mat_asb.o \ mld_s_base_onelev_setag.o \ -mld_s_base_onelev_setc.o \ -mld_s_base_onelev_seti.o \ -mld_s_base_onelev_setr.o \ mld_s_base_onelev_setsm.o \ mld_s_base_onelev_setsv.o \ mld_z_base_onelev_build.o \ @@ -67,12 +58,10 @@ mld_z_base_onelev_dump.o \ mld_z_base_onelev_free.o \ mld_z_base_onelev_mat_asb.o \ mld_z_base_onelev_setag.o \ -mld_z_base_onelev_setc.o \ -mld_z_base_onelev_seti.o \ -mld_z_base_onelev_setr.o \ mld_z_base_onelev_setsm.o \ mld_z_base_onelev_setsv.o + LIBNAME=libmld_prec.a lib: $(OBJS) diff --git a/mlprec/impl/level/mld_c_base_onelev_setc.f90 b/mlprec/impl/level/mld_c_base_onelev_setc.f90 deleted file mode 100644 index 93b8ff9c..00000000 --- a/mlprec/impl/level/mld_c_base_onelev_setc.f90 +++ /dev/null @@ -1,99 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_c_base_onelev_setc(lv,what,val,info,pos) - - use psb_base_mod - use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_setc - - Implicit None - - ! Arguments - class(mld_c_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='c_base_onelev_setc' - integer(psb_ipk_) :: ival - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = lv%stringval(val) - if (ival >= 0) then - call lv%set(what,ival,info,pos=pos) - else - - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end if - - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_c_base_onelev_setc diff --git a/mlprec/impl/level/mld_c_base_onelev_seti.F90 b/mlprec/impl/level/mld_c_base_onelev_seti.F90 deleted file mode 100644 index 534915cc..00000000 --- a/mlprec/impl/level/mld_c_base_onelev_seti.F90 +++ /dev/null @@ -1,253 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_c_base_onelev_seti(lv,what,val,info,pos) - - use psb_base_mod - use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_seti - use mld_c_base_aggregator_mod - use mld_c_dec_aggregator_mod - use mld_c_symdec_aggregator_mod - use mld_c_jac_smoother - use mld_c_as_smoother - use mld_c_diag_solver - use mld_c_ilu_solver - use mld_c_id_solver - use mld_c_gs_solver -#if defined(HAVE_SLU_) - use mld_c_slu_solver -#endif -#if defined(HAVE_MUMPS_) - use mld_c_mumps_solver -#endif - - Implicit None - - ! Arguments - class(mld_c_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='c_base_onelev_seti' - type(mld_c_base_smoother_type) :: mld_c_base_smoother_mold - type(mld_c_jac_smoother_type) :: mld_c_jac_smoother_mold - type(mld_c_as_smoother_type) :: mld_c_as_smoother_mold - type(mld_c_diag_solver_type) :: mld_c_diag_solver_mold - type(mld_c_ilu_solver_type) :: mld_c_ilu_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_bwgs_solver_type) :: mld_c_bwgs_solver_mold -#if defined(HAVE_SLU_) - type(mld_c_slu_solver_type) :: mld_c_slu_solver_mold -#endif -#if defined(HAVE_MUMPS_) - type(mld_c_mumps_solver_type) :: mld_c_mumps_solver_mold -#endif - - call psb_erractionsave(err_act) - info = psb_success_ - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - select case (what) - - case (mld_smoother_type_) - select case (val) - case (mld_noprec_) - call lv%set(mld_c_base_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_c_id_solver_mold,info,pos=pos) - - case (mld_jac_) - call lv%set(mld_c_jac_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_c_diag_solver_mold,info,pos=pos) - - case (mld_bjac_) - call lv%set(mld_c_jac_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_c_ilu_solver_mold,info,pos=pos) - - case (mld_as_) - call lv%set(mld_c_as_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_c_ilu_solver_mold,info,pos=pos) - - case (mld_fbgs_) - call lv%set(mld_c_jac_smoother_mold,info,pos='pre') - if (info == 0) call lv%set(mld_c_gs_solver_mold,info,pos='pre') - if (info == 0) call lv%set(mld_c_jac_smoother_mold,info,pos='post') - if (info == 0) call lv%set(mld_c_bwgs_solver_mold,info,pos='post') - - - case default - ! - ! Do nothing and hope for the best :) - ! - end select - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) call lv%sm%default() - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) call lv%sm2a%default() - end if - - - case(mld_sub_solve_) - select case (val) - case (mld_f_none_) - call lv%set(mld_c_id_solver_mold,info,pos=pos) - - case (mld_diag_scale_) - call lv%set(mld_c_diag_solver_mold,info,pos=pos) - - case (mld_gs_) - call lv%set(mld_c_gs_solver_mold,info,pos=pos) - - case (mld_bwgs_) - call lv%set(mld_c_bwgs_solver_mold,info,pos=pos) - - case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) - call lv%set(mld_c_ilu_solver_mold,info,pos=pos) - if (info == 0) then - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - call lv%sm%sv%set('SUB_SOLVE',val,info) - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) - end if - end if -#ifdef HAVE_SLU_ - case (mld_slu_) - call lv%set(mld_c_slu_solver_mold,info,pos=pos) -#endif -#ifdef HAVE_MUMPS_ - case (mld_mumps_) - call lv%set(mld_c_mumps_solver_mold,info,pos=pos) -#endif - case default - ! - ! Do nothing and hope for the best :) - ! - end select - - case (mld_smoother_sweeps_) - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) & - & lv%parms%sweeps_pre = val - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) & - & lv%parms%sweeps_post = val - - case (mld_ml_cycle_) - lv%parms%ml_cycle = val - - case (mld_par_aggr_alg_) - lv%parms%par_aggr_alg = val - if (allocated(lv%aggr)) then - call lv%aggr%free(info) - if (info == 0) deallocate(lv%aggr,stat=info) - if (info /= 0) then - info = psb_err_internal_error_ - return - end if - end if - - select case(val) - case(mld_dec_aggr_) - allocate(mld_c_dec_aggregator_type :: lv%aggr, stat=info) - case(mld_sym_dec_aggr_) - allocate(mld_c_symdec_aggregator_type :: lv%aggr, stat=info) - case default - info = psb_err_internal_error_ - end select - if (info == psb_success_) call lv%aggr%default() - - case (mld_aggr_ord_) - lv%parms%aggr_ord = val - - case (mld_aggr_type_) - lv%parms%aggr_type = val - if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info) - - case (mld_aggr_prol_) - lv%parms%aggr_prol = val - - case (mld_coarse_mat_) - lv%parms%coarse_mat = val - - case (mld_aggr_omega_alg_) - lv%parms%aggr_omega_alg= val - - case (mld_aggr_eig_) - lv%parms%aggr_eig = val - - case (mld_aggr_filter_) - lv%parms%aggr_filter = val - - case (mld_coarse_solve_) - lv%parms%coarse_solve = val - - case default - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end select - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_c_base_onelev_seti diff --git a/mlprec/impl/level/mld_c_base_onelev_setr.f90 b/mlprec/impl/level/mld_c_base_onelev_setr.f90 deleted file mode 100644 index adfd71ba..00000000 --- a/mlprec/impl/level/mld_c_base_onelev_setr.f90 +++ /dev/null @@ -1,104 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_c_base_onelev_setr(lv,what,val,info,pos) - - use psb_base_mod - use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_setr - - Implicit None - - ! Arguments - class(mld_c_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='c_base_onelev_setr' - - call psb_erractionsave(err_act) - - - info = psb_success_ - - select case (what) - - case (mld_aggr_omega_val_) - lv%parms%aggr_omega_val= val - - case (mld_aggr_thresh_) - lv%parms%aggr_thresh = val - - case default - - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end select - - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_c_base_onelev_setr diff --git a/mlprec/impl/level/mld_d_base_onelev_cseti.F90 b/mlprec/impl/level/mld_d_base_onelev_cseti.F90 index 18691606..d76c5b59 100644 --- a/mlprec/impl/level/mld_d_base_onelev_cseti.F90 +++ b/mlprec/impl/level/mld_d_base_onelev_cseti.F90 @@ -260,8 +260,7 @@ subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos) call lv%sm2a%set(what,val,info) end if end if - if (allocated(lv%aggr)) call lv%aggr%set(what,val,info) - + end select if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) diff --git a/mlprec/impl/level/mld_d_base_onelev_setag.f90 b/mlprec/impl/level/mld_d_base_onelev_setag.f90 index 8e09ceb1..c4c26cca 100644 --- a/mlprec/impl/level/mld_d_base_onelev_setag.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_setag.f90 @@ -76,7 +76,6 @@ subroutine mld_d_base_onelev_setag(lv,val,info,pos) lv%parms%par_aggr_alg = mld_ext_aggr_ lv%parms%aggr_type = mld_noalg_ end if - call lv%aggr%default() end subroutine mld_d_base_onelev_setag diff --git a/mlprec/impl/level/mld_d_base_onelev_setc.f90 b/mlprec/impl/level/mld_d_base_onelev_setc.f90 deleted file mode 100644 index 4b5f633b..00000000 --- a/mlprec/impl/level/mld_d_base_onelev_setc.f90 +++ /dev/null @@ -1,99 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_d_base_onelev_setc(lv,what,val,info,pos) - - use psb_base_mod - use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_setc - - Implicit None - - ! Arguments - class(mld_d_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='d_base_onelev_setc' - integer(psb_ipk_) :: ival - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = lv%stringval(val) - if (ival >= 0) then - call lv%set(what,ival,info,pos=pos) - else - - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end if - - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_d_base_onelev_setc diff --git a/mlprec/impl/level/mld_d_base_onelev_seti.F90 b/mlprec/impl/level/mld_d_base_onelev_seti.F90 deleted file mode 100644 index d68f2ec6..00000000 --- a/mlprec/impl/level/mld_d_base_onelev_seti.F90 +++ /dev/null @@ -1,273 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_d_base_onelev_seti(lv,what,val,info,pos) - - use psb_base_mod - use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_seti - use mld_d_base_aggregator_mod - use mld_d_dec_aggregator_mod - use mld_d_symdec_aggregator_mod - use mld_d_jac_smoother - use mld_d_as_smoother - use mld_d_diag_solver - use mld_d_ilu_solver - use mld_d_id_solver - use mld_d_gs_solver -#if defined(HAVE_UMF_) - use mld_d_umf_solver -#endif -#if defined(HAVE_SLUDIST_) - use mld_d_sludist_solver -#endif -#if defined(HAVE_SLU_) - use mld_d_slu_solver -#endif -#if defined(HAVE_MUMPS_) - use mld_d_mumps_solver -#endif - - Implicit None - - ! Arguments - class(mld_d_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='d_base_onelev_seti' - type(mld_d_base_smoother_type) :: mld_d_base_smoother_mold - type(mld_d_jac_smoother_type) :: mld_d_jac_smoother_mold - type(mld_d_as_smoother_type) :: mld_d_as_smoother_mold - type(mld_d_diag_solver_type) :: mld_d_diag_solver_mold - type(mld_d_ilu_solver_type) :: mld_d_ilu_solver_mold - type(mld_d_id_solver_type) :: mld_d_id_solver_mold - type(mld_d_gs_solver_type) :: mld_d_gs_solver_mold - type(mld_d_bwgs_solver_type) :: mld_d_bwgs_solver_mold -#if defined(HAVE_UMF_) - type(mld_d_umf_solver_type) :: mld_d_umf_solver_mold -#endif -#if defined(HAVE_SLUDIST_) - type(mld_d_sludist_solver_type) :: mld_d_sludist_solver_mold -#endif -#if defined(HAVE_SLU_) - type(mld_d_slu_solver_type) :: mld_d_slu_solver_mold -#endif -#if defined(HAVE_MUMPS_) - type(mld_d_mumps_solver_type) :: mld_d_mumps_solver_mold -#endif - - call psb_erractionsave(err_act) - info = psb_success_ - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - select case (what) - - case (mld_smoother_type_) - select case (val) - case (mld_noprec_) - call lv%set(mld_d_base_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_d_id_solver_mold,info,pos=pos) - - case (mld_jac_) - call lv%set(mld_d_jac_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_d_diag_solver_mold,info,pos=pos) - - case (mld_bjac_) - call lv%set(mld_d_jac_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_d_ilu_solver_mold,info,pos=pos) - - case (mld_as_) - call lv%set(mld_d_as_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_d_ilu_solver_mold,info,pos=pos) - - case (mld_fbgs_) - call lv%set(mld_d_jac_smoother_mold,info,pos='pre') - if (info == 0) call lv%set(mld_d_gs_solver_mold,info,pos='pre') - if (info == 0) call lv%set(mld_d_jac_smoother_mold,info,pos='post') - if (info == 0) call lv%set(mld_d_bwgs_solver_mold,info,pos='post') - - - case default - ! - ! Do nothing and hope for the best :) - ! - end select - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) call lv%sm%default() - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) call lv%sm2a%default() - end if - - - case(mld_sub_solve_) - select case (val) - case (mld_f_none_) - call lv%set(mld_d_id_solver_mold,info,pos=pos) - - case (mld_diag_scale_) - call lv%set(mld_d_diag_solver_mold,info,pos=pos) - - case (mld_gs_) - call lv%set(mld_d_gs_solver_mold,info,pos=pos) - - case (mld_bwgs_) - call lv%set(mld_d_bwgs_solver_mold,info,pos=pos) - - case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) - call lv%set(mld_d_ilu_solver_mold,info,pos=pos) - if (info == 0) then - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - call lv%sm%sv%set('SUB_SOLVE',val,info) - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) - end if - end if -#ifdef HAVE_SLU_ - case (mld_slu_) - call lv%set(mld_d_slu_solver_mold,info,pos=pos) -#endif -#ifdef HAVE_MUMPS_ - case (mld_mumps_) - call lv%set(mld_d_mumps_solver_mold,info,pos=pos) -#endif -#ifdef HAVE_SLUDIST_ - case (mld_sludist_) - call lv%set(mld_d_sludist_solver_mold,info,pos=pos) -#endif -#ifdef HAVE_UMF_ - case (mld_umf_) - call lv%set(mld_d_umf_solver_mold,info,pos=pos) -#endif - case default - ! - ! Do nothing and hope for the best :) - ! - end select - - case (mld_smoother_sweeps_) - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) & - & lv%parms%sweeps_pre = val - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) & - & lv%parms%sweeps_post = val - - case (mld_ml_cycle_) - lv%parms%ml_cycle = val - - case (mld_par_aggr_alg_) - lv%parms%par_aggr_alg = val - if (allocated(lv%aggr)) then - call lv%aggr%free(info) - if (info == 0) deallocate(lv%aggr,stat=info) - if (info /= 0) then - info = psb_err_internal_error_ - return - end if - end if - - select case(val) - case(mld_dec_aggr_) - allocate(mld_d_dec_aggregator_type :: lv%aggr, stat=info) - case(mld_sym_dec_aggr_) - allocate(mld_d_symdec_aggregator_type :: lv%aggr, stat=info) - case default - info = psb_err_internal_error_ - end select - if (info == psb_success_) call lv%aggr%default() - - case (mld_aggr_ord_) - lv%parms%aggr_ord = val - - case (mld_aggr_type_) - lv%parms%aggr_type = val - if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info) - - case (mld_aggr_prol_) - lv%parms%aggr_prol = val - - case (mld_coarse_mat_) - lv%parms%coarse_mat = val - - case (mld_aggr_omega_alg_) - lv%parms%aggr_omega_alg= val - - case (mld_aggr_eig_) - lv%parms%aggr_eig = val - - case (mld_aggr_filter_) - lv%parms%aggr_filter = val - - case (mld_coarse_solve_) - lv%parms%coarse_solve = val - - case default - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end select - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_d_base_onelev_seti diff --git a/mlprec/impl/level/mld_d_base_onelev_setr.f90 b/mlprec/impl/level/mld_d_base_onelev_setr.f90 deleted file mode 100644 index dfd96da7..00000000 --- a/mlprec/impl/level/mld_d_base_onelev_setr.f90 +++ /dev/null @@ -1,104 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_d_base_onelev_setr(lv,what,val,info,pos) - - use psb_base_mod - use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_setr - - Implicit None - - ! Arguments - class(mld_d_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='d_base_onelev_setr' - - call psb_erractionsave(err_act) - - - info = psb_success_ - - select case (what) - - case (mld_aggr_omega_val_) - lv%parms%aggr_omega_val= val - - case (mld_aggr_thresh_) - lv%parms%aggr_thresh = val - - case default - - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end select - - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_d_base_onelev_setr diff --git a/mlprec/impl/level/mld_s_base_onelev_setc.f90 b/mlprec/impl/level/mld_s_base_onelev_setc.f90 deleted file mode 100644 index 1093ce9a..00000000 --- a/mlprec/impl/level/mld_s_base_onelev_setc.f90 +++ /dev/null @@ -1,99 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_s_base_onelev_setc(lv,what,val,info,pos) - - use psb_base_mod - use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_setc - - Implicit None - - ! Arguments - class(mld_s_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='s_base_onelev_setc' - integer(psb_ipk_) :: ival - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = lv%stringval(val) - if (ival >= 0) then - call lv%set(what,ival,info,pos=pos) - else - - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end if - - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_s_base_onelev_setc diff --git a/mlprec/impl/level/mld_s_base_onelev_seti.F90 b/mlprec/impl/level/mld_s_base_onelev_seti.F90 deleted file mode 100644 index 7d12cf9b..00000000 --- a/mlprec/impl/level/mld_s_base_onelev_seti.F90 +++ /dev/null @@ -1,253 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_s_base_onelev_seti(lv,what,val,info,pos) - - use psb_base_mod - use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_seti - use mld_s_base_aggregator_mod - use mld_s_dec_aggregator_mod - use mld_s_symdec_aggregator_mod - use mld_s_jac_smoother - use mld_s_as_smoother - use mld_s_diag_solver - use mld_s_ilu_solver - use mld_s_id_solver - use mld_s_gs_solver -#if defined(HAVE_SLU_) - use mld_s_slu_solver -#endif -#if defined(HAVE_MUMPS_) - use mld_s_mumps_solver -#endif - - Implicit None - - ! Arguments - class(mld_s_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='s_base_onelev_seti' - type(mld_s_base_smoother_type) :: mld_s_base_smoother_mold - type(mld_s_jac_smoother_type) :: mld_s_jac_smoother_mold - type(mld_s_as_smoother_type) :: mld_s_as_smoother_mold - type(mld_s_diag_solver_type) :: mld_s_diag_solver_mold - type(mld_s_ilu_solver_type) :: mld_s_ilu_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_bwgs_solver_type) :: mld_s_bwgs_solver_mold -#if defined(HAVE_SLU_) - type(mld_s_slu_solver_type) :: mld_s_slu_solver_mold -#endif -#if defined(HAVE_MUMPS_) - type(mld_s_mumps_solver_type) :: mld_s_mumps_solver_mold -#endif - - call psb_erractionsave(err_act) - info = psb_success_ - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - select case (what) - - case (mld_smoother_type_) - select case (val) - case (mld_noprec_) - call lv%set(mld_s_base_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_s_id_solver_mold,info,pos=pos) - - case (mld_jac_) - call lv%set(mld_s_jac_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_s_diag_solver_mold,info,pos=pos) - - case (mld_bjac_) - call lv%set(mld_s_jac_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_s_ilu_solver_mold,info,pos=pos) - - case (mld_as_) - call lv%set(mld_s_as_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_s_ilu_solver_mold,info,pos=pos) - - case (mld_fbgs_) - call lv%set(mld_s_jac_smoother_mold,info,pos='pre') - if (info == 0) call lv%set(mld_s_gs_solver_mold,info,pos='pre') - if (info == 0) call lv%set(mld_s_jac_smoother_mold,info,pos='post') - if (info == 0) call lv%set(mld_s_bwgs_solver_mold,info,pos='post') - - - case default - ! - ! Do nothing and hope for the best :) - ! - end select - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) call lv%sm%default() - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) call lv%sm2a%default() - end if - - - case(mld_sub_solve_) - select case (val) - case (mld_f_none_) - call lv%set(mld_s_id_solver_mold,info,pos=pos) - - case (mld_diag_scale_) - call lv%set(mld_s_diag_solver_mold,info,pos=pos) - - case (mld_gs_) - call lv%set(mld_s_gs_solver_mold,info,pos=pos) - - case (mld_bwgs_) - call lv%set(mld_s_bwgs_solver_mold,info,pos=pos) - - case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) - call lv%set(mld_s_ilu_solver_mold,info,pos=pos) - if (info == 0) then - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - call lv%sm%sv%set('SUB_SOLVE',val,info) - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) - end if - end if -#ifdef HAVE_SLU_ - case (mld_slu_) - call lv%set(mld_s_slu_solver_mold,info,pos=pos) -#endif -#ifdef HAVE_MUMPS_ - case (mld_mumps_) - call lv%set(mld_s_mumps_solver_mold,info,pos=pos) -#endif - case default - ! - ! Do nothing and hope for the best :) - ! - end select - - case (mld_smoother_sweeps_) - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) & - & lv%parms%sweeps_pre = val - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) & - & lv%parms%sweeps_post = val - - case (mld_ml_cycle_) - lv%parms%ml_cycle = val - - case (mld_par_aggr_alg_) - lv%parms%par_aggr_alg = val - if (allocated(lv%aggr)) then - call lv%aggr%free(info) - if (info == 0) deallocate(lv%aggr,stat=info) - if (info /= 0) then - info = psb_err_internal_error_ - return - end if - end if - - select case(val) - case(mld_dec_aggr_) - allocate(mld_s_dec_aggregator_type :: lv%aggr, stat=info) - case(mld_sym_dec_aggr_) - allocate(mld_s_symdec_aggregator_type :: lv%aggr, stat=info) - case default - info = psb_err_internal_error_ - end select - if (info == psb_success_) call lv%aggr%default() - - case (mld_aggr_ord_) - lv%parms%aggr_ord = val - - case (mld_aggr_type_) - lv%parms%aggr_type = val - if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info) - - case (mld_aggr_prol_) - lv%parms%aggr_prol = val - - case (mld_coarse_mat_) - lv%parms%coarse_mat = val - - case (mld_aggr_omega_alg_) - lv%parms%aggr_omega_alg= val - - case (mld_aggr_eig_) - lv%parms%aggr_eig = val - - case (mld_aggr_filter_) - lv%parms%aggr_filter = val - - case (mld_coarse_solve_) - lv%parms%coarse_solve = val - - case default - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end select - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_s_base_onelev_seti diff --git a/mlprec/impl/level/mld_s_base_onelev_setr.f90 b/mlprec/impl/level/mld_s_base_onelev_setr.f90 deleted file mode 100644 index 2aeee09c..00000000 --- a/mlprec/impl/level/mld_s_base_onelev_setr.f90 +++ /dev/null @@ -1,104 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_s_base_onelev_setr(lv,what,val,info,pos) - - use psb_base_mod - use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_setr - - Implicit None - - ! Arguments - class(mld_s_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='s_base_onelev_setr' - - call psb_erractionsave(err_act) - - - info = psb_success_ - - select case (what) - - case (mld_aggr_omega_val_) - lv%parms%aggr_omega_val= val - - case (mld_aggr_thresh_) - lv%parms%aggr_thresh = val - - case default - - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end select - - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_s_base_onelev_setr diff --git a/mlprec/impl/level/mld_z_base_onelev_setc.f90 b/mlprec/impl/level/mld_z_base_onelev_setc.f90 deleted file mode 100644 index 137ee584..00000000 --- a/mlprec/impl/level/mld_z_base_onelev_setc.f90 +++ /dev/null @@ -1,99 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_z_base_onelev_setc(lv,what,val,info,pos) - - use psb_base_mod - use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_setc - - Implicit None - - ! Arguments - class(mld_z_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='z_base_onelev_setc' - integer(psb_ipk_) :: ival - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = lv%stringval(val) - if (ival >= 0) then - call lv%set(what,ival,info,pos=pos) - else - - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end if - - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_z_base_onelev_setc diff --git a/mlprec/impl/level/mld_z_base_onelev_seti.F90 b/mlprec/impl/level/mld_z_base_onelev_seti.F90 deleted file mode 100644 index bfba8765..00000000 --- a/mlprec/impl/level/mld_z_base_onelev_seti.F90 +++ /dev/null @@ -1,273 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_z_base_onelev_seti(lv,what,val,info,pos) - - use psb_base_mod - use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_seti - use mld_z_base_aggregator_mod - use mld_z_dec_aggregator_mod - use mld_z_symdec_aggregator_mod - use mld_z_jac_smoother - use mld_z_as_smoother - use mld_z_diag_solver - use mld_z_ilu_solver - use mld_z_id_solver - use mld_z_gs_solver -#if defined(HAVE_UMF_) - use mld_z_umf_solver -#endif -#if defined(HAVE_SLUDIST_) - use mld_z_sludist_solver -#endif -#if defined(HAVE_SLU_) - use mld_z_slu_solver -#endif -#if defined(HAVE_MUMPS_) - use mld_z_mumps_solver -#endif - - Implicit None - - ! Arguments - class(mld_z_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='z_base_onelev_seti' - type(mld_z_base_smoother_type) :: mld_z_base_smoother_mold - type(mld_z_jac_smoother_type) :: mld_z_jac_smoother_mold - type(mld_z_as_smoother_type) :: mld_z_as_smoother_mold - type(mld_z_diag_solver_type) :: mld_z_diag_solver_mold - type(mld_z_ilu_solver_type) :: mld_z_ilu_solver_mold - type(mld_z_id_solver_type) :: mld_z_id_solver_mold - type(mld_z_gs_solver_type) :: mld_z_gs_solver_mold - type(mld_z_bwgs_solver_type) :: mld_z_bwgs_solver_mold -#if defined(HAVE_UMF_) - type(mld_z_umf_solver_type) :: mld_z_umf_solver_mold -#endif -#if defined(HAVE_SLUDIST_) - type(mld_z_sludist_solver_type) :: mld_z_sludist_solver_mold -#endif -#if defined(HAVE_SLU_) - type(mld_z_slu_solver_type) :: mld_z_slu_solver_mold -#endif -#if defined(HAVE_MUMPS_) - type(mld_z_mumps_solver_type) :: mld_z_mumps_solver_mold -#endif - - call psb_erractionsave(err_act) - info = psb_success_ - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - select case (what) - - case (mld_smoother_type_) - select case (val) - case (mld_noprec_) - call lv%set(mld_z_base_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_z_id_solver_mold,info,pos=pos) - - case (mld_jac_) - call lv%set(mld_z_jac_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_z_diag_solver_mold,info,pos=pos) - - case (mld_bjac_) - call lv%set(mld_z_jac_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_z_ilu_solver_mold,info,pos=pos) - - case (mld_as_) - call lv%set(mld_z_as_smoother_mold,info,pos=pos) - if (info == 0) call lv%set(mld_z_ilu_solver_mold,info,pos=pos) - - case (mld_fbgs_) - call lv%set(mld_z_jac_smoother_mold,info,pos='pre') - if (info == 0) call lv%set(mld_z_gs_solver_mold,info,pos='pre') - if (info == 0) call lv%set(mld_z_jac_smoother_mold,info,pos='post') - if (info == 0) call lv%set(mld_z_bwgs_solver_mold,info,pos='post') - - - case default - ! - ! Do nothing and hope for the best :) - ! - end select - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) call lv%sm%default() - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) call lv%sm2a%default() - end if - - - case(mld_sub_solve_) - select case (val) - case (mld_f_none_) - call lv%set(mld_z_id_solver_mold,info,pos=pos) - - case (mld_diag_scale_) - call lv%set(mld_z_diag_solver_mold,info,pos=pos) - - case (mld_gs_) - call lv%set(mld_z_gs_solver_mold,info,pos=pos) - - case (mld_bwgs_) - call lv%set(mld_z_bwgs_solver_mold,info,pos=pos) - - case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) - call lv%set(mld_z_ilu_solver_mold,info,pos=pos) - if (info == 0) then - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - call lv%sm%sv%set('SUB_SOLVE',val,info) - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) call lv%sm2a%sv%set('SUB_SOLVE',val,info) - end if - end if -#ifdef HAVE_SLU_ - case (mld_slu_) - call lv%set(mld_z_slu_solver_mold,info,pos=pos) -#endif -#ifdef HAVE_MUMPS_ - case (mld_mumps_) - call lv%set(mld_z_mumps_solver_mold,info,pos=pos) -#endif -#ifdef HAVE_SLUDIST_ - case (mld_sludist_) - call lv%set(mld_z_sludist_solver_mold,info,pos=pos) -#endif -#ifdef HAVE_UMF_ - case (mld_umf_) - call lv%set(mld_z_umf_solver_mold,info,pos=pos) -#endif - case default - ! - ! Do nothing and hope for the best :) - ! - end select - - case (mld_smoother_sweeps_) - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) & - & lv%parms%sweeps_pre = val - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_)) & - & lv%parms%sweeps_post = val - - case (mld_ml_cycle_) - lv%parms%ml_cycle = val - - case (mld_par_aggr_alg_) - lv%parms%par_aggr_alg = val - if (allocated(lv%aggr)) then - call lv%aggr%free(info) - if (info == 0) deallocate(lv%aggr,stat=info) - if (info /= 0) then - info = psb_err_internal_error_ - return - end if - end if - - select case(val) - case(mld_dec_aggr_) - allocate(mld_z_dec_aggregator_type :: lv%aggr, stat=info) - case(mld_sym_dec_aggr_) - allocate(mld_z_symdec_aggregator_type :: lv%aggr, stat=info) - case default - info = psb_err_internal_error_ - end select - if (info == psb_success_) call lv%aggr%default() - - case (mld_aggr_ord_) - lv%parms%aggr_ord = val - - case (mld_aggr_type_) - lv%parms%aggr_type = val - if (allocated(lv%aggr)) call lv%aggr%set_aggr_type(lv%parms,info) - - case (mld_aggr_prol_) - lv%parms%aggr_prol = val - - case (mld_coarse_mat_) - lv%parms%coarse_mat = val - - case (mld_aggr_omega_alg_) - lv%parms%aggr_omega_alg= val - - case (mld_aggr_eig_) - lv%parms%aggr_eig = val - - case (mld_aggr_filter_) - lv%parms%aggr_filter = val - - case (mld_coarse_solve_) - lv%parms%coarse_solve = val - - case default - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end select - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_z_base_onelev_seti diff --git a/mlprec/impl/level/mld_z_base_onelev_setr.f90 b/mlprec/impl/level/mld_z_base_onelev_setr.f90 deleted file mode 100644 index f2303e41..00000000 --- a/mlprec/impl/level/mld_z_base_onelev_setr.f90 +++ /dev/null @@ -1,104 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_z_base_onelev_setr(lv,what,val,info,pos) - - use psb_base_mod - use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_setr - - Implicit None - - ! Arguments - class(mld_z_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - ! Local - integer(psb_ipk_) :: ipos_, err_act - character(len=20) :: name='z_base_onelev_setr' - - call psb_erractionsave(err_act) - - - info = psb_success_ - - select case (what) - - case (mld_aggr_omega_val_) - lv%parms%aggr_omega_val= val - - case (mld_aggr_thresh_) - lv%parms%aggr_thresh = val - - case default - - if (present(pos)) then - select case(psb_toupper(trim(pos))) - case('PRE') - ipos_ = mld_smooth_pre_ - case('POST') - ipos_ = mld_smooth_post_ - case default - ipos_ = mld_smooth_both_ - end select - else - ipos_ = mld_smooth_both_ - end if - - if ((ipos_==mld_smooth_pre_) .or.(ipos_==mld_smooth_both_)) then - if (allocated(lv%sm)) then - call lv%sm%set(what,val,info) - end if - end if - - if ((ipos_==mld_smooth_post_).or.(ipos_==mld_smooth_both_))then - if (allocated(lv%sm2a)) then - call lv%sm2a%set(what,val,info) - end if - end if - - end select - - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - -end subroutine mld_z_base_onelev_setr diff --git a/mlprec/impl/mld_cprecset.F90 b/mlprec/impl/mld_cprecset.F90 index 24e2d659..5bfc0b66 100644 --- a/mlprec/impl/mld_cprecset.F90 +++ b/mlprec/impl/mld_cprecset.F90 @@ -37,385 +37,6 @@ ! ! File: mld_cprecset.f90 ! -! Subroutine: mld_cprecseti -! Version: complex -! -! This routine sets the integer parameters defining the preconditioner. More -! precisely, the integer parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set character and complex parameters, see mld_cprecsetc and mld_cprecsetr, -! respectively. -! -! -! Arguments: -! p - type(mld_cprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! val - integer, input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_cprecseti(p,what,val,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_c_prec_mod, mld_protect_name => mld_cprecseti - use mld_c_jac_smoother - use mld_c_as_smoother - use mld_c_diag_solver - use mld_c_ilu_solver - use mld_c_id_solver - use mld_c_gs_solver -#if defined(HAVE_SLU_) - use mld_c_slu_solver -#endif -#if defined(HAVE_MUMPS_) - use mld_c_mumps_solver -#endif - - implicit none - - ! Arguments - class(mld_cprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - - ! Local variables - integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il - character(len=*), parameter :: name='mld_precseti' - - info = psb_success_ - - if (.not.allocated(p%precv)) then - info = 3111 - write(psb_err_unit,*) name,& - & ': Error: uninitialized preconditioner,',& - &' should call MLD_PRECINIT' - return - endif - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - - - select case(what) - case (mld_min_coarse_size_) - p%min_coarse_size = max(val,-1) - return - case(mld_max_levs_) - p%max_levs = max(val,1) - return - case(mld_outer_sweeps_) - p%outer_sweeps = max(val,1) - return - end select - - ! - ! Set preconditioner parameters at level ilev. - ! - if (present(ilev)) then - - select case(what) - case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,& - & mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,& - & mld_aggr_prol_, mld_aggr_omega_alg_,mld_aggr_eig_,& - & mld_sub_restr_,mld_sub_prol_, & - & mld_sub_ovr_,mld_sub_fillin_,& - & mld_coarse_mat_) - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - - case(mld_coarse_subsolve_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(ilev_)%set(mld_sub_solve_,val,info,pos=pos) - case(mld_coarse_solve_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_coarse_solve_,val,info,pos=pos) - select case (val) - case(mld_bjac_) - call p%precv(nlev_)%set(mld_smoother_type_,val,info,pos=pos) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) -#endif - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - case(mld_slu_) -#if defined(HAVE_SLU_) - 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) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(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_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) - case(mld_mumps_) -#if defined(HAVE_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) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_umf_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(mld_sludist_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_jac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - end select - - endif - case(mld_coarse_sweeps_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos) - - case(mld_coarse_fillin_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos) - case default - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - end select - - else if (.not.present(ilev)) then - ! - ! ilev not specified: set preconditioner parameters at all the appropriate - ! levels - ! - select case(what) - case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& - & mld_sub_ovr_,mld_sub_fillin_,& - & mld_smoother_sweeps_,mld_smoother_type_) - do ilev_=1,max(1,nlev_-1) - call p%precv(ilev_)%set(what,val,info,pos=pos) - if (info /= 0) return - end do - - case(mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,mld_aggr_prol_,& - & mld_aggr_eig_,mld_aggr_filter_) - do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) - end do - - case(mld_coarse_mat_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_coarse_mat_,val,info,pos=pos) - end if - - case(mld_coarse_solve_) - if (nlev_ > 1) then - call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos) - select case (val) - case(mld_bjac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) -#endif - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info) - case(mld_slu_) -#if defined(HAVE_SLU_) - 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) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(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_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) - case(mld_mumps_) -#if defined(HAVE_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) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_umf_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(mld_sludist_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_jac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - end select - endif - - case(mld_coarse_subsolve_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - endif - - case(mld_coarse_sweeps_) - - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos) - end if - - case(mld_coarse_fillin_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos) - end if - case default - do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) - end do - end select - - endif - -end subroutine mld_cprecseti - subroutine mld_cprecsetsm(p,val,info,ilev,ilmax,pos) use psb_base_mod @@ -606,251 +227,3 @@ subroutine mld_cprecsetag(p,val,info,ilev,ilmax,pos) end subroutine mld_cprecsetag -! -! Subroutine: mld_cprecsetc -! Version: complex -! -! This routine sets the character parameters defining the preconditioner. More -! precisely, the character parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set integer and complex parameters, see mld_cprecseti and mld_cprecsetr, -! respectively. -! -! -! Arguments: -! p - type(mld_cprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! string - character(len=*), input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_cprecsetc(p,what,string,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_c_prec_mod, mld_protect_name => mld_cprecsetc - - implicit none - - ! Arguments - class(mld_cprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: string - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - - ! Local variables - integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il - character(len=*), parameter :: name='mld_precsetc' - - info = psb_success_ - - if (.not.allocated(p%precv)) then - info = 3111 - return - endif - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - else - ilev_ = 1 - end if - - if ((ilev_<1).or.(ilev_ > nlev_)) then - write(psb_err_unit,*) name,& - & ': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - info = -1 - return - endif - - val = mld_stringval(string) - if (val >=0) then - call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos) - else - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - do il=ilev_, ilmax_ - call p%precv(il)%set(what,string,info,pos=pos) - end do - end if - - -end subroutine mld_cprecsetc - - -! -! Subroutine: mld_cprecsetr -! Version: complex -! -! This routine sets the complex parameters defining the preconditioner. More -! precisely, the complex parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set integer and character parameters, see mld_cprecseti and mld_cprecsetc, -! respectively. -! -! Arguments: -! p - type(mld_cprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! val - real(psb_spk_), input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_cprecsetr(p,what,val,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_c_prec_mod, mld_protect_name => mld_cprecsetr - - implicit none - - ! Arguments - class(mld_cprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - -! Local variables - integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il - real(psb_spk_) :: thr - character(len=*), parameter :: name='mld_precsetr' - - info = psb_success_ - - select case(what) - case (mld_min_cr_ratio_) - p%min_cr_ratio = max(sone,val) - return - end select - - if (.not.allocated(p%precv)) then - write(psb_err_unit,*) name,& - &': Error: uninitialized preconditioner,',& - &' should call MLD_PRECINIT' - info = 3111 - return - endif - nlev_ = size(p%precv) - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - - ! - ! Set preconditioner parameters at level ilev. - ! - if (present(ilev)) then - - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - - else if (.not.present(ilev)) then - ! - ! ilev not specified: set preconditioner parameters at all the appropriate levels - ! - - select case(what) - case(mld_coarse_iluthrs_) - ilev_=nlev_ - call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos) - - case default - - do il=1,nlev_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - end select - - endif - -end subroutine mld_cprecsetr - - - - diff --git a/mlprec/impl/mld_dprecset.F90 b/mlprec/impl/mld_dprecset.F90 index aa4bf23c..44daac05 100644 --- a/mlprec/impl/mld_dprecset.F90 +++ b/mlprec/impl/mld_dprecset.F90 @@ -37,418 +37,6 @@ ! ! File: mld_dprecset.f90 ! -! Subroutine: mld_dprecseti -! Version: real -! -! This routine sets the integer parameters defining the preconditioner. More -! precisely, the integer parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set character and real parameters, see mld_dprecsetc and mld_dprecsetr, -! respectively. -! -! -! Arguments: -! p - type(mld_dprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! val - integer, input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_dprecseti(p,what,val,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_d_prec_mod, mld_protect_name => mld_dprecseti - use mld_d_jac_smoother - use mld_d_as_smoother - use mld_d_diag_solver - use mld_d_ilu_solver - use mld_d_id_solver - use mld_d_gs_solver -#if defined(HAVE_UMF_) - use mld_d_umf_solver -#endif -#if defined(HAVE_SLUDIST_) - use mld_d_sludist_solver -#endif -#if defined(HAVE_SLU_) - use mld_d_slu_solver -#endif -#if defined(HAVE_MUMPS_) - use mld_d_mumps_solver -#endif - - implicit none - - ! Arguments - class(mld_dprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - - ! Local variables - integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il - character(len=*), parameter :: name='mld_precseti' - - info = psb_success_ - - if (.not.allocated(p%precv)) then - info = 3111 - write(psb_err_unit,*) name,& - & ': Error: uninitialized preconditioner,',& - &' should call MLD_PRECINIT' - return - endif - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - - - select case(what) - case (mld_min_coarse_size_) - p%min_coarse_size = max(val,-1) - return - case(mld_max_levs_) - p%max_levs = max(val,1) - return - case(mld_outer_sweeps_) - p%outer_sweeps = max(val,1) - return - end select - - ! - ! Set preconditioner parameters at level ilev. - ! - if (present(ilev)) then - - select case(what) - case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,& - & mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,& - & mld_aggr_prol_, mld_aggr_omega_alg_,mld_aggr_eig_,& - & mld_sub_restr_,mld_sub_prol_, & - & mld_sub_ovr_,mld_sub_fillin_,& - & mld_coarse_mat_) - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - - case(mld_coarse_subsolve_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(ilev_)%set(mld_sub_solve_,val,info,pos=pos) - case(mld_coarse_solve_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_coarse_solve_,val,info,pos=pos) - select case (val) - case(mld_bjac_) - call p%precv(nlev_)%set(mld_smoother_type_,val,info,pos=pos) -#if defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) -#endif - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - case(mld_slu_) -#if defined(HAVE_SLU_) - 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) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(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_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) - case(mld_mumps_) -#if defined(HAVE_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) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_umf_) -#if defined(HAVE_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) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_sludist_) -#if defined(HAVE_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) -#elif defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_jac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - end select - - endif - case(mld_coarse_sweeps_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos) - - case(mld_coarse_fillin_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos) - case default - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - end select - - else if (.not.present(ilev)) then - ! - ! ilev not specified: set preconditioner parameters at all the appropriate - ! levels - ! - select case(what) - case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& - & mld_sub_ovr_,mld_sub_fillin_,& - & mld_smoother_sweeps_,mld_smoother_type_) - do ilev_=1,max(1,nlev_-1) - call p%precv(ilev_)%set(what,val,info,pos=pos) - if (info /= 0) return - end do - - case(mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,mld_aggr_prol_,& - & mld_aggr_eig_,mld_aggr_filter_) - do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) - end do - - case(mld_coarse_mat_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_coarse_mat_,val,info,pos=pos) - end if - - case(mld_coarse_solve_) - if (nlev_ > 1) then - call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos) - select case (val) - case(mld_bjac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) -#if defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) -#endif - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info) - case(mld_slu_) -#if defined(HAVE_SLU_) - 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) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(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_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) - case(mld_mumps_) -#if defined(HAVE_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) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_umf_) -#if defined(HAVE_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) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(mld_sludist_) -#if defined(HAVE_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) -#elif defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_jac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - end select - endif - - case(mld_coarse_subsolve_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - endif - - case(mld_coarse_sweeps_) - - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos) - end if - - case(mld_coarse_fillin_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos) - end if - case default - do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) - end do - end select - - endif - -end subroutine mld_dprecseti - subroutine mld_dprecsetsm(p,val,info,ilev,ilmax,pos) use psb_base_mod @@ -639,251 +227,3 @@ subroutine mld_dprecsetag(p,val,info,ilev,ilmax,pos) end subroutine mld_dprecsetag -! -! Subroutine: mld_dprecsetc -! Version: real -! -! This routine sets the character parameters defining the preconditioner. More -! precisely, the character parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set integer and real parameters, see mld_dprecseti and mld_dprecsetr, -! respectively. -! -! -! Arguments: -! p - type(mld_dprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! string - character(len=*), input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_dprecsetc(p,what,string,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_d_prec_mod, mld_protect_name => mld_dprecsetc - - implicit none - - ! Arguments - class(mld_dprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: string - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - - ! Local variables - integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il - character(len=*), parameter :: name='mld_precsetc' - - info = psb_success_ - - if (.not.allocated(p%precv)) then - info = 3111 - return - endif - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - else - ilev_ = 1 - end if - - if ((ilev_<1).or.(ilev_ > nlev_)) then - write(psb_err_unit,*) name,& - & ': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - info = -1 - return - endif - - val = mld_stringval(string) - if (val >=0) then - call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos) - else - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - do il=ilev_, ilmax_ - call p%precv(il)%set(what,string,info,pos=pos) - end do - end if - - -end subroutine mld_dprecsetc - - -! -! Subroutine: mld_dprecsetr -! Version: real -! -! This routine sets the real parameters defining the preconditioner. More -! precisely, the real parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set integer and character parameters, see mld_dprecseti and mld_dprecsetc, -! respectively. -! -! Arguments: -! p - type(mld_dprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! val - real(psb_dpk_), input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_dprecsetr(p,what,val,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_d_prec_mod, mld_protect_name => mld_dprecsetr - - implicit none - - ! Arguments - class(mld_dprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - -! Local variables - integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il - real(psb_dpk_) :: thr - character(len=*), parameter :: name='mld_precsetr' - - info = psb_success_ - - select case(what) - case (mld_min_cr_ratio_) - p%min_cr_ratio = max(done,val) - return - end select - - if (.not.allocated(p%precv)) then - write(psb_err_unit,*) name,& - &': Error: uninitialized preconditioner,',& - &' should call MLD_PRECINIT' - info = 3111 - return - endif - nlev_ = size(p%precv) - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - - ! - ! Set preconditioner parameters at level ilev. - ! - if (present(ilev)) then - - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - - else if (.not.present(ilev)) then - ! - ! ilev not specified: set preconditioner parameters at all the appropriate levels - ! - - select case(what) - case(mld_coarse_iluthrs_) - ilev_=nlev_ - call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos) - - case default - - do il=1,nlev_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - end select - - endif - -end subroutine mld_dprecsetr - - - - diff --git a/mlprec/impl/mld_sprecset.F90 b/mlprec/impl/mld_sprecset.F90 index 3780e959..6ee91285 100644 --- a/mlprec/impl/mld_sprecset.F90 +++ b/mlprec/impl/mld_sprecset.F90 @@ -37,385 +37,6 @@ ! ! File: mld_sprecset.f90 ! -! Subroutine: mld_sprecseti -! Version: real -! -! This routine sets the integer parameters defining the preconditioner. More -! precisely, the integer parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set character and real parameters, see mld_sprecsetc and mld_sprecsetr, -! respectively. -! -! -! Arguments: -! p - type(mld_sprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! val - integer, input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_sprecseti(p,what,val,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_s_prec_mod, mld_protect_name => mld_sprecseti - use mld_s_jac_smoother - use mld_s_as_smoother - use mld_s_diag_solver - use mld_s_ilu_solver - use mld_s_id_solver - use mld_s_gs_solver -#if defined(HAVE_SLU_) - use mld_s_slu_solver -#endif -#if defined(HAVE_MUMPS_) - use mld_s_mumps_solver -#endif - - implicit none - - ! Arguments - class(mld_sprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - - ! Local variables - integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il - character(len=*), parameter :: name='mld_precseti' - - info = psb_success_ - - if (.not.allocated(p%precv)) then - info = 3111 - write(psb_err_unit,*) name,& - & ': Error: uninitialized preconditioner,',& - &' should call MLD_PRECINIT' - return - endif - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - - - select case(what) - case (mld_min_coarse_size_) - p%min_coarse_size = max(val,-1) - return - case(mld_max_levs_) - p%max_levs = max(val,1) - return - case(mld_outer_sweeps_) - p%outer_sweeps = max(val,1) - return - end select - - ! - ! Set preconditioner parameters at level ilev. - ! - if (present(ilev)) then - - select case(what) - case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,& - & mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,& - & mld_aggr_prol_, mld_aggr_omega_alg_,mld_aggr_eig_,& - & mld_sub_restr_,mld_sub_prol_, & - & mld_sub_ovr_,mld_sub_fillin_,& - & mld_coarse_mat_) - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - - case(mld_coarse_subsolve_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(ilev_)%set(mld_sub_solve_,val,info,pos=pos) - case(mld_coarse_solve_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_coarse_solve_,val,info,pos=pos) - select case (val) - case(mld_bjac_) - call p%precv(nlev_)%set(mld_smoother_type_,val,info,pos=pos) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) -#endif - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - case(mld_slu_) -#if defined(HAVE_SLU_) - 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) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(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_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) - case(mld_mumps_) -#if defined(HAVE_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) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_umf_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(mld_sludist_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_jac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - end select - - endif - case(mld_coarse_sweeps_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos) - - case(mld_coarse_fillin_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos) - case default - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - end select - - else if (.not.present(ilev)) then - ! - ! ilev not specified: set preconditioner parameters at all the appropriate - ! levels - ! - select case(what) - case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& - & mld_sub_ovr_,mld_sub_fillin_,& - & mld_smoother_sweeps_,mld_smoother_type_) - do ilev_=1,max(1,nlev_-1) - call p%precv(ilev_)%set(what,val,info,pos=pos) - if (info /= 0) return - end do - - case(mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,mld_aggr_prol_,& - & mld_aggr_eig_,mld_aggr_filter_) - do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) - end do - - case(mld_coarse_mat_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_coarse_mat_,val,info,pos=pos) - end if - - case(mld_coarse_solve_) - if (nlev_ > 1) then - call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos) - select case (val) - case(mld_bjac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) -#endif - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info) - case(mld_slu_) -#if defined(HAVE_SLU_) - 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) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(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_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) - case(mld_mumps_) -#if defined(HAVE_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) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_umf_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(mld_sludist_) -#if defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_jac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - end select - endif - - case(mld_coarse_subsolve_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - endif - - case(mld_coarse_sweeps_) - - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos) - end if - - case(mld_coarse_fillin_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos) - end if - case default - do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) - end do - end select - - endif - -end subroutine mld_sprecseti - subroutine mld_sprecsetsm(p,val,info,ilev,ilmax,pos) use psb_base_mod @@ -606,251 +227,3 @@ subroutine mld_sprecsetag(p,val,info,ilev,ilmax,pos) end subroutine mld_sprecsetag -! -! Subroutine: mld_sprecsetc -! Version: real -! -! This routine sets the character parameters defining the preconditioner. More -! precisely, the character parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set integer and real parameters, see mld_sprecseti and mld_sprecsetr, -! respectively. -! -! -! Arguments: -! p - type(mld_sprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! string - character(len=*), input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_sprecsetc(p,what,string,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_s_prec_mod, mld_protect_name => mld_sprecsetc - - implicit none - - ! Arguments - class(mld_sprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: string - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - - ! Local variables - integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il - character(len=*), parameter :: name='mld_precsetc' - - info = psb_success_ - - if (.not.allocated(p%precv)) then - info = 3111 - return - endif - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - else - ilev_ = 1 - end if - - if ((ilev_<1).or.(ilev_ > nlev_)) then - write(psb_err_unit,*) name,& - & ': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - info = -1 - return - endif - - val = mld_stringval(string) - if (val >=0) then - call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos) - else - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - do il=ilev_, ilmax_ - call p%precv(il)%set(what,string,info,pos=pos) - end do - end if - - -end subroutine mld_sprecsetc - - -! -! Subroutine: mld_sprecsetr -! Version: real -! -! This routine sets the real parameters defining the preconditioner. More -! precisely, the real parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set integer and character parameters, see mld_sprecseti and mld_sprecsetc, -! respectively. -! -! Arguments: -! p - type(mld_sprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! val - real(psb_spk_), input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_sprecsetr(p,what,val,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_s_prec_mod, mld_protect_name => mld_sprecsetr - - implicit none - - ! Arguments - class(mld_sprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - -! Local variables - integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il - real(psb_spk_) :: thr - character(len=*), parameter :: name='mld_precsetr' - - info = psb_success_ - - select case(what) - case (mld_min_cr_ratio_) - p%min_cr_ratio = max(sone,val) - return - end select - - if (.not.allocated(p%precv)) then - write(psb_err_unit,*) name,& - &': Error: uninitialized preconditioner,',& - &' should call MLD_PRECINIT' - info = 3111 - return - endif - nlev_ = size(p%precv) - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - - ! - ! Set preconditioner parameters at level ilev. - ! - if (present(ilev)) then - - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - - else if (.not.present(ilev)) then - ! - ! ilev not specified: set preconditioner parameters at all the appropriate levels - ! - - select case(what) - case(mld_coarse_iluthrs_) - ilev_=nlev_ - call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos) - - case default - - do il=1,nlev_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - end select - - endif - -end subroutine mld_sprecsetr - - - - diff --git a/mlprec/impl/mld_zprecset.F90 b/mlprec/impl/mld_zprecset.F90 index da553cb1..ad4fcf03 100644 --- a/mlprec/impl/mld_zprecset.F90 +++ b/mlprec/impl/mld_zprecset.F90 @@ -37,418 +37,6 @@ ! ! File: mld_zprecset.f90 ! -! Subroutine: mld_zprecseti -! Version: complex -! -! This routine sets the integer parameters defining the preconditioner. More -! precisely, the integer parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set character and complex parameters, see mld_zprecsetc and mld_zprecsetr, -! respectively. -! -! -! Arguments: -! p - type(mld_zprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! val - integer, input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_zprecseti(p,what,val,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_z_prec_mod, mld_protect_name => mld_zprecseti - use mld_z_jac_smoother - use mld_z_as_smoother - use mld_z_diag_solver - use mld_z_ilu_solver - use mld_z_id_solver - use mld_z_gs_solver -#if defined(HAVE_UMF_) - use mld_z_umf_solver -#endif -#if defined(HAVE_SLUDIST_) - use mld_z_sludist_solver -#endif -#if defined(HAVE_SLU_) - use mld_z_slu_solver -#endif -#if defined(HAVE_MUMPS_) - use mld_z_mumps_solver -#endif - - implicit none - - ! Arguments - class(mld_zprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - - ! Local variables - integer(psb_ipk_) :: ilev_, nlev_, ilmax_, il - character(len=*), parameter :: name='mld_precseti' - - info = psb_success_ - - if (.not.allocated(p%precv)) then - info = 3111 - write(psb_err_unit,*) name,& - & ': Error: uninitialized preconditioner,',& - &' should call MLD_PRECINIT' - return - endif - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - - - select case(what) - case (mld_min_coarse_size_) - p%min_coarse_size = max(val,-1) - return - case(mld_max_levs_) - p%max_levs = max(val,1) - return - case(mld_outer_sweeps_) - p%outer_sweeps = max(val,1) - return - end select - - ! - ! Set preconditioner parameters at level ilev. - ! - if (present(ilev)) then - - select case(what) - case(mld_smoother_type_,mld_sub_solve_,mld_smoother_sweeps_,& - & mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,& - & mld_aggr_prol_, mld_aggr_omega_alg_,mld_aggr_eig_,& - & mld_sub_restr_,mld_sub_prol_, & - & mld_sub_ovr_,mld_sub_fillin_,& - & mld_coarse_mat_) - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - - case(mld_coarse_subsolve_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(ilev_)%set(mld_sub_solve_,val,info,pos=pos) - case(mld_coarse_solve_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_coarse_solve_,val,info,pos=pos) - select case (val) - case(mld_bjac_) - call p%precv(nlev_)%set(mld_smoother_type_,val,info,pos=pos) -#if defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) -#endif - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - case(mld_slu_) -#if defined(HAVE_SLU_) - 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) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(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_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) - case(mld_mumps_) -#if defined(HAVE_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) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_umf_) -#if defined(HAVE_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) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_sludist_) -#if defined(HAVE_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) -#elif defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_jac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - end select - - endif - case(mld_coarse_sweeps_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos) - - case(mld_coarse_fillin_) - if (ilev_ /= nlev_) then - write(psb_err_unit,*) name,& - & ': Error: Inconsistent specification of WHAT vs. ILEV' - info = -2 - return - end if - call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos) - case default - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - end select - - else if (.not.present(ilev)) then - ! - ! ilev not specified: set preconditioner parameters at all the appropriate - ! levels - ! - select case(what) - case(mld_sub_solve_,mld_sub_restr_,mld_sub_prol_,& - & mld_sub_ovr_,mld_sub_fillin_,& - & mld_smoother_sweeps_,mld_smoother_type_) - do ilev_=1,max(1,nlev_-1) - call p%precv(ilev_)%set(what,val,info,pos=pos) - if (info /= 0) return - end do - - case(mld_ml_cycle_,mld_par_aggr_alg_,mld_aggr_ord_,mld_aggr_type_,mld_aggr_prol_,& - & mld_aggr_eig_,mld_aggr_filter_) - do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) - end do - - case(mld_coarse_mat_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_coarse_mat_,val,info,pos=pos) - end if - - case(mld_coarse_solve_) - if (nlev_ > 1) then - call p%precv(nlev_)%set('COARSE_SOLVE',val,info,pos=pos) - select case (val) - case(mld_bjac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) -#if defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) -#endif - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info) - case(mld_slu_) -#if defined(HAVE_SLU_) - 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) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(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_sub_solve_,val,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) - case(mld_mumps_) -#if defined(HAVE_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) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_umf_) -#if defined(HAVE_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) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - - case(mld_sludist_) -#if defined(HAVE_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) -#elif defined(HAVE_UMF_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_umf_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_SLU_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_slu_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_repl_mat_,info,pos=pos) -#elif defined(HAVE_MUMPS_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_mumps_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#else - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_ilu_n_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) -#endif - case(mld_jac_) - call p%precv(nlev_)%set(mld_smoother_type_,mld_bjac_,info,pos=pos) - call p%precv(nlev_)%set(mld_sub_solve_,mld_diag_scale_,info,pos=pos) - call p%precv(nlev_)%set(mld_coarse_mat_,mld_distr_mat_,info,pos=pos) - end select - endif - - case(mld_coarse_subsolve_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_sub_solve_,val,info,pos=pos) - endif - - case(mld_coarse_sweeps_) - - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_smoother_sweeps_,val,info,pos=pos) - end if - - case(mld_coarse_fillin_) - if (nlev_ > 1) then - call p%precv(nlev_)%set(mld_sub_fillin_,val,info,pos=pos) - end if - case default - do ilev_=1,nlev_ - call p%precv(ilev_)%set(what,val,info,pos=pos) - end do - end select - - endif - -end subroutine mld_zprecseti - subroutine mld_zprecsetsm(p,val,info,ilev,ilmax,pos) use psb_base_mod @@ -639,251 +227,3 @@ subroutine mld_zprecsetag(p,val,info,ilev,ilmax,pos) end subroutine mld_zprecsetag -! -! Subroutine: mld_zprecsetc -! Version: complex -! -! This routine sets the character parameters defining the preconditioner. More -! precisely, the character parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set integer and complex parameters, see mld_zprecseti and mld_zprecsetr, -! respectively. -! -! -! Arguments: -! p - type(mld_zprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! string - character(len=*), input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_zprecsetc(p,what,string,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_z_prec_mod, mld_protect_name => mld_zprecsetc - - implicit none - - ! Arguments - class(mld_zprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: string - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - - ! Local variables - integer(psb_ipk_) :: ilev_, nlev_,val,ilmax_, il - character(len=*), parameter :: name='mld_precsetc' - - info = psb_success_ - - if (.not.allocated(p%precv)) then - info = 3111 - return - endif - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - else - ilev_ = 1 - end if - - if ((ilev_<1).or.(ilev_ > nlev_)) then - write(psb_err_unit,*) name,& - & ': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - info = -1 - return - endif - - val = mld_stringval(string) - if (val >=0) then - call p%set(what,val,info,ilev=ilev,ilmax=ilmax,pos=pos) - else - nlev_ = size(p%precv) - - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - do il=ilev_, ilmax_ - call p%precv(il)%set(what,string,info,pos=pos) - end do - end if - - -end subroutine mld_zprecsetc - - -! -! Subroutine: mld_zprecsetr -! Version: complex -! -! This routine sets the complex parameters defining the preconditioner. More -! precisely, the complex parameter identified by 'what' is assigned the value -! contained in 'val'. -! For the multilevel preconditioners, the levels are numbered in increasing -! order starting from the finest one, i.e. level 1 is the finest level. -! -! To set integer and character parameters, see mld_zprecseti and mld_zprecsetc, -! respectively. -! -! Arguments: -! p - type(mld_zprec_type), input/output. -! The preconditioner data structure. -! what - integer, input. -! The number identifying the parameter to be set. -! A mnemonic constant has been associated to each of these -! numbers, as reported in the MLD2P4 User's and Reference Guide. -! val - real(psb_dpk_), input. -! The value of the parameter to be set. The list of allowed -! values is reported in the MLD2P4 User's and Reference Guide. -! info - integer, output. -! Error code. -! ilev - integer, optional, input. -! For the multilevel preconditioner, the level at which the -! preconditioner parameter has to be set. -! If nlev is not present, the parameter identified by 'what' -! is set at all the appropriate levels. -! -! NOTE: currently, the use of the argument ilev is not "safe" and is reserved to -! MLD2P4 developers. Indeed, by using ilev it is possible to set different values -! of the same parameter at different levels 1,...,nlev-1, even in cases where -! the parameter must have the same value at all the levels but the coarsest one. -! For this reason, the interface mld_precset to this routine has been built in -! such a way that ilev is not visible to the user (see mld_prec_mod.f90). -! -subroutine mld_zprecsetr(p,what,val,info,ilev,ilmax,pos) - - use psb_base_mod - use mld_z_prec_mod, mld_protect_name => mld_zprecsetr - - implicit none - - ! Arguments - class(mld_zprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - -! Local variables - integer(psb_ipk_) :: ilev_,nlev_, ilmax_, il - real(psb_dpk_) :: thr - character(len=*), parameter :: name='mld_precsetr' - - info = psb_success_ - - select case(what) - case (mld_min_cr_ratio_) - p%min_cr_ratio = max(done,val) - return - end select - - if (.not.allocated(p%precv)) then - write(psb_err_unit,*) name,& - &': Error: uninitialized preconditioner,',& - &' should call MLD_PRECINIT' - info = 3111 - return - endif - nlev_ = size(p%precv) - if (present(ilev)) then - ilev_ = ilev - if (present(ilmax)) then - ilmax_ = ilmax - else - ilmax_ = ilev_ - end if - else - ilev_ = 1 - ilmax_ = ilev_ - end if - if ((ilev_<1).or.(ilev_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILEV/NLEV combination',ilev_, nlev_ - return - endif - if ((ilmax_<1).or.(ilmax_ > nlev_)) then - info = -1 - write(psb_err_unit,*) name,& - &': Error: invalid ILMAX/NLEV combination',ilmax_, nlev_ - return - endif - - ! - ! Set preconditioner parameters at level ilev. - ! - if (present(ilev)) then - - do il=ilev_, ilmax_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - - else if (.not.present(ilev)) then - ! - ! ilev not specified: set preconditioner parameters at all the appropriate levels - ! - - select case(what) - case(mld_coarse_iluthrs_) - ilev_=nlev_ - call p%precv(ilev_)%set(mld_sub_iluthrs_,val,info,pos=pos) - - case default - - do il=1,nlev_ - call p%precv(il)%set(what,val,info,pos=pos) - end do - end select - - endif - -end subroutine mld_zprecsetr - - - - diff --git a/mlprec/impl/smoother/Makefile b/mlprec/impl/smoother/Makefile index 8aef9cda..89dbf942 100644 --- a/mlprec/impl/smoother/Makefile +++ b/mlprec/impl/smoother/Makefile @@ -18,9 +18,6 @@ mld_c_as_smoother_cseti.o \ mld_c_as_smoother_csetr.o \ mld_c_as_smoother_dmp.o \ mld_c_as_smoother_free.o \ -mld_c_as_smoother_setc.o \ -mld_c_as_smoother_seti.o \ -mld_c_as_smoother_setr.o \ mld_c_as_smoother_prol_a.o \ mld_c_as_smoother_prol_v.o \ mld_c_as_smoother_restr_a.o \ @@ -37,9 +34,6 @@ mld_c_base_smoother_csetr.o \ mld_c_base_smoother_descr.o \ mld_c_base_smoother_dmp.o \ mld_c_base_smoother_free.o \ -mld_c_base_smoother_setc.o \ -mld_c_base_smoother_seti.o \ -mld_c_base_smoother_setr.o \ mld_c_jac_smoother_apply.o \ mld_c_jac_smoother_apply_vect.o \ mld_c_jac_smoother_bld.o \ @@ -58,9 +52,6 @@ mld_d_as_smoother_cseti.o \ mld_d_as_smoother_csetr.o \ mld_d_as_smoother_dmp.o \ mld_d_as_smoother_free.o \ -mld_d_as_smoother_setc.o \ -mld_d_as_smoother_seti.o \ -mld_d_as_smoother_setr.o \ mld_d_as_smoother_prol_a.o \ mld_d_as_smoother_prol_v.o \ mld_d_as_smoother_restr_a.o \ @@ -77,9 +68,6 @@ mld_d_base_smoother_csetr.o \ mld_d_base_smoother_descr.o \ mld_d_base_smoother_dmp.o \ mld_d_base_smoother_free.o \ -mld_d_base_smoother_setc.o \ -mld_d_base_smoother_seti.o \ -mld_d_base_smoother_setr.o \ mld_d_jac_smoother_apply.o \ mld_d_jac_smoother_apply_vect.o \ mld_d_jac_smoother_bld.o \ @@ -98,9 +86,6 @@ mld_s_as_smoother_cseti.o \ mld_s_as_smoother_csetr.o \ mld_s_as_smoother_dmp.o \ mld_s_as_smoother_free.o \ -mld_s_as_smoother_setc.o \ -mld_s_as_smoother_seti.o \ -mld_s_as_smoother_setr.o \ mld_s_as_smoother_prol_a.o \ mld_s_as_smoother_prol_v.o \ mld_s_as_smoother_restr_a.o \ @@ -117,9 +102,6 @@ mld_s_base_smoother_csetr.o \ mld_s_base_smoother_descr.o \ mld_s_base_smoother_dmp.o \ mld_s_base_smoother_free.o \ -mld_s_base_smoother_setc.o \ -mld_s_base_smoother_seti.o \ -mld_s_base_smoother_setr.o \ mld_s_jac_smoother_apply.o \ mld_s_jac_smoother_apply_vect.o \ mld_s_jac_smoother_bld.o \ @@ -138,9 +120,6 @@ mld_z_as_smoother_cseti.o \ mld_z_as_smoother_csetr.o \ mld_z_as_smoother_dmp.o \ mld_z_as_smoother_free.o \ -mld_z_as_smoother_setc.o \ -mld_z_as_smoother_seti.o \ -mld_z_as_smoother_setr.o \ mld_z_as_smoother_prol_a.o \ mld_z_as_smoother_prol_v.o \ mld_z_as_smoother_restr_a.o \ @@ -157,9 +136,6 @@ mld_z_base_smoother_csetr.o \ mld_z_base_smoother_descr.o \ mld_z_base_smoother_dmp.o \ mld_z_base_smoother_free.o \ -mld_z_base_smoother_setc.o \ -mld_z_base_smoother_seti.o \ -mld_z_base_smoother_setr.o \ mld_z_jac_smoother_apply.o \ mld_z_jac_smoother_apply_vect.o \ mld_z_jac_smoother_bld.o \ @@ -168,7 +144,6 @@ mld_z_jac_smoother_dmp.o \ mld_z_jac_smoother_clone.o \ mld_z_jac_smoother_cnv.o - LIBNAME=libmld_prec.a lib: $(OBJS) diff --git a/mlprec/impl/smoother/mld_c_as_smoother_setc.f90 b/mlprec/impl/smoother/mld_c_as_smoother_setc.f90 deleted file mode 100644 index abf19e45..00000000 --- a/mlprec/impl/smoother/mld_c_as_smoother_setc.f90 +++ /dev/null @@ -1,74 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_c_as_smoother_setc(sm,what,val,info) - - use psb_base_mod - use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_setc - Implicit None - ! Arguments - class(mld_c_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='c_as_smoother_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sm%stringval(val) - if (ival >= 0) then - call sm%set(what,ival,info) - else - call sm%mld_c_base_smoother_type%set(what,val,info) - end if - - if (info /= psb_success_) then - info = psb_err_from_subroutine_ - call psb_errpush(info, name) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_c_as_smoother_setc diff --git a/mlprec/impl/smoother/mld_c_as_smoother_seti.f90 b/mlprec/impl/smoother/mld_c_as_smoother_seti.f90 deleted file mode 100644 index d401f944..00000000 --- a/mlprec/impl/smoother/mld_c_as_smoother_seti.f90 +++ /dev/null @@ -1,72 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_c_as_smoother_seti(sm,what,val,info) - - use psb_base_mod - use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_seti - Implicit None - - ! Arguments - class(mld_c_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='c_as_smoother_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_sub_ovr_) - sm%novr = val - case(mld_sub_restr_) - sm%restr = val - case(mld_sub_prol_) - sm%prol = val - case default - call sm%mld_c_base_smoother_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_c_as_smoother_seti diff --git a/mlprec/impl/smoother/mld_c_as_smoother_setr.f90 b/mlprec/impl/smoother/mld_c_as_smoother_setr.f90 deleted file mode 100644 index 46f6c546..00000000 --- a/mlprec/impl/smoother/mld_c_as_smoother_setr.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_c_as_smoother_setr(sm,what,val,info) - - use psb_base_mod - use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_setr - Implicit None - ! Arguments - class(mld_c_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='c_as_smoother_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - else -!!$ write(0,*) trim(name),' Missing component, not setting!' -!!$ info = 1121 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_c_as_smoother_setr diff --git a/mlprec/impl/smoother/mld_c_base_smoother_setc.f90 b/mlprec/impl/smoother/mld_c_base_smoother_setc.f90 deleted file mode 100644 index 88b82f78..00000000 --- a/mlprec/impl/smoother/mld_c_base_smoother_setc.f90 +++ /dev/null @@ -1,73 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_c_base_smoother_setc(sm,what,val,info) - - use psb_base_mod - use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_setc - Implicit None - - ! Arguments - class(mld_c_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='c_base_smoother_setc' - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = sm%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) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_c_base_smoother_setc diff --git a/mlprec/impl/smoother/mld_c_base_smoother_seti.f90 b/mlprec/impl/smoother/mld_c_base_smoother_seti.f90 deleted file mode 100644 index 9ea67f47..00000000 --- a/mlprec/impl/smoother/mld_c_base_smoother_seti.f90 +++ /dev/null @@ -1,64 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_c_base_smoother_seti(sm,what,val,info) - - use psb_base_mod - use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_seti - Implicit None - ! Arguments - class(mld_c_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='c_base_smoother_seti' - - call psb_erractionsave(err_act) - info = psb_success_ - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_c_base_smoother_seti diff --git a/mlprec/impl/smoother/mld_c_base_smoother_setr.f90 b/mlprec/impl/smoother/mld_c_base_smoother_setr.f90 deleted file mode 100644 index eaf9ca24..00000000 --- a/mlprec/impl/smoother/mld_c_base_smoother_setr.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_c_base_smoother_setr(sm,what,val,info) - - use psb_base_mod - use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_setr - Implicit None - - ! Arguments - class(mld_c_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='c_base_smoother_setr' - - call psb_erractionsave(err_act) - - - info = psb_success_ - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_c_base_smoother_setr diff --git a/mlprec/impl/smoother/mld_d_as_smoother_setc.f90 b/mlprec/impl/smoother/mld_d_as_smoother_setc.f90 deleted file mode 100644 index c90c0cfb..00000000 --- a/mlprec/impl/smoother/mld_d_as_smoother_setc.f90 +++ /dev/null @@ -1,74 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_d_as_smoother_setc(sm,what,val,info) - - use psb_base_mod - use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_setc - Implicit None - ! Arguments - class(mld_d_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='d_as_smoother_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sm%stringval(val) - if (ival >= 0) then - call sm%set(what,ival,info) - else - call sm%mld_d_base_smoother_type%set(what,val,info) - end if - - if (info /= psb_success_) then - info = psb_err_from_subroutine_ - call psb_errpush(info, name) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_d_as_smoother_setc diff --git a/mlprec/impl/smoother/mld_d_as_smoother_seti.f90 b/mlprec/impl/smoother/mld_d_as_smoother_seti.f90 deleted file mode 100644 index 2b84d5bb..00000000 --- a/mlprec/impl/smoother/mld_d_as_smoother_seti.f90 +++ /dev/null @@ -1,72 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_d_as_smoother_seti(sm,what,val,info) - - use psb_base_mod - use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_seti - Implicit None - - ! Arguments - class(mld_d_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_as_smoother_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_sub_ovr_) - sm%novr = val - case(mld_sub_restr_) - sm%restr = val - case(mld_sub_prol_) - sm%prol = val - case default - call sm%mld_d_base_smoother_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_d_as_smoother_seti diff --git a/mlprec/impl/smoother/mld_d_as_smoother_setr.f90 b/mlprec/impl/smoother/mld_d_as_smoother_setr.f90 deleted file mode 100644 index e87297a5..00000000 --- a/mlprec/impl/smoother/mld_d_as_smoother_setr.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_d_as_smoother_setr(sm,what,val,info) - - use psb_base_mod - use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_setr - Implicit None - ! Arguments - class(mld_d_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_as_smoother_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - else -!!$ write(0,*) trim(name),' Missing component, not setting!' -!!$ info = 1121 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_d_as_smoother_setr diff --git a/mlprec/impl/smoother/mld_d_base_smoother_setc.f90 b/mlprec/impl/smoother/mld_d_base_smoother_setc.f90 deleted file mode 100644 index cf5f34e8..00000000 --- a/mlprec/impl/smoother/mld_d_base_smoother_setc.f90 +++ /dev/null @@ -1,73 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_d_base_smoother_setc(sm,what,val,info) - - use psb_base_mod - use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_setc - Implicit None - - ! Arguments - class(mld_d_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='d_base_smoother_setc' - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = sm%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) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_d_base_smoother_setc diff --git a/mlprec/impl/smoother/mld_d_base_smoother_seti.f90 b/mlprec/impl/smoother/mld_d_base_smoother_seti.f90 deleted file mode 100644 index ea9deef4..00000000 --- a/mlprec/impl/smoother/mld_d_base_smoother_seti.f90 +++ /dev/null @@ -1,64 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_d_base_smoother_seti(sm,what,val,info) - - use psb_base_mod - use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_seti - Implicit None - ! Arguments - class(mld_d_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_smoother_seti' - - call psb_erractionsave(err_act) - info = psb_success_ - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_d_base_smoother_seti diff --git a/mlprec/impl/smoother/mld_d_base_smoother_setr.f90 b/mlprec/impl/smoother/mld_d_base_smoother_setr.f90 deleted file mode 100644 index 80f5ec7f..00000000 --- a/mlprec/impl/smoother/mld_d_base_smoother_setr.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_d_base_smoother_setr(sm,what,val,info) - - use psb_base_mod - use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_setr - Implicit None - - ! Arguments - class(mld_d_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_smoother_setr' - - call psb_erractionsave(err_act) - - - info = psb_success_ - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_d_base_smoother_setr diff --git a/mlprec/impl/smoother/mld_s_as_smoother_setc.f90 b/mlprec/impl/smoother/mld_s_as_smoother_setc.f90 deleted file mode 100644 index 842fa945..00000000 --- a/mlprec/impl/smoother/mld_s_as_smoother_setc.f90 +++ /dev/null @@ -1,74 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_s_as_smoother_setc(sm,what,val,info) - - use psb_base_mod - use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_setc - Implicit None - ! Arguments - class(mld_s_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='s_as_smoother_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sm%stringval(val) - if (ival >= 0) then - call sm%set(what,ival,info) - else - call sm%mld_s_base_smoother_type%set(what,val,info) - end if - - if (info /= psb_success_) then - info = psb_err_from_subroutine_ - call psb_errpush(info, name) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_s_as_smoother_setc diff --git a/mlprec/impl/smoother/mld_s_as_smoother_seti.f90 b/mlprec/impl/smoother/mld_s_as_smoother_seti.f90 deleted file mode 100644 index c4fee0fd..00000000 --- a/mlprec/impl/smoother/mld_s_as_smoother_seti.f90 +++ /dev/null @@ -1,72 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_s_as_smoother_seti(sm,what,val,info) - - use psb_base_mod - use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_seti - Implicit None - - ! Arguments - class(mld_s_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='s_as_smoother_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_sub_ovr_) - sm%novr = val - case(mld_sub_restr_) - sm%restr = val - case(mld_sub_prol_) - sm%prol = val - case default - call sm%mld_s_base_smoother_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_s_as_smoother_seti diff --git a/mlprec/impl/smoother/mld_s_as_smoother_setr.f90 b/mlprec/impl/smoother/mld_s_as_smoother_setr.f90 deleted file mode 100644 index 1eb9fe99..00000000 --- a/mlprec/impl/smoother/mld_s_as_smoother_setr.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_s_as_smoother_setr(sm,what,val,info) - - use psb_base_mod - use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_setr - Implicit None - ! Arguments - class(mld_s_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='s_as_smoother_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - else -!!$ write(0,*) trim(name),' Missing component, not setting!' -!!$ info = 1121 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_s_as_smoother_setr diff --git a/mlprec/impl/smoother/mld_s_base_smoother_setc.f90 b/mlprec/impl/smoother/mld_s_base_smoother_setc.f90 deleted file mode 100644 index 0e04cddf..00000000 --- a/mlprec/impl/smoother/mld_s_base_smoother_setc.f90 +++ /dev/null @@ -1,73 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_s_base_smoother_setc(sm,what,val,info) - - use psb_base_mod - use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_setc - Implicit None - - ! Arguments - class(mld_s_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='s_base_smoother_setc' - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = sm%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) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_s_base_smoother_setc diff --git a/mlprec/impl/smoother/mld_s_base_smoother_seti.f90 b/mlprec/impl/smoother/mld_s_base_smoother_seti.f90 deleted file mode 100644 index b840ce5e..00000000 --- a/mlprec/impl/smoother/mld_s_base_smoother_seti.f90 +++ /dev/null @@ -1,64 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_s_base_smoother_seti(sm,what,val,info) - - use psb_base_mod - use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_seti - Implicit None - ! Arguments - class(mld_s_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='s_base_smoother_seti' - - call psb_erractionsave(err_act) - info = psb_success_ - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_s_base_smoother_seti diff --git a/mlprec/impl/smoother/mld_s_base_smoother_setr.f90 b/mlprec/impl/smoother/mld_s_base_smoother_setr.f90 deleted file mode 100644 index 4a0d4936..00000000 --- a/mlprec/impl/smoother/mld_s_base_smoother_setr.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_s_base_smoother_setr(sm,what,val,info) - - use psb_base_mod - use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_setr - Implicit None - - ! Arguments - class(mld_s_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='s_base_smoother_setr' - - call psb_erractionsave(err_act) - - - info = psb_success_ - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_s_base_smoother_setr diff --git a/mlprec/impl/smoother/mld_z_as_smoother_setc.f90 b/mlprec/impl/smoother/mld_z_as_smoother_setc.f90 deleted file mode 100644 index c928b1aa..00000000 --- a/mlprec/impl/smoother/mld_z_as_smoother_setc.f90 +++ /dev/null @@ -1,74 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_z_as_smoother_setc(sm,what,val,info) - - use psb_base_mod - use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_setc - Implicit None - ! Arguments - class(mld_z_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='z_as_smoother_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sm%stringval(val) - if (ival >= 0) then - call sm%set(what,ival,info) - else - call sm%mld_z_base_smoother_type%set(what,val,info) - end if - - if (info /= psb_success_) then - info = psb_err_from_subroutine_ - call psb_errpush(info, name) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_z_as_smoother_setc diff --git a/mlprec/impl/smoother/mld_z_as_smoother_seti.f90 b/mlprec/impl/smoother/mld_z_as_smoother_seti.f90 deleted file mode 100644 index ba29e8ec..00000000 --- a/mlprec/impl/smoother/mld_z_as_smoother_seti.f90 +++ /dev/null @@ -1,72 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_z_as_smoother_seti(sm,what,val,info) - - use psb_base_mod - use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_seti - Implicit None - - ! Arguments - class(mld_z_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_as_smoother_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_sub_ovr_) - sm%novr = val - case(mld_sub_restr_) - sm%restr = val - case(mld_sub_prol_) - sm%prol = val - case default - call sm%mld_z_base_smoother_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_z_as_smoother_seti diff --git a/mlprec/impl/smoother/mld_z_as_smoother_setr.f90 b/mlprec/impl/smoother/mld_z_as_smoother_setr.f90 deleted file mode 100644 index 88f54237..00000000 --- a/mlprec/impl/smoother/mld_z_as_smoother_setr.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_z_as_smoother_setr(sm,what,val,info) - - use psb_base_mod - use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_setr - Implicit None - ! Arguments - class(mld_z_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_as_smoother_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - else -!!$ write(0,*) trim(name),' Missing component, not setting!' -!!$ info = 1121 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_z_as_smoother_setr diff --git a/mlprec/impl/smoother/mld_z_base_smoother_setc.f90 b/mlprec/impl/smoother/mld_z_base_smoother_setc.f90 deleted file mode 100644 index cb342510..00000000 --- a/mlprec/impl/smoother/mld_z_base_smoother_setc.f90 +++ /dev/null @@ -1,73 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_z_base_smoother_setc(sm,what,val,info) - - use psb_base_mod - use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_setc - Implicit None - - ! Arguments - class(mld_z_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='z_base_smoother_setc' - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = sm%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) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_z_base_smoother_setc diff --git a/mlprec/impl/smoother/mld_z_base_smoother_seti.f90 b/mlprec/impl/smoother/mld_z_base_smoother_seti.f90 deleted file mode 100644 index 0c089f6b..00000000 --- a/mlprec/impl/smoother/mld_z_base_smoother_seti.f90 +++ /dev/null @@ -1,64 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_z_base_smoother_seti(sm,what,val,info) - - use psb_base_mod - use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_seti - Implicit None - ! Arguments - class(mld_z_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_base_smoother_seti' - - call psb_erractionsave(err_act) - info = psb_success_ - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - if (info /= psb_success_) goto 9999 - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_z_base_smoother_seti diff --git a/mlprec/impl/smoother/mld_z_base_smoother_setr.f90 b/mlprec/impl/smoother/mld_z_base_smoother_setr.f90 deleted file mode 100644 index 330b4093..00000000 --- a/mlprec/impl/smoother/mld_z_base_smoother_setr.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_z_base_smoother_setr(sm,what,val,info) - - use psb_base_mod - use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_setr - Implicit None - - ! Arguments - class(mld_z_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_base_smoother_setr' - - call psb_erractionsave(err_act) - - - info = psb_success_ - - if (allocated(sm%sv)) then - call sm%sv%set(what,val,info) - end if - if (info /= psb_success_) goto 9999 - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_z_base_smoother_setr diff --git a/mlprec/impl/solver/Makefile b/mlprec/impl/solver/Makefile index 71dba236..d688c6e0 100644 --- a/mlprec/impl/solver/Makefile +++ b/mlprec/impl/solver/Makefile @@ -19,9 +19,6 @@ mld_c_base_solver_csetr.o \ mld_c_base_solver_descr.o \ mld_c_base_solver_dmp.o \ mld_c_base_solver_free.o \ -mld_c_base_solver_setc.o \ -mld_c_base_solver_seti.o \ -mld_c_base_solver_setr.o \ mld_c_diag_solver_apply.o \ mld_c_diag_solver_apply_vect.o \ mld_c_diag_solver_bld.o \ @@ -64,9 +61,6 @@ mld_d_base_solver_csetr.o \ mld_d_base_solver_descr.o \ mld_d_base_solver_dmp.o \ mld_d_base_solver_free.o \ -mld_d_base_solver_setc.o \ -mld_d_base_solver_seti.o \ -mld_d_base_solver_setr.o \ mld_d_diag_solver_apply.o \ mld_d_diag_solver_apply_vect.o \ mld_d_diag_solver_bld.o \ @@ -109,9 +103,6 @@ mld_s_base_solver_csetr.o \ mld_s_base_solver_descr.o \ mld_s_base_solver_dmp.o \ mld_s_base_solver_free.o \ -mld_s_base_solver_setc.o \ -mld_s_base_solver_seti.o \ -mld_s_base_solver_setr.o \ mld_s_diag_solver_apply.o \ mld_s_diag_solver_apply_vect.o \ mld_s_diag_solver_bld.o \ @@ -154,9 +145,6 @@ mld_z_base_solver_csetr.o \ mld_z_base_solver_descr.o \ mld_z_base_solver_dmp.o \ mld_z_base_solver_free.o \ -mld_z_base_solver_setc.o \ -mld_z_base_solver_seti.o \ -mld_z_base_solver_setr.o \ mld_z_diag_solver_apply.o \ mld_z_diag_solver_apply_vect.o \ mld_z_diag_solver_bld.o \ @@ -187,7 +175,7 @@ mld_zilut_fact.o \ mld_z_mumps_solver_apply.o \ mld_z_mumps_solver_apply_vect.o \ mld_z_mumps_solver_bld.o \ - + LIBNAME=libmld_prec.a diff --git a/mlprec/impl/solver/mld_c_base_solver_setc.f90 b/mlprec/impl/solver/mld_c_base_solver_setc.f90 deleted file mode 100644 index 53f1201e..00000000 --- a/mlprec/impl/solver/mld_c_base_solver_setc.f90 +++ /dev/null @@ -1,69 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_c_base_solver_setc(sv,what,val,info) - - use psb_base_mod - use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_setc - Implicit None - ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - Integer(Psb_ipk_) :: err_act, ival - character(len=20) :: name='d_base_solver_setc' - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = sv%stringval(val) - if (ival >=0) then - call sv%set(what,ival,info) - end if - - if (info /= psb_success_) goto 9999 - - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_c_base_solver_setc diff --git a/mlprec/impl/solver/mld_c_base_solver_seti.f90 b/mlprec/impl/solver/mld_c_base_solver_seti.f90 deleted file mode 100644 index 3a461e05..00000000 --- a/mlprec/impl/solver/mld_c_base_solver_seti.f90 +++ /dev/null @@ -1,55 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_c_base_solver_seti(sv,what,val,info) - - use psb_base_mod - use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_seti - Implicit None - ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_solver_seti' - - ! Correct action here is doing nothing. - info = 0 - - return -end subroutine mld_c_base_solver_seti diff --git a/mlprec/impl/solver/mld_c_base_solver_setr.f90 b/mlprec/impl/solver/mld_c_base_solver_setr.f90 deleted file mode 100644 index f6ea6371..00000000 --- a/mlprec/impl/solver/mld_c_base_solver_setr.f90 +++ /dev/null @@ -1,56 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_c_base_solver_setr(sv,what,val,info) - - use psb_base_mod - use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_setr - Implicit None - ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_solver_setr' - - - ! Correct action here is doing nothing. - info = 0 - - return -end subroutine mld_c_base_solver_setr diff --git a/mlprec/impl/solver/mld_d_base_solver_setc.f90 b/mlprec/impl/solver/mld_d_base_solver_setc.f90 deleted file mode 100644 index e2664ce7..00000000 --- a/mlprec/impl/solver/mld_d_base_solver_setc.f90 +++ /dev/null @@ -1,69 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_d_base_solver_setc(sv,what,val,info) - - use psb_base_mod - use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_setc - Implicit None - ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - Integer(Psb_ipk_) :: err_act, ival - character(len=20) :: name='d_base_solver_setc' - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = sv%stringval(val) - if (ival >=0) then - call sv%set(what,ival,info) - end if - - if (info /= psb_success_) goto 9999 - - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_d_base_solver_setc diff --git a/mlprec/impl/solver/mld_d_base_solver_seti.f90 b/mlprec/impl/solver/mld_d_base_solver_seti.f90 deleted file mode 100644 index 4e18f78f..00000000 --- a/mlprec/impl/solver/mld_d_base_solver_seti.f90 +++ /dev/null @@ -1,55 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_d_base_solver_seti(sv,what,val,info) - - use psb_base_mod - use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_seti - Implicit None - ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_solver_seti' - - ! Correct action here is doing nothing. - info = 0 - - return -end subroutine mld_d_base_solver_seti diff --git a/mlprec/impl/solver/mld_d_base_solver_setr.f90 b/mlprec/impl/solver/mld_d_base_solver_setr.f90 deleted file mode 100644 index a933cfd6..00000000 --- a/mlprec/impl/solver/mld_d_base_solver_setr.f90 +++ /dev/null @@ -1,56 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_d_base_solver_setr(sv,what,val,info) - - use psb_base_mod - use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_setr - Implicit None - ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_solver_setr' - - - ! Correct action here is doing nothing. - info = 0 - - return -end subroutine mld_d_base_solver_setr diff --git a/mlprec/impl/solver/mld_s_base_solver_setc.f90 b/mlprec/impl/solver/mld_s_base_solver_setc.f90 deleted file mode 100644 index 23e17ce5..00000000 --- a/mlprec/impl/solver/mld_s_base_solver_setc.f90 +++ /dev/null @@ -1,69 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_s_base_solver_setc(sv,what,val,info) - - use psb_base_mod - use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_setc - Implicit None - ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - Integer(Psb_ipk_) :: err_act, ival - character(len=20) :: name='d_base_solver_setc' - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = sv%stringval(val) - if (ival >=0) then - call sv%set(what,ival,info) - end if - - if (info /= psb_success_) goto 9999 - - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_s_base_solver_setc diff --git a/mlprec/impl/solver/mld_s_base_solver_seti.f90 b/mlprec/impl/solver/mld_s_base_solver_seti.f90 deleted file mode 100644 index 0a7fb9e6..00000000 --- a/mlprec/impl/solver/mld_s_base_solver_seti.f90 +++ /dev/null @@ -1,55 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_s_base_solver_seti(sv,what,val,info) - - use psb_base_mod - use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_seti - Implicit None - ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_solver_seti' - - ! Correct action here is doing nothing. - info = 0 - - return -end subroutine mld_s_base_solver_seti diff --git a/mlprec/impl/solver/mld_s_base_solver_setr.f90 b/mlprec/impl/solver/mld_s_base_solver_setr.f90 deleted file mode 100644 index d0f25532..00000000 --- a/mlprec/impl/solver/mld_s_base_solver_setr.f90 +++ /dev/null @@ -1,56 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_s_base_solver_setr(sv,what,val,info) - - use psb_base_mod - use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_setr - Implicit None - ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_solver_setr' - - - ! Correct action here is doing nothing. - info = 0 - - return -end subroutine mld_s_base_solver_setr diff --git a/mlprec/impl/solver/mld_z_base_solver_setc.f90 b/mlprec/impl/solver/mld_z_base_solver_setc.f90 deleted file mode 100644 index a0d60a99..00000000 --- a/mlprec/impl/solver/mld_z_base_solver_setc.f90 +++ /dev/null @@ -1,69 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_z_base_solver_setc(sv,what,val,info) - - use psb_base_mod - use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_setc - Implicit None - ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - Integer(Psb_ipk_) :: err_act, ival - character(len=20) :: name='d_base_solver_setc' - - call psb_erractionsave(err_act) - - info = psb_success_ - - ival = sv%stringval(val) - if (ival >=0) then - call sv%set(what,ival,info) - end if - - if (info /= psb_success_) goto 9999 - - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - - return -end subroutine mld_z_base_solver_setc diff --git a/mlprec/impl/solver/mld_z_base_solver_seti.f90 b/mlprec/impl/solver/mld_z_base_solver_seti.f90 deleted file mode 100644 index ebeec939..00000000 --- a/mlprec/impl/solver/mld_z_base_solver_seti.f90 +++ /dev/null @@ -1,55 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_z_base_solver_seti(sv,what,val,info) - - use psb_base_mod - use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_seti - Implicit None - ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_solver_seti' - - ! Correct action here is doing nothing. - info = 0 - - return -end subroutine mld_z_base_solver_seti diff --git a/mlprec/impl/solver/mld_z_base_solver_setr.f90 b/mlprec/impl/solver/mld_z_base_solver_setr.f90 deleted file mode 100644 index a31ba30d..00000000 --- a/mlprec/impl/solver/mld_z_base_solver_setr.f90 +++ /dev/null @@ -1,56 +0,0 @@ -! -! -! MLD2P4 version 2.2 -! MultiLevel Domain Decomposition Parallel Preconditioners Package -! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2008-2018 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Daniela di Serafino -! -! 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. -! -! -subroutine mld_z_base_solver_setr(sv,what,val,info) - - use psb_base_mod - use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_setr - Implicit None - ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_base_solver_setr' - - - ! Correct action here is doing nothing. - info = 0 - - return -end subroutine mld_z_base_solver_setr diff --git a/mlprec/mld_c_as_smoother.f90 b/mlprec/mld_c_as_smoother.f90 index 2da8aedb..9a84bad5 100644 --- a/mlprec/mld_c_as_smoother.f90 +++ b/mlprec/mld_c_as_smoother.f90 @@ -83,8 +83,6 @@ module mld_c_as_smoother generic, public :: apply_restr => restr_v, restr_a generic, public :: apply_prol => prol_v, prol_a procedure, pass(sm) :: free => mld_c_as_smoother_free - procedure, pass(sm) :: seti => mld_c_as_smoother_seti - procedure, pass(sm) :: setc => mld_c_as_smoother_setc procedure, pass(sm) :: cseti => mld_c_as_smoother_cseti procedure, pass(sm) :: csetc => mld_c_as_smoother_csetc procedure, pass(sm) :: descr => c_as_smoother_descr @@ -253,42 +251,6 @@ module mld_c_as_smoother end subroutine mld_c_as_smoother_cnv end interface - interface - subroutine mld_c_as_smoother_seti(sm,what,val,info) - import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & - & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_c_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_as_smoother_seti - end interface - - interface - subroutine mld_c_as_smoother_setc(sm,what,val,info) - import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & - & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_c_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_as_smoother_setc - end interface - - interface - subroutine mld_c_as_smoother_setr(sm,what,val,info) - import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & - & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_c_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_as_smoother_setr - end interface - interface subroutine mld_c_as_smoother_cseti(sm,what,val,info) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & diff --git a/mlprec/mld_c_base_aggregator_mod.f90 b/mlprec/mld_c_base_aggregator_mod.f90 index b62c9af1..7e816283 100644 --- a/mlprec/mld_c_base_aggregator_mod.f90 +++ b/mlprec/mld_c_base_aggregator_mod.f90 @@ -105,11 +105,41 @@ module mld_c_base_aggregator_mod procedure, pass(ag) :: descr => mld_c_base_aggregator_descr procedure, pass(ag) :: set_aggr_type => mld_c_base_aggregator_set_aggr_type procedure, nopass :: fmt => mld_c_base_aggregator_fmt + procedure, pass(ag) :: cseti => mld_c_base_aggregator_cseti + procedure, pass(ag) :: csetr => mld_c_base_aggregator_csetr + generic, public :: set => cseti, csetr end type mld_c_base_aggregator_type contains + subroutine mld_c_base_aggregator_cseti(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_c_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_c_base_aggregator_cseti + + subroutine mld_c_base_aggregator_csetr(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_c_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_c_base_aggregator_csetr + + subroutine mld_c_base_aggregator_update_next(ag,agnext,info) implicit none class(mld_c_base_aggregator_type), target, intent(inout) :: ag, agnext @@ -159,7 +189,7 @@ contains implicit none character(len=32) :: val - val = "Null " + val = "Default aggregator " end function mld_c_base_aggregator_fmt subroutine mld_c_base_aggregator_descr(ag,parms,iout,info) @@ -169,6 +199,7 @@ contains integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + write(iout,*) 'Aggregator object type: ',ag%fmt() call parms%mldescr(iout,info) return diff --git a/mlprec/mld_c_base_smoother_mod.f90 b/mlprec/mld_c_base_smoother_mod.f90 index caf92d49..a17300f5 100644 --- a/mlprec/mld_c_base_smoother_mod.f90 +++ b/mlprec/mld_c_base_smoother_mod.f90 @@ -112,13 +112,10 @@ module mld_c_base_smoother_mod procedure, pass(sm) :: apply_a => mld_c_base_smoother_apply generic, public :: apply => apply_a, apply_v procedure, pass(sm) :: free => mld_c_base_smoother_free - procedure, pass(sm) :: seti => mld_c_base_smoother_seti - procedure, pass(sm) :: setc => mld_c_base_smoother_setc - procedure, pass(sm) :: setr => mld_c_base_smoother_setr procedure, pass(sm) :: cseti => mld_c_base_smoother_cseti procedure, pass(sm) :: csetc => mld_c_base_smoother_csetc procedure, pass(sm) :: csetr => mld_c_base_smoother_csetr - generic, public :: set => seti, setc, setr, cseti, csetc, csetr + generic, public :: set => cseti, csetc, csetr procedure, pass(sm) :: default => c_base_smoother_default procedure, pass(sm) :: descr => mld_c_base_smoother_descr procedure, pass(sm) :: sizeof => c_base_smoother_sizeof @@ -188,44 +185,6 @@ module mld_c_base_smoother_mod end subroutine mld_c_base_smoother_check end interface - interface - subroutine mld_c_base_smoother_seti(sm,what,val,info) - import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & - & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & - & mld_c_base_smoother_type, psb_ipk_ - ! Arguments - class(mld_c_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_base_smoother_seti - end interface - - interface - subroutine mld_c_base_smoother_setc(sm,what,val,info) - import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & - & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & - & mld_c_base_smoother_type, psb_ipk_ - class(mld_c_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_base_smoother_setc - end interface - - interface - subroutine mld_c_base_smoother_setr(sm,what,val,info) - import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & - & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & - & mld_c_base_smoother_type, psb_ipk_ - ! Arguments - class(mld_c_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_base_smoother_setr - end interface - interface subroutine mld_c_base_smoother_cseti(sm,what,val,info) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & diff --git a/mlprec/mld_c_base_solver_mod.f90 b/mlprec/mld_c_base_solver_mod.f90 index c4dc7f35..376abc61 100644 --- a/mlprec/mld_c_base_solver_mod.f90 +++ b/mlprec/mld_c_base_solver_mod.f90 @@ -96,13 +96,10 @@ module mld_c_base_solver_mod procedure, pass(sv) :: apply_a => mld_c_base_solver_apply generic, public :: apply => apply_a, apply_v procedure, pass(sv) :: free => mld_c_base_solver_free - procedure, pass(sv) :: seti => mld_c_base_solver_seti - procedure, pass(sv) :: setc => mld_c_base_solver_setc - procedure, pass(sv) :: setr => mld_c_base_solver_setr procedure, pass(sv) :: cseti => mld_c_base_solver_cseti procedure, pass(sv) :: csetc => mld_c_base_solver_csetc procedure, pass(sv) :: csetr => mld_c_base_solver_csetr - generic, public :: set => seti, setc, setr, cseti, csetc, csetr + generic, public :: set => cseti, csetc, csetr procedure, pass(sv) :: default => c_base_solver_default procedure, pass(sv) :: descr => mld_c_base_solver_descr procedure, pass(sv) :: sizeof => c_base_solver_sizeof @@ -209,50 +206,6 @@ module mld_c_base_solver_mod end subroutine mld_c_base_solver_check end interface - interface - subroutine mld_c_base_solver_seti(sv,what,val,info) - import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & - & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & - & mld_c_base_solver_type, psb_ipk_ - Implicit None - - ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_base_solver_seti - end interface - - interface - subroutine mld_c_base_solver_setc(sv,what,val,info) - import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & - & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & - & mld_c_base_solver_type, psb_ipk_ - Implicit None - - ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_base_solver_setc - end interface - - interface - subroutine mld_c_base_solver_setr(sv,what,val,info) - import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & - & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & - & mld_c_base_solver_type, psb_ipk_ - Implicit None - ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_c_base_solver_setr - end interface - interface subroutine mld_c_base_solver_cseti(sv,what,val,info) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & diff --git a/mlprec/mld_c_dec_aggregator_mod.f90 b/mlprec/mld_c_dec_aggregator_mod.f90 index 53a5f2c9..e933494c 100644 --- a/mlprec/mld_c_dec_aggregator_mod.f90 +++ b/mlprec/mld_c_dec_aggregator_mod.f90 @@ -97,6 +97,7 @@ module mld_c_dec_aggregator_mod procedure, pass(ag) :: mat_asb => mld_c_dec_aggregator_mat_asb procedure, pass(ag) :: default => mld_c_dec_aggregator_default procedure, pass(ag) :: set_aggr_type => mld_c_dec_aggregator_set_aggr_type + procedure, pass(ag) :: descr => mld_c_dec_aggregator_descr procedure, nopass :: fmt => mld_c_dec_aggregator_fmt end type mld_c_dec_aggregator_type @@ -190,4 +191,18 @@ contains val = "Decoupled aggregation" end function mld_c_dec_aggregator_fmt + subroutine mld_c_dec_aggregator_descr(ag,parms,iout,info) + implicit none + class(mld_c_dec_aggregator_type), intent(in) :: ag + type(mld_sml_parms), intent(in) :: parms + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + + write(iout,*) 'Decoupled Aggregator' + write(iout,*) 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info) + + return + end subroutine mld_c_dec_aggregator_descr + end module mld_c_dec_aggregator_mod diff --git a/mlprec/mld_c_gs_solver.f90 b/mlprec/mld_c_gs_solver.f90 index 0ce986b2..746843ba 100644 --- a/mlprec/mld_c_gs_solver.f90 +++ b/mlprec/mld_c_gs_solver.f90 @@ -67,9 +67,6 @@ module mld_c_gs_solver procedure, pass(sv) :: apply_v => mld_c_gs_solver_apply_vect procedure, pass(sv) :: apply_a => mld_c_gs_solver_apply procedure, pass(sv) :: free => c_gs_solver_free - procedure, pass(sv) :: seti => c_gs_solver_seti - procedure, pass(sv) :: setc => c_gs_solver_setc - procedure, pass(sv) :: setr => c_gs_solver_setr procedure, pass(sv) :: cseti => c_gs_solver_cseti procedure, pass(sv) :: csetc => c_gs_solver_csetc procedure, pass(sv) :: csetr => c_gs_solver_csetr @@ -95,8 +92,7 @@ module mld_c_gs_solver private :: c_gs_solver_bld, c_gs_solver_apply, & - & c_gs_solver_free, c_gs_solver_seti, & - & c_gs_solver_setc, c_gs_solver_setr,& + & c_gs_solver_free, & & c_gs_solver_descr, c_gs_solver_sizeof, & & c_gs_solver_default, c_gs_solver_dmp, & & c_gs_solver_apply_vect, c_gs_solver_get_nzeros, & @@ -291,99 +287,6 @@ contains end subroutine c_gs_solver_check - - subroutine c_gs_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_c_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='c_gs_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_solver_sweeps_) - sv%sweeps = val - case default - call sv%mld_c_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine c_gs_solver_seti - - subroutine c_gs_solver_setc(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_c_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='c_gs_solver_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sv%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) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine c_gs_solver_setc - - subroutine c_gs_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_c_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='c_gs_solver_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - select case(what) - case(mld_solver_eps_) - sv%eps = val - case default - call sv%mld_c_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine c_gs_solver_setr - subroutine c_gs_solver_cseti(sv,what,val,info) Implicit None diff --git a/mlprec/mld_c_ilu_solver.f90 b/mlprec/mld_c_ilu_solver.f90 index 8ee43c46..f7358797 100644 --- a/mlprec/mld_c_ilu_solver.f90 +++ b/mlprec/mld_c_ilu_solver.f90 @@ -75,9 +75,6 @@ module mld_c_ilu_solver procedure, pass(sv) :: apply_v => mld_c_ilu_solver_apply_vect procedure, pass(sv) :: apply_a => mld_c_ilu_solver_apply procedure, pass(sv) :: free => c_ilu_solver_free - procedure, pass(sv) :: seti => c_ilu_solver_seti - procedure, pass(sv) :: setc => c_ilu_solver_setc - procedure, pass(sv) :: setr => c_ilu_solver_setr procedure, pass(sv) :: cseti => c_ilu_solver_cseti procedure, pass(sv) :: csetc => c_ilu_solver_csetc procedure, pass(sv) :: csetr => c_ilu_solver_csetr @@ -92,8 +89,7 @@ module mld_c_ilu_solver private :: c_ilu_solver_bld, c_ilu_solver_apply, & - & c_ilu_solver_free, c_ilu_solver_seti, & - & c_ilu_solver_setc, c_ilu_solver_setr,& + & c_ilu_solver_free, & & c_ilu_solver_descr, c_ilu_solver_sizeof, & & c_ilu_solver_default, c_ilu_solver_dmp, & & c_ilu_solver_apply_vect, c_ilu_solver_get_nzeros, & @@ -251,101 +247,6 @@ contains end subroutine c_ilu_solver_check - - subroutine c_ilu_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_c_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='c_ilu_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_sub_solve_) - sv%fact_type = val - case(mld_sub_fillin_) - sv%fill_in = val - case default - call sv%mld_c_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine c_ilu_solver_seti - - subroutine c_ilu_solver_setc(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_c_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='c_ilu_solver_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sv%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) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine c_ilu_solver_setc - - subroutine c_ilu_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_c_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='c_ilu_solver_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - select case(what) - case(mld_sub_iluthrs_) - sv%thresh = val - case default - call sv%mld_c_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine c_ilu_solver_setr - subroutine c_ilu_solver_cseti(sv,what,val,info) Implicit None diff --git a/mlprec/mld_c_mumps_solver.F90 b/mlprec/mld_c_mumps_solver.F90 index cf4b2db8..0e2baca4 100644 --- a/mlprec/mld_c_mumps_solver.F90 +++ b/mlprec/mld_c_mumps_solver.F90 @@ -76,8 +76,6 @@ module mld_c_mumps_solver procedure, pass(sv) :: free => c_mumps_solver_free procedure, pass(sv) :: descr => c_mumps_solver_descr procedure, pass(sv) :: sizeof => c_mumps_solver_sizeof - procedure, pass(sv) :: seti => c_mumps_solver_seti - procedure, pass(sv) :: setr => c_mumps_solver_setr procedure, pass(sv) :: cseti =>c_mumps_solver_cseti procedure, pass(sv) :: csetr => c_mumps_solver_csetr procedure, pass(sv) :: default => c_mumps_solver_default @@ -93,8 +91,7 @@ module mld_c_mumps_solver private :: c_mumps_solver_bld, c_mumps_solver_apply, & & c_mumps_solver_free, c_mumps_solver_descr, & & c_mumps_solver_sizeof, c_mumps_solver_apply_vect,& - & c_mumps_solver_seti, c_mumps_solver_setr, & - & c_mumps_solver_cseti, c_mumps_solver_csetri, & + & c_mumps_solver_cseti, c_mumps_solver_csetr, & & c_mumps_solver_default, c_mumps_solver_get_fmt, & & c_mumps_solver_get_id #if defined(HAVE_FINAL) @@ -254,85 +251,9 @@ contains end subroutine c_mumps_solver_descr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!$ WARNING: OTHERS PARAMETERS OF MUMPS COULD BE ADDED. FOR THIS, ADD AN !!$ -!!$ INTEGER IN MLD_BASE_PREC_TYPE.F90 AND MODIFY SUBROUTINE SET !!$ +!! WARNING: OTHERS PARAMETERS OF MUMPS COULD BE ADDED. !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine c_mumps_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_c_mumps_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_mumps_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - select case(what) -#if defined(HAVE_MUMPS_) - case(mld_as_sequential_) - sv%ipar(1)=val - case(mld_mumps_print_err_) - sv%ipar(2)=val - !case(mld_print_stat_) - ! sv%id%icntl(2)=val - ! sv%ipar(2)=val - !case(mld_print_glob_) - ! sv%id%icntl(3)=val - ! sv%ipar(3)=val -#endif - case default - call sv%mld_c_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine c_mumps_solver_seti - - - subroutine c_mumps_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_c_mumps_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_mumps_solver_setr' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case default - call sv%mld_c_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine c_mumps_solver_setr subroutine c_mumps_solver_cseti(sv,what,val,info) @@ -343,7 +264,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, iwhat + integer(psb_ipk_) :: err_act character(len=20) :: name='c_mumps_solver_cseti' info = psb_success_ @@ -351,20 +272,15 @@ contains select case(psb_toupper(what)) #if defined(HAVE_MUMPS_) - case('SET_AS_SEQUENTIAL') - iwhat=mld_as_sequential_ - case('SET_MUMPS_PRINT_ERR') - iwhat=mld_mumps_print_err_ + case('MUMPS_AS_SEQUENTIAL') + sv%ipar(1)=val + case('MUMPS_PRINT_ERR') + sv%ipar(2)=val #endif case default - iwhat=-1 + call sv%mld_c_base_solver_type%set(what,val,info) end select - if (iwhat >=0 ) then - call sv%set(iwhat,val,info) - else - call sv%mld_c_base_solver_type%set(what,val,info) - end if call psb_erractionrestore(err_act) return @@ -386,7 +302,7 @@ contains character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, iwhat + integer(psb_ipk_) :: err_act character(len=20) :: name='c_mumps_solver_csetr' info = psb_success_ @@ -397,12 +313,6 @@ contains call sv%mld_c_base_solver_type%set(what,val,info) end select - if (iwhat >=0 ) then - call sv%set(iwhat,val,info) - else - call sv%mld_c_base_solver_type%set(what,val,info) - end if - call psb_erractionrestore(err_act) return diff --git a/mlprec/mld_c_onelev_mod.f90 b/mlprec/mld_c_onelev_mod.f90 index 1ca988ed..b836b66b 100644 --- a/mlprec/mld_c_onelev_mod.f90 +++ b/mlprec/mld_c_onelev_mod.f90 @@ -163,17 +163,13 @@ module mld_c_onelev_mod procedure, pass(lv) :: nullify => c_base_onelev_nullify procedure, pass(lv) :: check => mld_c_base_onelev_check procedure, pass(lv) :: dump => mld_c_base_onelev_dump - procedure, pass(lv) :: seti => mld_c_base_onelev_seti - procedure, pass(lv) :: setr => mld_c_base_onelev_setr - procedure, pass(lv) :: setc => mld_c_base_onelev_setc procedure, pass(lv) :: cseti => mld_c_base_onelev_cseti procedure, pass(lv) :: csetr => mld_c_base_onelev_csetr procedure, pass(lv) :: csetc => mld_c_base_onelev_csetc procedure, pass(lv) :: setsm => mld_c_base_onelev_setsm procedure, pass(lv) :: setsv => mld_c_base_onelev_setsv procedure, pass(lv) :: setag => mld_c_base_onelev_setag - generic, public :: set => seti, setr, setc, & - & cseti, csetr, csetc, setsm, setsv, setag + generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag procedure, pass(lv) :: sizeof => c_base_onelev_sizeof procedure, pass(lv) :: get_nzeros => c_base_onelev_get_nzeros procedure, pass(lv) :: get_wrksz => c_base_onelev_get_wrksize @@ -274,22 +270,6 @@ module mld_c_onelev_mod end subroutine mld_c_base_onelev_check end interface - interface - subroutine mld_c_base_onelev_seti(lv,what,val,info,pos) - import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & - & psb_clinmap_type, psb_spk_, mld_c_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - - ! Arguments - class(mld_c_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_c_base_onelev_seti - end interface - interface subroutine mld_c_base_onelev_setsm(lv,val,info,pos) import :: psb_spk_, mld_c_onelev_type, mld_c_base_smoother_type, & @@ -332,37 +312,6 @@ module mld_c_onelev_mod end subroutine mld_c_base_onelev_setag end interface - interface - subroutine mld_c_base_onelev_setc(lv,what,val,info,pos) - import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & - & psb_clinmap_type, psb_spk_, mld_c_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - ! Arguments - class(mld_c_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_c_base_onelev_setc - end interface - - interface - subroutine mld_c_base_onelev_setr(lv,what,val,info,pos) - import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & - & psb_clinmap_type, psb_spk_, mld_c_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - - class(mld_c_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_c_base_onelev_setr - end interface - - interface subroutine mld_c_base_onelev_cseti(lv,what,val,info,pos) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & diff --git a/mlprec/mld_c_prec_mod.f90 b/mlprec/mld_c_prec_mod.f90 index 682b0548..990e4055 100644 --- a/mlprec/mld_c_prec_mod.f90 +++ b/mlprec/mld_c_prec_mod.f90 @@ -54,7 +54,6 @@ module mld_c_prec_mod interface mld_precset module procedure mld_c_iprecsetsm, mld_c_iprecsetsv, & - & mld_c_iprecseti, mld_c_iprecsetc, mld_c_iprecsetr, & & mld_c_cprecseti, mld_c_cprecsetc, mld_c_cprecsetr, & & mld_c_iprecsetag end interface mld_precset @@ -106,36 +105,6 @@ contains call p%set(val,info, pos=pos) end subroutine mld_c_iprecsetag - subroutine mld_c_iprecseti(p,what,val,info,pos) - type(mld_cprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_c_iprecseti - - subroutine mld_c_iprecsetr(p,what,val,info,pos) - type(mld_cprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_c_iprecsetr - - subroutine mld_c_iprecsetc(p,what,val,info,pos) - type(mld_cprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_c_iprecsetc - subroutine mld_c_cprecseti(p,what,val,info,pos) type(mld_cprec_type), intent(inout) :: p character(len=*), intent(in) :: what diff --git a/mlprec/mld_c_prec_type.f90 b/mlprec/mld_c_prec_type.f90 index a6f37391..7a9d4d13 100644 --- a/mlprec/mld_c_prec_type.f90 +++ b/mlprec/mld_c_prec_type.f90 @@ -128,14 +128,10 @@ module mld_c_prec_type procedure, pass(prec) :: setsm => mld_cprecsetsm procedure, pass(prec) :: setsv => mld_cprecsetsv procedure, pass(prec) :: setag => mld_cprecsetag - procedure, pass(prec) :: seti => mld_cprecseti - procedure, pass(prec) :: setc => mld_cprecsetc - procedure, pass(prec) :: setr => mld_cprecsetr procedure, pass(prec) :: cseti => mld_ccprecseti procedure, pass(prec) :: csetc => mld_ccprecsetc procedure, pass(prec) :: csetr => mld_ccprecsetr - generic, public :: set => seti, setc, setr, & - & cseti, csetc, csetr, setsm, setsv, setag + generic, public :: set => cseti, csetc, csetr, setsm, setsv, setag procedure, pass(prec) :: get_smoother => mld_c_get_smootherp procedure, pass(prec) :: get_solver => mld_c_get_solverp procedure, pass(prec) :: move_alloc => c_prec_move_alloc @@ -245,36 +241,6 @@ module mld_c_prec_type integer(psb_ipk_), optional, intent(in) :: ilev character(len=*), optional, intent(in) :: pos end subroutine mld_cprecsetag - subroutine mld_cprecseti(prec,what,val,info,ilev,ilmax,pos) - import :: psb_cspmat_type, psb_desc_type, psb_spk_, & - & mld_cprec_type, psb_ipk_ - class(mld_cprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_cprecseti - subroutine mld_cprecsetr(prec,what,val,info,ilev,ilmax,pos) - import :: psb_cspmat_type, psb_desc_type, psb_spk_, & - & mld_cprec_type, psb_ipk_ - class(mld_cprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_cprecsetr - subroutine mld_cprecsetc(prec,what,string,info,ilev,ilmax,pos) - import :: psb_cspmat_type, psb_desc_type, psb_spk_, & - & mld_cprec_type, psb_ipk_ - class(mld_cprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: string - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_cprecsetc subroutine mld_ccprecseti(prec,what,val,info,ilev,ilmax,pos) import :: psb_cspmat_type, psb_desc_type, psb_spk_, & & mld_cprec_type, psb_ipk_ diff --git a/mlprec/mld_c_symdec_aggregator_mod.f90 b/mlprec/mld_c_symdec_aggregator_mod.f90 index f3df179e..a3dd8fb9 100644 --- a/mlprec/mld_c_symdec_aggregator_mod.f90 +++ b/mlprec/mld_c_symdec_aggregator_mod.f90 @@ -95,6 +95,7 @@ module mld_c_symdec_aggregator_mod contains procedure, pass(ag) :: bld_tprol => mld_c_symdec_aggregator_build_tprol + procedure, pass(ag) :: descr => mld_c_symdec_aggregator_descr procedure, nopass :: fmt => mld_c_symdec_aggregator_fmt end type mld_c_symdec_aggregator_type @@ -124,4 +125,18 @@ contains val = "Symmetric Decoupled aggregation" end function mld_c_symdec_aggregator_fmt + subroutine mld_c_symdec_aggregator_descr(ag,parms,iout,info) + implicit none + class(mld_c_symdec_aggregator_type), intent(in) :: ag + type(mld_sml_parms), intent(in) :: parms + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + + write(iout,*) 'Decoupled Aggregator locally-symmetrized' + write(iout,*) 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info) + + return + end subroutine mld_c_symdec_aggregator_descr + end module mld_c_symdec_aggregator_mod diff --git a/mlprec/mld_d_as_smoother.f90 b/mlprec/mld_d_as_smoother.f90 index 7dcb6641..8aaee4b9 100644 --- a/mlprec/mld_d_as_smoother.f90 +++ b/mlprec/mld_d_as_smoother.f90 @@ -83,8 +83,6 @@ module mld_d_as_smoother generic, public :: apply_restr => restr_v, restr_a generic, public :: apply_prol => prol_v, prol_a procedure, pass(sm) :: free => mld_d_as_smoother_free - procedure, pass(sm) :: seti => mld_d_as_smoother_seti - procedure, pass(sm) :: setc => mld_d_as_smoother_setc procedure, pass(sm) :: cseti => mld_d_as_smoother_cseti procedure, pass(sm) :: csetc => mld_d_as_smoother_csetc procedure, pass(sm) :: descr => d_as_smoother_descr @@ -253,42 +251,6 @@ module mld_d_as_smoother end subroutine mld_d_as_smoother_cnv end interface - interface - subroutine mld_d_as_smoother_seti(sm,what,val,info) - import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_d_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_as_smoother_seti - end interface - - interface - subroutine mld_d_as_smoother_setc(sm,what,val,info) - import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_d_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_as_smoother_setc - end interface - - interface - subroutine mld_d_as_smoother_setr(sm,what,val,info) - import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_d_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_as_smoother_setr - end interface - interface subroutine mld_d_as_smoother_cseti(sm,what,val,info) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & diff --git a/mlprec/mld_d_base_aggregator_mod.f90 b/mlprec/mld_d_base_aggregator_mod.f90 index 7a2b1eea..71d73c60 100644 --- a/mlprec/mld_d_base_aggregator_mod.f90 +++ b/mlprec/mld_d_base_aggregator_mod.f90 @@ -104,9 +104,10 @@ module mld_d_base_aggregator_mod procedure, pass(ag) :: default => mld_d_base_aggregator_default procedure, pass(ag) :: descr => mld_d_base_aggregator_descr procedure, pass(ag) :: set_aggr_type => mld_d_base_aggregator_set_aggr_type - procedure, pass(ag) :: cseti => mld_d_base_aggregator_cseti - generic, public :: set => cseti procedure, nopass :: fmt => mld_d_base_aggregator_fmt + procedure, pass(ag) :: cseti => mld_d_base_aggregator_cseti + procedure, pass(ag) :: csetr => mld_d_base_aggregator_csetr + generic, public :: set => cseti, csetr end type mld_d_base_aggregator_type @@ -125,6 +126,20 @@ contains info = 0 end subroutine mld_d_base_aggregator_cseti + subroutine mld_d_base_aggregator_csetr(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_d_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_d_base_aggregator_csetr + + subroutine mld_d_base_aggregator_update_next(ag,agnext,info) implicit none class(mld_d_base_aggregator_type), target, intent(inout) :: ag, agnext diff --git a/mlprec/mld_d_base_smoother_mod.f90 b/mlprec/mld_d_base_smoother_mod.f90 index b382d100..18391f39 100644 --- a/mlprec/mld_d_base_smoother_mod.f90 +++ b/mlprec/mld_d_base_smoother_mod.f90 @@ -112,13 +112,10 @@ module mld_d_base_smoother_mod procedure, pass(sm) :: apply_a => mld_d_base_smoother_apply generic, public :: apply => apply_a, apply_v procedure, pass(sm) :: free => mld_d_base_smoother_free - procedure, pass(sm) :: seti => mld_d_base_smoother_seti - procedure, pass(sm) :: setc => mld_d_base_smoother_setc - procedure, pass(sm) :: setr => mld_d_base_smoother_setr procedure, pass(sm) :: cseti => mld_d_base_smoother_cseti procedure, pass(sm) :: csetc => mld_d_base_smoother_csetc procedure, pass(sm) :: csetr => mld_d_base_smoother_csetr - generic, public :: set => seti, setc, setr, cseti, csetc, csetr + generic, public :: set => cseti, csetc, csetr procedure, pass(sm) :: default => d_base_smoother_default procedure, pass(sm) :: descr => mld_d_base_smoother_descr procedure, pass(sm) :: sizeof => d_base_smoother_sizeof @@ -188,44 +185,6 @@ module mld_d_base_smoother_mod end subroutine mld_d_base_smoother_check end interface - interface - subroutine mld_d_base_smoother_seti(sm,what,val,info) - import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & - & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_base_smoother_type, psb_ipk_ - ! Arguments - class(mld_d_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_base_smoother_seti - end interface - - interface - subroutine mld_d_base_smoother_setc(sm,what,val,info) - import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & - & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_base_smoother_type, psb_ipk_ - class(mld_d_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_base_smoother_setc - end interface - - interface - subroutine mld_d_base_smoother_setr(sm,what,val,info) - import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & - & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_base_smoother_type, psb_ipk_ - ! Arguments - class(mld_d_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_base_smoother_setr - end interface - interface subroutine mld_d_base_smoother_cseti(sm,what,val,info) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & diff --git a/mlprec/mld_d_base_solver_mod.f90 b/mlprec/mld_d_base_solver_mod.f90 index 26e860e2..536f4ee6 100644 --- a/mlprec/mld_d_base_solver_mod.f90 +++ b/mlprec/mld_d_base_solver_mod.f90 @@ -96,13 +96,10 @@ module mld_d_base_solver_mod procedure, pass(sv) :: apply_a => mld_d_base_solver_apply generic, public :: apply => apply_a, apply_v procedure, pass(sv) :: free => mld_d_base_solver_free - procedure, pass(sv) :: seti => mld_d_base_solver_seti - procedure, pass(sv) :: setc => mld_d_base_solver_setc - procedure, pass(sv) :: setr => mld_d_base_solver_setr procedure, pass(sv) :: cseti => mld_d_base_solver_cseti procedure, pass(sv) :: csetc => mld_d_base_solver_csetc procedure, pass(sv) :: csetr => mld_d_base_solver_csetr - generic, public :: set => seti, setc, setr, cseti, csetc, csetr + generic, public :: set => cseti, csetc, csetr procedure, pass(sv) :: default => d_base_solver_default procedure, pass(sv) :: descr => mld_d_base_solver_descr procedure, pass(sv) :: sizeof => d_base_solver_sizeof @@ -209,50 +206,6 @@ module mld_d_base_solver_mod end subroutine mld_d_base_solver_check end interface - interface - subroutine mld_d_base_solver_seti(sv,what,val,info) - import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & - & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_base_solver_type, psb_ipk_ - Implicit None - - ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_base_solver_seti - end interface - - interface - subroutine mld_d_base_solver_setc(sv,what,val,info) - import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & - & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_base_solver_type, psb_ipk_ - Implicit None - - ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_base_solver_setc - end interface - - interface - subroutine mld_d_base_solver_setr(sv,what,val,info) - import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & - & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_base_solver_type, psb_ipk_ - Implicit None - ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_d_base_solver_setr - end interface - interface subroutine mld_d_base_solver_cseti(sv,what,val,info) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & diff --git a/mlprec/mld_d_dec_aggregator_mod.f90 b/mlprec/mld_d_dec_aggregator_mod.f90 index c835cd0b..3fa0247f 100644 --- a/mlprec/mld_d_dec_aggregator_mod.f90 +++ b/mlprec/mld_d_dec_aggregator_mod.f90 @@ -190,7 +190,7 @@ contains val = "Decoupled aggregation" end function mld_d_dec_aggregator_fmt - + subroutine mld_d_dec_aggregator_descr(ag,parms,iout,info) implicit none class(mld_d_dec_aggregator_type), intent(in) :: ag @@ -204,5 +204,5 @@ contains return end subroutine mld_d_dec_aggregator_descr - + end module mld_d_dec_aggregator_mod diff --git a/mlprec/mld_d_gs_solver.f90 b/mlprec/mld_d_gs_solver.f90 index 35c818dc..46ac5898 100644 --- a/mlprec/mld_d_gs_solver.f90 +++ b/mlprec/mld_d_gs_solver.f90 @@ -67,9 +67,6 @@ module mld_d_gs_solver procedure, pass(sv) :: apply_v => mld_d_gs_solver_apply_vect procedure, pass(sv) :: apply_a => mld_d_gs_solver_apply procedure, pass(sv) :: free => d_gs_solver_free - procedure, pass(sv) :: seti => d_gs_solver_seti - procedure, pass(sv) :: setc => d_gs_solver_setc - procedure, pass(sv) :: setr => d_gs_solver_setr procedure, pass(sv) :: cseti => d_gs_solver_cseti procedure, pass(sv) :: csetc => d_gs_solver_csetc procedure, pass(sv) :: csetr => d_gs_solver_csetr @@ -95,8 +92,7 @@ module mld_d_gs_solver private :: d_gs_solver_bld, d_gs_solver_apply, & - & d_gs_solver_free, d_gs_solver_seti, & - & d_gs_solver_setc, d_gs_solver_setr,& + & d_gs_solver_free, & & d_gs_solver_descr, d_gs_solver_sizeof, & & d_gs_solver_default, d_gs_solver_dmp, & & d_gs_solver_apply_vect, d_gs_solver_get_nzeros, & @@ -291,99 +287,6 @@ contains end subroutine d_gs_solver_check - - subroutine d_gs_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_d_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_gs_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_solver_sweeps_) - sv%sweeps = val - case default - call sv%mld_d_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine d_gs_solver_seti - - subroutine d_gs_solver_setc(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_d_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='d_gs_solver_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sv%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) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine d_gs_solver_setc - - subroutine d_gs_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_d_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_gs_solver_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - select case(what) - case(mld_solver_eps_) - sv%eps = val - case default - call sv%mld_d_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine d_gs_solver_setr - subroutine d_gs_solver_cseti(sv,what,val,info) Implicit None diff --git a/mlprec/mld_d_ilu_solver.f90 b/mlprec/mld_d_ilu_solver.f90 index 2f435a35..e6b177a2 100644 --- a/mlprec/mld_d_ilu_solver.f90 +++ b/mlprec/mld_d_ilu_solver.f90 @@ -75,9 +75,6 @@ module mld_d_ilu_solver procedure, pass(sv) :: apply_v => mld_d_ilu_solver_apply_vect procedure, pass(sv) :: apply_a => mld_d_ilu_solver_apply procedure, pass(sv) :: free => d_ilu_solver_free - procedure, pass(sv) :: seti => d_ilu_solver_seti - procedure, pass(sv) :: setc => d_ilu_solver_setc - procedure, pass(sv) :: setr => d_ilu_solver_setr procedure, pass(sv) :: cseti => d_ilu_solver_cseti procedure, pass(sv) :: csetc => d_ilu_solver_csetc procedure, pass(sv) :: csetr => d_ilu_solver_csetr @@ -92,8 +89,7 @@ module mld_d_ilu_solver private :: d_ilu_solver_bld, d_ilu_solver_apply, & - & d_ilu_solver_free, d_ilu_solver_seti, & - & d_ilu_solver_setc, d_ilu_solver_setr,& + & d_ilu_solver_free, & & d_ilu_solver_descr, d_ilu_solver_sizeof, & & d_ilu_solver_default, d_ilu_solver_dmp, & & d_ilu_solver_apply_vect, d_ilu_solver_get_nzeros, & @@ -251,101 +247,6 @@ contains end subroutine d_ilu_solver_check - - subroutine d_ilu_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_d_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_ilu_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_sub_solve_) - sv%fact_type = val - case(mld_sub_fillin_) - sv%fill_in = val - case default - call sv%mld_d_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine d_ilu_solver_seti - - subroutine d_ilu_solver_setc(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_d_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='d_ilu_solver_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sv%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) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine d_ilu_solver_setc - - subroutine d_ilu_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_d_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='d_ilu_solver_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - select case(what) - case(mld_sub_iluthrs_) - sv%thresh = val - case default - call sv%mld_d_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine d_ilu_solver_setr - subroutine d_ilu_solver_cseti(sv,what,val,info) Implicit None diff --git a/mlprec/mld_d_mumps_solver.F90 b/mlprec/mld_d_mumps_solver.F90 index 2f2dab5f..f41822d8 100644 --- a/mlprec/mld_d_mumps_solver.F90 +++ b/mlprec/mld_d_mumps_solver.F90 @@ -76,8 +76,6 @@ module mld_d_mumps_solver procedure, pass(sv) :: free => d_mumps_solver_free procedure, pass(sv) :: descr => d_mumps_solver_descr procedure, pass(sv) :: sizeof => d_mumps_solver_sizeof - procedure, pass(sv) :: seti => d_mumps_solver_seti - procedure, pass(sv) :: setr => d_mumps_solver_setr procedure, pass(sv) :: cseti =>d_mumps_solver_cseti procedure, pass(sv) :: csetr => d_mumps_solver_csetr procedure, pass(sv) :: default => d_mumps_solver_default @@ -93,8 +91,7 @@ module mld_d_mumps_solver private :: d_mumps_solver_bld, d_mumps_solver_apply, & & d_mumps_solver_free, d_mumps_solver_descr, & & d_mumps_solver_sizeof, d_mumps_solver_apply_vect,& - & d_mumps_solver_seti, d_mumps_solver_setr, & - & d_mumps_solver_cseti, d_mumps_solver_csetri, & + & d_mumps_solver_cseti, d_mumps_solver_csetr, & & d_mumps_solver_default, d_mumps_solver_get_fmt, & & d_mumps_solver_get_id #if defined(HAVE_FINAL) @@ -254,85 +251,9 @@ contains end subroutine d_mumps_solver_descr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!$ WARNING: OTHERS PARAMETERS OF MUMPS COULD BE ADDED. FOR THIS, ADD AN !!$ -!!$ INTEGER IN MLD_BASE_PREC_TYPE.F90 AND MODIFY SUBROUTINE SET !!$ +!! WARNING: OTHERS PARAMETERS OF MUMPS COULD BE ADDED. !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine d_mumps_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_d_mumps_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_mumps_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - select case(what) -#if defined(HAVE_MUMPS_) - case(mld_as_sequential_) - sv%ipar(1)=val - case(mld_mumps_print_err_) - sv%ipar(2)=val - !case(mld_print_stat_) - ! sv%id%icntl(2)=val - ! sv%ipar(2)=val - !case(mld_print_glob_) - ! sv%id%icntl(3)=val - ! sv%ipar(3)=val -#endif - case default - call sv%mld_d_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine d_mumps_solver_seti - - - subroutine d_mumps_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_d_mumps_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_mumps_solver_setr' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case default - call sv%mld_d_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine d_mumps_solver_setr subroutine d_mumps_solver_cseti(sv,what,val,info) @@ -343,7 +264,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, iwhat + integer(psb_ipk_) :: err_act character(len=20) :: name='d_mumps_solver_cseti' info = psb_success_ @@ -351,20 +272,15 @@ contains select case(psb_toupper(what)) #if defined(HAVE_MUMPS_) - case('SET_AS_SEQUENTIAL') - iwhat=mld_as_sequential_ - case('SET_MUMPS_PRINT_ERR') - iwhat=mld_mumps_print_err_ + case('MUMPS_AS_SEQUENTIAL') + sv%ipar(1)=val + case('MUMPS_PRINT_ERR') + sv%ipar(2)=val #endif case default - iwhat=-1 + call sv%mld_d_base_solver_type%set(what,val,info) end select - if (iwhat >=0 ) then - call sv%set(iwhat,val,info) - else - call sv%mld_d_base_solver_type%set(what,val,info) - end if call psb_erractionrestore(err_act) return @@ -386,7 +302,7 @@ contains character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, iwhat + integer(psb_ipk_) :: err_act character(len=20) :: name='d_mumps_solver_csetr' info = psb_success_ @@ -397,12 +313,6 @@ contains call sv%mld_d_base_solver_type%set(what,val,info) end select - if (iwhat >=0 ) then - call sv%set(iwhat,val,info) - else - call sv%mld_d_base_solver_type%set(what,val,info) - end if - call psb_erractionrestore(err_act) return diff --git a/mlprec/mld_d_onelev_mod.f90 b/mlprec/mld_d_onelev_mod.f90 index 25caa9d7..7cc6a728 100644 --- a/mlprec/mld_d_onelev_mod.f90 +++ b/mlprec/mld_d_onelev_mod.f90 @@ -163,17 +163,13 @@ module mld_d_onelev_mod procedure, pass(lv) :: nullify => d_base_onelev_nullify procedure, pass(lv) :: check => mld_d_base_onelev_check procedure, pass(lv) :: dump => mld_d_base_onelev_dump - procedure, pass(lv) :: seti => mld_d_base_onelev_seti - procedure, pass(lv) :: setr => mld_d_base_onelev_setr - procedure, pass(lv) :: setc => mld_d_base_onelev_setc procedure, pass(lv) :: cseti => mld_d_base_onelev_cseti procedure, pass(lv) :: csetr => mld_d_base_onelev_csetr procedure, pass(lv) :: csetc => mld_d_base_onelev_csetc procedure, pass(lv) :: setsm => mld_d_base_onelev_setsm procedure, pass(lv) :: setsv => mld_d_base_onelev_setsv procedure, pass(lv) :: setag => mld_d_base_onelev_setag - generic, public :: set => seti, setr, setc, & - & cseti, csetr, csetc, setsm, setsv, setag + generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag procedure, pass(lv) :: sizeof => d_base_onelev_sizeof procedure, pass(lv) :: get_nzeros => d_base_onelev_get_nzeros procedure, pass(lv) :: get_wrksz => d_base_onelev_get_wrksize @@ -274,22 +270,6 @@ module mld_d_onelev_mod end subroutine mld_d_base_onelev_check end interface - interface - subroutine mld_d_base_onelev_seti(lv,what,val,info,pos) - import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - - ! Arguments - class(mld_d_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_d_base_onelev_seti - end interface - interface subroutine mld_d_base_onelev_setsm(lv,val,info,pos) import :: psb_dpk_, mld_d_onelev_type, mld_d_base_smoother_type, & @@ -332,37 +312,6 @@ module mld_d_onelev_mod end subroutine mld_d_base_onelev_setag end interface - interface - subroutine mld_d_base_onelev_setc(lv,what,val,info,pos) - import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - ! Arguments - class(mld_d_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_d_base_onelev_setc - end interface - - interface - subroutine mld_d_base_onelev_setr(lv,what,val,info,pos) - import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dlinmap_type, psb_dpk_, mld_d_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - - class(mld_d_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_d_base_onelev_setr - end interface - - interface subroutine mld_d_base_onelev_cseti(lv,what,val,info,pos) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & diff --git a/mlprec/mld_d_prec_mod.f90 b/mlprec/mld_d_prec_mod.f90 index e9ffb466..aff3a958 100644 --- a/mlprec/mld_d_prec_mod.f90 +++ b/mlprec/mld_d_prec_mod.f90 @@ -54,7 +54,6 @@ module mld_d_prec_mod interface mld_precset module procedure mld_d_iprecsetsm, mld_d_iprecsetsv, & - & mld_d_iprecseti, mld_d_iprecsetc, mld_d_iprecsetr, & & mld_d_cprecseti, mld_d_cprecsetc, mld_d_cprecsetr, & & mld_d_iprecsetag end interface mld_precset @@ -106,36 +105,6 @@ contains call p%set(val,info, pos=pos) end subroutine mld_d_iprecsetag - subroutine mld_d_iprecseti(p,what,val,info,pos) - type(mld_dprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_d_iprecseti - - subroutine mld_d_iprecsetr(p,what,val,info,pos) - type(mld_dprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_d_iprecsetr - - subroutine mld_d_iprecsetc(p,what,val,info,pos) - type(mld_dprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_d_iprecsetc - subroutine mld_d_cprecseti(p,what,val,info,pos) type(mld_dprec_type), intent(inout) :: p character(len=*), intent(in) :: what diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index 64036b94..a2d6e763 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -128,14 +128,10 @@ module mld_d_prec_type procedure, pass(prec) :: setsm => mld_dprecsetsm procedure, pass(prec) :: setsv => mld_dprecsetsv procedure, pass(prec) :: setag => mld_dprecsetag - procedure, pass(prec) :: seti => mld_dprecseti - procedure, pass(prec) :: setc => mld_dprecsetc - procedure, pass(prec) :: setr => mld_dprecsetr procedure, pass(prec) :: cseti => mld_dcprecseti procedure, pass(prec) :: csetc => mld_dcprecsetc procedure, pass(prec) :: csetr => mld_dcprecsetr - generic, public :: set => seti, setc, setr, & - & cseti, csetc, csetr, setsm, setsv, setag + generic, public :: set => cseti, csetc, csetr, setsm, setsv, setag procedure, pass(prec) :: get_smoother => mld_d_get_smootherp procedure, pass(prec) :: get_solver => mld_d_get_solverp procedure, pass(prec) :: move_alloc => d_prec_move_alloc @@ -245,36 +241,6 @@ module mld_d_prec_type integer(psb_ipk_), optional, intent(in) :: ilev character(len=*), optional, intent(in) :: pos end subroutine mld_dprecsetag - subroutine mld_dprecseti(prec,what,val,info,ilev,ilmax,pos) - import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & - & mld_dprec_type, psb_ipk_ - class(mld_dprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_dprecseti - subroutine mld_dprecsetr(prec,what,val,info,ilev,ilmax,pos) - import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & - & mld_dprec_type, psb_ipk_ - class(mld_dprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_dprecsetr - subroutine mld_dprecsetc(prec,what,string,info,ilev,ilmax,pos) - import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & - & mld_dprec_type, psb_ipk_ - class(mld_dprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: string - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_dprecsetc subroutine mld_dcprecseti(prec,what,val,info,ilev,ilmax,pos) import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & & mld_dprec_type, psb_ipk_ diff --git a/mlprec/mld_s_as_smoother.f90 b/mlprec/mld_s_as_smoother.f90 index a9ef488d..f7abe638 100644 --- a/mlprec/mld_s_as_smoother.f90 +++ b/mlprec/mld_s_as_smoother.f90 @@ -83,8 +83,6 @@ module mld_s_as_smoother generic, public :: apply_restr => restr_v, restr_a generic, public :: apply_prol => prol_v, prol_a procedure, pass(sm) :: free => mld_s_as_smoother_free - procedure, pass(sm) :: seti => mld_s_as_smoother_seti - procedure, pass(sm) :: setc => mld_s_as_smoother_setc procedure, pass(sm) :: cseti => mld_s_as_smoother_cseti procedure, pass(sm) :: csetc => mld_s_as_smoother_csetc procedure, pass(sm) :: descr => s_as_smoother_descr @@ -253,42 +251,6 @@ module mld_s_as_smoother end subroutine mld_s_as_smoother_cnv end interface - interface - subroutine mld_s_as_smoother_seti(sm,what,val,info) - import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & - & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_s_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_as_smoother_seti - end interface - - interface - subroutine mld_s_as_smoother_setc(sm,what,val,info) - import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & - & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_s_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_as_smoother_setc - end interface - - interface - subroutine mld_s_as_smoother_setr(sm,what,val,info) - import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & - & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_s_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_as_smoother_setr - end interface - interface subroutine mld_s_as_smoother_cseti(sm,what,val,info) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & diff --git a/mlprec/mld_s_base_aggregator_mod.f90 b/mlprec/mld_s_base_aggregator_mod.f90 index f668023a..468ecbbc 100644 --- a/mlprec/mld_s_base_aggregator_mod.f90 +++ b/mlprec/mld_s_base_aggregator_mod.f90 @@ -105,11 +105,41 @@ module mld_s_base_aggregator_mod procedure, pass(ag) :: descr => mld_s_base_aggregator_descr procedure, pass(ag) :: set_aggr_type => mld_s_base_aggregator_set_aggr_type procedure, nopass :: fmt => mld_s_base_aggregator_fmt + procedure, pass(ag) :: cseti => mld_s_base_aggregator_cseti + procedure, pass(ag) :: csetr => mld_s_base_aggregator_csetr + generic, public :: set => cseti, csetr end type mld_s_base_aggregator_type contains + subroutine mld_s_base_aggregator_cseti(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_s_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_s_base_aggregator_cseti + + subroutine mld_s_base_aggregator_csetr(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_s_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_s_base_aggregator_csetr + + subroutine mld_s_base_aggregator_update_next(ag,agnext,info) implicit none class(mld_s_base_aggregator_type), target, intent(inout) :: ag, agnext @@ -159,7 +189,7 @@ contains implicit none character(len=32) :: val - val = "Null " + val = "Default aggregator " end function mld_s_base_aggregator_fmt subroutine mld_s_base_aggregator_descr(ag,parms,iout,info) @@ -169,6 +199,7 @@ contains integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + write(iout,*) 'Aggregator object type: ',ag%fmt() call parms%mldescr(iout,info) return diff --git a/mlprec/mld_s_base_smoother_mod.f90 b/mlprec/mld_s_base_smoother_mod.f90 index 25b35dae..0097e6e2 100644 --- a/mlprec/mld_s_base_smoother_mod.f90 +++ b/mlprec/mld_s_base_smoother_mod.f90 @@ -112,13 +112,10 @@ module mld_s_base_smoother_mod procedure, pass(sm) :: apply_a => mld_s_base_smoother_apply generic, public :: apply => apply_a, apply_v procedure, pass(sm) :: free => mld_s_base_smoother_free - procedure, pass(sm) :: seti => mld_s_base_smoother_seti - procedure, pass(sm) :: setc => mld_s_base_smoother_setc - procedure, pass(sm) :: setr => mld_s_base_smoother_setr procedure, pass(sm) :: cseti => mld_s_base_smoother_cseti procedure, pass(sm) :: csetc => mld_s_base_smoother_csetc procedure, pass(sm) :: csetr => mld_s_base_smoother_csetr - generic, public :: set => seti, setc, setr, cseti, csetc, csetr + generic, public :: set => cseti, csetc, csetr procedure, pass(sm) :: default => s_base_smoother_default procedure, pass(sm) :: descr => mld_s_base_smoother_descr procedure, pass(sm) :: sizeof => s_base_smoother_sizeof @@ -188,44 +185,6 @@ module mld_s_base_smoother_mod end subroutine mld_s_base_smoother_check end interface - interface - subroutine mld_s_base_smoother_seti(sm,what,val,info) - import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & - & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & - & mld_s_base_smoother_type, psb_ipk_ - ! Arguments - class(mld_s_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_base_smoother_seti - end interface - - interface - subroutine mld_s_base_smoother_setc(sm,what,val,info) - import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & - & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & - & mld_s_base_smoother_type, psb_ipk_ - class(mld_s_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_base_smoother_setc - end interface - - interface - subroutine mld_s_base_smoother_setr(sm,what,val,info) - import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & - & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & - & mld_s_base_smoother_type, psb_ipk_ - ! Arguments - class(mld_s_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_base_smoother_setr - end interface - interface subroutine mld_s_base_smoother_cseti(sm,what,val,info) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & diff --git a/mlprec/mld_s_base_solver_mod.f90 b/mlprec/mld_s_base_solver_mod.f90 index 1282a8c7..2d31f730 100644 --- a/mlprec/mld_s_base_solver_mod.f90 +++ b/mlprec/mld_s_base_solver_mod.f90 @@ -96,13 +96,10 @@ module mld_s_base_solver_mod procedure, pass(sv) :: apply_a => mld_s_base_solver_apply generic, public :: apply => apply_a, apply_v procedure, pass(sv) :: free => mld_s_base_solver_free - procedure, pass(sv) :: seti => mld_s_base_solver_seti - procedure, pass(sv) :: setc => mld_s_base_solver_setc - procedure, pass(sv) :: setr => mld_s_base_solver_setr procedure, pass(sv) :: cseti => mld_s_base_solver_cseti procedure, pass(sv) :: csetc => mld_s_base_solver_csetc procedure, pass(sv) :: csetr => mld_s_base_solver_csetr - generic, public :: set => seti, setc, setr, cseti, csetc, csetr + generic, public :: set => cseti, csetc, csetr procedure, pass(sv) :: default => s_base_solver_default procedure, pass(sv) :: descr => mld_s_base_solver_descr procedure, pass(sv) :: sizeof => s_base_solver_sizeof @@ -209,50 +206,6 @@ module mld_s_base_solver_mod end subroutine mld_s_base_solver_check end interface - interface - subroutine mld_s_base_solver_seti(sv,what,val,info) - import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & - & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & - & mld_s_base_solver_type, psb_ipk_ - Implicit None - - ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_base_solver_seti - end interface - - interface - subroutine mld_s_base_solver_setc(sv,what,val,info) - import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & - & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & - & mld_s_base_solver_type, psb_ipk_ - Implicit None - - ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_base_solver_setc - end interface - - interface - subroutine mld_s_base_solver_setr(sv,what,val,info) - import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & - & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & - & mld_s_base_solver_type, psb_ipk_ - Implicit None - ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_s_base_solver_setr - end interface - interface subroutine mld_s_base_solver_cseti(sv,what,val,info) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & diff --git a/mlprec/mld_s_dec_aggregator_mod.f90 b/mlprec/mld_s_dec_aggregator_mod.f90 index f1c80053..ccd4b1d6 100644 --- a/mlprec/mld_s_dec_aggregator_mod.f90 +++ b/mlprec/mld_s_dec_aggregator_mod.f90 @@ -97,6 +97,7 @@ module mld_s_dec_aggregator_mod procedure, pass(ag) :: mat_asb => mld_s_dec_aggregator_mat_asb procedure, pass(ag) :: default => mld_s_dec_aggregator_default procedure, pass(ag) :: set_aggr_type => mld_s_dec_aggregator_set_aggr_type + procedure, pass(ag) :: descr => mld_s_dec_aggregator_descr procedure, nopass :: fmt => mld_s_dec_aggregator_fmt end type mld_s_dec_aggregator_type @@ -190,4 +191,18 @@ contains val = "Decoupled aggregation" end function mld_s_dec_aggregator_fmt + subroutine mld_s_dec_aggregator_descr(ag,parms,iout,info) + implicit none + class(mld_s_dec_aggregator_type), intent(in) :: ag + type(mld_sml_parms), intent(in) :: parms + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + + write(iout,*) 'Decoupled Aggregator' + write(iout,*) 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info) + + return + end subroutine mld_s_dec_aggregator_descr + end module mld_s_dec_aggregator_mod diff --git a/mlprec/mld_s_gs_solver.f90 b/mlprec/mld_s_gs_solver.f90 index a9cb146a..6029c2bb 100644 --- a/mlprec/mld_s_gs_solver.f90 +++ b/mlprec/mld_s_gs_solver.f90 @@ -67,9 +67,6 @@ module mld_s_gs_solver procedure, pass(sv) :: apply_v => mld_s_gs_solver_apply_vect procedure, pass(sv) :: apply_a => mld_s_gs_solver_apply procedure, pass(sv) :: free => s_gs_solver_free - procedure, pass(sv) :: seti => s_gs_solver_seti - procedure, pass(sv) :: setc => s_gs_solver_setc - procedure, pass(sv) :: setr => s_gs_solver_setr procedure, pass(sv) :: cseti => s_gs_solver_cseti procedure, pass(sv) :: csetc => s_gs_solver_csetc procedure, pass(sv) :: csetr => s_gs_solver_csetr @@ -95,8 +92,7 @@ module mld_s_gs_solver private :: s_gs_solver_bld, s_gs_solver_apply, & - & s_gs_solver_free, s_gs_solver_seti, & - & s_gs_solver_setc, s_gs_solver_setr,& + & s_gs_solver_free, & & s_gs_solver_descr, s_gs_solver_sizeof, & & s_gs_solver_default, s_gs_solver_dmp, & & s_gs_solver_apply_vect, s_gs_solver_get_nzeros, & @@ -291,99 +287,6 @@ contains end subroutine s_gs_solver_check - - subroutine s_gs_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_s_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='s_gs_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_solver_sweeps_) - sv%sweeps = val - case default - call sv%mld_s_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine s_gs_solver_seti - - subroutine s_gs_solver_setc(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_s_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='s_gs_solver_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sv%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) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine s_gs_solver_setc - - subroutine s_gs_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_s_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='s_gs_solver_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - select case(what) - case(mld_solver_eps_) - sv%eps = val - case default - call sv%mld_s_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine s_gs_solver_setr - subroutine s_gs_solver_cseti(sv,what,val,info) Implicit None diff --git a/mlprec/mld_s_ilu_solver.f90 b/mlprec/mld_s_ilu_solver.f90 index a8d0e919..b80632f1 100644 --- a/mlprec/mld_s_ilu_solver.f90 +++ b/mlprec/mld_s_ilu_solver.f90 @@ -75,9 +75,6 @@ module mld_s_ilu_solver procedure, pass(sv) :: apply_v => mld_s_ilu_solver_apply_vect procedure, pass(sv) :: apply_a => mld_s_ilu_solver_apply procedure, pass(sv) :: free => s_ilu_solver_free - procedure, pass(sv) :: seti => s_ilu_solver_seti - procedure, pass(sv) :: setc => s_ilu_solver_setc - procedure, pass(sv) :: setr => s_ilu_solver_setr procedure, pass(sv) :: cseti => s_ilu_solver_cseti procedure, pass(sv) :: csetc => s_ilu_solver_csetc procedure, pass(sv) :: csetr => s_ilu_solver_csetr @@ -92,8 +89,7 @@ module mld_s_ilu_solver private :: s_ilu_solver_bld, s_ilu_solver_apply, & - & s_ilu_solver_free, s_ilu_solver_seti, & - & s_ilu_solver_setc, s_ilu_solver_setr,& + & s_ilu_solver_free, & & s_ilu_solver_descr, s_ilu_solver_sizeof, & & s_ilu_solver_default, s_ilu_solver_dmp, & & s_ilu_solver_apply_vect, s_ilu_solver_get_nzeros, & @@ -251,101 +247,6 @@ contains end subroutine s_ilu_solver_check - - subroutine s_ilu_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_s_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='s_ilu_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_sub_solve_) - sv%fact_type = val - case(mld_sub_fillin_) - sv%fill_in = val - case default - call sv%mld_s_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine s_ilu_solver_seti - - subroutine s_ilu_solver_setc(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_s_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='s_ilu_solver_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sv%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) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine s_ilu_solver_setc - - subroutine s_ilu_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_s_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='s_ilu_solver_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - select case(what) - case(mld_sub_iluthrs_) - sv%thresh = val - case default - call sv%mld_s_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine s_ilu_solver_setr - subroutine s_ilu_solver_cseti(sv,what,val,info) Implicit None diff --git a/mlprec/mld_s_mumps_solver.F90 b/mlprec/mld_s_mumps_solver.F90 index 464f0a75..4b4e4f7e 100644 --- a/mlprec/mld_s_mumps_solver.F90 +++ b/mlprec/mld_s_mumps_solver.F90 @@ -76,8 +76,6 @@ module mld_s_mumps_solver procedure, pass(sv) :: free => s_mumps_solver_free procedure, pass(sv) :: descr => s_mumps_solver_descr procedure, pass(sv) :: sizeof => s_mumps_solver_sizeof - procedure, pass(sv) :: seti => s_mumps_solver_seti - procedure, pass(sv) :: setr => s_mumps_solver_setr procedure, pass(sv) :: cseti =>s_mumps_solver_cseti procedure, pass(sv) :: csetr => s_mumps_solver_csetr procedure, pass(sv) :: default => s_mumps_solver_default @@ -93,8 +91,7 @@ module mld_s_mumps_solver private :: s_mumps_solver_bld, s_mumps_solver_apply, & & s_mumps_solver_free, s_mumps_solver_descr, & & s_mumps_solver_sizeof, s_mumps_solver_apply_vect,& - & s_mumps_solver_seti, s_mumps_solver_setr, & - & s_mumps_solver_cseti, s_mumps_solver_csetri, & + & s_mumps_solver_cseti, s_mumps_solver_csetr, & & s_mumps_solver_default, s_mumps_solver_get_fmt, & & s_mumps_solver_get_id #if defined(HAVE_FINAL) @@ -254,85 +251,9 @@ contains end subroutine s_mumps_solver_descr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!$ WARNING: OTHERS PARAMETERS OF MUMPS COULD BE ADDED. FOR THIS, ADD AN !!$ -!!$ INTEGER IN MLD_BASE_PREC_TYPE.F90 AND MODIFY SUBROUTINE SET !!$ +!! WARNING: OTHERS PARAMETERS OF MUMPS COULD BE ADDED. !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine s_mumps_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_s_mumps_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_mumps_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - select case(what) -#if defined(HAVE_MUMPS_) - case(mld_as_sequential_) - sv%ipar(1)=val - case(mld_mumps_print_err_) - sv%ipar(2)=val - !case(mld_print_stat_) - ! sv%id%icntl(2)=val - ! sv%ipar(2)=val - !case(mld_print_glob_) - ! sv%id%icntl(3)=val - ! sv%ipar(3)=val -#endif - case default - call sv%mld_s_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine s_mumps_solver_seti - - - subroutine s_mumps_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_s_mumps_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_mumps_solver_setr' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case default - call sv%mld_s_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine s_mumps_solver_setr subroutine s_mumps_solver_cseti(sv,what,val,info) @@ -343,7 +264,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, iwhat + integer(psb_ipk_) :: err_act character(len=20) :: name='s_mumps_solver_cseti' info = psb_success_ @@ -351,20 +272,15 @@ contains select case(psb_toupper(what)) #if defined(HAVE_MUMPS_) - case('SET_AS_SEQUENTIAL') - iwhat=mld_as_sequential_ - case('SET_MUMPS_PRINT_ERR') - iwhat=mld_mumps_print_err_ + case('MUMPS_AS_SEQUENTIAL') + sv%ipar(1)=val + case('MUMPS_PRINT_ERR') + sv%ipar(2)=val #endif case default - iwhat=-1 + call sv%mld_s_base_solver_type%set(what,val,info) end select - if (iwhat >=0 ) then - call sv%set(iwhat,val,info) - else - call sv%mld_s_base_solver_type%set(what,val,info) - end if call psb_erractionrestore(err_act) return @@ -386,7 +302,7 @@ contains character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, iwhat + integer(psb_ipk_) :: err_act character(len=20) :: name='s_mumps_solver_csetr' info = psb_success_ @@ -397,12 +313,6 @@ contains call sv%mld_s_base_solver_type%set(what,val,info) end select - if (iwhat >=0 ) then - call sv%set(iwhat,val,info) - else - call sv%mld_s_base_solver_type%set(what,val,info) - end if - call psb_erractionrestore(err_act) return diff --git a/mlprec/mld_s_onelev_mod.f90 b/mlprec/mld_s_onelev_mod.f90 index ce5cd89e..251ee330 100644 --- a/mlprec/mld_s_onelev_mod.f90 +++ b/mlprec/mld_s_onelev_mod.f90 @@ -163,17 +163,13 @@ module mld_s_onelev_mod procedure, pass(lv) :: nullify => s_base_onelev_nullify procedure, pass(lv) :: check => mld_s_base_onelev_check procedure, pass(lv) :: dump => mld_s_base_onelev_dump - procedure, pass(lv) :: seti => mld_s_base_onelev_seti - procedure, pass(lv) :: setr => mld_s_base_onelev_setr - procedure, pass(lv) :: setc => mld_s_base_onelev_setc procedure, pass(lv) :: cseti => mld_s_base_onelev_cseti procedure, pass(lv) :: csetr => mld_s_base_onelev_csetr procedure, pass(lv) :: csetc => mld_s_base_onelev_csetc procedure, pass(lv) :: setsm => mld_s_base_onelev_setsm procedure, pass(lv) :: setsv => mld_s_base_onelev_setsv procedure, pass(lv) :: setag => mld_s_base_onelev_setag - generic, public :: set => seti, setr, setc, & - & cseti, csetr, csetc, setsm, setsv, setag + generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag procedure, pass(lv) :: sizeof => s_base_onelev_sizeof procedure, pass(lv) :: get_nzeros => s_base_onelev_get_nzeros procedure, pass(lv) :: get_wrksz => s_base_onelev_get_wrksize @@ -274,22 +270,6 @@ module mld_s_onelev_mod end subroutine mld_s_base_onelev_check end interface - interface - subroutine mld_s_base_onelev_seti(lv,what,val,info,pos) - import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & - & psb_slinmap_type, psb_spk_, mld_s_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - - ! Arguments - class(mld_s_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_s_base_onelev_seti - end interface - interface subroutine mld_s_base_onelev_setsm(lv,val,info,pos) import :: psb_spk_, mld_s_onelev_type, mld_s_base_smoother_type, & @@ -332,37 +312,6 @@ module mld_s_onelev_mod end subroutine mld_s_base_onelev_setag end interface - interface - subroutine mld_s_base_onelev_setc(lv,what,val,info,pos) - import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & - & psb_slinmap_type, psb_spk_, mld_s_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - ! Arguments - class(mld_s_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_s_base_onelev_setc - end interface - - interface - subroutine mld_s_base_onelev_setr(lv,what,val,info,pos) - import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & - & psb_slinmap_type, psb_spk_, mld_s_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - - class(mld_s_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_s_base_onelev_setr - end interface - - interface subroutine mld_s_base_onelev_cseti(lv,what,val,info,pos) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & diff --git a/mlprec/mld_s_prec_mod.f90 b/mlprec/mld_s_prec_mod.f90 index f7cd86bb..15655dba 100644 --- a/mlprec/mld_s_prec_mod.f90 +++ b/mlprec/mld_s_prec_mod.f90 @@ -54,7 +54,6 @@ module mld_s_prec_mod interface mld_precset module procedure mld_s_iprecsetsm, mld_s_iprecsetsv, & - & mld_s_iprecseti, mld_s_iprecsetc, mld_s_iprecsetr, & & mld_s_cprecseti, mld_s_cprecsetc, mld_s_cprecsetr, & & mld_s_iprecsetag end interface mld_precset @@ -106,36 +105,6 @@ contains call p%set(val,info, pos=pos) end subroutine mld_s_iprecsetag - subroutine mld_s_iprecseti(p,what,val,info,pos) - type(mld_sprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_s_iprecseti - - subroutine mld_s_iprecsetr(p,what,val,info,pos) - type(mld_sprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_s_iprecsetr - - subroutine mld_s_iprecsetc(p,what,val,info,pos) - type(mld_sprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_s_iprecsetc - subroutine mld_s_cprecseti(p,what,val,info,pos) type(mld_sprec_type), intent(inout) :: p character(len=*), intent(in) :: what diff --git a/mlprec/mld_s_prec_type.f90 b/mlprec/mld_s_prec_type.f90 index 20adde41..a2b05ec1 100644 --- a/mlprec/mld_s_prec_type.f90 +++ b/mlprec/mld_s_prec_type.f90 @@ -128,14 +128,10 @@ module mld_s_prec_type procedure, pass(prec) :: setsm => mld_sprecsetsm procedure, pass(prec) :: setsv => mld_sprecsetsv procedure, pass(prec) :: setag => mld_sprecsetag - procedure, pass(prec) :: seti => mld_sprecseti - procedure, pass(prec) :: setc => mld_sprecsetc - procedure, pass(prec) :: setr => mld_sprecsetr procedure, pass(prec) :: cseti => mld_scprecseti procedure, pass(prec) :: csetc => mld_scprecsetc procedure, pass(prec) :: csetr => mld_scprecsetr - generic, public :: set => seti, setc, setr, & - & cseti, csetc, csetr, setsm, setsv, setag + generic, public :: set => cseti, csetc, csetr, setsm, setsv, setag procedure, pass(prec) :: get_smoother => mld_s_get_smootherp procedure, pass(prec) :: get_solver => mld_s_get_solverp procedure, pass(prec) :: move_alloc => s_prec_move_alloc @@ -245,36 +241,6 @@ module mld_s_prec_type integer(psb_ipk_), optional, intent(in) :: ilev character(len=*), optional, intent(in) :: pos end subroutine mld_sprecsetag - subroutine mld_sprecseti(prec,what,val,info,ilev,ilmax,pos) - import :: psb_sspmat_type, psb_desc_type, psb_spk_, & - & mld_sprec_type, psb_ipk_ - class(mld_sprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_sprecseti - subroutine mld_sprecsetr(prec,what,val,info,ilev,ilmax,pos) - import :: psb_sspmat_type, psb_desc_type, psb_spk_, & - & mld_sprec_type, psb_ipk_ - class(mld_sprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - real(psb_spk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_sprecsetr - subroutine mld_sprecsetc(prec,what,string,info,ilev,ilmax,pos) - import :: psb_sspmat_type, psb_desc_type, psb_spk_, & - & mld_sprec_type, psb_ipk_ - class(mld_sprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: string - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_sprecsetc subroutine mld_scprecseti(prec,what,val,info,ilev,ilmax,pos) import :: psb_sspmat_type, psb_desc_type, psb_spk_, & & mld_sprec_type, psb_ipk_ diff --git a/mlprec/mld_s_symdec_aggregator_mod.f90 b/mlprec/mld_s_symdec_aggregator_mod.f90 index 152ede99..dd7ffb62 100644 --- a/mlprec/mld_s_symdec_aggregator_mod.f90 +++ b/mlprec/mld_s_symdec_aggregator_mod.f90 @@ -95,6 +95,7 @@ module mld_s_symdec_aggregator_mod contains procedure, pass(ag) :: bld_tprol => mld_s_symdec_aggregator_build_tprol + procedure, pass(ag) :: descr => mld_s_symdec_aggregator_descr procedure, nopass :: fmt => mld_s_symdec_aggregator_fmt end type mld_s_symdec_aggregator_type @@ -124,4 +125,18 @@ contains val = "Symmetric Decoupled aggregation" end function mld_s_symdec_aggregator_fmt + subroutine mld_s_symdec_aggregator_descr(ag,parms,iout,info) + implicit none + class(mld_s_symdec_aggregator_type), intent(in) :: ag + type(mld_sml_parms), intent(in) :: parms + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + + write(iout,*) 'Decoupled Aggregator locally-symmetrized' + write(iout,*) 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info) + + return + end subroutine mld_s_symdec_aggregator_descr + end module mld_s_symdec_aggregator_mod diff --git a/mlprec/mld_z_as_smoother.f90 b/mlprec/mld_z_as_smoother.f90 index 4e11a61a..2da97762 100644 --- a/mlprec/mld_z_as_smoother.f90 +++ b/mlprec/mld_z_as_smoother.f90 @@ -83,8 +83,6 @@ module mld_z_as_smoother generic, public :: apply_restr => restr_v, restr_a generic, public :: apply_prol => prol_v, prol_a procedure, pass(sm) :: free => mld_z_as_smoother_free - procedure, pass(sm) :: seti => mld_z_as_smoother_seti - procedure, pass(sm) :: setc => mld_z_as_smoother_setc procedure, pass(sm) :: cseti => mld_z_as_smoother_cseti procedure, pass(sm) :: csetc => mld_z_as_smoother_csetc procedure, pass(sm) :: descr => z_as_smoother_descr @@ -253,42 +251,6 @@ module mld_z_as_smoother end subroutine mld_z_as_smoother_cnv end interface - interface - subroutine mld_z_as_smoother_seti(sm,what,val,info) - import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & - & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_z_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_as_smoother_seti - end interface - - interface - subroutine mld_z_as_smoother_setc(sm,what,val,info) - import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & - & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_z_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_as_smoother_setc - end interface - - interface - subroutine mld_z_as_smoother_setr(sm,what,val,info) - import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & - & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, psb_ipk_ - implicit none - class(mld_z_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_as_smoother_setr - end interface - interface subroutine mld_z_as_smoother_cseti(sm,what,val,info) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & diff --git a/mlprec/mld_z_base_aggregator_mod.f90 b/mlprec/mld_z_base_aggregator_mod.f90 index 660bc415..6c49ae2f 100644 --- a/mlprec/mld_z_base_aggregator_mod.f90 +++ b/mlprec/mld_z_base_aggregator_mod.f90 @@ -105,11 +105,41 @@ module mld_z_base_aggregator_mod procedure, pass(ag) :: descr => mld_z_base_aggregator_descr procedure, pass(ag) :: set_aggr_type => mld_z_base_aggregator_set_aggr_type procedure, nopass :: fmt => mld_z_base_aggregator_fmt + procedure, pass(ag) :: cseti => mld_z_base_aggregator_cseti + procedure, pass(ag) :: csetr => mld_z_base_aggregator_csetr + generic, public :: set => cseti, csetr end type mld_z_base_aggregator_type contains + subroutine mld_z_base_aggregator_cseti(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_z_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_z_base_aggregator_cseti + + subroutine mld_z_base_aggregator_csetr(ag,what,val,info) + + Implicit None + + ! Arguments + class(mld_z_base_aggregator_type), intent(inout) :: ag + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! Do nothing + info = 0 + end subroutine mld_z_base_aggregator_csetr + + subroutine mld_z_base_aggregator_update_next(ag,agnext,info) implicit none class(mld_z_base_aggregator_type), target, intent(inout) :: ag, agnext @@ -159,7 +189,7 @@ contains implicit none character(len=32) :: val - val = "Null " + val = "Default aggregator " end function mld_z_base_aggregator_fmt subroutine mld_z_base_aggregator_descr(ag,parms,iout,info) @@ -169,6 +199,7 @@ contains integer(psb_ipk_), intent(in) :: iout integer(psb_ipk_), intent(out) :: info + write(iout,*) 'Aggregator object type: ',ag%fmt() call parms%mldescr(iout,info) return diff --git a/mlprec/mld_z_base_smoother_mod.f90 b/mlprec/mld_z_base_smoother_mod.f90 index c73473e1..ca176c7a 100644 --- a/mlprec/mld_z_base_smoother_mod.f90 +++ b/mlprec/mld_z_base_smoother_mod.f90 @@ -112,13 +112,10 @@ module mld_z_base_smoother_mod procedure, pass(sm) :: apply_a => mld_z_base_smoother_apply generic, public :: apply => apply_a, apply_v procedure, pass(sm) :: free => mld_z_base_smoother_free - procedure, pass(sm) :: seti => mld_z_base_smoother_seti - procedure, pass(sm) :: setc => mld_z_base_smoother_setc - procedure, pass(sm) :: setr => mld_z_base_smoother_setr procedure, pass(sm) :: cseti => mld_z_base_smoother_cseti procedure, pass(sm) :: csetc => mld_z_base_smoother_csetc procedure, pass(sm) :: csetr => mld_z_base_smoother_csetr - generic, public :: set => seti, setc, setr, cseti, csetc, csetr + generic, public :: set => cseti, csetc, csetr procedure, pass(sm) :: default => z_base_smoother_default procedure, pass(sm) :: descr => mld_z_base_smoother_descr procedure, pass(sm) :: sizeof => z_base_smoother_sizeof @@ -188,44 +185,6 @@ module mld_z_base_smoother_mod end subroutine mld_z_base_smoother_check end interface - interface - subroutine mld_z_base_smoother_seti(sm,what,val,info) - import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & - & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & - & mld_z_base_smoother_type, psb_ipk_ - ! Arguments - class(mld_z_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_base_smoother_seti - end interface - - interface - subroutine mld_z_base_smoother_setc(sm,what,val,info) - import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & - & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & - & mld_z_base_smoother_type, psb_ipk_ - class(mld_z_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_base_smoother_setc - end interface - - interface - subroutine mld_z_base_smoother_setr(sm,what,val,info) - import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & - & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & - & mld_z_base_smoother_type, psb_ipk_ - ! Arguments - class(mld_z_base_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_base_smoother_setr - end interface - interface subroutine mld_z_base_smoother_cseti(sm,what,val,info) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & diff --git a/mlprec/mld_z_base_solver_mod.f90 b/mlprec/mld_z_base_solver_mod.f90 index 37d2b03c..79e58678 100644 --- a/mlprec/mld_z_base_solver_mod.f90 +++ b/mlprec/mld_z_base_solver_mod.f90 @@ -96,13 +96,10 @@ module mld_z_base_solver_mod procedure, pass(sv) :: apply_a => mld_z_base_solver_apply generic, public :: apply => apply_a, apply_v procedure, pass(sv) :: free => mld_z_base_solver_free - procedure, pass(sv) :: seti => mld_z_base_solver_seti - procedure, pass(sv) :: setc => mld_z_base_solver_setc - procedure, pass(sv) :: setr => mld_z_base_solver_setr procedure, pass(sv) :: cseti => mld_z_base_solver_cseti procedure, pass(sv) :: csetc => mld_z_base_solver_csetc procedure, pass(sv) :: csetr => mld_z_base_solver_csetr - generic, public :: set => seti, setc, setr, cseti, csetc, csetr + generic, public :: set => cseti, csetc, csetr procedure, pass(sv) :: default => z_base_solver_default procedure, pass(sv) :: descr => mld_z_base_solver_descr procedure, pass(sv) :: sizeof => z_base_solver_sizeof @@ -209,50 +206,6 @@ module mld_z_base_solver_mod end subroutine mld_z_base_solver_check end interface - interface - subroutine mld_z_base_solver_seti(sv,what,val,info) - import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & - & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & - & mld_z_base_solver_type, psb_ipk_ - Implicit None - - ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_base_solver_seti - end interface - - interface - subroutine mld_z_base_solver_setc(sv,what,val,info) - import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & - & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & - & mld_z_base_solver_type, psb_ipk_ - Implicit None - - ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_base_solver_setc - end interface - - interface - subroutine mld_z_base_solver_setr(sv,what,val,info) - import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & - & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & - & mld_z_base_solver_type, psb_ipk_ - Implicit None - ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - end subroutine mld_z_base_solver_setr - end interface - interface subroutine mld_z_base_solver_cseti(sv,what,val,info) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & diff --git a/mlprec/mld_z_dec_aggregator_mod.f90 b/mlprec/mld_z_dec_aggregator_mod.f90 index 6930230b..10989e0f 100644 --- a/mlprec/mld_z_dec_aggregator_mod.f90 +++ b/mlprec/mld_z_dec_aggregator_mod.f90 @@ -97,6 +97,7 @@ module mld_z_dec_aggregator_mod procedure, pass(ag) :: mat_asb => mld_z_dec_aggregator_mat_asb procedure, pass(ag) :: default => mld_z_dec_aggregator_default procedure, pass(ag) :: set_aggr_type => mld_z_dec_aggregator_set_aggr_type + procedure, pass(ag) :: descr => mld_z_dec_aggregator_descr procedure, nopass :: fmt => mld_z_dec_aggregator_fmt end type mld_z_dec_aggregator_type @@ -190,4 +191,18 @@ contains val = "Decoupled aggregation" end function mld_z_dec_aggregator_fmt + subroutine mld_z_dec_aggregator_descr(ag,parms,iout,info) + implicit none + class(mld_z_dec_aggregator_type), intent(in) :: ag + type(mld_dml_parms), intent(in) :: parms + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + + write(iout,*) 'Decoupled Aggregator' + write(iout,*) 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info) + + return + end subroutine mld_z_dec_aggregator_descr + end module mld_z_dec_aggregator_mod diff --git a/mlprec/mld_z_gs_solver.f90 b/mlprec/mld_z_gs_solver.f90 index fe14eb15..79ee052d 100644 --- a/mlprec/mld_z_gs_solver.f90 +++ b/mlprec/mld_z_gs_solver.f90 @@ -67,9 +67,6 @@ module mld_z_gs_solver procedure, pass(sv) :: apply_v => mld_z_gs_solver_apply_vect procedure, pass(sv) :: apply_a => mld_z_gs_solver_apply procedure, pass(sv) :: free => z_gs_solver_free - procedure, pass(sv) :: seti => z_gs_solver_seti - procedure, pass(sv) :: setc => z_gs_solver_setc - procedure, pass(sv) :: setr => z_gs_solver_setr procedure, pass(sv) :: cseti => z_gs_solver_cseti procedure, pass(sv) :: csetc => z_gs_solver_csetc procedure, pass(sv) :: csetr => z_gs_solver_csetr @@ -95,8 +92,7 @@ module mld_z_gs_solver private :: z_gs_solver_bld, z_gs_solver_apply, & - & z_gs_solver_free, z_gs_solver_seti, & - & z_gs_solver_setc, z_gs_solver_setr,& + & z_gs_solver_free, & & z_gs_solver_descr, z_gs_solver_sizeof, & & z_gs_solver_default, z_gs_solver_dmp, & & z_gs_solver_apply_vect, z_gs_solver_get_nzeros, & @@ -291,99 +287,6 @@ contains end subroutine z_gs_solver_check - - subroutine z_gs_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_z_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_gs_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_solver_sweeps_) - sv%sweeps = val - case default - call sv%mld_z_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine z_gs_solver_seti - - subroutine z_gs_solver_setc(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_z_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='z_gs_solver_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sv%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) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine z_gs_solver_setc - - subroutine z_gs_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_z_gs_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_gs_solver_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - select case(what) - case(mld_solver_eps_) - sv%eps = val - case default - call sv%mld_z_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine z_gs_solver_setr - subroutine z_gs_solver_cseti(sv,what,val,info) Implicit None diff --git a/mlprec/mld_z_ilu_solver.f90 b/mlprec/mld_z_ilu_solver.f90 index 1e7f563a..d1d9332f 100644 --- a/mlprec/mld_z_ilu_solver.f90 +++ b/mlprec/mld_z_ilu_solver.f90 @@ -75,9 +75,6 @@ module mld_z_ilu_solver procedure, pass(sv) :: apply_v => mld_z_ilu_solver_apply_vect procedure, pass(sv) :: apply_a => mld_z_ilu_solver_apply procedure, pass(sv) :: free => z_ilu_solver_free - procedure, pass(sv) :: seti => z_ilu_solver_seti - procedure, pass(sv) :: setc => z_ilu_solver_setc - procedure, pass(sv) :: setr => z_ilu_solver_setr procedure, pass(sv) :: cseti => z_ilu_solver_cseti procedure, pass(sv) :: csetc => z_ilu_solver_csetc procedure, pass(sv) :: csetr => z_ilu_solver_csetr @@ -92,8 +89,7 @@ module mld_z_ilu_solver private :: z_ilu_solver_bld, z_ilu_solver_apply, & - & z_ilu_solver_free, z_ilu_solver_seti, & - & z_ilu_solver_setc, z_ilu_solver_setr,& + & z_ilu_solver_free, & & z_ilu_solver_descr, z_ilu_solver_sizeof, & & z_ilu_solver_default, z_ilu_solver_dmp, & & z_ilu_solver_apply_vect, z_ilu_solver_get_nzeros, & @@ -251,101 +247,6 @@ contains end subroutine z_ilu_solver_check - - subroutine z_ilu_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_z_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_ilu_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case(mld_sub_solve_) - sv%fact_type = val - case(mld_sub_fillin_) - sv%fill_in = val - case default - call sv%mld_z_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine z_ilu_solver_seti - - subroutine z_ilu_solver_setc(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_z_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, ival - character(len=20) :: name='z_ilu_solver_setc' - - info = psb_success_ - call psb_erractionsave(err_act) - - - ival = sv%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) - goto 9999 - end if - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine z_ilu_solver_setc - - subroutine z_ilu_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_z_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_ilu_solver_setr' - - call psb_erractionsave(err_act) - info = psb_success_ - - select case(what) - case(mld_sub_iluthrs_) - sv%thresh = val - case default - call sv%mld_z_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(err_act) - return - end subroutine z_ilu_solver_setr - subroutine z_ilu_solver_cseti(sv,what,val,info) Implicit None diff --git a/mlprec/mld_z_mumps_solver.F90 b/mlprec/mld_z_mumps_solver.F90 index 5558ec2d..61699694 100644 --- a/mlprec/mld_z_mumps_solver.F90 +++ b/mlprec/mld_z_mumps_solver.F90 @@ -76,8 +76,6 @@ module mld_z_mumps_solver procedure, pass(sv) :: free => z_mumps_solver_free procedure, pass(sv) :: descr => z_mumps_solver_descr procedure, pass(sv) :: sizeof => z_mumps_solver_sizeof - procedure, pass(sv) :: seti => z_mumps_solver_seti - procedure, pass(sv) :: setr => z_mumps_solver_setr procedure, pass(sv) :: cseti =>z_mumps_solver_cseti procedure, pass(sv) :: csetr => z_mumps_solver_csetr procedure, pass(sv) :: default => z_mumps_solver_default @@ -93,8 +91,7 @@ module mld_z_mumps_solver private :: z_mumps_solver_bld, z_mumps_solver_apply, & & z_mumps_solver_free, z_mumps_solver_descr, & & z_mumps_solver_sizeof, z_mumps_solver_apply_vect,& - & z_mumps_solver_seti, z_mumps_solver_setr, & - & z_mumps_solver_cseti, z_mumps_solver_csetri, & + & z_mumps_solver_cseti, z_mumps_solver_csetr, & & z_mumps_solver_default, z_mumps_solver_get_fmt, & & z_mumps_solver_get_id #if defined(HAVE_FINAL) @@ -254,85 +251,9 @@ contains end subroutine z_mumps_solver_descr !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!$ WARNING: OTHERS PARAMETERS OF MUMPS COULD BE ADDED. FOR THIS, ADD AN !!$ -!!$ INTEGER IN MLD_BASE_PREC_TYPE.F90 AND MODIFY SUBROUTINE SET !!$ +!! WARNING: OTHERS PARAMETERS OF MUMPS COULD BE ADDED. !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine z_mumps_solver_seti(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_z_mumps_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_mumps_solver_seti' - - info = psb_success_ - call psb_erractionsave(err_act) - select case(what) -#if defined(HAVE_MUMPS_) - case(mld_as_sequential_) - sv%ipar(1)=val - case(mld_mumps_print_err_) - sv%ipar(2)=val - !case(mld_print_stat_) - ! sv%id%icntl(2)=val - ! sv%ipar(2)=val - !case(mld_print_glob_) - ! sv%id%icntl(3)=val - ! sv%ipar(3)=val -#endif - case default - call sv%mld_z_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine z_mumps_solver_seti - - - subroutine z_mumps_solver_setr(sv,what,val,info) - - Implicit None - - ! Arguments - class(mld_z_mumps_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act - character(len=20) :: name='z_mumps_solver_setr' - - info = psb_success_ - call psb_erractionsave(err_act) - - select case(what) - case default - call sv%mld_z_base_solver_type%set(what,val,info) - end select - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if - return - end subroutine z_mumps_solver_setr subroutine z_mumps_solver_cseti(sv,what,val,info) @@ -343,7 +264,7 @@ contains character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, iwhat + integer(psb_ipk_) :: err_act character(len=20) :: name='z_mumps_solver_cseti' info = psb_success_ @@ -351,20 +272,15 @@ contains select case(psb_toupper(what)) #if defined(HAVE_MUMPS_) - case('SET_AS_SEQUENTIAL') - iwhat=mld_as_sequential_ - case('SET_MUMPS_PRINT_ERR') - iwhat=mld_mumps_print_err_ + case('MUMPS_AS_SEQUENTIAL') + sv%ipar(1)=val + case('MUMPS_PRINT_ERR') + sv%ipar(2)=val #endif case default - iwhat=-1 + call sv%mld_z_base_solver_type%set(what,val,info) end select - if (iwhat >=0 ) then - call sv%set(iwhat,val,info) - else - call sv%mld_z_base_solver_type%set(what,val,info) - end if call psb_erractionrestore(err_act) return @@ -386,7 +302,7 @@ contains character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: err_act, iwhat + integer(psb_ipk_) :: err_act character(len=20) :: name='z_mumps_solver_csetr' info = psb_success_ @@ -397,12 +313,6 @@ contains call sv%mld_z_base_solver_type%set(what,val,info) end select - if (iwhat >=0 ) then - call sv%set(iwhat,val,info) - else - call sv%mld_z_base_solver_type%set(what,val,info) - end if - call psb_erractionrestore(err_act) return diff --git a/mlprec/mld_z_onelev_mod.f90 b/mlprec/mld_z_onelev_mod.f90 index 3f68c9e1..70dd6471 100644 --- a/mlprec/mld_z_onelev_mod.f90 +++ b/mlprec/mld_z_onelev_mod.f90 @@ -163,17 +163,13 @@ module mld_z_onelev_mod procedure, pass(lv) :: nullify => z_base_onelev_nullify procedure, pass(lv) :: check => mld_z_base_onelev_check procedure, pass(lv) :: dump => mld_z_base_onelev_dump - procedure, pass(lv) :: seti => mld_z_base_onelev_seti - procedure, pass(lv) :: setr => mld_z_base_onelev_setr - procedure, pass(lv) :: setc => mld_z_base_onelev_setc procedure, pass(lv) :: cseti => mld_z_base_onelev_cseti procedure, pass(lv) :: csetr => mld_z_base_onelev_csetr procedure, pass(lv) :: csetc => mld_z_base_onelev_csetc procedure, pass(lv) :: setsm => mld_z_base_onelev_setsm procedure, pass(lv) :: setsv => mld_z_base_onelev_setsv procedure, pass(lv) :: setag => mld_z_base_onelev_setag - generic, public :: set => seti, setr, setc, & - & cseti, csetr, csetc, setsm, setsv, setag + generic, public :: set => cseti, csetr, csetc, setsm, setsv, setag procedure, pass(lv) :: sizeof => z_base_onelev_sizeof procedure, pass(lv) :: get_nzeros => z_base_onelev_get_nzeros procedure, pass(lv) :: get_wrksz => z_base_onelev_get_wrksize @@ -274,22 +270,6 @@ module mld_z_onelev_mod end subroutine mld_z_base_onelev_check end interface - interface - subroutine mld_z_base_onelev_seti(lv,what,val,info,pos) - import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & - & psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - - ! Arguments - class(mld_z_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_z_base_onelev_seti - end interface - interface subroutine mld_z_base_onelev_setsm(lv,val,info,pos) import :: psb_dpk_, mld_z_onelev_type, mld_z_base_smoother_type, & @@ -332,37 +312,6 @@ module mld_z_onelev_mod end subroutine mld_z_base_onelev_setag end interface - interface - subroutine mld_z_base_onelev_setc(lv,what,val,info,pos) - import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & - & psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - ! Arguments - class(mld_z_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_z_base_onelev_setc - end interface - - interface - subroutine mld_z_base_onelev_setr(lv,what,val,info,pos) - import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & - & psb_zlinmap_type, psb_dpk_, mld_z_onelev_type, & - & psb_ipk_, psb_long_int_k_, psb_desc_type - Implicit None - - class(mld_z_onelev_type), intent(inout) :: lv - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - end subroutine mld_z_base_onelev_setr - end interface - - interface subroutine mld_z_base_onelev_cseti(lv,what,val,info,pos) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & diff --git a/mlprec/mld_z_prec_mod.f90 b/mlprec/mld_z_prec_mod.f90 index 2c402d10..f1c0443a 100644 --- a/mlprec/mld_z_prec_mod.f90 +++ b/mlprec/mld_z_prec_mod.f90 @@ -54,7 +54,6 @@ module mld_z_prec_mod interface mld_precset module procedure mld_z_iprecsetsm, mld_z_iprecsetsv, & - & mld_z_iprecseti, mld_z_iprecsetc, mld_z_iprecsetr, & & mld_z_cprecseti, mld_z_cprecsetc, mld_z_cprecsetr, & & mld_z_iprecsetag end interface mld_precset @@ -106,36 +105,6 @@ contains call p%set(val,info, pos=pos) end subroutine mld_z_iprecsetag - subroutine mld_z_iprecseti(p,what,val,info,pos) - type(mld_zprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_z_iprecseti - - subroutine mld_z_iprecsetr(p,what,val,info,pos) - type(mld_zprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_z_iprecsetr - - subroutine mld_z_iprecsetc(p,what,val,info,pos) - type(mld_zprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - character(len=*), optional, intent(in) :: pos - - call p%set(what,val,info,pos=pos) - end subroutine mld_z_iprecsetc - subroutine mld_z_cprecseti(p,what,val,info,pos) type(mld_zprec_type), intent(inout) :: p character(len=*), intent(in) :: what diff --git a/mlprec/mld_z_prec_type.f90 b/mlprec/mld_z_prec_type.f90 index 880085f1..ce1d0a81 100644 --- a/mlprec/mld_z_prec_type.f90 +++ b/mlprec/mld_z_prec_type.f90 @@ -128,14 +128,10 @@ module mld_z_prec_type procedure, pass(prec) :: setsm => mld_zprecsetsm procedure, pass(prec) :: setsv => mld_zprecsetsv procedure, pass(prec) :: setag => mld_zprecsetag - procedure, pass(prec) :: seti => mld_zprecseti - procedure, pass(prec) :: setc => mld_zprecsetc - procedure, pass(prec) :: setr => mld_zprecsetr procedure, pass(prec) :: cseti => mld_zcprecseti procedure, pass(prec) :: csetc => mld_zcprecsetc procedure, pass(prec) :: csetr => mld_zcprecsetr - generic, public :: set => seti, setc, setr, & - & cseti, csetc, csetr, setsm, setsv, setag + generic, public :: set => cseti, csetc, csetr, setsm, setsv, setag procedure, pass(prec) :: get_smoother => mld_z_get_smootherp procedure, pass(prec) :: get_solver => mld_z_get_solverp procedure, pass(prec) :: move_alloc => z_prec_move_alloc @@ -245,36 +241,6 @@ module mld_z_prec_type integer(psb_ipk_), optional, intent(in) :: ilev character(len=*), optional, intent(in) :: pos end subroutine mld_zprecsetag - subroutine mld_zprecseti(prec,what,val,info,ilev,ilmax,pos) - import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & - & mld_zprec_type, psb_ipk_ - class(mld_zprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - integer(psb_ipk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_zprecseti - subroutine mld_zprecsetr(prec,what,val,info,ilev,ilmax,pos) - import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & - & mld_zprec_type, psb_ipk_ - class(mld_zprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_zprecsetr - subroutine mld_zprecsetc(prec,what,string,info,ilev,ilmax,pos) - import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & - & mld_zprec_type, psb_ipk_ - class(mld_zprec_type), intent(inout) :: prec - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: string - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: ilev,ilmax - character(len=*), optional, intent(in) :: pos - end subroutine mld_zprecsetc subroutine mld_zcprecseti(prec,what,val,info,ilev,ilmax,pos) import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & & mld_zprec_type, psb_ipk_ diff --git a/mlprec/mld_z_symdec_aggregator_mod.f90 b/mlprec/mld_z_symdec_aggregator_mod.f90 index 2044c273..1397a532 100644 --- a/mlprec/mld_z_symdec_aggregator_mod.f90 +++ b/mlprec/mld_z_symdec_aggregator_mod.f90 @@ -95,6 +95,7 @@ module mld_z_symdec_aggregator_mod contains procedure, pass(ag) :: bld_tprol => mld_z_symdec_aggregator_build_tprol + procedure, pass(ag) :: descr => mld_z_symdec_aggregator_descr procedure, nopass :: fmt => mld_z_symdec_aggregator_fmt end type mld_z_symdec_aggregator_type @@ -124,4 +125,18 @@ contains val = "Symmetric Decoupled aggregation" end function mld_z_symdec_aggregator_fmt + subroutine mld_z_symdec_aggregator_descr(ag,parms,iout,info) + implicit none + class(mld_z_symdec_aggregator_type), intent(in) :: ag + type(mld_dml_parms), intent(in) :: parms + integer(psb_ipk_), intent(in) :: iout + integer(psb_ipk_), intent(out) :: info + + write(iout,*) 'Decoupled Aggregator locally-symmetrized' + write(iout,*) 'Aggregator object type: ',ag%fmt() + call parms%mldescr(iout,info) + + return + end subroutine mld_z_symdec_aggregator_descr + end module mld_z_symdec_aggregator_mod diff --git a/tests/Bcmatch/mld_d_pde3d.f90 b/tests/Bcmatch/mld_d_pde3d.f90 index de89f105..e2a335ff 100644 --- a/tests/Bcmatch/mld_d_pde3d.f90 +++ b/tests/Bcmatch/mld_d_pde3d.f90 @@ -638,7 +638,9 @@ program mld_d_pde3d integer(psb_ipk_) :: thrvsz ! size of threshold vector real(psb_dpk_) :: athres ! smoothed aggregation threshold integer(psb_ipk_) :: csize ! minimum size of coarsest matrix - + logical :: use_bcm ! use BootCMatch + integer(psb_ipk_) :: bcm_alg ! Matching method: 0 PREIS, 1 MC64, 2 SPRAL (auction) + integer(psb_ipk_) :: bcm_sweeps ! Pairing sweeps ! AMG smoother or pre-smoother; also 1-lev preconditioner character(len=16) :: smther ! (pre-)smoother type: BJAC, AS integer(psb_ipk_) :: jsweeps ! (pre-)smoother / 1-lev prec. sweeps @@ -671,7 +673,6 @@ program mld_d_pde3d integer(psb_ipk_) :: cfill ! fill-in for incomplete LU factorization real(psb_dpk_) :: cthres ! threshold for ILUT factorization integer(psb_ipk_) :: cjswp ! sweeps for GS or JAC coarsest-lev subsolver - logical :: use_bcm ! Use BootCMatch aggregation end type precdata type(precdata) :: p_choice @@ -819,8 +820,8 @@ program mld_d_pde3d call prec%set('coarse_sweeps', p_choice%cjswp, info) if (p_choice%use_bcm) then call prec%set(bcmag,info) - call prec%set('BCM_MATCH_ALG',2, info) - call prec%set('BCM_SWEEPS',3, info) + call prec%set('BCM_MATCH_ALG',p_choice%bcm_alg, info) + call prec%set('BCM_SWEEPS',p_choice%bcm_sweeps, info) !!$ if (p_choice%csize>0) call prec%set('BCM_MAX_CSIZE',p_choice%csize, info) call prec%set('BCM_MAX_NLEVELS',p_choice%maxlevs, info) !call prec%set('BCM_W_SIZE',desc_a%get_local_rows(), info,ilev=2) @@ -1035,7 +1036,9 @@ contains call read_data(prec%cfill,inp_unit) ! fill-in for incompl LU call read_data(prec%cthres,inp_unit) ! Threshold for ILUT call read_data(prec%cjswp,inp_unit) ! sweeps for GS/JAC subsolver - call read_data(prec%use_bcm,inp_unit) ! BootCMatch? + call read_data(prec%use_bcm,inp_unit) + call read_data(prec%bcm_alg,inp_unit) + call read_data(prec%bcm_sweeps,inp_unit) if (inp_unit /= psb_inp_unit) then close(inp_unit) end if @@ -1097,7 +1100,9 @@ contains call psb_bcast(icontxt,prec%cfill) call psb_bcast(icontxt,prec%cthres) call psb_bcast(icontxt,prec%cjswp) - call psb_bcast(icontxt,prec%use_bcm) + call psb_bcast(ictxt,prec%use_bcm) + call psb_bcast(ictxt,prec%bcm_alg) + call psb_bcast(ictxt,prec%bcm_sweeps) end subroutine get_parms diff --git a/tests/Bcmatch/runs/mld-bcm.inp b/tests/Bcmatch/runs/mld-bcm.inp index 374d5139..c07fea1e 100644 --- a/tests/Bcmatch/runs/mld-bcm.inp +++ b/tests/Bcmatch/runs/mld-bcm.inp @@ -1,17 +1,17 @@ %%%%%%%%%%% General arguments % Lines starting with % are ignored. CSR ! Storage format CSR COO JAD -0040 ! IDIM; domain size. Linear system size is IDIM**2 -CG ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS FCG GCR RGMRES +0100 ! IDIM; domain size. Linear system size is IDIM**2 +FCG ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS FCG GCR RGMRES 2 ! ISTOPC 00500 ! ITMAX 1 ! ITRACE 30 ! IRST (restart for RGMRES and BiCGSTABL) 1.d-6 ! EPS -ML-VCYCLE-FBGS-ILU ! Longer descriptive name for preconditioner (up to 20 chars) +ML-KCYCLE-FBGS-ILU ! Longer descriptive name for preconditioner (up to 20 chars) ML ! Preconditioner type: NONE JACOBI GS FBGS BJAC AS ML %%%%%%%%%%% First smoother (for all levels but coarsest) %%%%%%%%%%%%%%%% FBGS ! Smoother type JACOBI FBGS GS BWGS BJAC AS. For 1-level, repeats previous. -2 ! Number of sweeps for smoother +1 ! Number of sweeps for smoother 0 ! Number of overlap layers for AS preconditioner HALO ! AS restriction operator: NONE HALO NONE ! AS prolongation operator: NONE SUM AVG @@ -28,11 +28,11 @@ ILU ! Subdomain solver for BJAC/AS: JACOBI GS BGS ILU IL 0 ! Fill level P for ILU(P) and ILU(T,P) 1.d-4 ! Threshold T for ILU(T,P) %%%%%%%%%%% Multilevel parameters %%%%%%%%%%%%%%%% -VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MULT ADD +KCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MULT ADD 1 ! Number of outer sweeps for ML -3 ! Max Number of levels in a multilevel preconditioner; if <0, lib default -3 ! Target coarse matrix size; if <0, lib default -SMOOTHED ! Type of aggregation: SMOOTHED UNSMOOTHED +UNSMOOTHED ! Type of aggregation: SMOOTHED UNSMOOTHED DEC ! Parallel aggregation: DEC, SYMDEC NATURAL ! Ordering of aggregation NATURAL DEGREE NOFILTER ! Filtering of matrix: FILTER NOFILTER @@ -47,4 +47,6 @@ DIST ! Coarsest-level matrix distribution: DIST REPL, DE 1 ! Coarsest-level fillin P for ILU(P) and ILU(T,P) 1.d-4 ! Coarsest-level threshold T for ILU(T,P) 1 ! Number of sweeps for JACOBI/GS/BJAC coarsest-level solver -T ! Use BootCMatch aggregator \ No newline at end of file +T ! Use BootCMatch +2 ! Matching method: 0 PREIS, 1 MC64, 2 SPRAL (auction) +2 ! Pairing sweeps