mld2p4-2:

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_caggrmat_nosmth_asb.f90
 mlprec/impl/mld_cmlprec_aply.f90
 mlprec/impl/mld_cmlprec_bld.f90
 mlprec/impl/mld_cprecbld.f90
 mlprec/impl/mld_daggrmat_asb.f90
 mlprec/impl/mld_daggrmat_nosmth_asb.f90
 mlprec/impl/mld_dmlprec_aply.f90
 mlprec/impl/mld_dmlprec_bld.f90
 mlprec/impl/mld_dprecbld.f90
 mlprec/impl/mld_saggrmat_nosmth_asb.f90
 mlprec/impl/mld_smlprec_aply.f90
 mlprec/impl/mld_smlprec_bld.f90
 mlprec/impl/mld_sprecbld.f90
 mlprec/impl/mld_zaggrmat_nosmth_asb.f90
 mlprec/impl/mld_zmlprec_aply.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_as_smoother_cseti.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_bld.f90
 mlprec/impl/smoother/mld_d_as_smoother_cnv.f90
 mlprec/impl/smoother/mld_d_as_smoother_cseti.f90
 mlprec/impl/smoother/mld_d_base_smoother_bld.f90
 mlprec/impl/smoother/mld_d_base_smoother_cnv.f90
 mlprec/impl/smoother/mld_d_jac_smoother_bld.f90
 mlprec/impl/smoother/mld_d_jac_smoother_cnv.f90
 mlprec/impl/smoother/mld_s_as_smoother_bld.f90
 mlprec/impl/smoother/mld_s_as_smoother_cnv.f90
 mlprec/impl/smoother/mld_s_as_smoother_cseti.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_as_smoother_cseti.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_base_solver_cnv.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_base_prec_type.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_inner_mod.f90
 mlprec/mld_c_jac_smoother.f90
 mlprec/mld_c_onelev_mod.f90
 mlprec/mld_c_prec_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_inner_mod.f90
 mlprec/mld_d_jac_smoother.f90
 mlprec/mld_d_onelev_mod.f90
 mlprec/mld_d_prec_mod.f90
 mlprec/mld_d_prec_type.f90
 mlprec/mld_d_slu_solver.F90
 mlprec/mld_d_sludist_solver.F90
 mlprec/mld_d_umf_solver.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_inner_mod.f90
 mlprec/mld_s_jac_smoother.f90
 mlprec/mld_s_onelev_mod.f90
 mlprec/mld_s_prec_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_inner_mod.f90
 mlprec/mld_z_jac_smoother.f90
 mlprec/mld_z_onelev_mod.f90
 mlprec/mld_z_prec_mod.f90
 mlprec/mld_z_slu_solver.F90
 mlprec/mld_z_sludist_solver.F90
 mlprec/mld_z_umf_solver.F90
 tests/pdegen/runs/ppde.inp


Merged changes from 299 branch.
stopcriterion
Salvatore Filippone 11 years ago
commit 52ce9d084c

@ -8,45 +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
@ -63,4 +67,3 @@ veryclean: clean
clean:
/bin/rm -f $(OBJS) $(LOCAL_MODS)

@ -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

@ -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_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 (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

@ -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

@ -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

@ -488,18 +488,30 @@ contains
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
if (info /= psb_success_) goto 9999
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,&
& cone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -534,27 +546,45 @@ contains
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,&
& czero,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
!
! Compute the residual
!
call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,&
& cone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
sweeps = p%precv(level)%parms%sweeps_post
call p%precv(level)%sm%apply(cone,&
& mlprec_wrk(level)%x2l,cone,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
else
sweeps = p%precv(level)%parms%sweeps
@ -562,6 +592,11 @@ contains
& mlprec_wrk(level)%x2l,czero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
end if
@ -598,7 +633,11 @@ contains
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
!
! Compute the residual (at all levels but the coarsest one)
@ -607,14 +646,31 @@ contains
call psb_spmm(-cone,p%precv(level)%base_a,&
& mlprec_wrk(level)%y2l,cone,mlprec_wrk(level)%x2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,&
& cone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -658,7 +714,11 @@ contains
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
!
! Compute the residual (at all levels but the coarsest one)
@ -669,12 +729,23 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,&
& cone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -700,33 +771,59 @@ contains
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(cone,mlprec_wrk(level+1)%y2l,&
& czero,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
!
! Compute the residual
!
call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,&
& cone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(cone,&
& mlprec_wrk(level)%x2l,cone,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
else
sweeps = p%precv(level)%parms%sweeps
call p%precv(level)%sm%apply(cone,&
& mlprec_wrk(level)%x2l,czero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
end if
case default
@ -777,6 +874,11 @@ contains
& mlprec_wrk(level)%x2l,czero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
!
! Compute the residual (at all levels but the coarsest one)
! and call recursively
@ -786,8 +888,18 @@ contains
if (info == psb_success_) call psb_spmm(-cone,p%precv(level)%base_a,&
& mlprec_wrk(level)%y2l,cone,mlprec_wrk(level)%ty,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
@ -797,9 +909,9 @@ contains
& cone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_ ) then
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
& a_err='Error during prolongation')
goto 9999
end if
@ -809,6 +921,11 @@ contains
call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,&
& cone,mlprec_wrk(level)%tx,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
!
! Apply the base preconditioner
!
@ -823,7 +940,7 @@ contains
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error: residual/baseprec_aply')
& a_err='Error during smoother_apply')
goto 9999
end if
@ -1054,19 +1171,32 @@ contains
& mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
if (info /= psb_success_) goto 9999
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(cone,mlprec_wrk(level+1)%vy2l,&
& cone,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -1101,27 +1231,47 @@ contains
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(cone,mlprec_wrk(level+1)%vy2l,&
& czero,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
!
! Compute the residual
!
call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
& cone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
sweeps = p%precv(level)%parms%sweeps_post
call p%precv(level)%sm%apply(cone,&
& mlprec_wrk(level)%vx2l,cone,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
else
sweeps = p%precv(level)%parms%sweeps
@ -1129,6 +1279,11 @@ contains
& mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
end if
@ -1164,8 +1319,12 @@ contains
& mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
if (info /= psb_success_) goto 9999
!
! Compute the residual (at all levels but the coarsest one)
@ -1174,14 +1333,28 @@ contains
call psb_spmm(-cone,p%precv(level)%base_a,&
& mlprec_wrk(level)%vy2l,cone,mlprec_wrk(level)%vx2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(cone,mlprec_wrk(level+1)%vy2l,&
& cone,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -1224,8 +1397,12 @@ contains
& mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
if (info /= psb_success_) goto 9999
!
! Compute the residual (at all levels but the coarsest one)
@ -1234,14 +1411,29 @@ contains
call psb_spmm(-cone,p%precv(level)%base_a,&
& mlprec_wrk(level)%vy2l,cone,mlprec_wrk(level)%vx2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(cone,mlprec_wrk(level+1)%vy2l,&
& cone,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -1267,33 +1459,58 @@ contains
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(cone,mlprec_wrk(level+1)%vy2l,&
& czero,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
!
! Compute the residual
!
call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
& cone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(cone,&
& mlprec_wrk(level)%vx2l,cone,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
else
sweeps = p%precv(level)%parms%sweeps
call p%precv(level)%sm%apply(cone,&
& mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
end if
case default
@ -1336,6 +1553,12 @@ contains
& mlprec_wrk(level)%vx2l,czero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
!
! Compute the residual (at all levels but the coarsest one)
! and call recursively
@ -1349,8 +1572,18 @@ contains
if (info == psb_success_) call psb_spmm(-cone,p%precv(level)%base_a,&
& mlprec_wrk(level)%vy2l,cone,mlprec_wrk(level)%vty,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
@ -1360,9 +1593,9 @@ contains
& cone,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_ ) then
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
& a_err='Error during prolongation')
goto 9999
end if
@ -1372,6 +1605,11 @@ contains
call psb_spmm(-cone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
& cone,mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
!
! Apply the base preconditioner
!
@ -1386,7 +1624,7 @@ contains
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error: residual/baseprec_aply')
& a_err='Error during smoother_apply')
goto 9999
end if

@ -74,7 +74,7 @@
!
!
!
subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold)
subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
use psb_base_mod
use mld_c_inner_mod, mld_protect_name => mld_cmlprec_bld
@ -84,11 +84,12 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold)
! Arguments
type(psb_cspmat_type),intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_cprec_type),intent(inout),target :: p
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
!!$ character, intent(in), optional :: upd
! Local Variables
@ -486,11 +487,10 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold)
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,&

@ -58,7 +58,7 @@
! info - integer, output.
! Error code.
!
subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold)
subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold,imold)
use psb_base_mod
use mld_c_inner_mod
@ -68,11 +68,12 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold)
! Arguments
type(psb_cspmat_type),intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_cprec_type),intent(inout), target :: p
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
!!$ character, intent(in), optional :: upd
! Local Variables
@ -173,7 +174,8 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold)
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.')
@ -187,7 +189,8 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold)
!
! 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,&

@ -259,7 +259,10 @@ subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
! op_restr => PR^T i.e. restriction operator
! op_prol => PR i.e. prolongation operator
!
!!$ write(0,*) 'allocated DSC_AC ',allocated(p%desc_ac%v_halo_index%v),&
!!$ & allocated(p%desc_ac%v_ext_index%v),&
!!$ & allocated(p%desc_ac%v_ovrlap_index%v),&
!!$ &allocated(p%desc_ac%v_ovr_mst_idx%v)
p%map = psb_linmap(psb_map_aggr_,desc_a,&
& p%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
if (info == psb_success_) call op_prol%free()

@ -488,18 +488,30 @@ contains
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
if (info /= psb_success_) goto 9999
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,&
& done,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -534,27 +546,45 @@ contains
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,&
& dzero,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
!
! Compute the residual
!
call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%y2l,&
& done,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
sweeps = p%precv(level)%parms%sweeps_post
call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%x2l,done,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
else
sweeps = p%precv(level)%parms%sweeps
@ -562,6 +592,11 @@ contains
& mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
end if
@ -598,7 +633,11 @@ contains
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
!
! Compute the residual (at all levels but the coarsest one)
@ -607,14 +646,31 @@ contains
call psb_spmm(-done,p%precv(level)%base_a,&
& mlprec_wrk(level)%y2l,done,mlprec_wrk(level)%x2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,&
& done,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -658,7 +714,11 @@ contains
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
!
! Compute the residual (at all levels but the coarsest one)
@ -669,12 +729,23 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,&
& done,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -700,33 +771,59 @@ contains
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,&
& dzero,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
!
! Compute the residual
!
call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%y2l,&
& done,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%x2l,done,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
else
sweeps = p%precv(level)%parms%sweeps
call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
end if
case default
@ -777,6 +874,11 @@ contains
& mlprec_wrk(level)%x2l,dzero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
!
! Compute the residual (at all levels but the coarsest one)
! and call recursively
@ -786,8 +888,18 @@ contains
if (info == psb_success_) call psb_spmm(-done,p%precv(level)%base_a,&
& mlprec_wrk(level)%y2l,done,mlprec_wrk(level)%ty,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
@ -797,9 +909,9 @@ contains
& done,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_ ) then
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
& a_err='Error during prolongation')
goto 9999
end if
@ -809,6 +921,11 @@ contains
call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%y2l,&
& done,mlprec_wrk(level)%tx,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
!
! Apply the base preconditioner
!
@ -823,7 +940,7 @@ contains
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error: residual/baseprec_aply')
& a_err='Error during smoother_apply')
goto 9999
end if
@ -911,22 +1028,23 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
end if
level = 1
do level = 1, nlev
!!$ write(0,*) me, 'Allocating MLPREC_WRK at level ',level
call psb_geasb(mlprec_wrk(level)%vx2l,&
& p%precv(level)%base_desc,info,&
& scratch=.true.,mold=x%v)
call psb_geasb(mlprec_wrk(level)%vy2l,&
if (info == 0) call psb_geasb(mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc,info,&
& scratch=.true.,mold=x%v)
call psb_geasb(mlprec_wrk(level)%vtx,&
if (info == 0) call psb_geasb(mlprec_wrk(level)%vtx,&
& p%precv(level)%base_desc,info,&
& scratch=.true.,mold=x%v)
call psb_geasb(mlprec_wrk(level)%vty,&
if (info == 0) call psb_geasb(mlprec_wrk(level)%vty,&
& p%precv(level)%base_desc,info,&
& scratch=.true.,mold=x%v)
if (psb_errstatus_fatal()) then
if ((info/=0).or.psb_errstatus_fatal()) then
nc2l = p%precv(level)%base_desc%get_local_cols()
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),&
call psb_errpush(info,name,i_err=(/4*nc2l,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
@ -948,11 +1066,12 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
call psb_geaxpby(alpha,mlprec_wrk(level)%vy2l,beta,y,&
& p%precv(level)%base_desc,info)
do level = 1, nlev
call mlprec_wrk(level)%vx2l%free(info)
call mlprec_wrk(level)%vy2l%free(info)
call mlprec_wrk(level)%vtx%free(info)
call mlprec_wrk(level)%vty%free(info)
if (psb_errstatus_fatal()) then
!!$ write(0,*) me, 'Freeing MLPREC_WRK at level ',level
if (info == 0) call mlprec_wrk(level)%vx2l%free(info)
if (info == 0) call mlprec_wrk(level)%vy2l%free(info)
if (info == 0) call mlprec_wrk(level)%vtx%free(info)
if (info == 0) call mlprec_wrk(level)%vty%free(info)
if ((info /= 0).or.psb_errstatus_fatal()) then
info=psb_err_alloc_request_
nc2l = p%precv(level)%base_desc%get_local_cols()
call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),&
@ -1054,19 +1173,32 @@ contains
& mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
if (info /= psb_success_) goto 9999
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,&
& done,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -1084,6 +1216,7 @@ contains
select case (trans_)
case('N')
!!$ write(0,*) me,' Applying POST at level ',level
if (level > 1) then
! Apply the restriction
call psb_map_X2Y(done,mlprec_wrk(level-1)%vx2l,&
@ -1101,27 +1234,47 @@ contains
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,&
& dzero,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
!
! Compute the residual
!
call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
& done,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
sweeps = p%precv(level)%parms%sweeps_post
call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%vx2l,done,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
else
sweeps = p%precv(level)%parms%sweeps
@ -1129,9 +1282,14 @@ contains
& mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
end if
!!$ write(0,*) me,' Done POST at level ',level
case('T','C')
! Post-smoothing transpose is pre-smoothing
@ -1164,8 +1322,12 @@ contains
& mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
if (info /= psb_success_) goto 9999
!
! Compute the residual (at all levels but the coarsest one)
@ -1174,14 +1336,28 @@ contains
call psb_spmm(-done,p%precv(level)%base_a,&
& mlprec_wrk(level)%vy2l,done,mlprec_wrk(level)%vx2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,&
& done,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -1224,8 +1400,12 @@ contains
& mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
if (info /= psb_success_) goto 9999
!
! Compute the residual (at all levels but the coarsest one)
@ -1234,14 +1414,29 @@ contains
call psb_spmm(-done,p%precv(level)%base_a,&
& mlprec_wrk(level)%vy2l,done,mlprec_wrk(level)%vx2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,&
& done,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -1267,33 +1462,58 @@ contains
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,&
& dzero,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
!
! Compute the residual
!
call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
& done,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%vx2l,done,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
else
sweeps = p%precv(level)%parms%sweeps
call p%precv(level)%sm%apply(done,&
& mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
end if
case default
@ -1336,6 +1556,12 @@ contains
& mlprec_wrk(level)%vx2l,dzero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
!
! Compute the residual (at all levels but the coarsest one)
! and call recursively
@ -1349,8 +1575,18 @@ contains
if (info == psb_success_) call psb_spmm(-done,p%precv(level)%base_a,&
& mlprec_wrk(level)%vy2l,done,mlprec_wrk(level)%vty,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
@ -1360,9 +1596,9 @@ contains
& done,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_ ) then
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
& a_err='Error during prolongation')
goto 9999
end if
@ -1372,6 +1608,11 @@ contains
call psb_spmm(-done,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
& done,mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
!
! Apply the base preconditioner
!
@ -1386,7 +1627,7 @@ contains
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error: residual/baseprec_aply')
& a_err='Error during smoother_apply')
goto 9999
end if

@ -74,7 +74,7 @@
!
!
!
subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold)
subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
use psb_base_mod
use mld_d_inner_mod, mld_protect_name => mld_dmlprec_bld
@ -84,11 +84,12 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold)
! Arguments
type(psb_dspmat_type),intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_dprec_type),intent(inout),target :: p
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
!!$ character, intent(in), optional :: upd
! Local Variables
@ -486,11 +487,10 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold)
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,&

@ -58,7 +58,7 @@
! info - integer, output.
! Error code.
!
subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold)
subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold)
use psb_base_mod
use mld_d_inner_mod
@ -68,11 +68,12 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold)
! Arguments
type(psb_dspmat_type),intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_dprec_type),intent(inout), target :: p
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
!!$ character, intent(in), optional :: upd
! Local Variables
@ -173,8 +174,9 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold)
goto 9999
endif
call p%precv(1)%sm%build(a,desc_a,upd_,info,amold=amold,vmold=vmold)
if (info /= psb_success_) then
call p%precv(1)%sm%build(a,desc_a,upd_,info,&
& amold=amold,vmold=vmold,imold=imold)
if ((info /= psb_success_).or.psb_errstatus_fatal()) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='One level preconditioner build.')
goto 9999
@ -187,9 +189,10 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold)
!
! 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
if ((info /= psb_success_).or.psb_errstatus_fatal()) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Multilevel preconditioner build.')
goto 9999

@ -488,18 +488,30 @@ contains
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
if (info /= psb_success_) goto 9999
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,&
& sone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -534,27 +546,45 @@ contains
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,&
& szero,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
!
! Compute the residual
!
call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,&
& sone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
sweeps = p%precv(level)%parms%sweeps_post
call p%precv(level)%sm%apply(sone,&
& mlprec_wrk(level)%x2l,sone,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
else
sweeps = p%precv(level)%parms%sweeps
@ -562,6 +592,11 @@ contains
& mlprec_wrk(level)%x2l,szero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
end if
@ -598,7 +633,11 @@ contains
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
!
! Compute the residual (at all levels but the coarsest one)
@ -607,14 +646,31 @@ contains
call psb_spmm(-sone,p%precv(level)%base_a,&
& mlprec_wrk(level)%y2l,sone,mlprec_wrk(level)%x2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,&
& sone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -658,7 +714,11 @@ contains
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
!
! Compute the residual (at all levels but the coarsest one)
@ -669,12 +729,23 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,&
& sone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -700,33 +771,59 @@ contains
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(sone,mlprec_wrk(level+1)%y2l,&
& szero,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
!
! Compute the residual
!
call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,&
& sone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(sone,&
& mlprec_wrk(level)%x2l,sone,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
else
sweeps = p%precv(level)%parms%sweeps
call p%precv(level)%sm%apply(sone,&
& mlprec_wrk(level)%x2l,szero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
end if
case default
@ -777,6 +874,11 @@ contains
& mlprec_wrk(level)%x2l,szero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
!
! Compute the residual (at all levels but the coarsest one)
! and call recursively
@ -786,8 +888,18 @@ contains
if (info == psb_success_) call psb_spmm(-sone,p%precv(level)%base_a,&
& mlprec_wrk(level)%y2l,sone,mlprec_wrk(level)%ty,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
@ -797,9 +909,9 @@ contains
& sone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_ ) then
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
& a_err='Error during prolongation')
goto 9999
end if
@ -809,6 +921,11 @@ contains
call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,&
& sone,mlprec_wrk(level)%tx,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
!
! Apply the base preconditioner
!
@ -823,7 +940,7 @@ contains
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error: residual/baseprec_aply')
& a_err='Error during smoother_apply')
goto 9999
end if
@ -1054,19 +1171,32 @@ contains
& mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
if (info /= psb_success_) goto 9999
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(sone,mlprec_wrk(level+1)%vy2l,&
& sone,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -1101,27 +1231,47 @@ contains
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(sone,mlprec_wrk(level+1)%vy2l,&
& szero,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
!
! Compute the residual
!
call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
& sone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
sweeps = p%precv(level)%parms%sweeps_post
call p%precv(level)%sm%apply(sone,&
& mlprec_wrk(level)%vx2l,sone,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
else
sweeps = p%precv(level)%parms%sweeps
@ -1129,6 +1279,11 @@ contains
& mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
end if
@ -1164,8 +1319,12 @@ contains
& mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
if (info /= psb_success_) goto 9999
!
! Compute the residual (at all levels but the coarsest one)
@ -1174,14 +1333,28 @@ contains
call psb_spmm(-sone,p%precv(level)%base_a,&
& mlprec_wrk(level)%vy2l,sone,mlprec_wrk(level)%vx2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(sone,mlprec_wrk(level+1)%vy2l,&
& sone,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -1224,8 +1397,12 @@ contains
& mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
if (info /= psb_success_) goto 9999
!
! Compute the residual (at all levels but the coarsest one)
@ -1234,14 +1411,29 @@ contains
call psb_spmm(-sone,p%precv(level)%base_a,&
& mlprec_wrk(level)%vy2l,sone,mlprec_wrk(level)%vx2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(sone,mlprec_wrk(level+1)%vy2l,&
& sone,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -1267,33 +1459,58 @@ contains
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(sone,mlprec_wrk(level+1)%vy2l,&
& szero,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
!
! Compute the residual
!
call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
& sone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(sone,&
& mlprec_wrk(level)%vx2l,sone,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
else
sweeps = p%precv(level)%parms%sweeps
call p%precv(level)%sm%apply(sone,&
& mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
end if
case default
@ -1336,6 +1553,12 @@ contains
& mlprec_wrk(level)%vx2l,szero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
!
! Compute the residual (at all levels but the coarsest one)
! and call recursively
@ -1349,8 +1572,18 @@ contains
if (info == psb_success_) call psb_spmm(-sone,p%precv(level)%base_a,&
& mlprec_wrk(level)%vy2l,sone,mlprec_wrk(level)%vty,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
@ -1360,9 +1593,9 @@ contains
& sone,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_ ) then
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
& a_err='Error during prolongation')
goto 9999
end if
@ -1372,6 +1605,11 @@ contains
call psb_spmm(-sone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
& sone,mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
!
! Apply the base preconditioner
!
@ -1386,7 +1624,7 @@ contains
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error: residual/baseprec_aply')
& a_err='Error during smoother_apply')
goto 9999
end if

@ -74,7 +74,7 @@
!
!
!
subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold)
subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
use psb_base_mod
use mld_s_inner_mod, mld_protect_name => mld_smlprec_bld
@ -84,11 +84,12 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold)
! Arguments
type(psb_sspmat_type),intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_sprec_type),intent(inout),target :: p
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
!!$ character, intent(in), optional :: upd
! Local Variables
@ -486,11 +487,10 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold)
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,&

@ -58,7 +58,7 @@
! info - integer, output.
! Error code.
!
subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold)
subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold,imold)
use psb_base_mod
use mld_s_inner_mod
@ -68,11 +68,12 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold)
! Arguments
type(psb_sspmat_type),intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_sprec_type),intent(inout), target :: p
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
!!$ character, intent(in), optional :: upd
! Local Variables
@ -173,7 +174,8 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold)
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.')
@ -187,7 +189,8 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold)
!
! 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,&

@ -488,18 +488,30 @@ contains
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
if (info /= psb_success_) goto 9999
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,&
& zone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -534,27 +546,45 @@ contains
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,&
& zzero,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
!
! Compute the residual
!
call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,&
& zone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
sweeps = p%precv(level)%parms%sweeps_post
call p%precv(level)%sm%apply(zone,&
& mlprec_wrk(level)%x2l,zone,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
else
sweeps = p%precv(level)%parms%sweeps
@ -562,6 +592,11 @@ contains
& mlprec_wrk(level)%x2l,zzero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
end if
@ -598,7 +633,11 @@ contains
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
!
! Compute the residual (at all levels but the coarsest one)
@ -607,14 +646,31 @@ contains
call psb_spmm(-zone,p%precv(level)%base_a,&
& mlprec_wrk(level)%y2l,zone,mlprec_wrk(level)%x2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,&
& zone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -658,7 +714,11 @@ contains
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
!
! Compute the residual (at all levels but the coarsest one)
@ -669,12 +729,23 @@ contains
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,&
& zone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -700,33 +771,59 @@ contains
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(zone,mlprec_wrk(level+1)%y2l,&
& zzero,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
!
! Compute the residual
!
call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,&
& zone,mlprec_wrk(level)%x2l,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(zone,&
& mlprec_wrk(level)%x2l,zone,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
else
sweeps = p%precv(level)%parms%sweeps
call p%precv(level)%sm%apply(zone,&
& mlprec_wrk(level)%x2l,zzero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
end if
case default
@ -777,6 +874,11 @@ contains
& mlprec_wrk(level)%x2l,zzero,mlprec_wrk(level)%y2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
!
! Compute the residual (at all levels but the coarsest one)
! and call recursively
@ -786,8 +888,18 @@ contains
if (info == psb_success_) call psb_spmm(-zone,p%precv(level)%base_a,&
& mlprec_wrk(level)%y2l,zone,mlprec_wrk(level)%ty,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
@ -797,9 +909,9 @@ contains
& zone,mlprec_wrk(level)%y2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_ ) then
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
& a_err='Error during prolongation')
goto 9999
end if
@ -809,6 +921,11 @@ contains
call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%y2l,&
& zone,mlprec_wrk(level)%tx,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
!
! Apply the base preconditioner
!
@ -823,7 +940,7 @@ contains
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error: residual/baseprec_aply')
& a_err='Error during smoother_apply')
goto 9999
end if
@ -1054,19 +1171,32 @@ contains
& mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
if (info /= psb_success_) goto 9999
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(zone,mlprec_wrk(level+1)%vy2l,&
& zone,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -1101,27 +1231,47 @@ contains
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(zone,mlprec_wrk(level+1)%vy2l,&
& zzero,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
!
! Compute the residual
!
call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
& zone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
sweeps = p%precv(level)%parms%sweeps_post
call p%precv(level)%sm%apply(zone,&
& mlprec_wrk(level)%vx2l,zone,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
else
sweeps = p%precv(level)%parms%sweeps
@ -1129,6 +1279,11 @@ contains
& mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
end if
@ -1164,8 +1319,12 @@ contains
& mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
if (info /= psb_success_) goto 9999
!
! Compute the residual (at all levels but the coarsest one)
@ -1174,14 +1333,28 @@ contains
call psb_spmm(-zone,p%precv(level)%base_a,&
& mlprec_wrk(level)%vy2l,zone,mlprec_wrk(level)%vx2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(zone,mlprec_wrk(level+1)%vy2l,&
& zone,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -1224,8 +1397,12 @@ contains
& mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
if (info /= psb_success_) goto 9999
!
! Compute the residual (at all levels but the coarsest one)
@ -1234,14 +1411,29 @@ contains
call psb_spmm(-zone,p%precv(level)%base_a,&
& mlprec_wrk(level)%vy2l,zone,mlprec_wrk(level)%vx2l,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
call psb_map_Y2X(zone,mlprec_wrk(level+1)%vy2l,&
& zone,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
end if
@ -1267,33 +1459,58 @@ contains
if (level < nlev) then
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
! Apply the prolongator
!
call psb_map_Y2X(zone,mlprec_wrk(level+1)%vy2l,&
& zzero,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during prolongation')
goto 9999
end if
!
! Compute the residual
!
call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
& zone,mlprec_wrk(level)%vx2l,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) goto 9999
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
sweeps = p%precv(level)%parms%sweeps_pre
call p%precv(level)%sm%apply(zone,&
& mlprec_wrk(level)%vx2l,zone,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
else
sweeps = p%precv(level)%parms%sweeps
call p%precv(level)%sm%apply(zone,&
& mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
end if
case default
@ -1336,6 +1553,12 @@ contains
& mlprec_wrk(level)%vx2l,zzero,mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc, trans,&
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during smoother_apply')
goto 9999
end if
!
! Compute the residual (at all levels but the coarsest one)
! and call recursively
@ -1349,8 +1572,18 @@ contains
if (info == psb_success_) call psb_spmm(-zone,p%precv(level)%base_a,&
& mlprec_wrk(level)%vy2l,zone,mlprec_wrk(level)%vty,&
& p%precv(level)%base_desc,info,work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error in recursive call')
goto 9999
end if
!
@ -1360,9 +1593,9 @@ contains
& zone,mlprec_wrk(level)%vy2l,&
& p%precv(level+1)%map,info,work=work)
if (info /= psb_success_ ) then
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction')
& a_err='Error during prolongation')
goto 9999
end if
@ -1372,6 +1605,11 @@ contains
call psb_spmm(-zone,p%precv(level)%base_a,mlprec_wrk(level)%vy2l,&
& zone,mlprec_wrk(level)%vtx,p%precv(level)%base_desc,info,&
& work=work,trans=trans)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during residue')
goto 9999
end if
!
! Apply the base preconditioner
!
@ -1386,7 +1624,7 @@ contains
& sweeps,work,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error: residual/baseprec_aply')
& a_err='Error during smoother_apply')
goto 9999
end if

@ -74,7 +74,7 @@
!
!
!
subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold)
subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
use psb_base_mod
use mld_z_inner_mod, mld_protect_name => mld_zmlprec_bld
@ -84,11 +84,12 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold)
! Arguments
type(psb_zspmat_type),intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_zprec_type),intent(inout),target :: p
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
!!$ character, intent(in), optional :: upd
! Local Variables
@ -486,11 +487,10 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold)
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,&

@ -58,7 +58,7 @@
! info - integer, output.
! Error code.
!
subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold)
subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold,imold)
use psb_base_mod
use mld_z_inner_mod
@ -68,11 +68,12 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold)
! Arguments
type(psb_zspmat_type),intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_zprec_type),intent(inout), target :: p
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
!!$ character, intent(in), optional :: upd
! Local Variables
@ -173,7 +174,8 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold)
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.')
@ -187,7 +189,8 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold)
!
! 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,&

@ -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,11 +40,13 @@ 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 \
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 +60,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,11 +74,13 @@ 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 \
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 \
@ -87,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 \
@ -100,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 \
@ -118,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 \
@ -130,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
@ -150,4 +161,3 @@ veryclean: clean
clean:
/bin/rm -f $(OBJS) $(LOCAL_MODS)

@ -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
@ -44,12 +44,13 @@ subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
! Arguments
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(inout) :: desc_a
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
! 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

@ -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

@ -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
@ -44,12 +44,13 @@ subroutine mld_c_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
! Arguments
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(inout) :: desc_a
class(mld_c_base_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
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_base_smoother_bld'

@ -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

@ -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(in) :: 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(:)

@ -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

@ -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
@ -44,12 +44,13 @@ subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
! Arguments
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(inout) :: desc_a
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
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

@ -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 (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_d_as_smoother_cnv

@ -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
@ -44,12 +44,13 @@ subroutine mld_d_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
! Arguments
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(inout) :: desc_a
class(mld_d_base_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
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'

@ -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

@ -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
@ -45,12 +45,13 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
! Arguments
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: 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
! Local variables
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)

@ -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

@ -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
@ -44,12 +44,13 @@ subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
! Arguments
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(inout) :: desc_a
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
! 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

@ -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

@ -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
@ -44,12 +44,13 @@ subroutine mld_s_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
! Arguments
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(inout) :: desc_a
class(mld_s_base_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
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_base_smoother_bld'

@ -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

@ -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(in) :: 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(:)

@ -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

@ -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
@ -44,12 +44,13 @@ subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
! Arguments
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(inout) :: desc_a
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
! 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

@ -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

@ -53,6 +53,7 @@ subroutine mld_z_as_smoother_cseti(sm,what,val,info)
info = psb_success_
call psb_erractionsave(err_act)
select case(psb_toupper(what))
case('SUB_OVR')
sm%novr = val

@ -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
@ -44,12 +44,13 @@ subroutine mld_z_base_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
! Arguments
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(inout) :: desc_a
class(mld_z_base_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
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_base_smoother_bld'

@ -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

@ -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(in) :: 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(:)

@ -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

@ -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,12 +34,14 @@ 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 \
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 +55,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,12 +63,14 @@ 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 \
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 \
@ -77,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 \
@ -84,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 \
@ -103,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 \
@ -110,6 +121,7 @@ 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_cnv.o \
mld_z_ilu_solver_dmp.o

@ -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'

@ -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

@ -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(:)

@ -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

@ -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(:)

@ -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

@ -36,20 +36,21 @@
!!$ 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
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
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_bld'

@ -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

@ -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
@ -45,13 +45,14 @@ subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! 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
! Local variables
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)

@ -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_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_) :: 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_d_diag_solver_cnv

@ -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
@ -45,13 +45,14 @@ subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
! 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
! Local variables
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
!!$ real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)

@ -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_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_) :: 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_d_ilu_solver_cnv

@ -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'

@ -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

@ -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(:)

@ -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

@ -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(:)

@ -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

@ -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'

@ -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

@ -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(:)

@ -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

@ -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(:)

@ -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

@ -65,7 +65,7 @@ module mld_base_prec_type
!
use psb_const_mod
use psb_base_mod, only :&
& psb_desc_type,&
& psb_desc_type, psb_i_vect_type, psb_i_base_vect_type,&
& psb_ipk_, psb_dpk_, psb_spk_, psb_long_int_k_, &
& psb_cdfree, psb_halo_, psb_none_, psb_sum_, psb_avg_, &
& psb_nohalo_, psb_square_root_, psb_toupper, psb_root_,&

@ -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(in) :: desc_a
class(mld_c_as_smoother_type), intent(inout) :: sm
Type(psb_desc_type), Intent(inout) :: desc_a
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, &

@ -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,21 +247,35 @@ 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(in) :: desc_a
Type(psb_desc_type), Intent(inout) :: desc_a
class(mld_c_base_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_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, &

@ -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

@ -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,9 +115,22 @@ 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)
import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, &

@ -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(:)

@ -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,21 +127,37 @@ 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)
import :: psb_desc_type, mld_c_ilu_solver_type, psb_c_vect_type, psb_spk_, &

@ -48,17 +48,18 @@ module mld_c_inner_mod
use mld_c_prec_type
interface mld_mlprec_bld
subroutine mld_cmlprec_bld(a,desc_a,prec,info, amold, vmold)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, &
subroutine mld_cmlprec_bld(a,desc_a,prec,info, amold, vmold,imold)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_i_base_vect_type, &
& psb_spk_, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
use mld_c_prec_type, only : mld_cprec_type
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_cprec_type), intent(inout), target :: prec
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
!!$ character, intent(in),optional :: upd
end subroutine mld_cmlprec_bld
end interface mld_mlprec_bld

@ -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
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_c_jac_smoother_type), intent(inout) :: sm
& 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
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_, &

@ -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
@ -171,6 +173,19 @@ module mld_c_onelev_mod
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, &

@ -72,17 +72,18 @@ module mld_c_prec_mod
!!$ interface mld_inner_precset
interface mld_precbld
subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold)
subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
import :: psb_cspmat_type, psb_desc_type, psb_spk_, &
& psb_c_base_sparse_mat, psb_c_base_vect_type, &
& mld_cprec_type, psb_ipk_
& psb_i_base_vect_type, mld_cprec_type, psb_ipk_
implicit none
type(psb_cspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_cprec_type), intent(inout), target :: prec
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
!!$ character, intent(in),optional :: upd
end subroutine mld_cprecbld
end interface

@ -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

@ -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

@ -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

@ -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,9 +96,11 @@ 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_
& 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
@ -112,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
@ -129,21 +134,37 @@ 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(in) :: desc_a
class(mld_d_as_smoother_type), intent(inout) :: sm
Type(psb_desc_type), Intent(inout) :: desc_a
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
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_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, &

@ -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,21 +247,35 @@ 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(in) :: desc_a
Type(psb_desc_type), Intent(inout) :: desc_a
class(mld_d_base_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
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_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
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, &

@ -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,40 @@ 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_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_d_base_solver_type), intent(inout) :: sv
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
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, &
@ -173,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
@ -186,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
@ -201,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
@ -215,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

@ -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,10 +103,10 @@ 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
class(mld_d_diag_solver_type), intent(inout) :: sv
@ -113,9 +115,22 @@ module mld_d_diag_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_diag_solver_bld
end interface
interface
subroutine mld_d_diag_solver_cnv(sv,info,amold,vmold,imold)
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
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)
import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, &

@ -112,19 +112,20 @@ 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
! 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
! Local variables
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)

@ -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,21 +127,37 @@ 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
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
end subroutine mld_d_ilu_solver_bld
end interface
interface
subroutine mld_d_ilu_solver_cnv(sv,info,amold,vmold,imold)
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
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)
import :: psb_desc_type, mld_d_ilu_solver_type, psb_d_vect_type, psb_dpk_, &

@ -48,17 +48,18 @@ module mld_d_inner_mod
use mld_d_prec_type
interface mld_mlprec_bld
subroutine mld_dmlprec_bld(a,desc_a,prec,info, amold, vmold)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, &
subroutine mld_dmlprec_bld(a,desc_a,prec,info, amold, vmold,imold)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_i_base_vect_type, &
& psb_dpk_, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
use mld_d_prec_type, only : mld_dprec_type
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_dprec_type), intent(inout), target :: prec
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
!!$ character, intent(in),optional :: upd
end subroutine mld_dmlprec_bld
end interface mld_mlprec_bld

@ -55,6 +55,7 @@ module mld_d_jac_smoother
integer(psb_ipk_) :: nnz_nd_tot
contains
procedure, pass(sm) :: build => mld_d_jac_smoother_bld
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
@ -72,9 +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
@ -89,9 +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(:)
@ -105,19 +110,34 @@ 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_
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_d_jac_smoother_type), intent(inout) :: sm
& 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
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
end subroutine mld_d_jac_smoother_bld
end interface
interface
subroutine mld_d_jac_smoother_cnv(sm,info,amold,vmold,imold)
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
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_, &

@ -56,8 +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
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.
@ -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
@ -171,6 +173,19 @@ module mld_d_onelev_mod
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)
import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, &

@ -72,17 +72,18 @@ module mld_d_prec_mod
!!$ interface mld_inner_precset
interface mld_precbld
subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold)
subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
& psb_d_base_sparse_mat, psb_d_base_vect_type, &
& mld_dprec_type, psb_ipk_
& psb_i_base_vect_type, mld_dprec_type, psb_ipk_
implicit none
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(psb_desc_type), intent(inout), target :: desc_a
type(mld_dprec_type), intent(inout), target :: prec
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
!!$ character, intent(in),optional :: upd
end subroutine mld_dprecbld
end interface

@ -439,6 +439,7 @@ contains
root_ = psb_root_
end if
if (root_ == -1) root_ = me
!
! The preconditioner description is printed by processor psb_root_.
! This agrees with the fact that all the parameters defining the

@ -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

@ -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

@ -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

@ -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(in) :: desc_a
class(mld_s_as_smoother_type), intent(inout) :: sm
Type(psb_desc_type), Intent(inout) :: desc_a
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, &

@ -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,21 +247,35 @@ 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(in) :: desc_a
Type(psb_desc_type), Intent(inout) :: desc_a
class(mld_s_base_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_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, &

@ -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

Some files were not shown because too many files have changed in this diff Show More

Loading…
Cancel
Save