From 665c72474ad4b038470f11e7e94f81a757e52ec4 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 2 Sep 2013 15:10:37 +0000 Subject: [PATCH] --- mlprec/impl/level/Makefile | 1 + mlprec/impl/level/mld_d_base_onelev_cnv.f90 | 63 +++++++++++ mlprec/impl/mld_dmlprec_bld.f90 | 7 +- mlprec/impl/mld_dprecbld.f90 | 6 +- mlprec/impl/smoother/Makefile | 3 + .../impl/smoother/mld_d_as_smoother_bld.f90 | 8 +- .../impl/smoother/mld_d_as_smoother_cnv.f90 | 101 ++++++++++++++++++ .../impl/smoother/mld_d_base_smoother_bld.f90 | 3 +- .../impl/smoother/mld_d_base_smoother_cnv.f90 | 75 +++++++++++++ .../impl/smoother/mld_d_jac_smoother_bld.f90 | 3 +- .../impl/smoother/mld_d_jac_smoother_cnv.f90 | 91 ++++++++++++++++ mlprec/impl/solver/Makefile | 3 + mlprec/impl/solver/mld_d_base_solver_bld.f90 | 3 +- mlprec/impl/solver/mld_d_base_solver_cnv.f90 | 68 ++++++++++++ mlprec/impl/solver/mld_d_diag_solver_bld.f90 | 3 +- mlprec/impl/solver/mld_d_diag_solver_cnv.f90 | 83 ++++++++++++++ mlprec/impl/solver/mld_d_ilu_solver_bld.f90 | 3 +- mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 | 83 ++++++++++++++ mlprec/mld_d_as_smoother.f90 | 26 ++++- mlprec/mld_d_base_smoother_mod.f90 | 27 ++++- mlprec/mld_d_base_solver_mod.f90 | 29 +++-- mlprec/mld_d_diag_solver.f90 | 28 +++-- mlprec/mld_d_id_solver.f90 | 3 +- mlprec/mld_d_ilu_solver.f90 | 21 +++- mlprec/mld_d_jac_smoother.f90 | 26 ++++- mlprec/mld_d_onelev_mod.f90 | 17 ++- mlprec/mld_d_slu_solver.F90 | 3 +- mlprec/mld_d_sludist_solver.F90 | 3 +- mlprec/mld_d_umf_solver.F90 | 3 +- 29 files changed, 751 insertions(+), 42 deletions(-) create mode 100644 mlprec/impl/level/mld_d_base_onelev_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_d_base_smoother_cnv.f90 create mode 100644 mlprec/impl/smoother/mld_d_jac_smoother_cnv.f90 create mode 100644 mlprec/impl/solver/mld_d_base_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_d_diag_solver_cnv.f90 create mode 100644 mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 diff --git a/mlprec/impl/level/Makefile b/mlprec/impl/level/Makefile index aa1ddb72..4964e210 100644 --- a/mlprec/impl/level/Makefile +++ b/mlprec/impl/level/Makefile @@ -18,6 +18,7 @@ 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_descr.o \ mld_d_base_onelev_dump.o \ mld_d_base_onelev_free.o \ diff --git a/mlprec/impl/level/mld_d_base_onelev_cnv.f90 b/mlprec/impl/level/mld_d_base_onelev_cnv.f90 new file mode 100644 index 00000000..fdbef138 --- /dev/null +++ b/mlprec/impl/level/mld_d_base_onelev_cnv.f90 @@ -0,0 +1,63 @@ +!!$ +!!$ +!!$ 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_d_base_onelev_cnv(lv,info,amold,vmold,imold) + + use psb_base_mod + use mld_d_onelev_mod, mld_protect_name => mld_d_base_onelev_cnv + implicit none + + class(mld_d_onelev_type), intent(inout) :: lv + 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 + + 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) + +end subroutine mld_d_base_onelev_cnv diff --git a/mlprec/impl/mld_dmlprec_bld.f90 b/mlprec/impl/mld_dmlprec_bld.f90 index 16641ff4..2bd905fa 100644 --- a/mlprec/impl/mld_dmlprec_bld.f90 +++ b/mlprec/impl/mld_dmlprec_bld.f90 @@ -487,11 +487,12 @@ subroutine mld_dmlprec_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) + 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) end if if (info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,& diff --git a/mlprec/impl/mld_dprecbld.f90 b/mlprec/impl/mld_dprecbld.f90 index 938b3277..61fa7092 100644 --- a/mlprec/impl/mld_dprecbld.f90 +++ b/mlprec/impl/mld_dprecbld.f90 @@ -174,7 +174,8 @@ subroutine mld_dprecbld(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_dprecbld(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 8237f66d..f2536eda 100644 --- a/mlprec/impl/smoother/Makefile +++ b/mlprec/impl/smoother/Makefile @@ -43,6 +43,7 @@ mld_d_as_smoother_apply_vect.o \ mld_d_as_smoother_bld.o \ mld_d_as_smoother_check.o \ mld_d_as_smoother_clone.o \ +mld_d_as_smoother_cnv.o \ mld_d_as_smoother_csetc.o \ mld_d_as_smoother_cseti.o \ mld_d_as_smoother_csetr.o \ @@ -56,6 +57,7 @@ mld_d_base_smoother_apply_vect.o \ mld_d_base_smoother_bld.o \ mld_d_base_smoother_check.o \ mld_d_base_smoother_clone.o \ +mld_d_base_smoother_cnv.o \ mld_d_base_smoother_csetc.o \ mld_d_base_smoother_cseti.o \ mld_d_base_smoother_csetr.o \ @@ -69,6 +71,7 @@ mld_d_jac_smoother_apply.o \ mld_d_jac_smoother_apply_vect.o \ mld_d_jac_smoother_bld.o \ mld_d_jac_smoother_clone.o \ +mld_d_jac_smoother_cnv.o \ mld_s_as_smoother_apply.o \ mld_s_as_smoother_apply_vect.o \ mld_s_as_smoother_bld.o \ diff --git a/mlprec/impl/smoother/mld_d_as_smoother_bld.f90 b/mlprec/impl/smoother/mld_d_as_smoother_bld.f90 index 93d3c9d9..9e848d3a 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_bld @@ -50,6 +50,7 @@ subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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 ! Local variables type(psb_dspmat_type) :: blck, atmp @@ -164,6 +165,11 @@ subroutine mld_d_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_d_as_smoother_cnv.f90 b/mlprec/impl/smoother/mld_d_as_smoother_cnv.f90 new file mode 100644 index 00000000..c9bd4c3b --- /dev/null +++ b/mlprec/impl/smoother/mld_d_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_d_as_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_cnv + Implicit None + + ! Arguments + 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 + + ! 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 (info == psb_success_) & + & 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_d_as_smoother_cnv diff --git a/mlprec/impl/smoother/mld_d_base_smoother_bld.f90 b/mlprec/impl/smoother/mld_d_base_smoother_bld.f90 index 1b669a2c..cfb0642c 100644 --- a/mlprec/impl/smoother/mld_d_base_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_d_base_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_bld @@ -50,6 +50,7 @@ subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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 integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_smoother_bld' diff --git a/mlprec/impl/smoother/mld_d_base_smoother_cnv.f90 b/mlprec/impl/smoother/mld_d_base_smoother_cnv.f90 new file mode 100644 index 00000000..3822f40a --- /dev/null +++ b/mlprec/impl/smoother/mld_d_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_d_base_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_cnv + Implicit None + + ! Arguments + class(mld_d_base_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 + 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_d_base_smoother_cnv diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 index 641d64ba..d3e2d954 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_d_jac_smoother_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) +subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) use psb_base_mod use mld_d_diag_solver @@ -51,6 +51,7 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) 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 ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_cnv.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_cnv.f90 new file mode 100644 index 00000000..5fccdd13 --- /dev/null +++ b/mlprec/impl/smoother/mld_d_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_d_jac_smoother_cnv(sm,info,amold,vmold,imold) + + use psb_base_mod + use mld_d_diag_solver + use mld_d_jac_smoother, mld_protect_name => mld_d_jac_smoother_cnv + Implicit None + + ! Arguments + 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 + 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_d_jac_smoother_cnv diff --git a/mlprec/impl/solver/Makefile b/mlprec/impl/solver/Makefile index 2ebf3afc..31de5a20 100644 --- a/mlprec/impl/solver/Makefile +++ b/mlprec/impl/solver/Makefile @@ -38,6 +38,7 @@ mld_d_base_solver_apply_vect.o \ mld_d_base_solver_bld.o \ mld_d_base_solver_check.o \ mld_d_base_solver_clone.o \ +mld_d_base_solver_cnv.o \ mld_d_base_solver_csetc.o \ mld_d_base_solver_cseti.o \ mld_d_base_solver_csetr.o \ @@ -51,6 +52,7 @@ mld_d_diag_solver_apply.o \ mld_d_diag_solver_apply_vect.o \ mld_d_diag_solver_bld.o \ mld_d_diag_solver_clone.o \ +mld_d_diag_solver_cnv.o \ mld_d_id_solver_apply.o \ mld_d_id_solver_apply_vect.o \ mld_d_id_solver_clone.o \ @@ -58,6 +60,7 @@ mld_d_ilu_solver_apply.o \ mld_d_ilu_solver_apply_vect.o \ mld_d_ilu_solver_bld.o \ mld_d_ilu_solver_clone.o \ +mld_d_ilu_solver_cnv.o \ mld_d_ilu_solver_dmp.o \ mld_s_base_solver_apply.o \ mld_s_base_solver_apply_vect.o \ diff --git a/mlprec/impl/solver/mld_d_base_solver_bld.f90 b/mlprec/impl/solver/mld_d_base_solver_bld.f90 index e259eb88..27433aea 100644 --- a/mlprec/impl/solver/mld_d_base_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_d_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_d_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_bld @@ -50,6 +50,7 @@ subroutine mld_d_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) 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 integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_bld' diff --git a/mlprec/impl/solver/mld_d_base_solver_cnv.f90 b/mlprec/impl/solver/mld_d_base_solver_cnv.f90 new file mode 100644 index 00000000..6076bf39 --- /dev/null +++ b/mlprec/impl/solver/mld_d_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_d_base_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_cnv + 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 + + 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_d_base_solver_cnv diff --git a/mlprec/impl/solver/mld_d_diag_solver_bld.f90 b/mlprec/impl/solver/mld_d_diag_solver_bld.f90 index 815c991f..2a84af95 100644 --- a/mlprec/impl/solver/mld_d_diag_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_diag_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_d_diag_solver, mld_protect_name => mld_d_diag_solver_bld @@ -52,6 +52,7 @@ subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) 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 ! 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 new file mode 100644 index 00000000..7b844756 --- /dev/null +++ b/mlprec/impl/solver/mld_d_diag_solver_cnv.f90 @@ -0,0 +1,83 @@ +!!$ +!!$ +!!$ 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_d_diag_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_d_diag_solver, mld_protect_name => mld_d_diag_solver_cnv + + Implicit None + + ! Arguments + class(mld_d_diag_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 + ! 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 + 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,*) me,' ',trim(name),' start' + + + if (allocated(sv%dv)) then + call sv%dv%cnv(vmold) + 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_d_diag_solver_cnv diff --git a/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 b/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 index 7da0aa70..44eb017d 100644 --- a/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 @@ -36,7 +36,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) +subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_bld @@ -52,6 +52,7 @@ subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) 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 ! 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 new file mode 100644 index 00000000..1cb3166c --- /dev/null +++ b/mlprec/impl/solver/mld_d_ilu_solver_cnv.f90 @@ -0,0 +1,83 @@ +!!$ +!!$ +!!$ 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_d_ilu_solver_cnv(sv,info,amold,vmold,imold) + + use psb_base_mod + use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_cnv + + Implicit None + + ! Arguments + class(mld_d_ilu_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 + ! 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 + 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,*) 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_d_ilu_solver_cnv diff --git a/mlprec/mld_d_as_smoother.f90 b/mlprec/mld_d_as_smoother.f90 index 34287249..1bc2fce9 100644 --- a/mlprec/mld_d_as_smoother.f90 +++ b/mlprec/mld_d_as_smoother.f90 @@ -58,6 +58,7 @@ module mld_d_as_smoother procedure, pass(sm) :: check => mld_d_as_smoother_check procedure, pass(sm) :: dump => mld_d_as_smoother_dmp procedure, pass(sm) :: build => mld_d_as_smoother_bld + procedure, pass(sm) :: cnv => mld_d_as_smoother_cnv procedure, pass(sm) :: clone => mld_d_as_smoother_clone procedure, pass(sm) :: apply_v => mld_d_as_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_d_as_smoother_apply @@ -95,7 +96,8 @@ module mld_d_as_smoother end interface interface - subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + subroutine mld_d_as_smoother_apply_vect(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_ implicit none @@ -129,10 +131,11 @@ module mld_d_as_smoother end interface interface - subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold,imold) 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_d_base_sparse_mat, psb_ipk_ + & psb_desc_type, psb_d_base_sparse_mat, psb_ipk_,& + & psb_i_base_vect_type implicit none type(psb_dspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a @@ -141,9 +144,24 @@ module mld_d_as_smoother 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_bld end 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 + 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 8c0de52d..c3482ba6 100644 --- a/mlprec/mld_d_base_smoother_mod.f90 +++ b/mlprec/mld_d_base_smoother_mod.f90 @@ -55,7 +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_d_vect_type, psb_d_base_vect_type, psb_d_base_sparse_mat, psb_dpk_,& + & psb_i_base_vect_type ! ! @@ -96,6 +97,7 @@ module mld_d_base_smoother_mod procedure, pass(sm) :: dump => mld_d_base_smoother_dmp procedure, pass(sm) :: clone => mld_d_base_smoother_clone procedure, pass(sm) :: build => mld_d_base_smoother_bld + procedure, pass(sm) :: cnv => mld_d_base_smoother_cnv procedure, pass(sm) :: apply_v => mld_d_base_smoother_apply_vect procedure, pass(sm) :: apply_a => mld_d_base_smoother_apply generic, public :: apply => apply_a, apply_v @@ -122,7 +124,8 @@ module mld_d_base_smoother_mod interface - subroutine mld_d_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info) + 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_, & & mld_d_base_smoother_type, psb_ipk_ @@ -244,10 +247,11 @@ module mld_d_base_smoother_mod end interface interface - subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + 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_ + & mld_d_base_smoother_type, psb_ipk_, psb_i_base_vect_type ! Arguments type(psb_dspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a @@ -256,9 +260,24 @@ module mld_d_base_smoother_mod 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_smoother_bld end interface + 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_, & + & mld_d_base_smoother_type, psb_ipk_, psb_i_base_vect_type + ! Arguments + class(mld_d_base_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_base_smoother_cnv + end interface + interface subroutine mld_d_base_smoother_free(sm,info) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & diff --git a/mlprec/mld_d_base_solver_mod.f90 b/mlprec/mld_d_base_solver_mod.f90 index 3731d143..a394e5a8 100644 --- a/mlprec/mld_d_base_solver_mod.f90 +++ b/mlprec/mld_d_base_solver_mod.f90 @@ -55,7 +55,8 @@ 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 ! ! ! Type: mld_T_base_solver_type. @@ -88,6 +89,7 @@ module mld_d_base_solver_mod procedure, pass(sv) :: dump => mld_d_base_solver_dmp procedure, pass(sv) :: clone => mld_d_base_solver_clone procedure, pass(sv) :: build => mld_d_base_solver_bld + procedure, pass(sv) :: cnv => mld_d_base_solver_cnv procedure, pass(sv) :: apply_v => mld_d_base_solver_apply_vect procedure, pass(sv) :: apply_a => mld_d_base_solver_apply generic, public :: apply => apply_a, apply_v @@ -147,24 +149,39 @@ module mld_d_base_solver_mod end interface interface - subroutine mld_d_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_d_base_solver_bld(a,desc_a,sv,upd,info,b,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_solver_type, psb_ipk_ + & mld_d_base_solver_type, psb_ipk_, psb_i_base_vect_type 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 + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_d_base_solver_bld end interface + interface + 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 + ! 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 + end subroutine mld_d_base_solver_cnv + end interface + interface subroutine mld_d_base_solver_check(sv,info) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & diff --git a/mlprec/mld_d_diag_solver.f90 b/mlprec/mld_d_diag_solver.f90 index 089ea2c4..48a76ed7 100644 --- a/mlprec/mld_d_diag_solver.f90 +++ b/mlprec/mld_d_diag_solver.f90 @@ -52,6 +52,7 @@ module mld_d_diag_solver real(psb_dpk_), allocatable :: d(:) contains procedure, pass(sv) :: build => mld_d_diag_solver_bld + procedure, pass(sv) :: cnv => mld_d_diag_solver_cnv procedure, pass(sv) :: clone => mld_d_diag_solver_clone procedure, pass(sv) :: apply_v => mld_d_diag_solver_apply_vect procedure, pass(sv) :: apply_a => mld_d_diag_solver_apply @@ -69,7 +70,8 @@ module mld_d_diag_solver interface - subroutine mld_d_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) + 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_, & & mld_d_diag_solver_type, psb_ipk_ @@ -101,20 +103,34 @@ module mld_d_diag_solver end interface interface - subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,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_diag_solver_type, psb_ipk_ + & 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 + class(psb_i_base_vect_type), intent(in), optional :: imold end subroutine mld_d_diag_solver_bld end interface + + 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_, & + & 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 + 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_diag_solver_cnv + end interface interface subroutine mld_d_diag_solver_clone(sv,svout,info) diff --git a/mlprec/mld_d_id_solver.f90 b/mlprec/mld_d_id_solver.f90 index e93ec10f..2f896e8f 100644 --- a/mlprec/mld_d_id_solver.f90 +++ b/mlprec/mld_d_id_solver.f90 @@ -112,7 +112,7 @@ module mld_d_id_solver contains - subroutine d_id_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine d_id_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) Implicit None @@ -125,6 +125,7 @@ contains 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 ! 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 9a4aa7eb..19267f92 100644 --- a/mlprec/mld_d_ilu_solver.f90 +++ b/mlprec/mld_d_ilu_solver.f90 @@ -58,6 +58,7 @@ module mld_d_ilu_solver procedure, pass(sv) :: dump => mld_d_ilu_solver_dmp procedure, pass(sv) :: clone => mld_d_ilu_solver_clone procedure, pass(sv) :: build => mld_d_ilu_solver_bld + procedure, pass(sv) :: cnv => mld_d_ilu_solver_cnv procedure, pass(sv) :: apply_v => mld_d_ilu_solver_apply_vect procedure, pass(sv) :: apply_a => mld_d_ilu_solver_apply procedure, pass(sv) :: free => d_ilu_solver_free @@ -126,9 +127,10 @@ module mld_d_ilu_solver end interface interface - subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) import :: psb_desc_type, mld_d_ilu_solver_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_, psb_i_base_vect_type implicit none type(psb_dspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(in) :: desc_a @@ -138,8 +140,23 @@ module mld_d_ilu_solver 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_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_, & + & 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 + 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_ilu_solver_cnv + end interface interface subroutine mld_d_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) diff --git a/mlprec/mld_d_jac_smoother.f90 b/mlprec/mld_d_jac_smoother.f90 index 90dacb89..bcf40c9f 100644 --- a/mlprec/mld_d_jac_smoother.f90 +++ b/mlprec/mld_d_jac_smoother.f90 @@ -56,6 +56,7 @@ module mld_d_jac_smoother 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) :: 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 @@ -72,7 +73,8 @@ 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_ @@ -89,7 +91,8 @@ 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_ type(psb_desc_type), intent(in) :: desc_data @@ -105,9 +108,10 @@ module mld_d_jac_smoother end interface interface - subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold) + subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,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, psb_ipk_ + & 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_desc_type), Intent(inout) :: desc_a class(mld_d_jac_smoother_type), intent(inout) :: sm @@ -115,9 +119,23 @@ module mld_d_jac_smoother 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_jac_smoother_bld end interface + 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,& + & psb_ipk_, psb_i_base_vect_type + 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 + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine mld_d_jac_smoother_cnv + end interface + interface subroutine mld_d_jac_smoother_clone(sm,smout,info) import :: mld_d_jac_smoother_type, psb_dpk_, & diff --git a/mlprec/mld_d_onelev_mod.f90 b/mlprec/mld_d_onelev_mod.f90 index d4474890..cf045f46 100644 --- a/mlprec/mld_d_onelev_mod.f90 +++ b/mlprec/mld_d_onelev_mod.f90 @@ -57,7 +57,8 @@ 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_dlinmap_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_d_onelev_mod type(psb_dlinmap_type) :: map contains procedure, pass(lv) :: clone => d_base_onelev_clone + procedure, pass(lv) :: cnv => mld_d_base_onelev_cnv procedure, pass(lv) :: descr => mld_d_base_onelev_descr procedure, pass(lv) :: default => d_base_onelev_default procedure, pass(lv) :: free => mld_d_base_onelev_free @@ -170,6 +172,19 @@ module mld_d_onelev_mod integer(psb_ipk_), intent(in), optional :: iout end subroutine mld_d_base_onelev_descr end interface + + interface + subroutine mld_d_base_onelev_cnv(lv,info,amold,vmold,imold) + import :: mld_d_onelev_type, psb_d_base_vect_type, psb_dpk_, & + & psb_d_base_sparse_mat, psb_ipk_, psb_i_base_vect_type + ! Arguments + class(mld_d_onelev_type), intent(inout) :: lv + 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_onelev_cnv + end interface interface subroutine mld_d_base_onelev_free(lv,info) diff --git a/mlprec/mld_d_slu_solver.F90 b/mlprec/mld_d_slu_solver.F90 index 0c9b1dbb..cc615d25 100644 --- a/mlprec/mld_d_slu_solver.F90 +++ b/mlprec/mld_d_slu_solver.F90 @@ -241,7 +241,7 @@ contains end subroutine d_slu_solver_apply_vect - subroutine d_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine d_slu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -256,6 +256,7 @@ contains 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 ! Local variables type(psb_dspmat_type) :: atmp type(psb_d_csr_sparse_mat) :: acsr diff --git a/mlprec/mld_d_sludist_solver.F90 b/mlprec/mld_d_sludist_solver.F90 index fbe501d1..f55004bf 100644 --- a/mlprec/mld_d_sludist_solver.F90 +++ b/mlprec/mld_d_sludist_solver.F90 @@ -237,7 +237,7 @@ contains end subroutine d_sludist_solver_apply_vect - subroutine d_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine d_sludist_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -252,6 +252,7 @@ contains 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 ! Local variables type(psb_dspmat_type) :: atmp type(psb_d_csr_sparse_mat) :: acsr diff --git a/mlprec/mld_d_umf_solver.F90 b/mlprec/mld_d_umf_solver.F90 index 16c12044..70235bd6 100644 --- a/mlprec/mld_d_umf_solver.F90 +++ b/mlprec/mld_d_umf_solver.F90 @@ -245,7 +245,7 @@ contains end subroutine d_umf_solver_apply_vect - subroutine d_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) + subroutine d_umf_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold,imold) use psb_base_mod @@ -260,6 +260,7 @@ contains 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 ! Local variables type(psb_dspmat_type) :: atmp type(psb_d_csc_sparse_mat) :: acsc