From b784aae5cc70a95c6146bb1549ce1bfd73ad099b Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 2 Sep 2013 16:33:45 +0000 Subject: [PATCH] mld2p4-299 mlprec/impl/level/Makefile mlprec/impl/level/mld_c_base_onelev_cnv.f90 mlprec/impl/level/mld_d_base_onelev_cnv.f90 mlprec/impl/level/mld_s_base_onelev_cnv.f90 mlprec/impl/level/mld_z_base_onelev_cnv.f90 mlprec/impl/mld_cmlprec_bld.f90 mlprec/impl/mld_cprecbld.f90 mlprec/impl/mld_dmlprec_bld.f90 mlprec/impl/mld_smlprec_bld.f90 mlprec/impl/mld_sprecbld.f90 mlprec/impl/mld_zmlprec_bld.f90 mlprec/impl/mld_zprecbld.f90 mlprec/impl/smoother/Makefile mlprec/impl/smoother/mld_c_as_smoother_bld.f90 mlprec/impl/smoother/mld_c_as_smoother_cnv.f90 mlprec/impl/smoother/mld_c_base_smoother_bld.f90 mlprec/impl/smoother/mld_c_base_smoother_cnv.f90 mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 mlprec/impl/smoother/mld_c_jac_smoother_cnv.f90 mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 mlprec/impl/smoother/mld_s_as_smoother_bld.f90 mlprec/impl/smoother/mld_s_as_smoother_cnv.f90 mlprec/impl/smoother/mld_s_base_smoother_bld.f90 mlprec/impl/smoother/mld_s_base_smoother_cnv.f90 mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 mlprec/impl/smoother/mld_s_jac_smoother_cnv.f90 mlprec/impl/smoother/mld_z_as_smoother_bld.f90 mlprec/impl/smoother/mld_z_as_smoother_cnv.f90 mlprec/impl/smoother/mld_z_base_smoother_bld.f90 mlprec/impl/smoother/mld_z_base_smoother_cnv.f90 mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 mlprec/impl/smoother/mld_z_jac_smoother_cnv.f90 mlprec/impl/solver/Makefile mlprec/impl/solver/mld_c_base_solver_bld.f90 mlprec/impl/solver/mld_c_base_solver_cnv.f90 mlprec/impl/solver/mld_c_diag_solver_bld.f90 mlprec/impl/solver/mld_c_diag_solver_cnv.f90 mlprec/impl/solver/mld_c_ilu_solver_bld.f90 mlprec/impl/solver/mld_c_ilu_solver_cnv.f90 mlprec/impl/solver/mld_d_base_solver_bld.f90 mlprec/impl/solver/mld_d_diag_solver_bld.f90 mlprec/impl/solver/mld_d_diag_solver_cnv.f90 mlprec/impl/solver/mld_d_ilu_solver_bld.f90 mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 mlprec/impl/solver/mld_s_base_solver_bld.f90 mlprec/impl/solver/mld_s_base_solver_cnv.f90 mlprec/impl/solver/mld_s_diag_solver_bld.f90 mlprec/impl/solver/mld_s_diag_solver_cnv.f90 mlprec/impl/solver/mld_s_ilu_solver_bld.f90 mlprec/impl/solver/mld_s_ilu_solver_cnv.f90 mlprec/impl/solver/mld_z_base_solver_bld.f90 mlprec/impl/solver/mld_z_base_solver_cnv.f90 mlprec/impl/solver/mld_z_diag_solver_bld.f90 mlprec/impl/solver/mld_z_diag_solver_cnv.f90 mlprec/impl/solver/mld_z_ilu_solver_bld.f90 mlprec/impl/solver/mld_z_ilu_solver_cnv.f90 mlprec/mld_c_as_smoother.f90 mlprec/mld_c_base_smoother_mod.f90 mlprec/mld_c_base_solver_mod.f90 mlprec/mld_c_diag_solver.f90 mlprec/mld_c_id_solver.f90 mlprec/mld_c_ilu_solver.f90 mlprec/mld_c_jac_smoother.f90 mlprec/mld_c_onelev_mod.f90 mlprec/mld_c_slu_solver.F90 mlprec/mld_c_sludist_solver.F90 mlprec/mld_c_umf_solver.F90 mlprec/mld_d_as_smoother.f90 mlprec/mld_d_base_smoother_mod.f90 mlprec/mld_d_base_solver_mod.f90 mlprec/mld_d_diag_solver.f90 mlprec/mld_d_id_solver.f90 mlprec/mld_d_ilu_solver.f90 mlprec/mld_d_jac_smoother.f90 mlprec/mld_d_onelev_mod.f90 mlprec/mld_s_as_smoother.f90 mlprec/mld_s_base_smoother_mod.f90 mlprec/mld_s_base_solver_mod.f90 mlprec/mld_s_diag_solver.f90 mlprec/mld_s_id_solver.f90 mlprec/mld_s_ilu_solver.f90 mlprec/mld_s_jac_smoother.f90 mlprec/mld_s_onelev_mod.f90 mlprec/mld_s_slu_solver.F90 mlprec/mld_s_sludist_solver.F90 mlprec/mld_s_umf_solver.F90 mlprec/mld_z_as_smoother.f90 mlprec/mld_z_base_smoother_mod.f90 mlprec/mld_z_base_solver_mod.f90 mlprec/mld_z_diag_solver.f90 mlprec/mld_z_id_solver.f90 mlprec/mld_z_ilu_solver.f90 mlprec/mld_z_jac_smoother.f90 mlprec/mld_z_onelev_mod.f90 mlprec/mld_z_slu_solver.F90 mlprec/mld_z_sludist_solver.F90 mlprec/mld_z_umf_solver.F90 Adjustments for IMOLD, BLD and CNV methods. --- mlprec/impl/level/Makefile | 30 +++--- mlprec/impl/level/mld_c_base_onelev_cnv.f90 | 64 +++++++++++ mlprec/impl/level/mld_d_base_onelev_cnv.f90 | 19 ++-- mlprec/impl/level/mld_s_base_onelev_cnv.f90 | 64 +++++++++++ mlprec/impl/level/mld_z_base_onelev_cnv.f90 | 64 +++++++++++ mlprec/impl/mld_cmlprec_bld.f90 | 7 +- mlprec/impl/mld_cprecbld.f90 | 6 +- mlprec/impl/mld_dmlprec_bld.f90 | 6 +- mlprec/impl/mld_smlprec_bld.f90 | 7 +- mlprec/impl/mld_sprecbld.f90 | 6 +- mlprec/impl/mld_zmlprec_bld.f90 | 7 +- mlprec/impl/mld_zprecbld.f90 | 6 +- mlprec/impl/smoother/Makefile | 13 ++- .../impl/smoother/mld_c_as_smoother_bld.f90 | 8 +- .../impl/smoother/mld_c_as_smoother_cnv.f90 | 101 ++++++++++++++++++ .../impl/smoother/mld_c_base_smoother_bld.f90 | 3 +- .../impl/smoother/mld_c_base_smoother_cnv.f90 | 75 +++++++++++++ .../impl/smoother/mld_c_jac_smoother_bld.f90 | 9 +- .../impl/smoother/mld_c_jac_smoother_cnv.f90 | 91 ++++++++++++++++ .../impl/smoother/mld_d_as_smoother_cnv.f90 | 2 +- .../impl/smoother/mld_d_jac_smoother_bld.f90 | 6 +- .../impl/smoother/mld_s_as_smoother_bld.f90 | 8 +- .../impl/smoother/mld_s_as_smoother_cnv.f90 | 101 ++++++++++++++++++ .../impl/smoother/mld_s_base_smoother_bld.f90 | 3 +- .../impl/smoother/mld_s_base_smoother_cnv.f90 | 75 +++++++++++++ .../impl/smoother/mld_s_jac_smoother_bld.f90 | 9 +- .../impl/smoother/mld_s_jac_smoother_cnv.f90 | 91 ++++++++++++++++ .../impl/smoother/mld_z_as_smoother_bld.f90 | 8 +- .../impl/smoother/mld_z_as_smoother_cnv.f90 | 101 ++++++++++++++++++ .../impl/smoother/mld_z_base_smoother_bld.f90 | 3 +- .../impl/smoother/mld_z_base_smoother_cnv.f90 | 75 +++++++++++++ .../impl/smoother/mld_z_jac_smoother_bld.f90 | 9 +- .../impl/smoother/mld_z_jac_smoother_cnv.f90 | 91 ++++++++++++++++ mlprec/impl/solver/Makefile | 11 +- mlprec/impl/solver/mld_c_base_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_c_base_solver_cnv.f90 | 68 ++++++++++++ mlprec/impl/solver/mld_c_diag_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_c_diag_solver_cnv.f90 | 81 ++++++++++++++ mlprec/impl/solver/mld_c_ilu_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_c_ilu_solver_cnv.f90 | 81 ++++++++++++++ mlprec/impl/solver/mld_d_base_solver_bld.f90 | 6 +- mlprec/impl/solver/mld_d_diag_solver_bld.f90 | 8 +- mlprec/impl/solver/mld_d_diag_solver_cnv.f90 | 8 +- mlprec/impl/solver/mld_d_ilu_solver_bld.f90 | 8 +- mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 | 6 +- mlprec/impl/solver/mld_s_base_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_s_base_solver_cnv.f90 | 68 ++++++++++++ mlprec/impl/solver/mld_s_diag_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_s_diag_solver_cnv.f90 | 81 ++++++++++++++ mlprec/impl/solver/mld_s_ilu_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_s_ilu_solver_cnv.f90 | 81 ++++++++++++++ mlprec/impl/solver/mld_z_base_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_z_base_solver_cnv.f90 | 68 ++++++++++++ mlprec/impl/solver/mld_z_diag_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_z_diag_solver_cnv.f90 | 81 ++++++++++++++ mlprec/impl/solver/mld_z_ilu_solver_bld.f90 | 9 +- mlprec/impl/solver/mld_z_ilu_solver_cnv.f90 | 81 ++++++++++++++ mlprec/mld_c_as_smoother.f90 | 35 ++++-- mlprec/mld_c_base_smoother_mod.f90 | 25 ++++- mlprec/mld_c_base_solver_mod.f90 | 42 +++++--- mlprec/mld_c_diag_solver.f90 | 21 +++- mlprec/mld_c_id_solver.f90 | 9 +- mlprec/mld_c_ilu_solver.f90 | 27 ++++- mlprec/mld_c_jac_smoother.f90 | 36 +++++-- mlprec/mld_c_onelev_mod.f90 | 21 +++- mlprec/mld_c_slu_solver.F90 | 3 +- mlprec/mld_c_sludist_solver.F90 | 3 +- mlprec/mld_c_umf_solver.F90 | 3 +- mlprec/mld_d_as_smoother.f90 | 31 +++--- mlprec/mld_d_base_smoother_mod.f90 | 12 +-- mlprec/mld_d_base_solver_mod.f90 | 41 +++---- mlprec/mld_d_diag_solver.f90 | 13 ++- mlprec/mld_d_id_solver.f90 | 8 +- mlprec/mld_d_ilu_solver.f90 | 14 +-- mlprec/mld_d_jac_smoother.f90 | 26 ++--- mlprec/mld_d_onelev_mod.f90 | 8 +- mlprec/mld_s_as_smoother.f90 | 35 ++++-- mlprec/mld_s_base_smoother_mod.f90 | 25 ++++- mlprec/mld_s_base_solver_mod.f90 | 42 +++++--- mlprec/mld_s_diag_solver.f90 | 21 +++- mlprec/mld_s_id_solver.f90 | 9 +- mlprec/mld_s_ilu_solver.f90 | 27 ++++- mlprec/mld_s_jac_smoother.f90 | 36 +++++-- mlprec/mld_s_onelev_mod.f90 | 21 +++- mlprec/mld_s_slu_solver.F90 | 3 +- mlprec/mld_s_sludist_solver.F90 | 3 +- mlprec/mld_s_umf_solver.F90 | 3 +- mlprec/mld_z_as_smoother.f90 | 35 ++++-- mlprec/mld_z_base_smoother_mod.f90 | 25 ++++- mlprec/mld_z_base_solver_mod.f90 | 42 +++++--- mlprec/mld_z_diag_solver.f90 | 21 +++- mlprec/mld_z_id_solver.f90 | 9 +- mlprec/mld_z_ilu_solver.f90 | 27 ++++- mlprec/mld_z_jac_smoother.f90 | 36 +++++-- mlprec/mld_z_onelev_mod.f90 | 21 +++- mlprec/mld_z_slu_solver.F90 | 3 +- mlprec/mld_z_sludist_solver.F90 | 3 +- mlprec/mld_z_umf_solver.F90 | 3 +- 98 files changed, 2465 insertions(+), 349 deletions(-) create mode 100644 mlprec/impl/level/mld_c_base_onelev_cnv.f90 create mode 100644 mlprec/impl/level/mld_s_base_onelev_cnv.f90 create mode 100644 mlprec/impl/level/mld_z_base_onelev_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_c_as_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_c_base_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_c_jac_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_s_as_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_s_base_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_s_jac_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_z_as_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_z_base_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_z_jac_smoother_cnv.f90 create mode 100644 mlprec/impl/solver/mld_c_base_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_c_diag_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_c_ilu_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_s_base_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_s_diag_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_s_ilu_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_z_base_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_z_diag_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_z_ilu_solver_cnv.f90 diff --git a/mlprec/impl/level/Makefile b/mlprec/impl/level/Makefile index 4964e210..d90f44aa 100644 --- a/mlprec/impl/level/Makefile +++ b/mlprec/impl/level/Makefile @@ -8,46 +8,49 @@ FINCLUDES=$(FMFLAG)../.. $(FMFLAG)$(LIBDIR) $(FMFLAG)$(PSBINCDIR) $(FMFLAG)$(PSB OBJS=mld_c_base_onelev_check.o \ +mld_c_base_onelev_cnv.o \ +mld_c_base_onelev_csetc.o \ +mld_c_base_onelev_cseti.o \ +mld_c_base_onelev_csetr.o \ mld_c_base_onelev_descr.o \ mld_c_base_onelev_dump.o \ 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_cnv.o \ +mld_d_base_onelev_csetc.o \ +mld_d_base_onelev_cseti.o \ +mld_d_base_onelev_csetr.o \ mld_d_base_onelev_descr.o \ mld_d_base_onelev_dump.o \ 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_cnv.o \ +mld_s_base_onelev_csetc.o \ +mld_s_base_onelev_cseti.o \ +mld_s_base_onelev_csetr.o \ mld_s_base_onelev_descr.o \ mld_s_base_onelev_dump.o \ 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_cnv.o \ +mld_z_base_onelev_csetc.o \ +mld_z_base_onelev_cseti.o \ +mld_z_base_onelev_csetr.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_csetc.o \ -mld_z_base_onelev_cseti.o \ -mld_z_base_onelev_csetr.o +mld_z_base_onelev_setr.o LIBNAME=libmld_prec.a @@ -64,4 +67,3 @@ veryclean: clean clean: /bin/rm -f $(OBJS) $(LOCAL_MODS) - diff --git a/mlprec/impl/level/mld_c_base_onelev_cnv.f90 b/mlprec/impl/level/mld_c_base_onelev_cnv.f90 new file mode 100644 index 00000000..d53268af --- /dev/null +++ b/mlprec/impl/level/mld_c_base_onelev_cnv.f90 @@ -0,0 +1,64 @@ +!!$ +!!$ +!!$ 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,2013 +!!$ +!!$ 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_cnv(lv,info,amold,vmold,imold) + + use psb_base_mod + use mld_c_onelev_mod, mld_protect_name => mld_c_base_onelev_cnv + implicit none + + class(mld_c_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + integer(psb_ipk_) :: i + + info = psb_success_ + + if (any((/present(amold),present(vmold),present(imold)/))) then + if (allocated(lv%sm)) & + & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info == psb_success_) & + & call lv%ac%cscnv(info,mold=amold) + if (info == psb_success_ .and. lv%desc_ac%is_ok()) & + & call lv%desc_ac%cnv(imold) + call lv%map%cnv(info,mold=amold,imold=imold) + end if +end subroutine mld_c_base_onelev_cnv diff --git a/mlprec/impl/level/mld_d_base_onelev_cnv.f90 b/mlprec/impl/level/mld_d_base_onelev_cnv.f90 index fdbef138..324ecb6b 100644 --- a/mlprec/impl/level/mld_d_base_onelev_cnv.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_cnv.f90 @@ -51,13 +51,14 @@ subroutine mld_d_base_onelev_cnv(lv,info,amold,vmold,imold) integer(psb_ipk_) :: i info = psb_success_ - - if (allocated(lv%sm)) & - & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) - if (info == psb_success_) & - & call lv%ac%cscnv(info,mold=amold) - if (info == psb_success_ .and. lv%desc_ac%is_ok()) & - & call lv%desc_ac%cnv(imold) - call lv%map%cnv(info,mold=amold,imold=imold) - + + if (any((/present(amold),present(vmold),present(imold)/))) then + if (allocated(lv%sm)) & + & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info == psb_success_) & + & call lv%ac%cscnv(info,mold=amold) + if (info == psb_success_ .and. lv%desc_ac%is_ok()) & + & call lv%desc_ac%cnv(imold) + call lv%map%cnv(info,mold=amold,imold=imold) + end if end subroutine mld_d_base_onelev_cnv diff --git a/mlprec/impl/level/mld_s_base_onelev_cnv.f90 b/mlprec/impl/level/mld_s_base_onelev_cnv.f90 new file mode 100644 index 00000000..efa0c3a6 --- /dev/null +++ b/mlprec/impl/level/mld_s_base_onelev_cnv.f90 @@ -0,0 +1,64 @@ +!!$ +!!$ +!!$ 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,2013 +!!$ +!!$ 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_cnv(lv,info,amold,vmold,imold) + + use psb_base_mod + use mld_s_onelev_mod, mld_protect_name => mld_s_base_onelev_cnv + implicit none + + class(mld_s_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + integer(psb_ipk_) :: i + + info = psb_success_ + + if (any((/present(amold),present(vmold),present(imold)/))) then + if (allocated(lv%sm)) & + & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info == psb_success_) & + & call lv%ac%cscnv(info,mold=amold) + if (info == psb_success_ .and. lv%desc_ac%is_ok()) & + & call lv%desc_ac%cnv(imold) + call lv%map%cnv(info,mold=amold,imold=imold) + end if +end subroutine mld_s_base_onelev_cnv diff --git a/mlprec/impl/level/mld_z_base_onelev_cnv.f90 b/mlprec/impl/level/mld_z_base_onelev_cnv.f90 new file mode 100644 index 00000000..25f0f7f1 --- /dev/null +++ b/mlprec/impl/level/mld_z_base_onelev_cnv.f90 @@ -0,0 +1,64 @@ +!!$ +!!$ +!!$ 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,2013 +!!$ +!!$ 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_cnv(lv,info,amold,vmold,imold) + + use psb_base_mod + use mld_z_onelev_mod, mld_protect_name => mld_z_base_onelev_cnv + implicit none + + class(mld_z_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + integer(psb_ipk_) :: i + + info = psb_success_ + + if (any((/present(amold),present(vmold),present(imold)/))) then + if (allocated(lv%sm)) & + & call lv%sm%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info == psb_success_) & + & call lv%ac%cscnv(info,mold=amold) + if (info == psb_success_ .and. lv%desc_ac%is_ok()) & + & call lv%desc_ac%cnv(imold) + call lv%map%cnv(info,mold=amold,imold=imold) + end if +end subroutine mld_z_base_onelev_cnv diff --git a/mlprec/impl/mld_cmlprec_bld.f90 b/mlprec/impl/mld_cmlprec_bld.f90 index adcf6aae..e3eb13bc 100644 --- a/mlprec/impl/mld_cmlprec_bld.f90 +++ b/mlprec/impl/mld_cmlprec_bld.f90 @@ -487,11 +487,10 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold) end if call p%precv(i)%sm%build(p%precv(i)%base_a,p%precv(i)%base_desc,& - & 'F',info,amold=amold,vmold=vmold) + & 'F',info,amold=amold,vmold=vmold,imold=imold) - if ((info == psb_success_).and.(i>1).and.(present(amold))) then - call psb_map_cscnv(p%precv(i)%map,info,mold=amold) - call p%precv(i)%ac%cscnv(info,mold=amold) + if ((info == psb_success_).and.(i>1)) then + call p%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold) end if if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/mld_cprecbld.f90 b/mlprec/impl/mld_cprecbld.f90 index 61ced362..e1207f44 100644 --- a/mlprec/impl/mld_cprecbld.f90 +++ b/mlprec/impl/mld_cprecbld.f90 @@ -174,7 +174,8 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold) goto 9999 endif - call p%precv(1)%sm%build(a,desc_a,upd_,info,amold=amold,vmold=vmold) + call p%precv(1)%sm%build(a,desc_a,upd_,info,& + & amold=amold,vmold=vmold,imold=imold) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='One level preconditioner build.') @@ -188,7 +189,8 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold) ! ! Build the multilevel preconditioner ! - call mld_mlprec_bld(a,desc_a,p,info,amold=amold,vmold=vmold) + call mld_mlprec_bld(a,desc_a,p,info,& + & amold=amold,vmold=vmold,imold=imold) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/mld_dmlprec_bld.f90 b/mlprec/impl/mld_dmlprec_bld.f90 index 2bd905fa..0b176021 100644 --- a/mlprec/impl/mld_dmlprec_bld.f90 +++ b/mlprec/impl/mld_dmlprec_bld.f90 @@ -489,10 +489,8 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold) call p%precv(i)%sm%build(p%precv(i)%base_a,p%precv(i)%base_desc,& & 'F',info,amold=amold,vmold=vmold,imold=imold) - if ((info == psb_success_).and.(i>1).and.(present(amold))) then - call p%precv(i)%cnv(info,amold=amold,imold=imold) -!!$ call psb_map_cscnv(p%precv(i)%map,info,mold=amold) -!!$ call p%precv(i)%ac%cscnv(info,mold=amold) + if ((info == psb_success_).and.(i>1)) then + call p%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold) end if if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/mld_smlprec_bld.f90 b/mlprec/impl/mld_smlprec_bld.f90 index 205c13e5..9f3b59df 100644 --- a/mlprec/impl/mld_smlprec_bld.f90 +++ b/mlprec/impl/mld_smlprec_bld.f90 @@ -487,11 +487,10 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold) end if call p%precv(i)%sm%build(p%precv(i)%base_a,p%precv(i)%base_desc,& - & 'F',info,amold=amold,vmold=vmold) + & 'F',info,amold=amold,vmold=vmold,imold=imold) - if ((info == psb_success_).and.(i>1).and.(present(amold))) then - call psb_map_cscnv(p%precv(i)%map,info,mold=amold) - call p%precv(i)%ac%cscnv(info,mold=amold) + if ((info == psb_success_).and.(i>1)) then + call p%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold) end if if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/mld_sprecbld.f90 b/mlprec/impl/mld_sprecbld.f90 index 5b3c5d33..b16d13c2 100644 --- a/mlprec/impl/mld_sprecbld.f90 +++ b/mlprec/impl/mld_sprecbld.f90 @@ -174,7 +174,8 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold) goto 9999 endif - call p%precv(1)%sm%build(a,desc_a,upd_,info,amold=amold,vmold=vmold) + call p%precv(1)%sm%build(a,desc_a,upd_,info,& + & amold=amold,vmold=vmold,imold=imold) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='One level preconditioner build.') @@ -188,7 +189,8 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold) ! ! Build the multilevel preconditioner ! - call mld_mlprec_bld(a,desc_a,p,info,amold=amold,vmold=vmold) + call mld_mlprec_bld(a,desc_a,p,info,& + & amold=amold,vmold=vmold,imold=imold) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/mld_zmlprec_bld.f90 b/mlprec/impl/mld_zmlprec_bld.f90 index e66a4917..e54559fc 100644 --- a/mlprec/impl/mld_zmlprec_bld.f90 +++ b/mlprec/impl/mld_zmlprec_bld.f90 @@ -487,11 +487,10 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold) end if call p%precv(i)%sm%build(p%precv(i)%base_a,p%precv(i)%base_desc,& - & 'F',info,amold=amold,vmold=vmold) + & 'F',info,amold=amold,vmold=vmold,imold=imold) - if ((info == psb_success_).and.(i>1).and.(present(amold))) then - call psb_map_cscnv(p%precv(i)%map,info,mold=amold) - call p%precv(i)%ac%cscnv(info,mold=amold) + if ((info == psb_success_).and.(i>1)) then + call p%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold) end if if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/mld_zprecbld.f90 b/mlprec/impl/mld_zprecbld.f90 index 1cda521f..d7976e40 100644 --- a/mlprec/impl/mld_zprecbld.f90 +++ b/mlprec/impl/mld_zprecbld.f90 @@ -174,7 +174,8 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold) goto 9999 endif - call p%precv(1)%sm%build(a,desc_a,upd_,info,amold=amold,vmold=vmold) + call p%precv(1)%sm%build(a,desc_a,upd_,info,& + & amold=amold,vmold=vmold,imold=imold) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& & a_err='One level preconditioner build.') @@ -188,7 +189,8 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold) ! ! Build the multilevel preconditioner ! - call mld_mlprec_bld(a,desc_a,p,info,amold=amold,vmold=vmold) + call mld_mlprec_bld(a,desc_a,p,info,& + & amold=amold,vmold=vmold,imold=imold) if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/smoother/Makefile b/mlprec/impl/smoother/Makefile index f2536eda..49429c8d 100644 --- a/mlprec/impl/smoother/Makefile +++ b/mlprec/impl/smoother/Makefile @@ -12,6 +12,7 @@ mld_c_as_smoother_apply_vect.o \ mld_c_as_smoother_bld.o \ mld_c_as_smoother_check.o \ mld_c_as_smoother_clone.o \ +mld_c_as_smoother_cnv.o \ mld_c_as_smoother_csetc.o \ mld_c_as_smoother_cseti.o \ mld_c_as_smoother_csetr.o \ @@ -25,6 +26,7 @@ mld_c_base_smoother_apply_vect.o \ mld_c_base_smoother_bld.o \ mld_c_base_smoother_check.o \ mld_c_base_smoother_clone.o \ +mld_c_base_smoother_cnv.o \ mld_c_base_smoother_csetc.o \ mld_c_base_smoother_cseti.o \ mld_c_base_smoother_csetr.o \ @@ -38,6 +40,7 @@ mld_c_jac_smoother_apply.o \ mld_c_jac_smoother_apply_vect.o \ mld_c_jac_smoother_bld.o \ mld_c_jac_smoother_clone.o \ +mld_c_jac_smoother_cnv.o \ mld_d_as_smoother_apply.o \ mld_d_as_smoother_apply_vect.o \ mld_d_as_smoother_bld.o \ @@ -77,6 +80,7 @@ mld_s_as_smoother_apply_vect.o \ mld_s_as_smoother_bld.o \ mld_s_as_smoother_check.o \ mld_s_as_smoother_clone.o \ +mld_s_as_smoother_cnv.o \ mld_s_as_smoother_csetc.o \ mld_s_as_smoother_cseti.o \ mld_s_as_smoother_csetr.o \ @@ -90,6 +94,7 @@ mld_s_base_smoother_apply_vect.o \ mld_s_base_smoother_bld.o \ mld_s_base_smoother_check.o \ mld_s_base_smoother_clone.o \ +mld_s_base_smoother_cnv.o \ mld_s_base_smoother_csetc.o \ mld_s_base_smoother_cseti.o \ mld_s_base_smoother_csetr.o \ @@ -103,11 +108,13 @@ mld_s_jac_smoother_apply.o \ mld_s_jac_smoother_apply_vect.o \ mld_s_jac_smoother_bld.o \ mld_s_jac_smoother_clone.o \ +mld_s_jac_smoother_cnv.o \ mld_z_as_smoother_apply.o \ mld_z_as_smoother_apply_vect.o \ mld_z_as_smoother_bld.o \ mld_z_as_smoother_check.o \ mld_z_as_smoother_clone.o \ +mld_z_as_smoother_cnv.o \ mld_z_as_smoother_csetc.o \ mld_z_as_smoother_cseti.o \ mld_z_as_smoother_csetr.o \ @@ -121,6 +128,7 @@ mld_z_base_smoother_apply_vect.o \ mld_z_base_smoother_bld.o \ mld_z_base_smoother_check.o \ mld_z_base_smoother_clone.o \ +mld_z_base_smoother_cnv.o \ mld_z_base_smoother_csetc.o \ mld_z_base_smoother_cseti.o \ mld_z_base_smoother_csetr.o \ @@ -133,8 +141,8 @@ mld_z_base_smoother_setr.o \ mld_z_jac_smoother_apply.o \ mld_z_jac_smoother_apply_vect.o \ mld_z_jac_smoother_bld.o \ -mld_z_jac_smoother_clone.o - +mld_z_jac_smoother_clone.o \ +mld_z_jac_smoother_cnv.o LIBNAME=libmld_prec.a @@ -153,4 +161,3 @@ veryclean: clean clean: /bin/rm -f $(OBJS) $(LOCAL_MODS) - diff --git a/mlprec/impl/smoother/mld_c_as_smoother_bld.f90 b/mlprec/impl/smoother/mld_c_as_smoother_bld.f90 index 2245df25..737a56d5 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_bld @@ -50,6 +50,7 @@ subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_cspmat_type) :: blck, atmp @@ -164,6 +165,11 @@ subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) & type='csr',dupl=psb_dupl_add_) end if end if + if (info == psb_success_) then + if (present(imold)) then + call sm%desc_data%cnv(imold) + end if + end if if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4') goto 9999 diff --git a/mlprec/impl/smoother/mld_c_as_smoother_cnv.f90 b/mlprec/impl/smoother/mld_c_as_smoother_cnv.f90 new file mode 100644 index 00000000..8ea42b1d --- /dev/null +++ b/mlprec/impl/smoother/mld_c_as_smoother_cnv.f90 @@ -0,0 +1,101 @@ +!!$ +!!$ +!!$ 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,2013 +!!$ +!!$ 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_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_cnv + Implicit None + + ! Arguments + class(mld_c_as_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + ! Local variables + type(psb_dspmat_type) :: blck, atmp + integer(psb_ipk_) :: n_row,n_col, nrow_a, nhalo, novr, data_, nzeros + real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_as_smoother_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ictxt = sm%desc_data%get_context() + call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + + if (allocated(sm%sv)) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + + if (info == psb_success_) then + if (present(amold)) then + call sm%nd%cscnv(info,& + & mold=amold,dupl=psb_dupl_add_) + end if + end if + if (info == psb_success_) then + if (present(imold)) then + call sm%desc_data%cnv(imold) + end if + end if + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + 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_cnv diff --git a/mlprec/impl/smoother/mld_c_base_smoother_bld.f90 b/mlprec/impl/smoother/mld_c_base_smoother_bld.f90 index c66cf9bc..ef172c2b 100644 --- a/mlprec/impl/smoother/mld_c_base_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_c_base_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_c_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_c_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_bld @@ -50,6 +50,7 @@ subroutine mld_c_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold integer(psb_ipk_) :: err_act character(len=20) :: name='c_base_smoother_bld' diff --git a/mlprec/impl/smoother/mld_c_base_smoother_cnv.f90 b/mlprec/impl/smoother/mld_c_base_smoother_cnv.f90 new file mode 100644 index 00000000..5669803c --- /dev/null +++ b/mlprec/impl/smoother/mld_c_base_smoother_cnv.f90 @@ -0,0 +1,75 @@ +!!$ +!!$ +!!$ 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,2013 +!!$ +!!$ 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_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_cnv + Implicit None + + ! Arguments + class(mld_c_base_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_smoother_cnv' + + call psb_erractionsave(err_act) + + info = psb_success_ + if (allocated(sm%sv)) then + call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + else + info = 1121 + call psb_errpush(info,name) + endif + 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_cnv diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 index 0334c10a..80383ab2 100644 --- a/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_c_jac_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_c_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_c_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_c_diag_solver @@ -45,12 +45,13 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(inout) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_c_jac_smoother_type), intent(inout) :: sm - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_cnv.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_cnv.f90 new file mode 100644 index 00000000..75c266e6 --- /dev/null +++ b/mlprec/impl/smoother/mld_c_jac_smoother_cnv.f90 @@ -0,0 +1,91 @@ +!!$ +!!$ +!!$ 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,2013 +!!$ +!!$ 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_jac_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_c_diag_solver + use mld_c_jac_smoother, mld_protect_name => mld_c_jac_smoother_cnv + Implicit None + + ! Arguments + class(mld_c_jac_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_jac_smoother_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + + if (info == psb_success_) then + if (present(amold)) then + call sm%nd%cscnv(info,& + & mold=amold,dupl=psb_dupl_add_) + else + call sm%nd%cscnv(info,& + & type='csr',dupl=psb_dupl_add_) + endif + end if + + if (allocated(sm%sv)) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='solver cnv') + 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_jac_smoother_cnv diff --git a/mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 b/mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 index c9bd4c3b..5d872dce 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 @@ -66,7 +66,7 @@ subroutine mld_d_as_smoother_cnv(sm,info,amold,vmold,imold) & write(debug_unit,*) me,' ',trim(name),' start' - if (info == psb_success_) & + if (allocated(sm%sv)) & & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) if (info == psb_success_) then diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 index d3e2d954..89c19d82 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 @@ -45,10 +45,10 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(inout) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_d_jac_smoother_type), intent(inout) :: sm - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_i_base_vect_type), intent(in), optional :: imold diff --git a/mlprec/impl/smoother/mld_s_as_smoother_bld.f90 b/mlprec/impl/smoother/mld_s_as_smoother_bld.f90 index 14287add..3ed6ea3a 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_bld @@ -50,6 +50,7 @@ subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_sspmat_type) :: blck, atmp @@ -164,6 +165,11 @@ subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) & type='csr',dupl=psb_dupl_add_) end if end if + if (info == psb_success_) then + if (present(imold)) then + call sm%desc_data%cnv(imold) + end if + end if if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4') goto 9999 diff --git a/mlprec/impl/smoother/mld_s_as_smoother_cnv.f90 b/mlprec/impl/smoother/mld_s_as_smoother_cnv.f90 new file mode 100644 index 00000000..bdec52d6 --- /dev/null +++ b/mlprec/impl/smoother/mld_s_as_smoother_cnv.f90 @@ -0,0 +1,101 @@ +!!$ +!!$ +!!$ 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,2013 +!!$ +!!$ 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_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_cnv + Implicit None + + ! Arguments + class(mld_s_as_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + ! Local variables + type(psb_dspmat_type) :: blck, atmp + integer(psb_ipk_) :: n_row,n_col, nrow_a, nhalo, novr, data_, nzeros + real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_as_smoother_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ictxt = sm%desc_data%get_context() + call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + + if (allocated(sm%sv)) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + + if (info == psb_success_) then + if (present(amold)) then + call sm%nd%cscnv(info,& + & mold=amold,dupl=psb_dupl_add_) + end if + end if + if (info == psb_success_) then + if (present(imold)) then + call sm%desc_data%cnv(imold) + end if + end if + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + 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_cnv diff --git a/mlprec/impl/smoother/mld_s_base_smoother_bld.f90 b/mlprec/impl/smoother/mld_s_base_smoother_bld.f90 index c1aef016..65a55ece 100644 --- a/mlprec/impl/smoother/mld_s_base_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_s_base_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_s_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_s_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_bld @@ -50,6 +50,7 @@ subroutine mld_s_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold integer(psb_ipk_) :: err_act character(len=20) :: name='s_base_smoother_bld' diff --git a/mlprec/impl/smoother/mld_s_base_smoother_cnv.f90 b/mlprec/impl/smoother/mld_s_base_smoother_cnv.f90 new file mode 100644 index 00000000..779596d6 --- /dev/null +++ b/mlprec/impl/smoother/mld_s_base_smoother_cnv.f90 @@ -0,0 +1,75 @@ +!!$ +!!$ +!!$ 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,2013 +!!$ +!!$ 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_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_cnv + Implicit None + + ! Arguments + class(mld_s_base_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_smoother_cnv' + + call psb_erractionsave(err_act) + + info = psb_success_ + if (allocated(sm%sv)) then + call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + else + info = 1121 + call psb_errpush(info,name) + endif + 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_cnv diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 index c399dce9..7dd86148 100644 --- a/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_s_jac_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_s_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_s_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_s_diag_solver @@ -45,12 +45,13 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(inout) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_s_jac_smoother_type), intent(inout) :: sm - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_cnv.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_cnv.f90 new file mode 100644 index 00000000..009f901e --- /dev/null +++ b/mlprec/impl/smoother/mld_s_jac_smoother_cnv.f90 @@ -0,0 +1,91 @@ +!!$ +!!$ +!!$ 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,2013 +!!$ +!!$ 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_jac_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_s_diag_solver + use mld_s_jac_smoother, mld_protect_name => mld_s_jac_smoother_cnv + Implicit None + + ! Arguments + class(mld_s_jac_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_jac_smoother_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + + if (info == psb_success_) then + if (present(amold)) then + call sm%nd%cscnv(info,& + & mold=amold,dupl=psb_dupl_add_) + else + call sm%nd%cscnv(info,& + & type='csr',dupl=psb_dupl_add_) + endif + end if + + if (allocated(sm%sv)) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='solver cnv') + 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_jac_smoother_cnv diff --git a/mlprec/impl/smoother/mld_z_as_smoother_bld.f90 b/mlprec/impl/smoother/mld_z_as_smoother_bld.f90 index 95164793..e7a26e68 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_bld @@ -50,6 +50,7 @@ subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_zspmat_type) :: blck, atmp @@ -164,6 +165,11 @@ subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) & type='csr',dupl=psb_dupl_add_) end if end if + if (info == psb_success_) then + if (present(imold)) then + call sm%desc_data%cnv(imold) + end if + end if if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4') goto 9999 diff --git a/mlprec/impl/smoother/mld_z_as_smoother_cnv.f90 b/mlprec/impl/smoother/mld_z_as_smoother_cnv.f90 new file mode 100644 index 00000000..f0e4c5ab --- /dev/null +++ b/mlprec/impl/smoother/mld_z_as_smoother_cnv.f90 @@ -0,0 +1,101 @@ +!!$ +!!$ +!!$ 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,2013 +!!$ +!!$ 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_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_cnv + Implicit None + + ! Arguments + class(mld_z_as_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + ! Local variables + type(psb_dspmat_type) :: blck, atmp + integer(psb_ipk_) :: n_row,n_col, nrow_a, nhalo, novr, data_, nzeros + real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_as_smoother_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ictxt = sm%desc_data%get_context() + call psb_info(ictxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + + if (allocated(sm%sv)) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + + if (info == psb_success_) then + if (present(amold)) then + call sm%nd%cscnv(info,& + & mold=amold,dupl=psb_dupl_add_) + end if + end if + if (info == psb_success_) then + if (present(imold)) then + call sm%desc_data%cnv(imold) + end if + end if + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='clip & psb_spcnv csr 4') + goto 9999 + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + 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_cnv diff --git a/mlprec/impl/smoother/mld_z_base_smoother_bld.f90 b/mlprec/impl/smoother/mld_z_base_smoother_bld.f90 index 3722d0d6..c36adf89 100644 --- a/mlprec/impl/smoother/mld_z_base_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_z_base_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_z_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_z_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_bld @@ -50,6 +50,7 @@ subroutine mld_z_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold integer(psb_ipk_) :: err_act character(len=20) :: name='z_base_smoother_bld' diff --git a/mlprec/impl/smoother/mld_z_base_smoother_cnv.f90 b/mlprec/impl/smoother/mld_z_base_smoother_cnv.f90 new file mode 100644 index 00000000..65837751 --- /dev/null +++ b/mlprec/impl/smoother/mld_z_base_smoother_cnv.f90 @@ -0,0 +1,75 @@ +!!$ +!!$ +!!$ 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,2013 +!!$ +!!$ 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_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_cnv + Implicit None + + ! Arguments + class(mld_z_base_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_smoother_cnv' + + call psb_erractionsave(err_act) + + info = psb_success_ + if (allocated(sm%sv)) then + call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + else + info = 1121 + call psb_errpush(info,name) + endif + 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_cnv diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 index 8e9eb03f..52ae6f08 100644 --- a/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_z_jac_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_z_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_z_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_z_diag_solver @@ -45,12 +45,13 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) ! Arguments type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(inout) :: desc_a + Type(psb_desc_type), Intent(inout) :: desc_a class(mld_z_jac_smoother_type), intent(inout) :: sm - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_cnv.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_cnv.f90 new file mode 100644 index 00000000..3f1a957c --- /dev/null +++ b/mlprec/impl/smoother/mld_z_jac_smoother_cnv.f90 @@ -0,0 +1,91 @@ +!!$ +!!$ +!!$ 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,2013 +!!$ +!!$ 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_jac_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_z_diag_solver + use mld_z_jac_smoother, mld_protect_name => mld_z_jac_smoother_cnv + Implicit None + + ! Arguments + class(mld_z_jac_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_jac_smoother_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + + if (info == psb_success_) then + if (present(amold)) then + call sm%nd%cscnv(info,& + & mold=amold,dupl=psb_dupl_add_) + else + call sm%nd%cscnv(info,& + & type='csr',dupl=psb_dupl_add_) + endif + end if + + if (allocated(sm%sv)) & + & call sm%sv%cnv(info,amold=amold,vmold=vmold,imold=imold) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='solver cnv') + 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_jac_smoother_cnv diff --git a/mlprec/impl/solver/Makefile b/mlprec/impl/solver/Makefile index 31de5a20..27e6723d 100644 --- a/mlprec/impl/solver/Makefile +++ b/mlprec/impl/solver/Makefile @@ -12,6 +12,7 @@ mld_c_base_solver_apply_vect.o \ mld_c_base_solver_bld.o \ mld_c_base_solver_check.o \ mld_c_base_solver_clone.o \ +mld_c_base_solver_cnv.o \ mld_c_base_solver_csetc.o \ mld_c_base_solver_cseti.o \ mld_c_base_solver_csetr.o \ @@ -25,6 +26,7 @@ mld_c_diag_solver_apply.o \ mld_c_diag_solver_apply_vect.o \ mld_c_diag_solver_bld.o \ mld_c_diag_solver_clone.o \ +mld_c_diag_solver_cnv.o \ mld_c_id_solver_apply.o \ mld_c_id_solver_apply_vect.o \ mld_c_id_solver_clone.o \ @@ -32,6 +34,7 @@ mld_c_ilu_solver_apply.o \ mld_c_ilu_solver_apply_vect.o \ mld_c_ilu_solver_bld.o \ mld_c_ilu_solver_clone.o \ +mld_c_ilu_solver_cnv.o \ mld_c_ilu_solver_dmp.o \ mld_d_base_solver_apply.o \ mld_d_base_solver_apply_vect.o \ @@ -67,6 +70,7 @@ mld_s_base_solver_apply_vect.o \ mld_s_base_solver_bld.o \ mld_s_base_solver_check.o \ mld_s_base_solver_clone.o \ +mld_s_base_solver_cnv.o \ mld_s_base_solver_csetc.o \ mld_s_base_solver_cseti.o \ mld_s_base_solver_csetr.o \ @@ -80,6 +84,7 @@ mld_s_diag_solver_apply.o \ mld_s_diag_solver_apply_vect.o \ mld_s_diag_solver_bld.o \ mld_s_diag_solver_clone.o \ +mld_s_diag_solver_cnv.o \ mld_s_id_solver_apply.o \ mld_s_id_solver_apply_vect.o \ mld_s_id_solver_clone.o \ @@ -87,12 +92,14 @@ mld_s_ilu_solver_apply.o \ mld_s_ilu_solver_apply_vect.o \ mld_s_ilu_solver_bld.o \ mld_s_ilu_solver_clone.o \ +mld_s_ilu_solver_cnv.o \ mld_s_ilu_solver_dmp.o \ mld_z_base_solver_apply.o \ mld_z_base_solver_apply_vect.o \ mld_z_base_solver_bld.o \ mld_z_base_solver_check.o \ mld_z_base_solver_clone.o \ +mld_z_base_solver_cnv.o \ mld_z_base_solver_csetc.o \ mld_z_base_solver_cseti.o \ mld_z_base_solver_csetr.o \ @@ -106,6 +113,7 @@ mld_z_diag_solver_apply.o \ mld_z_diag_solver_apply_vect.o \ mld_z_diag_solver_bld.o \ mld_z_diag_solver_clone.o \ +mld_z_diag_solver_cnv.o \ mld_z_id_solver_apply.o \ mld_z_id_solver_apply_vect.o \ mld_z_id_solver_clone.o \ @@ -113,7 +121,8 @@ mld_z_ilu_solver_apply.o \ mld_z_ilu_solver_apply_vect.o \ mld_z_ilu_solver_bld.o \ mld_z_ilu_solver_clone.o \ -mld_z_ilu_solver_dmp.o +mld_z_ilu_solver_cnv.o \ +mld_z_ilu_solver_dmp.o LIBNAME=libmld_prec.a diff --git a/mlprec/impl/solver/mld_c_base_solver_bld.f90 b/mlprec/impl/solver/mld_c_base_solver_bld.f90 index 101c0f83..ea09f2c1 100644 --- a/mlprec/impl/solver/mld_c_base_solver_bld.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_bld.f90 @@ -36,20 +36,21 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_c_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_c_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_bld Implicit None ! Arguments type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_c_base_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_bld' diff --git a/mlprec/impl/solver/mld_c_base_solver_cnv.f90 b/mlprec/impl/solver/mld_c_base_solver_cnv.f90 new file mode 100644 index 00000000..3f61bc80 --- /dev/null +++ b/mlprec/impl/solver/mld_c_base_solver_cnv.f90 @@ -0,0 +1,68 @@ +!!$ +!!$ +!!$ 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,2013 +!!$ +!!$ 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_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_cnv + Implicit None + ! Arguments + class(mld_c_base_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_cnv' + + call psb_erractionsave(err_act) + + info = psb_success_ + + 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_cnv diff --git a/mlprec/impl/solver/mld_c_diag_solver_bld.f90 b/mlprec/impl/solver/mld_c_diag_solver_bld.f90 index 81297e46..0ad16a00 100644 --- a/mlprec/impl/solver/mld_c_diag_solver_bld.f90 +++ b/mlprec/impl/solver/mld_c_diag_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_c_diag_solver, mld_protect_name => mld_c_diag_solver_bld @@ -45,13 +45,14 @@ subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_c_diag_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_c_diag_solver_cnv.f90 b/mlprec/impl/solver/mld_c_diag_solver_cnv.f90 new file mode 100644 index 00000000..22f973e2 --- /dev/null +++ b/mlprec/impl/solver/mld_c_diag_solver_cnv.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,2013 +!!$ +!!$ 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_diag_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_c_diag_solver, mld_protect_name => mld_c_diag_solver_cnv + + Implicit None + + ! Arguments + class(mld_c_diag_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: err_act, debug_unit, debug_level + character(len=20) :: name='d_diag_solver_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' start' + + + if (allocated(sv%dv)) then + call sv%dv%cnv(vmold) + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' end' + + 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_diag_solver_cnv diff --git a/mlprec/impl/solver/mld_c_ilu_solver_bld.f90 b/mlprec/impl/solver/mld_c_ilu_solver_bld.f90 index e4ce481e..70db6e43 100644 --- a/mlprec/impl/solver/mld_c_ilu_solver_bld.f90 +++ b/mlprec/impl/solver/mld_c_ilu_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_bld @@ -45,13 +45,14 @@ subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_c_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota !!$ complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_c_ilu_solver_cnv.f90 b/mlprec/impl/solver/mld_c_ilu_solver_cnv.f90 new file mode 100644 index 00000000..a4e60463 --- /dev/null +++ b/mlprec/impl/solver/mld_c_ilu_solver_cnv.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,2013 +!!$ +!!$ 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_ilu_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_cnv + + Implicit None + + ! Arguments + class(mld_c_ilu_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: err_act, debug_unit, debug_level + character(len=20) :: name='d_ilu_solver_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + call sv%dv%cnv(mold=vmold) + + if (present(amold)) then + call sv%l%cscnv(info,mold=amold) + call sv%u%cscnv(info,mold=amold) + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' end' + + 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_ilu_solver_cnv diff --git a/mlprec/impl/solver/mld_d_base_solver_bld.f90 b/mlprec/impl/solver/mld_d_base_solver_bld.f90 index 27433aea..d90c0417 100644 --- a/mlprec/impl/solver/mld_d_base_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_bld.f90 @@ -43,10 +43,10 @@ subroutine mld_d_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) Implicit None ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_d_base_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold diff --git a/mlprec/impl/solver/mld_d_diag_solver_bld.f90 b/mlprec/impl/solver/mld_d_diag_solver_bld.f90 index 2a84af95..cf7ef28c 100644 --- a/mlprec/impl/solver/mld_d_diag_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_diag_solver_bld.f90 @@ -45,14 +45,14 @@ subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_d_diag_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold - class(psb_i_base_vect_type), intent(in), optional :: imold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_d_diag_solver_cnv.f90 b/mlprec/impl/solver/mld_d_diag_solver_cnv.f90 index 7b844756..9d7cea47 100644 --- a/mlprec/impl/solver/mld_d_diag_solver_cnv.f90 +++ b/mlprec/impl/solver/mld_d_diag_solver_cnv.f90 @@ -50,9 +50,7 @@ subroutine mld_d_diag_solver_cnv(sv,info,amold,vmold,imold) class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables - integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota - real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + integer(psb_ipk_) :: err_act, debug_unit, debug_level character(len=20) :: name='d_diag_solver_cnv', ch_err info=psb_success_ @@ -60,7 +58,7 @@ subroutine mld_d_diag_solver_cnv(sv,info,amold,vmold,imold) debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),' start' + & write(debug_unit,*) trim(name),' start' if (allocated(sv%dv)) then @@ -68,7 +66,7 @@ subroutine mld_d_diag_solver_cnv(sv,info,amold,vmold,imold) end if if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),' end' + & write(debug_unit,*) trim(name),' end' call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 b/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 index 44eb017d..62340845 100644 --- a/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 @@ -45,14 +45,14 @@ subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_d_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold - class(psb_i_base_vect_type), intent(in), optional :: imold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota !!$ real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 b/mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 index 1cb3166c..531bbe2b 100644 --- a/mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 +++ b/mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 @@ -50,9 +50,7 @@ subroutine mld_d_ilu_solver_cnv(sv,info,amold,vmold,imold) class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables - integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota -!!$ real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + integer(psb_ipk_) :: err_act, debug_unit, debug_level character(len=20) :: name='d_ilu_solver_cnv', ch_err info=psb_success_ @@ -68,7 +66,7 @@ subroutine mld_d_ilu_solver_cnv(sv,info,amold,vmold,imold) end if if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),' end' + & write(debug_unit,*) trim(name),' end' call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/solver/mld_s_base_solver_bld.f90 b/mlprec/impl/solver/mld_s_base_solver_bld.f90 index 3742352f..f211daf9 100644 --- a/mlprec/impl/solver/mld_s_base_solver_bld.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_bld.f90 @@ -36,20 +36,21 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_s_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_s_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_bld Implicit None ! Arguments type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_s_base_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_bld' diff --git a/mlprec/impl/solver/mld_s_base_solver_cnv.f90 b/mlprec/impl/solver/mld_s_base_solver_cnv.f90 new file mode 100644 index 00000000..bb24ea08 --- /dev/null +++ b/mlprec/impl/solver/mld_s_base_solver_cnv.f90 @@ -0,0 +1,68 @@ +!!$ +!!$ +!!$ 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,2013 +!!$ +!!$ 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_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_cnv + Implicit None + ! Arguments + class(mld_s_base_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_cnv' + + call psb_erractionsave(err_act) + + info = psb_success_ + + 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_cnv diff --git a/mlprec/impl/solver/mld_s_diag_solver_bld.f90 b/mlprec/impl/solver/mld_s_diag_solver_bld.f90 index 9b9db3a9..b3ab0c4d 100644 --- a/mlprec/impl/solver/mld_s_diag_solver_bld.f90 +++ b/mlprec/impl/solver/mld_s_diag_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_s_diag_solver, mld_protect_name => mld_s_diag_solver_bld @@ -45,13 +45,14 @@ subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_s_diag_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_s_diag_solver_cnv.f90 b/mlprec/impl/solver/mld_s_diag_solver_cnv.f90 new file mode 100644 index 00000000..fbcae73f --- /dev/null +++ b/mlprec/impl/solver/mld_s_diag_solver_cnv.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,2013 +!!$ +!!$ 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_diag_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_s_diag_solver, mld_protect_name => mld_s_diag_solver_cnv + + Implicit None + + ! Arguments + class(mld_s_diag_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: err_act, debug_unit, debug_level + character(len=20) :: name='d_diag_solver_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' start' + + + if (allocated(sv%dv)) then + call sv%dv%cnv(vmold) + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' end' + + 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_diag_solver_cnv diff --git a/mlprec/impl/solver/mld_s_ilu_solver_bld.f90 b/mlprec/impl/solver/mld_s_ilu_solver_bld.f90 index 42147c72..23788d67 100644 --- a/mlprec/impl/solver/mld_s_ilu_solver_bld.f90 +++ b/mlprec/impl/solver/mld_s_ilu_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_bld @@ -45,13 +45,14 @@ subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_s_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota !!$ real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_s_ilu_solver_cnv.f90 b/mlprec/impl/solver/mld_s_ilu_solver_cnv.f90 new file mode 100644 index 00000000..f6f0f6c6 --- /dev/null +++ b/mlprec/impl/solver/mld_s_ilu_solver_cnv.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,2013 +!!$ +!!$ 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_ilu_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_cnv + + Implicit None + + ! Arguments + class(mld_s_ilu_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: err_act, debug_unit, debug_level + character(len=20) :: name='d_ilu_solver_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + call sv%dv%cnv(mold=vmold) + + if (present(amold)) then + call sv%l%cscnv(info,mold=amold) + call sv%u%cscnv(info,mold=amold) + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' end' + + 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_ilu_solver_cnv diff --git a/mlprec/impl/solver/mld_z_base_solver_bld.f90 b/mlprec/impl/solver/mld_z_base_solver_bld.f90 index 65a593c4..eb38916e 100644 --- a/mlprec/impl/solver/mld_z_base_solver_bld.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_bld.f90 @@ -36,20 +36,21 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_z_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_z_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_bld Implicit None ! Arguments type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_z_base_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_bld' diff --git a/mlprec/impl/solver/mld_z_base_solver_cnv.f90 b/mlprec/impl/solver/mld_z_base_solver_cnv.f90 new file mode 100644 index 00000000..01c15785 --- /dev/null +++ b/mlprec/impl/solver/mld_z_base_solver_cnv.f90 @@ -0,0 +1,68 @@ +!!$ +!!$ +!!$ 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,2013 +!!$ +!!$ 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_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_cnv + Implicit None + ! Arguments + class(mld_z_base_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_cnv' + + call psb_erractionsave(err_act) + + info = psb_success_ + + 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_cnv diff --git a/mlprec/impl/solver/mld_z_diag_solver_bld.f90 b/mlprec/impl/solver/mld_z_diag_solver_bld.f90 index 1aabba32..70099cf9 100644 --- a/mlprec/impl/solver/mld_z_diag_solver_bld.f90 +++ b/mlprec/impl/solver/mld_z_diag_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_z_diag_solver, mld_protect_name => mld_z_diag_solver_bld @@ -45,13 +45,14 @@ subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_z_diag_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_z_diag_solver_cnv.f90 b/mlprec/impl/solver/mld_z_diag_solver_cnv.f90 new file mode 100644 index 00000000..090dfee3 --- /dev/null +++ b/mlprec/impl/solver/mld_z_diag_solver_cnv.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,2013 +!!$ +!!$ 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_diag_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_z_diag_solver, mld_protect_name => mld_z_diag_solver_cnv + + Implicit None + + ! Arguments + class(mld_z_diag_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: err_act, debug_unit, debug_level + character(len=20) :: name='d_diag_solver_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' start' + + + if (allocated(sv%dv)) then + call sv%dv%cnv(vmold) + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' end' + + 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_diag_solver_cnv diff --git a/mlprec/impl/solver/mld_z_ilu_solver_bld.f90 b/mlprec/impl/solver/mld_z_ilu_solver_bld.f90 index 645d6a54..5194d27e 100644 --- a/mlprec/impl/solver/mld_z_ilu_solver_bld.f90 +++ b/mlprec/impl/solver/mld_z_ilu_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_bld @@ -45,13 +45,14 @@ subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_z_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota !!$ complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/solver/mld_z_ilu_solver_cnv.f90 b/mlprec/impl/solver/mld_z_ilu_solver_cnv.f90 new file mode 100644 index 00000000..8a351f43 --- /dev/null +++ b/mlprec/impl/solver/mld_z_ilu_solver_cnv.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,2013 +!!$ +!!$ 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_ilu_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_cnv + + Implicit None + + ! Arguments + class(mld_z_ilu_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + ! Local variables + integer(psb_ipk_) :: err_act, debug_unit, debug_level + character(len=20) :: name='d_ilu_solver_cnv', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + + call sv%dv%cnv(mold=vmold) + + if (present(amold)) then + call sv%l%cscnv(info,mold=amold) + call sv%u%cscnv(info,mold=amold) + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) trim(name),' end' + + 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_ilu_solver_cnv diff --git a/mlprec/mld_c_as_smoother.f90 b/mlprec/mld_c_as_smoother.f90 index 5428359d..00d2dfad 100644 --- a/mlprec/mld_c_as_smoother.f90 +++ b/mlprec/mld_c_as_smoother.f90 @@ -58,6 +58,7 @@ module mld_c_as_smoother procedure, pass(sm) :: check => mld_c_as_smoother_check procedure, pass(sm) :: dump => mld_c_as_smoother_dmp procedure, pass(sm) :: build => mld_c_as_smoother_bld + procedure, pass(sm) :: cnv => mld_c_as_smoother_cnv procedure, pass(sm) :: clone => mld_c_as_smoother_clone procedure, pass(sm) :: apply_v => mld_c_as_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_c_as_smoother_apply @@ -95,9 +96,11 @@ module mld_c_as_smoother end interface interface - subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,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_ + & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, & + & psb_desc_type, psb_ipk_ implicit none type(psb_desc_type), intent(in) :: desc_data class(mld_c_as_smoother_type), intent(inout) :: sm @@ -112,9 +115,11 @@ module mld_c_as_smoother end interface interface - subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,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_ + & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_,& + & psb_desc_type, psb_ipk_ implicit none type(psb_desc_type), intent(in) :: desc_data class(mld_c_as_smoother_type), intent(inout) :: sm @@ -129,21 +134,37 @@ module mld_c_as_smoother end interface interface - subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) 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_c_base_sparse_mat, psb_ipk_ + & psb_desc_type, psb_c_base_sparse_mat, psb_ipk_,& + & psb_i_base_vect_type implicit none type(psb_cspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a - class(mld_c_as_smoother_type), intent(inout) :: sm + class(mld_c_as_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_c_as_smoother_bld end interface + interface + subroutine mld_c_as_smoother_cnv(sm,info,amold,vmold,imold) + import :: psb_c_base_vect_type, & + & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, & + & psb_c_base_sparse_mat, psb_ipk_, psb_i_base_vect_type + implicit none + class(mld_c_as_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_c_as_smoother_cnv + end interface + interface subroutine mld_c_as_smoother_seti(sm,what,val,info) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & diff --git a/mlprec/mld_c_base_smoother_mod.f90 b/mlprec/mld_c_base_smoother_mod.f90 index ed154f17..ec6f5958 100644 --- a/mlprec/mld_c_base_smoother_mod.f90 +++ b/mlprec/mld_c_base_smoother_mod.f90 @@ -55,7 +55,8 @@ module mld_c_base_smoother_mod use mld_c_base_solver_mod use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_long_int_k_,& - & psb_c_vect_type, psb_c_base_vect_type, psb_c_base_sparse_mat, psb_spk_ + & psb_c_vect_type, psb_c_base_vect_type, psb_c_base_sparse_mat, & + & psb_spk_, psb_i_base_vect_type ! ! @@ -96,6 +97,7 @@ module mld_c_base_smoother_mod procedure, pass(sm) :: dump => mld_c_base_smoother_dmp procedure, pass(sm) :: clone => mld_c_base_smoother_clone procedure, pass(sm) :: build => mld_c_base_smoother_bld + procedure, pass(sm) :: cnv => mld_c_base_smoother_cnv procedure, pass(sm) :: apply_v => mld_c_base_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_c_base_smoother_apply generic, public :: apply => apply_a, apply_v @@ -122,7 +124,8 @@ module mld_c_base_smoother_mod interface - subroutine mld_c_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_c_base_smoother_apply(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,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_ @@ -244,10 +247,10 @@ module mld_c_base_smoother_mod end interface interface - subroutine mld_c_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_c_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) 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_ + & mld_c_base_smoother_type, psb_ipk_, psb_i_base_vect_type ! Arguments type(psb_cspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a @@ -256,9 +259,23 @@ module mld_c_base_smoother_mod integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_c_base_smoother_bld end interface + interface + subroutine mld_c_base_smoother_cnv(sm,info,amold,vmold,imold) + import :: psb_c_base_sparse_mat, psb_c_base_vect_type, psb_spk_, & + & mld_c_base_smoother_type, psb_ipk_, psb_i_base_vect_type + ! Arguments + class(mld_c_base_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_c_base_smoother_cnv + end interface + interface subroutine mld_c_base_smoother_free(sm,info) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & diff --git a/mlprec/mld_c_base_solver_mod.f90 b/mlprec/mld_c_base_solver_mod.f90 index 5762113c..e8722500 100644 --- a/mlprec/mld_c_base_solver_mod.f90 +++ b/mlprec/mld_c_base_solver_mod.f90 @@ -55,7 +55,8 @@ module mld_c_base_solver_mod use mld_base_prec_type use psb_base_mod, only : psb_cspmat_type, & - & psb_c_vect_type, psb_c_base_vect_type, psb_c_base_sparse_mat + & psb_c_vect_type, psb_c_base_vect_type, psb_c_base_sparse_mat, & + & psb_i_base_vect_type ! ! ! Type: mld_T_base_solver_type. @@ -88,6 +89,7 @@ module mld_c_base_solver_mod procedure, pass(sv) :: dump => mld_c_base_solver_dmp procedure, pass(sv) :: clone => mld_c_base_solver_clone procedure, pass(sv) :: build => mld_c_base_solver_bld + procedure, pass(sv) :: cnv => mld_c_base_solver_cnv procedure, pass(sv) :: apply_v => mld_c_base_solver_apply_vect procedure, pass(sv) :: apply_a => mld_c_base_solver_apply generic, public :: apply => apply_a, apply_v @@ -147,24 +149,40 @@ module mld_c_base_solver_mod end interface interface - subroutine mld_c_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_c_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) 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_ + & mld_c_base_solver_type, psb_ipk_, psb_i_base_vect_type Implicit None ! Arguments - type(psb_cspmat_type), intent(in), target :: a + type(psb_cspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(in) :: desc_a - class(mld_c_base_solver_type), intent(inout) :: sv + class(mld_c_base_solver_type), intent(inout) :: sv character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info - type(psb_cspmat_type), intent(in), target, optional :: b - class(psb_c_base_sparse_mat), intent(in), optional :: amold - class(psb_c_base_vect_type), intent(in), optional :: vmold + type(psb_cspmat_type), intent(in), target, optional :: b + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_c_base_solver_bld end interface + interface + subroutine mld_c_base_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_c_base_sparse_mat, psb_c_base_vect_type, psb_spk_, & + & mld_c_base_solver_type, psb_ipk_, psb_i_base_vect_type + Implicit None + + ! Arguments + class(mld_c_base_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_c_base_solver_cnv + end interface + interface subroutine mld_c_base_solver_check(sv,info) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & @@ -173,7 +191,7 @@ module mld_c_base_solver_mod Implicit None ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv + class(mld_c_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(out) :: info end subroutine mld_c_base_solver_check end interface @@ -186,7 +204,7 @@ module mld_c_base_solver_mod Implicit None ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv + class(mld_c_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info @@ -201,7 +219,7 @@ module mld_c_base_solver_mod Implicit None ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv + class(mld_c_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info @@ -215,7 +233,7 @@ module mld_c_base_solver_mod & mld_c_base_solver_type, psb_ipk_ Implicit None ! Arguments - class(mld_c_base_solver_type), intent(inout) :: sv + 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 diff --git a/mlprec/mld_c_diag_solver.f90 b/mlprec/mld_c_diag_solver.f90 index f0e551b1..47205ccb 100644 --- a/mlprec/mld_c_diag_solver.f90 +++ b/mlprec/mld_c_diag_solver.f90 @@ -52,6 +52,7 @@ module mld_c_diag_solver complex(psb_spk_), allocatable :: d(:) contains procedure, pass(sv) :: build => mld_c_diag_solver_bld + procedure, pass(sv) :: cnv => mld_c_diag_solver_cnv procedure, pass(sv) :: clone => mld_c_diag_solver_clone procedure, pass(sv) :: apply_v => mld_c_diag_solver_apply_vect procedure, pass(sv) :: apply_a => mld_c_diag_solver_apply @@ -69,7 +70,8 @@ module mld_c_diag_solver interface - subroutine mld_c_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) + subroutine mld_c_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& + & trans,work,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_diag_solver_type, psb_ipk_ @@ -101,10 +103,10 @@ module mld_c_diag_solver end interface interface - subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) 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_diag_solver_type, psb_ipk_ + & mld_c_diag_solver_type, psb_ipk_, psb_i_base_vect_type type(psb_cspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(in) :: desc_a class(mld_c_diag_solver_type), intent(inout) :: sv @@ -113,8 +115,21 @@ module mld_c_diag_solver type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_c_diag_solver_bld end interface + + interface + subroutine mld_c_diag_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_c_base_sparse_mat, psb_c_base_vect_type, psb_spk_, & + & mld_c_diag_solver_type, psb_ipk_, psb_i_base_vect_type + class(mld_c_diag_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_c_diag_solver_cnv + end interface interface subroutine mld_c_diag_solver_clone(sv,svout,info) diff --git a/mlprec/mld_c_id_solver.f90 b/mlprec/mld_c_id_solver.f90 index 8b3e1fd0..a2562fa0 100644 --- a/mlprec/mld_c_id_solver.f90 +++ b/mlprec/mld_c_id_solver.f90 @@ -112,19 +112,20 @@ module mld_c_id_solver contains - subroutine c_id_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine c_id_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) Implicit None ! Arguments type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_c_id_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/mld_c_ilu_solver.f90 b/mlprec/mld_c_ilu_solver.f90 index f3cc98c4..271c3d67 100644 --- a/mlprec/mld_c_ilu_solver.f90 +++ b/mlprec/mld_c_ilu_solver.f90 @@ -58,6 +58,7 @@ module mld_c_ilu_solver procedure, pass(sv) :: dump => mld_c_ilu_solver_dmp procedure, pass(sv) :: clone => mld_c_ilu_solver_clone procedure, pass(sv) :: build => mld_c_ilu_solver_bld + procedure, pass(sv) :: cnv => mld_c_ilu_solver_cnv procedure, pass(sv) :: apply_v => mld_c_ilu_solver_apply_vect procedure, pass(sv) :: apply_a => mld_c_ilu_solver_apply procedure, pass(sv) :: free => c_ilu_solver_free @@ -126,20 +127,36 @@ module mld_c_ilu_solver end interface interface - subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) import :: psb_desc_type, mld_c_ilu_solver_type, psb_c_vect_type, psb_spk_, & - & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_ + & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type implicit none type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_c_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_c_ilu_solver_bld end interface + + interface + subroutine mld_c_ilu_solver_cnv(sv,info,amold,vmold,imold) + import :: mld_c_ilu_solver_type, psb_spk_, & + & psb_c_base_sparse_mat, psb_c_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type + implicit none + class(mld_c_ilu_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_c_ilu_solver_cnv + end interface interface subroutine mld_c_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) diff --git a/mlprec/mld_c_jac_smoother.f90 b/mlprec/mld_c_jac_smoother.f90 index f3e3be73..c8ad338c 100644 --- a/mlprec/mld_c_jac_smoother.f90 +++ b/mlprec/mld_c_jac_smoother.f90 @@ -55,6 +55,7 @@ module mld_c_jac_smoother integer(psb_ipk_) :: nnz_nd_tot contains procedure, pass(sm) :: build => mld_c_jac_smoother_bld + procedure, pass(sm) :: cnv => mld_c_jac_smoother_cnv procedure, pass(sm) :: clone => mld_c_jac_smoother_clone procedure, pass(sm) :: apply_v => mld_c_jac_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_c_jac_smoother_apply @@ -72,9 +73,11 @@ module mld_c_jac_smoother interface - subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& + & sweeps,work,info) import :: psb_desc_type, mld_c_jac_smoother_type, psb_c_vect_type, psb_spk_, & - & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_ + & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,& + & psb_ipk_ type(psb_desc_type), intent(in) :: desc_data class(mld_c_jac_smoother_type), intent(inout) :: sm @@ -89,9 +92,11 @@ module mld_c_jac_smoother end interface interface - subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,& + & sweeps,work,info) import :: psb_desc_type, mld_c_jac_smoother_type, psb_c_vect_type, psb_spk_, & - & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_ + & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, & + & psb_ipk_ type(psb_desc_type), intent(in) :: desc_data class(mld_c_jac_smoother_type), intent(inout) :: sm complex(psb_spk_),intent(inout) :: x(:) @@ -105,19 +110,34 @@ module mld_c_jac_smoother end interface interface - subroutine mld_c_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_c_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) import :: psb_desc_type, mld_c_jac_smoother_type, psb_c_vect_type, psb_spk_, & - & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_ - type(psb_cspmat_type), intent(in), target :: a + & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type + type(psb_cspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a - class(mld_c_jac_smoother_type), intent(inout) :: sm + class(mld_c_jac_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_c_jac_smoother_bld end interface + interface + subroutine mld_c_jac_smoother_cnv(sm,info,amold,vmold,imold) + import :: mld_c_jac_smoother_type, psb_spk_, & + & psb_c_base_sparse_mat, psb_c_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type + class(mld_c_jac_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_c_jac_smoother_cnv + end interface + interface subroutine mld_c_jac_smoother_clone(sm,smout,info) import :: mld_c_jac_smoother_type, psb_spk_, & diff --git a/mlprec/mld_c_onelev_mod.f90 b/mlprec/mld_c_onelev_mod.f90 index ff05b488..02f9206e 100644 --- a/mlprec/mld_c_onelev_mod.f90 +++ b/mlprec/mld_c_onelev_mod.f90 @@ -56,8 +56,9 @@ module mld_c_onelev_mod use mld_base_prec_type use mld_c_base_smoother_mod - use psb_base_mod, only : psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & - & psb_clinmap_type, psb_spk_, psb_ipk_, psb_long_int_k_, psb_desc_type + use psb_base_mod, only : psb_cspmat_type, psb_c_vect_type, & + & psb_c_base_vect_type, psb_clinmap_type, psb_spk_, & + & psb_ipk_, psb_long_int_k_, psb_desc_type, psb_i_base_vect_type ! ! ! Type: mld_Tonelev_type. @@ -128,6 +129,7 @@ module mld_c_onelev_mod type(psb_clinmap_type) :: map contains procedure, pass(lv) :: clone => c_base_onelev_clone + procedure, pass(lv) :: cnv => mld_c_base_onelev_cnv procedure, pass(lv) :: descr => mld_c_base_onelev_descr procedure, pass(lv) :: default => c_base_onelev_default procedure, pass(lv) :: free => mld_c_base_onelev_free @@ -170,7 +172,20 @@ module mld_c_onelev_mod integer(psb_ipk_), intent(in), optional :: iout end subroutine mld_c_base_onelev_descr end interface - + + interface + subroutine mld_c_base_onelev_cnv(lv,info,amold,vmold,imold) + import :: mld_c_onelev_type, psb_c_base_vect_type, psb_spk_, & + & psb_c_base_sparse_mat, psb_ipk_, psb_i_base_vect_type + ! Arguments + class(mld_c_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + class(psb_c_base_sparse_mat), intent(in), optional :: amold + class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_c_base_onelev_cnv + end interface + interface subroutine mld_c_base_onelev_free(lv,info) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & diff --git a/mlprec/mld_c_slu_solver.F90 b/mlprec/mld_c_slu_solver.F90 index 80c8b53b..91826127 100644 --- a/mlprec/mld_c_slu_solver.F90 +++ b/mlprec/mld_c_slu_solver.F90 @@ -241,7 +241,7 @@ contains end subroutine c_slu_solver_apply_vect - subroutine c_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine c_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -256,6 +256,7 @@ contains type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_cspmat_type) :: atmp type(psb_c_csr_sparse_mat) :: acsr diff --git a/mlprec/mld_c_sludist_solver.F90 b/mlprec/mld_c_sludist_solver.F90 index fac53f56..03d75921 100644 --- a/mlprec/mld_c_sludist_solver.F90 +++ b/mlprec/mld_c_sludist_solver.F90 @@ -237,7 +237,7 @@ contains end subroutine c_sludist_solver_apply_vect - subroutine c_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine c_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -252,6 +252,7 @@ contains type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_cspmat_type) :: atmp type(psb_c_csr_sparse_mat) :: acsr diff --git a/mlprec/mld_c_umf_solver.F90 b/mlprec/mld_c_umf_solver.F90 index 15a3a1b8..065be919 100644 --- a/mlprec/mld_c_umf_solver.F90 +++ b/mlprec/mld_c_umf_solver.F90 @@ -245,7 +245,7 @@ contains end subroutine c_umf_solver_apply_vect - subroutine c_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine c_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -260,6 +260,7 @@ contains type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_cspmat_type) :: atmp type(psb_c_csc_sparse_mat) :: acsc diff --git a/mlprec/mld_d_as_smoother.f90 b/mlprec/mld_d_as_smoother.f90 index 1bc2fce9..e2c03c84 100644 --- a/mlprec/mld_d_as_smoother.f90 +++ b/mlprec/mld_d_as_smoother.f90 @@ -97,9 +97,10 @@ module mld_d_as_smoother interface subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,& - & trans,sweeps,work,info) + & trans,sweeps,work,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_ + & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, & + & psb_desc_type, psb_ipk_ implicit none type(psb_desc_type), intent(in) :: desc_data class(mld_d_as_smoother_type), intent(inout) :: sm @@ -114,9 +115,11 @@ module mld_d_as_smoother end interface interface - subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,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_ + & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_,& + & psb_desc_type, psb_ipk_ implicit none type(psb_desc_type), intent(in) :: desc_data class(mld_d_as_smoother_type), intent(inout) :: sm @@ -139,7 +142,7 @@ module mld_d_as_smoother implicit none type(psb_dspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a - class(mld_d_as_smoother_type), intent(inout) :: sm + class(mld_d_as_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info class(psb_d_base_sparse_mat), intent(in), optional :: amold @@ -147,21 +150,21 @@ module mld_d_as_smoother class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_d_as_smoother_bld end interface - - interface + + interface subroutine mld_d_as_smoother_cnv(sm,info,amold,vmold,imold) - 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_as_smoother_type, psb_ipk_, psb_i_base_vect_type - ! Arguments - class(mld_d_as_smoother_type), intent(inout) :: sm - integer(psb_ipk_), intent(out) :: info + import :: psb_d_base_vect_type, & + & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, & + & psb_d_base_sparse_mat, psb_ipk_, psb_i_base_vect_type + implicit none + class(mld_d_as_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_d_as_smoother_cnv end interface - + interface subroutine mld_d_as_smoother_seti(sm,what,val,info) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & diff --git a/mlprec/mld_d_base_smoother_mod.f90 b/mlprec/mld_d_base_smoother_mod.f90 index c3482ba6..b531aacf 100644 --- a/mlprec/mld_d_base_smoother_mod.f90 +++ b/mlprec/mld_d_base_smoother_mod.f90 @@ -55,8 +55,8 @@ module mld_d_base_smoother_mod use mld_d_base_solver_mod use psb_base_mod, only : psb_desc_type, psb_dspmat_type, psb_long_int_k_,& - & psb_d_vect_type, psb_d_base_vect_type, psb_d_base_sparse_mat, psb_dpk_,& - & psb_i_base_vect_type + & psb_d_vect_type, psb_d_base_vect_type, psb_d_base_sparse_mat, & + & psb_dpk_, psb_i_base_vect_type ! ! @@ -124,7 +124,7 @@ module mld_d_base_smoother_mod interface - subroutine mld_d_base_smoother_apply(alpha,sm,x,beta,y,desc_data,& + subroutine mld_d_base_smoother_apply(alpha,sm,x,beta,y,desc_data,& & trans,sweeps,work,info) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & @@ -247,8 +247,7 @@ module mld_d_base_smoother_mod end interface interface - subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,& - & amold,vmold,imold) + subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) 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_, psb_i_base_vect_type @@ -266,8 +265,7 @@ module mld_d_base_smoother_mod interface subroutine mld_d_base_smoother_cnv(sm,info,amold,vmold,imold) - import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & - & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & + import :: psb_d_base_sparse_mat, psb_d_base_vect_type, psb_dpk_, & & mld_d_base_smoother_type, psb_ipk_, psb_i_base_vect_type ! Arguments class(mld_d_base_smoother_type), intent(inout) :: sm diff --git a/mlprec/mld_d_base_solver_mod.f90 b/mlprec/mld_d_base_solver_mod.f90 index a394e5a8..d69a8df5 100644 --- a/mlprec/mld_d_base_solver_mod.f90 +++ b/mlprec/mld_d_base_solver_mod.f90 @@ -55,7 +55,7 @@ module mld_d_base_solver_mod use mld_base_prec_type use psb_base_mod, only : psb_dspmat_type, & - & psb_d_vect_type, psb_d_base_vect_type, psb_d_base_sparse_mat,& + & psb_d_vect_type, psb_d_base_vect_type, psb_d_base_sparse_mat, & & psb_i_base_vect_type ! ! @@ -156,15 +156,15 @@ module mld_d_base_solver_mod Implicit None ! Arguments - type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a - class(mld_d_base_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info - type(psb_dspmat_type), intent(in), target, optional :: b - class(psb_d_base_sparse_mat), intent(in), optional :: amold - class(psb_d_base_vect_type), intent(in), optional :: vmold - class(psb_i_base_vect_type), intent(in), optional :: imold + type(psb_dspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(in) :: desc_a + class(mld_d_base_solver_type), intent(inout) :: sv + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info + type(psb_dspmat_type), intent(in), target, optional :: b + class(psb_d_base_sparse_mat), intent(in), optional :: amold + class(psb_d_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_d_base_solver_bld end interface @@ -172,13 +172,14 @@ module mld_d_base_solver_mod subroutine mld_d_base_solver_cnv(sv,info,amold,vmold,imold) import :: psb_d_base_sparse_mat, psb_d_base_vect_type, psb_dpk_, & & mld_d_base_solver_type, psb_ipk_, psb_i_base_vect_type - Implicit None + Implicit None + ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(out) :: info - class(psb_d_base_sparse_mat), intent(in), optional :: amold - class(psb_d_base_vect_type), intent(in), optional :: vmold - class(psb_i_base_vect_type), intent(in), optional :: imold + class(mld_d_base_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_d_base_sparse_mat), intent(in), optional :: amold + class(psb_d_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_d_base_solver_cnv end interface @@ -190,7 +191,7 @@ module mld_d_base_solver_mod Implicit None ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv + class(mld_d_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(out) :: info end subroutine mld_d_base_solver_check end interface @@ -203,7 +204,7 @@ module mld_d_base_solver_mod Implicit None ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv + class(mld_d_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info @@ -218,7 +219,7 @@ module mld_d_base_solver_mod Implicit None ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv + class(mld_d_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info @@ -232,7 +233,7 @@ module mld_d_base_solver_mod & mld_d_base_solver_type, psb_ipk_ Implicit None ! Arguments - class(mld_d_base_solver_type), intent(inout) :: sv + 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 diff --git a/mlprec/mld_d_diag_solver.f90 b/mlprec/mld_d_diag_solver.f90 index 48a76ed7..19aa31f7 100644 --- a/mlprec/mld_d_diag_solver.f90 +++ b/mlprec/mld_d_diag_solver.f90 @@ -70,7 +70,7 @@ module mld_d_diag_solver interface - subroutine mld_d_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& + subroutine mld_d_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& & trans,work,info) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & @@ -108,10 +108,10 @@ module mld_d_diag_solver & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & & mld_d_diag_solver_type, psb_ipk_, psb_i_base_vect_type type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_d_diag_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold @@ -121,11 +121,10 @@ module mld_d_diag_solver interface subroutine mld_d_diag_solver_cnv(sv,info,amold,vmold,imold) - import :: psb_desc_type, psb_d_base_sparse_mat, & - & psb_d_base_vect_type, psb_dpk_, & + import :: psb_d_base_sparse_mat, psb_d_base_vect_type, psb_dpk_, & & mld_d_diag_solver_type, psb_ipk_, psb_i_base_vect_type class(mld_d_diag_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_i_base_vect_type), intent(in), optional :: imold diff --git a/mlprec/mld_d_id_solver.f90 b/mlprec/mld_d_id_solver.f90 index 2f896e8f..20ff7b28 100644 --- a/mlprec/mld_d_id_solver.f90 +++ b/mlprec/mld_d_id_solver.f90 @@ -118,14 +118,14 @@ contains ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_d_id_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold - class(psb_i_base_vect_type), intent(in), optional :: imold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/mld_d_ilu_solver.f90 b/mlprec/mld_d_ilu_solver.f90 index 19267f92..65769912 100644 --- a/mlprec/mld_d_ilu_solver.f90 +++ b/mlprec/mld_d_ilu_solver.f90 @@ -133,28 +133,28 @@ module mld_d_ilu_solver & psb_ipk_, psb_i_base_vect_type implicit none type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_d_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold - class(psb_i_base_vect_type), intent(in), optional :: imold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_d_ilu_solver_bld end interface interface subroutine mld_d_ilu_solver_cnv(sv,info,amold,vmold,imold) - import :: psb_desc_type, mld_d_ilu_solver_type, psb_dpk_, & + import :: mld_d_ilu_solver_type, psb_dpk_, & & psb_d_base_sparse_mat, psb_d_base_vect_type,& & psb_ipk_, psb_i_base_vect_type implicit none class(mld_d_ilu_solver_type), intent(inout) :: sv - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold - class(psb_i_base_vect_type), intent(in), optional :: imold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_d_ilu_solver_cnv end interface diff --git a/mlprec/mld_d_jac_smoother.f90 b/mlprec/mld_d_jac_smoother.f90 index bcf40c9f..3f52618b 100644 --- a/mlprec/mld_d_jac_smoother.f90 +++ b/mlprec/mld_d_jac_smoother.f90 @@ -55,8 +55,8 @@ module mld_d_jac_smoother integer(psb_ipk_) :: nnz_nd_tot contains procedure, pass(sm) :: build => mld_d_jac_smoother_bld - procedure, pass(sm) :: clone => mld_d_jac_smoother_clone procedure, pass(sm) :: cnv => mld_d_jac_smoother_cnv + procedure, pass(sm) :: clone => mld_d_jac_smoother_clone procedure, pass(sm) :: apply_v => mld_d_jac_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_d_jac_smoother_apply procedure, pass(sm) :: free => d_jac_smoother_free @@ -73,10 +73,11 @@ module mld_d_jac_smoother interface - subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,& - & trans,sweeps,work,info) + subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& + & sweeps,work,info) import :: psb_desc_type, mld_d_jac_smoother_type, psb_d_vect_type, psb_dpk_, & - & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_ + & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,& + & psb_ipk_ type(psb_desc_type), intent(in) :: desc_data class(mld_d_jac_smoother_type), intent(inout) :: sm @@ -91,10 +92,11 @@ module mld_d_jac_smoother end interface interface - subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,& - & trans,sweeps,work,info) + subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,& + & sweeps,work,info) import :: psb_desc_type, mld_d_jac_smoother_type, psb_d_vect_type, psb_dpk_, & - & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_ + & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, & + & psb_ipk_ type(psb_desc_type), intent(in) :: desc_data class(mld_d_jac_smoother_type), intent(inout) :: sm real(psb_dpk_),intent(inout) :: x(:) @@ -112,9 +114,9 @@ module mld_d_jac_smoother import :: psb_desc_type, mld_d_jac_smoother_type, psb_d_vect_type, psb_dpk_, & & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,& & psb_ipk_, psb_i_base_vect_type - type(psb_dspmat_type), intent(in), target :: a + type(psb_dspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a - class(mld_d_jac_smoother_type), intent(inout) :: sm + class(mld_d_jac_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info class(psb_d_base_sparse_mat), intent(in), optional :: amold @@ -125,10 +127,10 @@ module mld_d_jac_smoother interface subroutine mld_d_jac_smoother_cnv(sm,info,amold,vmold,imold) - import :: psb_desc_type, mld_d_jac_smoother_type, psb_d_vect_type, psb_dpk_, & - & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,& + import :: mld_d_jac_smoother_type, psb_dpk_, & + & psb_d_base_sparse_mat, psb_d_base_vect_type,& & psb_ipk_, psb_i_base_vect_type - class(mld_d_jac_smoother_type), intent(inout) :: sm + class(mld_d_jac_smoother_type), intent(inout) :: sm integer(psb_ipk_), intent(out) :: info class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold diff --git a/mlprec/mld_d_onelev_mod.f90 b/mlprec/mld_d_onelev_mod.f90 index cf045f46..9e5cc0c1 100644 --- a/mlprec/mld_d_onelev_mod.f90 +++ b/mlprec/mld_d_onelev_mod.f90 @@ -56,9 +56,9 @@ module mld_d_onelev_mod use mld_base_prec_type use mld_d_base_smoother_mod - use psb_base_mod, only : psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dlinmap_type, psb_dpk_, psb_ipk_, psb_long_int_k_,& - & psb_desc_type, psb_i_base_vect_type + use psb_base_mod, only : psb_dspmat_type, psb_d_vect_type, & + & psb_d_base_vect_type, psb_dlinmap_type, psb_dpk_, & + & psb_ipk_, psb_long_int_k_, psb_desc_type, psb_i_base_vect_type ! ! ! Type: mld_Tonelev_type. @@ -185,7 +185,7 @@ module mld_d_onelev_mod class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_d_base_onelev_cnv end interface - + interface subroutine mld_d_base_onelev_free(lv,info) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & diff --git a/mlprec/mld_s_as_smoother.f90 b/mlprec/mld_s_as_smoother.f90 index 287c1bec..fd49a067 100644 --- a/mlprec/mld_s_as_smoother.f90 +++ b/mlprec/mld_s_as_smoother.f90 @@ -58,6 +58,7 @@ module mld_s_as_smoother procedure, pass(sm) :: check => mld_s_as_smoother_check procedure, pass(sm) :: dump => mld_s_as_smoother_dmp procedure, pass(sm) :: build => mld_s_as_smoother_bld + procedure, pass(sm) :: cnv => mld_s_as_smoother_cnv procedure, pass(sm) :: clone => mld_s_as_smoother_clone procedure, pass(sm) :: apply_v => mld_s_as_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_s_as_smoother_apply @@ -95,9 +96,11 @@ module mld_s_as_smoother end interface interface - subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,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_ + & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, & + & psb_desc_type, psb_ipk_ implicit none type(psb_desc_type), intent(in) :: desc_data class(mld_s_as_smoother_type), intent(inout) :: sm @@ -112,9 +115,11 @@ module mld_s_as_smoother end interface interface - subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,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_ + & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_,& + & psb_desc_type, psb_ipk_ implicit none type(psb_desc_type), intent(in) :: desc_data class(mld_s_as_smoother_type), intent(inout) :: sm @@ -129,21 +134,37 @@ module mld_s_as_smoother end interface interface - subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) 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_s_base_sparse_mat, psb_ipk_ + & psb_desc_type, psb_s_base_sparse_mat, psb_ipk_,& + & psb_i_base_vect_type implicit none type(psb_sspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a - class(mld_s_as_smoother_type), intent(inout) :: sm + class(mld_s_as_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_s_as_smoother_bld end interface + interface + subroutine mld_s_as_smoother_cnv(sm,info,amold,vmold,imold) + import :: psb_s_base_vect_type, & + & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, & + & psb_s_base_sparse_mat, psb_ipk_, psb_i_base_vect_type + implicit none + class(mld_s_as_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_s_as_smoother_cnv + end interface + interface subroutine mld_s_as_smoother_seti(sm,what,val,info) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & diff --git a/mlprec/mld_s_base_smoother_mod.f90 b/mlprec/mld_s_base_smoother_mod.f90 index 688b7004..d5db07a3 100644 --- a/mlprec/mld_s_base_smoother_mod.f90 +++ b/mlprec/mld_s_base_smoother_mod.f90 @@ -55,7 +55,8 @@ module mld_s_base_smoother_mod use mld_s_base_solver_mod use psb_base_mod, only : psb_desc_type, psb_sspmat_type, psb_long_int_k_,& - & psb_s_vect_type, psb_s_base_vect_type, psb_s_base_sparse_mat, psb_spk_ + & psb_s_vect_type, psb_s_base_vect_type, psb_s_base_sparse_mat, & + & psb_spk_, psb_i_base_vect_type ! ! @@ -96,6 +97,7 @@ module mld_s_base_smoother_mod procedure, pass(sm) :: dump => mld_s_base_smoother_dmp procedure, pass(sm) :: clone => mld_s_base_smoother_clone procedure, pass(sm) :: build => mld_s_base_smoother_bld + procedure, pass(sm) :: cnv => mld_s_base_smoother_cnv procedure, pass(sm) :: apply_v => mld_s_base_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_s_base_smoother_apply generic, public :: apply => apply_a, apply_v @@ -122,7 +124,8 @@ module mld_s_base_smoother_mod interface - subroutine mld_s_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_s_base_smoother_apply(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,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_ @@ -244,10 +247,10 @@ module mld_s_base_smoother_mod end interface interface - subroutine mld_s_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_s_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) 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_ + & mld_s_base_smoother_type, psb_ipk_, psb_i_base_vect_type ! Arguments type(psb_sspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a @@ -256,9 +259,23 @@ module mld_s_base_smoother_mod integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_s_base_smoother_bld end interface + interface + subroutine mld_s_base_smoother_cnv(sm,info,amold,vmold,imold) + import :: psb_s_base_sparse_mat, psb_s_base_vect_type, psb_spk_, & + & mld_s_base_smoother_type, psb_ipk_, psb_i_base_vect_type + ! Arguments + class(mld_s_base_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_s_base_smoother_cnv + end interface + interface subroutine mld_s_base_smoother_free(sm,info) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & diff --git a/mlprec/mld_s_base_solver_mod.f90 b/mlprec/mld_s_base_solver_mod.f90 index a2226e53..82b966f6 100644 --- a/mlprec/mld_s_base_solver_mod.f90 +++ b/mlprec/mld_s_base_solver_mod.f90 @@ -55,7 +55,8 @@ module mld_s_base_solver_mod use mld_base_prec_type use psb_base_mod, only : psb_sspmat_type, & - & psb_s_vect_type, psb_s_base_vect_type, psb_s_base_sparse_mat + & psb_s_vect_type, psb_s_base_vect_type, psb_s_base_sparse_mat, & + & psb_i_base_vect_type ! ! ! Type: mld_T_base_solver_type. @@ -88,6 +89,7 @@ module mld_s_base_solver_mod procedure, pass(sv) :: dump => mld_s_base_solver_dmp procedure, pass(sv) :: clone => mld_s_base_solver_clone procedure, pass(sv) :: build => mld_s_base_solver_bld + procedure, pass(sv) :: cnv => mld_s_base_solver_cnv procedure, pass(sv) :: apply_v => mld_s_base_solver_apply_vect procedure, pass(sv) :: apply_a => mld_s_base_solver_apply generic, public :: apply => apply_a, apply_v @@ -147,24 +149,40 @@ module mld_s_base_solver_mod end interface interface - subroutine mld_s_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_s_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) 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_ + & mld_s_base_solver_type, psb_ipk_, psb_i_base_vect_type Implicit None ! Arguments - type(psb_sspmat_type), intent(in), target :: a + type(psb_sspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(in) :: desc_a - class(mld_s_base_solver_type), intent(inout) :: sv + class(mld_s_base_solver_type), intent(inout) :: sv character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info - type(psb_sspmat_type), intent(in), target, optional :: b - class(psb_s_base_sparse_mat), intent(in), optional :: amold - class(psb_s_base_vect_type), intent(in), optional :: vmold + type(psb_sspmat_type), intent(in), target, optional :: b + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_s_base_solver_bld end interface + interface + subroutine mld_s_base_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_s_base_sparse_mat, psb_s_base_vect_type, psb_spk_, & + & mld_s_base_solver_type, psb_ipk_, psb_i_base_vect_type + Implicit None + + ! Arguments + class(mld_s_base_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_s_base_solver_cnv + end interface + interface subroutine mld_s_base_solver_check(sv,info) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & @@ -173,7 +191,7 @@ module mld_s_base_solver_mod Implicit None ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv + class(mld_s_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(out) :: info end subroutine mld_s_base_solver_check end interface @@ -186,7 +204,7 @@ module mld_s_base_solver_mod Implicit None ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv + class(mld_s_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info @@ -201,7 +219,7 @@ module mld_s_base_solver_mod Implicit None ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv + class(mld_s_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info @@ -215,7 +233,7 @@ module mld_s_base_solver_mod & mld_s_base_solver_type, psb_ipk_ Implicit None ! Arguments - class(mld_s_base_solver_type), intent(inout) :: sv + 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 diff --git a/mlprec/mld_s_diag_solver.f90 b/mlprec/mld_s_diag_solver.f90 index 8f7d239b..5dc6ac70 100644 --- a/mlprec/mld_s_diag_solver.f90 +++ b/mlprec/mld_s_diag_solver.f90 @@ -52,6 +52,7 @@ module mld_s_diag_solver real(psb_spk_), allocatable :: d(:) contains procedure, pass(sv) :: build => mld_s_diag_solver_bld + procedure, pass(sv) :: cnv => mld_s_diag_solver_cnv procedure, pass(sv) :: clone => mld_s_diag_solver_clone procedure, pass(sv) :: apply_v => mld_s_diag_solver_apply_vect procedure, pass(sv) :: apply_a => mld_s_diag_solver_apply @@ -69,7 +70,8 @@ module mld_s_diag_solver interface - subroutine mld_s_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) + subroutine mld_s_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& + & trans,work,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_diag_solver_type, psb_ipk_ @@ -101,10 +103,10 @@ module mld_s_diag_solver end interface interface - subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) 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_diag_solver_type, psb_ipk_ + & mld_s_diag_solver_type, psb_ipk_, psb_i_base_vect_type type(psb_sspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(in) :: desc_a class(mld_s_diag_solver_type), intent(inout) :: sv @@ -113,8 +115,21 @@ module mld_s_diag_solver type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_s_diag_solver_bld end interface + + interface + subroutine mld_s_diag_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_s_base_sparse_mat, psb_s_base_vect_type, psb_spk_, & + & mld_s_diag_solver_type, psb_ipk_, psb_i_base_vect_type + class(mld_s_diag_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_s_diag_solver_cnv + end interface interface subroutine mld_s_diag_solver_clone(sv,svout,info) diff --git a/mlprec/mld_s_id_solver.f90 b/mlprec/mld_s_id_solver.f90 index 72bed12c..79543bae 100644 --- a/mlprec/mld_s_id_solver.f90 +++ b/mlprec/mld_s_id_solver.f90 @@ -112,19 +112,20 @@ module mld_s_id_solver contains - subroutine s_id_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine s_id_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) Implicit None ! Arguments type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_s_id_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/mld_s_ilu_solver.f90 b/mlprec/mld_s_ilu_solver.f90 index bd096437..84e1090b 100644 --- a/mlprec/mld_s_ilu_solver.f90 +++ b/mlprec/mld_s_ilu_solver.f90 @@ -58,6 +58,7 @@ module mld_s_ilu_solver procedure, pass(sv) :: dump => mld_s_ilu_solver_dmp procedure, pass(sv) :: clone => mld_s_ilu_solver_clone procedure, pass(sv) :: build => mld_s_ilu_solver_bld + procedure, pass(sv) :: cnv => mld_s_ilu_solver_cnv procedure, pass(sv) :: apply_v => mld_s_ilu_solver_apply_vect procedure, pass(sv) :: apply_a => mld_s_ilu_solver_apply procedure, pass(sv) :: free => s_ilu_solver_free @@ -126,20 +127,36 @@ module mld_s_ilu_solver end interface interface - subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) import :: psb_desc_type, mld_s_ilu_solver_type, psb_s_vect_type, psb_spk_, & - & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_ + & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type implicit none type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_s_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_s_ilu_solver_bld end interface + + interface + subroutine mld_s_ilu_solver_cnv(sv,info,amold,vmold,imold) + import :: mld_s_ilu_solver_type, psb_spk_, & + & psb_s_base_sparse_mat, psb_s_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type + implicit none + class(mld_s_ilu_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_s_ilu_solver_cnv + end interface interface subroutine mld_s_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) diff --git a/mlprec/mld_s_jac_smoother.f90 b/mlprec/mld_s_jac_smoother.f90 index f404d1f0..8f463c9c 100644 --- a/mlprec/mld_s_jac_smoother.f90 +++ b/mlprec/mld_s_jac_smoother.f90 @@ -55,6 +55,7 @@ module mld_s_jac_smoother integer(psb_ipk_) :: nnz_nd_tot contains procedure, pass(sm) :: build => mld_s_jac_smoother_bld + procedure, pass(sm) :: cnv => mld_s_jac_smoother_cnv procedure, pass(sm) :: clone => mld_s_jac_smoother_clone procedure, pass(sm) :: apply_v => mld_s_jac_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_s_jac_smoother_apply @@ -72,9 +73,11 @@ module mld_s_jac_smoother interface - subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& + & sweeps,work,info) import :: psb_desc_type, mld_s_jac_smoother_type, psb_s_vect_type, psb_spk_, & - & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_ + & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,& + & psb_ipk_ type(psb_desc_type), intent(in) :: desc_data class(mld_s_jac_smoother_type), intent(inout) :: sm @@ -89,9 +92,11 @@ module mld_s_jac_smoother end interface interface - subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,& + & sweeps,work,info) import :: psb_desc_type, mld_s_jac_smoother_type, psb_s_vect_type, psb_spk_, & - & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_ + & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, & + & psb_ipk_ type(psb_desc_type), intent(in) :: desc_data class(mld_s_jac_smoother_type), intent(inout) :: sm real(psb_spk_),intent(inout) :: x(:) @@ -105,19 +110,34 @@ module mld_s_jac_smoother end interface interface - subroutine mld_s_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_s_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) import :: psb_desc_type, mld_s_jac_smoother_type, psb_s_vect_type, psb_spk_, & - & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_ - type(psb_sspmat_type), intent(in), target :: a + & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type + type(psb_sspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a - class(mld_s_jac_smoother_type), intent(inout) :: sm + class(mld_s_jac_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_s_jac_smoother_bld end interface + interface + subroutine mld_s_jac_smoother_cnv(sm,info,amold,vmold,imold) + import :: mld_s_jac_smoother_type, psb_spk_, & + & psb_s_base_sparse_mat, psb_s_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type + class(mld_s_jac_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_s_jac_smoother_cnv + end interface + interface subroutine mld_s_jac_smoother_clone(sm,smout,info) import :: mld_s_jac_smoother_type, psb_spk_, & diff --git a/mlprec/mld_s_onelev_mod.f90 b/mlprec/mld_s_onelev_mod.f90 index d5f06e37..17b835e5 100644 --- a/mlprec/mld_s_onelev_mod.f90 +++ b/mlprec/mld_s_onelev_mod.f90 @@ -56,8 +56,9 @@ module mld_s_onelev_mod use mld_base_prec_type use mld_s_base_smoother_mod - use psb_base_mod, only : psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & - & psb_slinmap_type, psb_spk_, psb_ipk_, psb_long_int_k_, psb_desc_type + use psb_base_mod, only : psb_sspmat_type, psb_s_vect_type, & + & psb_s_base_vect_type, psb_slinmap_type, psb_spk_, & + & psb_ipk_, psb_long_int_k_, psb_desc_type, psb_i_base_vect_type ! ! ! Type: mld_Tonelev_type. @@ -128,6 +129,7 @@ module mld_s_onelev_mod type(psb_slinmap_type) :: map contains procedure, pass(lv) :: clone => s_base_onelev_clone + procedure, pass(lv) :: cnv => mld_s_base_onelev_cnv procedure, pass(lv) :: descr => mld_s_base_onelev_descr procedure, pass(lv) :: default => s_base_onelev_default procedure, pass(lv) :: free => mld_s_base_onelev_free @@ -170,7 +172,20 @@ module mld_s_onelev_mod integer(psb_ipk_), intent(in), optional :: iout end subroutine mld_s_base_onelev_descr end interface - + + interface + subroutine mld_s_base_onelev_cnv(lv,info,amold,vmold,imold) + import :: mld_s_onelev_type, psb_s_base_vect_type, psb_spk_, & + & psb_s_base_sparse_mat, psb_ipk_, psb_i_base_vect_type + ! Arguments + class(mld_s_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_s_base_onelev_cnv + end interface + interface subroutine mld_s_base_onelev_free(lv,info) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & diff --git a/mlprec/mld_s_slu_solver.F90 b/mlprec/mld_s_slu_solver.F90 index 21f7457a..be116171 100644 --- a/mlprec/mld_s_slu_solver.F90 +++ b/mlprec/mld_s_slu_solver.F90 @@ -241,7 +241,7 @@ contains end subroutine s_slu_solver_apply_vect - subroutine s_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine s_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -256,6 +256,7 @@ contains type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_sspmat_type) :: atmp type(psb_s_csr_sparse_mat) :: acsr diff --git a/mlprec/mld_s_sludist_solver.F90 b/mlprec/mld_s_sludist_solver.F90 index 5808c716..3c6441ea 100644 --- a/mlprec/mld_s_sludist_solver.F90 +++ b/mlprec/mld_s_sludist_solver.F90 @@ -237,7 +237,7 @@ contains end subroutine s_sludist_solver_apply_vect - subroutine s_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine s_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -252,6 +252,7 @@ contains type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_sspmat_type) :: atmp type(psb_s_csr_sparse_mat) :: acsr diff --git a/mlprec/mld_s_umf_solver.F90 b/mlprec/mld_s_umf_solver.F90 index 1cf3a41c..7d860fd1 100644 --- a/mlprec/mld_s_umf_solver.F90 +++ b/mlprec/mld_s_umf_solver.F90 @@ -245,7 +245,7 @@ contains end subroutine s_umf_solver_apply_vect - subroutine s_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine s_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -260,6 +260,7 @@ contains type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_sspmat_type) :: atmp type(psb_s_csc_sparse_mat) :: acsc diff --git a/mlprec/mld_z_as_smoother.f90 b/mlprec/mld_z_as_smoother.f90 index d6c969e8..001a9a57 100644 --- a/mlprec/mld_z_as_smoother.f90 +++ b/mlprec/mld_z_as_smoother.f90 @@ -58,6 +58,7 @@ module mld_z_as_smoother procedure, pass(sm) :: check => mld_z_as_smoother_check procedure, pass(sm) :: dump => mld_z_as_smoother_dmp procedure, pass(sm) :: build => mld_z_as_smoother_bld + procedure, pass(sm) :: cnv => mld_z_as_smoother_cnv procedure, pass(sm) :: clone => mld_z_as_smoother_clone procedure, pass(sm) :: apply_v => mld_z_as_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_z_as_smoother_apply @@ -95,9 +96,11 @@ module mld_z_as_smoother end interface interface - subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,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_ + & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, & + & psb_desc_type, psb_ipk_ implicit none type(psb_desc_type), intent(in) :: desc_data class(mld_z_as_smoother_type), intent(inout) :: sm @@ -112,9 +115,11 @@ module mld_z_as_smoother end interface interface - subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,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_ + & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_,& + & psb_desc_type, psb_ipk_ implicit none type(psb_desc_type), intent(in) :: desc_data class(mld_z_as_smoother_type), intent(inout) :: sm @@ -129,21 +134,37 @@ module mld_z_as_smoother end interface interface - subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) 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_z_base_sparse_mat, psb_ipk_ + & psb_desc_type, psb_z_base_sparse_mat, psb_ipk_,& + & psb_i_base_vect_type implicit none type(psb_zspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a - class(mld_z_as_smoother_type), intent(inout) :: sm + class(mld_z_as_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_z_as_smoother_bld end interface + interface + subroutine mld_z_as_smoother_cnv(sm,info,amold,vmold,imold) + import :: psb_z_base_vect_type, & + & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, & + & psb_z_base_sparse_mat, psb_ipk_, psb_i_base_vect_type + implicit none + class(mld_z_as_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_z_as_smoother_cnv + end interface + interface subroutine mld_z_as_smoother_seti(sm,what,val,info) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & diff --git a/mlprec/mld_z_base_smoother_mod.f90 b/mlprec/mld_z_base_smoother_mod.f90 index b6956c22..554f002c 100644 --- a/mlprec/mld_z_base_smoother_mod.f90 +++ b/mlprec/mld_z_base_smoother_mod.f90 @@ -55,7 +55,8 @@ module mld_z_base_smoother_mod use mld_z_base_solver_mod use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_long_int_k_,& - & psb_z_vect_type, psb_z_base_vect_type, psb_z_base_sparse_mat, psb_dpk_ + & psb_z_vect_type, psb_z_base_vect_type, psb_z_base_sparse_mat, & + & psb_dpk_, psb_i_base_vect_type ! ! @@ -96,6 +97,7 @@ module mld_z_base_smoother_mod procedure, pass(sm) :: dump => mld_z_base_smoother_dmp procedure, pass(sm) :: clone => mld_z_base_smoother_clone procedure, pass(sm) :: build => mld_z_base_smoother_bld + procedure, pass(sm) :: cnv => mld_z_base_smoother_cnv procedure, pass(sm) :: apply_v => mld_z_base_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_z_base_smoother_apply generic, public :: apply => apply_a, apply_v @@ -122,7 +124,8 @@ module mld_z_base_smoother_mod interface - subroutine mld_z_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_z_base_smoother_apply(alpha,sm,x,beta,y,desc_data,& + & trans,sweeps,work,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_ @@ -244,10 +247,10 @@ module mld_z_base_smoother_mod end interface interface - subroutine mld_z_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_z_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) 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_ + & mld_z_base_smoother_type, psb_ipk_, psb_i_base_vect_type ! Arguments type(psb_zspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a @@ -256,9 +259,23 @@ module mld_z_base_smoother_mod integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_z_base_smoother_bld end interface + interface + subroutine mld_z_base_smoother_cnv(sm,info,amold,vmold,imold) + import :: psb_z_base_sparse_mat, psb_z_base_vect_type, psb_dpk_, & + & mld_z_base_smoother_type, psb_ipk_, psb_i_base_vect_type + ! Arguments + class(mld_z_base_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_z_base_smoother_cnv + end interface + interface subroutine mld_z_base_smoother_free(sm,info) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & diff --git a/mlprec/mld_z_base_solver_mod.f90 b/mlprec/mld_z_base_solver_mod.f90 index e4841d0a..d8b362bb 100644 --- a/mlprec/mld_z_base_solver_mod.f90 +++ b/mlprec/mld_z_base_solver_mod.f90 @@ -55,7 +55,8 @@ module mld_z_base_solver_mod use mld_base_prec_type use psb_base_mod, only : psb_zspmat_type, & - & psb_z_vect_type, psb_z_base_vect_type, psb_z_base_sparse_mat + & psb_z_vect_type, psb_z_base_vect_type, psb_z_base_sparse_mat, & + & psb_i_base_vect_type ! ! ! Type: mld_T_base_solver_type. @@ -88,6 +89,7 @@ module mld_z_base_solver_mod procedure, pass(sv) :: dump => mld_z_base_solver_dmp procedure, pass(sv) :: clone => mld_z_base_solver_clone procedure, pass(sv) :: build => mld_z_base_solver_bld + procedure, pass(sv) :: cnv => mld_z_base_solver_cnv procedure, pass(sv) :: apply_v => mld_z_base_solver_apply_vect procedure, pass(sv) :: apply_a => mld_z_base_solver_apply generic, public :: apply => apply_a, apply_v @@ -147,24 +149,40 @@ module mld_z_base_solver_mod end interface interface - subroutine mld_z_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_z_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) 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_ + & mld_z_base_solver_type, psb_ipk_, psb_i_base_vect_type Implicit None ! Arguments - type(psb_zspmat_type), intent(in), target :: a + type(psb_zspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(in) :: desc_a - class(mld_z_base_solver_type), intent(inout) :: sv + class(mld_z_base_solver_type), intent(inout) :: sv character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info - type(psb_zspmat_type), intent(in), target, optional :: b - class(psb_z_base_sparse_mat), intent(in), optional :: amold - class(psb_z_base_vect_type), intent(in), optional :: vmold + type(psb_zspmat_type), intent(in), target, optional :: b + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_z_base_solver_bld end interface + interface + subroutine mld_z_base_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_z_base_sparse_mat, psb_z_base_vect_type, psb_dpk_, & + & mld_z_base_solver_type, psb_ipk_, psb_i_base_vect_type + Implicit None + + ! Arguments + class(mld_z_base_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_z_base_solver_cnv + end interface + interface subroutine mld_z_base_solver_check(sv,info) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & @@ -173,7 +191,7 @@ module mld_z_base_solver_mod Implicit None ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv + class(mld_z_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(out) :: info end subroutine mld_z_base_solver_check end interface @@ -186,7 +204,7 @@ module mld_z_base_solver_mod Implicit None ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv + class(mld_z_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info @@ -201,7 +219,7 @@ module mld_z_base_solver_mod Implicit None ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv + class(mld_z_base_solver_type), intent(inout) :: sv integer(psb_ipk_), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info @@ -215,7 +233,7 @@ module mld_z_base_solver_mod & mld_z_base_solver_type, psb_ipk_ Implicit None ! Arguments - class(mld_z_base_solver_type), intent(inout) :: sv + 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 diff --git a/mlprec/mld_z_diag_solver.f90 b/mlprec/mld_z_diag_solver.f90 index 982b2545..413e1287 100644 --- a/mlprec/mld_z_diag_solver.f90 +++ b/mlprec/mld_z_diag_solver.f90 @@ -52,6 +52,7 @@ module mld_z_diag_solver complex(psb_dpk_), allocatable :: d(:) contains procedure, pass(sv) :: build => mld_z_diag_solver_bld + procedure, pass(sv) :: cnv => mld_z_diag_solver_cnv procedure, pass(sv) :: clone => mld_z_diag_solver_clone procedure, pass(sv) :: apply_v => mld_z_diag_solver_apply_vect procedure, pass(sv) :: apply_a => mld_z_diag_solver_apply @@ -69,7 +70,8 @@ module mld_z_diag_solver interface - subroutine mld_z_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) + subroutine mld_z_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& + & trans,work,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_diag_solver_type, psb_ipk_ @@ -101,10 +103,10 @@ module mld_z_diag_solver end interface interface - subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) 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_diag_solver_type, psb_ipk_ + & mld_z_diag_solver_type, psb_ipk_, psb_i_base_vect_type type(psb_zspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(in) :: desc_a class(mld_z_diag_solver_type), intent(inout) :: sv @@ -113,8 +115,21 @@ module mld_z_diag_solver type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_z_diag_solver_bld end interface + + interface + subroutine mld_z_diag_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_z_base_sparse_mat, psb_z_base_vect_type, psb_dpk_, & + & mld_z_diag_solver_type, psb_ipk_, psb_i_base_vect_type + class(mld_z_diag_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_z_diag_solver_cnv + end interface interface subroutine mld_z_diag_solver_clone(sv,svout,info) diff --git a/mlprec/mld_z_id_solver.f90 b/mlprec/mld_z_id_solver.f90 index fc0d45c5..4d03a38d 100644 --- a/mlprec/mld_z_id_solver.f90 +++ b/mlprec/mld_z_id_solver.f90 @@ -112,19 +112,20 @@ module mld_z_id_solver contains - subroutine z_id_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine z_id_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) Implicit None ! Arguments type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_z_id_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/mld_z_ilu_solver.f90 b/mlprec/mld_z_ilu_solver.f90 index 1a41baf4..e03bef96 100644 --- a/mlprec/mld_z_ilu_solver.f90 +++ b/mlprec/mld_z_ilu_solver.f90 @@ -58,6 +58,7 @@ module mld_z_ilu_solver procedure, pass(sv) :: dump => mld_z_ilu_solver_dmp procedure, pass(sv) :: clone => mld_z_ilu_solver_clone procedure, pass(sv) :: build => mld_z_ilu_solver_bld + procedure, pass(sv) :: cnv => mld_z_ilu_solver_cnv procedure, pass(sv) :: apply_v => mld_z_ilu_solver_apply_vect procedure, pass(sv) :: apply_a => mld_z_ilu_solver_apply procedure, pass(sv) :: free => z_ilu_solver_free @@ -126,20 +127,36 @@ module mld_z_ilu_solver end interface interface - subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) import :: psb_desc_type, mld_z_ilu_solver_type, psb_z_vect_type, psb_dpk_, & - & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_ + & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type implicit none type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_z_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer(psb_ipk_), intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_z_ilu_solver_bld end interface + + interface + subroutine mld_z_ilu_solver_cnv(sv,info,amold,vmold,imold) + import :: mld_z_ilu_solver_type, psb_dpk_, & + & psb_z_base_sparse_mat, psb_z_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type + implicit none + class(mld_z_ilu_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_z_ilu_solver_cnv + end interface interface subroutine mld_z_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) diff --git a/mlprec/mld_z_jac_smoother.f90 b/mlprec/mld_z_jac_smoother.f90 index e0115f4d..14dd97ae 100644 --- a/mlprec/mld_z_jac_smoother.f90 +++ b/mlprec/mld_z_jac_smoother.f90 @@ -55,6 +55,7 @@ module mld_z_jac_smoother integer(psb_ipk_) :: nnz_nd_tot contains procedure, pass(sm) :: build => mld_z_jac_smoother_bld + procedure, pass(sm) :: cnv => mld_z_jac_smoother_cnv procedure, pass(sm) :: clone => mld_z_jac_smoother_clone procedure, pass(sm) :: apply_v => mld_z_jac_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_z_jac_smoother_apply @@ -72,9 +73,11 @@ module mld_z_jac_smoother interface - subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& + & sweeps,work,info) import :: psb_desc_type, mld_z_jac_smoother_type, psb_z_vect_type, psb_dpk_, & - & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_ + & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,& + & psb_ipk_ type(psb_desc_type), intent(in) :: desc_data class(mld_z_jac_smoother_type), intent(inout) :: sm @@ -89,9 +92,11 @@ module mld_z_jac_smoother end interface interface - subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,& + & sweeps,work,info) import :: psb_desc_type, mld_z_jac_smoother_type, psb_z_vect_type, psb_dpk_, & - & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_ + & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, & + & psb_ipk_ type(psb_desc_type), intent(in) :: desc_data class(mld_z_jac_smoother_type), intent(inout) :: sm complex(psb_dpk_),intent(inout) :: x(:) @@ -105,19 +110,34 @@ module mld_z_jac_smoother end interface interface - subroutine mld_z_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_z_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) import :: psb_desc_type, mld_z_jac_smoother_type, psb_z_vect_type, psb_dpk_, & - & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_ - type(psb_zspmat_type), intent(in), target :: a + & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type + type(psb_zspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a - class(mld_z_jac_smoother_type), intent(inout) :: sm + class(mld_z_jac_smoother_type), intent(inout) :: sm character, intent(in) :: upd integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_z_jac_smoother_bld end interface + interface + subroutine mld_z_jac_smoother_cnv(sm,info,amold,vmold,imold) + import :: mld_z_jac_smoother_type, psb_dpk_, & + & psb_z_base_sparse_mat, psb_z_base_vect_type,& + & psb_ipk_, psb_i_base_vect_type + class(mld_z_jac_smoother_type), intent(inout) :: sm + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_z_jac_smoother_cnv + end interface + interface subroutine mld_z_jac_smoother_clone(sm,smout,info) import :: mld_z_jac_smoother_type, psb_dpk_, & diff --git a/mlprec/mld_z_onelev_mod.f90 b/mlprec/mld_z_onelev_mod.f90 index d8987fcf..638cbd5e 100644 --- a/mlprec/mld_z_onelev_mod.f90 +++ b/mlprec/mld_z_onelev_mod.f90 @@ -56,8 +56,9 @@ module mld_z_onelev_mod use mld_base_prec_type use mld_z_base_smoother_mod - use psb_base_mod, only : psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & - & psb_zlinmap_type, psb_dpk_, psb_ipk_, psb_long_int_k_, psb_desc_type + use psb_base_mod, only : psb_zspmat_type, psb_z_vect_type, & + & psb_z_base_vect_type, psb_zlinmap_type, psb_dpk_, & + & psb_ipk_, psb_long_int_k_, psb_desc_type, psb_i_base_vect_type ! ! ! Type: mld_Tonelev_type. @@ -128,6 +129,7 @@ module mld_z_onelev_mod type(psb_zlinmap_type) :: map contains procedure, pass(lv) :: clone => z_base_onelev_clone + procedure, pass(lv) :: cnv => mld_z_base_onelev_cnv procedure, pass(lv) :: descr => mld_z_base_onelev_descr procedure, pass(lv) :: default => z_base_onelev_default procedure, pass(lv) :: free => mld_z_base_onelev_free @@ -170,7 +172,20 @@ module mld_z_onelev_mod integer(psb_ipk_), intent(in), optional :: iout end subroutine mld_z_base_onelev_descr end interface - + + interface + subroutine mld_z_base_onelev_cnv(lv,info,amold,vmold,imold) + import :: mld_z_onelev_type, psb_z_base_vect_type, psb_dpk_, & + & psb_z_base_sparse_mat, psb_ipk_, psb_i_base_vect_type + ! Arguments + class(mld_z_onelev_type), intent(inout) :: lv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_z_base_onelev_cnv + end interface + interface subroutine mld_z_base_onelev_free(lv,info) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & diff --git a/mlprec/mld_z_slu_solver.F90 b/mlprec/mld_z_slu_solver.F90 index 95f834ee..f4f5ea84 100644 --- a/mlprec/mld_z_slu_solver.F90 +++ b/mlprec/mld_z_slu_solver.F90 @@ -241,7 +241,7 @@ contains end subroutine z_slu_solver_apply_vect - subroutine z_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine z_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -256,6 +256,7 @@ contains type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_zspmat_type) :: atmp type(psb_z_csr_sparse_mat) :: acsr diff --git a/mlprec/mld_z_sludist_solver.F90 b/mlprec/mld_z_sludist_solver.F90 index e5c2c0c5..462dc32e 100644 --- a/mlprec/mld_z_sludist_solver.F90 +++ b/mlprec/mld_z_sludist_solver.F90 @@ -237,7 +237,7 @@ contains end subroutine z_sludist_solver_apply_vect - subroutine z_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine z_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -252,6 +252,7 @@ contains type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_zspmat_type) :: atmp type(psb_z_csr_sparse_mat) :: acsr diff --git a/mlprec/mld_z_umf_solver.F90 b/mlprec/mld_z_umf_solver.F90 index d9352cf4..f2ac8aaa 100644 --- a/mlprec/mld_z_umf_solver.F90 +++ b/mlprec/mld_z_umf_solver.F90 @@ -245,7 +245,7 @@ contains end subroutine z_umf_solver_apply_vect - subroutine z_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine z_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -260,6 +260,7 @@ contains type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables type(psb_zspmat_type) :: atmp type(psb_z_csc_sparse_mat) :: acsc