From 31ba8fd554e008dedb0cc91d11ed1a5dd1fe658d Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 2 Feb 2013 10:16:49 +0000 Subject: [PATCH] mld2p4-2: mlprec/impl/Makefile mlprec/impl/level/Makefile mlprec/impl/level/mld_c_base_onelev_csetc.f90 mlprec/impl/level/mld_c_base_onelev_cseti.f90 mlprec/impl/level/mld_c_base_onelev_csetr.f90 mlprec/impl/level/mld_c_base_onelev_seti.f90 mlprec/impl/level/mld_c_base_onelev_setr.f90 mlprec/impl/level/mld_d_base_onelev_csetc.f90 mlprec/impl/level/mld_d_base_onelev_cseti.f90 mlprec/impl/level/mld_d_base_onelev_csetr.f90 mlprec/impl/level/mld_d_base_onelev_seti.f90 mlprec/impl/level/mld_d_base_onelev_setr.f90 mlprec/impl/level/mld_s_base_onelev_csetc.f90 mlprec/impl/level/mld_s_base_onelev_cseti.f90 mlprec/impl/level/mld_s_base_onelev_csetr.f90 mlprec/impl/level/mld_s_base_onelev_seti.f90 mlprec/impl/level/mld_s_base_onelev_setr.f90 mlprec/impl/level/mld_z_base_onelev_csetc.f90 mlprec/impl/level/mld_z_base_onelev_cseti.f90 mlprec/impl/level/mld_z_base_onelev_csetr.f90 mlprec/impl/level/mld_z_base_onelev_seti.f90 mlprec/impl/level/mld_z_base_onelev_setr.f90 mlprec/impl/mld_cprecset.F90 mlprec/impl/mld_dcprecset.F90 mlprec/impl/mld_dmlprec_bld.f90 mlprec/impl/mld_dprecset.F90 mlprec/impl/mld_sprecset.F90 mlprec/impl/mld_zprecset.F90 mlprec/impl/smoother/Makefile mlprec/impl/smoother/mld_c_as_smoother_csetc.f90 mlprec/impl/smoother/mld_c_as_smoother_cseti.f90 mlprec/impl/smoother/mld_c_as_smoother_csetr.f90 mlprec/impl/smoother/mld_c_base_smoother_csetc.f90 mlprec/impl/smoother/mld_c_base_smoother_cseti.f90 mlprec/impl/smoother/mld_c_base_smoother_csetr.f90 mlprec/impl/smoother/mld_d_as_smoother_csetc.f90 mlprec/impl/smoother/mld_d_as_smoother_cseti.f90 mlprec/impl/smoother/mld_d_as_smoother_csetr.f90 mlprec/impl/smoother/mld_d_base_smoother_csetc.f90 mlprec/impl/smoother/mld_d_base_smoother_cseti.f90 mlprec/impl/smoother/mld_d_base_smoother_csetr.f90 mlprec/impl/smoother/mld_s_as_smoother_csetc.f90 mlprec/impl/smoother/mld_s_as_smoother_cseti.f90 mlprec/impl/smoother/mld_s_as_smoother_csetr.f90 mlprec/impl/smoother/mld_s_base_smoother_csetc.f90 mlprec/impl/smoother/mld_s_base_smoother_cseti.f90 mlprec/impl/smoother/mld_s_base_smoother_csetr.f90 mlprec/impl/smoother/mld_z_as_smoother_csetc.f90 mlprec/impl/smoother/mld_z_as_smoother_cseti.f90 mlprec/impl/smoother/mld_z_as_smoother_csetr.f90 mlprec/impl/smoother/mld_z_base_smoother_csetc.f90 mlprec/impl/smoother/mld_z_base_smoother_cseti.f90 mlprec/impl/smoother/mld_z_base_smoother_csetr.f90 mlprec/impl/solver/Makefile mlprec/impl/solver/mld_c_base_solver_csetc.f90 mlprec/impl/solver/mld_c_base_solver_cseti.f90 mlprec/impl/solver/mld_c_base_solver_csetr.f90 mlprec/impl/solver/mld_d_base_solver_csetc.f90 mlprec/impl/solver/mld_d_base_solver_cseti.f90 mlprec/impl/solver/mld_d_base_solver_csetr.f90 mlprec/impl/solver/mld_s_base_solver_csetc.f90 mlprec/impl/solver/mld_s_base_solver_cseti.f90 mlprec/impl/solver/mld_s_base_solver_csetr.f90 mlprec/impl/solver/mld_z_base_solver_csetc.f90 mlprec/impl/solver/mld_z_base_solver_cseti.f90 mlprec/impl/solver/mld_z_base_solver_csetr.f90 mlprec/mld_c_as_smoother.f90 mlprec/mld_c_base_smoother_mod.f90 mlprec/mld_c_base_solver_mod.f90 mlprec/mld_c_ilu_solver.f90 mlprec/mld_c_onelev_mod.f90 mlprec/mld_c_prec_mod.f90 mlprec/mld_c_prec_type.f90 mlprec/mld_d_as_smoother.f90 mlprec/mld_d_base_smoother_mod.f90 mlprec/mld_d_base_solver_mod.f90 mlprec/mld_d_ilu_solver.f90 mlprec/mld_d_onelev_mod.f90 mlprec/mld_d_prec_mod.f90 mlprec/mld_d_prec_type.f90 mlprec/mld_s_as_smoother.f90 mlprec/mld_s_base_smoother_mod.f90 mlprec/mld_s_base_solver_mod.f90 mlprec/mld_s_ilu_solver.f90 mlprec/mld_s_onelev_mod.f90 mlprec/mld_s_prec_mod.f90 mlprec/mld_s_prec_type.f90 mlprec/mld_z_as_smoother.f90 mlprec/mld_z_base_smoother_mod.f90 mlprec/mld_z_base_solver_mod.f90 mlprec/mld_z_ilu_solver.f90 mlprec/mld_z_onelev_mod.f90 mlprec/mld_z_prec_mod.f90 mlprec/mld_z_prec_type.f90 tests/newslv/runs/ppde.inp tests/pdegen/ppde3d.f90 Introduced CSET routines. Reorganize SET for MLD. To be completed, we now only have mld_dcprecset.f90 --- mlprec/impl/Makefile | 2 +- mlprec/impl/level/Makefile | 14 +- mlprec/impl/level/mld_c_base_onelev_csetc.f90 | 81 ++ mlprec/impl/level/mld_c_base_onelev_cseti.f90 | 113 +++ mlprec/impl/level/mld_c_base_onelev_csetr.f90 | 84 ++ mlprec/impl/level/mld_c_base_onelev_seti.f90 | 2 +- mlprec/impl/level/mld_c_base_onelev_setr.f90 | 2 +- mlprec/impl/level/mld_d_base_onelev_csetc.f90 | 81 ++ mlprec/impl/level/mld_d_base_onelev_cseti.f90 | 113 +++ mlprec/impl/level/mld_d_base_onelev_csetr.f90 | 84 ++ mlprec/impl/level/mld_d_base_onelev_seti.f90 | 2 +- mlprec/impl/level/mld_d_base_onelev_setr.f90 | 2 +- mlprec/impl/level/mld_s_base_onelev_csetc.f90 | 81 ++ mlprec/impl/level/mld_s_base_onelev_cseti.f90 | 113 +++ mlprec/impl/level/mld_s_base_onelev_csetr.f90 | 84 ++ mlprec/impl/level/mld_s_base_onelev_seti.f90 | 2 +- mlprec/impl/level/mld_s_base_onelev_setr.f90 | 2 +- mlprec/impl/level/mld_z_base_onelev_csetc.f90 | 81 ++ mlprec/impl/level/mld_z_base_onelev_cseti.f90 | 113 +++ mlprec/impl/level/mld_z_base_onelev_csetr.f90 | 84 ++ mlprec/impl/level/mld_z_base_onelev_seti.f90 | 2 +- mlprec/impl/level/mld_z_base_onelev_setr.f90 | 2 +- mlprec/impl/mld_cprecset.F90 | 128 +++ mlprec/impl/mld_dcprecset.F90 | 763 ++++++++++++++++++ mlprec/impl/mld_dmlprec_bld.f90 | 6 +- mlprec/impl/mld_dprecset.F90 | 36 +- mlprec/impl/mld_sprecset.F90 | 128 +++ mlprec/impl/mld_zprecset.F90 | 129 +++ mlprec/impl/smoother/Makefile | 26 + .../impl/smoother/mld_c_as_smoother_csetc.f90 | 81 ++ .../impl/smoother/mld_c_as_smoother_cseti.f90 | 81 ++ .../impl/smoother/mld_c_as_smoother_csetr.f90 | 73 ++ .../smoother/mld_c_base_smoother_csetc.f90 | 78 ++ .../smoother/mld_c_base_smoother_cseti.f90 | 69 ++ .../smoother/mld_c_base_smoother_csetr.f90 | 73 ++ .../impl/smoother/mld_d_as_smoother_csetc.f90 | 81 ++ .../impl/smoother/mld_d_as_smoother_cseti.f90 | 81 ++ .../impl/smoother/mld_d_as_smoother_csetr.f90 | 73 ++ .../smoother/mld_d_base_smoother_csetc.f90 | 78 ++ .../smoother/mld_d_base_smoother_cseti.f90 | 69 ++ .../smoother/mld_d_base_smoother_csetr.f90 | 73 ++ .../impl/smoother/mld_s_as_smoother_csetc.f90 | 81 ++ .../impl/smoother/mld_s_as_smoother_cseti.f90 | 81 ++ .../impl/smoother/mld_s_as_smoother_csetr.f90 | 73 ++ .../smoother/mld_s_base_smoother_csetc.f90 | 78 ++ .../smoother/mld_s_base_smoother_cseti.f90 | 69 ++ .../smoother/mld_s_base_smoother_csetr.f90 | 73 ++ .../impl/smoother/mld_z_as_smoother_csetc.f90 | 81 ++ .../impl/smoother/mld_z_as_smoother_cseti.f90 | 81 ++ .../impl/smoother/mld_z_as_smoother_csetr.f90 | 73 ++ .../smoother/mld_z_base_smoother_csetc.f90 | 78 ++ .../smoother/mld_z_base_smoother_cseti.f90 | 69 ++ .../smoother/mld_z_base_smoother_csetr.f90 | 73 ++ mlprec/impl/solver/Makefile | 12 + .../impl/solver/mld_c_base_solver_csetc.f90 | 74 ++ .../impl/solver/mld_c_base_solver_cseti.f90 | 56 ++ .../impl/solver/mld_c_base_solver_csetr.f90 | 57 ++ .../impl/solver/mld_d_base_solver_csetc.f90 | 74 ++ .../impl/solver/mld_d_base_solver_cseti.f90 | 56 ++ .../impl/solver/mld_d_base_solver_csetr.f90 | 57 ++ .../impl/solver/mld_s_base_solver_csetc.f90 | 74 ++ .../impl/solver/mld_s_base_solver_cseti.f90 | 56 ++ .../impl/solver/mld_s_base_solver_csetr.f90 | 57 ++ .../impl/solver/mld_z_base_solver_csetc.f90 | 74 ++ .../impl/solver/mld_z_base_solver_cseti.f90 | 56 ++ .../impl/solver/mld_z_base_solver_csetr.f90 | 57 ++ mlprec/mld_c_as_smoother.f90 | 39 + mlprec/mld_c_base_smoother_mod.f90 | 43 +- mlprec/mld_c_base_solver_mod.f90 | 49 +- mlprec/mld_c_ilu_solver.f90 | 115 +++ mlprec/mld_c_onelev_mod.f90 | 49 +- mlprec/mld_c_prec_mod.f90 | 36 +- mlprec/mld_c_prec_type.f90 | 33 +- mlprec/mld_d_as_smoother.f90 | 39 + mlprec/mld_d_base_smoother_mod.f90 | 43 +- mlprec/mld_d_base_solver_mod.f90 | 49 +- mlprec/mld_d_ilu_solver.f90 | 115 +++ mlprec/mld_d_onelev_mod.f90 | 49 +- mlprec/mld_d_prec_mod.f90 | 36 +- mlprec/mld_d_prec_type.f90 | 33 +- mlprec/mld_s_as_smoother.f90 | 39 + mlprec/mld_s_base_smoother_mod.f90 | 43 +- mlprec/mld_s_base_solver_mod.f90 | 49 +- mlprec/mld_s_ilu_solver.f90 | 115 +++ mlprec/mld_s_onelev_mod.f90 | 49 +- mlprec/mld_s_prec_mod.f90 | 36 +- mlprec/mld_s_prec_type.f90 | 33 +- mlprec/mld_z_as_smoother.f90 | 39 + mlprec/mld_z_base_smoother_mod.f90 | 43 +- mlprec/mld_z_base_solver_mod.f90 | 49 +- mlprec/mld_z_ilu_solver.f90 | 115 +++ mlprec/mld_z_onelev_mod.f90 | 49 +- mlprec/mld_z_prec_mod.f90 | 36 +- mlprec/mld_z_prec_type.f90 | 33 +- tests/newslv/runs/ppde.inp | 2 +- tests/pdegen/ppde3d.f90 | 54 +- 96 files changed, 6363 insertions(+), 89 deletions(-) create mode 100644 mlprec/impl/level/mld_c_base_onelev_csetc.f90 create mode 100644 mlprec/impl/level/mld_c_base_onelev_cseti.f90 create mode 100644 mlprec/impl/level/mld_c_base_onelev_csetr.f90 create mode 100644 mlprec/impl/level/mld_d_base_onelev_csetc.f90 create mode 100644 mlprec/impl/level/mld_d_base_onelev_cseti.f90 create mode 100644 mlprec/impl/level/mld_d_base_onelev_csetr.f90 create mode 100644 mlprec/impl/level/mld_s_base_onelev_csetc.f90 create mode 100644 mlprec/impl/level/mld_s_base_onelev_cseti.f90 create mode 100644 mlprec/impl/level/mld_s_base_onelev_csetr.f90 create mode 100644 mlprec/impl/level/mld_z_base_onelev_csetc.f90 create mode 100644 mlprec/impl/level/mld_z_base_onelev_cseti.f90 create mode 100644 mlprec/impl/level/mld_z_base_onelev_csetr.f90 create mode 100644 mlprec/impl/mld_dcprecset.F90 create mode 100644 mlprec/impl/smoother/mld_c_as_smoother_csetc.f90 create mode 100644 mlprec/impl/smoother/mld_c_as_smoother_cseti.f90 create mode 100644 mlprec/impl/smoother/mld_c_as_smoother_csetr.f90 create mode 100644 mlprec/impl/smoother/mld_c_base_smoother_csetc.f90 create mode 100644 mlprec/impl/smoother/mld_c_base_smoother_cseti.f90 create mode 100644 mlprec/impl/smoother/mld_c_base_smoother_csetr.f90 create mode 100644 mlprec/impl/smoother/mld_d_as_smoother_csetc.f90 create mode 100644 mlprec/impl/smoother/mld_d_as_smoother_cseti.f90 create mode 100644 mlprec/impl/smoother/mld_d_as_smoother_csetr.f90 create mode 100644 mlprec/impl/smoother/mld_d_base_smoother_csetc.f90 create mode 100644 mlprec/impl/smoother/mld_d_base_smoother_cseti.f90 create mode 100644 mlprec/impl/smoother/mld_d_base_smoother_csetr.f90 create mode 100644 mlprec/impl/smoother/mld_s_as_smoother_csetc.f90 create mode 100644 mlprec/impl/smoother/mld_s_as_smoother_cseti.f90 create mode 100644 mlprec/impl/smoother/mld_s_as_smoother_csetr.f90 create mode 100644 mlprec/impl/smoother/mld_s_base_smoother_csetc.f90 create mode 100644 mlprec/impl/smoother/mld_s_base_smoother_cseti.f90 create mode 100644 mlprec/impl/smoother/mld_s_base_smoother_csetr.f90 create mode 100644 mlprec/impl/smoother/mld_z_as_smoother_csetc.f90 create mode 100644 mlprec/impl/smoother/mld_z_as_smoother_cseti.f90 create mode 100644 mlprec/impl/smoother/mld_z_as_smoother_csetr.f90 create mode 100644 mlprec/impl/smoother/mld_z_base_smoother_csetc.f90 create mode 100644 mlprec/impl/smoother/mld_z_base_smoother_cseti.f90 create mode 100644 mlprec/impl/smoother/mld_z_base_smoother_csetr.f90 create mode 100644 mlprec/impl/solver/mld_c_base_solver_csetc.f90 create mode 100644 mlprec/impl/solver/mld_c_base_solver_cseti.f90 create mode 100644 mlprec/impl/solver/mld_c_base_solver_csetr.f90 create mode 100644 mlprec/impl/solver/mld_d_base_solver_csetc.f90 create mode 100644 mlprec/impl/solver/mld_d_base_solver_cseti.f90 create mode 100644 mlprec/impl/solver/mld_d_base_solver_csetr.f90 create mode 100644 mlprec/impl/solver/mld_s_base_solver_csetc.f90 create mode 100644 mlprec/impl/solver/mld_s_base_solver_cseti.f90 create mode 100644 mlprec/impl/solver/mld_s_base_solver_csetr.f90 create mode 100644 mlprec/impl/solver/mld_z_base_solver_csetc.f90 create mode 100644 mlprec/impl/solver/mld_z_base_solver_cseti.f90 create mode 100644 mlprec/impl/solver/mld_z_base_solver_csetr.f90 diff --git a/mlprec/impl/Makefile b/mlprec/impl/Makefile index 17b42c15..89825825 100644 --- a/mlprec/impl/Makefile +++ b/mlprec/impl/Makefile @@ -60,7 +60,7 @@ CINNEROBJS= mld_ccoarse_bld.o mld_cmlprec_bld.o \ INNEROBJS= $(SINNEROBJS) $(DINNEROBJS) $(CINNEROBJS) $(ZINNEROBJS) -DOUTEROBJS=mld_dprecbld.o mld_dprecset.o mld_dprecinit.o mld_dprecaply.o +DOUTEROBJS=mld_dprecbld.o mld_dprecset.o mld_dprecinit.o mld_dprecaply.o mld_dcprecset.o SOUTEROBJS=mld_sprecbld.o mld_sprecset.o mld_sprecinit.o mld_sprecaply.o diff --git a/mlprec/impl/level/Makefile b/mlprec/impl/level/Makefile index d2f6bc04..aa1ddb72 100644 --- a/mlprec/impl/level/Makefile +++ b/mlprec/impl/level/Makefile @@ -14,6 +14,9 @@ mld_c_base_onelev_free.o \ mld_c_base_onelev_setc.o \ mld_c_base_onelev_seti.o \ mld_c_base_onelev_setr.o \ +mld_c_base_onelev_csetc.o \ +mld_c_base_onelev_cseti.o \ +mld_c_base_onelev_csetr.o \ mld_d_base_onelev_check.o \ mld_d_base_onelev_descr.o \ mld_d_base_onelev_dump.o \ @@ -21,6 +24,9 @@ mld_d_base_onelev_free.o \ mld_d_base_onelev_setc.o \ mld_d_base_onelev_seti.o \ mld_d_base_onelev_setr.o \ +mld_d_base_onelev_csetc.o \ +mld_d_base_onelev_cseti.o \ +mld_d_base_onelev_csetr.o \ mld_s_base_onelev_check.o \ mld_s_base_onelev_descr.o \ mld_s_base_onelev_dump.o \ @@ -28,13 +34,19 @@ mld_s_base_onelev_free.o \ mld_s_base_onelev_setc.o \ mld_s_base_onelev_seti.o \ mld_s_base_onelev_setr.o \ +mld_s_base_onelev_csetc.o \ +mld_s_base_onelev_cseti.o \ +mld_s_base_onelev_csetr.o \ mld_z_base_onelev_check.o \ mld_z_base_onelev_descr.o \ mld_z_base_onelev_dump.o \ mld_z_base_onelev_free.o \ mld_z_base_onelev_setc.o \ mld_z_base_onelev_seti.o \ -mld_z_base_onelev_setr.o +mld_z_base_onelev_setr.o \ +mld_z_base_onelev_csetc.o \ +mld_z_base_onelev_cseti.o \ +mld_z_base_onelev_csetr.o LIBNAME=libmld_prec.a diff --git a/mlprec/impl/level/mld_c_base_onelev_csetc.f90 b/mlprec/impl/level/mld_c_base_onelev_csetc.f90 new file mode 100644 index 00000000..86c9097c --- /dev/null +++ b/mlprec/impl/level/mld_c_base_onelev_csetc.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetc(lv,what,val,info) + + use psb_base_mod + use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_csetc + + Implicit None + + ! Arguments + class(mld_c_onelev_type), intent(inout) :: lv + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act + character(len=20) :: name='c_base_onelev_csetc' + integer(psb_ipk_) :: ival + + call psb_erractionsave(err_act) + + info = psb_success_ + + ival = mld_stringval(val) + if (ival >= 0) then + call lv%set(what,ival,info) + else + if (allocated(lv%sm)) then + call lv%sm%set(what,val,info) + end if + end if + + + if (info /= psb_success_) goto 9999 + + 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 mld_c_base_onelev_csetc diff --git a/mlprec/impl/level/mld_c_base_onelev_cseti.f90 b/mlprec/impl/level/mld_c_base_onelev_cseti.f90 new file mode 100644 index 00000000..bcd4403f --- /dev/null +++ b/mlprec/impl/level/mld_c_base_onelev_cseti.f90 @@ -0,0 +1,113 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_cseti(lv,what,val,info) + + use psb_base_mod + use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_cseti + + Implicit None + + ! Arguments + class(mld_c_onelev_type), intent(inout) :: lv + character(len=*), 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_onelev_cseti' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case (what) + + case ('SMOOTHER_SWEEPS') + lv%parms%sweeps = val + lv%parms%sweeps_pre = val + lv%parms%sweeps_post = val + + case ('SMOOTHER_SWEEPS_PRE') + lv%parms%sweeps_pre = val + + case ('SMOOTHER_SWEEPS_POST') + lv%parms%sweeps_post = val + + case ('ML_TYPE') + lv%parms%ml_type = val + + case ('AGGR_ALG') + lv%parms%aggr_alg = val + + case ('AGGR_KIND') + lv%parms%aggr_kind = val + + case ('COARSE_MAT') + lv%parms%coarse_mat = val + + case ('SMOOTHER_POS') + lv%parms%smoother_pos = val + + case ('AGGR_OMEGA_ALG') + lv%parms%aggr_omega_alg= val + + case ('AGGR_EIG') + lv%parms%aggr_eig = val + + case ('AGGR_FILTER') + lv%parms%aggr_filter = val + + case ('COARSE_SOLVE') + lv%parms%coarse_solve = val + + case default + if (allocated(lv%sm)) then + call lv%sm%set(what,val,info) + end if + end select + if (info /= psb_success_) goto 9999 + 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 mld_c_base_onelev_cseti diff --git a/mlprec/impl/level/mld_c_base_onelev_csetr.f90 b/mlprec/impl/level/mld_c_base_onelev_csetr.f90 new file mode 100644 index 00000000..5e20a6e0 --- /dev/null +++ b/mlprec/impl/level/mld_c_base_onelev_csetr.f90 @@ -0,0 +1,84 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetr(lv,what,val,info) + + use psb_base_mod + use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_csetr + + Implicit None + + ! Arguments + class(mld_c_onelev_type), intent(inout) :: lv + character(len=*), 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_onelev_csetr' + + call psb_erractionsave(err_act) + + + info = psb_success_ + + select case (what) + + case ('AGGR_OMEGA_VAL') + lv%parms%aggr_omega_val= val + + case ('AGGR_THRESH') + lv%parms%aggr_thresh = val + + case default + if (allocated(lv%sm)) then + call lv%sm%set(what,val,info) + end if + end select + + if (info /= psb_success_) goto 9999 + 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 mld_c_base_onelev_csetr diff --git a/mlprec/impl/level/mld_c_base_onelev_seti.f90 b/mlprec/impl/level/mld_c_base_onelev_seti.f90 index e459133a..82418b01 100644 --- a/mlprec/impl/level/mld_c_base_onelev_seti.f90 +++ b/mlprec/impl/level/mld_c_base_onelev_seti.f90 @@ -98,8 +98,8 @@ subroutine mld_c_base_onelev_seti(lv,what,val,info) if (allocated(lv%sm)) then call lv%sm%set(what,val,info) end if - if (info /= psb_success_) goto 9999 end select + if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/level/mld_c_base_onelev_setr.f90 b/mlprec/impl/level/mld_c_base_onelev_setr.f90 index ba150677..a2c23a40 100644 --- a/mlprec/impl/level/mld_c_base_onelev_setr.f90 +++ b/mlprec/impl/level/mld_c_base_onelev_setr.f90 @@ -68,9 +68,9 @@ subroutine mld_c_base_onelev_setr(lv,what,val,info) if (allocated(lv%sm)) then call lv%sm%set(what,val,info) end if - if (info /= psb_success_) goto 9999 end select + if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/level/mld_d_base_onelev_csetc.f90 b/mlprec/impl/level/mld_d_base_onelev_csetc.f90 new file mode 100644 index 00000000..f3cb715b --- /dev/null +++ b/mlprec/impl/level/mld_d_base_onelev_csetc.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetc(lv,what,val,info) + + use psb_base_mod + use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_csetc + + Implicit None + + ! Arguments + class(mld_d_onelev_type), intent(inout) :: lv + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_onelev_csetc' + integer(psb_ipk_) :: ival + + call psb_erractionsave(err_act) + + info = psb_success_ + + ival = mld_stringval(val) + if (ival >= 0) then + call lv%set(what,ival,info) + else + if (allocated(lv%sm)) then + call lv%sm%set(what,val,info) + end if + end if + + + if (info /= psb_success_) goto 9999 + + 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 mld_d_base_onelev_csetc diff --git a/mlprec/impl/level/mld_d_base_onelev_cseti.f90 b/mlprec/impl/level/mld_d_base_onelev_cseti.f90 new file mode 100644 index 00000000..e4b5ee9c --- /dev/null +++ b/mlprec/impl/level/mld_d_base_onelev_cseti.f90 @@ -0,0 +1,113 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_cseti(lv,what,val,info) + + use psb_base_mod + use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_cseti + + Implicit None + + ! Arguments + class(mld_d_onelev_type), intent(inout) :: lv + character(len=*), 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_onelev_cseti' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case (what) + + case ('SMOOTHER_SWEEPS') + lv%parms%sweeps = val + lv%parms%sweeps_pre = val + lv%parms%sweeps_post = val + + case ('SMOOTHER_SWEEPS_PRE') + lv%parms%sweeps_pre = val + + case ('SMOOTHER_SWEEPS_POST') + lv%parms%sweeps_post = val + + case ('ML_TYPE') + lv%parms%ml_type = val + + case ('AGGR_ALG') + lv%parms%aggr_alg = val + + case ('AGGR_KIND') + lv%parms%aggr_kind = val + + case ('COARSE_MAT') + lv%parms%coarse_mat = val + + case ('SMOOTHER_POS') + lv%parms%smoother_pos = val + + case ('AGGR_OMEGA_ALG') + lv%parms%aggr_omega_alg= val + + case ('AGGR_EIG') + lv%parms%aggr_eig = val + + case ('AGGR_FILTER') + lv%parms%aggr_filter = val + + case ('COARSE_SOLVE') + lv%parms%coarse_solve = val + + case default + if (allocated(lv%sm)) then + call lv%sm%set(what,val,info) + end if + end select + if (info /= psb_success_) goto 9999 + 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 mld_d_base_onelev_cseti diff --git a/mlprec/impl/level/mld_d_base_onelev_csetr.f90 b/mlprec/impl/level/mld_d_base_onelev_csetr.f90 new file mode 100644 index 00000000..fe54e40e --- /dev/null +++ b/mlprec/impl/level/mld_d_base_onelev_csetr.f90 @@ -0,0 +1,84 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetr(lv,what,val,info) + + use psb_base_mod + use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_csetr + + Implicit None + + ! Arguments + class(mld_d_onelev_type), intent(inout) :: lv + character(len=*), 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_onelev_csetr' + + call psb_erractionsave(err_act) + + + info = psb_success_ + + select case (what) + + case ('AGGR_OMEGA_VAL') + lv%parms%aggr_omega_val= val + + case ('AGGR_THRESH') + lv%parms%aggr_thresh = val + + case default + if (allocated(lv%sm)) then + call lv%sm%set(what,val,info) + end if + end select + + if (info /= psb_success_) goto 9999 + 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 mld_d_base_onelev_csetr diff --git a/mlprec/impl/level/mld_d_base_onelev_seti.f90 b/mlprec/impl/level/mld_d_base_onelev_seti.f90 index c66fd323..7a00a17e 100644 --- a/mlprec/impl/level/mld_d_base_onelev_seti.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_seti.f90 @@ -98,8 +98,8 @@ subroutine mld_d_base_onelev_seti(lv,what,val,info) if (allocated(lv%sm)) then call lv%sm%set(what,val,info) end if - if (info /= psb_success_) goto 9999 end select + if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/level/mld_d_base_onelev_setr.f90 b/mlprec/impl/level/mld_d_base_onelev_setr.f90 index f7c603a1..bcea6391 100644 --- a/mlprec/impl/level/mld_d_base_onelev_setr.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_setr.f90 @@ -68,9 +68,9 @@ subroutine mld_d_base_onelev_setr(lv,what,val,info) if (allocated(lv%sm)) then call lv%sm%set(what,val,info) end if - if (info /= psb_success_) goto 9999 end select + if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/level/mld_s_base_onelev_csetc.f90 b/mlprec/impl/level/mld_s_base_onelev_csetc.f90 new file mode 100644 index 00000000..b4a46f17 --- /dev/null +++ b/mlprec/impl/level/mld_s_base_onelev_csetc.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetc(lv,what,val,info) + + use psb_base_mod + use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_csetc + + Implicit None + + ! Arguments + class(mld_s_onelev_type), intent(inout) :: lv + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act + character(len=20) :: name='s_base_onelev_csetc' + integer(psb_ipk_) :: ival + + call psb_erractionsave(err_act) + + info = psb_success_ + + ival = mld_stringval(val) + if (ival >= 0) then + call lv%set(what,ival,info) + else + if (allocated(lv%sm)) then + call lv%sm%set(what,val,info) + end if + end if + + + if (info /= psb_success_) goto 9999 + + 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 mld_s_base_onelev_csetc diff --git a/mlprec/impl/level/mld_s_base_onelev_cseti.f90 b/mlprec/impl/level/mld_s_base_onelev_cseti.f90 new file mode 100644 index 00000000..f6abe349 --- /dev/null +++ b/mlprec/impl/level/mld_s_base_onelev_cseti.f90 @@ -0,0 +1,113 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_cseti(lv,what,val,info) + + use psb_base_mod + use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_cseti + + Implicit None + + ! Arguments + class(mld_s_onelev_type), intent(inout) :: lv + character(len=*), 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_onelev_cseti' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case (what) + + case ('SMOOTHER_SWEEPS') + lv%parms%sweeps = val + lv%parms%sweeps_pre = val + lv%parms%sweeps_post = val + + case ('SMOOTHER_SWEEPS_PRE') + lv%parms%sweeps_pre = val + + case ('SMOOTHER_SWEEPS_POST') + lv%parms%sweeps_post = val + + case ('ML_TYPE') + lv%parms%ml_type = val + + case ('AGGR_ALG') + lv%parms%aggr_alg = val + + case ('AGGR_KIND') + lv%parms%aggr_kind = val + + case ('COARSE_MAT') + lv%parms%coarse_mat = val + + case ('SMOOTHER_POS') + lv%parms%smoother_pos = val + + case ('AGGR_OMEGA_ALG') + lv%parms%aggr_omega_alg= val + + case ('AGGR_EIG') + lv%parms%aggr_eig = val + + case ('AGGR_FILTER') + lv%parms%aggr_filter = val + + case ('COARSE_SOLVE') + lv%parms%coarse_solve = val + + case default + if (allocated(lv%sm)) then + call lv%sm%set(what,val,info) + end if + end select + if (info /= psb_success_) goto 9999 + 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 mld_s_base_onelev_cseti diff --git a/mlprec/impl/level/mld_s_base_onelev_csetr.f90 b/mlprec/impl/level/mld_s_base_onelev_csetr.f90 new file mode 100644 index 00000000..3cf6e005 --- /dev/null +++ b/mlprec/impl/level/mld_s_base_onelev_csetr.f90 @@ -0,0 +1,84 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetr(lv,what,val,info) + + use psb_base_mod + use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_csetr + + Implicit None + + ! Arguments + class(mld_s_onelev_type), intent(inout) :: lv + character(len=*), 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_onelev_csetr' + + call psb_erractionsave(err_act) + + + info = psb_success_ + + select case (what) + + case ('AGGR_OMEGA_VAL') + lv%parms%aggr_omega_val= val + + case ('AGGR_THRESH') + lv%parms%aggr_thresh = val + + case default + if (allocated(lv%sm)) then + call lv%sm%set(what,val,info) + end if + end select + + if (info /= psb_success_) goto 9999 + 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 mld_s_base_onelev_csetr diff --git a/mlprec/impl/level/mld_s_base_onelev_seti.f90 b/mlprec/impl/level/mld_s_base_onelev_seti.f90 index c1daa7db..a2ecb969 100644 --- a/mlprec/impl/level/mld_s_base_onelev_seti.f90 +++ b/mlprec/impl/level/mld_s_base_onelev_seti.f90 @@ -98,8 +98,8 @@ subroutine mld_s_base_onelev_seti(lv,what,val,info) if (allocated(lv%sm)) then call lv%sm%set(what,val,info) end if - if (info /= psb_success_) goto 9999 end select + if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/level/mld_s_base_onelev_setr.f90 b/mlprec/impl/level/mld_s_base_onelev_setr.f90 index 885126f4..ed2989cf 100644 --- a/mlprec/impl/level/mld_s_base_onelev_setr.f90 +++ b/mlprec/impl/level/mld_s_base_onelev_setr.f90 @@ -68,9 +68,9 @@ subroutine mld_s_base_onelev_setr(lv,what,val,info) if (allocated(lv%sm)) then call lv%sm%set(what,val,info) end if - if (info /= psb_success_) goto 9999 end select + if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/level/mld_z_base_onelev_csetc.f90 b/mlprec/impl/level/mld_z_base_onelev_csetc.f90 new file mode 100644 index 00000000..e7071b31 --- /dev/null +++ b/mlprec/impl/level/mld_z_base_onelev_csetc.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetc(lv,what,val,info) + + use psb_base_mod + use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_csetc + + Implicit None + + ! Arguments + class(mld_z_onelev_type), intent(inout) :: lv + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act + character(len=20) :: name='z_base_onelev_csetc' + integer(psb_ipk_) :: ival + + call psb_erractionsave(err_act) + + info = psb_success_ + + ival = mld_stringval(val) + if (ival >= 0) then + call lv%set(what,ival,info) + else + if (allocated(lv%sm)) then + call lv%sm%set(what,val,info) + end if + end if + + + if (info /= psb_success_) goto 9999 + + 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 mld_z_base_onelev_csetc diff --git a/mlprec/impl/level/mld_z_base_onelev_cseti.f90 b/mlprec/impl/level/mld_z_base_onelev_cseti.f90 new file mode 100644 index 00000000..adb70a0f --- /dev/null +++ b/mlprec/impl/level/mld_z_base_onelev_cseti.f90 @@ -0,0 +1,113 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_cseti(lv,what,val,info) + + use psb_base_mod + use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_cseti + + Implicit None + + ! Arguments + class(mld_z_onelev_type), intent(inout) :: lv + character(len=*), 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_onelev_cseti' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case (what) + + case ('SMOOTHER_SWEEPS') + lv%parms%sweeps = val + lv%parms%sweeps_pre = val + lv%parms%sweeps_post = val + + case ('SMOOTHER_SWEEPS_PRE') + lv%parms%sweeps_pre = val + + case ('SMOOTHER_SWEEPS_POST') + lv%parms%sweeps_post = val + + case ('ML_TYPE') + lv%parms%ml_type = val + + case ('AGGR_ALG') + lv%parms%aggr_alg = val + + case ('AGGR_KIND') + lv%parms%aggr_kind = val + + case ('COARSE_MAT') + lv%parms%coarse_mat = val + + case ('SMOOTHER_POS') + lv%parms%smoother_pos = val + + case ('AGGR_OMEGA_ALG') + lv%parms%aggr_omega_alg= val + + case ('AGGR_EIG') + lv%parms%aggr_eig = val + + case ('AGGR_FILTER') + lv%parms%aggr_filter = val + + case ('COARSE_SOLVE') + lv%parms%coarse_solve = val + + case default + if (allocated(lv%sm)) then + call lv%sm%set(what,val,info) + end if + end select + if (info /= psb_success_) goto 9999 + 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 mld_z_base_onelev_cseti diff --git a/mlprec/impl/level/mld_z_base_onelev_csetr.f90 b/mlprec/impl/level/mld_z_base_onelev_csetr.f90 new file mode 100644 index 00000000..97e2a325 --- /dev/null +++ b/mlprec/impl/level/mld_z_base_onelev_csetr.f90 @@ -0,0 +1,84 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetr(lv,what,val,info) + + use psb_base_mod + use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_csetr + + Implicit None + + ! Arguments + class(mld_z_onelev_type), intent(inout) :: lv + character(len=*), 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_onelev_csetr' + + call psb_erractionsave(err_act) + + + info = psb_success_ + + select case (what) + + case ('AGGR_OMEGA_VAL') + lv%parms%aggr_omega_val= val + + case ('AGGR_THRESH') + lv%parms%aggr_thresh = val + + case default + if (allocated(lv%sm)) then + call lv%sm%set(what,val,info) + end if + end select + + if (info /= psb_success_) goto 9999 + 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 mld_z_base_onelev_csetr diff --git a/mlprec/impl/level/mld_z_base_onelev_seti.f90 b/mlprec/impl/level/mld_z_base_onelev_seti.f90 index cb2d1200..d19e1498 100644 --- a/mlprec/impl/level/mld_z_base_onelev_seti.f90 +++ b/mlprec/impl/level/mld_z_base_onelev_seti.f90 @@ -98,8 +98,8 @@ subroutine mld_z_base_onelev_seti(lv,what,val,info) if (allocated(lv%sm)) then call lv%sm%set(what,val,info) end if - if (info /= psb_success_) goto 9999 end select + if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/level/mld_z_base_onelev_setr.f90 b/mlprec/impl/level/mld_z_base_onelev_setr.f90 index 7d067b38..b0403b00 100644 --- a/mlprec/impl/level/mld_z_base_onelev_setr.f90 +++ b/mlprec/impl/level/mld_z_base_onelev_setr.f90 @@ -68,9 +68,9 @@ subroutine mld_z_base_onelev_setr(lv,what,val,info) if (allocated(lv%sm)) then call lv%sm%set(what,val,info) end if - if (info /= psb_success_) goto 9999 end select + if (info /= psb_success_) goto 9999 call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/mld_cprecset.F90 b/mlprec/impl/mld_cprecset.F90 index fdd269fe..fe73b471 100644 --- a/mlprec/impl/mld_cprecset.F90 +++ b/mlprec/impl/mld_cprecset.F90 @@ -891,3 +891,131 @@ subroutine mld_cprecsetr(p,what,val,info,ilev) endif end subroutine mld_cprecsetr + + + +subroutine mld_ccprecseti(p,what,val,info,ilev) + + use psb_base_mod + use mld_c_prec_mod, mld_protect_name => mld_ccprecseti + 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 +#if defined(HAVE_UMF_) && 0 + use mld_c_umf_solver +#endif +#if defined(HAVE_SLU_) + use mld_c_slu_solver +#endif + + implicit none + + ! Arguments + class(mld_cprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + + ! Local variables + integer(psb_ipk_) :: ilev_, nlev_ + character(len=*), parameter :: name='mld_precseti' + + info = psb_success_ + + +end subroutine mld_ccprecseti + + +subroutine mld_ccprecsetc(p,what,string,info,ilev) + + use psb_base_mod + use mld_c_prec_mod, mld_protect_name => mld_ccprecsetc + + implicit none + + ! Arguments + class(mld_cprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + character(len=*), intent(in) :: string + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + + ! Local variables + integer(psb_ipk_) :: ilev_, nlev_,val + 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 + + +end subroutine mld_ccprecsetc + +subroutine mld_ccprecsetr(p,what,val,info,ilev) + + use psb_base_mod + use mld_c_prec_mod, mld_protect_name => mld_ccprecsetr + + implicit none + + ! Arguments + class(mld_cprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + +! Local variables + integer(psb_ipk_) :: ilev_,nlev_ + character(len=*), parameter :: name='mld_precsetr' + + info = psb_success_ + + if (present(ilev)) then + ilev_ = ilev + else + ilev_ = 1 + end if + + 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 ((ilev_<1).or.(ilev_ > nlev_)) then + write(psb_err_unit,*) name,& + & ': Error: invalid ILEV/NLEV combination',& + & ilev_, nlev_ + info = -1 + return + endif + + + + +end subroutine mld_ccprecsetr + diff --git a/mlprec/impl/mld_dcprecset.F90 b/mlprec/impl/mld_dcprecset.F90 new file mode 100644 index 00000000..7b49d82e --- /dev/null +++ b/mlprec/impl/mld_dcprecset.F90 @@ -0,0 +1,763 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +! File: mld_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_dcprecseti(p,what,val,info,ilev) + + use psb_base_mod + use mld_d_prec_mod, mld_protect_name => mld_dcprecseti + 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 +#if defined(HAVE_UMF_) + use mld_d_umf_solver +#endif +#if defined(HAVE_SLU_) + use mld_d_slu_solver +#endif + + implicit none + + ! Arguments + class(mld_dprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + + ! Local variables + integer(psb_ipk_) :: ilev_, nlev_ + 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 + else + ilev_ = 1 + 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 (what == 'COARSE_AGGR_SIZE') then + p%coarse_aggr_size = max(val,-1) + return + end if + + ! + ! Set preconditioner parameters at level ilev. + ! + if (present(ilev)) then + + if (ilev_ == 1) then + ! + ! Rules for fine level are slightly different. + ! + select case(what) + case('SMOOTHER_TYPE') + call onelev_set_smoother(p%precv(ilev_),val,info) + case('SUB_SOLVE') + call onelev_set_solver(p%precv(ilev_),val,info) + case('SMOOTHER_SWEEPS','ML_TYPE','AGGR_ALG','AGGR_KIND',& + & 'SMOOTHER_POS','AGGR_OMEGA_ALG','AGGR_EIG',& + & 'SMOOTHER_SWEEPS_PRE','SMOOTHER_SWEEPS_POST',& + & 'SUB_RESTR','SUB_PROL', & + & 'SUB_REN','SUB_OVR','SUB_FILLIN') + call p%precv(ilev_)%set(what,val,info) + + case default + call p%precv(ilev_)%set(what,val,info) + end select + + else if (ilev_ > 1) then + + select case(what) + case('SMOOTHER_TYPE') + call onelev_set_smoother(p%precv(ilev_),val,info) + case('SUB_SOLVE') + call onelev_set_solver(p%precv(ilev_),val,info) + case('SMOOTHER_SWEEPS','ML_TYPE','AGGR_ALG','AGGR_KIND',& + & 'SMOOTHER_POS','AGGR_OMEGA_ALG','AGGR_EIG',& + & 'SMOOTHER_SWEEPS_PRE','SMOOTHER_SWEEPS_POST',& + & 'SUB_RESTR','SUB_PROL', & + & 'SUB_REN','SUB_OVR','SUB_FILLIN',& + & 'COARSE_MAT') + call p%precv(ilev_)%set(what,val,info) + + case('COARSE_SUBSOLVE') + if (ilev_ /= nlev_) then + write(psb_err_unit,*) name,& + & ': Error: Inconsistent specification of WHAT vs. ILEV' + info = -2 + return + end if + call onelev_set_solver(p%precv(ilev_),val,info) + case('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('COARSE_SOLVE',val,info) + select case (val) + case(mld_bjac_) + call onelev_set_smoother(p%precv(nlev_),val,info) +#if defined(HAVE_UMF_) + call onelev_set_solver(p%precv(nlev_),mld_umf_,info) +#elif defined(HAVE_SLU_) + call onelev_set_solver(p%precv(nlev_),mld_slu_,info) +#else + call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info) +#endif + call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info) + case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_) + call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info) + call onelev_set_solver(p%precv(nlev_),val,info) + call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info) + case(mld_sludist_) + call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info) + call onelev_set_solver(p%precv(nlev_),val,info) + call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info) + case(mld_jac_) + call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info) + call onelev_set_solver(p%precv(nlev_),mld_diag_scale_,info) + call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info) + end select + + endif + case('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('SMOOTHER_SWEEPS',val,info) + + case('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('SUB_FILLIN',val,info) + case default + call p%precv(ilev_)%set(what,val,info) + end select + + endif + + else if (.not.present(ilev)) then + ! + ! ilev not specified: set preconditioner parameters at all the appropriate + ! levels + ! + select case(what) + case('SUB_SOLVE') + do ilev_=1,max(1,nlev_-1) + if (.not.allocated(p%precv(ilev_)%sm)) then + write(psb_err_unit,*) name,& + & ': Error: uninitialized preconditioner component,',& + & ' should call MLD_PRECINIT' + info = -1 + return + endif + call onelev_set_solver(p%precv(ilev_),val,info) + + end do + + case('SUB_RESTR','SUB_PROL',& + & 'SUB_REN','SUB_OVR','SUB_FILLIN') + do ilev_=1,max(1,nlev_-1) + call p%precv(ilev_)%set(what,val,info) + end do + + case('SMOOTHER_SWEEPS') + do ilev_=1,max(1,nlev_-1) + call p%precv(ilev_)%set(what,val,info) + end do + + case('SMOOTHER_TYPE') + do ilev_=1,max(1,nlev_-1) + call onelev_set_smoother(p%precv(ilev_),val,info) + end do + + case('ML_TYPE','AGGR_ALG','AGGR_KIND',& + & 'SMOOTHER_SWEEPS_PRE','SMOOTHER_SWEEPS_POST',& + & 'SMOOTHER_POS','AGGR_OMEGA_ALG',& + & 'AGGR_EIG','AGGR_FILTER') + do ilev_=1,nlev_ + call p%precv(ilev_)%set(what,val,info) + end do + + case('COARSE_MAT') + if (nlev_ > 1) then + call p%precv(nlev_)%set('COARSE_MAT',val,info) + end if + + case('COARSE_SOLVE') + if (nlev_ > 1) then + + call p%precv(nlev_)%set('COARSE_SOLVE',val,info) + select case (val) + case(mld_bjac_) + call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info) +#if defined(HAVE_UMF_) + call onelev_set_solver(p%precv(nlev_),mld_umf_,info) +#elif defined(HAVE_SLU_) + call onelev_set_solver(p%precv(nlev_),mld_slu_,info) +#else + call onelev_set_solver(p%precv(nlev_),mld_ilu_n_,info) +#endif + call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info) + case(mld_umf_, mld_slu_,mld_ilu_n_, mld_ilu_t_,mld_milu_n_) + call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info) + call onelev_set_solver(p%precv(nlev_),val,info) + call p%precv(nlev_)%set('COARSE_MAT',mld_repl_mat_,info) + case(mld_sludist_) + call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info) + call onelev_set_solver(p%precv(nlev_),val,info) + call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info) + case(mld_jac_) + call onelev_set_smoother(p%precv(nlev_),mld_bjac_,info) + call onelev_set_solver(p%precv(nlev_),mld_diag_scale_,info) + call p%precv(nlev_)%set('COARSE_MAT',mld_distr_mat_,info) + end select + + endif + + case('COARSE_SUBSOLVE') + if (nlev_ > 1) then + call onelev_set_solver(p%precv(nlev_),val,info) + endif + + case('COARSE_SWEEPS') + + if (nlev_ > 1) then + call p%precv(nlev_)%set('SMOOTHER_SWEEPS',val,info) + end if + + case('COARSE_FILLIN') + if (nlev_ > 1) then + call p%precv(nlev_)%set('SUB_FILLIN',val,info) + end if + case default + do ilev_=1,nlev_ + call p%precv(ilev_)%set(what,val,info) + end do + end select + + endif + +contains + + subroutine onelev_set_smoother(level,val,info) + type(mld_d_onelev_type), intent(inout) :: level + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + info = psb_success_ + + ! + ! This here requires a bit more attention. + ! + select case (val) + case (mld_noprec_) + if (allocated(level%sm)) then + select type (sm => level%sm) + type is (mld_d_base_smoother_type) + ! do nothing + class default + call level%sm%free(info) + if (info == 0) deallocate(level%sm) + if (info == 0) allocate(mld_d_base_smoother_type ::& + & level%sm, stat=info) + if (info == 0) allocate(mld_d_id_solver_type ::& + & level%sm%sv, stat=info) + end select + else + allocate(mld_d_base_smoother_type ::& + & level%sm, stat=info) + if (info ==0) allocate(mld_d_id_solver_type ::& + & level%sm%sv, stat=info) + endif + + case (mld_jac_) + if (allocated(level%sm)) then + select type (sm => level%sm) + class is (mld_d_jac_smoother_type) + ! do nothing + class default + call level%sm%free(info) + if (info == 0) deallocate(level%sm) + if (info == 0) allocate(mld_d_jac_smoother_type :: & + & level%sm, stat=info) + if (info == 0) allocate(mld_d_diag_solver_type :: & + & level%sm%sv, stat=info) + end select + else + allocate(mld_d_jac_smoother_type :: level%sm, stat=info) + if (info == 0) allocate(mld_d_diag_solver_type ::& + & level%sm%sv, stat=info) + endif + + case (mld_bjac_) + if (allocated(level%sm)) then + select type (sm => level%sm) + class is (mld_d_jac_smoother_type) + ! do nothing + class default + call level%sm%free(info) + if (info == 0) deallocate(level%sm) + if (info == 0) allocate(mld_d_jac_smoother_type ::& + & level%sm, stat=info) + if (info == 0) allocate(mld_d_ilu_solver_type ::& + & level%sm%sv, stat=info) + end select + else + allocate(mld_d_jac_smoother_type :: level%sm, stat=info) + if (info == 0) allocate(mld_d_ilu_solver_type ::& + & level%sm%sv, stat=info) + endif + + case (mld_as_) + if (allocated(level%sm)) then + select type (sm => level%sm) + class is (mld_d_as_smoother_type) + ! do nothing + class default + call level%sm%free(info) + if (info == 0) deallocate(level%sm) + if (info == 0) allocate(mld_d_as_smoother_type ::& + & level%sm, stat=info) + if (info == 0) allocate(mld_d_ilu_solver_type ::& + & level%sm%sv, stat=info) + end select + else + allocate(mld_d_as_smoother_type :: level%sm, stat=info) + if (info == 0) allocate(mld_d_ilu_solver_type ::& + & level%sm%sv, stat=info) + endif + + case default + ! + ! Do nothing and hope for the best :) + ! + end select + if (allocated(level%sm)) & + & call level%sm%default() + + end subroutine onelev_set_smoother + + subroutine onelev_set_solver(level,val,info) + type(mld_d_onelev_type), intent(inout) :: level + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + info = psb_success_ + + ! + ! This here requires a bit more attention. + ! + select case (val) + case (mld_f_none_) + if (allocated(level%sm%sv)) then + select type (sv => level%sm%sv) + class is (mld_d_id_solver_type) + ! do nothing + class default + call level%sm%sv%free(info) + if (info == 0) deallocate(level%sm%sv) + if (info == 0) allocate(mld_d_id_solver_type ::& + & level%sm%sv, stat=info) + end select + else + allocate(mld_d_id_solver_type :: level%sm%sv, stat=info) + endif + if (allocated(level%sm)) then + if (allocated(level%sm%sv)) & + & call level%sm%sv%default() + end if + + + case (mld_diag_scale_) + if (allocated(level%sm%sv)) then + select type (sv => level%sm%sv) + class is (mld_d_diag_solver_type) + ! do nothing + class default + call level%sm%sv%free(info) + if (info == 0) deallocate(level%sm%sv) + if (info == 0) allocate(mld_d_diag_solver_type ::& + & level%sm%sv, stat=info) + end select + else + allocate(mld_d_diag_solver_type :: level%sm%sv, stat=info) + endif + if (allocated(level%sm)) then + if (allocated(level%sm%sv)) & + & call level%sm%sv%default() + end if + + + case (mld_ilu_n_,mld_milu_n_,mld_ilu_t_) + if (allocated(level%sm%sv)) then + select type (sv => level%sm%sv) + class is (mld_d_ilu_solver_type) + ! do nothing + class default + call level%sm%sv%free(info) + if (info == 0) deallocate(level%sm%sv) + if (info == 0) allocate(mld_d_ilu_solver_type ::& + & level%sm%sv, stat=info) + end select + else + allocate(mld_d_ilu_solver_type :: level%sm%sv, stat=info) + endif + if (allocated(level%sm)) then + if (allocated(level%sm%sv)) & + & call level%sm%sv%default() + end if + call level%sm%sv%set('SUB_SOLVE',val,info) + +#ifdef HAVE_UMF_ + case (mld_umf_) + if (allocated(level%sm%sv)) then + select type (sv => level%sm%sv) + class is (mld_d_umf_solver_type) + ! do nothing + class default + call level%sm%sv%free(info) + if (info == 0) deallocate(level%sm%sv) + if (info == 0) allocate(mld_d_umf_solver_type ::& + & level%sm%sv, stat=info) + end select + else + allocate(mld_d_umf_solver_type :: level%sm%sv, stat=info) + endif + if (allocated(level%sm)) then + if (allocated(level%sm%sv)) & + & call level%sm%sv%default() + end if +#endif +#ifdef HAVE_SLU_ + case (mld_slu_) + if (allocated(level%sm%sv)) then + select type (sv => level%sm%sv) + class is (mld_d_slu_solver_type) + ! do nothing + class default + call level%sm%sv%free(info) + if (info == 0) deallocate(level%sm%sv) + if (info == 0) allocate(mld_d_slu_solver_type ::& + & level%sm%sv, stat=info) + end select + else + allocate(mld_d_slu_solver_type :: level%sm%sv, stat=info) + endif + if (allocated(level%sm)) then + if (allocated(level%sm%sv)) & + & call level%sm%sv%default() + end if +#endif + case default + ! + ! Do nothing and hope for the best :) + ! + end select + + end subroutine onelev_set_solver + + +end subroutine mld_dcprecseti + +! +! 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_dcprecsetc(p,what,string,info,ilev) + + use psb_base_mod + use mld_d_prec_mod, mld_protect_name => mld_dcprecsetc + + implicit none + + ! Arguments + class(mld_dprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + character(len=*), intent(in) :: string + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + + ! Local variables + integer(psb_ipk_) :: ilev_, nlev_,val + 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) + else + call p%precv(ilev_)%set(what,val,info) + end if + +end subroutine mld_dcprecsetc + + +! +! 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_dcprecsetr(p,what,val,info,ilev) + + use psb_base_mod + use mld_d_prec_mod, mld_protect_name => mld_dcprecsetr + + implicit none + + ! Arguments + class(mld_dprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + +! Local variables + integer(psb_ipk_) :: ilev_,nlev_ + character(len=*), parameter :: name='mld_precsetr' + + info = psb_success_ + + if (present(ilev)) then + ilev_ = ilev + else + ilev_ = 1 + end if + + 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 ((ilev_<1).or.(ilev_ > nlev_)) then + write(psb_err_unit,*) name,& + & ': Error: invalid ILEV/NLEV combination',& + & ilev_, nlev_ + info = -1 + return + endif + + ! + ! Set preconditioner parameters at level ilev. + ! + if (present(ilev)) then + + call p%precv(ilev_)%set(what,val,info) + + else if (.not.present(ilev)) then + ! + ! ilev not specified: set preconditioner parameters at all the appropriate levels + ! + + select case(what) + case('COARSE_ILUTHRS') + ilev_=nlev_ + call p%precv(ilev_)%set('SUB_ILUTHRS',val,info) + + case default + + do ilev_=1,nlev_ + call p%precv(ilev_)%set(what,val,info) + end do + end select + + endif + +end subroutine mld_dcprecsetr + + diff --git a/mlprec/impl/mld_dmlprec_bld.f90 b/mlprec/impl/mld_dmlprec_bld.f90 index 893cc92b..19fab1b5 100644 --- a/mlprec/impl/mld_dmlprec_bld.f90 +++ b/mlprec/impl/mld_dmlprec_bld.f90 @@ -294,13 +294,13 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold) if (i ==1) then ! This is a workaround for a bug in gfortran 4.7.2 call doallc(i,p%precv,base_sm,info) - ! !$ allocate(p%precv(i)%sm,source=base_sm,stat=info) +!!$ allocate(p%precv(i)%sm,source=base_sm,stat=info) else if (i < newsz) then call doallc(i,p%precv,med_sm,info) - ! !$ allocate(p%precv(i)%sm,source=med_sm,stat=info) +!!$ allocate(p%precv(i)%sm,source=med_sm,stat=info) else call doallc(i,p%precv,coarse_sm,info) - ! !$ allocate(p%precv(i)%sm,source=coarse_sm,stat=info) +!!$ allocate(p%precv(i)%sm,source=coarse_sm,stat=info) end if end if if (info /= psb_success_) then diff --git a/mlprec/impl/mld_dprecset.F90 b/mlprec/impl/mld_dprecset.F90 index 78cf906c..c4f0fb65 100644 --- a/mlprec/impl/mld_dprecset.F90 +++ b/mlprec/impl/mld_dprecset.F90 @@ -360,7 +360,7 @@ contains select type (sm => level%sm) type is (mld_d_base_smoother_type) ! do nothing - class default + class default call level%sm%free(info) if (info == 0) deallocate(level%sm) if (info == 0) allocate(mld_d_base_smoother_type ::& @@ -378,9 +378,9 @@ contains case (mld_jac_) if (allocated(level%sm)) then select type (sm => level%sm) - class is (mld_d_jac_smoother_type) + class is (mld_d_jac_smoother_type) ! do nothing - class default + class default call level%sm%free(info) if (info == 0) deallocate(level%sm) if (info == 0) allocate(mld_d_jac_smoother_type :: & @@ -397,9 +397,9 @@ contains case (mld_bjac_) if (allocated(level%sm)) then select type (sm => level%sm) - class is (mld_d_jac_smoother_type) + class is (mld_d_jac_smoother_type) ! do nothing - class default + class default call level%sm%free(info) if (info == 0) deallocate(level%sm) if (info == 0) allocate(mld_d_jac_smoother_type ::& @@ -416,9 +416,9 @@ contains case (mld_as_) if (allocated(level%sm)) then select type (sm => level%sm) - class is (mld_d_as_smoother_type) + class is (mld_d_as_smoother_type) ! do nothing - class default + class default call level%sm%free(info) if (info == 0) deallocate(level%sm) if (info == 0) allocate(mld_d_as_smoother_type ::& @@ -455,9 +455,9 @@ contains case (mld_f_none_) if (allocated(level%sm%sv)) then select type (sv => level%sm%sv) - class is (mld_d_id_solver_type) - ! do nothing - class default + class is (mld_d_id_solver_type) + ! do nothing + class default call level%sm%sv%free(info) if (info == 0) deallocate(level%sm%sv) if (info == 0) allocate(mld_d_id_solver_type ::& @@ -475,9 +475,9 @@ contains case (mld_diag_scale_) if (allocated(level%sm%sv)) then select type (sv => level%sm%sv) - class is (mld_d_diag_solver_type) + class is (mld_d_diag_solver_type) ! do nothing - class default + class default call level%sm%sv%free(info) if (info == 0) deallocate(level%sm%sv) if (info == 0) allocate(mld_d_diag_solver_type ::& @@ -516,9 +516,9 @@ contains case (mld_umf_) if (allocated(level%sm%sv)) then select type (sv => level%sm%sv) - class is (mld_d_umf_solver_type) + class is (mld_d_umf_solver_type) ! do nothing - class default + class default call level%sm%sv%free(info) if (info == 0) deallocate(level%sm%sv) if (info == 0) allocate(mld_d_umf_solver_type ::& @@ -536,9 +536,9 @@ contains case (mld_slu_) if (allocated(level%sm%sv)) then select type (sv => level%sm%sv) - class is (mld_d_slu_solver_type) + class is (mld_d_slu_solver_type) ! do nothing - class default + class default call level%sm%sv%free(info) if (info == 0) deallocate(level%sm%sv) if (info == 0) allocate(mld_d_slu_solver_type ::& @@ -891,3 +891,7 @@ subroutine mld_dprecsetr(p,what,val,info,ilev) endif end subroutine mld_dprecsetr + + + + diff --git a/mlprec/impl/mld_sprecset.F90 b/mlprec/impl/mld_sprecset.F90 index ca34cc74..d156c972 100644 --- a/mlprec/impl/mld_sprecset.F90 +++ b/mlprec/impl/mld_sprecset.F90 @@ -891,3 +891,131 @@ subroutine mld_sprecsetr(p,what,val,info,ilev) endif end subroutine mld_sprecsetr + + + + +subroutine mld_scprecseti(p,what,val,info,ilev) + + use psb_base_mod + use mld_s_prec_mod, mld_protect_name => mld_scprecseti + 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 +#if defined(HAVE_UMF_) && 0 + use mld_s_umf_solver +#endif +#if defined(HAVE_SLU_) + use mld_s_slu_solver +#endif + + implicit none + + ! Arguments + class(mld_sprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + + ! Local variables + integer(psb_ipk_) :: ilev_, nlev_ + character(len=*), parameter :: name='mld_precseti' + + info = psb_success_ + + +end subroutine mld_scprecseti + + +subroutine mld_scprecsetc(p,what,string,info,ilev) + + use psb_base_mod + use mld_s_prec_mod, mld_protect_name => mld_scprecsetc + + implicit none + + ! Arguments + class(mld_sprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + character(len=*), intent(in) :: string + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + + ! Local variables + integer(psb_ipk_) :: ilev_, nlev_,val + 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 + + +end subroutine mld_scprecsetc + +subroutine mld_scprecsetr(p,what,val,info,ilev) + + use psb_base_mod + use mld_s_prec_mod, mld_protect_name => mld_scprecsetr + + implicit none + + ! Arguments + class(mld_sprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + +! Local variables + integer(psb_ipk_) :: ilev_,nlev_ + character(len=*), parameter :: name='mld_precsetr' + + info = psb_success_ + + if (present(ilev)) then + ilev_ = ilev + else + ilev_ = 1 + end if + + 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 ((ilev_<1).or.(ilev_ > nlev_)) then + write(psb_err_unit,*) name,& + & ': Error: invalid ILEV/NLEV combination',& + & ilev_, nlev_ + info = -1 + return + endif + + + + +end subroutine mld_scprecsetr diff --git a/mlprec/impl/mld_zprecset.F90 b/mlprec/impl/mld_zprecset.F90 index ce78d24d..773b4116 100644 --- a/mlprec/impl/mld_zprecset.F90 +++ b/mlprec/impl/mld_zprecset.F90 @@ -890,3 +890,132 @@ subroutine mld_zprecsetr(p,what,val,info,ilev) endif end subroutine mld_zprecsetr + + + + + +subroutine mld_zcprecseti(p,what,val,info,ilev) + + use psb_base_mod + use mld_z_prec_mod, mld_protect_name => mld_zcprecseti + 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 +#if defined(HAVE_UMF_) + use mld_z_umf_solver +#endif +#if defined(HAVE_SLU_) + use mld_z_slu_solver +#endif + + implicit none + + ! Arguments + class(mld_zprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + + ! Local variables + integer(psb_ipk_) :: ilev_, nlev_ + character(len=*), parameter :: name='mld_precseti' + + info = psb_success_ + + +end subroutine mld_zcprecseti + + +subroutine mld_zcprecsetc(p,what,string,info,ilev) + + use psb_base_mod + use mld_z_prec_mod, mld_protect_name => mld_zcprecsetc + + implicit none + + ! Arguments + class(mld_zprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + character(len=*), intent(in) :: string + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + + ! Local variables + integer(psb_ipk_) :: ilev_, nlev_,val + 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 + + +end subroutine mld_zcprecsetc + +subroutine mld_zcprecsetr(p,what,val,info,ilev) + + use psb_base_mod + use mld_z_prec_mod, mld_protect_name => mld_zcprecsetr + + implicit none + + ! Arguments + class(mld_zprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + +! Local variables + integer(psb_ipk_) :: ilev_,nlev_ + character(len=*), parameter :: name='mld_precsetr' + + info = psb_success_ + + if (present(ilev)) then + ilev_ = ilev + else + ilev_ = 1 + end if + + 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 ((ilev_<1).or.(ilev_ > nlev_)) then + write(psb_err_unit,*) name,& + & ': Error: invalid ILEV/NLEV combination',& + & ilev_, nlev_ + info = -1 + return + endif + + + + +end subroutine mld_zcprecsetr diff --git a/mlprec/impl/smoother/Makefile b/mlprec/impl/smoother/Makefile index 44440050..8fac6f78 100644 --- a/mlprec/impl/smoother/Makefile +++ b/mlprec/impl/smoother/Makefile @@ -16,6 +16,9 @@ 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_csetc.o \ +mld_c_as_smoother_cseti.o \ +mld_c_as_smoother_csetr.o \ mld_c_base_smoother_apply.o \ mld_c_base_smoother_apply_vect.o \ mld_c_base_smoother_bld.o \ @@ -26,6 +29,9 @@ 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_base_smoother_csetc.o \ +mld_c_base_smoother_cseti.o \ +mld_c_base_smoother_csetr.o \ mld_c_jac_smoother_apply.o \ mld_c_jac_smoother_apply_vect.o \ mld_c_jac_smoother_bld.o \ @@ -38,6 +44,9 @@ 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_csetc.o \ +mld_d_as_smoother_cseti.o \ +mld_d_as_smoother_csetr.o \ mld_d_base_smoother_apply.o \ mld_d_base_smoother_apply_vect.o \ mld_d_base_smoother_bld.o \ @@ -48,6 +57,9 @@ 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_base_smoother_csetc.o \ +mld_d_base_smoother_cseti.o \ +mld_d_base_smoother_csetr.o \ mld_d_jac_smoother_apply.o \ mld_d_jac_smoother_apply_vect.o \ mld_d_jac_smoother_bld.o \ @@ -60,6 +72,9 @@ 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_csetc.o \ +mld_s_as_smoother_cseti.o \ +mld_s_as_smoother_csetr.o \ mld_s_base_smoother_apply.o \ mld_s_base_smoother_apply_vect.o \ mld_s_base_smoother_bld.o \ @@ -70,6 +85,9 @@ 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_base_smoother_csetc.o \ +mld_s_base_smoother_cseti.o \ +mld_s_base_smoother_csetr.o \ mld_s_jac_smoother_apply.o \ mld_s_jac_smoother_apply_vect.o \ mld_s_jac_smoother_bld.o \ @@ -82,6 +100,9 @@ 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_csetc.o \ +mld_z_as_smoother_cseti.o \ +mld_z_as_smoother_csetr.o \ mld_z_base_smoother_apply.o \ mld_z_base_smoother_apply_vect.o \ mld_z_base_smoother_bld.o \ @@ -92,11 +113,15 @@ 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_base_smoother_csetc.o \ +mld_z_base_smoother_cseti.o \ +mld_z_base_smoother_csetr.o \ mld_z_jac_smoother_apply.o \ mld_z_jac_smoother_apply_vect.o \ mld_z_jac_smoother_bld.o + LIBNAME=libmld_prec.a lib: $(OBJS) @@ -113,3 +138,4 @@ veryclean: clean clean: /bin/rm -f $(OBJS) $(LOCAL_MODS) + diff --git a/mlprec/impl/smoother/mld_c_as_smoother_csetc.f90 b/mlprec/impl/smoother/mld_c_as_smoother_csetc.f90 new file mode 100644 index 00000000..29b85afa --- /dev/null +++ b/mlprec/impl/smoother/mld_c_as_smoother_csetc.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetc(sm,what,val,info) + + use psb_base_mod + use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_csetc + Implicit None + ! Arguments + class(mld_c_as_smoother_type), intent(inout) :: sm + character(len=*), 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_csetc' + + info = psb_success_ + call psb_erractionsave(err_act) + + + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info, name) + goto 9999 + end if + + 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 mld_c_as_smoother_csetc diff --git a/mlprec/impl/smoother/mld_c_as_smoother_cseti.f90 b/mlprec/impl/smoother/mld_c_as_smoother_cseti.f90 new file mode 100644 index 00000000..0939de39 --- /dev/null +++ b/mlprec/impl/smoother/mld_c_as_smoother_cseti.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_cseti(sm,what,val,info) + + use psb_base_mod + use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_cseti + Implicit None + + ! Arguments + class(mld_c_as_smoother_type), intent(inout) :: sm + character(len=*), 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_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) +!!$ case('SMOOTHER_SWEEPS') +!!$ sm%sweeps = val + case('SUB_OVR') + sm%novr = val + case('SUB_RESTR') + sm%restr = val + case('SUB_PROL') + sm%prol = val + case default + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + 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 mld_c_as_smoother_cseti diff --git a/mlprec/impl/smoother/mld_c_as_smoother_csetr.f90 b/mlprec/impl/smoother/mld_c_as_smoother_csetr.f90 new file mode 100644 index 00000000..5a94801d --- /dev/null +++ b/mlprec/impl/smoother/mld_c_as_smoother_csetr.f90 @@ -0,0 +1,73 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetr(sm,what,val,info) + + use psb_base_mod + use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_csetr + Implicit None + ! Arguments + class(mld_c_as_smoother_type), intent(inout) :: sm + character(len=*), 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_csetr' + + 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 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_c_as_smoother_csetr diff --git a/mlprec/impl/smoother/mld_c_base_smoother_csetc.f90 b/mlprec/impl/smoother/mld_c_base_smoother_csetc.f90 new file mode 100644 index 00000000..07bd90d5 --- /dev/null +++ b/mlprec/impl/smoother/mld_c_base_smoother_csetc.f90 @@ -0,0 +1,78 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetc(sm,what,val,info) + + use psb_base_mod + use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_csetc + Implicit None + + ! Arguments + class(mld_c_base_smoother_type), intent(inout) :: sm + character(len=*), 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_csetc' + + call psb_erractionsave(err_act) + + info = psb_success_ + + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + end if + + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_c_base_smoother_csetc diff --git a/mlprec/impl/smoother/mld_c_base_smoother_cseti.f90 b/mlprec/impl/smoother/mld_c_base_smoother_cseti.f90 new file mode 100644 index 00000000..f44106f0 --- /dev/null +++ b/mlprec/impl/smoother/mld_c_base_smoother_cseti.f90 @@ -0,0 +1,69 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_cseti(sm,what,val,info) + + use psb_base_mod + use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_cseti + Implicit None + ! Arguments + class(mld_c_base_smoother_type), intent(inout) :: sm + character(len=*), 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_cseti' + + 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 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_c_base_smoother_cseti diff --git a/mlprec/impl/smoother/mld_c_base_smoother_csetr.f90 b/mlprec/impl/smoother/mld_c_base_smoother_csetr.f90 new file mode 100644 index 00000000..d97bdb57 --- /dev/null +++ b/mlprec/impl/smoother/mld_c_base_smoother_csetr.f90 @@ -0,0 +1,73 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetr(sm,what,val,info) + + use psb_base_mod + use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_csetr + Implicit None + + ! Arguments + class(mld_c_base_smoother_type), intent(inout) :: sm + character(len=*), 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_csetr' + + 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 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_c_base_smoother_csetr diff --git a/mlprec/impl/smoother/mld_d_as_smoother_csetc.f90 b/mlprec/impl/smoother/mld_d_as_smoother_csetc.f90 new file mode 100644 index 00000000..b770d28f --- /dev/null +++ b/mlprec/impl/smoother/mld_d_as_smoother_csetc.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetc(sm,what,val,info) + + use psb_base_mod + use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_csetc + Implicit None + ! Arguments + class(mld_d_as_smoother_type), intent(inout) :: sm + character(len=*), 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_csetc' + + info = psb_success_ + call psb_erractionsave(err_act) + + + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info, name) + goto 9999 + end if + + 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 mld_d_as_smoother_csetc diff --git a/mlprec/impl/smoother/mld_d_as_smoother_cseti.f90 b/mlprec/impl/smoother/mld_d_as_smoother_cseti.f90 new file mode 100644 index 00000000..4b195909 --- /dev/null +++ b/mlprec/impl/smoother/mld_d_as_smoother_cseti.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_cseti(sm,what,val,info) + + use psb_base_mod + use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_cseti + Implicit None + + ! Arguments + class(mld_d_as_smoother_type), intent(inout) :: sm + character(len=*), 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_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) +!!$ case('SMOOTHER_SWEEPS') +!!$ sm%sweeps = val + case('SUB_OVR') + sm%novr = val + case('SUB_RESTR') + sm%restr = val + case('SUB_PROL') + sm%prol = val + case default + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + 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 mld_d_as_smoother_cseti diff --git a/mlprec/impl/smoother/mld_d_as_smoother_csetr.f90 b/mlprec/impl/smoother/mld_d_as_smoother_csetr.f90 new file mode 100644 index 00000000..22dc0241 --- /dev/null +++ b/mlprec/impl/smoother/mld_d_as_smoother_csetr.f90 @@ -0,0 +1,73 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetr(sm,what,val,info) + + use psb_base_mod + use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_csetr + Implicit None + ! Arguments + class(mld_d_as_smoother_type), intent(inout) :: sm + character(len=*), 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_csetr' + + 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 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_d_as_smoother_csetr diff --git a/mlprec/impl/smoother/mld_d_base_smoother_csetc.f90 b/mlprec/impl/smoother/mld_d_base_smoother_csetc.f90 new file mode 100644 index 00000000..a4e1bd60 --- /dev/null +++ b/mlprec/impl/smoother/mld_d_base_smoother_csetc.f90 @@ -0,0 +1,78 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetc(sm,what,val,info) + + use psb_base_mod + use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_csetc + Implicit None + + ! Arguments + class(mld_d_base_smoother_type), intent(inout) :: sm + character(len=*), 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_csetc' + + call psb_erractionsave(err_act) + + info = psb_success_ + + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + end if + + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_d_base_smoother_csetc diff --git a/mlprec/impl/smoother/mld_d_base_smoother_cseti.f90 b/mlprec/impl/smoother/mld_d_base_smoother_cseti.f90 new file mode 100644 index 00000000..346c5459 --- /dev/null +++ b/mlprec/impl/smoother/mld_d_base_smoother_cseti.f90 @@ -0,0 +1,69 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_cseti(sm,what,val,info) + + use psb_base_mod + use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_cseti + Implicit None + ! Arguments + class(mld_d_base_smoother_type), intent(inout) :: sm + character(len=*), 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_cseti' + + 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 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_d_base_smoother_cseti diff --git a/mlprec/impl/smoother/mld_d_base_smoother_csetr.f90 b/mlprec/impl/smoother/mld_d_base_smoother_csetr.f90 new file mode 100644 index 00000000..e0d9ddeb --- /dev/null +++ b/mlprec/impl/smoother/mld_d_base_smoother_csetr.f90 @@ -0,0 +1,73 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetr(sm,what,val,info) + + use psb_base_mod + use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_csetr + Implicit None + + ! Arguments + class(mld_d_base_smoother_type), intent(inout) :: sm + character(len=*), 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_csetr' + + 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 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_d_base_smoother_csetr diff --git a/mlprec/impl/smoother/mld_s_as_smoother_csetc.f90 b/mlprec/impl/smoother/mld_s_as_smoother_csetc.f90 new file mode 100644 index 00000000..1609c97f --- /dev/null +++ b/mlprec/impl/smoother/mld_s_as_smoother_csetc.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetc(sm,what,val,info) + + use psb_base_mod + use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_csetc + Implicit None + ! Arguments + class(mld_s_as_smoother_type), intent(inout) :: sm + character(len=*), 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_csetc' + + info = psb_success_ + call psb_erractionsave(err_act) + + + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info, name) + goto 9999 + end if + + 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 mld_s_as_smoother_csetc diff --git a/mlprec/impl/smoother/mld_s_as_smoother_cseti.f90 b/mlprec/impl/smoother/mld_s_as_smoother_cseti.f90 new file mode 100644 index 00000000..1e40e4a4 --- /dev/null +++ b/mlprec/impl/smoother/mld_s_as_smoother_cseti.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_cseti(sm,what,val,info) + + use psb_base_mod + use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_cseti + Implicit None + + ! Arguments + class(mld_s_as_smoother_type), intent(inout) :: sm + character(len=*), 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_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) +!!$ case('SMOOTHER_SWEEPS') +!!$ sm%sweeps = val + case('SUB_OVR') + sm%novr = val + case('SUB_RESTR') + sm%restr = val + case('SUB_PROL') + sm%prol = val + case default + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + 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 mld_s_as_smoother_cseti diff --git a/mlprec/impl/smoother/mld_s_as_smoother_csetr.f90 b/mlprec/impl/smoother/mld_s_as_smoother_csetr.f90 new file mode 100644 index 00000000..ed0c546c --- /dev/null +++ b/mlprec/impl/smoother/mld_s_as_smoother_csetr.f90 @@ -0,0 +1,73 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetr(sm,what,val,info) + + use psb_base_mod + use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_csetr + Implicit None + ! Arguments + class(mld_s_as_smoother_type), intent(inout) :: sm + character(len=*), 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_csetr' + + 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 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_s_as_smoother_csetr diff --git a/mlprec/impl/smoother/mld_s_base_smoother_csetc.f90 b/mlprec/impl/smoother/mld_s_base_smoother_csetc.f90 new file mode 100644 index 00000000..7282caae --- /dev/null +++ b/mlprec/impl/smoother/mld_s_base_smoother_csetc.f90 @@ -0,0 +1,78 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetc(sm,what,val,info) + + use psb_base_mod + use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_csetc + Implicit None + + ! Arguments + class(mld_s_base_smoother_type), intent(inout) :: sm + character(len=*), 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_csetc' + + call psb_erractionsave(err_act) + + info = psb_success_ + + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + end if + + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_s_base_smoother_csetc diff --git a/mlprec/impl/smoother/mld_s_base_smoother_cseti.f90 b/mlprec/impl/smoother/mld_s_base_smoother_cseti.f90 new file mode 100644 index 00000000..4371fbd8 --- /dev/null +++ b/mlprec/impl/smoother/mld_s_base_smoother_cseti.f90 @@ -0,0 +1,69 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_cseti(sm,what,val,info) + + use psb_base_mod + use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_cseti + Implicit None + ! Arguments + class(mld_s_base_smoother_type), intent(inout) :: sm + character(len=*), 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_cseti' + + 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 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_s_base_smoother_cseti diff --git a/mlprec/impl/smoother/mld_s_base_smoother_csetr.f90 b/mlprec/impl/smoother/mld_s_base_smoother_csetr.f90 new file mode 100644 index 00000000..22c3c5a3 --- /dev/null +++ b/mlprec/impl/smoother/mld_s_base_smoother_csetr.f90 @@ -0,0 +1,73 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetr(sm,what,val,info) + + use psb_base_mod + use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_csetr + Implicit None + + ! Arguments + class(mld_s_base_smoother_type), intent(inout) :: sm + character(len=*), 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_csetr' + + 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 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_s_base_smoother_csetr diff --git a/mlprec/impl/smoother/mld_z_as_smoother_csetc.f90 b/mlprec/impl/smoother/mld_z_as_smoother_csetc.f90 new file mode 100644 index 00000000..0f434284 --- /dev/null +++ b/mlprec/impl/smoother/mld_z_as_smoother_csetc.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetc(sm,what,val,info) + + use psb_base_mod + use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_csetc + Implicit None + ! Arguments + class(mld_z_as_smoother_type), intent(inout) :: sm + character(len=*), 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_csetc' + + info = psb_success_ + call psb_erractionsave(err_act) + + + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info, name) + goto 9999 + end if + + 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 mld_z_as_smoother_csetc diff --git a/mlprec/impl/smoother/mld_z_as_smoother_cseti.f90 b/mlprec/impl/smoother/mld_z_as_smoother_cseti.f90 new file mode 100644 index 00000000..12a28d12 --- /dev/null +++ b/mlprec/impl/smoother/mld_z_as_smoother_cseti.f90 @@ -0,0 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_cseti(sm,what,val,info) + + use psb_base_mod + use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_cseti + Implicit None + + ! Arguments + class(mld_z_as_smoother_type), intent(inout) :: sm + character(len=*), 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_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) +!!$ case('SMOOTHER_SWEEPS') +!!$ sm%sweeps = val + case('SUB_OVR') + sm%novr = val + case('SUB_RESTR') + sm%restr = val + case('SUB_PROL') + sm%prol = val + case default + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + 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 mld_z_as_smoother_cseti diff --git a/mlprec/impl/smoother/mld_z_as_smoother_csetr.f90 b/mlprec/impl/smoother/mld_z_as_smoother_csetr.f90 new file mode 100644 index 00000000..c32503ed --- /dev/null +++ b/mlprec/impl/smoother/mld_z_as_smoother_csetr.f90 @@ -0,0 +1,73 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetr(sm,what,val,info) + + use psb_base_mod + use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_csetr + Implicit None + ! Arguments + class(mld_z_as_smoother_type), intent(inout) :: sm + character(len=*), 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_csetr' + + 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 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_z_as_smoother_csetr diff --git a/mlprec/impl/smoother/mld_z_base_smoother_csetc.f90 b/mlprec/impl/smoother/mld_z_base_smoother_csetc.f90 new file mode 100644 index 00000000..9b462b4f --- /dev/null +++ b/mlprec/impl/smoother/mld_z_base_smoother_csetc.f90 @@ -0,0 +1,78 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetc(sm,what,val,info) + + use psb_base_mod + use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_csetc + Implicit None + + ! Arguments + class(mld_z_base_smoother_type), intent(inout) :: sm + character(len=*), 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_csetc' + + call psb_erractionsave(err_act) + + info = psb_success_ + + ival = mld_stringval(val) + if (ival >= 0) then + call sm%set(what,ival,info) + else + if (allocated(sm%sv)) then + call sm%sv%set(what,val,info) + end if + end if + + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_z_base_smoother_csetc diff --git a/mlprec/impl/smoother/mld_z_base_smoother_cseti.f90 b/mlprec/impl/smoother/mld_z_base_smoother_cseti.f90 new file mode 100644 index 00000000..199bb545 --- /dev/null +++ b/mlprec/impl/smoother/mld_z_base_smoother_cseti.f90 @@ -0,0 +1,69 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_cseti(sm,what,val,info) + + use psb_base_mod + use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_cseti + Implicit None + ! Arguments + class(mld_z_base_smoother_type), intent(inout) :: sm + character(len=*), 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_cseti' + + 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 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_z_base_smoother_cseti diff --git a/mlprec/impl/smoother/mld_z_base_smoother_csetr.f90 b/mlprec/impl/smoother/mld_z_base_smoother_csetr.f90 new file mode 100644 index 00000000..effd17e2 --- /dev/null +++ b/mlprec/impl/smoother/mld_z_base_smoother_csetr.f90 @@ -0,0 +1,73 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetr(sm,what,val,info) + + use psb_base_mod + use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_csetr + Implicit None + + ! Arguments + class(mld_z_base_smoother_type), intent(inout) :: sm + character(len=*), 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_csetr' + + 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 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_z_base_smoother_csetr diff --git a/mlprec/impl/solver/Makefile b/mlprec/impl/solver/Makefile index aa3d0ff9..dae4b151 100644 --- a/mlprec/impl/solver/Makefile +++ b/mlprec/impl/solver/Makefile @@ -17,6 +17,9 @@ 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_base_solver_csetc.o \ +mld_c_base_solver_cseti.o \ +mld_c_base_solver_csetr.o \ mld_c_diag_solver_apply.o \ mld_c_diag_solver_apply_vect.o \ mld_c_diag_solver_bld.o \ @@ -36,6 +39,9 @@ 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_base_solver_csetc.o \ +mld_d_base_solver_cseti.o \ +mld_d_base_solver_csetr.o \ mld_d_diag_solver_apply.o \ mld_d_diag_solver_apply_vect.o \ mld_d_diag_solver_bld.o \ @@ -55,6 +61,9 @@ 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_base_solver_csetc.o \ +mld_s_base_solver_cseti.o \ +mld_s_base_solver_csetr.o \ mld_s_diag_solver_apply.o \ mld_s_diag_solver_apply_vect.o \ mld_s_diag_solver_bld.o \ @@ -74,6 +83,9 @@ 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_base_solver_csetc.o \ +mld_z_base_solver_cseti.o \ +mld_z_base_solver_csetr.o \ mld_z_diag_solver_apply.o \ mld_z_diag_solver_apply_vect.o \ mld_z_diag_solver_bld.o \ diff --git a/mlprec/impl/solver/mld_c_base_solver_csetc.f90 b/mlprec/impl/solver/mld_c_base_solver_csetc.f90 new file mode 100644 index 00000000..2c498d59 --- /dev/null +++ b/mlprec/impl/solver/mld_c_base_solver_csetc.f90 @@ -0,0 +1,74 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetc(sv,what,val,info) + + use psb_base_mod + use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_csetc + Implicit None + ! Arguments + class(mld_c_base_solver_type), intent(inout) :: sv + character(len=*), 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_csetc' + + call psb_erractionsave(err_act) + + info = psb_success_ + + ival = mld_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 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_c_base_solver_csetc diff --git a/mlprec/impl/solver/mld_c_base_solver_cseti.f90 b/mlprec/impl/solver/mld_c_base_solver_cseti.f90 new file mode 100644 index 00000000..60d8dadc --- /dev/null +++ b/mlprec/impl/solver/mld_c_base_solver_cseti.f90 @@ -0,0 +1,56 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_cseti(sv,what,val,info) + + use psb_base_mod + use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_cseti + Implicit None + ! Arguments + class(mld_c_base_solver_type), intent(inout) :: sv + character(len=*), 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_cseti' + + ! Correct action here is doing nothing. + info = 0 + + return +end subroutine mld_c_base_solver_cseti diff --git a/mlprec/impl/solver/mld_c_base_solver_csetr.f90 b/mlprec/impl/solver/mld_c_base_solver_csetr.f90 new file mode 100644 index 00000000..304bc2d7 --- /dev/null +++ b/mlprec/impl/solver/mld_c_base_solver_csetr.f90 @@ -0,0 +1,57 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetr(sv,what,val,info) + + use psb_base_mod + use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_csetr + 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_csetr' + + + ! Correct action here is doing nothing. + info = 0 + + return +end subroutine mld_c_base_solver_csetr diff --git a/mlprec/impl/solver/mld_d_base_solver_csetc.f90 b/mlprec/impl/solver/mld_d_base_solver_csetc.f90 new file mode 100644 index 00000000..357261ff --- /dev/null +++ b/mlprec/impl/solver/mld_d_base_solver_csetc.f90 @@ -0,0 +1,74 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetc(sv,what,val,info) + + use psb_base_mod + use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_csetc + Implicit None + ! Arguments + class(mld_d_base_solver_type), intent(inout) :: sv + character(len=*), 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_csetc' + + call psb_erractionsave(err_act) + + info = psb_success_ + + ival = mld_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 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_d_base_solver_csetc diff --git a/mlprec/impl/solver/mld_d_base_solver_cseti.f90 b/mlprec/impl/solver/mld_d_base_solver_cseti.f90 new file mode 100644 index 00000000..880a7b22 --- /dev/null +++ b/mlprec/impl/solver/mld_d_base_solver_cseti.f90 @@ -0,0 +1,56 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_cseti(sv,what,val,info) + + use psb_base_mod + use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_cseti + Implicit None + ! Arguments + class(mld_d_base_solver_type), intent(inout) :: sv + character(len=*), 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_cseti' + + ! Correct action here is doing nothing. + info = 0 + + return +end subroutine mld_d_base_solver_cseti diff --git a/mlprec/impl/solver/mld_d_base_solver_csetr.f90 b/mlprec/impl/solver/mld_d_base_solver_csetr.f90 new file mode 100644 index 00000000..2c47679f --- /dev/null +++ b/mlprec/impl/solver/mld_d_base_solver_csetr.f90 @@ -0,0 +1,57 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetr(sv,what,val,info) + + use psb_base_mod + use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_csetr + 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_csetr' + + + ! Correct action here is doing nothing. + info = 0 + + return +end subroutine mld_d_base_solver_csetr diff --git a/mlprec/impl/solver/mld_s_base_solver_csetc.f90 b/mlprec/impl/solver/mld_s_base_solver_csetc.f90 new file mode 100644 index 00000000..16498da6 --- /dev/null +++ b/mlprec/impl/solver/mld_s_base_solver_csetc.f90 @@ -0,0 +1,74 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetc(sv,what,val,info) + + use psb_base_mod + use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_csetc + Implicit None + ! Arguments + class(mld_s_base_solver_type), intent(inout) :: sv + character(len=*), 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_csetc' + + call psb_erractionsave(err_act) + + info = psb_success_ + + ival = mld_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 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_s_base_solver_csetc diff --git a/mlprec/impl/solver/mld_s_base_solver_cseti.f90 b/mlprec/impl/solver/mld_s_base_solver_cseti.f90 new file mode 100644 index 00000000..c133e00a --- /dev/null +++ b/mlprec/impl/solver/mld_s_base_solver_cseti.f90 @@ -0,0 +1,56 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_cseti(sv,what,val,info) + + use psb_base_mod + use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_cseti + Implicit None + ! Arguments + class(mld_s_base_solver_type), intent(inout) :: sv + character(len=*), 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_cseti' + + ! Correct action here is doing nothing. + info = 0 + + return +end subroutine mld_s_base_solver_cseti diff --git a/mlprec/impl/solver/mld_s_base_solver_csetr.f90 b/mlprec/impl/solver/mld_s_base_solver_csetr.f90 new file mode 100644 index 00000000..b2b4c9ff --- /dev/null +++ b/mlprec/impl/solver/mld_s_base_solver_csetr.f90 @@ -0,0 +1,57 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetr(sv,what,val,info) + + use psb_base_mod + use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_csetr + 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_csetr' + + + ! Correct action here is doing nothing. + info = 0 + + return +end subroutine mld_s_base_solver_csetr diff --git a/mlprec/impl/solver/mld_z_base_solver_csetc.f90 b/mlprec/impl/solver/mld_z_base_solver_csetc.f90 new file mode 100644 index 00000000..db6e933e --- /dev/null +++ b/mlprec/impl/solver/mld_z_base_solver_csetc.f90 @@ -0,0 +1,74 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetc(sv,what,val,info) + + use psb_base_mod + use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_csetc + Implicit None + ! Arguments + class(mld_z_base_solver_type), intent(inout) :: sv + character(len=*), 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_csetc' + + call psb_erractionsave(err_act) + + info = psb_success_ + + ival = mld_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 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine mld_z_base_solver_csetc diff --git a/mlprec/impl/solver/mld_z_base_solver_cseti.f90 b/mlprec/impl/solver/mld_z_base_solver_cseti.f90 new file mode 100644 index 00000000..918c14ca --- /dev/null +++ b/mlprec/impl/solver/mld_z_base_solver_cseti.f90 @@ -0,0 +1,56 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_cseti(sv,what,val,info) + + use psb_base_mod + use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_cseti + Implicit None + ! Arguments + class(mld_z_base_solver_type), intent(inout) :: sv + character(len=*), 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_cseti' + + ! Correct action here is doing nothing. + info = 0 + + return +end subroutine mld_z_base_solver_cseti diff --git a/mlprec/impl/solver/mld_z_base_solver_csetr.f90 b/mlprec/impl/solver/mld_z_base_solver_csetr.f90 new file mode 100644 index 00000000..b44d39b9 --- /dev/null +++ b/mlprec/impl/solver/mld_z_base_solver_csetr.f90 @@ -0,0 +1,57 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ 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_csetr(sv,what,val,info) + + use psb_base_mod + use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_csetr + 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_csetr' + + + ! Correct action here is doing nothing. + info = 0 + + return +end subroutine mld_z_base_solver_csetr diff --git a/mlprec/mld_c_as_smoother.f90 b/mlprec/mld_c_as_smoother.f90 index a5ff974c..8e1a1a92 100644 --- a/mlprec/mld_c_as_smoother.f90 +++ b/mlprec/mld_c_as_smoother.f90 @@ -64,6 +64,9 @@ module mld_c_as_smoother procedure, pass(sm) :: seti => mld_c_as_smoother_seti procedure, pass(sm) :: setc => mld_c_as_smoother_setc procedure, pass(sm) :: setr => mld_c_as_smoother_setr + procedure, pass(sm) :: cseti => mld_c_as_smoother_cseti + procedure, pass(sm) :: csetc => mld_c_as_smoother_csetc + procedure, pass(sm) :: csetr => mld_c_as_smoother_csetr procedure, pass(sm) :: descr => c_as_smoother_descr procedure, pass(sm) :: sizeof => c_as_smoother_sizeof procedure, pass(sm) :: default => c_as_smoother_default @@ -176,6 +179,42 @@ module mld_c_as_smoother 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, & + & 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 + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_c_as_smoother_cseti + end interface + + interface + subroutine mld_c_as_smoother_csetc(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 + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_c_as_smoother_csetc + end interface + + interface + subroutine mld_c_as_smoother_csetr(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 + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_c_as_smoother_csetr + end interface + interface subroutine mld_c_as_smoother_free(sm,info) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & diff --git a/mlprec/mld_c_base_smoother_mod.f90 b/mlprec/mld_c_base_smoother_mod.f90 index 094e576e..8897ef60 100644 --- a/mlprec/mld_c_base_smoother_mod.f90 +++ b/mlprec/mld_c_base_smoother_mod.f90 @@ -102,7 +102,10 @@ module mld_c_base_smoother_mod 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 - generic, public :: set => seti, setc, 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 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 @@ -199,6 +202,44 @@ module mld_c_base_smoother_mod 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, & + & 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 + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_c_base_smoother_cseti + end interface + + interface + subroutine mld_c_base_smoother_csetc(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 + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_c_base_smoother_csetc + end interface + + interface + subroutine mld_c_base_smoother_csetr(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 + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_c_base_smoother_csetr + end interface + interface subroutine mld_c_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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 7fba8a20..73e79574 100644 --- a/mlprec/mld_c_base_solver_mod.f90 +++ b/mlprec/mld_c_base_solver_mod.f90 @@ -94,7 +94,10 @@ module mld_c_base_solver_mod 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 - generic, public :: set => seti, setc, 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 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 @@ -216,6 +219,50 @@ module mld_c_base_solver_mod 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, & + & 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 + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_c_base_solver_cseti + end interface + + interface + subroutine mld_c_base_solver_csetc(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 + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_c_base_solver_csetc + end interface + + interface + subroutine mld_c_base_solver_csetr(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 + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_c_base_solver_csetr + end interface + interface subroutine mld_c_base_solver_free(sv,info) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & diff --git a/mlprec/mld_c_ilu_solver.f90 b/mlprec/mld_c_ilu_solver.f90 index 75b28d8e..e5a16c65 100644 --- a/mlprec/mld_c_ilu_solver.f90 +++ b/mlprec/mld_c_ilu_solver.f90 @@ -63,6 +63,9 @@ module mld_c_ilu_solver 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 procedure, pass(sv) :: descr => c_ilu_solver_descr procedure, pass(sv) :: default => c_ilu_solver_default procedure, pass(sv) :: sizeof => c_ilu_solver_sizeof @@ -319,6 +322,118 @@ contains return end subroutine c_ilu_solver_setr + subroutine c_ilu_solver_cseti(sv,what,val,info) + + Implicit None + + ! Arguments + class(mld_c_ilu_solver_type), intent(inout) :: sv + character(len=*), 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_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) + case('SUB_SOLVE') + sv%fact_type = val + case('SUB_FILLIN') + sv%fill_in = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 + 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_ilu_solver_cseti + + subroutine c_ilu_solver_csetc(sv,what,val,info) + + Implicit None + + ! Arguments + class(mld_c_ilu_solver_type), intent(inout) :: sv + character(len=*), 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_csetc' + + info = psb_success_ + call psb_erractionsave(err_act) + + + ival = mld_stringval(val) + if (ival >= 0) then + call sv%set(what,ival,info) + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info, name) + goto 9999 + end if + + 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_ilu_solver_csetc + + subroutine c_ilu_solver_csetr(sv,what,val,info) + + Implicit None + + ! Arguments + class(mld_c_ilu_solver_type), intent(inout) :: sv + character(len=*), 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_csetr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(what) + case('SUB_ILUTHRS') + sv%thresh = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 +!!$ goto 9999 + 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_ilu_solver_csetr + subroutine c_ilu_solver_free(sv,info) Implicit None diff --git a/mlprec/mld_c_onelev_mod.f90 b/mlprec/mld_c_onelev_mod.f90 index 7ab57344..314bf707 100644 --- a/mlprec/mld_c_onelev_mod.f90 +++ b/mlprec/mld_c_onelev_mod.f90 @@ -136,7 +136,10 @@ module mld_c_onelev_mod 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 - generic, public :: set => seti, setr, 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 + generic, public :: set => seti, setr, setc, cseti, csetr, csetc procedure, pass(lv) :: sizeof => c_base_onelev_sizeof procedure, pass(lv) :: get_nzeros => c_base_onelev_get_nzeros end type mld_c_onelev_type @@ -232,6 +235,50 @@ module mld_c_onelev_mod end subroutine mld_c_base_onelev_setr end interface + + interface + subroutine mld_c_base_onelev_cseti(lv,what,val,info) + 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 + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_c_base_onelev_cseti + end interface + + interface + subroutine mld_c_base_onelev_csetc(lv,what,val,info) + 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 + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_c_base_onelev_csetc + end interface + + interface + subroutine mld_c_base_onelev_csetr(lv,what,val,info) + 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 + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_c_base_onelev_csetr + end interface + interface subroutine mld_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,solver) 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 103f782a..f5d65884 100644 --- a/mlprec/mld_c_prec_mod.f90 +++ b/mlprec/mld_c_prec_mod.f90 @@ -60,7 +60,8 @@ 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_iprecseti, mld_c_iprecsetc, mld_c_iprecsetr, & + & mld_c_cprecseti, mld_c_cprecsetc, mld_c_cprecsetr end interface !!$ interface mld_inner_precset @@ -118,12 +119,39 @@ contains end subroutine mld_c_iprecsetr subroutine mld_c_iprecsetc(p,what,val,info) - type(mld_cprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val + type(mld_cprec_type), intent(inout) :: p + integer(psb_ipk_), intent(in) :: what + character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info call p%set(what,val,info) end subroutine mld_c_iprecsetc + subroutine mld_c_cprecseti(p,what,val,info) + type(mld_cprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + + call p%set(what,val,info) + end subroutine mld_c_cprecseti + + subroutine mld_c_cprecsetr(p,what,val,info) + type(mld_cprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + + call p%set(what,val,info) + end subroutine mld_c_cprecsetr + + subroutine mld_c_cprecsetc(p,what,val,info) + type(mld_cprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + + call p%set(what,val,info) + end subroutine mld_c_cprecsetc + end module mld_c_prec_mod diff --git a/mlprec/mld_c_prec_type.f90 b/mlprec/mld_c_prec_type.f90 index f9901d09..c38d99f4 100644 --- a/mlprec/mld_c_prec_type.f90 +++ b/mlprec/mld_c_prec_type.f90 @@ -99,7 +99,11 @@ module mld_c_prec_type procedure, pass(prec) :: seti => mld_cprecseti procedure, pass(prec) :: setc => mld_cprecsetc procedure, pass(prec) :: setr => mld_cprecsetr - generic, public :: set => seti, setc, setr, setsm, setsv + 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 end type mld_cprec_type private :: mld_c_dump, mld_c_get_compl, mld_c_cmp_compl,& @@ -210,6 +214,33 @@ module mld_c_prec_type integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev end subroutine mld_cprecsetc + subroutine mld_ccprecseti(prec,what,val,info,ilev) + import :: psb_cspmat_type, psb_desc_type, psb_spk_, & + & mld_cprec_type, psb_ipk_ + class(mld_cprec_type), intent(inout) :: prec + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + end subroutine mld_ccprecseti + subroutine mld_ccprecsetr(prec,what,val,info,ilev) + import :: psb_cspmat_type, psb_desc_type, psb_spk_, & + & mld_cprec_type, psb_ipk_ + class(mld_cprec_type), intent(inout) :: prec + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + end subroutine mld_ccprecsetr + subroutine mld_ccprecsetc(prec,what,string,info,ilev) + import :: psb_cspmat_type, psb_desc_type, psb_spk_, & + & mld_cprec_type, psb_ipk_ + class(mld_cprec_type), intent(inout) :: prec + character(len=*), intent(in) :: what + character(len=*), intent(in) :: string + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + end subroutine mld_ccprecsetc end interface diff --git a/mlprec/mld_d_as_smoother.f90 b/mlprec/mld_d_as_smoother.f90 index 50ed56b2..072b50a6 100644 --- a/mlprec/mld_d_as_smoother.f90 +++ b/mlprec/mld_d_as_smoother.f90 @@ -64,6 +64,9 @@ module mld_d_as_smoother procedure, pass(sm) :: seti => mld_d_as_smoother_seti procedure, pass(sm) :: setc => mld_d_as_smoother_setc procedure, pass(sm) :: setr => mld_d_as_smoother_setr + procedure, pass(sm) :: cseti => mld_d_as_smoother_cseti + procedure, pass(sm) :: csetc => mld_d_as_smoother_csetc + procedure, pass(sm) :: csetr => mld_d_as_smoother_csetr procedure, pass(sm) :: descr => d_as_smoother_descr procedure, pass(sm) :: sizeof => d_as_smoother_sizeof procedure, pass(sm) :: default => d_as_smoother_default @@ -176,6 +179,42 @@ module mld_d_as_smoother 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, & + & 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 + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_d_as_smoother_cseti + end interface + + interface + subroutine mld_d_as_smoother_csetc(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 + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_d_as_smoother_csetc + end interface + + interface + subroutine mld_d_as_smoother_csetr(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 + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_d_as_smoother_csetr + end interface + interface subroutine mld_d_as_smoother_free(sm,info) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & diff --git a/mlprec/mld_d_base_smoother_mod.f90 b/mlprec/mld_d_base_smoother_mod.f90 index 94b410b2..8ea7c8d0 100644 --- a/mlprec/mld_d_base_smoother_mod.f90 +++ b/mlprec/mld_d_base_smoother_mod.f90 @@ -102,7 +102,10 @@ module mld_d_base_smoother_mod 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 - generic, public :: set => seti, setc, 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 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 @@ -199,6 +202,44 @@ module mld_d_base_smoother_mod 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, & + & 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 + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_d_base_smoother_cseti + end interface + + interface + subroutine mld_d_base_smoother_csetc(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 + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_d_base_smoother_csetc + end interface + + interface + subroutine mld_d_base_smoother_csetr(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 + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_d_base_smoother_csetr + end interface + interface subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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 3a946c0d..a584a1b2 100644 --- a/mlprec/mld_d_base_solver_mod.f90 +++ b/mlprec/mld_d_base_solver_mod.f90 @@ -94,7 +94,10 @@ module mld_d_base_solver_mod 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 - generic, public :: set => seti, setc, 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 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 @@ -216,6 +219,50 @@ module mld_d_base_solver_mod 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, & + & 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 + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_d_base_solver_cseti + end interface + + interface + subroutine mld_d_base_solver_csetc(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 + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_d_base_solver_csetc + end interface + + interface + subroutine mld_d_base_solver_csetr(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 + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_d_base_solver_csetr + end interface + interface subroutine mld_d_base_solver_free(sv,info) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & diff --git a/mlprec/mld_d_ilu_solver.f90 b/mlprec/mld_d_ilu_solver.f90 index 3e1dffdf..5f38649f 100644 --- a/mlprec/mld_d_ilu_solver.f90 +++ b/mlprec/mld_d_ilu_solver.f90 @@ -63,6 +63,9 @@ module mld_d_ilu_solver 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 procedure, pass(sv) :: descr => d_ilu_solver_descr procedure, pass(sv) :: default => d_ilu_solver_default procedure, pass(sv) :: sizeof => d_ilu_solver_sizeof @@ -319,6 +322,118 @@ contains return end subroutine d_ilu_solver_setr + subroutine d_ilu_solver_cseti(sv,what,val,info) + + Implicit None + + ! Arguments + class(mld_d_ilu_solver_type), intent(inout) :: sv + character(len=*), 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_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) + case('SUB_SOLVE') + sv%fact_type = val + case('SUB_FILLIN') + sv%fill_in = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 + 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_ilu_solver_cseti + + subroutine d_ilu_solver_csetc(sv,what,val,info) + + Implicit None + + ! Arguments + class(mld_d_ilu_solver_type), intent(inout) :: sv + character(len=*), 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_csetc' + + info = psb_success_ + call psb_erractionsave(err_act) + + + ival = mld_stringval(val) + if (ival >= 0) then + call sv%set(what,ival,info) + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info, name) + goto 9999 + end if + + 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_ilu_solver_csetc + + subroutine d_ilu_solver_csetr(sv,what,val,info) + + Implicit None + + ! Arguments + class(mld_d_ilu_solver_type), intent(inout) :: sv + character(len=*), 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_csetr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(what) + case('SUB_ILUTHRS') + sv%thresh = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 +!!$ goto 9999 + 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_ilu_solver_csetr + subroutine d_ilu_solver_free(sv,info) Implicit None diff --git a/mlprec/mld_d_onelev_mod.f90 b/mlprec/mld_d_onelev_mod.f90 index a5b020e5..9ec6e264 100644 --- a/mlprec/mld_d_onelev_mod.f90 +++ b/mlprec/mld_d_onelev_mod.f90 @@ -136,7 +136,10 @@ module mld_d_onelev_mod 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 - generic, public :: set => seti, setr, 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 + generic, public :: set => seti, setr, setc, cseti, csetr, csetc procedure, pass(lv) :: sizeof => d_base_onelev_sizeof procedure, pass(lv) :: get_nzeros => d_base_onelev_get_nzeros end type mld_d_onelev_type @@ -232,6 +235,50 @@ module mld_d_onelev_mod end subroutine mld_d_base_onelev_setr end interface + + interface + subroutine mld_d_base_onelev_cseti(lv,what,val,info) + 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 + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_d_base_onelev_cseti + end interface + + interface + subroutine mld_d_base_onelev_csetc(lv,what,val,info) + 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 + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_d_base_onelev_csetc + end interface + + interface + subroutine mld_d_base_onelev_csetr(lv,what,val,info) + 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 + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_d_base_onelev_csetr + end interface + interface subroutine mld_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,solver) 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 46141003..e2c9afed 100644 --- a/mlprec/mld_d_prec_mod.f90 +++ b/mlprec/mld_d_prec_mod.f90 @@ -60,7 +60,8 @@ 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_iprecseti, mld_d_iprecsetc, mld_d_iprecsetr, & + & mld_d_cprecseti, mld_d_cprecsetc, mld_d_cprecsetr end interface !!$ interface mld_inner_precset @@ -118,12 +119,39 @@ contains end subroutine mld_d_iprecsetr subroutine mld_d_iprecsetc(p,what,val,info) - type(mld_dprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val + type(mld_dprec_type), intent(inout) :: p + integer(psb_ipk_), intent(in) :: what + character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info call p%set(what,val,info) end subroutine mld_d_iprecsetc + subroutine mld_d_cprecseti(p,what,val,info) + type(mld_dprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + + call p%set(what,val,info) + end subroutine mld_d_cprecseti + + subroutine mld_d_cprecsetr(p,what,val,info) + type(mld_dprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + + call p%set(what,val,info) + end subroutine mld_d_cprecsetr + + subroutine mld_d_cprecsetc(p,what,val,info) + type(mld_dprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + + call p%set(what,val,info) + end subroutine mld_d_cprecsetc + end module mld_d_prec_mod diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index e3f10ea4..0588721b 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -99,7 +99,11 @@ module mld_d_prec_type procedure, pass(prec) :: seti => mld_dprecseti procedure, pass(prec) :: setc => mld_dprecsetc procedure, pass(prec) :: setr => mld_dprecsetr - generic, public :: set => seti, setc, setr, setsm, setsv + 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 end type mld_dprec_type private :: mld_d_dump, mld_d_get_compl, mld_d_cmp_compl,& @@ -210,6 +214,33 @@ module mld_d_prec_type integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev end subroutine mld_dprecsetc + subroutine mld_dcprecseti(prec,what,val,info,ilev) + import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & + & mld_dprec_type, psb_ipk_ + class(mld_dprec_type), intent(inout) :: prec + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + end subroutine mld_dcprecseti + subroutine mld_dcprecsetr(prec,what,val,info,ilev) + import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & + & mld_dprec_type, psb_ipk_ + class(mld_dprec_type), intent(inout) :: prec + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + end subroutine mld_dcprecsetr + subroutine mld_dcprecsetc(prec,what,string,info,ilev) + import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & + & mld_dprec_type, psb_ipk_ + class(mld_dprec_type), intent(inout) :: prec + character(len=*), intent(in) :: what + character(len=*), intent(in) :: string + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + end subroutine mld_dcprecsetc end interface diff --git a/mlprec/mld_s_as_smoother.f90 b/mlprec/mld_s_as_smoother.f90 index cf1064e5..8520d5bd 100644 --- a/mlprec/mld_s_as_smoother.f90 +++ b/mlprec/mld_s_as_smoother.f90 @@ -64,6 +64,9 @@ module mld_s_as_smoother procedure, pass(sm) :: seti => mld_s_as_smoother_seti procedure, pass(sm) :: setc => mld_s_as_smoother_setc procedure, pass(sm) :: setr => mld_s_as_smoother_setr + procedure, pass(sm) :: cseti => mld_s_as_smoother_cseti + procedure, pass(sm) :: csetc => mld_s_as_smoother_csetc + procedure, pass(sm) :: csetr => mld_s_as_smoother_csetr procedure, pass(sm) :: descr => s_as_smoother_descr procedure, pass(sm) :: sizeof => s_as_smoother_sizeof procedure, pass(sm) :: default => s_as_smoother_default @@ -176,6 +179,42 @@ module mld_s_as_smoother 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, & + & 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 + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_s_as_smoother_cseti + end interface + + interface + subroutine mld_s_as_smoother_csetc(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 + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_s_as_smoother_csetc + end interface + + interface + subroutine mld_s_as_smoother_csetr(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 + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_s_as_smoother_csetr + end interface + interface subroutine mld_s_as_smoother_free(sm,info) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & diff --git a/mlprec/mld_s_base_smoother_mod.f90 b/mlprec/mld_s_base_smoother_mod.f90 index 87268898..d256636a 100644 --- a/mlprec/mld_s_base_smoother_mod.f90 +++ b/mlprec/mld_s_base_smoother_mod.f90 @@ -102,7 +102,10 @@ module mld_s_base_smoother_mod 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 - generic, public :: set => seti, setc, 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 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 @@ -199,6 +202,44 @@ module mld_s_base_smoother_mod 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, & + & 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 + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_s_base_smoother_cseti + end interface + + interface + subroutine mld_s_base_smoother_csetc(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 + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_s_base_smoother_csetc + end interface + + interface + subroutine mld_s_base_smoother_csetr(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 + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_s_base_smoother_csetr + end interface + interface subroutine mld_s_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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 3b606fe3..f1595abc 100644 --- a/mlprec/mld_s_base_solver_mod.f90 +++ b/mlprec/mld_s_base_solver_mod.f90 @@ -94,7 +94,10 @@ module mld_s_base_solver_mod 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 - generic, public :: set => seti, setc, 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 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 @@ -216,6 +219,50 @@ module mld_s_base_solver_mod 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, & + & 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 + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_s_base_solver_cseti + end interface + + interface + subroutine mld_s_base_solver_csetc(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 + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_s_base_solver_csetc + end interface + + interface + subroutine mld_s_base_solver_csetr(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 + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_s_base_solver_csetr + end interface + interface subroutine mld_s_base_solver_free(sv,info) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & diff --git a/mlprec/mld_s_ilu_solver.f90 b/mlprec/mld_s_ilu_solver.f90 index b34d6efc..01d253d8 100644 --- a/mlprec/mld_s_ilu_solver.f90 +++ b/mlprec/mld_s_ilu_solver.f90 @@ -63,6 +63,9 @@ module mld_s_ilu_solver 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 procedure, pass(sv) :: descr => s_ilu_solver_descr procedure, pass(sv) :: default => s_ilu_solver_default procedure, pass(sv) :: sizeof => s_ilu_solver_sizeof @@ -319,6 +322,118 @@ contains return end subroutine s_ilu_solver_setr + subroutine s_ilu_solver_cseti(sv,what,val,info) + + Implicit None + + ! Arguments + class(mld_s_ilu_solver_type), intent(inout) :: sv + character(len=*), 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_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) + case('SUB_SOLVE') + sv%fact_type = val + case('SUB_FILLIN') + sv%fill_in = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 + 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_ilu_solver_cseti + + subroutine s_ilu_solver_csetc(sv,what,val,info) + + Implicit None + + ! Arguments + class(mld_s_ilu_solver_type), intent(inout) :: sv + character(len=*), 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_csetc' + + info = psb_success_ + call psb_erractionsave(err_act) + + + ival = mld_stringval(val) + if (ival >= 0) then + call sv%set(what,ival,info) + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info, name) + goto 9999 + end if + + 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_ilu_solver_csetc + + subroutine s_ilu_solver_csetr(sv,what,val,info) + + Implicit None + + ! Arguments + class(mld_s_ilu_solver_type), intent(inout) :: sv + character(len=*), 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_csetr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(what) + case('SUB_ILUTHRS') + sv%thresh = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 +!!$ goto 9999 + 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_ilu_solver_csetr + subroutine s_ilu_solver_free(sv,info) Implicit None diff --git a/mlprec/mld_s_onelev_mod.f90 b/mlprec/mld_s_onelev_mod.f90 index 2c46dd96..c35a7d22 100644 --- a/mlprec/mld_s_onelev_mod.f90 +++ b/mlprec/mld_s_onelev_mod.f90 @@ -136,7 +136,10 @@ module mld_s_onelev_mod 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 - generic, public :: set => seti, setr, 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 + generic, public :: set => seti, setr, setc, cseti, csetr, csetc procedure, pass(lv) :: sizeof => s_base_onelev_sizeof procedure, pass(lv) :: get_nzeros => s_base_onelev_get_nzeros end type mld_s_onelev_type @@ -232,6 +235,50 @@ module mld_s_onelev_mod end subroutine mld_s_base_onelev_setr end interface + + interface + subroutine mld_s_base_onelev_cseti(lv,what,val,info) + 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 + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_s_base_onelev_cseti + end interface + + interface + subroutine mld_s_base_onelev_csetc(lv,what,val,info) + 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 + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_s_base_onelev_csetc + end interface + + interface + subroutine mld_s_base_onelev_csetr(lv,what,val,info) + 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 + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_s_base_onelev_csetr + end interface + interface subroutine mld_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,solver) 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 aa69495a..94974ba1 100644 --- a/mlprec/mld_s_prec_mod.f90 +++ b/mlprec/mld_s_prec_mod.f90 @@ -60,7 +60,8 @@ 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_iprecseti, mld_s_iprecsetc, mld_s_iprecsetr, & + & mld_s_cprecseti, mld_s_cprecsetc, mld_s_cprecsetr end interface !!$ interface mld_inner_precset @@ -118,12 +119,39 @@ contains end subroutine mld_s_iprecsetr subroutine mld_s_iprecsetc(p,what,val,info) - type(mld_sprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val + type(mld_sprec_type), intent(inout) :: p + integer(psb_ipk_), intent(in) :: what + character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info call p%set(what,val,info) end subroutine mld_s_iprecsetc + subroutine mld_s_cprecseti(p,what,val,info) + type(mld_sprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + + call p%set(what,val,info) + end subroutine mld_s_cprecseti + + subroutine mld_s_cprecsetr(p,what,val,info) + type(mld_sprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + + call p%set(what,val,info) + end subroutine mld_s_cprecsetr + + subroutine mld_s_cprecsetc(p,what,val,info) + type(mld_sprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + + call p%set(what,val,info) + end subroutine mld_s_cprecsetc + end module mld_s_prec_mod diff --git a/mlprec/mld_s_prec_type.f90 b/mlprec/mld_s_prec_type.f90 index 20babaaa..156535cc 100644 --- a/mlprec/mld_s_prec_type.f90 +++ b/mlprec/mld_s_prec_type.f90 @@ -99,7 +99,11 @@ module mld_s_prec_type procedure, pass(prec) :: seti => mld_sprecseti procedure, pass(prec) :: setc => mld_sprecsetc procedure, pass(prec) :: setr => mld_sprecsetr - generic, public :: set => seti, setc, setr, setsm, setsv + 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 end type mld_sprec_type private :: mld_s_dump, mld_s_get_compl, mld_s_cmp_compl,& @@ -210,6 +214,33 @@ module mld_s_prec_type integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev end subroutine mld_sprecsetc + subroutine mld_scprecseti(prec,what,val,info,ilev) + import :: psb_sspmat_type, psb_desc_type, psb_spk_, & + & mld_sprec_type, psb_ipk_ + class(mld_sprec_type), intent(inout) :: prec + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + end subroutine mld_scprecseti + subroutine mld_scprecsetr(prec,what,val,info,ilev) + import :: psb_sspmat_type, psb_desc_type, psb_spk_, & + & mld_sprec_type, psb_ipk_ + class(mld_sprec_type), intent(inout) :: prec + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + end subroutine mld_scprecsetr + subroutine mld_scprecsetc(prec,what,string,info,ilev) + import :: psb_sspmat_type, psb_desc_type, psb_spk_, & + & mld_sprec_type, psb_ipk_ + class(mld_sprec_type), intent(inout) :: prec + character(len=*), intent(in) :: what + character(len=*), intent(in) :: string + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + end subroutine mld_scprecsetc end interface diff --git a/mlprec/mld_z_as_smoother.f90 b/mlprec/mld_z_as_smoother.f90 index 2e638ce3..d346bf57 100644 --- a/mlprec/mld_z_as_smoother.f90 +++ b/mlprec/mld_z_as_smoother.f90 @@ -64,6 +64,9 @@ module mld_z_as_smoother procedure, pass(sm) :: seti => mld_z_as_smoother_seti procedure, pass(sm) :: setc => mld_z_as_smoother_setc procedure, pass(sm) :: setr => mld_z_as_smoother_setr + procedure, pass(sm) :: cseti => mld_z_as_smoother_cseti + procedure, pass(sm) :: csetc => mld_z_as_smoother_csetc + procedure, pass(sm) :: csetr => mld_z_as_smoother_csetr procedure, pass(sm) :: descr => z_as_smoother_descr procedure, pass(sm) :: sizeof => z_as_smoother_sizeof procedure, pass(sm) :: default => z_as_smoother_default @@ -176,6 +179,42 @@ module mld_z_as_smoother 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, & + & 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 + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_z_as_smoother_cseti + end interface + + interface + subroutine mld_z_as_smoother_csetc(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 + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_z_as_smoother_csetc + end interface + + interface + subroutine mld_z_as_smoother_csetr(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 + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_z_as_smoother_csetr + end interface + interface subroutine mld_z_as_smoother_free(sm,info) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & diff --git a/mlprec/mld_z_base_smoother_mod.f90 b/mlprec/mld_z_base_smoother_mod.f90 index 7730f8a3..62a7e9f1 100644 --- a/mlprec/mld_z_base_smoother_mod.f90 +++ b/mlprec/mld_z_base_smoother_mod.f90 @@ -102,7 +102,10 @@ module mld_z_base_smoother_mod 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 - generic, public :: set => seti, setc, 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 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 @@ -199,6 +202,44 @@ module mld_z_base_smoother_mod 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, & + & 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 + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_z_base_smoother_cseti + end interface + + interface + subroutine mld_z_base_smoother_csetc(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 + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_z_base_smoother_csetc + end interface + + interface + subroutine mld_z_base_smoother_csetr(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 + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_z_base_smoother_csetr + end interface + interface subroutine mld_z_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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 27c7e4ce..3ea3c0c0 100644 --- a/mlprec/mld_z_base_solver_mod.f90 +++ b/mlprec/mld_z_base_solver_mod.f90 @@ -94,7 +94,10 @@ module mld_z_base_solver_mod 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 - generic, public :: set => seti, setc, 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 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 @@ -216,6 +219,50 @@ module mld_z_base_solver_mod 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, & + & 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 + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_z_base_solver_cseti + end interface + + interface + subroutine mld_z_base_solver_csetc(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 + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_z_base_solver_csetc + end interface + + interface + subroutine mld_z_base_solver_csetr(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 + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_z_base_solver_csetr + end interface + interface subroutine mld_z_base_solver_free(sv,info) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & diff --git a/mlprec/mld_z_ilu_solver.f90 b/mlprec/mld_z_ilu_solver.f90 index 2808bbce..39079a68 100644 --- a/mlprec/mld_z_ilu_solver.f90 +++ b/mlprec/mld_z_ilu_solver.f90 @@ -63,6 +63,9 @@ module mld_z_ilu_solver 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 procedure, pass(sv) :: descr => z_ilu_solver_descr procedure, pass(sv) :: default => z_ilu_solver_default procedure, pass(sv) :: sizeof => z_ilu_solver_sizeof @@ -319,6 +322,118 @@ contains return end subroutine z_ilu_solver_setr + subroutine z_ilu_solver_cseti(sv,what,val,info) + + Implicit None + + ! Arguments + class(mld_z_ilu_solver_type), intent(inout) :: sv + character(len=*), 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_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) + case('SUB_SOLVE') + sv%fact_type = val + case('SUB_FILLIN') + sv%fill_in = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 + 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_ilu_solver_cseti + + subroutine z_ilu_solver_csetc(sv,what,val,info) + + Implicit None + + ! Arguments + class(mld_z_ilu_solver_type), intent(inout) :: sv + character(len=*), 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_csetc' + + info = psb_success_ + call psb_erractionsave(err_act) + + + ival = mld_stringval(val) + if (ival >= 0) then + call sv%set(what,ival,info) + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info, name) + goto 9999 + end if + + 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_ilu_solver_csetc + + subroutine z_ilu_solver_csetr(sv,what,val,info) + + Implicit None + + ! Arguments + class(mld_z_ilu_solver_type), intent(inout) :: sv + character(len=*), 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_csetr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(what) + case('SUB_ILUTHRS') + sv%thresh = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 +!!$ goto 9999 + 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_ilu_solver_csetr + subroutine z_ilu_solver_free(sv,info) Implicit None diff --git a/mlprec/mld_z_onelev_mod.f90 b/mlprec/mld_z_onelev_mod.f90 index 4dc1f1f8..a44491a9 100644 --- a/mlprec/mld_z_onelev_mod.f90 +++ b/mlprec/mld_z_onelev_mod.f90 @@ -136,7 +136,10 @@ module mld_z_onelev_mod 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 - generic, public :: set => seti, setr, 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 + generic, public :: set => seti, setr, setc, cseti, csetr, csetc procedure, pass(lv) :: sizeof => z_base_onelev_sizeof procedure, pass(lv) :: get_nzeros => z_base_onelev_get_nzeros end type mld_z_onelev_type @@ -232,6 +235,50 @@ module mld_z_onelev_mod end subroutine mld_z_base_onelev_setr end interface + + interface + subroutine mld_z_base_onelev_cseti(lv,what,val,info) + 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 + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_z_base_onelev_cseti + end interface + + interface + subroutine mld_z_base_onelev_csetc(lv,what,val,info) + 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 + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_z_base_onelev_csetc + end interface + + interface + subroutine mld_z_base_onelev_csetr(lv,what,val,info) + 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 + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine mld_z_base_onelev_csetr + end interface + interface subroutine mld_z_base_onelev_dump(lv,level,info,prefix,head,ac,rp,smoother,solver) 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 eb39f2f5..8b863b8a 100644 --- a/mlprec/mld_z_prec_mod.f90 +++ b/mlprec/mld_z_prec_mod.f90 @@ -60,7 +60,8 @@ 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_iprecseti, mld_z_iprecsetc, mld_z_iprecsetr, & + & mld_z_cprecseti, mld_z_cprecsetc, mld_z_cprecsetr end interface !!$ interface mld_inner_precset @@ -118,12 +119,39 @@ contains end subroutine mld_z_iprecsetr subroutine mld_z_iprecsetc(p,what,val,info) - type(mld_zprec_type), intent(inout) :: p - integer(psb_ipk_), intent(in) :: what - character(len=*), intent(in) :: val + type(mld_zprec_type), intent(inout) :: p + integer(psb_ipk_), intent(in) :: what + character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info call p%set(what,val,info) end subroutine mld_z_iprecsetc + subroutine mld_z_cprecseti(p,what,val,info) + type(mld_zprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + + call p%set(what,val,info) + end subroutine mld_z_cprecseti + + subroutine mld_z_cprecsetr(p,what,val,info) + type(mld_zprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + + call p%set(what,val,info) + end subroutine mld_z_cprecsetr + + subroutine mld_z_cprecsetc(p,what,val,info) + type(mld_zprec_type), intent(inout) :: p + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + + call p%set(what,val,info) + end subroutine mld_z_cprecsetc + end module mld_z_prec_mod diff --git a/mlprec/mld_z_prec_type.f90 b/mlprec/mld_z_prec_type.f90 index 14d4c1a0..f7d773b6 100644 --- a/mlprec/mld_z_prec_type.f90 +++ b/mlprec/mld_z_prec_type.f90 @@ -99,7 +99,11 @@ module mld_z_prec_type procedure, pass(prec) :: seti => mld_zprecseti procedure, pass(prec) :: setc => mld_zprecsetc procedure, pass(prec) :: setr => mld_zprecsetr - generic, public :: set => seti, setc, setr, setsm, setsv + 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 end type mld_zprec_type private :: mld_z_dump, mld_z_get_compl, mld_z_cmp_compl,& @@ -210,6 +214,33 @@ module mld_z_prec_type integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev end subroutine mld_zprecsetc + subroutine mld_zcprecseti(prec,what,val,info,ilev) + import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & + & mld_zprec_type, psb_ipk_ + class(mld_zprec_type), intent(inout) :: prec + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + end subroutine mld_zcprecseti + subroutine mld_zcprecsetr(prec,what,val,info,ilev) + import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & + & mld_zprec_type, psb_ipk_ + class(mld_zprec_type), intent(inout) :: prec + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + end subroutine mld_zcprecsetr + subroutine mld_zcprecsetc(prec,what,string,info,ilev) + import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & + & mld_zprec_type, psb_ipk_ + class(mld_zprec_type), intent(inout) :: prec + character(len=*), intent(in) :: what + character(len=*), intent(in) :: string + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: ilev + end subroutine mld_zcprecsetc end interface diff --git a/tests/newslv/runs/ppde.inp b/tests/newslv/runs/ppde.inp index 253279f8..66b45b44 100644 --- a/tests/newslv/runs/ppde.inp +++ b/tests/newslv/runs/ppde.inp @@ -28,4 +28,4 @@ ILU ! Coarse level: subsolver DSCALE ILU UMF SLU SLUDI 1.d-4 ! Coarse level: Threshold T for ILU(T,P) 4 ! Coarse level: Number of Jacobi sweeps -0.10d0 ! Smoother Aggregation Threshold: >= 0.0 default if <0 -100 ! Coarse size limit to determine levels. If <0, then use NL +200 ! Coarse size limit to determine levels. If <0, then use NL diff --git a/tests/pdegen/ppde3d.f90 b/tests/pdegen/ppde3d.f90 index c934bd4e..1fb5f0e6 100644 --- a/tests/pdegen/ppde3d.f90 +++ b/tests/pdegen/ppde3d.f90 @@ -242,37 +242,37 @@ program ppde3d if (psb_toupper(prectype%prec) == 'ML') then nlv = prectype%nlev call mld_precinit(prec,prectype%prec, info, nlev=nlv) - call mld_precset(prec,mld_smoother_type_, prectype%smther, info) - call mld_precset(prec,mld_smoother_sweeps_, prectype%jsweeps, info) - call mld_precset(prec,mld_sub_ovr_, prectype%novr, info) - call mld_precset(prec,mld_sub_restr_, prectype%restr, info) - call mld_precset(prec,mld_sub_prol_, prectype%prol, info) - call mld_precset(prec,mld_sub_solve_, prectype%solve, info) - call mld_precset(prec,mld_sub_fillin_, prectype%fill1, info) - call mld_precset(prec,mld_sub_iluthrs_, prectype%thr1, info) - call mld_precset(prec,mld_aggr_kind_, prectype%aggrkind,info) - call mld_precset(prec,mld_aggr_alg_, prectype%aggr_alg,info) - call mld_precset(prec,mld_ml_type_, prectype%mltype, info) - call mld_precset(prec,mld_smoother_pos_, prectype%smthpos, info) + call mld_precset(prec,'smoother_type', prectype%smther, info) + call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info) + call mld_precset(prec,'sub_ovr', prectype%novr, info) + call mld_precset(prec,'sub_restr', prectype%restr, info) + call mld_precset(prec,'sub_prol', prectype%prol, info) + call mld_precset(prec,'sub_solve', prectype%solve, info) + call mld_precset(prec,'sub_fillin', prectype%fill1, info) + call mld_precset(prec,'sub_iluthrs', prectype%thr1, info) + call mld_precset(prec,'aggr_kind', prectype%aggrkind,info) + call mld_precset(prec,'aggr_alg', prectype%aggr_alg,info) + call mld_precset(prec,'ml_type', prectype%mltype, info) + call mld_precset(prec,'smoother_pos', prectype%smthpos, info) if (prectype%athres >= dzero) & - & call mld_precset(prec,mld_aggr_thresh_, prectype%athres, info) - call mld_precset(prec,mld_coarse_solve_, prectype%csolve, info) - call mld_precset(prec,mld_coarse_subsolve_, prectype%csbsolve,info) - call mld_precset(prec,mld_coarse_mat_, prectype%cmat, info) - call mld_precset(prec,mld_coarse_fillin_, prectype%cfill, info) - call mld_precset(prec,mld_coarse_iluthrs_, prectype%cthres, info) - call mld_precset(prec,mld_coarse_sweeps_, prectype%cjswp, info) - call mld_precset(prec,mld_coarse_aggr_size_, prectype%csize, info) + & call mld_precset(prec,'aggr_thresh', prectype%athres, info) + call mld_precset(prec,'coarse_solve', prectype%csolve, info) + call mld_precset(prec,'coarse_subsolve', prectype%csbsolve,info) + call mld_precset(prec,'coarse_mat', prectype%cmat, info) + call mld_precset(prec,'coarse_fillin', prectype%cfill, info) + call mld_precset(prec,'coarse_iluthrs', prectype%cthres, info) + call mld_precset(prec,'coarse_sweeps', prectype%cjswp, info) + call mld_precset(prec,'coarse_aggr_size', prectype%csize, info) else nlv = 1 call mld_precinit(prec,prectype%prec, info, nlev=nlv) - call mld_precset(prec,mld_smoother_sweeps_, prectype%jsweeps, info) - call mld_precset(prec,mld_sub_ovr_, prectype%novr, info) - call mld_precset(prec,mld_sub_restr_, prectype%restr, info) - call mld_precset(prec,mld_sub_prol_, prectype%prol, info) - call mld_precset(prec,mld_sub_solve_, prectype%solve, info) - call mld_precset(prec,mld_sub_fillin_, prectype%fill1, info) - call mld_precset(prec,mld_sub_iluthrs_, prectype%thr1, info) + call mld_precset(prec,'smoother_sweeps', prectype%jsweeps, info) + call mld_precset(prec,'sub_ovr', prectype%novr, info) + call mld_precset(prec,'sub_restr', prectype%restr, info) + call mld_precset(prec,'sub_prol', prectype%prol, info) + call mld_precset(prec,'sub_solve', prectype%solve, info) + call mld_precset(prec,'sub_fillin', prectype%fill1, info) + call mld_precset(prec,'sub_iluthrs', prectype%thr1, info) end if call psb_barrier(ictxt) t1 = psb_wtime()