diff --git a/amgprec/Makefile b/amgprec/Makefile index 595e3497..d6f3e631 100644 --- a/amgprec/Makefile +++ b/amgprec/Makefile @@ -13,7 +13,9 @@ DMODOBJS=amg_d_prec_type.o \ amg_d_base_solver_mod.o amg_d_base_smoother_mod.o amg_d_onelev_mod.o \ amg_d_gs_solver.o amg_d_mumps_solver.o \ amg_d_base_aggregator_mod.o \ - amg_d_dec_aggregator_mod.o amg_d_symdec_aggregator_mod.o + amg_d_dec_aggregator_mod.o amg_d_symdec_aggregator_mod.o \ + amg_d_ainv_solver.o amg_d_base_ainv_mod.o \ + amg_d_invk_solver.o amg_d_invt_solver.o #amg_d_bcmatch_aggregator_mod.o SMODOBJS=amg_s_prec_type.o amg_s_ilu_fact_mod.o \ @@ -22,7 +24,9 @@ SMODOBJS=amg_s_prec_type.o amg_s_ilu_fact_mod.o \ amg_s_base_solver_mod.o amg_s_base_smoother_mod.o amg_s_onelev_mod.o \ amg_s_gs_solver.o amg_s_mumps_solver.o \ amg_s_base_aggregator_mod.o \ - amg_s_dec_aggregator_mod.o amg_s_symdec_aggregator_mod.o + amg_s_dec_aggregator_mod.o amg_s_symdec_aggregator_mod.o \ + amg_s_ainv_solver.o amg_s_base_ainv_mod.o \ + amg_s_invk_solver.o amg_s_invt_solver.o ZMODOBJS=amg_z_prec_type.o amg_z_ilu_fact_mod.o \ amg_z_inner_mod.o amg_z_ilu_solver.o amg_z_diag_solver.o amg_z_jac_smoother.o amg_z_as_smoother.o \ @@ -30,7 +34,9 @@ ZMODOBJS=amg_z_prec_type.o amg_z_ilu_fact_mod.o \ amg_z_base_solver_mod.o amg_z_base_smoother_mod.o amg_z_onelev_mod.o \ amg_z_gs_solver.o amg_z_mumps_solver.o \ amg_z_base_aggregator_mod.o \ - amg_z_dec_aggregator_mod.o amg_z_symdec_aggregator_mod.o + amg_z_dec_aggregator_mod.o amg_z_symdec_aggregator_mod.o \ + amg_z_ainv_solver.o amg_z_base_ainv_mod.o \ + amg_z_invk_solver.o amg_z_invt_solver.o CMODOBJS=amg_c_prec_type.o amg_c_ilu_fact_mod.o \ amg_c_inner_mod.o amg_c_ilu_solver.o amg_c_diag_solver.o amg_c_jac_smoother.o amg_c_as_smoother.o \ @@ -38,16 +44,19 @@ CMODOBJS=amg_c_prec_type.o amg_c_ilu_fact_mod.o \ amg_c_base_solver_mod.o amg_c_base_smoother_mod.o amg_c_onelev_mod.o \ amg_c_gs_solver.o amg_c_mumps_solver.o \ amg_c_base_aggregator_mod.o \ - amg_c_dec_aggregator_mod.o amg_c_symdec_aggregator_mod.o + amg_c_dec_aggregator_mod.o amg_c_symdec_aggregator_mod.o \ + amg_c_ainv_solver.o amg_c_base_ainv_mod.o \ + amg_c_invk_solver.o amg_c_invt_solver.o MODOBJS=amg_base_prec_type.o amg_prec_type.o amg_prec_mod.o \ amg_s_prec_mod.o amg_d_prec_mod.o amg_c_prec_mod.o amg_z_prec_mod.o \ - $(SMODOBJS) $(DMODOBJS) $(CMODOBJS) $(ZMODOBJS) + amg_base_ainv_mod.o amg_ainv_mod.o\ + $(SMODOBJS) $(DMODOBJS) $(CMODOBJS) $(ZMODOBJS) -OBJS=$(MODOBJS) +OBJS=$(MODOBJS) LOCAL_MODS=$(MODOBJS:.o=$(.mod)) LIBNAME=libamg_prec.a @@ -67,9 +76,9 @@ lib: $(OBJS) impld $(MODOBJS): $(PSBLAS_MODDIR)/$(BASEMODNAME)$(.mod) -amg_base_prec_type.o: amg_const.h +amg_base_prec_type.o: amg_const.h amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o : amg_base_prec_type.o -amg_prec_type.o: amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o +amg_prec_type.o: amg_s_prec_type.o amg_d_prec_type.o amg_c_prec_type.o amg_z_prec_type.o amg_prec_mod.o: amg_prec_type.o amg_s_prec_mod.o amg_d_prec_mod.o amg_c_prec_mod.o amg_z_prec_mod.o $(SINNEROBJS) $(SOUTEROBJS): $(SMODOBJS) @@ -82,10 +91,10 @@ amg_d_inner_mod.o: amg_d_prec_type.o amg_c_inner_mod.o: amg_c_prec_type.o amg_z_inner_mod.o: amg_z_prec_type.o -amg_s_prec_mod.o: $(SMODOBJS) -amg_d_prec_mod.o: $(DMODOBJS) -amg_c_prec_mod.o: $(CMODOBJS) -amg_z_prec_mod.o: $(ZMODOBJS) +amg_s_prec_mod.o: $(SMODOBJS) +amg_d_prec_mod.o: $(DMODOBJS) +amg_c_prec_mod.o: $(CMODOBJS) +amg_z_prec_mod.o: $(ZMODOBJS) amg_s_prec_type.o: amg_s_onelev_mod.o @@ -119,6 +128,14 @@ amg_d_base_smoother_mod.o: amg_d_base_solver_mod.o amg_c_base_smoother_mod.o: amg_c_base_solver_mod.o amg_z_base_smoother_mod.o: amg_z_base_solver_mod.o +amg_s_ainv_solver.o: amg_s_base_ainv_mod.o +amg_c_ainv_solver.o: amg_c_base_ainv_mod.o +amg_d_ainv_solver.o: amg_d_base_ainv_mod.o +amg_z_ainv_solver.o: amg_z_base_ainv_mod.o +amg_s_base_ainv_mod.o: amg_s_base_solver_mod.o amg_base_ainv_mod.o +amg_c_base_ainv_mod.o: amg_c_base_solver_mod.o amg_base_ainv_mod.o +amg_d_base_ainv_mod.o: amg_d_base_solver_mod.o amg_base_ainv_mod.o +amg_z_base_ainv_mod.o: amg_z_base_solver_mod.o amg_base_ainv_mod.o amg_s_base_solver_mod.o amg_d_base_solver_mod.o amg_c_base_solver_mod.o amg_z_base_solver_mod.o: amg_base_prec_type.o @@ -141,11 +158,11 @@ amg_s_as_smoother.o amg_s_jac_smoother.o: amg_s_base_smoother_mod.o amg_s_jac_smoother.o: amg_s_diag_solver.o amg_sprecinit.o amg_sprecset.o: amg_s_diag_solver.o amg_s_ilu_solver.o \ amg_s_as_smoother.o amg_s_jac_smoother.o \ - amg_s_id_solver.o amg_s_slu_solver.o + amg_s_id_solver.o amg_s_slu_solver.o amg_z_mumps_solver.o amg_z_gs_solver.o amg_z_id_solver.o amg_z_sludist_solver.o amg_z_slu_solver.o \ amg_z_umf_solver.o amg_z_diag_solver.o amg_z_ilu_solver.o: amg_z_base_solver_mod.o amg_z_prec_type.o -amg_z_ilu_fact_mod.o: amg_base_prec_type.o amg_z_base_solver_mod.o +amg_z_ilu_fact_mod.o: amg_base_prec_type.o amg_z_base_solver_mod.o amg_z_ilu_solver.o amg_z_iluk_fact.o: amg_z_ilu_fact_mod.o amg_z_as_smoother.o amg_z_jac_smoother.o: amg_z_base_smoother_mod.o amg_z_jac_smoother.o: amg_z_diag_solver.o @@ -163,7 +180,24 @@ amg_cprecinit.o amg_cprecset.o: amg_c_diag_solver.o amg_c_ilu_solver.o \ amg_c_as_smoother.o amg_c_jac_smoother.o \ amg_c_id_solver.o amg_c_slu_solver.o amg_c_sludist_solver.o - +amg_base_ainv_mod.o: amg_base_prec_type.o +amg_s_base_ainv_mod.o amg_d_base_ainv_mod.o amg_c_base_ainv_mod.o amg_z_base_ainv_mod.o: amg_base_ainv_mod.o +amg_s_ainv_solver.o: amg_base_ainv_mod.o amg_s_base_ainv_mod.o +amg_d_ainv_solver.o: amg_base_ainv_mod.o amg_d_base_ainv_mod.o +amg_c_ainv_solver.o: amg_base_ainv_mod.o amg_c_base_ainv_mod.o +amg_z_ainv_solver.o: amg_base_ainv_mod.o amg_z_base_ainv_mod.o +amg_s_invk_solver.o: amg_base_ainv_mod.o amg_s_base_ainv_mod.o +amg_d_invk_solver.o: amg_base_ainv_mod.o amg_d_base_ainv_mod.o +amg_c_invk_solver.o: amg_base_ainv_mod.o amg_c_base_ainv_mod.o +amg_z_invk_solver.o: amg_base_ainv_mod.o amg_z_base_ainv_mod.o +amg_s_invt_solver.o: amg_base_ainv_mod.o amg_s_base_ainv_mod.o +amg_d_invt_solver.o: amg_base_ainv_mod.o amg_d_base_ainv_mod.o +amg_c_invt_solver.o: amg_base_ainv_mod.o amg_c_base_ainv_mod.o +amg_z_invt_solver.o: amg_base_ainv_mod.o amg_z_base_ainv_mod.o +amg_ainv_mod.o: amg_s_ainv_solver.o amg_d_ainv_solver.o amg_c_ainv_solver.o \ + amg_z_ainv_solver.o amg_s_invk_solver.o amg_d_invk_solver.o amg_c_invk_solver.o \ + amg_z_invk_solver.o amg_s_invt_solver.o amg_d_invt_solver.o amg_c_invt_solver.o \ + amg_z_invt_solver.o veryclean: clean /bin/rm -f $(LIBNAME) diff --git a/amgprec/amg_ainv_mod.f90 b/amgprec/amg_ainv_mod.f90 new file mode 100644 index 00000000..b5cf477b --- /dev/null +++ b/amgprec/amg_ainv_mod.f90 @@ -0,0 +1,49 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +module amg_ainv_mod + use amg_d_ainv_solver + use amg_d_invk_solver + use amg_d_invt_solver + use amg_s_ainv_solver + use amg_s_invk_solver + use amg_s_invt_solver + use amg_c_ainv_solver + use amg_c_invk_solver + use amg_c_invt_solver + use amg_c_ainv_solver + use amg_c_invk_solver + use amg_c_invt_solver +end module amg_ainv_mod diff --git a/amgprec/amg_base_ainv_mod.F90 b/amgprec/amg_base_ainv_mod.F90 new file mode 100644 index 00000000..f5941acb --- /dev/null +++ b/amgprec/amg_base_ainv_mod.F90 @@ -0,0 +1,64 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +module amg_base_ainv_mod + + use amg_base_prec_type + use psb_prec_const_mod, only : psb_inv_fillin_, psb_inv_thresh_ + + integer, parameter :: amg_inv_fillin_ = psb_inv_fillin_ + integer, parameter :: amg_ainv_alg_ = amg_inv_fillin_ + 1 + integer, parameter :: amg_inv_thresh_ = psb_inv_thresh_ +#if 0 + integer, parameter :: amg_ainv_orth1_ = amg_inv_thresh_ + 1 + integer, parameter :: amg_ainv_orth2_ = amg_ainv_orth1_ + 1 + integer, parameter :: amg_ainv_orth3_ = amg_ainv_orth2_ + 1 + integer, parameter :: amg_ainv_orth4_ = amg_ainv_orth3_ + 1 + integer, parameter :: amg_ainv_llk_ = amg_ainv_orth4_ + 1 +#else + integer, parameter :: amg_ainv_llk_ = amg_inv_thresh_ + 1 +#endif + integer, parameter :: amg_ainv_s_llk_ = amg_ainv_llk_ + 1 + integer, parameter :: amg_ainv_s_ft_llk_ = amg_ainv_s_llk_ + 1 + integer, parameter :: amg_ainv_llk_noth_ = amg_ainv_s_ft_llk_ + 1 + integer, parameter :: amg_ainv_mlk_ = amg_ainv_llk_noth_ + 1 + integer, parameter :: amg_ainv_lmx_ = amg_ainv_mlk_ +#if defined(HAVE_TUMA_SAINV) + integer, parameter :: amg_ainv_s_tuma_ = amg_ainv_lmx_ + 1 + integer, parameter :: amg_ainv_l_tuma_ = amg_ainv_s_tuma_ + 1 +#endif + + +end module amg_base_ainv_mod diff --git a/amgprec/amg_c_ainv_solver.F90 b/amgprec/amg_c_ainv_solver.F90 new file mode 100644 index 00000000..c5796f21 --- /dev/null +++ b/amgprec/amg_c_ainv_solver.F90 @@ -0,0 +1,321 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +! +! +! +! +module amg_c_ainv_solver + + use amg_c_base_ainv_mod + use psb_base_mod, only : psb_d_vect_type + + type, extends(amg_c_base_ainv_solver_type) :: amg_c_ainv_solver_type + ! + ! Compute an approximate factorization + ! A^-1 = Z D^-1 W^T + ! Note that here W is going to be transposed explicitly, + ! so that the component w will in the end contain W^T. + ! + integer(psb_ipk_) :: alg, fill_in + real(psb_spk_) :: thresh + contains + procedure, pass(sv) :: check => amg_c_ainv_solver_check + procedure, pass(sv) :: build => amg_c_ainv_solver_bld + procedure, pass(sv) :: clone => amg_c_ainv_solver_clone + procedure, pass(sv) :: cseti => amg_c_ainv_solver_cseti + procedure, pass(sv) :: csetc => amg_c_ainv_solver_csetc + procedure, pass(sv) :: csetr => amg_c_ainv_solver_csetr + procedure, pass(sv) :: seti => amg_c_ainv_solver_seti + procedure, pass(sv) :: setc => amg_c_ainv_solver_setc + procedure, pass(sv) :: setr => amg_c_ainv_solver_setr + generic, public :: set => seti, setr, setc + procedure, pass(sv) :: descr => amg_c_ainv_solver_descr + procedure, pass(sv) :: default => c_ainv_solver_default + procedure, nopass :: stringval => c_ainv_stringval + procedure, nopass :: algname => c_ainv_algname + end type amg_c_ainv_solver_type + + + private :: c_ainv_stringval, c_ainv_solver_default, & + & c_ainv_algname + + interface + subroutine amg_c_ainv_solver_clone(sv,svout,info) + import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & + & amg_c_base_solver_type, psb_dpk_, amg_c_ainv_solver_type, psb_ipk_ + Implicit None + class(amg_c_ainv_solver_type), intent(inout) :: sv + class(amg_c_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + end subroutine amg_c_ainv_solver_clone + end interface + + + interface + subroutine amg_c_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) + import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & + & psb_d_vect_type, psb_c_base_vect_type, psb_dpk_,& + & amg_c_ainv_solver_type, psb_i_base_vect_type, psb_ipk_ + + Implicit None + + ! Arguments + type(psb_cspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_c_ainv_solver_type), intent(inout) :: sv + 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 amg_c_ainv_solver_bld + end interface + + interface + subroutine amg_c_ainv_solver_check(sv,info) + import :: psb_dpk_, amg_c_ainv_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_c_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_c_ainv_solver_check + end interface + + interface + subroutine amg_c_ainv_solver_cseti(sv,what,val,info,idx) + import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, psb_ipk_,& + & psb_d_vect_type, psb_c_base_vect_type, psb_dpk_, amg_c_ainv_solver_type + Implicit None + ! Arguments + class(amg_c_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_c_ainv_solver_cseti + end interface + + + interface + subroutine amg_c_ainv_solver_csetc(sv,what,val,info,idx) + import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, psb_ipk_,& + & psb_d_vect_type, psb_c_base_vect_type, psb_dpk_, amg_c_ainv_solver_type + Implicit None + ! Arguments + class(amg_c_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_c_ainv_solver_csetc + end interface + + interface + subroutine amg_c_ainv_solver_csetr(sv,what,val,info,idx) + import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, psb_ipk_,& + & psb_d_vect_type, psb_c_base_vect_type, psb_spk_, amg_c_ainv_solver_type + Implicit None + ! Arguments + class(amg_c_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_c_ainv_solver_csetr + end interface + + interface + subroutine amg_c_ainv_solver_setc(sv,what,val,info) + import :: amg_c_ainv_solver_type, psb_ipk_ + Implicit none + ! Arguments + class(amg_c_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_c_ainv_solver_setc + end interface + + interface + subroutine amg_c_ainv_solver_seti(sv,what,val,info) + import :: amg_c_ainv_solver_type, psb_ipk_ + Implicit none + ! Arguments + class(amg_c_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_c_ainv_solver_seti + end interface + + interface + subroutine amg_c_ainv_solver_setr(sv,what,val,info) + import :: amg_c_ainv_solver_type, psb_ipk_, psb_spk_ + Implicit none + ! Arguments + class(amg_c_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_c_ainv_solver_setr + end interface + + interface + subroutine amg_c_ainv_solver_descr(sv,info,iout,coarse) + import :: psb_dpk_, amg_c_ainv_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_c_ainv_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + end subroutine amg_c_ainv_solver_descr + end interface + + interface amg_ainv_bld + subroutine amg_c_ainv_bld(a,alg,fillin,thresh,wmat,d,zmat,desc,info,blck,iscale) + import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & + & psb_d_vect_type, psb_c_base_vect_type, psb_spk_, psb_ipk_ + implicit none + type(psb_cspmat_type), intent(in), target :: a + integer(psb_ipk_), intent(in) :: fillin,alg + real(psb_spk_), intent(in) :: thresh + type(psb_cspmat_type), intent(inout) :: wmat, zmat + complex(psb_spk_), allocatable :: d(:) + Type(psb_desc_type), Intent(inout) :: desc + integer(psb_ipk_), intent(out) :: info + type(psb_cspmat_type), intent(in), optional :: blck + integer(psb_ipk_), intent(in), optional :: iscale + end subroutine amg_c_ainv_bld + end interface + + +contains + + subroutine c_ainv_solver_default(sv) + + use psb_base_mod + + Implicit None + + ! Arguments + class(amg_c_ainv_solver_type), intent(inout) :: sv + + sv%alg = amg_ainv_llk_ + sv%fill_in = 0 + sv%thresh = dzero + + return + end subroutine c_ainv_solver_default + + function is_positive_nz_min(ip) result(res) + implicit none + integer(psb_ipk_), intent(in) :: ip + logical :: res + + res = (ip >= 1) + return + end function is_positive_nz_min + + + function c_ainv_stringval(string) result(val) + use psb_base_mod, only : psb_ipk_,psb_toupper + implicit none + ! Arguments + character(len=*), intent(in) :: string + integer(psb_ipk_) :: val + character(len=*), parameter :: name='d_ainv_stringval' + + select case(psb_toupper(trim(string))) + case('LLK') + val = amg_ainv_llk_ + case('STAB-LLK') + val = amg_ainv_s_ft_llk_ + case('SYM-LLK') + val = amg_ainv_s_llk_ + case('MLK') + val = amg_ainv_mlk_ +#if defined(HAVE_TUMA_SAINV) + case('SAINV-TUMA') + val = amg_ainv_s_tuma_ + case('LAINV-TUMA') + val = amg_ainv_l_tuma_ +#endif + case default + val = amg_stringval(string) + end select + end function c_ainv_stringval + + + function c_ainv_algname(ialg) result(val) + integer(psb_ipk_), intent(in) :: ialg + character(len=40) :: val + + character(len=*), parameter :: mlkname = 'Left-looking, list merge ' + character(len=*), parameter :: llkname = 'Left-looking ' + character(len=*), parameter :: stabllkname = 'Stabilized Left-looking ' + character(len=*), parameter :: sllkname = 'Symmetric Left-looking ' + character(len=*), parameter :: sainvname = 'SAINV (Benzi & Tuma) ' + character(len=*), parameter :: lainvname = 'LAINV (Benzi & Tuma) ' + character(len=*), parameter :: defname = 'Unknown alg variant ' + + select case (ialg) + case(amg_ainv_mlk_) + val = mlkname + case(amg_ainv_llk_) + val = llkname + case(amg_ainv_s_llk_) + val = sllkname + case(amg_ainv_s_ft_llk_) + val = stabllkname +#if defined(HAVE_TUMA_SAINV) + case(amg_ainv_s_tuma_ ) + val = sainvname + case(amg_ainv_l_tuma_ ) + val = lainvname +#endif + case default + val = defname + end select + + end function c_ainv_algname + +end module amg_c_ainv_solver diff --git a/amgprec/amg_c_base_ainv_mod.f90 b/amgprec/amg_c_base_ainv_mod.f90 new file mode 100644 index 00000000..7867cb04 --- /dev/null +++ b/amgprec/amg_c_base_ainv_mod.f90 @@ -0,0 +1,199 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +module amg_c_base_ainv_mod + + use amg_base_ainv_mod + use amg_c_base_solver_mod + use psb_c_ainv_tools_mod + use psb_base_mod, only : psb_c_vect_type, psb_spk_, psb_epk_ + + + + type, extends(amg_c_base_solver_type) :: amg_c_base_ainv_solver_type + ! + ! Compute an approximate factorization + ! A^-1 = Z D^-1 W^T + ! Note that here W is going to be transposed explicitly, + ! so that the component w will in the end contain W^T. + ! + type(psb_cspmat_type) :: w, z + type(psb_c_vect_type) :: dv + complex(psb_spk_), allocatable :: d(:) + + contains + procedure, pass(sv) :: cnv => amg_c_base_ainv_solver_cnv + procedure, pass(sv) :: dump => amg_c_base_ainv_solver_dmp + procedure, pass(sv) :: apply_v => amg_c_base_ainv_solver_apply_vect + procedure, pass(sv) :: apply_a => amg_c_base_ainv_solver_apply + procedure, pass(sv) :: free => amg_c_base_ainv_solver_free + procedure, pass(sv) :: sizeof => c_base_ainv_solver_sizeof + procedure, pass(sv) :: get_nzeros => c_base_ainv_get_nzeros + procedure, nopass :: get_wrksz => c_base_ainv_get_wrksize + procedure, pass(sv) :: update_a => amg_c_base_ainv_update_a + generic, public :: update => update_a + end type amg_c_base_ainv_solver_type + + private :: c_base_ainv_solver_sizeof, & + & c_base_ainv_get_nzeros, c_base_ainv_get_wrksize + + + interface + subroutine amg_c_base_ainv_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_c_base_sparse_mat, psb_c_base_vect_type, psb_spk_, & + & amg_c_base_ainv_solver_type, psb_ipk_, psb_i_base_vect_type + Implicit None + ! Arguments + class(amg_c_base_ainv_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 amg_c_base_ainv_solver_cnv + end interface + + interface + subroutine amg_c_base_ainv_update_a(sv,x,desc_data,info) + import :: psb_desc_type, psb_spk_,amg_c_base_ainv_solver_type, psb_c_vect_type, psb_ipk_ + type(psb_desc_type), intent(in) :: desc_data + class(amg_c_base_ainv_solver_type), intent(inout) :: sv + complex(psb_spk_),intent(in) :: x(:) + integer(psb_ipk_), intent(out) :: info + end subroutine amg_c_base_ainv_update_a + end interface + + interface + subroutine amg_c_base_ainv_solver_apply(alpha,sv,x,beta,y,desc_data,& + & trans,work,info,init,initu) + import :: psb_desc_type, psb_spk_,amg_c_base_ainv_solver_type, psb_ipk_ + type(psb_desc_type), intent(in) :: desc_data + class(amg_c_base_ainv_solver_type), intent(inout) :: sv + complex(psb_spk_),intent(inout) :: x(:) + complex(psb_spk_),intent(inout) :: y(:) + complex(psb_spk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + complex(psb_spk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: init + complex(psb_spk_),intent(inout), optional :: initu(:) + end subroutine amg_c_base_ainv_solver_apply + end interface + + interface + subroutine amg_c_base_ainv_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& + & trans,work,wv,info,init,initu) + import :: psb_desc_type, psb_spk_,amg_c_base_ainv_solver_type, psb_c_vect_type, psb_ipk_ + type(psb_desc_type), intent(in) :: desc_data + class(amg_c_base_ainv_solver_type), intent(inout) :: sv + type(psb_c_vect_type),intent(inout) :: x + type(psb_c_vect_type),intent(inout) :: y + complex(psb_spk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + complex(psb_spk_),target, intent(inout) :: work(:) + type(psb_c_vect_type),intent(inout) :: wv(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: init + type(psb_c_vect_type),intent(inout), optional :: initu + end subroutine amg_c_base_ainv_solver_apply_vect + end interface + + + interface + subroutine amg_c_base_ainv_solver_free(sv,info) + import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & + & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, amg_c_base_ainv_solver_type, psb_ipk_ + Implicit None + + ! Arguments + class(amg_c_base_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_c_base_ainv_solver_free + end interface + + interface + subroutine amg_c_base_ainv_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) + import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & + & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, amg_c_base_ainv_solver_type, psb_ipk_ + + implicit none + class(amg_c_base_ainv_solver_type), intent(in) :: sv + type(psb_desc_type), intent(in) :: desc + integer(psb_ipk_), intent(in) :: level + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix, head + logical, optional, intent(in) :: solver, global_num + end subroutine amg_c_base_ainv_solver_dmp + end interface + +contains + + function c_base_ainv_get_nzeros(sv) result(val) + implicit none + ! Arguments + class(amg_c_base_ainv_solver_type), intent(in) :: sv + integer(psb_epk_) :: val + integer :: i + + val = 0 + val = val + sv%dv%get_nrows() + val = val + sv%w%get_nzeros() + val = val + sv%z%get_nzeros() + + return + end function c_base_ainv_get_nzeros + + function c_base_ainv_solver_sizeof(sv) result(val) + implicit none + ! Arguments + class(amg_c_base_ainv_solver_type), intent(in) :: sv + integer(psb_epk_) :: val + integer :: i + + val = 2*psb_sizeof_ip + psb_sizeof_dp + val = val + sv%dv%sizeof() + val = val + sv%w%sizeof() + val = val + sv%z%sizeof() + + return + end function c_base_ainv_solver_sizeof + + function c_base_ainv_get_wrksize() result(val) + implicit none + integer(psb_ipk_) :: val + + val = 2 + end function c_base_ainv_get_wrksize + +end module amg_c_base_ainv_mod diff --git a/amgprec/amg_c_invk_solver.f90 b/amgprec/amg_c_invk_solver.f90 new file mode 100644 index 00000000..44ad0a77 --- /dev/null +++ b/amgprec/amg_c_invk_solver.f90 @@ -0,0 +1,168 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +! +! +! +! + +module amg_c_invk_solver + + use amg_c_base_solver_mod + use amg_c_base_ainv_mod + use psb_base_mod, only : psb_c_vect_type + + type, extends(amg_c_base_ainv_solver_type) :: amg_c_invk_solver_type + integer(psb_ipk_) :: fill_in, inv_fill + contains + procedure, pass(sv) :: check => amg_c_invk_solver_check + procedure, pass(sv) :: clone => amg_c_invk_solver_clone + procedure, pass(sv) :: build => amg_c_invk_solver_bld + procedure, pass(sv) :: cseti => amg_c_invk_solver_cseti + procedure, pass(sv) :: seti => amg_c_invk_solver_seti + generic, public :: set => seti + procedure, pass(sv) :: descr => amg_c_invk_solver_descr + procedure, pass(sv) :: default => c_invk_solver_default + end type amg_c_invk_solver_type + + + private :: c_invk_solver_default + + + interface + subroutine amg_c_invk_solver_clone(sv,svout,info) + import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & + & amg_c_base_solver_type, psb_spk_, amg_c_invk_solver_type, psb_ipk_ + Implicit None + class(amg_c_invk_solver_type), intent(inout) :: sv + class(amg_c_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + end subroutine amg_c_invk_solver_clone + end interface + + interface + subroutine amg_c_invk_solver_bld(a,desc_a,sv,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_, & + & amg_c_invk_solver_type, psb_i_base_vect_type, psb_ipk_ + + Implicit None + + ! Arguments + type(psb_cspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_c_invk_solver_type), intent(inout) :: sv + 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 amg_c_invk_solver_bld + end interface + + interface + subroutine amg_c_invk_solver_check(sv,info) + import :: psb_spk_, amg_c_invk_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_c_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_c_invk_solver_check + end interface + + interface + subroutine amg_c_invk_solver_cseti(sv,what,val,info,idx) + import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & + & psb_ipk_, psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & + & amg_c_invk_solver_type + + Implicit None + + ! Arguments + class(amg_c_invk_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_c_invk_solver_cseti + end interface + + interface + subroutine amg_c_invk_solver_descr(sv,info,iout,coarse) + import :: psb_spk_, amg_c_invk_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_c_invk_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + end subroutine amg_c_invk_solver_descr + end interface + + interface + subroutine amg_c_invk_solver_seti(sv,what,val,info) + import :: amg_c_invk_solver_type, psb_ipk_ + Implicit none + ! Arguments + class(amg_c_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_c_invk_solver_seti + end interface + +contains + + subroutine c_invk_solver_default(sv) + + !use psb_base_mod + + Implicit None + + ! Arguments + class(amg_c_invk_solver_type), intent(inout) :: sv + + sv%fill_in = 0 + sv%inv_fill = 0 + + return + end subroutine c_invk_solver_default + +end module amg_c_invk_solver diff --git a/amgprec/amg_c_invt_solver.f90 b/amgprec/amg_c_invt_solver.f90 new file mode 100644 index 00000000..2cec974c --- /dev/null +++ b/amgprec/amg_c_invt_solver.f90 @@ -0,0 +1,194 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +! +! +! + +module amg_c_invt_solver + + use amg_c_base_solver_mod + use amg_c_base_ainv_mod + use psb_base_mod, only : psb_c_vect_type + + type, extends(amg_c_base_ainv_solver_type) :: amg_c_invt_solver_type + integer(psb_ipk_) :: fill_in, inv_fill + real(psb_spk_) :: thresh, inv_thresh + contains + procedure, pass(sv) :: check => amg_c_invt_solver_check + procedure, pass(sv) :: clone => amg_c_invt_solver_clone + procedure, pass(sv) :: build => amg_c_invt_solver_bld + procedure, pass(sv) :: cseti => amg_c_invt_solver_cseti + procedure, pass(sv) :: csetr => amg_c_invt_solver_csetr + procedure, pass(sv) :: seti => amg_c_invt_solver_seti + procedure, pass(sv) :: setr => amg_c_invt_solver_setr + generic, public :: set => seti, setr + procedure, pass(sv) :: descr => amg_c_invt_solver_descr + procedure, pass(sv) :: default => c_invt_solver_default + end type amg_c_invt_solver_type + + private :: c_invt_solver_default + + + interface + subroutine amg_c_invt_solver_clone(sv,svout,info) + import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & + & amg_c_base_solver_type, psb_spk_, amg_c_invt_solver_type, psb_ipk_ + Implicit None + class(amg_c_invt_solver_type), intent(inout) :: sv + class(amg_c_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + end subroutine amg_c_invt_solver_clone + end interface + + interface + subroutine amg_c_invt_solver_bld(a,desc_a,sv,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_,& + & amg_c_invt_solver_type, psb_i_base_vect_type, psb_ipk_ + + Implicit None + + ! Arguments + type(psb_cspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_c_invt_solver_type), intent(inout) :: sv + 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 amg_c_invt_solver_bld + end interface + + interface + subroutine amg_c_invt_solver_check(sv,info) + import :: amg_c_invt_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_c_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_c_invt_solver_check + end interface + + interface + subroutine amg_c_invt_solver_cseti(sv,what,val,info,idx) + import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, psb_ipk_,& + & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, amg_c_invt_solver_type + Implicit None + ! Arguments + class(amg_c_invt_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_c_invt_solver_cseti + end interface + + interface + subroutine amg_c_invt_solver_csetr(sv,what,val,info,idx) + import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, psb_ipk_,& + & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, amg_c_invt_solver_type + Implicit None + ! Arguments + class(amg_c_invt_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_c_invt_solver_csetr + end interface + + interface + subroutine amg_c_invt_solver_descr(sv,info,iout,coarse) + import :: psb_spk_, amg_c_invt_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_c_invt_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + end subroutine amg_c_invt_solver_descr + end interface + + interface + subroutine amg_c_invt_solver_setr(sv,what,val,info) + import :: amg_c_invt_solver_type, psb_spk_, psb_ipk_ + Implicit none + ! Arguments + class(amg_c_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_c_invt_solver_setr + end interface + + interface + subroutine amg_c_invt_solver_seti(sv,what,val,info) + import :: amg_c_invt_solver_type, psb_ipk_ + Implicit none + ! Arguments + class(amg_c_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine + end interface + +contains + + subroutine c_invt_solver_default(sv) + + !use psb_base_mod + + Implicit None + + ! Arguments + class(amg_c_invt_solver_type), intent(inout) :: sv + + sv%fill_in = 0 + sv%inv_fill = 0 + sv%thresh = szero + sv%inv_thresh = szero + + return + end subroutine c_invt_solver_default + +end module amg_c_invt_solver diff --git a/amgprec/amg_c_prec_mod.f90 b/amgprec/amg_c_prec_mod.f90 index e039bee1..babe0cfa 100644 --- a/amgprec/amg_c_prec_mod.f90 +++ b/amgprec/amg_c_prec_mod.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! AMG4PSBLAS version 1.0 ! Algebraic Multigrid Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2020 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante -! +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the AMG4PSBLAS 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 @@ -33,8 +33,8 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! ! File: amg_c_prec_mod.f90 ! ! Module: amg_c_prec_mod @@ -52,6 +52,9 @@ module amg_c_prec_mod use amg_c_l1_diag_solver use amg_c_ilu_solver use amg_c_gs_solver + use amg_c_ainv_solver + use amg_c_invk_solver + use amg_c_invt_solver interface amg_precset module procedure amg_c_iprecsetsm, amg_c_iprecsetsv, & @@ -78,7 +81,7 @@ module amg_c_prec_mod ! !$ character, intent(in), optional :: upd end subroutine amg_c_extprol_bld end interface amg_extprol_bld - + contains subroutine amg_c_iprecsetsm(p,val,info,pos) @@ -108,7 +111,7 @@ contains subroutine amg_c_cprecseti(p,what,val,info,pos) type(amg_cprec_type), intent(inout) :: p - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos @@ -118,7 +121,7 @@ contains subroutine amg_c_cprecsetr(p,what,val,info,pos) type(amg_cprec_type), intent(inout) :: p - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos @@ -128,7 +131,7 @@ contains subroutine amg_c_cprecsetc(p,what,val,info,pos) type(amg_cprec_type), intent(inout) :: p - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos diff --git a/amgprec/amg_c_prec_type.f90 b/amgprec/amg_c_prec_type.f90 index 762f4748..dc116f5d 100644 --- a/amgprec/amg_c_prec_type.f90 +++ b/amgprec/amg_c_prec_type.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! AMG4PSBLAS version 1.0 ! Algebraic Multigrid Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2020 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante -! +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the AMG4PSBLAS 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 @@ -33,21 +33,21 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! ! File: amg_c_prec_type.f90 ! ! Module: amg_c_prec_type ! -! This module defines: +! This module defines: ! - the amg_c_prec_type data structure containing the preconditioner and related ! data structures; ! ! It contains routines for -! - Building and applying; +! - Building and applying; ! - checking if the preconditioner is correctly defined; ! - printing a description of the preconditioner; -! - deallocating the preconditioner data structure. +! - deallocating the preconditioner data structure. ! module amg_c_prec_type @@ -70,25 +70,25 @@ module amg_c_prec_type ! It consists of an array of 'one-level' intermediate data structures ! of type amg_conelev_type, each containing the information needed to apply ! the smoothing and the coarse-space correction at a generic level. RT is the - ! real data type, i.e. S for both S and C, and D for both D and Z. + ! real data type, i.e. S for both S and C, and D for both D and Z. ! ! type amg_cprec_type - ! type(amg_conelev_type), allocatable :: precv(:) + ! type(amg_conelev_type), allocatable :: precv(:) ! end type amg_cprec_type - ! + ! ! Note that the levels are numbered in increasing order starting from ! the level 1 as the finest one, and the number of levels is given by - ! size(precv(:)) which is the id of the coarsest level. + ! size(precv(:)) which is the id of the coarsest level. ! In the multigrid literature many authors number the levels in the opposite ! order, with level 0 being the id of the coarsest level. ! ! integer, parameter, private :: wv_size_=4 - + type, extends(psb_cprec_type) :: amg_cprec_type type(amg_saggr_data) :: ag_data ! - ! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle. + ! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle. ! integer(psb_ipk_) :: outer_sweeps = 1 ! @@ -97,11 +97,11 @@ module amg_c_prec_type ! to keep track against what is put later in the multilevel array ! integer(psb_ipk_) :: coarse_solver = -1 - + ! ! The multilevel hierarchy ! - type(amg_c_onelev_type), allocatable :: precv(:) + type(amg_c_onelev_type), allocatable :: precv(:) contains procedure, pass(prec) :: psb_c_apply2_vect => amg_c_apply2_vect procedure, pass(prec) :: psb_c_apply1_vect => amg_c_apply1_vect @@ -157,7 +157,7 @@ module amg_c_prec_type interface amg_precdescr subroutine amg_cfile_prec_descr(prec,iout,root) import :: amg_cprec_type, psb_ipk_ - implicit none + implicit none ! Arguments class(amg_cprec_type), intent(in) :: prec integer(psb_ipk_), intent(in), optional :: iout @@ -211,7 +211,7 @@ module amg_c_prec_type end subroutine amg_cprecaply1 end interface - interface + interface subroutine amg_cprecsetsm(prec,val,info,ilev,ilmax,pos) import :: psb_cspmat_type, psb_desc_type, psb_spk_, & & amg_cprec_type, amg_c_base_smoother_type, psb_ipk_ @@ -243,7 +243,7 @@ module amg_c_prec_type import :: psb_cspmat_type, psb_desc_type, psb_spk_, & & amg_cprec_type, psb_ipk_ class(amg_cprec_type), intent(inout) :: prec - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx @@ -253,7 +253,7 @@ module amg_c_prec_type import :: psb_cspmat_type, psb_desc_type, psb_spk_, & & amg_cprec_type, psb_ipk_ class(amg_cprec_type), intent(inout) :: prec - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx @@ -263,7 +263,7 @@ module amg_c_prec_type import :: psb_cspmat_type, psb_desc_type, psb_spk_, & & amg_cprec_type, psb_ipk_ class(amg_cprec_type), intent(inout) :: prec - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what character(len=*), intent(in) :: string integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx @@ -341,28 +341,28 @@ module amg_c_prec_type ! character, intent(in),optional :: upd end subroutine amg_c_smoothers_bld end interface amg_smoothers_bld - + contains ! ! Function returning a pointer to the smoother ! function amg_c_get_smootherp(prec,ilev) result(val) - implicit none + implicit none class(amg_cprec_type), target, intent(in) :: prec integer(psb_ipk_), optional :: ilev class(amg_c_base_smoother_type), pointer :: val integer(psb_ipk_) :: ilev_ - + val => null() - if (present(ilev)) then + if (present(ilev)) then ilev_ = ilev else - ! What is a good default? + ! What is a good default? ilev_ = 1 end if - if (allocated(prec%precv)) then - if ((1<=ilev_).and.(ilev_<=size(prec%precv))) then - if (allocated(prec%precv(ilev_)%sm)) then + if (allocated(prec%precv)) then + if ((1<=ilev_).and.(ilev_<=size(prec%precv))) then + if (allocated(prec%precv(ilev_)%sm)) then val => prec%precv(ilev_)%sm end if end if @@ -372,23 +372,23 @@ contains ! Function returning a pointer to the solver ! function amg_c_get_solverp(prec,ilev) result(val) - implicit none + implicit none class(amg_cprec_type), target, intent(in) :: prec integer(psb_ipk_), optional :: ilev class(amg_c_base_solver_type), pointer :: val integer(psb_ipk_) :: ilev_ - + val => null() - if (present(ilev)) then + if (present(ilev)) then ilev_ = ilev else - ! What is a good default? + ! What is a good default? ilev_ = 1 end if - if (allocated(prec%precv)) then - if ((1<=ilev_).and.(ilev_<=size(prec%precv))) then - if (allocated(prec%precv(ilev_)%sm)) then - if (allocated(prec%precv(ilev_)%sm%sv)) then + if (allocated(prec%precv)) then + if ((1<=ilev_).and.(ilev_<=size(prec%precv))) then + if (allocated(prec%precv(ilev_)%sm)) then + if (allocated(prec%precv(ilev_)%sm%sv)) then val => prec%precv(ilev_)%sm%sv end if end if @@ -399,25 +399,25 @@ contains ! Function returning the size of the precv(:) array ! function amg_c_get_nlevs(prec) result(val) - implicit none + implicit none class(amg_cprec_type), intent(in) :: prec integer(psb_ipk_) :: val val = 0 - if (allocated(prec%precv)) then + if (allocated(prec%precv)) then val = size(prec%precv) end if end function amg_c_get_nlevs ! ! Function returning the size of the amg_prec_type data structure - ! in bytes or in number of nonzeros of the operator(s) involved. + ! in bytes or in number of nonzeros of the operator(s) involved. ! function amg_c_get_nzeros(prec) result(val) - implicit none + implicit none class(amg_cprec_type), intent(in) :: prec integer(psb_epk_) :: val integer(psb_ipk_) :: i val = 0 - if (allocated(prec%precv)) then + if (allocated(prec%precv)) then do i=1, size(prec%precv) val = val + prec%precv(i)%get_nzeros() end do @@ -425,13 +425,13 @@ contains end function amg_c_get_nzeros function amg_cprec_sizeof(prec) result(val) - implicit none + implicit none class(amg_cprec_type), intent(in) :: prec integer(psb_epk_) :: val integer(psb_ipk_) :: i val = 0 val = val + psb_sizeof_ip - if (allocated(prec%precv)) then + if (allocated(prec%precv)) then do i=1, size(prec%precv) val = val + prec%precv(i)%sizeof() end do @@ -444,40 +444,40 @@ contains ! various level to the nonzeroes at the fine level ! (original matrix) ! - + function amg_c_get_compl(prec) result(val) - implicit none + implicit none class(amg_cprec_type), intent(in) :: prec complex(psb_spk_) :: val - + val = prec%ag_data%op_complexity end function amg_c_get_compl - - subroutine amg_c_cmp_compl(prec) - implicit none + subroutine amg_c_cmp_compl(prec) + + implicit none class(amg_cprec_type), intent(inout) :: prec - + real(psb_spk_) :: num, den, nmin type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: il + integer(psb_ipk_) :: il num = -sone den = sone ctxt = prec%ctxt - if (allocated(prec%precv)) then + if (allocated(prec%precv)) then il = 1 num = prec%precv(il)%base_a%get_nzeros() if (num >= szero) then - den = num + den = num do il=2,size(prec%precv) num = num + max(0,prec%precv(il)%base_a%get_nzeros()) end do end if end if nmin = num - call psb_min(ctxt,nmin) + call psb_min(ctxt,nmin) if (nmin < szero) then num = szero den = sone @@ -487,25 +487,25 @@ contains end if prec%ag_data%op_complexity = num/den end subroutine amg_c_cmp_compl - + ! ! Average coarsening ratio ! - + function amg_c_get_avg_cr(prec) result(val) - implicit none + implicit none class(amg_cprec_type), intent(in) :: prec complex(psb_spk_) :: val - + val = prec%ag_data%avg_cr end function amg_c_get_avg_cr - - subroutine amg_c_cmp_avg_cr(prec) - implicit none + subroutine amg_c_cmp_avg_cr(prec) + + implicit none class(amg_cprec_type), intent(inout) :: prec - + real(psb_spk_) :: avgcr type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: il, nl, iam, np @@ -519,12 +519,12 @@ contains do il=2,nl avgcr = avgcr + max(szero,prec%precv(il)%szratio) end do - avgcr = avgcr / (nl-1) + avgcr = avgcr / (nl-1) end if - call psb_sum(ctxt,avgcr) + call psb_sum(ctxt,avgcr) prec%ag_data%avg_cr = avgcr/np end subroutine amg_c_cmp_avg_cr - + ! ! Subroutines: amg_Tprec_free ! Version: complex @@ -538,74 +538,74 @@ contains ! error code. ! subroutine amg_cprecfree(p,info) - + implicit none - + ! Arguments type(amg_cprec_type), intent(inout) :: p integer(psb_ipk_), intent(out) :: info - + ! Local variables integer(psb_ipk_) :: me,err_act,i character(len=20) :: name - + info=psb_success_ name = 'amg_cprecfree' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_; return end if - + me=-1 - + call p%free(info) - + return - + end subroutine amg_cprecfree subroutine amg_c_prec_free(prec,info) - + implicit none - + ! Arguments class(amg_cprec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info - + ! Local variables integer(psb_ipk_) :: me,err_act,i character(len=20) :: name - + info=psb_success_ name = 'amg_cprecfree' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_; goto 9999 end if - + me=-1 - if (allocated(prec%precv)) then - do i=1,size(prec%precv) + if (allocated(prec%precv)) then + do i=1,size(prec%precv) call prec%precv(i)%free(info) end do deallocate(prec%precv,stat=info) end if call psb_erractionrestore(err_act) return - + 9999 call psb_error_handler(err_act) return - + end subroutine amg_c_prec_free - + ! - ! Top level methods. + ! Top level methods. ! subroutine amg_c_apply2_vect(prec,x,y,desc_data,info,trans,work) - implicit none + implicit none type(psb_desc_type),intent(in) :: desc_data class(amg_cprec_type), intent(inout) :: prec type(psb_c_vect_type),intent(inout) :: x @@ -618,13 +618,13 @@ contains call psb_erractionsave(err_act) - select type(prec) + select type(prec) type is (amg_cprec_type) call amg_precapply(prec,x,y,desc_data,info,trans,work) class default info = psb_err_missing_override_method_ call psb_errpush(info,name) - goto 9999 + goto 9999 end select call psb_erractionrestore(err_act) @@ -636,7 +636,7 @@ contains end subroutine amg_c_apply2_vect subroutine amg_c_apply1_vect(prec,x,desc_data,info,trans,work) - implicit none + implicit none type(psb_desc_type),intent(in) :: desc_data class(amg_cprec_type), intent(inout) :: prec type(psb_c_vect_type),intent(inout) :: x @@ -648,13 +648,13 @@ contains call psb_erractionsave(err_act) - select type(prec) + select type(prec) type is (amg_cprec_type) call amg_precapply(prec,x,desc_data,info,trans,work) class default info = psb_err_missing_override_method_ call psb_errpush(info,name) - goto 9999 + goto 9999 end select call psb_erractionrestore(err_act) @@ -667,7 +667,7 @@ contains subroutine amg_c_apply2v(prec,x,y,desc_data,info,trans,work) - implicit none + implicit none type(psb_desc_type),intent(in) :: desc_data class(amg_cprec_type), intent(inout) :: prec complex(psb_spk_),intent(inout) :: x(:) @@ -680,13 +680,13 @@ contains call psb_erractionsave(err_act) - select type(prec) + select type(prec) type is (amg_cprec_type) call amg_precapply(prec,x,y,desc_data,info,trans,work) class default info = psb_err_missing_override_method_ call psb_errpush(info,name) - goto 9999 + goto 9999 end select call psb_erractionrestore(err_act) @@ -698,7 +698,7 @@ contains end subroutine amg_c_apply2v subroutine amg_c_apply1v(prec,x,desc_data,info,trans) - implicit none + implicit none type(psb_desc_type),intent(in) :: desc_data class(amg_cprec_type), intent(inout) :: prec complex(psb_spk_),intent(inout) :: x(:) @@ -709,13 +709,13 @@ contains call psb_erractionsave(err_act) - select type(prec) + select type(prec) type is (amg_cprec_type) call amg_precapply(prec,x,desc_data,info,trans) class default info = psb_err_missing_override_method_ call psb_errpush(info,name) - goto 9999 + goto 9999 end select call psb_erractionrestore(err_act) @@ -730,8 +730,8 @@ contains subroutine amg_c_dump(prec,info,istart,iend,iproc,prefix,head,& & ac,rp,smoother,solver,tprol,& & global_num) - - implicit none + + implicit none class(amg_cprec_type), intent(in) :: prec integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: istart, iend, iproc @@ -742,27 +742,26 @@ contains integer(psb_ipk_) :: iam, np, iproc_ character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than - ! len of prefix_ + ! len of prefix_ info = 0 ctxt = prec%ctxt call psb_info(ctxt,iam,np) - iln = size(prec%precv) - if (present(istart)) then + if (present(istart)) then il1 = max(1,istart) else il1 = min(2,iln) end if - if (present(iend)) then + if (present(iend)) then iln = min(iln, iend) end if iproc_ = -1 - if (present(iproc)) then + if (present(iproc)) then iproc_ = iproc end if - if ((iproc_ == -1).or.(iproc_==iam)) then + if ((iproc_ == -1).or.(iproc_==iam)) then do lev=il1, iln call prec%precv(lev)%dump(lev,info,prefix=prefix,head=head,& & ac=ac,smoother=smoother,solver=solver,rp=rp,tprol=tprol, & @@ -773,7 +772,7 @@ contains subroutine amg_c_cnv(prec,info,amold,vmold,imold) - implicit none + implicit none class(amg_cprec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info class(psb_c_base_sparse_mat), intent(in), optional :: amold @@ -781,7 +780,7 @@ contains class(psb_i_base_vect_type), intent(in), optional :: imold integer(psb_ipk_) :: i - + info = psb_success_ if (allocated(prec%precv)) then do i=1,size(prec%precv) @@ -789,24 +788,24 @@ contains & call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold) end do end if - + end subroutine amg_c_cnv subroutine amg_c_clone(prec,precout,info) - implicit none + implicit none class(amg_cprec_type), intent(inout) :: prec class(psb_cprec_type), intent(inout) :: precout integer(psb_ipk_), intent(out) :: info - + call precout%free(info) - if (info == 0) call amg_c_inner_clone(prec,precout,info) + if (info == 0) call amg_c_inner_clone(prec,precout,info) end subroutine amg_c_clone subroutine amg_c_inner_clone(prec,precout,info) - implicit none + implicit none class(amg_cprec_type), intent(inout) :: prec class(psb_cprec_type), target, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info @@ -821,17 +820,17 @@ contains pout%ctxt = prec%ctxt pout%ag_data = prec%ag_data pout%outer_sweeps = prec%outer_sweeps - if (allocated(prec%precv)) then - ln = size(prec%precv) + if (allocated(prec%precv)) then + ln = size(prec%precv) allocate(pout%precv(ln),stat=info) if (info /= psb_success_) goto 9999 - if (ln >= 1) then + if (ln >= 1) then call prec%precv(1)%clone(pout%precv(1),info) end if do lev=2, ln if (info /= psb_success_) exit call prec%precv(lev)%clone(pout%precv(lev),info) - if (info == psb_success_) then + if (info == psb_success_) then pout%precv(lev)%base_a => pout%precv(lev)%ac pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc @@ -842,7 +841,7 @@ contains if (allocated(prec%precv(1)%wrk)) & & call pout%allocate_wrk(info,vmold=prec%precv(1)%wrk%vx2l%v) - class default + class default write(0,*) 'Error: wrong out type' info = psb_err_invalid_input_ end select @@ -854,14 +853,14 @@ contains implicit none class(amg_cprec_type), intent(inout) :: prec class(amg_cprec_type), intent(inout), target :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: i - - if (same_type_as(prec,b)) then - if (allocated(b%precv)) then + + if (same_type_as(prec,b)) then + if (allocated(b%precv)) then ! This might not be required if FINAL procedures are available. call b%free(info) - if (info /= psb_success_) then + if (info /= psb_success_) then !????? !!$ return endif @@ -869,7 +868,7 @@ contains b%ctxt = prec%ctxt b%ag_data = prec%ag_data b%outer_sweeps = prec%outer_sweeps - + call move_alloc(prec%precv,b%precv) ! Fix the pointers except on level 1. do i=2, size(b%precv) @@ -878,7 +877,7 @@ contains b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc end do - + else write(0,*) 'Warning: PREC%move_alloc onto different type?' info = psb_err_internal_error_ @@ -888,7 +887,7 @@ contains subroutine amg_c_allocate_wrk(prec,info,vmold,desc) use psb_base_mod implicit none - + ! Arguments class(amg_cprec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info @@ -896,37 +895,37 @@ contains ! ! In MLD the DESC optional argument is ignored, since ! the necessary info is contained in the various entries of the - ! PRECV component. + ! PRECV component. type(psb_desc_type), intent(in), optional :: desc - + ! Local variables integer(psb_ipk_) :: me,err_act,i,j,level,nlev, nc2l character(len=20) :: name - + info=psb_success_ name = 'amg_c_allocate_wrk' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_; goto 9999 end if - nlev = size(prec%precv) + nlev = size(prec%precv) level = 1 do level = 1, nlev call prec%precv(level)%allocate_wrk(info,vmold=vmold) - if (psb_errstatus_fatal()) then + if (psb_errstatus_fatal()) then nc2l = prec%precv(level)%base_desc%get_local_cols() info=psb_err_alloc_request_ call psb_errpush(info,name,i_err=(/2*nc2l/), a_err='complex(psb_spk_)') - goto 9999 + goto 9999 end if end do call psb_erractionrestore(err_act) return - + 9999 call psb_error_handler(err_act) return - + end subroutine amg_c_allocate_wrk subroutine amg_c_free_wrk(prec,info) @@ -948,13 +947,13 @@ contains info = psb_err_internal_error_; goto 9999 end if - if (allocated(prec%precv)) then - nlev = size(prec%precv) + if (allocated(prec%precv)) then + nlev = size(prec%precv) do level = 1, nlev call prec%precv(level)%free_wrk(info) end do end if - + call psb_erractionrestore(err_act) return @@ -966,7 +965,7 @@ contains function amg_c_is_allocated_wrk(prec) result(res) use psb_base_mod implicit none - + ! Arguments class(amg_cprec_type), intent(in) :: prec logical :: res @@ -974,7 +973,7 @@ contains res = .false. if (.not.allocated(prec%precv)) return res = allocated(prec%precv(1)%wrk) - + end function amg_c_is_allocated_wrk end module amg_c_prec_type diff --git a/amgprec/amg_d_ainv_solver.F90 b/amgprec/amg_d_ainv_solver.F90 new file mode 100644 index 00000000..8f9dc6b7 --- /dev/null +++ b/amgprec/amg_d_ainv_solver.F90 @@ -0,0 +1,321 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +! +! +! +! +module amg_d_ainv_solver + + use amg_d_base_ainv_mod + use psb_base_mod, only : psb_d_vect_type + + type, extends(amg_d_base_ainv_solver_type) :: amg_d_ainv_solver_type + ! + ! Compute an approximate factorization + ! A^-1 = Z D^-1 W^T + ! Note that here W is going to be transposed explicitly, + ! so that the component w will in the end contain W^T. + ! + integer(psb_ipk_) :: alg, fill_in + real(psb_dpk_) :: thresh + contains + procedure, pass(sv) :: check => amg_d_ainv_solver_check + procedure, pass(sv) :: build => amg_d_ainv_solver_bld + procedure, pass(sv) :: clone => amg_d_ainv_solver_clone + procedure, pass(sv) :: cseti => amg_d_ainv_solver_cseti + procedure, pass(sv) :: csetc => amg_d_ainv_solver_csetc + procedure, pass(sv) :: csetr => amg_d_ainv_solver_csetr + procedure, pass(sv) :: seti => amg_d_ainv_solver_seti + procedure, pass(sv) :: setc => amg_d_ainv_solver_setc + procedure, pass(sv) :: setr => amg_d_ainv_solver_setr + generic, public :: set => seti, setr, setc + procedure, pass(sv) :: descr => amg_d_ainv_solver_descr + procedure, pass(sv) :: default => d_ainv_solver_default + procedure, nopass :: stringval => d_ainv_stringval + procedure, nopass :: algname => d_ainv_algname + end type amg_d_ainv_solver_type + + + private :: d_ainv_stringval, d_ainv_solver_default, & + & d_ainv_algname + + interface + subroutine amg_d_ainv_solver_clone(sv,svout,info) + import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & + & amg_d_base_solver_type, psb_dpk_, amg_d_ainv_solver_type, psb_ipk_ + Implicit None + class(amg_d_ainv_solver_type), intent(inout) :: sv + class(amg_d_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + end subroutine amg_d_ainv_solver_clone + end interface + + + interface + subroutine amg_d_ainv_solver_bld(a,desc_a,sv,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_,& + & amg_d_ainv_solver_type, psb_i_base_vect_type, psb_ipk_ + + Implicit None + + ! Arguments + type(psb_dspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_d_ainv_solver_type), intent(inout) :: sv + 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 amg_d_ainv_solver_bld + end interface + + interface + subroutine amg_d_ainv_solver_check(sv,info) + import :: psb_dpk_, amg_d_ainv_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_d_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_d_ainv_solver_check + end interface + + interface + subroutine amg_d_ainv_solver_cseti(sv,what,val,info,idx) + import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, psb_ipk_,& + & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, amg_d_ainv_solver_type + Implicit None + ! Arguments + class(amg_d_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_d_ainv_solver_cseti + end interface + + + interface + subroutine amg_d_ainv_solver_csetc(sv,what,val,info,idx) + import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, psb_ipk_,& + & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, amg_d_ainv_solver_type + Implicit None + ! Arguments + class(amg_d_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_d_ainv_solver_csetc + end interface + + interface + subroutine amg_d_ainv_solver_csetr(sv,what,val,info,idx) + import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, psb_ipk_,& + & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, amg_d_ainv_solver_type + Implicit None + ! Arguments + class(amg_d_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_d_ainv_solver_csetr + end interface + + interface + subroutine amg_d_ainv_solver_setc(sv,what,val,info) + import :: amg_d_ainv_solver_type, psb_ipk_ + Implicit none + ! Arguments + class(amg_d_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_d_ainv_solver_setc + end interface + + interface + subroutine amg_d_ainv_solver_seti(sv,what,val,info) + import :: amg_d_ainv_solver_type, psb_ipk_ + Implicit none + ! Arguments + class(amg_d_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_d_ainv_solver_seti + end interface + + interface + subroutine amg_d_ainv_solver_setr(sv,what,val,info) + import :: amg_d_ainv_solver_type, psb_ipk_, psb_dpk_ + Implicit none + ! Arguments + class(amg_d_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_d_ainv_solver_setr + end interface + + interface + subroutine amg_d_ainv_solver_descr(sv,info,iout,coarse) + import :: psb_dpk_, amg_d_ainv_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_d_ainv_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + end subroutine amg_d_ainv_solver_descr + end interface + + interface amg_ainv_bld + subroutine amg_d_ainv_bld(a,alg,fillin,thresh,wmat,d,zmat,desc,info,blck,iscale) + import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & + & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, psb_ipk_ + implicit none + type(psb_dspmat_type), intent(in), target :: a + integer(psb_ipk_), intent(in) :: fillin,alg + real(psb_dpk_), intent(in) :: thresh + type(psb_dspmat_type), intent(inout) :: wmat, zmat + real(psb_dpk_), allocatable :: d(:) + Type(psb_desc_type), Intent(inout) :: desc + integer(psb_ipk_), intent(out) :: info + type(psb_dspmat_type), intent(in), optional :: blck + integer(psb_ipk_), intent(in), optional :: iscale + end subroutine amg_d_ainv_bld + end interface + + +contains + + subroutine d_ainv_solver_default(sv) + + use psb_base_mod + + Implicit None + + ! Arguments + class(amg_d_ainv_solver_type), intent(inout) :: sv + + sv%alg = amg_ainv_llk_ + sv%fill_in = 0 + sv%thresh = dzero + + return + end subroutine d_ainv_solver_default + + function is_positive_nz_min(ip) result(res) + implicit none + integer(psb_ipk_), intent(in) :: ip + logical :: res + + res = (ip >= 1) + return + end function is_positive_nz_min + + + function d_ainv_stringval(string) result(val) + use psb_base_mod, only : psb_ipk_,psb_toupper + implicit none + ! Arguments + character(len=*), intent(in) :: string + integer(psb_ipk_) :: val + character(len=*), parameter :: name='d_ainv_stringval' + + select case(psb_toupper(trim(string))) + case('LLK') + val = amg_ainv_llk_ + case('STAB-LLK') + val = amg_ainv_s_ft_llk_ + case('SYM-LLK') + val = amg_ainv_s_llk_ + case('MLK') + val = amg_ainv_mlk_ +#if defined(HAVE_TUMA_SAINV) + case('SAINV-TUMA') + val = amg_ainv_s_tuma_ + case('LAINV-TUMA') + val = amg_ainv_l_tuma_ +#endif + case default + val = amg_stringval(string) + end select + end function d_ainv_stringval + + + function d_ainv_algname(ialg) result(val) + integer(psb_ipk_), intent(in) :: ialg + character(len=40) :: val + + character(len=*), parameter :: mlkname = 'Left-looking, list merge ' + character(len=*), parameter :: llkname = 'Left-looking ' + character(len=*), parameter :: stabllkname = 'Stabilized Left-looking ' + character(len=*), parameter :: sllkname = 'Symmetric Left-looking ' + character(len=*), parameter :: sainvname = 'SAINV (Benzi & Tuma) ' + character(len=*), parameter :: lainvname = 'LAINV (Benzi & Tuma) ' + character(len=*), parameter :: defname = 'Unknown alg variant ' + + select case (ialg) + case(amg_ainv_mlk_) + val = mlkname + case(amg_ainv_llk_) + val = llkname + case(amg_ainv_s_llk_) + val = sllkname + case(amg_ainv_s_ft_llk_) + val = stabllkname +#if defined(HAVE_TUMA_SAINV) + case(amg_ainv_s_tuma_ ) + val = sainvname + case(amg_ainv_l_tuma_ ) + val = lainvname +#endif + case default + val = defname + end select + + end function d_ainv_algname + +end module amg_d_ainv_solver diff --git a/amgprec/amg_d_base_ainv_mod.f90 b/amgprec/amg_d_base_ainv_mod.f90 new file mode 100644 index 00000000..dce7f1f3 --- /dev/null +++ b/amgprec/amg_d_base_ainv_mod.f90 @@ -0,0 +1,199 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +module amg_d_base_ainv_mod + + use amg_base_ainv_mod + use amg_d_base_solver_mod + use psb_d_ainv_tools_mod + use psb_base_mod, only : psb_d_vect_type, psb_dpk_, psb_epk_ + + + + type, extends(amg_d_base_solver_type) :: amg_d_base_ainv_solver_type + ! + ! Compute an approximate factorization + ! A^-1 = Z D^-1 W^T + ! Note that here W is going to be transposed explicitly, + ! so that the component w will in the end contain W^T. + ! + type(psb_dspmat_type) :: w, z + type(psb_d_vect_type) :: dv + real(psb_dpk_), allocatable :: d(:) + + contains + procedure, pass(sv) :: cnv => amg_d_base_ainv_solver_cnv + procedure, pass(sv) :: dump => amg_d_base_ainv_solver_dmp + procedure, pass(sv) :: apply_v => amg_d_base_ainv_solver_apply_vect + procedure, pass(sv) :: apply_a => amg_d_base_ainv_solver_apply + procedure, pass(sv) :: free => amg_d_base_ainv_solver_free + procedure, pass(sv) :: sizeof => d_base_ainv_solver_sizeof + procedure, pass(sv) :: get_nzeros => d_base_ainv_get_nzeros + procedure, nopass :: get_wrksz => d_base_ainv_get_wrksize + procedure, pass(sv) :: update_a => amg_d_base_ainv_update_a + generic, public :: update => update_a + end type amg_d_base_ainv_solver_type + + private :: d_base_ainv_solver_sizeof, & + & d_base_ainv_get_nzeros, d_base_ainv_get_wrksize + + + interface + subroutine amg_d_base_ainv_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_d_base_sparse_mat, psb_d_base_vect_type, psb_dpk_, & + & amg_d_base_ainv_solver_type, psb_ipk_, psb_i_base_vect_type + Implicit None + ! Arguments + class(amg_d_base_ainv_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 amg_d_base_ainv_solver_cnv + end interface + + interface + subroutine amg_d_base_ainv_update_a(sv,x,desc_data,info) + import :: psb_desc_type, psb_dpk_,amg_d_base_ainv_solver_type, psb_d_vect_type, psb_ipk_ + type(psb_desc_type), intent(in) :: desc_data + class(amg_d_base_ainv_solver_type), intent(inout) :: sv + real(psb_dpk_),intent(in) :: x(:) + integer(psb_ipk_), intent(out) :: info + end subroutine amg_d_base_ainv_update_a + end interface + + interface + subroutine amg_d_base_ainv_solver_apply(alpha,sv,x,beta,y,desc_data,& + & trans,work,info,init,initu) + import :: psb_desc_type, psb_dpk_,amg_d_base_ainv_solver_type, psb_ipk_ + type(psb_desc_type), intent(in) :: desc_data + class(amg_d_base_ainv_solver_type), intent(inout) :: sv + real(psb_dpk_),intent(inout) :: x(:) + real(psb_dpk_),intent(inout) :: y(:) + real(psb_dpk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + real(psb_dpk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: init + real(psb_dpk_),intent(inout), optional :: initu(:) + end subroutine amg_d_base_ainv_solver_apply + end interface + + interface + subroutine amg_d_base_ainv_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& + & trans,work,wv,info,init,initu) + import :: psb_desc_type, psb_dpk_,amg_d_base_ainv_solver_type, psb_d_vect_type, psb_ipk_ + type(psb_desc_type), intent(in) :: desc_data + class(amg_d_base_ainv_solver_type), intent(inout) :: sv + type(psb_d_vect_type),intent(inout) :: x + type(psb_d_vect_type),intent(inout) :: y + real(psb_dpk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + real(psb_dpk_),target, intent(inout) :: work(:) + type(psb_d_vect_type),intent(inout) :: wv(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: init + type(psb_d_vect_type),intent(inout), optional :: initu + end subroutine amg_d_base_ainv_solver_apply_vect + end interface + + + interface + subroutine amg_d_base_ainv_solver_free(sv,info) + import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & + & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, amg_d_base_ainv_solver_type, psb_ipk_ + Implicit None + + ! Arguments + class(amg_d_base_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_d_base_ainv_solver_free + end interface + + interface + subroutine amg_d_base_ainv_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) + import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & + & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, amg_d_base_ainv_solver_type, psb_ipk_ + + implicit none + class(amg_d_base_ainv_solver_type), intent(in) :: sv + type(psb_desc_type), intent(in) :: desc + integer(psb_ipk_), intent(in) :: level + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix, head + logical, optional, intent(in) :: solver, global_num + end subroutine amg_d_base_ainv_solver_dmp + end interface + +contains + + function d_base_ainv_get_nzeros(sv) result(val) + implicit none + ! Arguments + class(amg_d_base_ainv_solver_type), intent(in) :: sv + integer(psb_epk_) :: val + integer :: i + + val = 0 + val = val + sv%dv%get_nrows() + val = val + sv%w%get_nzeros() + val = val + sv%z%get_nzeros() + + return + end function d_base_ainv_get_nzeros + + function d_base_ainv_solver_sizeof(sv) result(val) + implicit none + ! Arguments + class(amg_d_base_ainv_solver_type), intent(in) :: sv + integer(psb_epk_) :: val + integer :: i + + val = 2*psb_sizeof_ip + psb_sizeof_dp + val = val + sv%dv%sizeof() + val = val + sv%w%sizeof() + val = val + sv%z%sizeof() + + return + end function d_base_ainv_solver_sizeof + + function d_base_ainv_get_wrksize() result(val) + implicit none + integer(psb_ipk_) :: val + + val = 2 + end function d_base_ainv_get_wrksize + +end module amg_d_base_ainv_mod diff --git a/amgprec/amg_d_invk_solver.f90 b/amgprec/amg_d_invk_solver.f90 new file mode 100644 index 00000000..d2d08537 --- /dev/null +++ b/amgprec/amg_d_invk_solver.f90 @@ -0,0 +1,168 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +! +! +! +! + +module amg_d_invk_solver + + use amg_d_base_solver_mod + use amg_d_base_ainv_mod + use psb_base_mod, only : psb_d_vect_type + + type, extends(amg_d_base_ainv_solver_type) :: amg_d_invk_solver_type + integer(psb_ipk_) :: fill_in, inv_fill + contains + procedure, pass(sv) :: check => amg_d_invk_solver_check + procedure, pass(sv) :: clone => amg_d_invk_solver_clone + procedure, pass(sv) :: build => amg_d_invk_solver_bld + procedure, pass(sv) :: cseti => amg_d_invk_solver_cseti + procedure, pass(sv) :: seti => amg_d_invk_solver_seti + generic, public :: set => seti + procedure, pass(sv) :: descr => amg_d_invk_solver_descr + procedure, pass(sv) :: default => d_invk_solver_default + end type amg_d_invk_solver_type + + + private :: d_invk_solver_default + + + interface + subroutine amg_d_invk_solver_clone(sv,svout,info) + import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & + & amg_d_base_solver_type, psb_dpk_, amg_d_invk_solver_type, psb_ipk_ + Implicit None + class(amg_d_invk_solver_type), intent(inout) :: sv + class(amg_d_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + end subroutine amg_d_invk_solver_clone + end interface + + interface + subroutine amg_d_invk_solver_bld(a,desc_a,sv,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_, & + & amg_d_invk_solver_type, psb_i_base_vect_type, psb_ipk_ + + Implicit None + + ! Arguments + type(psb_dspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_d_invk_solver_type), intent(inout) :: sv + 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 amg_d_invk_solver_bld + end interface + + interface + subroutine amg_d_invk_solver_check(sv,info) + import :: psb_dpk_, amg_d_invk_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_d_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_d_invk_solver_check + end interface + + interface + subroutine amg_d_invk_solver_cseti(sv,what,val,info,idx) + import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & + & psb_ipk_, psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & + & amg_d_invk_solver_type + + Implicit None + + ! Arguments + class(amg_d_invk_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_d_invk_solver_cseti + end interface + + interface + subroutine amg_d_invk_solver_descr(sv,info,iout,coarse) + import :: psb_dpk_, amg_d_invk_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_d_invk_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + end subroutine amg_d_invk_solver_descr + end interface + + interface + subroutine amg_d_invk_solver_seti(sv,what,val,info) + import :: amg_d_invk_solver_type, psb_ipk_ + Implicit none + ! Arguments + class(amg_d_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_d_invk_solver_seti + end interface + +contains + + subroutine d_invk_solver_default(sv) + + !use psb_base_mod + + Implicit None + + ! Arguments + class(amg_d_invk_solver_type), intent(inout) :: sv + + sv%fill_in = 0 + sv%inv_fill = 0 + + return + end subroutine d_invk_solver_default + +end module amg_d_invk_solver diff --git a/amgprec/amg_d_invt_solver.f90 b/amgprec/amg_d_invt_solver.f90 new file mode 100644 index 00000000..fecf4f27 --- /dev/null +++ b/amgprec/amg_d_invt_solver.f90 @@ -0,0 +1,194 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +! +! +! + +module amg_d_invt_solver + + use amg_d_base_solver_mod + use amg_d_base_ainv_mod + use psb_base_mod, only : psb_d_vect_type + + type, extends(amg_d_base_ainv_solver_type) :: amg_d_invt_solver_type + integer(psb_ipk_) :: fill_in, inv_fill + real(psb_dpk_) :: thresh, inv_thresh + contains + procedure, pass(sv) :: check => amg_d_invt_solver_check + procedure, pass(sv) :: clone => amg_d_invt_solver_clone + procedure, pass(sv) :: build => amg_d_invt_solver_bld + procedure, pass(sv) :: cseti => amg_d_invt_solver_cseti + procedure, pass(sv) :: csetr => amg_d_invt_solver_csetr + procedure, pass(sv) :: seti => amg_d_invt_solver_seti + procedure, pass(sv) :: setr => amg_d_invt_solver_setr + generic, public :: set => seti, setr + procedure, pass(sv) :: descr => amg_d_invt_solver_descr + procedure, pass(sv) :: default => d_invt_solver_default + end type amg_d_invt_solver_type + + private :: d_invt_solver_default + + + interface + subroutine amg_d_invt_solver_clone(sv,svout,info) + import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & + & amg_d_base_solver_type, psb_dpk_, amg_d_invt_solver_type, psb_ipk_ + Implicit None + class(amg_d_invt_solver_type), intent(inout) :: sv + class(amg_d_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + end subroutine amg_d_invt_solver_clone + end interface + + interface + subroutine amg_d_invt_solver_bld(a,desc_a,sv,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_,& + & amg_d_invt_solver_type, psb_i_base_vect_type, psb_ipk_ + + Implicit None + + ! Arguments + type(psb_dspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_d_invt_solver_type), intent(inout) :: sv + 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 amg_d_invt_solver_bld + end interface + + interface + subroutine amg_d_invt_solver_check(sv,info) + import :: amg_d_invt_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_d_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_d_invt_solver_check + end interface + + interface + subroutine amg_d_invt_solver_cseti(sv,what,val,info,idx) + import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, psb_ipk_,& + & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, amg_d_invt_solver_type + Implicit None + ! Arguments + class(amg_d_invt_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_d_invt_solver_cseti + end interface + + interface + subroutine amg_d_invt_solver_csetr(sv,what,val,info,idx) + import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, psb_ipk_,& + & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, amg_d_invt_solver_type + Implicit None + ! Arguments + class(amg_d_invt_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_d_invt_solver_csetr + end interface + + interface + subroutine amg_d_invt_solver_descr(sv,info,iout,coarse) + import :: psb_dpk_, amg_d_invt_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_d_invt_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + end subroutine amg_d_invt_solver_descr + end interface + + interface + subroutine amg_d_invt_solver_setr(sv,what,val,info) + import :: amg_d_invt_solver_type, psb_dpk_, psb_ipk_ + Implicit none + ! Arguments + class(amg_d_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_d_invt_solver_setr + end interface + + interface + subroutine amg_d_invt_solver_seti(sv,what,val,info) + import :: amg_d_invt_solver_type, psb_ipk_ + Implicit none + ! Arguments + class(amg_d_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine + end interface + +contains + + subroutine d_invt_solver_default(sv) + + !use psb_base_mod + + Implicit None + + ! Arguments + class(amg_d_invt_solver_type), intent(inout) :: sv + + sv%fill_in = 0 + sv%inv_fill = 0 + sv%thresh = dzero + sv%inv_thresh = dzero + + return + end subroutine d_invt_solver_default + +end module amg_d_invt_solver diff --git a/amgprec/amg_d_prec_mod.f90 b/amgprec/amg_d_prec_mod.f90 index 6ac5a763..c63cc6de 100644 --- a/amgprec/amg_d_prec_mod.f90 +++ b/amgprec/amg_d_prec_mod.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! AMG4PSBLAS version 1.0 ! Algebraic Multigrid Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2020 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante -! +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the AMG4PSBLAS 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 @@ -33,8 +33,8 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! ! File: amg_d_prec_mod.f90 ! ! Module: amg_d_prec_mod @@ -52,6 +52,9 @@ module amg_d_prec_mod use amg_d_l1_diag_solver use amg_d_ilu_solver use amg_d_gs_solver + use amg_d_ainv_solver + use amg_d_invk_solver + use amg_d_invt_solver interface amg_precset module procedure amg_d_iprecsetsm, amg_d_iprecsetsv, & @@ -78,7 +81,7 @@ module amg_d_prec_mod ! !$ character, intent(in), optional :: upd end subroutine amg_d_extprol_bld end interface amg_extprol_bld - + contains subroutine amg_d_iprecsetsm(p,val,info,pos) @@ -108,7 +111,7 @@ contains subroutine amg_d_cprecseti(p,what,val,info,pos) type(amg_dprec_type), intent(inout) :: p - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos @@ -118,7 +121,7 @@ contains subroutine amg_d_cprecsetr(p,what,val,info,pos) type(amg_dprec_type), intent(inout) :: p - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos @@ -128,7 +131,7 @@ contains subroutine amg_d_cprecsetc(p,what,val,info,pos) type(amg_dprec_type), intent(inout) :: p - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos diff --git a/amgprec/amg_d_prec_type.f90 b/amgprec/amg_d_prec_type.f90 index d9474c1b..ca0dd5cc 100644 --- a/amgprec/amg_d_prec_type.f90 +++ b/amgprec/amg_d_prec_type.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! AMG4PSBLAS version 1.0 ! Algebraic Multigrid Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2020 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante -! +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the AMG4PSBLAS 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 @@ -33,21 +33,21 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! ! File: amg_d_prec_type.f90 ! ! Module: amg_d_prec_type ! -! This module defines: +! This module defines: ! - the amg_d_prec_type data structure containing the preconditioner and related ! data structures; ! ! It contains routines for -! - Building and applying; +! - Building and applying; ! - checking if the preconditioner is correctly defined; ! - printing a description of the preconditioner; -! - deallocating the preconditioner data structure. +! - deallocating the preconditioner data structure. ! module amg_d_prec_type @@ -70,25 +70,25 @@ module amg_d_prec_type ! It consists of an array of 'one-level' intermediate data structures ! of type amg_donelev_type, each containing the information needed to apply ! the smoothing and the coarse-space correction at a generic level. RT is the - ! real data type, i.e. S for both S and C, and D for both D and Z. + ! real data type, i.e. S for both S and C, and D for both D and Z. ! ! type amg_dprec_type - ! type(amg_donelev_type), allocatable :: precv(:) + ! type(amg_donelev_type), allocatable :: precv(:) ! end type amg_dprec_type - ! + ! ! Note that the levels are numbered in increasing order starting from ! the level 1 as the finest one, and the number of levels is given by - ! size(precv(:)) which is the id of the coarsest level. + ! size(precv(:)) which is the id of the coarsest level. ! In the multigrid literature many authors number the levels in the opposite ! order, with level 0 being the id of the coarsest level. ! ! integer, parameter, private :: wv_size_=4 - + type, extends(psb_dprec_type) :: amg_dprec_type type(amg_daggr_data) :: ag_data ! - ! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle. + ! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle. ! integer(psb_ipk_) :: outer_sweeps = 1 ! @@ -97,11 +97,11 @@ module amg_d_prec_type ! to keep track against what is put later in the multilevel array ! integer(psb_ipk_) :: coarse_solver = -1 - + ! ! The multilevel hierarchy ! - type(amg_d_onelev_type), allocatable :: precv(:) + type(amg_d_onelev_type), allocatable :: precv(:) contains procedure, pass(prec) :: psb_d_apply2_vect => amg_d_apply2_vect procedure, pass(prec) :: psb_d_apply1_vect => amg_d_apply1_vect @@ -157,7 +157,7 @@ module amg_d_prec_type interface amg_precdescr subroutine amg_dfile_prec_descr(prec,iout,root) import :: amg_dprec_type, psb_ipk_ - implicit none + implicit none ! Arguments class(amg_dprec_type), intent(in) :: prec integer(psb_ipk_), intent(in), optional :: iout @@ -211,7 +211,7 @@ module amg_d_prec_type end subroutine amg_dprecaply1 end interface - interface + interface subroutine amg_dprecsetsm(prec,val,info,ilev,ilmax,pos) import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & & amg_dprec_type, amg_d_base_smoother_type, psb_ipk_ @@ -243,7 +243,7 @@ module amg_d_prec_type import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & & amg_dprec_type, psb_ipk_ class(amg_dprec_type), intent(inout) :: prec - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx @@ -253,7 +253,7 @@ module amg_d_prec_type import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & & amg_dprec_type, psb_ipk_ class(amg_dprec_type), intent(inout) :: prec - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx @@ -263,7 +263,7 @@ module amg_d_prec_type import :: psb_dspmat_type, psb_desc_type, psb_dpk_, & & amg_dprec_type, psb_ipk_ class(amg_dprec_type), intent(inout) :: prec - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what character(len=*), intent(in) :: string integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx @@ -341,28 +341,28 @@ module amg_d_prec_type ! character, intent(in),optional :: upd end subroutine amg_d_smoothers_bld end interface amg_smoothers_bld - + contains ! ! Function returning a pointer to the smoother ! function amg_d_get_smootherp(prec,ilev) result(val) - implicit none + implicit none class(amg_dprec_type), target, intent(in) :: prec integer(psb_ipk_), optional :: ilev class(amg_d_base_smoother_type), pointer :: val integer(psb_ipk_) :: ilev_ - + val => null() - if (present(ilev)) then + if (present(ilev)) then ilev_ = ilev else - ! What is a good default? + ! What is a good default? ilev_ = 1 end if - if (allocated(prec%precv)) then - if ((1<=ilev_).and.(ilev_<=size(prec%precv))) then - if (allocated(prec%precv(ilev_)%sm)) then + if (allocated(prec%precv)) then + if ((1<=ilev_).and.(ilev_<=size(prec%precv))) then + if (allocated(prec%precv(ilev_)%sm)) then val => prec%precv(ilev_)%sm end if end if @@ -372,23 +372,23 @@ contains ! Function returning a pointer to the solver ! function amg_d_get_solverp(prec,ilev) result(val) - implicit none + implicit none class(amg_dprec_type), target, intent(in) :: prec integer(psb_ipk_), optional :: ilev class(amg_d_base_solver_type), pointer :: val integer(psb_ipk_) :: ilev_ - + val => null() - if (present(ilev)) then + if (present(ilev)) then ilev_ = ilev else - ! What is a good default? + ! What is a good default? ilev_ = 1 end if - if (allocated(prec%precv)) then - if ((1<=ilev_).and.(ilev_<=size(prec%precv))) then - if (allocated(prec%precv(ilev_)%sm)) then - if (allocated(prec%precv(ilev_)%sm%sv)) then + if (allocated(prec%precv)) then + if ((1<=ilev_).and.(ilev_<=size(prec%precv))) then + if (allocated(prec%precv(ilev_)%sm)) then + if (allocated(prec%precv(ilev_)%sm%sv)) then val => prec%precv(ilev_)%sm%sv end if end if @@ -399,25 +399,25 @@ contains ! Function returning the size of the precv(:) array ! function amg_d_get_nlevs(prec) result(val) - implicit none + implicit none class(amg_dprec_type), intent(in) :: prec integer(psb_ipk_) :: val val = 0 - if (allocated(prec%precv)) then + if (allocated(prec%precv)) then val = size(prec%precv) end if end function amg_d_get_nlevs ! ! Function returning the size of the amg_prec_type data structure - ! in bytes or in number of nonzeros of the operator(s) involved. + ! in bytes or in number of nonzeros of the operator(s) involved. ! function amg_d_get_nzeros(prec) result(val) - implicit none + implicit none class(amg_dprec_type), intent(in) :: prec integer(psb_epk_) :: val integer(psb_ipk_) :: i val = 0 - if (allocated(prec%precv)) then + if (allocated(prec%precv)) then do i=1, size(prec%precv) val = val + prec%precv(i)%get_nzeros() end do @@ -425,13 +425,13 @@ contains end function amg_d_get_nzeros function amg_dprec_sizeof(prec) result(val) - implicit none + implicit none class(amg_dprec_type), intent(in) :: prec integer(psb_epk_) :: val integer(psb_ipk_) :: i val = 0 val = val + psb_sizeof_ip - if (allocated(prec%precv)) then + if (allocated(prec%precv)) then do i=1, size(prec%precv) val = val + prec%precv(i)%sizeof() end do @@ -444,40 +444,40 @@ contains ! various level to the nonzeroes at the fine level ! (original matrix) ! - + function amg_d_get_compl(prec) result(val) - implicit none + implicit none class(amg_dprec_type), intent(in) :: prec real(psb_dpk_) :: val - + val = prec%ag_data%op_complexity end function amg_d_get_compl - - subroutine amg_d_cmp_compl(prec) - implicit none + subroutine amg_d_cmp_compl(prec) + + implicit none class(amg_dprec_type), intent(inout) :: prec - + real(psb_dpk_) :: num, den, nmin type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: il + integer(psb_ipk_) :: il num = -done den = done ctxt = prec%ctxt - if (allocated(prec%precv)) then + if (allocated(prec%precv)) then il = 1 num = prec%precv(il)%base_a%get_nzeros() if (num >= dzero) then - den = num + den = num do il=2,size(prec%precv) num = num + max(0,prec%precv(il)%base_a%get_nzeros()) end do end if end if nmin = num - call psb_min(ctxt,nmin) + call psb_min(ctxt,nmin) if (nmin < dzero) then num = dzero den = done @@ -487,25 +487,25 @@ contains end if prec%ag_data%op_complexity = num/den end subroutine amg_d_cmp_compl - + ! ! Average coarsening ratio ! - + function amg_d_get_avg_cr(prec) result(val) - implicit none + implicit none class(amg_dprec_type), intent(in) :: prec real(psb_dpk_) :: val - + val = prec%ag_data%avg_cr end function amg_d_get_avg_cr - - subroutine amg_d_cmp_avg_cr(prec) - implicit none + subroutine amg_d_cmp_avg_cr(prec) + + implicit none class(amg_dprec_type), intent(inout) :: prec - + real(psb_dpk_) :: avgcr type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: il, nl, iam, np @@ -519,12 +519,12 @@ contains do il=2,nl avgcr = avgcr + max(dzero,prec%precv(il)%szratio) end do - avgcr = avgcr / (nl-1) + avgcr = avgcr / (nl-1) end if - call psb_sum(ctxt,avgcr) + call psb_sum(ctxt,avgcr) prec%ag_data%avg_cr = avgcr/np end subroutine amg_d_cmp_avg_cr - + ! ! Subroutines: amg_Tprec_free ! Version: real @@ -538,74 +538,74 @@ contains ! error code. ! subroutine amg_dprecfree(p,info) - + implicit none - + ! Arguments type(amg_dprec_type), intent(inout) :: p integer(psb_ipk_), intent(out) :: info - + ! Local variables integer(psb_ipk_) :: me,err_act,i character(len=20) :: name - + info=psb_success_ name = 'amg_dprecfree' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_; return end if - + me=-1 - + call p%free(info) - + return - + end subroutine amg_dprecfree subroutine amg_d_prec_free(prec,info) - + implicit none - + ! Arguments class(amg_dprec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info - + ! Local variables integer(psb_ipk_) :: me,err_act,i character(len=20) :: name - + info=psb_success_ name = 'amg_dprecfree' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_; goto 9999 end if - + me=-1 - if (allocated(prec%precv)) then - do i=1,size(prec%precv) + if (allocated(prec%precv)) then + do i=1,size(prec%precv) call prec%precv(i)%free(info) end do deallocate(prec%precv,stat=info) end if call psb_erractionrestore(err_act) return - + 9999 call psb_error_handler(err_act) return - + end subroutine amg_d_prec_free - + ! - ! Top level methods. + ! Top level methods. ! subroutine amg_d_apply2_vect(prec,x,y,desc_data,info,trans,work) - implicit none + implicit none type(psb_desc_type),intent(in) :: desc_data class(amg_dprec_type), intent(inout) :: prec type(psb_d_vect_type),intent(inout) :: x @@ -618,13 +618,13 @@ contains call psb_erractionsave(err_act) - select type(prec) + select type(prec) type is (amg_dprec_type) call amg_precapply(prec,x,y,desc_data,info,trans,work) class default info = psb_err_missing_override_method_ call psb_errpush(info,name) - goto 9999 + goto 9999 end select call psb_erractionrestore(err_act) @@ -636,7 +636,7 @@ contains end subroutine amg_d_apply2_vect subroutine amg_d_apply1_vect(prec,x,desc_data,info,trans,work) - implicit none + implicit none type(psb_desc_type),intent(in) :: desc_data class(amg_dprec_type), intent(inout) :: prec type(psb_d_vect_type),intent(inout) :: x @@ -648,13 +648,13 @@ contains call psb_erractionsave(err_act) - select type(prec) + select type(prec) type is (amg_dprec_type) call amg_precapply(prec,x,desc_data,info,trans,work) class default info = psb_err_missing_override_method_ call psb_errpush(info,name) - goto 9999 + goto 9999 end select call psb_erractionrestore(err_act) @@ -667,7 +667,7 @@ contains subroutine amg_d_apply2v(prec,x,y,desc_data,info,trans,work) - implicit none + implicit none type(psb_desc_type),intent(in) :: desc_data class(amg_dprec_type), intent(inout) :: prec real(psb_dpk_),intent(inout) :: x(:) @@ -680,13 +680,13 @@ contains call psb_erractionsave(err_act) - select type(prec) + select type(prec) type is (amg_dprec_type) call amg_precapply(prec,x,y,desc_data,info,trans,work) class default info = psb_err_missing_override_method_ call psb_errpush(info,name) - goto 9999 + goto 9999 end select call psb_erractionrestore(err_act) @@ -698,7 +698,7 @@ contains end subroutine amg_d_apply2v subroutine amg_d_apply1v(prec,x,desc_data,info,trans) - implicit none + implicit none type(psb_desc_type),intent(in) :: desc_data class(amg_dprec_type), intent(inout) :: prec real(psb_dpk_),intent(inout) :: x(:) @@ -709,13 +709,13 @@ contains call psb_erractionsave(err_act) - select type(prec) + select type(prec) type is (amg_dprec_type) call amg_precapply(prec,x,desc_data,info,trans) class default info = psb_err_missing_override_method_ call psb_errpush(info,name) - goto 9999 + goto 9999 end select call psb_erractionrestore(err_act) @@ -730,8 +730,8 @@ contains subroutine amg_d_dump(prec,info,istart,iend,iproc,prefix,head,& & ac,rp,smoother,solver,tprol,& & global_num) - - implicit none + + implicit none class(amg_dprec_type), intent(in) :: prec integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: istart, iend, iproc @@ -742,27 +742,26 @@ contains integer(psb_ipk_) :: iam, np, iproc_ character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than - ! len of prefix_ + ! len of prefix_ info = 0 ctxt = prec%ctxt call psb_info(ctxt,iam,np) - iln = size(prec%precv) - if (present(istart)) then + if (present(istart)) then il1 = max(1,istart) else il1 = min(2,iln) end if - if (present(iend)) then + if (present(iend)) then iln = min(iln, iend) end if iproc_ = -1 - if (present(iproc)) then + if (present(iproc)) then iproc_ = iproc end if - if ((iproc_ == -1).or.(iproc_==iam)) then + if ((iproc_ == -1).or.(iproc_==iam)) then do lev=il1, iln call prec%precv(lev)%dump(lev,info,prefix=prefix,head=head,& & ac=ac,smoother=smoother,solver=solver,rp=rp,tprol=tprol, & @@ -773,7 +772,7 @@ contains subroutine amg_d_cnv(prec,info,amold,vmold,imold) - implicit none + implicit none class(amg_dprec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info class(psb_d_base_sparse_mat), intent(in), optional :: amold @@ -781,7 +780,7 @@ contains class(psb_i_base_vect_type), intent(in), optional :: imold integer(psb_ipk_) :: i - + info = psb_success_ if (allocated(prec%precv)) then do i=1,size(prec%precv) @@ -789,24 +788,24 @@ contains & call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold) end do end if - + end subroutine amg_d_cnv subroutine amg_d_clone(prec,precout,info) - implicit none + implicit none class(amg_dprec_type), intent(inout) :: prec class(psb_dprec_type), intent(inout) :: precout integer(psb_ipk_), intent(out) :: info - + call precout%free(info) - if (info == 0) call amg_d_inner_clone(prec,precout,info) + if (info == 0) call amg_d_inner_clone(prec,precout,info) end subroutine amg_d_clone subroutine amg_d_inner_clone(prec,precout,info) - implicit none + implicit none class(amg_dprec_type), intent(inout) :: prec class(psb_dprec_type), target, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info @@ -821,17 +820,17 @@ contains pout%ctxt = prec%ctxt pout%ag_data = prec%ag_data pout%outer_sweeps = prec%outer_sweeps - if (allocated(prec%precv)) then - ln = size(prec%precv) + if (allocated(prec%precv)) then + ln = size(prec%precv) allocate(pout%precv(ln),stat=info) if (info /= psb_success_) goto 9999 - if (ln >= 1) then + if (ln >= 1) then call prec%precv(1)%clone(pout%precv(1),info) end if do lev=2, ln if (info /= psb_success_) exit call prec%precv(lev)%clone(pout%precv(lev),info) - if (info == psb_success_) then + if (info == psb_success_) then pout%precv(lev)%base_a => pout%precv(lev)%ac pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc @@ -842,7 +841,7 @@ contains if (allocated(prec%precv(1)%wrk)) & & call pout%allocate_wrk(info,vmold=prec%precv(1)%wrk%vx2l%v) - class default + class default write(0,*) 'Error: wrong out type' info = psb_err_invalid_input_ end select @@ -854,14 +853,14 @@ contains implicit none class(amg_dprec_type), intent(inout) :: prec class(amg_dprec_type), intent(inout), target :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: i - - if (same_type_as(prec,b)) then - if (allocated(b%precv)) then + + if (same_type_as(prec,b)) then + if (allocated(b%precv)) then ! This might not be required if FINAL procedures are available. call b%free(info) - if (info /= psb_success_) then + if (info /= psb_success_) then !????? !!$ return endif @@ -869,7 +868,7 @@ contains b%ctxt = prec%ctxt b%ag_data = prec%ag_data b%outer_sweeps = prec%outer_sweeps - + call move_alloc(prec%precv,b%precv) ! Fix the pointers except on level 1. do i=2, size(b%precv) @@ -878,7 +877,7 @@ contains b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc end do - + else write(0,*) 'Warning: PREC%move_alloc onto different type?' info = psb_err_internal_error_ @@ -888,7 +887,7 @@ contains subroutine amg_d_allocate_wrk(prec,info,vmold,desc) use psb_base_mod implicit none - + ! Arguments class(amg_dprec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info @@ -896,37 +895,37 @@ contains ! ! In MLD the DESC optional argument is ignored, since ! the necessary info is contained in the various entries of the - ! PRECV component. + ! PRECV component. type(psb_desc_type), intent(in), optional :: desc - + ! Local variables integer(psb_ipk_) :: me,err_act,i,j,level,nlev, nc2l character(len=20) :: name - + info=psb_success_ name = 'amg_d_allocate_wrk' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_; goto 9999 end if - nlev = size(prec%precv) + nlev = size(prec%precv) level = 1 do level = 1, nlev call prec%precv(level)%allocate_wrk(info,vmold=vmold) - if (psb_errstatus_fatal()) then + if (psb_errstatus_fatal()) then nc2l = prec%precv(level)%base_desc%get_local_cols() info=psb_err_alloc_request_ call psb_errpush(info,name,i_err=(/2*nc2l/), a_err='real(psb_dpk_)') - goto 9999 + goto 9999 end if end do call psb_erractionrestore(err_act) return - + 9999 call psb_error_handler(err_act) return - + end subroutine amg_d_allocate_wrk subroutine amg_d_free_wrk(prec,info) @@ -948,13 +947,13 @@ contains info = psb_err_internal_error_; goto 9999 end if - if (allocated(prec%precv)) then - nlev = size(prec%precv) + if (allocated(prec%precv)) then + nlev = size(prec%precv) do level = 1, nlev call prec%precv(level)%free_wrk(info) end do end if - + call psb_erractionrestore(err_act) return @@ -966,7 +965,7 @@ contains function amg_d_is_allocated_wrk(prec) result(res) use psb_base_mod implicit none - + ! Arguments class(amg_dprec_type), intent(in) :: prec logical :: res @@ -974,7 +973,7 @@ contains res = .false. if (.not.allocated(prec%precv)) return res = allocated(prec%precv(1)%wrk) - + end function amg_d_is_allocated_wrk end module amg_d_prec_type diff --git a/amgprec/amg_s_ainv_solver.F90 b/amgprec/amg_s_ainv_solver.F90 new file mode 100644 index 00000000..a317227d --- /dev/null +++ b/amgprec/amg_s_ainv_solver.F90 @@ -0,0 +1,321 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +! +! +! +! +module amg_s_ainv_solver + + use amg_s_base_ainv_mod + use psb_base_mod, only : psb_d_vect_type + + type, extends(amg_s_base_ainv_solver_type) :: amg_s_ainv_solver_type + ! + ! Compute an approximate factorization + ! A^-1 = Z D^-1 W^T + ! Note that here W is going to be transposed explicitly, + ! so that the component w will in the end contain W^T. + ! + integer(psb_ipk_) :: alg, fill_in + real(psb_spk_) :: thresh + contains + procedure, pass(sv) :: check => amg_s_ainv_solver_check + procedure, pass(sv) :: build => amg_s_ainv_solver_bld + procedure, pass(sv) :: clone => amg_s_ainv_solver_clone + procedure, pass(sv) :: cseti => amg_s_ainv_solver_cseti + procedure, pass(sv) :: csetc => amg_s_ainv_solver_csetc + procedure, pass(sv) :: csetr => amg_s_ainv_solver_csetr + procedure, pass(sv) :: seti => amg_s_ainv_solver_seti + procedure, pass(sv) :: setc => amg_s_ainv_solver_setc + procedure, pass(sv) :: setr => amg_s_ainv_solver_setr + generic, public :: set => seti, setr, setc + procedure, pass(sv) :: descr => amg_s_ainv_solver_descr + procedure, pass(sv) :: default => s_ainv_solver_default + procedure, nopass :: stringval => s_ainv_stringval + procedure, nopass :: algname => s_ainv_algname + end type amg_s_ainv_solver_type + + + private :: s_ainv_stringval, s_ainv_solver_default, & + & s_ainv_algname + + interface + subroutine amg_s_ainv_solver_clone(sv,svout,info) + import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & + & amg_s_base_solver_type, psb_dpk_, amg_s_ainv_solver_type, psb_ipk_ + Implicit None + class(amg_s_ainv_solver_type), intent(inout) :: sv + class(amg_s_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + end subroutine amg_s_ainv_solver_clone + end interface + + + interface + subroutine amg_s_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) + import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & + & psb_d_vect_type, psb_s_base_vect_type, psb_dpk_,& + & amg_s_ainv_solver_type, psb_i_base_vect_type, psb_ipk_ + + Implicit None + + ! Arguments + type(psb_sspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_s_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + type(psb_sspmat_type), intent(in), target, optional :: b + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine amg_s_ainv_solver_bld + end interface + + interface + subroutine amg_s_ainv_solver_check(sv,info) + import :: psb_dpk_, amg_s_ainv_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_s_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_s_ainv_solver_check + end interface + + interface + subroutine amg_s_ainv_solver_cseti(sv,what,val,info,idx) + import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, psb_ipk_,& + & psb_d_vect_type, psb_s_base_vect_type, psb_dpk_, amg_s_ainv_solver_type + Implicit None + ! Arguments + class(amg_s_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_s_ainv_solver_cseti + end interface + + + interface + subroutine amg_s_ainv_solver_csetc(sv,what,val,info,idx) + import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, psb_ipk_,& + & psb_d_vect_type, psb_s_base_vect_type, psb_dpk_, amg_s_ainv_solver_type + Implicit None + ! Arguments + class(amg_s_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_s_ainv_solver_csetc + end interface + + interface + subroutine amg_s_ainv_solver_csetr(sv,what,val,info,idx) + import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, psb_ipk_,& + & psb_d_vect_type, psb_s_base_vect_type, psb_spk_, amg_s_ainv_solver_type + Implicit None + ! Arguments + class(amg_s_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_s_ainv_solver_csetr + end interface + + interface + subroutine amg_s_ainv_solver_setc(sv,what,val,info) + import :: amg_s_ainv_solver_type, psb_ipk_ + Implicit none + ! Arguments + class(amg_s_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_s_ainv_solver_setc + end interface + + interface + subroutine amg_s_ainv_solver_seti(sv,what,val,info) + import :: amg_s_ainv_solver_type, psb_ipk_ + Implicit none + ! Arguments + class(amg_s_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_s_ainv_solver_seti + end interface + + interface + subroutine amg_s_ainv_solver_setr(sv,what,val,info) + import :: amg_s_ainv_solver_type, psb_ipk_, psb_spk_ + Implicit none + ! Arguments + class(amg_s_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_s_ainv_solver_setr + end interface + + interface + subroutine amg_s_ainv_solver_descr(sv,info,iout,coarse) + import :: psb_dpk_, amg_s_ainv_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_s_ainv_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + end subroutine amg_s_ainv_solver_descr + end interface + + interface amg_ainv_bld + subroutine amg_s_ainv_bld(a,alg,fillin,thresh,wmat,d,zmat,desc,info,blck,iscale) + import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & + & psb_d_vect_type, psb_s_base_vect_type, psb_spk_, psb_ipk_ + implicit none + type(psb_sspmat_type), intent(in), target :: a + integer(psb_ipk_), intent(in) :: fillin,alg + real(psb_spk_), intent(in) :: thresh + type(psb_sspmat_type), intent(inout) :: wmat, zmat + real(psb_spk_), allocatable :: d(:) + Type(psb_desc_type), Intent(inout) :: desc + integer(psb_ipk_), intent(out) :: info + type(psb_sspmat_type), intent(in), optional :: blck + integer(psb_ipk_), intent(in), optional :: iscale + end subroutine amg_s_ainv_bld + end interface + + +contains + + subroutine s_ainv_solver_default(sv) + + use psb_base_mod + + Implicit None + + ! Arguments + class(amg_s_ainv_solver_type), intent(inout) :: sv + + sv%alg = amg_ainv_llk_ + sv%fill_in = 0 + sv%thresh = dzero + + return + end subroutine s_ainv_solver_default + + function is_positive_nz_min(ip) result(res) + implicit none + integer(psb_ipk_), intent(in) :: ip + logical :: res + + res = (ip >= 1) + return + end function is_positive_nz_min + + + function s_ainv_stringval(string) result(val) + use psb_base_mod, only : psb_ipk_,psb_toupper + implicit none + ! Arguments + character(len=*), intent(in) :: string + integer(psb_ipk_) :: val + character(len=*), parameter :: name='d_ainv_stringval' + + select case(psb_toupper(trim(string))) + case('LLK') + val = amg_ainv_llk_ + case('STAB-LLK') + val = amg_ainv_s_ft_llk_ + case('SYM-LLK') + val = amg_ainv_s_llk_ + case('MLK') + val = amg_ainv_mlk_ +#if defined(HAVE_TUMA_SAINV) + case('SAINV-TUMA') + val = amg_ainv_s_tuma_ + case('LAINV-TUMA') + val = amg_ainv_l_tuma_ +#endif + case default + val = amg_stringval(string) + end select + end function s_ainv_stringval + + + function s_ainv_algname(ialg) result(val) + integer(psb_ipk_), intent(in) :: ialg + character(len=40) :: val + + character(len=*), parameter :: mlkname = 'Left-looking, list merge ' + character(len=*), parameter :: llkname = 'Left-looking ' + character(len=*), parameter :: stabllkname = 'Stabilized Left-looking ' + character(len=*), parameter :: sllkname = 'Symmetric Left-looking ' + character(len=*), parameter :: sainvname = 'SAINV (Benzi & Tuma) ' + character(len=*), parameter :: lainvname = 'LAINV (Benzi & Tuma) ' + character(len=*), parameter :: defname = 'Unknown alg variant ' + + select case (ialg) + case(amg_ainv_mlk_) + val = mlkname + case(amg_ainv_llk_) + val = llkname + case(amg_ainv_s_llk_) + val = sllkname + case(amg_ainv_s_ft_llk_) + val = stabllkname +#if defined(HAVE_TUMA_SAINV) + case(amg_ainv_s_tuma_ ) + val = sainvname + case(amg_ainv_l_tuma_ ) + val = lainvname +#endif + case default + val = defname + end select + + end function s_ainv_algname + +end module amg_s_ainv_solver diff --git a/amgprec/amg_s_base_ainv_mod.f90 b/amgprec/amg_s_base_ainv_mod.f90 new file mode 100644 index 00000000..cec2b710 --- /dev/null +++ b/amgprec/amg_s_base_ainv_mod.f90 @@ -0,0 +1,199 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +module amg_s_base_ainv_mod + + use amg_base_ainv_mod + use amg_s_base_solver_mod + use psb_s_ainv_tools_mod + use psb_base_mod, only : psb_s_vect_type, psb_spk_, psb_epk_ + + + + type, extends(amg_s_base_solver_type) :: amg_s_base_ainv_solver_type + ! + ! Compute an approximate factorization + ! A^-1 = Z D^-1 W^T + ! Note that here W is going to be transposed explicitly, + ! so that the component w will in the end contain W^T. + ! + type(psb_sspmat_type) :: w, z + type(psb_s_vect_type) :: dv + real(psb_spk_), allocatable :: d(:) + + contains + procedure, pass(sv) :: cnv => amg_s_base_ainv_solver_cnv + procedure, pass(sv) :: dump => amg_s_base_ainv_solver_dmp + procedure, pass(sv) :: apply_v => amg_s_base_ainv_solver_apply_vect + procedure, pass(sv) :: apply_a => amg_s_base_ainv_solver_apply + procedure, pass(sv) :: free => amg_s_base_ainv_solver_free + procedure, pass(sv) :: sizeof => s_base_ainv_solver_sizeof + procedure, pass(sv) :: get_nzeros => s_base_ainv_get_nzeros + procedure, nopass :: get_wrksz => s_base_ainv_get_wrksize + procedure, pass(sv) :: update_a => amg_s_base_ainv_update_a + generic, public :: update => update_a + end type amg_s_base_ainv_solver_type + + private :: s_base_ainv_solver_sizeof, & + & s_base_ainv_get_nzeros, s_base_ainv_get_wrksize + + + interface + subroutine amg_s_base_ainv_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_s_base_sparse_mat, psb_s_base_vect_type, psb_spk_, & + & amg_s_base_ainv_solver_type, psb_ipk_, psb_i_base_vect_type + Implicit None + ! Arguments + class(amg_s_base_ainv_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 amg_s_base_ainv_solver_cnv + end interface + + interface + subroutine amg_s_base_ainv_update_a(sv,x,desc_data,info) + import :: psb_desc_type, psb_spk_,amg_s_base_ainv_solver_type, psb_s_vect_type, psb_ipk_ + type(psb_desc_type), intent(in) :: desc_data + class(amg_s_base_ainv_solver_type), intent(inout) :: sv + real(psb_spk_),intent(in) :: x(:) + integer(psb_ipk_), intent(out) :: info + end subroutine amg_s_base_ainv_update_a + end interface + + interface + subroutine amg_s_base_ainv_solver_apply(alpha,sv,x,beta,y,desc_data,& + & trans,work,info,init,initu) + import :: psb_desc_type, psb_spk_,amg_s_base_ainv_solver_type, psb_ipk_ + type(psb_desc_type), intent(in) :: desc_data + class(amg_s_base_ainv_solver_type), intent(inout) :: sv + real(psb_spk_),intent(inout) :: x(:) + real(psb_spk_),intent(inout) :: y(:) + real(psb_spk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + real(psb_spk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: init + real(psb_spk_),intent(inout), optional :: initu(:) + end subroutine amg_s_base_ainv_solver_apply + end interface + + interface + subroutine amg_s_base_ainv_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& + & trans,work,wv,info,init,initu) + import :: psb_desc_type, psb_spk_,amg_s_base_ainv_solver_type, psb_s_vect_type, psb_ipk_ + type(psb_desc_type), intent(in) :: desc_data + class(amg_s_base_ainv_solver_type), intent(inout) :: sv + type(psb_s_vect_type),intent(inout) :: x + type(psb_s_vect_type),intent(inout) :: y + real(psb_spk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + real(psb_spk_),target, intent(inout) :: work(:) + type(psb_s_vect_type),intent(inout) :: wv(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: init + type(psb_s_vect_type),intent(inout), optional :: initu + end subroutine amg_s_base_ainv_solver_apply_vect + end interface + + + interface + subroutine amg_s_base_ainv_solver_free(sv,info) + import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & + & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, amg_s_base_ainv_solver_type, psb_ipk_ + Implicit None + + ! Arguments + class(amg_s_base_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_s_base_ainv_solver_free + end interface + + interface + subroutine amg_s_base_ainv_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) + import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & + & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, amg_s_base_ainv_solver_type, psb_ipk_ + + implicit none + class(amg_s_base_ainv_solver_type), intent(in) :: sv + type(psb_desc_type), intent(in) :: desc + integer(psb_ipk_), intent(in) :: level + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix, head + logical, optional, intent(in) :: solver, global_num + end subroutine amg_s_base_ainv_solver_dmp + end interface + +contains + + function s_base_ainv_get_nzeros(sv) result(val) + implicit none + ! Arguments + class(amg_s_base_ainv_solver_type), intent(in) :: sv + integer(psb_epk_) :: val + integer :: i + + val = 0 + val = val + sv%dv%get_nrows() + val = val + sv%w%get_nzeros() + val = val + sv%z%get_nzeros() + + return + end function s_base_ainv_get_nzeros + + function s_base_ainv_solver_sizeof(sv) result(val) + implicit none + ! Arguments + class(amg_s_base_ainv_solver_type), intent(in) :: sv + integer(psb_epk_) :: val + integer :: i + + val = 2*psb_sizeof_ip + psb_sizeof_dp + val = val + sv%dv%sizeof() + val = val + sv%w%sizeof() + val = val + sv%z%sizeof() + + return + end function s_base_ainv_solver_sizeof + + function s_base_ainv_get_wrksize() result(val) + implicit none + integer(psb_ipk_) :: val + + val = 2 + end function s_base_ainv_get_wrksize + +end module amg_s_base_ainv_mod diff --git a/amgprec/amg_s_invk_solver.f90 b/amgprec/amg_s_invk_solver.f90 new file mode 100644 index 00000000..6ea2a43f --- /dev/null +++ b/amgprec/amg_s_invk_solver.f90 @@ -0,0 +1,168 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +! +! +! +! + +module amg_s_invk_solver + + use amg_s_base_solver_mod + use amg_s_base_ainv_mod + use psb_base_mod, only : psb_s_vect_type + + type, extends(amg_s_base_ainv_solver_type) :: amg_s_invk_solver_type + integer(psb_ipk_) :: fill_in, inv_fill + contains + procedure, pass(sv) :: check => amg_s_invk_solver_check + procedure, pass(sv) :: clone => amg_s_invk_solver_clone + procedure, pass(sv) :: build => amg_s_invk_solver_bld + procedure, pass(sv) :: cseti => amg_s_invk_solver_cseti + procedure, pass(sv) :: seti => amg_s_invk_solver_seti + generic, public :: set => seti + procedure, pass(sv) :: descr => amg_s_invk_solver_descr + procedure, pass(sv) :: default => s_invk_solver_default + end type amg_s_invk_solver_type + + + private :: s_invk_solver_default + + + interface + subroutine amg_s_invk_solver_clone(sv,svout,info) + import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & + & amg_s_base_solver_type, psb_spk_, amg_s_invk_solver_type, psb_ipk_ + Implicit None + class(amg_s_invk_solver_type), intent(inout) :: sv + class(amg_s_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + end subroutine amg_s_invk_solver_clone + end interface + + interface + subroutine amg_s_invk_solver_bld(a,desc_a,sv,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_, & + & amg_s_invk_solver_type, psb_i_base_vect_type, psb_ipk_ + + Implicit None + + ! Arguments + type(psb_sspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_s_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + type(psb_sspmat_type), intent(in), target, optional :: b + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine amg_s_invk_solver_bld + end interface + + interface + subroutine amg_s_invk_solver_check(sv,info) + import :: psb_spk_, amg_s_invk_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_s_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_s_invk_solver_check + end interface + + interface + subroutine amg_s_invk_solver_cseti(sv,what,val,info,idx) + import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & + & psb_ipk_, psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & + & amg_s_invk_solver_type + + Implicit None + + ! Arguments + class(amg_s_invk_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_s_invk_solver_cseti + end interface + + interface + subroutine amg_s_invk_solver_descr(sv,info,iout,coarse) + import :: psb_spk_, amg_s_invk_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_s_invk_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + end subroutine amg_s_invk_solver_descr + end interface + + interface + subroutine amg_s_invk_solver_seti(sv,what,val,info) + import :: amg_s_invk_solver_type, psb_ipk_ + Implicit none + ! Arguments + class(amg_s_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_s_invk_solver_seti + end interface + +contains + + subroutine s_invk_solver_default(sv) + + !use psb_base_mod + + Implicit None + + ! Arguments + class(amg_s_invk_solver_type), intent(inout) :: sv + + sv%fill_in = 0 + sv%inv_fill = 0 + + return + end subroutine s_invk_solver_default + +end module amg_s_invk_solver diff --git a/amgprec/amg_s_invt_solver.f90 b/amgprec/amg_s_invt_solver.f90 new file mode 100644 index 00000000..64a3e87d --- /dev/null +++ b/amgprec/amg_s_invt_solver.f90 @@ -0,0 +1,194 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +! +! +! + +module amg_s_invt_solver + + use amg_s_base_solver_mod + use amg_s_base_ainv_mod + use psb_base_mod, only : psb_s_vect_type + + type, extends(amg_s_base_ainv_solver_type) :: amg_s_invt_solver_type + integer(psb_ipk_) :: fill_in, inv_fill + real(psb_spk_) :: thresh, inv_thresh + contains + procedure, pass(sv) :: check => amg_s_invt_solver_check + procedure, pass(sv) :: clone => amg_s_invt_solver_clone + procedure, pass(sv) :: build => amg_s_invt_solver_bld + procedure, pass(sv) :: cseti => amg_s_invt_solver_cseti + procedure, pass(sv) :: csetr => amg_s_invt_solver_csetr + procedure, pass(sv) :: seti => amg_s_invt_solver_seti + procedure, pass(sv) :: setr => amg_s_invt_solver_setr + generic, public :: set => seti, setr + procedure, pass(sv) :: descr => amg_s_invt_solver_descr + procedure, pass(sv) :: default => s_invt_solver_default + end type amg_s_invt_solver_type + + private :: s_invt_solver_default + + + interface + subroutine amg_s_invt_solver_clone(sv,svout,info) + import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & + & amg_s_base_solver_type, psb_spk_, amg_s_invt_solver_type, psb_ipk_ + Implicit None + class(amg_s_invt_solver_type), intent(inout) :: sv + class(amg_s_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + end subroutine amg_s_invt_solver_clone + end interface + + interface + subroutine amg_s_invt_solver_bld(a,desc_a,sv,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_,& + & amg_s_invt_solver_type, psb_i_base_vect_type, psb_ipk_ + + Implicit None + + ! Arguments + type(psb_sspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_s_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + type(psb_sspmat_type), intent(in), target, optional :: b + class(psb_s_base_sparse_mat), intent(in), optional :: amold + class(psb_s_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine amg_s_invt_solver_bld + end interface + + interface + subroutine amg_s_invt_solver_check(sv,info) + import :: amg_s_invt_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_s_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_s_invt_solver_check + end interface + + interface + subroutine amg_s_invt_solver_cseti(sv,what,val,info,idx) + import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, psb_ipk_,& + & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, amg_s_invt_solver_type + Implicit None + ! Arguments + class(amg_s_invt_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_s_invt_solver_cseti + end interface + + interface + subroutine amg_s_invt_solver_csetr(sv,what,val,info,idx) + import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, psb_ipk_,& + & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, amg_s_invt_solver_type + Implicit None + ! Arguments + class(amg_s_invt_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_s_invt_solver_csetr + end interface + + interface + subroutine amg_s_invt_solver_descr(sv,info,iout,coarse) + import :: psb_spk_, amg_s_invt_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_s_invt_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + end subroutine amg_s_invt_solver_descr + end interface + + interface + subroutine amg_s_invt_solver_setr(sv,what,val,info) + import :: amg_s_invt_solver_type, psb_spk_, psb_ipk_ + Implicit none + ! Arguments + class(amg_s_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_s_invt_solver_setr + end interface + + interface + subroutine amg_s_invt_solver_seti(sv,what,val,info) + import :: amg_s_invt_solver_type, psb_ipk_ + Implicit none + ! Arguments + class(amg_s_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine + end interface + +contains + + subroutine s_invt_solver_default(sv) + + !use psb_base_mod + + Implicit None + + ! Arguments + class(amg_s_invt_solver_type), intent(inout) :: sv + + sv%fill_in = 0 + sv%inv_fill = 0 + sv%thresh = szero + sv%inv_thresh = szero + + return + end subroutine s_invt_solver_default + +end module amg_s_invt_solver diff --git a/amgprec/amg_s_prec_mod.f90 b/amgprec/amg_s_prec_mod.f90 index adec19e6..6de769b6 100644 --- a/amgprec/amg_s_prec_mod.f90 +++ b/amgprec/amg_s_prec_mod.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! AMG4PSBLAS version 1.0 ! Algebraic Multigrid Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2020 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante -! +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the AMG4PSBLAS 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 @@ -33,8 +33,8 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! ! File: amg_s_prec_mod.f90 ! ! Module: amg_s_prec_mod @@ -52,6 +52,9 @@ module amg_s_prec_mod use amg_s_l1_diag_solver use amg_s_ilu_solver use amg_s_gs_solver + use amg_s_ainv_solver + use amg_s_invk_solver + use amg_s_invt_solver interface amg_precset module procedure amg_s_iprecsetsm, amg_s_iprecsetsv, & @@ -78,7 +81,7 @@ module amg_s_prec_mod ! !$ character, intent(in), optional :: upd end subroutine amg_s_extprol_bld end interface amg_extprol_bld - + contains subroutine amg_s_iprecsetsm(p,val,info,pos) @@ -108,7 +111,7 @@ contains subroutine amg_s_cprecseti(p,what,val,info,pos) type(amg_sprec_type), intent(inout) :: p - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos @@ -118,7 +121,7 @@ contains subroutine amg_s_cprecsetr(p,what,val,info,pos) type(amg_sprec_type), intent(inout) :: p - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos @@ -128,7 +131,7 @@ contains subroutine amg_s_cprecsetc(p,what,val,info,pos) type(amg_sprec_type), intent(inout) :: p - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos diff --git a/amgprec/amg_s_prec_type.f90 b/amgprec/amg_s_prec_type.f90 index 0e5baecf..696cb448 100644 --- a/amgprec/amg_s_prec_type.f90 +++ b/amgprec/amg_s_prec_type.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! AMG4PSBLAS version 1.0 ! Algebraic Multigrid Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2020 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante -! +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the AMG4PSBLAS 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 @@ -33,21 +33,21 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! ! File: amg_s_prec_type.f90 ! ! Module: amg_s_prec_type ! -! This module defines: +! This module defines: ! - the amg_s_prec_type data structure containing the preconditioner and related ! data structures; ! ! It contains routines for -! - Building and applying; +! - Building and applying; ! - checking if the preconditioner is correctly defined; ! - printing a description of the preconditioner; -! - deallocating the preconditioner data structure. +! - deallocating the preconditioner data structure. ! module amg_s_prec_type @@ -70,25 +70,25 @@ module amg_s_prec_type ! It consists of an array of 'one-level' intermediate data structures ! of type amg_sonelev_type, each containing the information needed to apply ! the smoothing and the coarse-space correction at a generic level. RT is the - ! real data type, i.e. S for both S and C, and D for both D and Z. + ! real data type, i.e. S for both S and C, and D for both D and Z. ! ! type amg_sprec_type - ! type(amg_sonelev_type), allocatable :: precv(:) + ! type(amg_sonelev_type), allocatable :: precv(:) ! end type amg_sprec_type - ! + ! ! Note that the levels are numbered in increasing order starting from ! the level 1 as the finest one, and the number of levels is given by - ! size(precv(:)) which is the id of the coarsest level. + ! size(precv(:)) which is the id of the coarsest level. ! In the multigrid literature many authors number the levels in the opposite ! order, with level 0 being the id of the coarsest level. ! ! integer, parameter, private :: wv_size_=4 - + type, extends(psb_sprec_type) :: amg_sprec_type type(amg_saggr_data) :: ag_data ! - ! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle. + ! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle. ! integer(psb_ipk_) :: outer_sweeps = 1 ! @@ -97,11 +97,11 @@ module amg_s_prec_type ! to keep track against what is put later in the multilevel array ! integer(psb_ipk_) :: coarse_solver = -1 - + ! ! The multilevel hierarchy ! - type(amg_s_onelev_type), allocatable :: precv(:) + type(amg_s_onelev_type), allocatable :: precv(:) contains procedure, pass(prec) :: psb_s_apply2_vect => amg_s_apply2_vect procedure, pass(prec) :: psb_s_apply1_vect => amg_s_apply1_vect @@ -157,7 +157,7 @@ module amg_s_prec_type interface amg_precdescr subroutine amg_sfile_prec_descr(prec,iout,root) import :: amg_sprec_type, psb_ipk_ - implicit none + implicit none ! Arguments class(amg_sprec_type), intent(in) :: prec integer(psb_ipk_), intent(in), optional :: iout @@ -211,7 +211,7 @@ module amg_s_prec_type end subroutine amg_sprecaply1 end interface - interface + interface subroutine amg_sprecsetsm(prec,val,info,ilev,ilmax,pos) import :: psb_sspmat_type, psb_desc_type, psb_spk_, & & amg_sprec_type, amg_s_base_smoother_type, psb_ipk_ @@ -243,7 +243,7 @@ module amg_s_prec_type import :: psb_sspmat_type, psb_desc_type, psb_spk_, & & amg_sprec_type, psb_ipk_ class(amg_sprec_type), intent(inout) :: prec - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx @@ -253,7 +253,7 @@ module amg_s_prec_type import :: psb_sspmat_type, psb_desc_type, psb_spk_, & & amg_sprec_type, psb_ipk_ class(amg_sprec_type), intent(inout) :: prec - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what real(psb_spk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx @@ -263,7 +263,7 @@ module amg_s_prec_type import :: psb_sspmat_type, psb_desc_type, psb_spk_, & & amg_sprec_type, psb_ipk_ class(amg_sprec_type), intent(inout) :: prec - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what character(len=*), intent(in) :: string integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx @@ -341,28 +341,28 @@ module amg_s_prec_type ! character, intent(in),optional :: upd end subroutine amg_s_smoothers_bld end interface amg_smoothers_bld - + contains ! ! Function returning a pointer to the smoother ! function amg_s_get_smootherp(prec,ilev) result(val) - implicit none + implicit none class(amg_sprec_type), target, intent(in) :: prec integer(psb_ipk_), optional :: ilev class(amg_s_base_smoother_type), pointer :: val integer(psb_ipk_) :: ilev_ - + val => null() - if (present(ilev)) then + if (present(ilev)) then ilev_ = ilev else - ! What is a good default? + ! What is a good default? ilev_ = 1 end if - if (allocated(prec%precv)) then - if ((1<=ilev_).and.(ilev_<=size(prec%precv))) then - if (allocated(prec%precv(ilev_)%sm)) then + if (allocated(prec%precv)) then + if ((1<=ilev_).and.(ilev_<=size(prec%precv))) then + if (allocated(prec%precv(ilev_)%sm)) then val => prec%precv(ilev_)%sm end if end if @@ -372,23 +372,23 @@ contains ! Function returning a pointer to the solver ! function amg_s_get_solverp(prec,ilev) result(val) - implicit none + implicit none class(amg_sprec_type), target, intent(in) :: prec integer(psb_ipk_), optional :: ilev class(amg_s_base_solver_type), pointer :: val integer(psb_ipk_) :: ilev_ - + val => null() - if (present(ilev)) then + if (present(ilev)) then ilev_ = ilev else - ! What is a good default? + ! What is a good default? ilev_ = 1 end if - if (allocated(prec%precv)) then - if ((1<=ilev_).and.(ilev_<=size(prec%precv))) then - if (allocated(prec%precv(ilev_)%sm)) then - if (allocated(prec%precv(ilev_)%sm%sv)) then + if (allocated(prec%precv)) then + if ((1<=ilev_).and.(ilev_<=size(prec%precv))) then + if (allocated(prec%precv(ilev_)%sm)) then + if (allocated(prec%precv(ilev_)%sm%sv)) then val => prec%precv(ilev_)%sm%sv end if end if @@ -399,25 +399,25 @@ contains ! Function returning the size of the precv(:) array ! function amg_s_get_nlevs(prec) result(val) - implicit none + implicit none class(amg_sprec_type), intent(in) :: prec integer(psb_ipk_) :: val val = 0 - if (allocated(prec%precv)) then + if (allocated(prec%precv)) then val = size(prec%precv) end if end function amg_s_get_nlevs ! ! Function returning the size of the amg_prec_type data structure - ! in bytes or in number of nonzeros of the operator(s) involved. + ! in bytes or in number of nonzeros of the operator(s) involved. ! function amg_s_get_nzeros(prec) result(val) - implicit none + implicit none class(amg_sprec_type), intent(in) :: prec integer(psb_epk_) :: val integer(psb_ipk_) :: i val = 0 - if (allocated(prec%precv)) then + if (allocated(prec%precv)) then do i=1, size(prec%precv) val = val + prec%precv(i)%get_nzeros() end do @@ -425,13 +425,13 @@ contains end function amg_s_get_nzeros function amg_sprec_sizeof(prec) result(val) - implicit none + implicit none class(amg_sprec_type), intent(in) :: prec integer(psb_epk_) :: val integer(psb_ipk_) :: i val = 0 val = val + psb_sizeof_ip - if (allocated(prec%precv)) then + if (allocated(prec%precv)) then do i=1, size(prec%precv) val = val + prec%precv(i)%sizeof() end do @@ -444,40 +444,40 @@ contains ! various level to the nonzeroes at the fine level ! (original matrix) ! - + function amg_s_get_compl(prec) result(val) - implicit none + implicit none class(amg_sprec_type), intent(in) :: prec real(psb_spk_) :: val - + val = prec%ag_data%op_complexity end function amg_s_get_compl - - subroutine amg_s_cmp_compl(prec) - implicit none + subroutine amg_s_cmp_compl(prec) + + implicit none class(amg_sprec_type), intent(inout) :: prec - + real(psb_spk_) :: num, den, nmin type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: il + integer(psb_ipk_) :: il num = -sone den = sone ctxt = prec%ctxt - if (allocated(prec%precv)) then + if (allocated(prec%precv)) then il = 1 num = prec%precv(il)%base_a%get_nzeros() if (num >= szero) then - den = num + den = num do il=2,size(prec%precv) num = num + max(0,prec%precv(il)%base_a%get_nzeros()) end do end if end if nmin = num - call psb_min(ctxt,nmin) + call psb_min(ctxt,nmin) if (nmin < szero) then num = szero den = sone @@ -487,25 +487,25 @@ contains end if prec%ag_data%op_complexity = num/den end subroutine amg_s_cmp_compl - + ! ! Average coarsening ratio ! - + function amg_s_get_avg_cr(prec) result(val) - implicit none + implicit none class(amg_sprec_type), intent(in) :: prec real(psb_spk_) :: val - + val = prec%ag_data%avg_cr end function amg_s_get_avg_cr - - subroutine amg_s_cmp_avg_cr(prec) - implicit none + subroutine amg_s_cmp_avg_cr(prec) + + implicit none class(amg_sprec_type), intent(inout) :: prec - + real(psb_spk_) :: avgcr type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: il, nl, iam, np @@ -519,12 +519,12 @@ contains do il=2,nl avgcr = avgcr + max(szero,prec%precv(il)%szratio) end do - avgcr = avgcr / (nl-1) + avgcr = avgcr / (nl-1) end if - call psb_sum(ctxt,avgcr) + call psb_sum(ctxt,avgcr) prec%ag_data%avg_cr = avgcr/np end subroutine amg_s_cmp_avg_cr - + ! ! Subroutines: amg_Tprec_free ! Version: real @@ -538,74 +538,74 @@ contains ! error code. ! subroutine amg_sprecfree(p,info) - + implicit none - + ! Arguments type(amg_sprec_type), intent(inout) :: p integer(psb_ipk_), intent(out) :: info - + ! Local variables integer(psb_ipk_) :: me,err_act,i character(len=20) :: name - + info=psb_success_ name = 'amg_sprecfree' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_; return end if - + me=-1 - + call p%free(info) - + return - + end subroutine amg_sprecfree subroutine amg_s_prec_free(prec,info) - + implicit none - + ! Arguments class(amg_sprec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info - + ! Local variables integer(psb_ipk_) :: me,err_act,i character(len=20) :: name - + info=psb_success_ name = 'amg_sprecfree' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_; goto 9999 end if - + me=-1 - if (allocated(prec%precv)) then - do i=1,size(prec%precv) + if (allocated(prec%precv)) then + do i=1,size(prec%precv) call prec%precv(i)%free(info) end do deallocate(prec%precv,stat=info) end if call psb_erractionrestore(err_act) return - + 9999 call psb_error_handler(err_act) return - + end subroutine amg_s_prec_free - + ! - ! Top level methods. + ! Top level methods. ! subroutine amg_s_apply2_vect(prec,x,y,desc_data,info,trans,work) - implicit none + implicit none type(psb_desc_type),intent(in) :: desc_data class(amg_sprec_type), intent(inout) :: prec type(psb_s_vect_type),intent(inout) :: x @@ -618,13 +618,13 @@ contains call psb_erractionsave(err_act) - select type(prec) + select type(prec) type is (amg_sprec_type) call amg_precapply(prec,x,y,desc_data,info,trans,work) class default info = psb_err_missing_override_method_ call psb_errpush(info,name) - goto 9999 + goto 9999 end select call psb_erractionrestore(err_act) @@ -636,7 +636,7 @@ contains end subroutine amg_s_apply2_vect subroutine amg_s_apply1_vect(prec,x,desc_data,info,trans,work) - implicit none + implicit none type(psb_desc_type),intent(in) :: desc_data class(amg_sprec_type), intent(inout) :: prec type(psb_s_vect_type),intent(inout) :: x @@ -648,13 +648,13 @@ contains call psb_erractionsave(err_act) - select type(prec) + select type(prec) type is (amg_sprec_type) call amg_precapply(prec,x,desc_data,info,trans,work) class default info = psb_err_missing_override_method_ call psb_errpush(info,name) - goto 9999 + goto 9999 end select call psb_erractionrestore(err_act) @@ -667,7 +667,7 @@ contains subroutine amg_s_apply2v(prec,x,y,desc_data,info,trans,work) - implicit none + implicit none type(psb_desc_type),intent(in) :: desc_data class(amg_sprec_type), intent(inout) :: prec real(psb_spk_),intent(inout) :: x(:) @@ -680,13 +680,13 @@ contains call psb_erractionsave(err_act) - select type(prec) + select type(prec) type is (amg_sprec_type) call amg_precapply(prec,x,y,desc_data,info,trans,work) class default info = psb_err_missing_override_method_ call psb_errpush(info,name) - goto 9999 + goto 9999 end select call psb_erractionrestore(err_act) @@ -698,7 +698,7 @@ contains end subroutine amg_s_apply2v subroutine amg_s_apply1v(prec,x,desc_data,info,trans) - implicit none + implicit none type(psb_desc_type),intent(in) :: desc_data class(amg_sprec_type), intent(inout) :: prec real(psb_spk_),intent(inout) :: x(:) @@ -709,13 +709,13 @@ contains call psb_erractionsave(err_act) - select type(prec) + select type(prec) type is (amg_sprec_type) call amg_precapply(prec,x,desc_data,info,trans) class default info = psb_err_missing_override_method_ call psb_errpush(info,name) - goto 9999 + goto 9999 end select call psb_erractionrestore(err_act) @@ -730,8 +730,8 @@ contains subroutine amg_s_dump(prec,info,istart,iend,iproc,prefix,head,& & ac,rp,smoother,solver,tprol,& & global_num) - - implicit none + + implicit none class(amg_sprec_type), intent(in) :: prec integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: istart, iend, iproc @@ -742,27 +742,26 @@ contains integer(psb_ipk_) :: iam, np, iproc_ character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than - ! len of prefix_ + ! len of prefix_ info = 0 ctxt = prec%ctxt call psb_info(ctxt,iam,np) - iln = size(prec%precv) - if (present(istart)) then + if (present(istart)) then il1 = max(1,istart) else il1 = min(2,iln) end if - if (present(iend)) then + if (present(iend)) then iln = min(iln, iend) end if iproc_ = -1 - if (present(iproc)) then + if (present(iproc)) then iproc_ = iproc end if - if ((iproc_ == -1).or.(iproc_==iam)) then + if ((iproc_ == -1).or.(iproc_==iam)) then do lev=il1, iln call prec%precv(lev)%dump(lev,info,prefix=prefix,head=head,& & ac=ac,smoother=smoother,solver=solver,rp=rp,tprol=tprol, & @@ -773,7 +772,7 @@ contains subroutine amg_s_cnv(prec,info,amold,vmold,imold) - implicit none + implicit none class(amg_sprec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info class(psb_s_base_sparse_mat), intent(in), optional :: amold @@ -781,7 +780,7 @@ contains class(psb_i_base_vect_type), intent(in), optional :: imold integer(psb_ipk_) :: i - + info = psb_success_ if (allocated(prec%precv)) then do i=1,size(prec%precv) @@ -789,24 +788,24 @@ contains & call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold) end do end if - + end subroutine amg_s_cnv subroutine amg_s_clone(prec,precout,info) - implicit none + implicit none class(amg_sprec_type), intent(inout) :: prec class(psb_sprec_type), intent(inout) :: precout integer(psb_ipk_), intent(out) :: info - + call precout%free(info) - if (info == 0) call amg_s_inner_clone(prec,precout,info) + if (info == 0) call amg_s_inner_clone(prec,precout,info) end subroutine amg_s_clone subroutine amg_s_inner_clone(prec,precout,info) - implicit none + implicit none class(amg_sprec_type), intent(inout) :: prec class(psb_sprec_type), target, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info @@ -821,17 +820,17 @@ contains pout%ctxt = prec%ctxt pout%ag_data = prec%ag_data pout%outer_sweeps = prec%outer_sweeps - if (allocated(prec%precv)) then - ln = size(prec%precv) + if (allocated(prec%precv)) then + ln = size(prec%precv) allocate(pout%precv(ln),stat=info) if (info /= psb_success_) goto 9999 - if (ln >= 1) then + if (ln >= 1) then call prec%precv(1)%clone(pout%precv(1),info) end if do lev=2, ln if (info /= psb_success_) exit call prec%precv(lev)%clone(pout%precv(lev),info) - if (info == psb_success_) then + if (info == psb_success_) then pout%precv(lev)%base_a => pout%precv(lev)%ac pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc @@ -842,7 +841,7 @@ contains if (allocated(prec%precv(1)%wrk)) & & call pout%allocate_wrk(info,vmold=prec%precv(1)%wrk%vx2l%v) - class default + class default write(0,*) 'Error: wrong out type' info = psb_err_invalid_input_ end select @@ -854,14 +853,14 @@ contains implicit none class(amg_sprec_type), intent(inout) :: prec class(amg_sprec_type), intent(inout), target :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: i - - if (same_type_as(prec,b)) then - if (allocated(b%precv)) then + + if (same_type_as(prec,b)) then + if (allocated(b%precv)) then ! This might not be required if FINAL procedures are available. call b%free(info) - if (info /= psb_success_) then + if (info /= psb_success_) then !????? !!$ return endif @@ -869,7 +868,7 @@ contains b%ctxt = prec%ctxt b%ag_data = prec%ag_data b%outer_sweeps = prec%outer_sweeps - + call move_alloc(prec%precv,b%precv) ! Fix the pointers except on level 1. do i=2, size(b%precv) @@ -878,7 +877,7 @@ contains b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc end do - + else write(0,*) 'Warning: PREC%move_alloc onto different type?' info = psb_err_internal_error_ @@ -888,7 +887,7 @@ contains subroutine amg_s_allocate_wrk(prec,info,vmold,desc) use psb_base_mod implicit none - + ! Arguments class(amg_sprec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info @@ -896,37 +895,37 @@ contains ! ! In MLD the DESC optional argument is ignored, since ! the necessary info is contained in the various entries of the - ! PRECV component. + ! PRECV component. type(psb_desc_type), intent(in), optional :: desc - + ! Local variables integer(psb_ipk_) :: me,err_act,i,j,level,nlev, nc2l character(len=20) :: name - + info=psb_success_ name = 'amg_s_allocate_wrk' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_; goto 9999 end if - nlev = size(prec%precv) + nlev = size(prec%precv) level = 1 do level = 1, nlev call prec%precv(level)%allocate_wrk(info,vmold=vmold) - if (psb_errstatus_fatal()) then + if (psb_errstatus_fatal()) then nc2l = prec%precv(level)%base_desc%get_local_cols() info=psb_err_alloc_request_ call psb_errpush(info,name,i_err=(/2*nc2l/), a_err='real(psb_spk_)') - goto 9999 + goto 9999 end if end do call psb_erractionrestore(err_act) return - + 9999 call psb_error_handler(err_act) return - + end subroutine amg_s_allocate_wrk subroutine amg_s_free_wrk(prec,info) @@ -948,13 +947,13 @@ contains info = psb_err_internal_error_; goto 9999 end if - if (allocated(prec%precv)) then - nlev = size(prec%precv) + if (allocated(prec%precv)) then + nlev = size(prec%precv) do level = 1, nlev call prec%precv(level)%free_wrk(info) end do end if - + call psb_erractionrestore(err_act) return @@ -966,7 +965,7 @@ contains function amg_s_is_allocated_wrk(prec) result(res) use psb_base_mod implicit none - + ! Arguments class(amg_sprec_type), intent(in) :: prec logical :: res @@ -974,7 +973,7 @@ contains res = .false. if (.not.allocated(prec%precv)) return res = allocated(prec%precv(1)%wrk) - + end function amg_s_is_allocated_wrk end module amg_s_prec_type diff --git a/amgprec/amg_z_ainv_solver.F90 b/amgprec/amg_z_ainv_solver.F90 new file mode 100644 index 00000000..56f0b14a --- /dev/null +++ b/amgprec/amg_z_ainv_solver.F90 @@ -0,0 +1,321 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +! +! +! +! +module amg_z_ainv_solver + + use amg_z_base_ainv_mod + use psb_base_mod, only : psb_d_vect_type + + type, extends(amg_z_base_ainv_solver_type) :: amg_z_ainv_solver_type + ! + ! Compute an approximate factorization + ! A^-1 = Z D^-1 W^T + ! Note that here W is going to be transposed explicitly, + ! so that the component w will in the end contain W^T. + ! + integer(psb_ipk_) :: alg, fill_in + real(psb_dpk_) :: thresh + contains + procedure, pass(sv) :: check => amg_z_ainv_solver_check + procedure, pass(sv) :: build => amg_z_ainv_solver_bld + procedure, pass(sv) :: clone => amg_z_ainv_solver_clone + procedure, pass(sv) :: cseti => amg_z_ainv_solver_cseti + procedure, pass(sv) :: csetc => amg_z_ainv_solver_csetc + procedure, pass(sv) :: csetr => amg_z_ainv_solver_csetr + procedure, pass(sv) :: seti => amg_z_ainv_solver_seti + procedure, pass(sv) :: setc => amg_z_ainv_solver_setc + procedure, pass(sv) :: setr => amg_z_ainv_solver_setr + generic, public :: set => seti, setr, setc + procedure, pass(sv) :: descr => amg_z_ainv_solver_descr + procedure, pass(sv) :: default => z_ainv_solver_default + procedure, nopass :: stringval => z_ainv_stringval + procedure, nopass :: algname => z_ainv_algname + end type amg_z_ainv_solver_type + + + private :: z_ainv_stringval, z_ainv_solver_default, & + & z_ainv_algname + + interface + subroutine amg_z_ainv_solver_clone(sv,svout,info) + import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & + & amg_z_base_solver_type, psb_dpk_, amg_z_ainv_solver_type, psb_ipk_ + Implicit None + class(amg_z_ainv_solver_type), intent(inout) :: sv + class(amg_z_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + end subroutine amg_z_ainv_solver_clone + end interface + + + interface + subroutine amg_z_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) + import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & + & psb_d_vect_type, psb_z_base_vect_type, psb_dpk_,& + & amg_z_ainv_solver_type, psb_i_base_vect_type, psb_ipk_ + + Implicit None + + ! Arguments + type(psb_zspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_z_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + type(psb_zspmat_type), intent(in), target, optional :: b + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine amg_z_ainv_solver_bld + end interface + + interface + subroutine amg_z_ainv_solver_check(sv,info) + import :: psb_dpk_, amg_z_ainv_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_z_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_z_ainv_solver_check + end interface + + interface + subroutine amg_z_ainv_solver_cseti(sv,what,val,info,idx) + import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, psb_ipk_,& + & psb_d_vect_type, psb_z_base_vect_type, psb_dpk_, amg_z_ainv_solver_type + Implicit None + ! Arguments + class(amg_z_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_z_ainv_solver_cseti + end interface + + + interface + subroutine amg_z_ainv_solver_csetc(sv,what,val,info,idx) + import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, psb_ipk_,& + & psb_d_vect_type, psb_z_base_vect_type, psb_dpk_, amg_z_ainv_solver_type + Implicit None + ! Arguments + class(amg_z_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_z_ainv_solver_csetc + end interface + + interface + subroutine amg_z_ainv_solver_csetr(sv,what,val,info,idx) + import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, psb_ipk_,& + & psb_d_vect_type, psb_z_base_vect_type, psb_dpk_, amg_z_ainv_solver_type + Implicit None + ! Arguments + class(amg_z_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_z_ainv_solver_csetr + end interface + + interface + subroutine amg_z_ainv_solver_setc(sv,what,val,info) + import :: amg_z_ainv_solver_type, psb_ipk_ + Implicit none + ! Arguments + class(amg_z_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_z_ainv_solver_setc + end interface + + interface + subroutine amg_z_ainv_solver_seti(sv,what,val,info) + import :: amg_z_ainv_solver_type, psb_ipk_ + Implicit none + ! Arguments + class(amg_z_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_z_ainv_solver_seti + end interface + + interface + subroutine amg_z_ainv_solver_setr(sv,what,val,info) + import :: amg_z_ainv_solver_type, psb_ipk_, psb_dpk_ + Implicit none + ! Arguments + class(amg_z_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_z_ainv_solver_setr + end interface + + interface + subroutine amg_z_ainv_solver_descr(sv,info,iout,coarse) + import :: psb_dpk_, amg_z_ainv_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_z_ainv_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + end subroutine amg_z_ainv_solver_descr + end interface + + interface amg_ainv_bld + subroutine amg_z_ainv_bld(a,alg,fillin,thresh,wmat,d,zmat,desc,info,blck,iscale) + import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & + & psb_d_vect_type, psb_z_base_vect_type, psb_dpk_, psb_ipk_ + implicit none + type(psb_zspmat_type), intent(in), target :: a + integer(psb_ipk_), intent(in) :: fillin,alg + real(psb_dpk_), intent(in) :: thresh + type(psb_zspmat_type), intent(inout) :: wmat, zmat + complex(psb_dpk_), allocatable :: d(:) + Type(psb_desc_type), Intent(inout) :: desc + integer(psb_ipk_), intent(out) :: info + type(psb_zspmat_type), intent(in), optional :: blck + integer(psb_ipk_), intent(in), optional :: iscale + end subroutine amg_z_ainv_bld + end interface + + +contains + + subroutine z_ainv_solver_default(sv) + + use psb_base_mod + + Implicit None + + ! Arguments + class(amg_z_ainv_solver_type), intent(inout) :: sv + + sv%alg = amg_ainv_llk_ + sv%fill_in = 0 + sv%thresh = dzero + + return + end subroutine z_ainv_solver_default + + function is_positive_nz_min(ip) result(res) + implicit none + integer(psb_ipk_), intent(in) :: ip + logical :: res + + res = (ip >= 1) + return + end function is_positive_nz_min + + + function z_ainv_stringval(string) result(val) + use psb_base_mod, only : psb_ipk_,psb_toupper + implicit none + ! Arguments + character(len=*), intent(in) :: string + integer(psb_ipk_) :: val + character(len=*), parameter :: name='d_ainv_stringval' + + select case(psb_toupper(trim(string))) + case('LLK') + val = amg_ainv_llk_ + case('STAB-LLK') + val = amg_ainv_s_ft_llk_ + case('SYM-LLK') + val = amg_ainv_s_llk_ + case('MLK') + val = amg_ainv_mlk_ +#if defined(HAVE_TUMA_SAINV) + case('SAINV-TUMA') + val = amg_ainv_s_tuma_ + case('LAINV-TUMA') + val = amg_ainv_l_tuma_ +#endif + case default + val = amg_stringval(string) + end select + end function z_ainv_stringval + + + function z_ainv_algname(ialg) result(val) + integer(psb_ipk_), intent(in) :: ialg + character(len=40) :: val + + character(len=*), parameter :: mlkname = 'Left-looking, list merge ' + character(len=*), parameter :: llkname = 'Left-looking ' + character(len=*), parameter :: stabllkname = 'Stabilized Left-looking ' + character(len=*), parameter :: sllkname = 'Symmetric Left-looking ' + character(len=*), parameter :: sainvname = 'SAINV (Benzi & Tuma) ' + character(len=*), parameter :: lainvname = 'LAINV (Benzi & Tuma) ' + character(len=*), parameter :: defname = 'Unknown alg variant ' + + select case (ialg) + case(amg_ainv_mlk_) + val = mlkname + case(amg_ainv_llk_) + val = llkname + case(amg_ainv_s_llk_) + val = sllkname + case(amg_ainv_s_ft_llk_) + val = stabllkname +#if defined(HAVE_TUMA_SAINV) + case(amg_ainv_s_tuma_ ) + val = sainvname + case(amg_ainv_l_tuma_ ) + val = lainvname +#endif + case default + val = defname + end select + + end function z_ainv_algname + +end module amg_z_ainv_solver diff --git a/amgprec/amg_z_base_ainv_mod.f90 b/amgprec/amg_z_base_ainv_mod.f90 new file mode 100644 index 00000000..3c2c6b74 --- /dev/null +++ b/amgprec/amg_z_base_ainv_mod.f90 @@ -0,0 +1,199 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +module amg_z_base_ainv_mod + + use amg_base_ainv_mod + use amg_z_base_solver_mod + use psb_z_ainv_tools_mod + use psb_base_mod, only : psb_z_vect_type, psb_dpk_, psb_epk_ + + + + type, extends(amg_z_base_solver_type) :: amg_z_base_ainv_solver_type + ! + ! Compute an approximate factorization + ! A^-1 = Z D^-1 W^T + ! Note that here W is going to be transposed explicitly, + ! so that the component w will in the end contain W^T. + ! + type(psb_zspmat_type) :: w, z + type(psb_z_vect_type) :: dv + complex(psb_dpk_), allocatable :: d(:) + + contains + procedure, pass(sv) :: cnv => amg_z_base_ainv_solver_cnv + procedure, pass(sv) :: dump => amg_z_base_ainv_solver_dmp + procedure, pass(sv) :: apply_v => amg_z_base_ainv_solver_apply_vect + procedure, pass(sv) :: apply_a => amg_z_base_ainv_solver_apply + procedure, pass(sv) :: free => amg_z_base_ainv_solver_free + procedure, pass(sv) :: sizeof => z_base_ainv_solver_sizeof + procedure, pass(sv) :: get_nzeros => z_base_ainv_get_nzeros + procedure, nopass :: get_wrksz => z_base_ainv_get_wrksize + procedure, pass(sv) :: update_a => amg_z_base_ainv_update_a + generic, public :: update => update_a + end type amg_z_base_ainv_solver_type + + private :: z_base_ainv_solver_sizeof, & + & z_base_ainv_get_nzeros, z_base_ainv_get_wrksize + + + interface + subroutine amg_z_base_ainv_solver_cnv(sv,info,amold,vmold,imold) + import :: psb_z_base_sparse_mat, psb_z_base_vect_type, psb_dpk_, & + & amg_z_base_ainv_solver_type, psb_ipk_, psb_i_base_vect_type + Implicit None + ! Arguments + class(amg_z_base_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine amg_z_base_ainv_solver_cnv + end interface + + interface + subroutine amg_z_base_ainv_update_a(sv,x,desc_data,info) + import :: psb_desc_type, psb_dpk_,amg_z_base_ainv_solver_type, psb_z_vect_type, psb_ipk_ + type(psb_desc_type), intent(in) :: desc_data + class(amg_z_base_ainv_solver_type), intent(inout) :: sv + complex(psb_dpk_),intent(in) :: x(:) + integer(psb_ipk_), intent(out) :: info + end subroutine amg_z_base_ainv_update_a + end interface + + interface + subroutine amg_z_base_ainv_solver_apply(alpha,sv,x,beta,y,desc_data,& + & trans,work,info,init,initu) + import :: psb_desc_type, psb_dpk_,amg_z_base_ainv_solver_type, psb_ipk_ + type(psb_desc_type), intent(in) :: desc_data + class(amg_z_base_ainv_solver_type), intent(inout) :: sv + complex(psb_dpk_),intent(inout) :: x(:) + complex(psb_dpk_),intent(inout) :: y(:) + complex(psb_dpk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + complex(psb_dpk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: init + complex(psb_dpk_),intent(inout), optional :: initu(:) + end subroutine amg_z_base_ainv_solver_apply + end interface + + interface + subroutine amg_z_base_ainv_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& + & trans,work,wv,info,init,initu) + import :: psb_desc_type, psb_dpk_,amg_z_base_ainv_solver_type, psb_z_vect_type, psb_ipk_ + type(psb_desc_type), intent(in) :: desc_data + class(amg_z_base_ainv_solver_type), intent(inout) :: sv + type(psb_z_vect_type),intent(inout) :: x + type(psb_z_vect_type),intent(inout) :: y + complex(psb_dpk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + complex(psb_dpk_),target, intent(inout) :: work(:) + type(psb_z_vect_type),intent(inout) :: wv(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: init + type(psb_z_vect_type),intent(inout), optional :: initu + end subroutine amg_z_base_ainv_solver_apply_vect + end interface + + + interface + subroutine amg_z_base_ainv_solver_free(sv,info) + import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & + & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, amg_z_base_ainv_solver_type, psb_ipk_ + Implicit None + + ! Arguments + class(amg_z_base_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_z_base_ainv_solver_free + end interface + + interface + subroutine amg_z_base_ainv_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) + import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & + & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, amg_z_base_ainv_solver_type, psb_ipk_ + + implicit none + class(amg_z_base_ainv_solver_type), intent(in) :: sv + type(psb_desc_type), intent(in) :: desc + integer(psb_ipk_), intent(in) :: level + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix, head + logical, optional, intent(in) :: solver, global_num + end subroutine amg_z_base_ainv_solver_dmp + end interface + +contains + + function z_base_ainv_get_nzeros(sv) result(val) + implicit none + ! Arguments + class(amg_z_base_ainv_solver_type), intent(in) :: sv + integer(psb_epk_) :: val + integer :: i + + val = 0 + val = val + sv%dv%get_nrows() + val = val + sv%w%get_nzeros() + val = val + sv%z%get_nzeros() + + return + end function z_base_ainv_get_nzeros + + function z_base_ainv_solver_sizeof(sv) result(val) + implicit none + ! Arguments + class(amg_z_base_ainv_solver_type), intent(in) :: sv + integer(psb_epk_) :: val + integer :: i + + val = 2*psb_sizeof_ip + psb_sizeof_dp + val = val + sv%dv%sizeof() + val = val + sv%w%sizeof() + val = val + sv%z%sizeof() + + return + end function z_base_ainv_solver_sizeof + + function z_base_ainv_get_wrksize() result(val) + implicit none + integer(psb_ipk_) :: val + + val = 2 + end function z_base_ainv_get_wrksize + +end module amg_z_base_ainv_mod diff --git a/amgprec/amg_z_invk_solver.f90 b/amgprec/amg_z_invk_solver.f90 new file mode 100644 index 00000000..86bf6f41 --- /dev/null +++ b/amgprec/amg_z_invk_solver.f90 @@ -0,0 +1,168 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +! +! +! +! + +module amg_z_invk_solver + + use amg_z_base_solver_mod + use amg_z_base_ainv_mod + use psb_base_mod, only : psb_z_vect_type + + type, extends(amg_z_base_ainv_solver_type) :: amg_z_invk_solver_type + integer(psb_ipk_) :: fill_in, inv_fill + contains + procedure, pass(sv) :: check => amg_z_invk_solver_check + procedure, pass(sv) :: clone => amg_z_invk_solver_clone + procedure, pass(sv) :: build => amg_z_invk_solver_bld + procedure, pass(sv) :: cseti => amg_z_invk_solver_cseti + procedure, pass(sv) :: seti => amg_z_invk_solver_seti + generic, public :: set => seti + procedure, pass(sv) :: descr => amg_z_invk_solver_descr + procedure, pass(sv) :: default => z_invk_solver_default + end type amg_z_invk_solver_type + + + private :: z_invk_solver_default + + + interface + subroutine amg_z_invk_solver_clone(sv,svout,info) + import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & + & amg_z_base_solver_type, psb_dpk_, amg_z_invk_solver_type, psb_ipk_ + Implicit None + class(amg_z_invk_solver_type), intent(inout) :: sv + class(amg_z_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + end subroutine amg_z_invk_solver_clone + end interface + + interface + subroutine amg_z_invk_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) + import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & + & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & + & amg_z_invk_solver_type, psb_i_base_vect_type, psb_ipk_ + + Implicit None + + ! Arguments + type(psb_zspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_z_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + type(psb_zspmat_type), intent(in), target, optional :: b + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine amg_z_invk_solver_bld + end interface + + interface + subroutine amg_z_invk_solver_check(sv,info) + import :: psb_dpk_, amg_z_invk_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_z_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_z_invk_solver_check + end interface + + interface + subroutine amg_z_invk_solver_cseti(sv,what,val,info,idx) + import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & + & psb_ipk_, psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & + & amg_z_invk_solver_type + + Implicit None + + ! Arguments + class(amg_z_invk_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_z_invk_solver_cseti + end interface + + interface + subroutine amg_z_invk_solver_descr(sv,info,iout,coarse) + import :: psb_dpk_, amg_z_invk_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_z_invk_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + end subroutine amg_z_invk_solver_descr + end interface + + interface + subroutine amg_z_invk_solver_seti(sv,what,val,info) + import :: amg_z_invk_solver_type, psb_ipk_ + Implicit none + ! Arguments + class(amg_z_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_z_invk_solver_seti + end interface + +contains + + subroutine z_invk_solver_default(sv) + + !use psb_base_mod + + Implicit None + + ! Arguments + class(amg_z_invk_solver_type), intent(inout) :: sv + + sv%fill_in = 0 + sv%inv_fill = 0 + + return + end subroutine z_invk_solver_default + +end module amg_z_invk_solver diff --git a/amgprec/amg_z_invt_solver.f90 b/amgprec/amg_z_invt_solver.f90 new file mode 100644 index 00000000..b8609bc7 --- /dev/null +++ b/amgprec/amg_z_invt_solver.f90 @@ -0,0 +1,194 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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. +! +! +! +! +! +! + +module amg_z_invt_solver + + use amg_z_base_solver_mod + use amg_z_base_ainv_mod + use psb_base_mod, only : psb_z_vect_type + + type, extends(amg_z_base_ainv_solver_type) :: amg_z_invt_solver_type + integer(psb_ipk_) :: fill_in, inv_fill + real(psb_dpk_) :: thresh, inv_thresh + contains + procedure, pass(sv) :: check => amg_z_invt_solver_check + procedure, pass(sv) :: clone => amg_z_invt_solver_clone + procedure, pass(sv) :: build => amg_z_invt_solver_bld + procedure, pass(sv) :: cseti => amg_z_invt_solver_cseti + procedure, pass(sv) :: csetr => amg_z_invt_solver_csetr + procedure, pass(sv) :: seti => amg_z_invt_solver_seti + procedure, pass(sv) :: setr => amg_z_invt_solver_setr + generic, public :: set => seti, setr + procedure, pass(sv) :: descr => amg_z_invt_solver_descr + procedure, pass(sv) :: default => z_invt_solver_default + end type amg_z_invt_solver_type + + private :: z_invt_solver_default + + + interface + subroutine amg_z_invt_solver_clone(sv,svout,info) + import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & + & amg_z_base_solver_type, psb_dpk_, amg_z_invt_solver_type, psb_ipk_ + Implicit None + class(amg_z_invt_solver_type), intent(inout) :: sv + class(amg_z_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + end subroutine amg_z_invt_solver_clone + end interface + + interface + subroutine amg_z_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) + import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & + & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_,& + & amg_z_invt_solver_type, psb_i_base_vect_type, psb_ipk_ + + Implicit None + + ! Arguments + type(psb_zspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_z_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + type(psb_zspmat_type), intent(in), target, optional :: b + class(psb_z_base_sparse_mat), intent(in), optional :: amold + class(psb_z_base_vect_type), intent(in), optional :: vmold + class(psb_i_base_vect_type), intent(in), optional :: imold + end subroutine amg_z_invt_solver_bld + end interface + + interface + subroutine amg_z_invt_solver_check(sv,info) + import :: amg_z_invt_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_z_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + end subroutine amg_z_invt_solver_check + end interface + + interface + subroutine amg_z_invt_solver_cseti(sv,what,val,info,idx) + import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, psb_ipk_,& + & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, amg_z_invt_solver_type + Implicit None + ! Arguments + class(amg_z_invt_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_z_invt_solver_cseti + end interface + + interface + subroutine amg_z_invt_solver_csetr(sv,what,val,info,idx) + import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, psb_ipk_,& + & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, amg_z_invt_solver_type + Implicit None + ! Arguments + class(amg_z_invt_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + end subroutine amg_z_invt_solver_csetr + end interface + + interface + subroutine amg_z_invt_solver_descr(sv,info,iout,coarse) + import :: psb_dpk_, amg_z_invt_solver_type, psb_ipk_ + + Implicit None + + ! Arguments + class(amg_z_invt_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + end subroutine amg_z_invt_solver_descr + end interface + + interface + subroutine amg_z_invt_solver_setr(sv,what,val,info) + import :: amg_z_invt_solver_type, psb_dpk_, psb_ipk_ + Implicit none + ! Arguments + class(amg_z_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine amg_z_invt_solver_setr + end interface + + interface + subroutine amg_z_invt_solver_seti(sv,what,val,info) + import :: amg_z_invt_solver_type, psb_ipk_ + Implicit none + ! Arguments + class(amg_z_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + end subroutine + end interface + +contains + + subroutine z_invt_solver_default(sv) + + !use psb_base_mod + + Implicit None + + ! Arguments + class(amg_z_invt_solver_type), intent(inout) :: sv + + sv%fill_in = 0 + sv%inv_fill = 0 + sv%thresh = dzero + sv%inv_thresh = dzero + + return + end subroutine z_invt_solver_default + +end module amg_z_invt_solver diff --git a/amgprec/amg_z_prec_mod.f90 b/amgprec/amg_z_prec_mod.f90 index f317efa6..484b1829 100644 --- a/amgprec/amg_z_prec_mod.f90 +++ b/amgprec/amg_z_prec_mod.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! AMG4PSBLAS version 1.0 ! Algebraic Multigrid Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2020 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante -! +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the AMG4PSBLAS 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 @@ -33,8 +33,8 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! ! File: amg_z_prec_mod.f90 ! ! Module: amg_z_prec_mod @@ -52,6 +52,9 @@ module amg_z_prec_mod use amg_z_l1_diag_solver use amg_z_ilu_solver use amg_z_gs_solver + use amg_z_ainv_solver + use amg_z_invk_solver + use amg_z_invt_solver interface amg_precset module procedure amg_z_iprecsetsm, amg_z_iprecsetsv, & @@ -78,7 +81,7 @@ module amg_z_prec_mod ! !$ character, intent(in), optional :: upd end subroutine amg_z_extprol_bld end interface amg_extprol_bld - + contains subroutine amg_z_iprecsetsm(p,val,info,pos) @@ -108,7 +111,7 @@ contains subroutine amg_z_cprecseti(p,what,val,info,pos) type(amg_zprec_type), intent(inout) :: p - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos @@ -118,7 +121,7 @@ contains subroutine amg_z_cprecsetr(p,what,val,info,pos) type(amg_zprec_type), intent(inout) :: p - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos @@ -128,7 +131,7 @@ contains subroutine amg_z_cprecsetc(p,what,val,info,pos) type(amg_zprec_type), intent(inout) :: p - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what character(len=*), intent(in) :: val integer(psb_ipk_), intent(out) :: info character(len=*), optional, intent(in) :: pos diff --git a/amgprec/amg_z_prec_type.f90 b/amgprec/amg_z_prec_type.f90 index d65efe75..e9ea6620 100644 --- a/amgprec/amg_z_prec_type.f90 +++ b/amgprec/amg_z_prec_type.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! AMG4PSBLAS version 1.0 ! Algebraic Multigrid Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2020 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante -! +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the AMG4PSBLAS 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 @@ -33,21 +33,21 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! ! File: amg_z_prec_type.f90 ! ! Module: amg_z_prec_type ! -! This module defines: +! This module defines: ! - the amg_z_prec_type data structure containing the preconditioner and related ! data structures; ! ! It contains routines for -! - Building and applying; +! - Building and applying; ! - checking if the preconditioner is correctly defined; ! - printing a description of the preconditioner; -! - deallocating the preconditioner data structure. +! - deallocating the preconditioner data structure. ! module amg_z_prec_type @@ -70,25 +70,25 @@ module amg_z_prec_type ! It consists of an array of 'one-level' intermediate data structures ! of type amg_zonelev_type, each containing the information needed to apply ! the smoothing and the coarse-space correction at a generic level. RT is the - ! real data type, i.e. S for both S and C, and D for both D and Z. + ! real data type, i.e. S for both S and C, and D for both D and Z. ! ! type amg_zprec_type - ! type(amg_zonelev_type), allocatable :: precv(:) + ! type(amg_zonelev_type), allocatable :: precv(:) ! end type amg_zprec_type - ! + ! ! Note that the levels are numbered in increasing order starting from ! the level 1 as the finest one, and the number of levels is given by - ! size(precv(:)) which is the id of the coarsest level. + ! size(precv(:)) which is the id of the coarsest level. ! In the multigrid literature many authors number the levels in the opposite ! order, with level 0 being the id of the coarsest level. ! ! integer, parameter, private :: wv_size_=4 - + type, extends(psb_zprec_type) :: amg_zprec_type type(amg_daggr_data) :: ag_data ! - ! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle. + ! Number of outer sweeps. Sometimes 2 V-cycles may be better than 1 W-cycle. ! integer(psb_ipk_) :: outer_sweeps = 1 ! @@ -97,11 +97,11 @@ module amg_z_prec_type ! to keep track against what is put later in the multilevel array ! integer(psb_ipk_) :: coarse_solver = -1 - + ! ! The multilevel hierarchy ! - type(amg_z_onelev_type), allocatable :: precv(:) + type(amg_z_onelev_type), allocatable :: precv(:) contains procedure, pass(prec) :: psb_z_apply2_vect => amg_z_apply2_vect procedure, pass(prec) :: psb_z_apply1_vect => amg_z_apply1_vect @@ -157,7 +157,7 @@ module amg_z_prec_type interface amg_precdescr subroutine amg_zfile_prec_descr(prec,iout,root) import :: amg_zprec_type, psb_ipk_ - implicit none + implicit none ! Arguments class(amg_zprec_type), intent(in) :: prec integer(psb_ipk_), intent(in), optional :: iout @@ -211,7 +211,7 @@ module amg_z_prec_type end subroutine amg_zprecaply1 end interface - interface + interface subroutine amg_zprecsetsm(prec,val,info,ilev,ilmax,pos) import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & & amg_zprec_type, amg_z_base_smoother_type, psb_ipk_ @@ -243,7 +243,7 @@ module amg_z_prec_type import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & & amg_zprec_type, psb_ipk_ class(amg_zprec_type), intent(inout) :: prec - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what integer(psb_ipk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx @@ -253,7 +253,7 @@ module amg_z_prec_type import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & & amg_zprec_type, psb_ipk_ class(amg_zprec_type), intent(inout) :: prec - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what real(psb_dpk_), intent(in) :: val integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx @@ -263,7 +263,7 @@ module amg_z_prec_type import :: psb_zspmat_type, psb_desc_type, psb_dpk_, & & amg_zprec_type, psb_ipk_ class(amg_zprec_type), intent(inout) :: prec - character(len=*), intent(in) :: what + character(len=*), intent(in) :: what character(len=*), intent(in) :: string integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: ilev,ilmax,idx @@ -341,28 +341,28 @@ module amg_z_prec_type ! character, intent(in),optional :: upd end subroutine amg_z_smoothers_bld end interface amg_smoothers_bld - + contains ! ! Function returning a pointer to the smoother ! function amg_z_get_smootherp(prec,ilev) result(val) - implicit none + implicit none class(amg_zprec_type), target, intent(in) :: prec integer(psb_ipk_), optional :: ilev class(amg_z_base_smoother_type), pointer :: val integer(psb_ipk_) :: ilev_ - + val => null() - if (present(ilev)) then + if (present(ilev)) then ilev_ = ilev else - ! What is a good default? + ! What is a good default? ilev_ = 1 end if - if (allocated(prec%precv)) then - if ((1<=ilev_).and.(ilev_<=size(prec%precv))) then - if (allocated(prec%precv(ilev_)%sm)) then + if (allocated(prec%precv)) then + if ((1<=ilev_).and.(ilev_<=size(prec%precv))) then + if (allocated(prec%precv(ilev_)%sm)) then val => prec%precv(ilev_)%sm end if end if @@ -372,23 +372,23 @@ contains ! Function returning a pointer to the solver ! function amg_z_get_solverp(prec,ilev) result(val) - implicit none + implicit none class(amg_zprec_type), target, intent(in) :: prec integer(psb_ipk_), optional :: ilev class(amg_z_base_solver_type), pointer :: val integer(psb_ipk_) :: ilev_ - + val => null() - if (present(ilev)) then + if (present(ilev)) then ilev_ = ilev else - ! What is a good default? + ! What is a good default? ilev_ = 1 end if - if (allocated(prec%precv)) then - if ((1<=ilev_).and.(ilev_<=size(prec%precv))) then - if (allocated(prec%precv(ilev_)%sm)) then - if (allocated(prec%precv(ilev_)%sm%sv)) then + if (allocated(prec%precv)) then + if ((1<=ilev_).and.(ilev_<=size(prec%precv))) then + if (allocated(prec%precv(ilev_)%sm)) then + if (allocated(prec%precv(ilev_)%sm%sv)) then val => prec%precv(ilev_)%sm%sv end if end if @@ -399,25 +399,25 @@ contains ! Function returning the size of the precv(:) array ! function amg_z_get_nlevs(prec) result(val) - implicit none + implicit none class(amg_zprec_type), intent(in) :: prec integer(psb_ipk_) :: val val = 0 - if (allocated(prec%precv)) then + if (allocated(prec%precv)) then val = size(prec%precv) end if end function amg_z_get_nlevs ! ! Function returning the size of the amg_prec_type data structure - ! in bytes or in number of nonzeros of the operator(s) involved. + ! in bytes or in number of nonzeros of the operator(s) involved. ! function amg_z_get_nzeros(prec) result(val) - implicit none + implicit none class(amg_zprec_type), intent(in) :: prec integer(psb_epk_) :: val integer(psb_ipk_) :: i val = 0 - if (allocated(prec%precv)) then + if (allocated(prec%precv)) then do i=1, size(prec%precv) val = val + prec%precv(i)%get_nzeros() end do @@ -425,13 +425,13 @@ contains end function amg_z_get_nzeros function amg_zprec_sizeof(prec) result(val) - implicit none + implicit none class(amg_zprec_type), intent(in) :: prec integer(psb_epk_) :: val integer(psb_ipk_) :: i val = 0 val = val + psb_sizeof_ip - if (allocated(prec%precv)) then + if (allocated(prec%precv)) then do i=1, size(prec%precv) val = val + prec%precv(i)%sizeof() end do @@ -444,40 +444,40 @@ contains ! various level to the nonzeroes at the fine level ! (original matrix) ! - + function amg_z_get_compl(prec) result(val) - implicit none + implicit none class(amg_zprec_type), intent(in) :: prec complex(psb_dpk_) :: val - + val = prec%ag_data%op_complexity end function amg_z_get_compl - - subroutine amg_z_cmp_compl(prec) - implicit none + subroutine amg_z_cmp_compl(prec) + + implicit none class(amg_zprec_type), intent(inout) :: prec - + real(psb_dpk_) :: num, den, nmin type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: il + integer(psb_ipk_) :: il num = -done den = done ctxt = prec%ctxt - if (allocated(prec%precv)) then + if (allocated(prec%precv)) then il = 1 num = prec%precv(il)%base_a%get_nzeros() if (num >= dzero) then - den = num + den = num do il=2,size(prec%precv) num = num + max(0,prec%precv(il)%base_a%get_nzeros()) end do end if end if nmin = num - call psb_min(ctxt,nmin) + call psb_min(ctxt,nmin) if (nmin < dzero) then num = dzero den = done @@ -487,25 +487,25 @@ contains end if prec%ag_data%op_complexity = num/den end subroutine amg_z_cmp_compl - + ! ! Average coarsening ratio ! - + function amg_z_get_avg_cr(prec) result(val) - implicit none + implicit none class(amg_zprec_type), intent(in) :: prec complex(psb_dpk_) :: val - + val = prec%ag_data%avg_cr end function amg_z_get_avg_cr - - subroutine amg_z_cmp_avg_cr(prec) - implicit none + subroutine amg_z_cmp_avg_cr(prec) + + implicit none class(amg_zprec_type), intent(inout) :: prec - + real(psb_dpk_) :: avgcr type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: il, nl, iam, np @@ -519,12 +519,12 @@ contains do il=2,nl avgcr = avgcr + max(dzero,prec%precv(il)%szratio) end do - avgcr = avgcr / (nl-1) + avgcr = avgcr / (nl-1) end if - call psb_sum(ctxt,avgcr) + call psb_sum(ctxt,avgcr) prec%ag_data%avg_cr = avgcr/np end subroutine amg_z_cmp_avg_cr - + ! ! Subroutines: amg_Tprec_free ! Version: complex @@ -538,74 +538,74 @@ contains ! error code. ! subroutine amg_zprecfree(p,info) - + implicit none - + ! Arguments type(amg_zprec_type), intent(inout) :: p integer(psb_ipk_), intent(out) :: info - + ! Local variables integer(psb_ipk_) :: me,err_act,i character(len=20) :: name - + info=psb_success_ name = 'amg_zprecfree' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_; return end if - + me=-1 - + call p%free(info) - + return - + end subroutine amg_zprecfree subroutine amg_z_prec_free(prec,info) - + implicit none - + ! Arguments class(amg_zprec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info - + ! Local variables integer(psb_ipk_) :: me,err_act,i character(len=20) :: name - + info=psb_success_ name = 'amg_zprecfree' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_; goto 9999 end if - + me=-1 - if (allocated(prec%precv)) then - do i=1,size(prec%precv) + if (allocated(prec%precv)) then + do i=1,size(prec%precv) call prec%precv(i)%free(info) end do deallocate(prec%precv,stat=info) end if call psb_erractionrestore(err_act) return - + 9999 call psb_error_handler(err_act) return - + end subroutine amg_z_prec_free - + ! - ! Top level methods. + ! Top level methods. ! subroutine amg_z_apply2_vect(prec,x,y,desc_data,info,trans,work) - implicit none + implicit none type(psb_desc_type),intent(in) :: desc_data class(amg_zprec_type), intent(inout) :: prec type(psb_z_vect_type),intent(inout) :: x @@ -618,13 +618,13 @@ contains call psb_erractionsave(err_act) - select type(prec) + select type(prec) type is (amg_zprec_type) call amg_precapply(prec,x,y,desc_data,info,trans,work) class default info = psb_err_missing_override_method_ call psb_errpush(info,name) - goto 9999 + goto 9999 end select call psb_erractionrestore(err_act) @@ -636,7 +636,7 @@ contains end subroutine amg_z_apply2_vect subroutine amg_z_apply1_vect(prec,x,desc_data,info,trans,work) - implicit none + implicit none type(psb_desc_type),intent(in) :: desc_data class(amg_zprec_type), intent(inout) :: prec type(psb_z_vect_type),intent(inout) :: x @@ -648,13 +648,13 @@ contains call psb_erractionsave(err_act) - select type(prec) + select type(prec) type is (amg_zprec_type) call amg_precapply(prec,x,desc_data,info,trans,work) class default info = psb_err_missing_override_method_ call psb_errpush(info,name) - goto 9999 + goto 9999 end select call psb_erractionrestore(err_act) @@ -667,7 +667,7 @@ contains subroutine amg_z_apply2v(prec,x,y,desc_data,info,trans,work) - implicit none + implicit none type(psb_desc_type),intent(in) :: desc_data class(amg_zprec_type), intent(inout) :: prec complex(psb_dpk_),intent(inout) :: x(:) @@ -680,13 +680,13 @@ contains call psb_erractionsave(err_act) - select type(prec) + select type(prec) type is (amg_zprec_type) call amg_precapply(prec,x,y,desc_data,info,trans,work) class default info = psb_err_missing_override_method_ call psb_errpush(info,name) - goto 9999 + goto 9999 end select call psb_erractionrestore(err_act) @@ -698,7 +698,7 @@ contains end subroutine amg_z_apply2v subroutine amg_z_apply1v(prec,x,desc_data,info,trans) - implicit none + implicit none type(psb_desc_type),intent(in) :: desc_data class(amg_zprec_type), intent(inout) :: prec complex(psb_dpk_),intent(inout) :: x(:) @@ -709,13 +709,13 @@ contains call psb_erractionsave(err_act) - select type(prec) + select type(prec) type is (amg_zprec_type) call amg_precapply(prec,x,desc_data,info,trans) class default info = psb_err_missing_override_method_ call psb_errpush(info,name) - goto 9999 + goto 9999 end select call psb_erractionrestore(err_act) @@ -730,8 +730,8 @@ contains subroutine amg_z_dump(prec,info,istart,iend,iproc,prefix,head,& & ac,rp,smoother,solver,tprol,& & global_num) - - implicit none + + implicit none class(amg_zprec_type), intent(in) :: prec integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(in), optional :: istart, iend, iproc @@ -742,27 +742,26 @@ contains integer(psb_ipk_) :: iam, np, iproc_ character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than - ! len of prefix_ + ! len of prefix_ info = 0 ctxt = prec%ctxt call psb_info(ctxt,iam,np) - iln = size(prec%precv) - if (present(istart)) then + if (present(istart)) then il1 = max(1,istart) else il1 = min(2,iln) end if - if (present(iend)) then + if (present(iend)) then iln = min(iln, iend) end if iproc_ = -1 - if (present(iproc)) then + if (present(iproc)) then iproc_ = iproc end if - if ((iproc_ == -1).or.(iproc_==iam)) then + if ((iproc_ == -1).or.(iproc_==iam)) then do lev=il1, iln call prec%precv(lev)%dump(lev,info,prefix=prefix,head=head,& & ac=ac,smoother=smoother,solver=solver,rp=rp,tprol=tprol, & @@ -773,7 +772,7 @@ contains subroutine amg_z_cnv(prec,info,amold,vmold,imold) - implicit none + implicit none class(amg_zprec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info class(psb_z_base_sparse_mat), intent(in), optional :: amold @@ -781,7 +780,7 @@ contains class(psb_i_base_vect_type), intent(in), optional :: imold integer(psb_ipk_) :: i - + info = psb_success_ if (allocated(prec%precv)) then do i=1,size(prec%precv) @@ -789,24 +788,24 @@ contains & call prec%precv(i)%cnv(info,amold=amold,vmold=vmold,imold=imold) end do end if - + end subroutine amg_z_cnv subroutine amg_z_clone(prec,precout,info) - implicit none + implicit none class(amg_zprec_type), intent(inout) :: prec class(psb_zprec_type), intent(inout) :: precout integer(psb_ipk_), intent(out) :: info - + call precout%free(info) - if (info == 0) call amg_z_inner_clone(prec,precout,info) + if (info == 0) call amg_z_inner_clone(prec,precout,info) end subroutine amg_z_clone subroutine amg_z_inner_clone(prec,precout,info) - implicit none + implicit none class(amg_zprec_type), intent(inout) :: prec class(psb_zprec_type), target, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info @@ -821,17 +820,17 @@ contains pout%ctxt = prec%ctxt pout%ag_data = prec%ag_data pout%outer_sweeps = prec%outer_sweeps - if (allocated(prec%precv)) then - ln = size(prec%precv) + if (allocated(prec%precv)) then + ln = size(prec%precv) allocate(pout%precv(ln),stat=info) if (info /= psb_success_) goto 9999 - if (ln >= 1) then + if (ln >= 1) then call prec%precv(1)%clone(pout%precv(1),info) end if do lev=2, ln if (info /= psb_success_) exit call prec%precv(lev)%clone(pout%precv(lev),info) - if (info == psb_success_) then + if (info == psb_success_) then pout%precv(lev)%base_a => pout%precv(lev)%ac pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc @@ -842,7 +841,7 @@ contains if (allocated(prec%precv(1)%wrk)) & & call pout%allocate_wrk(info,vmold=prec%precv(1)%wrk%vx2l%v) - class default + class default write(0,*) 'Error: wrong out type' info = psb_err_invalid_input_ end select @@ -854,14 +853,14 @@ contains implicit none class(amg_zprec_type), intent(inout) :: prec class(amg_zprec_type), intent(inout), target :: b - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: i - - if (same_type_as(prec,b)) then - if (allocated(b%precv)) then + + if (same_type_as(prec,b)) then + if (allocated(b%precv)) then ! This might not be required if FINAL procedures are available. call b%free(info) - if (info /= psb_success_) then + if (info /= psb_success_) then !????? !!$ return endif @@ -869,7 +868,7 @@ contains b%ctxt = prec%ctxt b%ag_data = prec%ag_data b%outer_sweeps = prec%outer_sweeps - + call move_alloc(prec%precv,b%precv) ! Fix the pointers except on level 1. do i=2, size(b%precv) @@ -878,7 +877,7 @@ contains b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc end do - + else write(0,*) 'Warning: PREC%move_alloc onto different type?' info = psb_err_internal_error_ @@ -888,7 +887,7 @@ contains subroutine amg_z_allocate_wrk(prec,info,vmold,desc) use psb_base_mod implicit none - + ! Arguments class(amg_zprec_type), intent(inout) :: prec integer(psb_ipk_), intent(out) :: info @@ -896,37 +895,37 @@ contains ! ! In MLD the DESC optional argument is ignored, since ! the necessary info is contained in the various entries of the - ! PRECV component. + ! PRECV component. type(psb_desc_type), intent(in), optional :: desc - + ! Local variables integer(psb_ipk_) :: me,err_act,i,j,level,nlev, nc2l character(len=20) :: name - + info=psb_success_ name = 'amg_z_allocate_wrk' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_; goto 9999 end if - nlev = size(prec%precv) + nlev = size(prec%precv) level = 1 do level = 1, nlev call prec%precv(level)%allocate_wrk(info,vmold=vmold) - if (psb_errstatus_fatal()) then + if (psb_errstatus_fatal()) then nc2l = prec%precv(level)%base_desc%get_local_cols() info=psb_err_alloc_request_ call psb_errpush(info,name,i_err=(/2*nc2l/), a_err='complex(psb_dpk_)') - goto 9999 + goto 9999 end if end do call psb_erractionrestore(err_act) return - + 9999 call psb_error_handler(err_act) return - + end subroutine amg_z_allocate_wrk subroutine amg_z_free_wrk(prec,info) @@ -948,13 +947,13 @@ contains info = psb_err_internal_error_; goto 9999 end if - if (allocated(prec%precv)) then - nlev = size(prec%precv) + if (allocated(prec%precv)) then + nlev = size(prec%precv) do level = 1, nlev call prec%precv(level)%free_wrk(info) end do end if - + call psb_erractionrestore(err_act) return @@ -966,7 +965,7 @@ contains function amg_z_is_allocated_wrk(prec) result(res) use psb_base_mod implicit none - + ! Arguments class(amg_zprec_type), intent(in) :: prec logical :: res @@ -974,7 +973,7 @@ contains res = .false. if (.not.allocated(prec%precv)) return res = allocated(prec%precv(1)%wrk) - + end function amg_z_is_allocated_wrk end module amg_z_prec_type diff --git a/amgprec/impl/solver/Makefile b/amgprec/impl/solver/Makefile index c9cd0452..2ad66c71 100644 --- a/amgprec/impl/solver/Makefile +++ b/amgprec/impl/solver/Makefile @@ -1,7 +1,7 @@ include ../../../Make.inc LIBDIR=../../../lib INCDIR=../../../include -MODDIR=../../../modules +MODDIR=../../../modules HERE=../.. FINCLUDES=$(FMFLAG)$(HERE) $(FMFLAG)$(MODDIR) $(FMFLAG)$(INCDIR) $(PSBLAS_INCLUDES) @@ -191,15 +191,124 @@ amg_z_ilu_solver_dmp.o \ amg_z_mumps_solver_apply.o \ amg_z_mumps_solver_apply_vect.o \ amg_z_mumps_solver_bld.o \ - +amg_s_ainv_solver_bld.o \ +amg_s_ainv_solver_check.o \ +amg_s_ainv_solver_clone.o \ +amg_s_ainv_solver_csetc.o \ +amg_s_ainv_solver_cseti.o \ +amg_s_ainv_solver_csetr.o \ +amg_s_ainv_solver_descr.o \ +amg_s_ainv_solver_setc.o \ +amg_s_ainv_solver_seti.o \ +amg_s_ainv_solver_setr.o \ +amg_d_ainv_solver_bld.o \ +amg_d_ainv_solver_check.o \ +amg_d_ainv_solver_clone.o \ +amg_d_ainv_solver_csetc.o \ +amg_d_ainv_solver_cseti.o \ +amg_d_ainv_solver_csetr.o \ +amg_d_ainv_solver_descr.o \ +amg_d_ainv_solver_setc.o \ +amg_d_ainv_solver_seti.o \ +amg_d_ainv_solver_setr.o \ +amg_c_ainv_solver_bld.o \ +amg_c_ainv_solver_check.o \ +amg_c_ainv_solver_clone.o \ +amg_c_ainv_solver_csetc.o \ +amg_c_ainv_solver_cseti.o \ +amg_c_ainv_solver_csetr.o \ +amg_c_ainv_solver_descr.o \ +amg_c_ainv_solver_setc.o \ +amg_c_ainv_solver_seti.o \ +amg_c_ainv_solver_setr.o \ +amg_s_base_ainv_solver_apply_vect.o \ +amg_s_base_ainv_solver_apply.o \ +amg_s_base_ainv_solver_cnv.o \ +amg_s_base_ainv_solver_dmp.o \ +amg_s_base_ainv_solver_free.o \ +amg_s_base_ainv_update_a.o \ +amg_d_base_ainv_solver_apply_vect.o \ +amg_d_base_ainv_solver_apply.o \ +amg_d_base_ainv_solver_cnv.o \ +amg_d_base_ainv_solver_dmp.o \ +amg_d_base_ainv_solver_free.o \ +amg_d_base_ainv_update_a.o \ +amg_c_base_ainv_solver_apply_vect.o \ +amg_c_base_ainv_solver_apply.o \ +amg_c_base_ainv_solver_cnv.o \ +amg_c_base_ainv_solver_dmp.o \ +amg_c_base_ainv_solver_free.o \ +amg_c_base_ainv_update_a.o \ +amg_z_base_ainv_solver_apply_vect.o \ +amg_z_base_ainv_solver_apply.o \ +amg_z_base_ainv_solver_cnv.o \ +amg_z_base_ainv_solver_dmp.o \ +amg_z_base_ainv_solver_free.o \ +amg_z_base_ainv_update_a.o \ +amg_d_invt_solver_bld.o \ +amg_d_invt_solver_check.o \ +amg_d_invt_solver_clone.o \ +amg_d_invt_solver_cseti.o \ +amg_d_invt_solver_csetr.o \ +amg_d_invt_solver_descr.o \ +amg_d_invt_solver_seti.o \ +amg_d_invt_solver_setr.o \ +amg_d_invk_solver_bld.o \ +amg_d_invk_solver_check.o \ +amg_d_invk_solver_clone.o \ +amg_d_invk_solver_cseti.o \ +amg_d_invk_solver_descr.o \ +amg_d_invk_solver_seti.o \ +amg_s_invt_solver_bld.o \ +amg_s_invt_solver_check.o \ +amg_s_invt_solver_clone.o \ +amg_s_invt_solver_cseti.o \ +amg_s_invt_solver_csetr.o \ +amg_s_invt_solver_descr.o \ +amg_s_invt_solver_seti.o \ +amg_s_invt_solver_setr.o \ +amg_s_invk_solver_bld.o \ +amg_s_invk_solver_check.o \ +amg_s_invk_solver_clone.o \ +amg_s_invk_solver_cseti.o \ +amg_s_invk_solver_descr.o \ +amg_s_invk_solver_seti.o \ +amg_c_invt_solver_bld.o \ +amg_c_invt_solver_check.o \ +amg_c_invt_solver_clone.o \ +amg_c_invt_solver_cseti.o \ +amg_c_invt_solver_csetr.o \ +amg_c_invt_solver_descr.o \ +amg_c_invt_solver_seti.o \ +amg_c_invt_solver_setr.o \ +amg_c_invk_solver_bld.o \ +amg_c_invk_solver_check.o \ +amg_c_invk_solver_clone.o \ +amg_c_invk_solver_cseti.o \ +amg_c_invk_solver_descr.o \ +amg_c_invk_solver_seti.o \ +amg_z_invt_solver_bld.o \ +amg_z_invt_solver_check.o \ +amg_z_invt_solver_clone.o \ +amg_z_invt_solver_cseti.o \ +amg_z_invt_solver_csetr.o \ +amg_z_invt_solver_descr.o \ +amg_z_invt_solver_seti.o \ +amg_z_invt_solver_setr.o \ +amg_z_invk_solver_bld.o \ +amg_z_invk_solver_check.o \ +amg_z_invk_solver_clone.o \ +amg_z_invk_solver_cseti.o \ +amg_z_invk_solver_descr.o \ +amg_z_invk_solver_seti.o LIBNAME=libamg_prec.a -lib: $(OBJS) +lib: $(OBJS) $(AR) $(HERE)/$(LIBNAME) $(OBJS) $(RANLIB) $(HERE)/$(LIBNAME) -mpobjs: +mpobjs: (make $(MPFOBJS) FC="$(MPFC)" FCOPT="$(FCOPT)") (make $(MPCOBJS) CC="$(MPCC)" CCOPT="$(CCOPT)") @@ -208,4 +317,3 @@ veryclean: clean clean: /bin/rm -f $(OBJS) $(LOCAL_MODS) - diff --git a/amgprec/impl/solver/amg_c_ainv_solver_bld.f90 b/amgprec/impl/solver/amg_c_ainv_solver_bld.f90 new file mode 100644 index 00000000..ef8d1d51 --- /dev/null +++ b/amgprec/impl/solver/amg_c_ainv_solver_bld.f90 @@ -0,0 +1,98 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) + + + use psb_base_mod + use psb_c_ainv_fact_mod + use amg_c_ainv_solver, amg_protect_name => amg_c_ainv_solver_bld + + Implicit None + + ! Arguments + type(psb_cspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_c_ainv_solver_type), intent(inout) :: sv + 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(:) + integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + type(psb_ctxt_type) :: ctxt + character(len=20) :: name='amg_c_ainv_solver_bld', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + call psb_c_ainv_bld(a,sv%alg,sv%fill_in,sv%thresh,& + & sv%w,sv%d,sv%z,desc_a,info,b,iscale=amg_ilu_scale_maxval_) + + if ((info == psb_success_) .and.present(amold)) then + call sv%w%set_asb() + call sv%w%trim() + call sv%z%set_asb() + call sv%z%trim() + call sv%w%cscnv(info,mold=amold) + if (info == psb_success_) & + & call sv%z%cscnv(info,mold=amold) + end if + + if (info == psb_success_) & + & call sv%dv%bld(sv%d,mold=vmold) + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name) + goto 9999 + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_ainv_solver_bld diff --git a/amgprec/impl/solver/amg_c_ainv_solver_check.f90 b/amgprec/impl/solver/amg_c_ainv_solver_check.f90 new file mode 100644 index 00000000..75564d5c --- /dev/null +++ b/amgprec/impl/solver/amg_c_ainv_solver_check.f90 @@ -0,0 +1,65 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_ainv_solver_check(sv,info) + + + use psb_base_mod + use amg_c_ainv_solver, amg_protect_name => amg_c_ainv_solver_check + + Implicit None + + ! Arguments + class(amg_c_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_c_ainv_solver_check' + + call psb_erractionsave(err_act) + info = psb_success_ + + call amg_check_def(sv%fill_in,& + & 'Nzmin',ione,is_positive_nz_min) + call amg_check_def(sv%thresh,& + & 'Eps',szero,is_legal_s_fact_thrs) + + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_ainv_solver_check diff --git a/amgprec/impl/solver/amg_c_ainv_solver_clone.f90 b/amgprec/impl/solver/amg_c_ainv_solver_clone.f90 new file mode 100644 index 00000000..49060a8e --- /dev/null +++ b/amgprec/impl/solver/amg_c_ainv_solver_clone.f90 @@ -0,0 +1,91 @@ +! +! +! AMG4PSBLAS version 1.0 +! MultiLevel Domain Decomposition Parallel Preconditioners Package +! based on PSBLAS (Parallel Sparse BLAS version 3.0) +! +! (C) Copyright 2008,2009,2010,2010,2012 +! +! Salvatore Filippone University of Rome Tor Vergata +! Alfredo Buttari CNRS-IRIT, Toulouse +! Pasqua D'Ambra ICAR-CNR, Naples +! Daniela di Serafino Second University of Naples +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_ainv_solver_clone(sv,svout,info) + + use psb_base_mod + use amg_c_ainv_solver, amg_protect_name => amg_c_ainv_solver_clone + + Implicit None + + ! Arguments + class(amg_c_ainv_solver_type), intent(inout) :: sv + class(amg_c_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + ! Local variables + integer(psb_ipk_) :: err_act + + + info=psb_success_ + call psb_erractionsave(err_act) + + if (allocated(svout)) then + call svout%free(info) + if (info == psb_success_) deallocate(svout, stat=info) + end if + if (info == psb_success_) & + & allocate(amg_c_ainv_solver_type :: svout, stat=info) + if (info /= 0) then + info = psb_err_alloc_dealloc_ + goto 9999 + end if + select type(svo => svout) + type is (amg_c_ainv_solver_type) + svo%alg = sv%alg + svo%fill_in = sv%fill_in + svo%thresh = sv%thresh + call psb_safe_ab_cpy(sv%d,svo%d,info) + if (info == psb_success_) & + & call sv%dv%clone(svo%dv,info) + if (info == psb_success_) & + & call sv%w%clone(svo%w,info) + if (info == psb_success_) & + & call sv%z%clone(svo%z,info) + + class default + info = psb_err_internal_error_ + end select + + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_ainv_solver_clone diff --git a/amgprec/impl/solver/amg_c_ainv_solver_csetc.f90 b/amgprec/impl/solver/amg_c_ainv_solver_csetc.f90 new file mode 100644 index 00000000..309692d9 --- /dev/null +++ b/amgprec/impl/solver/amg_c_ainv_solver_csetc.f90 @@ -0,0 +1,79 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_ainv_solver_csetc(sv,what,val,info,idx) + + + use psb_base_mod + use amg_c_ainv_solver, amg_protect_name => amg_c_ainv_solver_csetc + + Implicit None + + ! Arguments + class(amg_c_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_ ) :: err_act, ival + character(len=20) :: name='amg_c_ainv_solver_setc' + + info = psb_success_ + call psb_erractionsave(err_act) + +!!$ select case(psb_toupper(trim(what))) +!!$ case('AINV_ALG') +!!$ sv%alg = sv%stringval(val) +!!$ case default +!!$ call sv%mld_d_base_solver_type%set(what,val,info) +!!$ end select + ival = sv%stringval(val) + + if (ival >=0) then + call sv%set(what,ival,info) + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info, name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_ainv_solver_csetc diff --git a/amgprec/impl/solver/amg_c_ainv_solver_cseti.f90 b/amgprec/impl/solver/amg_c_ainv_solver_cseti.f90 new file mode 100644 index 00000000..b65b0549 --- /dev/null +++ b/amgprec/impl/solver/amg_c_ainv_solver_cseti.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_ainv_solver_cseti(sv,what,val,info,idx) + + use psb_base_mod + use amg_c_ainv_solver, amg_protect_name => amg_c_ainv_solver_cseti + + Implicit None + + ! Arguments + class(amg_c_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_c_ainv_solver_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(psb_toupper(trim(what))) + case('SUB_FILLIN') + sv%fill_in = val + case('AINV_ALG') + sv%alg = val + case default + call sv%amg_c_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_ainv_solver_cseti diff --git a/amgprec/impl/solver/amg_c_ainv_solver_csetr.f90 b/amgprec/impl/solver/amg_c_ainv_solver_csetr.f90 new file mode 100644 index 00000000..1b085b3e --- /dev/null +++ b/amgprec/impl/solver/amg_c_ainv_solver_csetr.f90 @@ -0,0 +1,67 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_ainv_solver_csetr(sv,what,val,info,idx) + + use psb_base_mod + use amg_c_ainv_solver, amg_protect_name => amg_c_ainv_solver_csetr + + Implicit None + + ! Arguments + class(amg_c_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_c_ainv_solver_csetr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(psb_toupper(what)) + case('SUB_ILUTHRS') + sv%thresh = val + case default + call sv%amg_c_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_ainv_solver_csetr diff --git a/amgprec/impl/solver/amg_c_ainv_solver_descr.f90 b/amgprec/impl/solver/amg_c_ainv_solver_descr.f90 new file mode 100644 index 00000000..a3ec7c30 --- /dev/null +++ b/amgprec/impl/solver/amg_c_ainv_solver_descr.f90 @@ -0,0 +1,73 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_ainv_solver_descr(sv,info,iout,coarse) + + + use psb_base_mod + use amg_c_ainv_solver, amg_protect_name => amg_c_ainv_solver_descr + + Implicit None + + ! Arguments + class(amg_c_ainv_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + ! Local variables + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ictxt, me, np + character(len=20), parameter :: name='amg_c_ainv_solver_descr' + integer(psb_ipk_) :: iout_ + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(iout)) then + iout_ = iout + else + iout_ = 6 + endif + + write(iout_,*) ' AINV: Approximate Inverse with sparse biconjugation ' + write(iout_,*) ' Algorithm variant : ',sv%algname(sv%alg) + write(iout_,*) ' Fill level : ',sv%fill_in + write(iout_,*) ' Fill threshold : ',sv%thresh + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_ainv_solver_descr diff --git a/amgprec/impl/solver/amg_c_ainv_solver_setc.f90 b/amgprec/impl/solver/amg_c_ainv_solver_setc.f90 new file mode 100644 index 00000000..2c3eccdc --- /dev/null +++ b/amgprec/impl/solver/amg_c_ainv_solver_setc.f90 @@ -0,0 +1,71 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_ainv_solver_setc(sv,what,val,info) + + + use psb_base_mod + use amg_c_ainv_solver, amg_protect_name => amg_c_ainv_solver_setc + + Implicit None + + ! Arguments + class(amg_c_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act, ival + character(len=20) :: name='amg_c_ainv_solver_setc' + + info = psb_success_ + call psb_erractionsave(err_act) + + ival = sv%stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info, name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_ainv_solver_setc diff --git a/amgprec/impl/solver/amg_c_ainv_solver_seti.f90 b/amgprec/impl/solver/amg_c_ainv_solver_seti.f90 new file mode 100644 index 00000000..8d52497f --- /dev/null +++ b/amgprec/impl/solver/amg_c_ainv_solver_seti.f90 @@ -0,0 +1,70 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_ainv_solver_seti(sv,what,val,info) + + + use psb_base_mod + use amg_c_ainv_solver, amg_protect_name => amg_c_ainv_solver_seti + + Implicit None + + ! Arguments + class(amg_c_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_c_ainv_solver_seti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) + case(amg_sub_fillin_) + sv%fill_in = val + case(amg_ainv_alg_) + sv%alg = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_ainv_solver_seti diff --git a/amgprec/impl/solver/amg_c_ainv_solver_setr.f90 b/amgprec/impl/solver/amg_c_ainv_solver_setr.f90 new file mode 100644 index 00000000..7dbe0fa7 --- /dev/null +++ b/amgprec/impl/solver/amg_c_ainv_solver_setr.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_ainv_solver_setr(sv,what,val,info) + + + use psb_base_mod + use amg_c_ainv_solver, amg_protect_name => amg_c_ainv_solver_setr + + Implicit None + + ! Arguments + class(amg_c_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_c_ainv_solver_setr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(what) + case(amg_sub_iluthrs_) + sv%thresh = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 +!!$ goto 9999 + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_ainv_solver_setr diff --git a/amgprec/impl/solver/amg_c_base_ainv_solver_apply.f90 b/amgprec/impl/solver/amg_c_base_ainv_solver_apply.f90 new file mode 100644 index 00000000..f6e72f45 --- /dev/null +++ b/amgprec/impl/solver/amg_c_base_ainv_solver_apply.f90 @@ -0,0 +1,153 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_base_ainv_solver_apply(alpha,sv,x,beta,y,desc_data,& + & trans,work,info,init,initu) + + use psb_base_mod + use amg_c_base_ainv_mod, amg_protect_name => amg_c_base_ainv_solver_apply + implicit none + type(psb_desc_type), intent(in) :: desc_data + class(amg_c_base_ainv_solver_type), intent(inout) :: sv + complex(psb_spk_),intent(inout) :: x(:) + complex(psb_spk_),intent(inout) :: y(:) + complex(psb_spk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + complex(psb_spk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: init + complex(psb_spk_),intent(inout), optional :: initu(:) + ! + integer(psb_ipk_) :: n_row,n_col + complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) + integer(psb_ipk_) :: np,me,i, err_act + type(psb_ctxt_type) :: ctxt + character :: trans_ + character(len=20) :: name='d_base_ainv_solver_apply' + + call psb_erractionsave(err_act) + + info = psb_success_ + + trans_ = psb_toupper(trans) + select case(trans_) + case('N') + case('T','C') + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select + ! + ! For non-iterative solvers, init and initu are ignored. + ! + + n_row = psb_cd_get_local_rows(desc_data) + n_col = psb_cd_get_local_cols(desc_data) + + if (n_col <= size(work)) then + ww => work(1:n_col) + if ((4*n_col+n_col) <= size(work)) then + aux => work(n_col+1:) + else + allocate(aux(4*n_col),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/4*n_col/),& + & a_err='real(psb_dpk_)') + goto 9999 + end if + endif + else + allocate(ww(n_col),aux(4*n_col),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/5*n_col/),& + & a_err='real(psb_dpk_)') + goto 9999 + end if + endif + + select case(trans_) + case('N') + call psb_spmm(cone,sv%w,x,czero,ww,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + ww(1:n_row) = ww(1:n_row) * sv%d(1:n_row) + if (info == psb_success_) & + & call psb_spmm(alpha,sv%z,ww,beta,y,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + + case('T','C') + call psb_spmm(cone,sv%z,x,czero,ww,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + ww(1:n_row) = ww(1:n_row) * sv%d(1:n_row) + if (info == psb_success_) & + & call psb_spmm(alpha,sv%w,ww,beta,y,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + + case default + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Invalid TRANS in ainv subsolve') + goto 9999 + end select + + + if (info /= psb_success_) then + + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in subsolve') + goto 9999 + endif + + if (n_col <= size(work)) then + if ((4*n_col+n_col) <= size(work)) then + else + deallocate(aux,stat=info) + endif + else + deallocate(ww,aux,stat=info) + endif + + if (info /= psb_success_) then + + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Deallocate') + goto 9999 + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_base_ainv_solver_apply diff --git a/amgprec/impl/solver/amg_c_base_ainv_solver_apply_vect.f90 b/amgprec/impl/solver/amg_c_base_ainv_solver_apply_vect.f90 new file mode 100644 index 00000000..636be015 --- /dev/null +++ b/amgprec/impl/solver/amg_c_base_ainv_solver_apply_vect.f90 @@ -0,0 +1,167 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_base_ainv_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& + & trans,work,wv,info,init,initu) + + use psb_base_mod + use amg_c_base_ainv_mod, amg_protect_name => amg_c_base_ainv_solver_apply_vect + implicit none + type(psb_desc_type), intent(in) :: desc_data + class(amg_c_base_ainv_solver_type), intent(inout) :: sv + type(psb_c_vect_type), intent(inout) :: x + type(psb_c_vect_type), intent(inout) :: y + complex(psb_spk_), intent(in) :: alpha,beta + character(len=1), intent(in) :: trans + complex(psb_spk_),target, intent(inout) :: work(:) + type(psb_c_vect_type),intent(inout) :: wv(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: init + type(psb_c_vect_type),intent(inout), optional :: initu + ! + integer(psb_ipk_) :: n_row,n_col + complex(psb_spk_), pointer :: ww(:), aux(:) + type(psb_c_vect_type) :: tx,ty + integer(psb_ipk_) :: np,me,i, err_act + type(psb_ctxt_type) :: ctxt + character :: trans_ + character(len=20) :: name='d_base_ainv_solver_apply' + + call psb_erractionsave(err_act) + + info = psb_success_ + + trans_ = psb_toupper(trans) + select case(trans_) + case('N') + case('T','C') + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select + ! + ! For non-iterative solvers, init and initu are ignored. + ! + + n_row = psb_cd_get_local_rows(desc_data) + n_col = psb_cd_get_local_cols(desc_data) + + if (n_col <= size(work)) then + ww => work(1:n_col) + if ((4*n_col+n_col) <= size(work)) then + aux => work(n_col+1:) + else + allocate(aux(4*n_col),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/4*n_col/),& + & a_err='real(psb_dpk_)') + goto 9999 + end if + endif + else + allocate(ww(n_col),aux(4*n_col),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/5*n_col/),& + & a_err='real(psb_dpk_)') + goto 9999 + end if + endif + + if (size(wv) < 2) then + info = psb_err_internal_error_ + call psb_errpush(info,name,& + & a_err='invalid wv size') + goto 9999 + end if + + + associate(tx => wv(1), ty => wv(2)) + + select case(trans_) + case('N') + call psb_spmm(cone,sv%w,x,czero,tx,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + if (info == psb_success_) call ty%mlt(cone,sv%dv,tx,czero,info) + if (info == psb_success_) & + & call psb_spmm(alpha,sv%z,ty,beta,y,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + + case('T','C') + call psb_spmm(cone,sv%z,x,czero,tx,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + if (info == psb_success_) call ty%mlt(cone,sv%dv,tx,czero,info) + if (info == psb_success_) & + & call psb_spmm(alpha,sv%w,ty,beta,y,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + + case default + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Invalid TRANS in ainv subsolve') + goto 9999 + end select + + + if (info /= psb_success_) then + + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in subsolve') + goto 9999 + endif + + end associate + + if (n_col <= size(work)) then + if ((4*n_col+n_col) <= size(work)) then + else + deallocate(aux,stat=info) + endif + else + deallocate(ww,aux,stat=info) + endif + + if (info /= psb_success_) then + + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Deallocate') + goto 9999 + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_base_ainv_solver_apply_vect diff --git a/amgprec/impl/solver/amg_c_base_ainv_solver_cnv.f90 b/amgprec/impl/solver/amg_c_base_ainv_solver_cnv.f90 new file mode 100644 index 00000000..b360fec1 --- /dev/null +++ b/amgprec/impl/solver/amg_c_base_ainv_solver_cnv.f90 @@ -0,0 +1,63 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_base_ainv_solver_cnv(sv,info,amold,vmold,imold) + use psb_base_mod + use amg_c_base_ainv_mod, amg_protect_name => amg_c_base_ainv_solver_cnv + Implicit None + ! Arguments + class(amg_c_base_ainv_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 + integer(psb_ipk_) :: i, j, il1, iln, lname, lev + integer(psb_ipk_) :: iam, np + type(psb_ctxt_type) :: ctxt + character(len=80) :: prefix_ + character(len=120) :: fname ! len should be at least 20 more than + logical :: solver_ + ! len of prefix_ + + info = 0 + + if (present(amold)) then + call sv%w%cscnv(info,mold=amold) + call sv%z%cscnv(info,mold=amold) + end if + call sv%dv%cnv(mold=vmold) + +end subroutine amg_c_base_ainv_solver_cnv diff --git a/amgprec/impl/solver/amg_c_base_ainv_solver_dmp.f90 b/amgprec/impl/solver/amg_c_base_ainv_solver_dmp.f90 new file mode 100644 index 00000000..885ecd08 --- /dev/null +++ b/amgprec/impl/solver/amg_c_base_ainv_solver_dmp.f90 @@ -0,0 +1,93 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_base_ainv_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) + + use psb_base_mod + use amg_c_base_ainv_mod, amg_protect_name => amg_c_base_ainv_solver_dmp + implicit none + class(amg_c_base_ainv_solver_type), intent(in) :: sv + type(psb_desc_type), intent(in) :: desc + integer(psb_ipk_), intent(in) :: level + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix, head + logical, optional, intent(in) :: solver, global_num + ! + integer(psb_ipk_) :: i, j, il1, iln, lname, lev + integer(psb_ipk_) :: iam, np + type(psb_ctxt_type) :: ctxt + character(len=80) :: prefix_ + character(len=120) :: fname ! len should be at least 20 more than + logical :: solver_, global_num_ + ! len of prefix_ + + info = 0 + + if (present(prefix)) then + prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) + else + prefix_ = "dump_ainv_d" + end if + + ctxt = desc%get_context() + call psb_info(ctxt,iam,np) + + if (present(solver)) then + solver_ = solver + else + solver_ = .false. + end if + if (present(global_num)) then + global_num_ = global_num + else + global_num_ = .false. + end if + lname = len_trim(prefix_) + fname = trim(prefix_) + write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam + lname = lname + 5 + + if (solver_) then + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_wmat.mtx' + if (sv%w%is_asb()) & + & call sv%w%print(fname,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx' + if (allocated(sv%d)) & + & call psb_geprt(fname,sv%d,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_zmat.mtx' + if (sv%z%is_asb()) & + & call sv%z%print(fname,head=head) + end if + +end subroutine amg_c_base_ainv_solver_dmp diff --git a/amgprec/impl/solver/amg_c_base_ainv_solver_free.f90 b/amgprec/impl/solver/amg_c_base_ainv_solver_free.f90 new file mode 100644 index 00000000..5b2a1568 --- /dev/null +++ b/amgprec/impl/solver/amg_c_base_ainv_solver_free.f90 @@ -0,0 +1,70 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_base_ainv_solver_free(sv,info) + + use psb_base_mod + use amg_c_base_ainv_mod, amg_protect_name => amg_c_base_ainv_solver_free + + Implicit None + + ! Arguments + class(amg_c_base_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_c_base_ainv_solver_free' + + call psb_erractionsave(err_act) + info = psb_success_ + call sv%clear_data(info) + + if (allocated(sv%d)) then + deallocate(sv%d,stat=info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + end if + call sv%w%free() + call sv%z%free() + call sv%dv%free(info) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_base_ainv_solver_free diff --git a/amgprec/impl/solver/amg_c_base_ainv_update_a.f90 b/amgprec/impl/solver/amg_c_base_ainv_update_a.f90 new file mode 100644 index 00000000..62690b32 --- /dev/null +++ b/amgprec/impl/solver/amg_c_base_ainv_update_a.f90 @@ -0,0 +1,81 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_base_ainv_update_a(sv,x,desc_data,info) + use amg_c_base_ainv_mod, amg_protect_name => amg_c_base_ainv_update_a + use psb_base_mod + + implicit none + + type(psb_desc_type), intent(in) :: desc_data + class(amg_c_base_ainv_solver_type), intent(inout) :: sv + complex(psb_spk_),intent(in) :: x(:) + integer(psb_ipk_), intent(out) :: info + + ! Local variables + complex(psb_spk_), allocatable :: dd(:), ee(:) + integer(psb_ipk_) :: nrows, ncols, i, j, k, nzr, nzc, ir, ic + + type(psb_c_csc_sparse_mat) :: ac + type(psb_c_csr_sparse_mat) :: ar + + dd = sv%dv%get_vect() + if (size(x) amg_c_invk_solver_bld + + Implicit None + + ! Arguments + type(psb_cspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_c_invk_solver_type), intent(inout) :: sv + 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(:) + integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + type(psb_ctxt_type) :: ctxt + character(len=20) :: name='c_invk_solver_bld', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + + call psb_invk_fact(a,sv%fill_in,sv%inv_fill,& + & sv%w,sv%d,sv%z,desc_a,info,b) + + + if ((info == psb_success_) .and.present(amold)) then + call sv%w%cscnv(info,mold=amold) + if (info == psb_success_) & + & call sv%z%cscnv(info,mold=amold) + end if + + if (info == psb_success_) then + call sv%dv%bld(sv%d,mold=vmold) + end if + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_invk_solver_bld diff --git a/amgprec/impl/solver/amg_c_invk_solver_check.f90 b/amgprec/impl/solver/amg_c_invk_solver_check.f90 new file mode 100644 index 00000000..991ff25a --- /dev/null +++ b/amgprec/impl/solver/amg_c_invk_solver_check.f90 @@ -0,0 +1,64 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_invk_solver_check(sv,info) + + + use psb_base_mod + use amg_c_invk_solver, amg_protect_name => amg_c_invk_solver_check + + Implicit None + + ! Arguments + class(amg_c_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + Integer(Psb_Ipk_) :: err_act + character(len=20) :: name='c_invk_solver_check' + + call psb_erractionsave(err_act) + info = psb_success_ + + call amg_check_def(sv%fill_in,& + & 'Level',izero,is_int_non_negative) + call amg_check_def(sv%inv_fill,& + & 'Level',izero,is_int_non_negative) + + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_invk_solver_check diff --git a/amgprec/impl/solver/amg_c_invk_solver_clone.f90 b/amgprec/impl/solver/amg_c_invk_solver_clone.f90 new file mode 100644 index 00000000..8642a637 --- /dev/null +++ b/amgprec/impl/solver/amg_c_invk_solver_clone.f90 @@ -0,0 +1,90 @@ +! +! +! AMG4PSBLAS version 1.0 +! MultiLevel Domain Decomposition Parallel Preconditioners Package +! based on PSBLAS (Parallel Sparse BLAS version 3.0) +! +! (C) Copyright 2008,2009,2010,2010,2012 +! +! Salvatore Filippone University of Rome Tor Vergata +! Alfredo Buttari CNRS-IRIT, Toulouse +! Pasqua D'Ambra ICAR-CNR, Naples +! Daniela di Serafino Second University of Naples +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_invk_solver_clone(sv,svout,info) + + use psb_base_mod + use amg_c_invk_solver, amg_protect_name => amg_c_invk_solver_clone + + Implicit None + + ! Arguments + class(amg_c_invk_solver_type), intent(inout) :: sv + class(amg_c_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + ! Local variables + integer(psb_ipk_) :: err_act + + + info=psb_success_ + call psb_erractionsave(err_act) + + if (allocated(svout)) then + call svout%free(info) + if (info == psb_success_) deallocate(svout, stat=info) + end if + if (info == psb_success_) & + & allocate(amg_c_invk_solver_type :: svout, stat=info) + if (info /= 0) then + info = psb_err_alloc_dealloc_ + goto 9999 + end if + select type(svo => svout) + type is (amg_c_invk_solver_type) + svo%fill_in = sv%fill_in + svo%inv_fill = sv%inv_fill + call psb_safe_ab_cpy(sv%d,svo%d,info) + if (info == psb_success_) & + & call sv%dv%clone(svo%dv,info) + if (info == psb_success_) & + & call sv%w%clone(svo%w,info) + if (info == psb_success_) & + & call sv%z%clone(svo%z,info) + + class default + info = psb_err_internal_error_ + end select + + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_invk_solver_clone diff --git a/amgprec/impl/solver/amg_c_invk_solver_cseti.f90 b/amgprec/impl/solver/amg_c_invk_solver_cseti.f90 new file mode 100644 index 00000000..0033e202 --- /dev/null +++ b/amgprec/impl/solver/amg_c_invk_solver_cseti.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_invk_solver_cseti(sv,what,val,info,idx) + + use psb_base_mod + use amg_c_invk_solver, amg_protect_name => amg_c_invk_solver_cseti + + Implicit None + + ! Arguments + class(amg_c_invk_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_invk_solver_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(psb_toupper(what)) + case('SUB_FILLIN') + sv%fill_in = val + case('INV_FILLIN') + sv%inv_fill = val + case default + call sv%amg_c_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_invk_solver_cseti diff --git a/amgprec/impl/solver/amg_c_invk_solver_descr.f90 b/amgprec/impl/solver/amg_c_invk_solver_descr.f90 new file mode 100644 index 00000000..31777e5f --- /dev/null +++ b/amgprec/impl/solver/amg_c_invk_solver_descr.f90 @@ -0,0 +1,73 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_invk_solver_descr(sv,info,iout,coarse) + + + use psb_base_mod + use amg_c_invk_solver, amg_protect_name => amg_c_invk_solver_descr + + Implicit None + + ! Arguments + class(amg_c_invk_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + ! Local variables + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: me, np + type(psb_ctxt_type) :: ctxt + character(len=20), parameter :: name='amg_c_invk_solver_descr' + integer(psb_ipk_) :: iout_ + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(iout)) then + iout_ = iout + else + iout_ = 6 + endif + + write(iout_,*) ' INVK Approximate Inverse with ILU(N) ' + write(iout_,*) ' Fill level :',sv%fill_in + write(iout_,*) ' Inverse fill level :',sv%inv_fill + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_invk_solver_descr diff --git a/amgprec/impl/solver/amg_c_invk_solver_seti.f90 b/amgprec/impl/solver/amg_c_invk_solver_seti.f90 new file mode 100644 index 00000000..52c23eb8 --- /dev/null +++ b/amgprec/impl/solver/amg_c_invk_solver_seti.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_invk_solver_seti(sv,what,val,info) + + + use psb_base_mod + use amg_c_invk_solver, amg_protect_name => amg_c_invk_solver_seti + + Implicit None + + ! Arguments + class(amg_c_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_invk_solver_seti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) + case(amg_sub_fillin_) + sv%fill_in = val + case(amg_inv_fillin_) + sv%inv_fill = val + case default + ! call sv%amg_c_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_invk_solver_seti diff --git a/amgprec/impl/solver/amg_c_invt_solver_bld.f90 b/amgprec/impl/solver/amg_c_invt_solver_bld.f90 new file mode 100644 index 00000000..f7dffaaa --- /dev/null +++ b/amgprec/impl/solver/amg_c_invt_solver_bld.f90 @@ -0,0 +1,97 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) + + use psb_base_mod + use psb_c_invt_fact_mod ! This module contains the construction routines + use amg_c_invt_solver, amg_protect_name => amg_c_invt_solver_bld + + Implicit None + + ! Arguments + type(psb_cspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_c_invt_solver_type), intent(inout) :: sv + 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(:) + integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + type(psb_ctxt_type) :: ctxt + character(len=20) :: name='amg_c_invt_solver_bld', ch_err + + info = psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + + call psb_invt_fact(a,sv%fill_in,sv%inv_fill,& + & sv%thresh,sv%inv_thresh,& + & sv%w,sv%d,sv%z,desc_a,info,b) + + if ((info == psb_success_) .and.present(amold)) then + call sv%w%cscnv(info,mold=amold) + if (info == psb_success_) & + & call sv%z%cscnv(info,mold=amold) + end if + + if (info == psb_success_) then + call sv%dv%bld(sv%d,mold=vmold) + end if + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name) + goto 9999 + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_invt_solver_bld diff --git a/amgprec/impl/solver/amg_c_invt_solver_check.f90 b/amgprec/impl/solver/amg_c_invt_solver_check.f90 new file mode 100644 index 00000000..e4e0b9e1 --- /dev/null +++ b/amgprec/impl/solver/amg_c_invt_solver_check.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_invt_solver_check(sv,info) + + + use psb_base_mod + use amg_c_invt_solver, amg_protect_name => amg_c_invt_solver_check + + Implicit None + + ! Arguments + class(amg_c_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + ! + Integer(Psb_Ipk_) :: err_act + character(len=20) :: name='amg_c_invt_solver_check' + + call psb_erractionsave(err_act) + info = psb_success_ + + call amg_check_def(sv%fill_in,& + & 'Level',izero,is_int_non_negative) + call amg_check_def(sv%inv_fill,& + & 'Level',izero,is_int_non_negative) + call amg_check_def(sv%thresh,& + & 'Eps',szero,is_legal_s_fact_thrs) + call amg_check_def(sv%inv_thresh,& + & 'Eps',szero,is_legal_s_fact_thrs) + + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_invt_solver_check diff --git a/amgprec/impl/solver/amg_c_invt_solver_clone.f90 b/amgprec/impl/solver/amg_c_invt_solver_clone.f90 new file mode 100644 index 00000000..0f758764 --- /dev/null +++ b/amgprec/impl/solver/amg_c_invt_solver_clone.f90 @@ -0,0 +1,92 @@ +! +! +! AMG4PSBLAS version 1.0 +! MultiLevel Domain Decomposition Parallel Preconditioners Package +! based on PSBLAS (Parallel Sparse BLAS version 3.0) +! +! (C) Copyright 2008,2009,2010,2010,2012 +! +! Salvatore Filippone University of Rome Tor Vergata +! Alfredo Buttari CNRS-IRIT, Toulouse +! Pasqua D'Ambra ICAR-CNR, Naples +! Daniela di Serafino Second University of Naples +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_invt_solver_clone(sv,svout,info) + + use psb_base_mod + use amg_c_invt_solver, amg_protect_name => amg_c_invt_solver_clone + + Implicit None + + ! Arguments + class(amg_c_invt_solver_type), intent(inout) :: sv + class(amg_c_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + ! Local variables + integer(psb_ipk_) :: err_act + + + info=psb_success_ + call psb_erractionsave(err_act) + + if (allocated(svout)) then + call svout%free(info) + if (info == psb_success_) deallocate(svout, stat=info) + end if + if (info == psb_success_) & + & allocate(amg_c_invt_solver_type :: svout, stat=info) + if (info /= 0) then + info = psb_err_alloc_dealloc_ + goto 9999 + end if + select type(svo => svout) + type is (amg_c_invt_solver_type) + svo%fill_in = sv%fill_in + svo%inv_fill = sv%inv_fill + svo%thresh = sv%thresh + svo%inv_thresh = sv%inv_thresh + call psb_safe_ab_cpy(sv%d,svo%d,info) + if (info == psb_success_) & + & call sv%dv%clone(svo%dv,info) + if (info == psb_success_) & + & call sv%w%clone(svo%w,info) + if (info == psb_success_) & + & call sv%z%clone(svo%z,info) + + class default + info = psb_err_internal_error_ + end select + + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_invt_solver_clone diff --git a/amgprec/impl/solver/amg_c_invt_solver_cseti.f90 b/amgprec/impl/solver/amg_c_invt_solver_cseti.f90 new file mode 100644 index 00000000..8670f97a --- /dev/null +++ b/amgprec/impl/solver/amg_c_invt_solver_cseti.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_invt_solver_cseti(sv,what,val,info,idx) + + use psb_base_mod + use amg_c_invt_solver, amg_protect_name => amg_c_invt_solver_cseti + + Implicit None + + ! Arguments + class(amg_c_invt_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_c_invt_solver_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(psb_toupper(what)) + case('SUB_FILLIN') + sv%fill_in = val + case('INV_FILLIN') + sv%inv_fill = val + case default + call sv%amg_c_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_invt_solver_cseti diff --git a/amgprec/impl/solver/amg_c_invt_solver_csetr.f90 b/amgprec/impl/solver/amg_c_invt_solver_csetr.f90 new file mode 100644 index 00000000..317b6719 --- /dev/null +++ b/amgprec/impl/solver/amg_c_invt_solver_csetr.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_invt_solver_csetr(sv,what,val,info,idx) + + use psb_base_mod + use amg_c_invt_solver, amg_protect_name => amg_c_invt_solver_csetr + + Implicit None + + ! Arguments + class(amg_c_invt_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_c_invt_solver_csetr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(psb_toupper(what)) + case('SUB_ILUTHRS') + sv%thresh = val + case('INV_THRESH') + sv%inv_thresh = val + case default + call sv%amg_c_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_invt_solver_csetr diff --git a/amgprec/impl/solver/amg_c_invt_solver_descr.f90 b/amgprec/impl/solver/amg_c_invt_solver_descr.f90 new file mode 100644 index 00000000..cf6a3837 --- /dev/null +++ b/amgprec/impl/solver/amg_c_invt_solver_descr.f90 @@ -0,0 +1,74 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_invt_solver_descr(sv,info,iout,coarse) + + + use psb_base_mod + use amg_c_invt_solver, amg_protect_name => amg_c_invt_solver_descr + + Implicit None + + ! Arguments + class(amg_c_invt_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + ! Local variables + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ictxt, me, np + character(len=20), parameter :: name='amg_c_invt_solver_descr' + integer(psb_ipk_) :: iout_ + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(iout)) then + iout_ = iout + else + iout_ = 6 + endif + + write(iout_,*) ' INVT Approximate Inverse with ILU(T,P) ' + write(iout_,*) ' Fill level :',sv%fill_in + write(iout_,*) ' Fill threshold :',sv%thresh + write(iout_,*) ' Inverse fill level :',sv%inv_fill + write(iout_,*) ' Inverse fill threshold :',sv%inv_thresh + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_invt_solver_descr diff --git a/amgprec/impl/solver/amg_c_invt_solver_seti.f90 b/amgprec/impl/solver/amg_c_invt_solver_seti.f90 new file mode 100644 index 00000000..3cd19581 --- /dev/null +++ b/amgprec/impl/solver/amg_c_invt_solver_seti.f90 @@ -0,0 +1,70 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_invt_solver_seti(sv,what,val,info) + + + use psb_base_mod + use amg_c_invt_solver, amg_protect_name => amg_c_invt_solver_seti + + Implicit None + + ! Arguments + class(amg_c_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + Integer(Psb_Ipk_) :: err_act + character(len=20) :: name='amg_c_invt_solver_seti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) + case(amg_sub_fillin_) + sv%fill_in = val + case(amg_inv_fillin_) + sv%inv_fill = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_invt_solver_seti diff --git a/amgprec/impl/solver/amg_c_invt_solver_setr.f90 b/amgprec/impl/solver/amg_c_invt_solver_setr.f90 new file mode 100644 index 00000000..eec1287f --- /dev/null +++ b/amgprec/impl/solver/amg_c_invt_solver_setr.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_c_invt_solver_setr(sv,what,val,info) + + + use psb_base_mod + use amg_c_invt_solver, amg_protect_name => amg_c_invt_solver_setr + + Implicit None + + ! Arguments + class(amg_c_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + Integer(Psb_Ipk_) :: err_act + character(len=20) :: name='amg_c_invt_solver_setr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(what) + case(amg_sub_iluthrs_) + sv%thresh = val + case(amg_inv_thresh_) + sv%inv_thresh = val + case default + ! call sv%amg_c_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_c_invt_solver_setr diff --git a/amgprec/impl/solver/amg_d_ainv_solver_bld.f90 b/amgprec/impl/solver/amg_d_ainv_solver_bld.f90 new file mode 100644 index 00000000..e05711b6 --- /dev/null +++ b/amgprec/impl/solver/amg_d_ainv_solver_bld.f90 @@ -0,0 +1,98 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) + + + use psb_base_mod + use psb_d_ainv_fact_mod + use amg_d_ainv_solver, amg_protect_name => amg_d_ainv_solver_bld + + Implicit None + + ! Arguments + type(psb_dspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_d_ainv_solver_type), intent(inout) :: sv + 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(:) + integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + type(psb_ctxt_type) :: ctxt + character(len=20) :: name='amg_d_ainv_solver_bld', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + call psb_d_ainv_bld(a,sv%alg,sv%fill_in,sv%thresh,& + & sv%w,sv%d,sv%z,desc_a,info,b,iscale=amg_ilu_scale_maxval_) + + if ((info == psb_success_) .and.present(amold)) then + call sv%w%set_asb() + call sv%w%trim() + call sv%z%set_asb() + call sv%z%trim() + call sv%w%cscnv(info,mold=amold) + if (info == psb_success_) & + & call sv%z%cscnv(info,mold=amold) + end if + + if (info == psb_success_) & + & call sv%dv%bld(sv%d,mold=vmold) + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name) + goto 9999 + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_ainv_solver_bld diff --git a/amgprec/impl/solver/amg_d_ainv_solver_check.f90 b/amgprec/impl/solver/amg_d_ainv_solver_check.f90 new file mode 100644 index 00000000..256fcbd8 --- /dev/null +++ b/amgprec/impl/solver/amg_d_ainv_solver_check.f90 @@ -0,0 +1,65 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_ainv_solver_check(sv,info) + + + use psb_base_mod + use amg_d_ainv_solver, amg_protect_name => amg_d_ainv_solver_check + + Implicit None + + ! Arguments + class(amg_d_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_d_ainv_solver_check' + + call psb_erractionsave(err_act) + info = psb_success_ + + call amg_check_def(sv%fill_in,& + & 'Nzmin',ione,is_positive_nz_min) + call amg_check_def(sv%thresh,& + & 'Eps',dzero,is_legal_d_fact_thrs) + + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_ainv_solver_check diff --git a/amgprec/impl/solver/amg_d_ainv_solver_clone.f90 b/amgprec/impl/solver/amg_d_ainv_solver_clone.f90 new file mode 100644 index 00000000..85f036cd --- /dev/null +++ b/amgprec/impl/solver/amg_d_ainv_solver_clone.f90 @@ -0,0 +1,91 @@ +! +! +! AMG4PSBLAS version 1.0 +! MultiLevel Domain Decomposition Parallel Preconditioners Package +! based on PSBLAS (Parallel Sparse BLAS version 3.0) +! +! (C) Copyright 2008,2009,2010,2010,2012 +! +! Salvatore Filippone University of Rome Tor Vergata +! Alfredo Buttari CNRS-IRIT, Toulouse +! Pasqua D'Ambra ICAR-CNR, Naples +! Daniela di Serafino Second University of Naples +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_ainv_solver_clone(sv,svout,info) + + use psb_base_mod + use amg_d_ainv_solver, amg_protect_name => amg_d_ainv_solver_clone + + Implicit None + + ! Arguments + class(amg_d_ainv_solver_type), intent(inout) :: sv + class(amg_d_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + ! Local variables + integer(psb_ipk_) :: err_act + + + info=psb_success_ + call psb_erractionsave(err_act) + + if (allocated(svout)) then + call svout%free(info) + if (info == psb_success_) deallocate(svout, stat=info) + end if + if (info == psb_success_) & + & allocate(amg_d_ainv_solver_type :: svout, stat=info) + if (info /= 0) then + info = psb_err_alloc_dealloc_ + goto 9999 + end if + select type(svo => svout) + type is (amg_d_ainv_solver_type) + svo%alg = sv%alg + svo%fill_in = sv%fill_in + svo%thresh = sv%thresh + call psb_safe_ab_cpy(sv%d,svo%d,info) + if (info == psb_success_) & + & call sv%dv%clone(svo%dv,info) + if (info == psb_success_) & + & call sv%w%clone(svo%w,info) + if (info == psb_success_) & + & call sv%z%clone(svo%z,info) + + class default + info = psb_err_internal_error_ + end select + + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_ainv_solver_clone diff --git a/amgprec/impl/solver/amg_d_ainv_solver_csetc.f90 b/amgprec/impl/solver/amg_d_ainv_solver_csetc.f90 new file mode 100644 index 00000000..fa2799b5 --- /dev/null +++ b/amgprec/impl/solver/amg_d_ainv_solver_csetc.f90 @@ -0,0 +1,79 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_ainv_solver_csetc(sv,what,val,info,idx) + + + use psb_base_mod + use amg_d_ainv_solver, amg_protect_name => amg_d_ainv_solver_csetc + + Implicit None + + ! Arguments + class(amg_d_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_ ) :: err_act, ival + character(len=20) :: name='amg_d_ainv_solver_setc' + + info = psb_success_ + call psb_erractionsave(err_act) + +!!$ select case(psb_toupper(trim(what))) +!!$ case('AINV_ALG') +!!$ sv%alg = sv%stringval(val) +!!$ case default +!!$ call sv%mld_d_base_solver_type%set(what,val,info) +!!$ end select + ival = sv%stringval(val) + + if (ival >=0) then + call sv%set(what,ival,info) + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info, name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_ainv_solver_csetc diff --git a/amgprec/impl/solver/amg_d_ainv_solver_cseti.f90 b/amgprec/impl/solver/amg_d_ainv_solver_cseti.f90 new file mode 100644 index 00000000..bc0af0ef --- /dev/null +++ b/amgprec/impl/solver/amg_d_ainv_solver_cseti.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_ainv_solver_cseti(sv,what,val,info,idx) + + use psb_base_mod + use amg_d_ainv_solver, amg_protect_name => amg_d_ainv_solver_cseti + + Implicit None + + ! Arguments + class(amg_d_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_d_ainv_solver_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(psb_toupper(trim(what))) + case('SUB_FILLIN') + sv%fill_in = val + case('AINV_ALG') + sv%alg = val + case default + call sv%amg_d_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_ainv_solver_cseti diff --git a/amgprec/impl/solver/amg_d_ainv_solver_csetr.f90 b/amgprec/impl/solver/amg_d_ainv_solver_csetr.f90 new file mode 100644 index 00000000..046d5683 --- /dev/null +++ b/amgprec/impl/solver/amg_d_ainv_solver_csetr.f90 @@ -0,0 +1,67 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_ainv_solver_csetr(sv,what,val,info,idx) + + use psb_base_mod + use amg_d_ainv_solver, amg_protect_name => amg_d_ainv_solver_csetr + + Implicit None + + ! Arguments + class(amg_d_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_d_ainv_solver_csetr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(psb_toupper(what)) + case('SUB_ILUTHRS') + sv%thresh = val + case default + call sv%amg_d_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_ainv_solver_csetr diff --git a/amgprec/impl/solver/amg_d_ainv_solver_descr.f90 b/amgprec/impl/solver/amg_d_ainv_solver_descr.f90 new file mode 100644 index 00000000..1629eb45 --- /dev/null +++ b/amgprec/impl/solver/amg_d_ainv_solver_descr.f90 @@ -0,0 +1,73 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_ainv_solver_descr(sv,info,iout,coarse) + + + use psb_base_mod + use amg_d_ainv_solver, amg_protect_name => amg_d_ainv_solver_descr + + Implicit None + + ! Arguments + class(amg_d_ainv_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + ! Local variables + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ictxt, me, np + character(len=20), parameter :: name='amg_d_ainv_solver_descr' + integer(psb_ipk_) :: iout_ + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(iout)) then + iout_ = iout + else + iout_ = 6 + endif + + write(iout_,*) ' AINV: Approximate Inverse with sparse biconjugation ' + write(iout_,*) ' Algorithm variant : ',sv%algname(sv%alg) + write(iout_,*) ' Fill level : ',sv%fill_in + write(iout_,*) ' Fill threshold : ',sv%thresh + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_ainv_solver_descr diff --git a/amgprec/impl/solver/amg_d_ainv_solver_setc.f90 b/amgprec/impl/solver/amg_d_ainv_solver_setc.f90 new file mode 100644 index 00000000..260f8a84 --- /dev/null +++ b/amgprec/impl/solver/amg_d_ainv_solver_setc.f90 @@ -0,0 +1,71 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_ainv_solver_setc(sv,what,val,info) + + + use psb_base_mod + use amg_d_ainv_solver, amg_protect_name => amg_d_ainv_solver_setc + + Implicit None + + ! Arguments + class(amg_d_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act, ival + character(len=20) :: name='amg_d_ainv_solver_setc' + + info = psb_success_ + call psb_erractionsave(err_act) + + ival = sv%stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info, name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_ainv_solver_setc diff --git a/amgprec/impl/solver/amg_d_ainv_solver_seti.f90 b/amgprec/impl/solver/amg_d_ainv_solver_seti.f90 new file mode 100644 index 00000000..2d7c5a64 --- /dev/null +++ b/amgprec/impl/solver/amg_d_ainv_solver_seti.f90 @@ -0,0 +1,70 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_ainv_solver_seti(sv,what,val,info) + + + use psb_base_mod + use amg_d_ainv_solver, amg_protect_name => amg_d_ainv_solver_seti + + Implicit None + + ! Arguments + class(amg_d_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_d_ainv_solver_seti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) + case(amg_sub_fillin_) + sv%fill_in = val + case(amg_ainv_alg_) + sv%alg = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_ainv_solver_seti diff --git a/amgprec/impl/solver/amg_d_ainv_solver_setr.f90 b/amgprec/impl/solver/amg_d_ainv_solver_setr.f90 new file mode 100644 index 00000000..6a816c16 --- /dev/null +++ b/amgprec/impl/solver/amg_d_ainv_solver_setr.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_ainv_solver_setr(sv,what,val,info) + + + use psb_base_mod + use amg_d_ainv_solver, amg_protect_name => amg_d_ainv_solver_setr + + Implicit None + + ! Arguments + class(amg_d_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_d_ainv_solver_setr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(what) + case(amg_sub_iluthrs_) + sv%thresh = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 +!!$ goto 9999 + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_ainv_solver_setr diff --git a/amgprec/impl/solver/amg_d_base_ainv_solver_apply.f90 b/amgprec/impl/solver/amg_d_base_ainv_solver_apply.f90 new file mode 100644 index 00000000..b36a41b3 --- /dev/null +++ b/amgprec/impl/solver/amg_d_base_ainv_solver_apply.f90 @@ -0,0 +1,153 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_base_ainv_solver_apply(alpha,sv,x,beta,y,desc_data,& + & trans,work,info,init,initu) + + use psb_base_mod + use amg_d_base_ainv_mod, amg_protect_name => amg_d_base_ainv_solver_apply + implicit none + type(psb_desc_type), intent(in) :: desc_data + class(amg_d_base_ainv_solver_type), intent(inout) :: sv + real(psb_dpk_),intent(inout) :: x(:) + real(psb_dpk_),intent(inout) :: y(:) + real(psb_dpk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + real(psb_dpk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: init + real(psb_dpk_),intent(inout), optional :: initu(:) + ! + integer(psb_ipk_) :: n_row,n_col + real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) + integer(psb_ipk_) :: np,me,i, err_act + type(psb_ctxt_type) :: ctxt + character :: trans_ + character(len=20) :: name='d_base_ainv_solver_apply' + + call psb_erractionsave(err_act) + + info = psb_success_ + + trans_ = psb_toupper(trans) + select case(trans_) + case('N') + case('T','C') + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select + ! + ! For non-iterative solvers, init and initu are ignored. + ! + + n_row = psb_cd_get_local_rows(desc_data) + n_col = psb_cd_get_local_cols(desc_data) + + if (n_col <= size(work)) then + ww => work(1:n_col) + if ((4*n_col+n_col) <= size(work)) then + aux => work(n_col+1:) + else + allocate(aux(4*n_col),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/4*n_col/),& + & a_err='real(psb_dpk_)') + goto 9999 + end if + endif + else + allocate(ww(n_col),aux(4*n_col),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/5*n_col/),& + & a_err='real(psb_dpk_)') + goto 9999 + end if + endif + + select case(trans_) + case('N') + call psb_spmm(done,sv%w,x,dzero,ww,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + ww(1:n_row) = ww(1:n_row) * sv%d(1:n_row) + if (info == psb_success_) & + & call psb_spmm(alpha,sv%z,ww,beta,y,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + + case('T','C') + call psb_spmm(done,sv%z,x,dzero,ww,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + ww(1:n_row) = ww(1:n_row) * sv%d(1:n_row) + if (info == psb_success_) & + & call psb_spmm(alpha,sv%w,ww,beta,y,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + + case default + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Invalid TRANS in ainv subsolve') + goto 9999 + end select + + + if (info /= psb_success_) then + + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in subsolve') + goto 9999 + endif + + if (n_col <= size(work)) then + if ((4*n_col+n_col) <= size(work)) then + else + deallocate(aux,stat=info) + endif + else + deallocate(ww,aux,stat=info) + endif + + if (info /= psb_success_) then + + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Deallocate') + goto 9999 + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_base_ainv_solver_apply diff --git a/amgprec/impl/solver/amg_d_base_ainv_solver_apply_vect.f90 b/amgprec/impl/solver/amg_d_base_ainv_solver_apply_vect.f90 new file mode 100644 index 00000000..7f65a178 --- /dev/null +++ b/amgprec/impl/solver/amg_d_base_ainv_solver_apply_vect.f90 @@ -0,0 +1,167 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_base_ainv_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& + & trans,work,wv,info,init,initu) + + use psb_base_mod + use amg_d_base_ainv_mod, amg_protect_name => amg_d_base_ainv_solver_apply_vect + implicit none + type(psb_desc_type), intent(in) :: desc_data + class(amg_d_base_ainv_solver_type), intent(inout) :: sv + type(psb_d_vect_type), intent(inout) :: x + type(psb_d_vect_type), intent(inout) :: y + real(psb_dpk_), intent(in) :: alpha,beta + character(len=1), intent(in) :: trans + real(psb_dpk_),target, intent(inout) :: work(:) + type(psb_d_vect_type),intent(inout) :: wv(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: init + type(psb_d_vect_type),intent(inout), optional :: initu + ! + integer(psb_ipk_) :: n_row,n_col + real(psb_dpk_), pointer :: ww(:), aux(:) + type(psb_d_vect_type) :: tx,ty + integer(psb_ipk_) :: np,me,i, err_act + type(psb_ctxt_type) :: ctxt + character :: trans_ + character(len=20) :: name='d_base_ainv_solver_apply' + + call psb_erractionsave(err_act) + + info = psb_success_ + + trans_ = psb_toupper(trans) + select case(trans_) + case('N') + case('T','C') + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select + ! + ! For non-iterative solvers, init and initu are ignored. + ! + + n_row = psb_cd_get_local_rows(desc_data) + n_col = psb_cd_get_local_cols(desc_data) + + if (n_col <= size(work)) then + ww => work(1:n_col) + if ((4*n_col+n_col) <= size(work)) then + aux => work(n_col+1:) + else + allocate(aux(4*n_col),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/4*n_col/),& + & a_err='real(psb_dpk_)') + goto 9999 + end if + endif + else + allocate(ww(n_col),aux(4*n_col),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/5*n_col/),& + & a_err='real(psb_dpk_)') + goto 9999 + end if + endif + + if (size(wv) < 2) then + info = psb_err_internal_error_ + call psb_errpush(info,name,& + & a_err='invalid wv size') + goto 9999 + end if + + + associate(tx => wv(1), ty => wv(2)) + + select case(trans_) + case('N') + call psb_spmm(done,sv%w,x,dzero,tx,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + if (info == psb_success_) call ty%mlt(done,sv%dv,tx,dzero,info) + if (info == psb_success_) & + & call psb_spmm(alpha,sv%z,ty,beta,y,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + + case('T','C') + call psb_spmm(done,sv%z,x,dzero,tx,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + if (info == psb_success_) call ty%mlt(done,sv%dv,tx,dzero,info) + if (info == psb_success_) & + & call psb_spmm(alpha,sv%w,ty,beta,y,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + + case default + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Invalid TRANS in ainv subsolve') + goto 9999 + end select + + + if (info /= psb_success_) then + + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in subsolve') + goto 9999 + endif + + end associate + + if (n_col <= size(work)) then + if ((4*n_col+n_col) <= size(work)) then + else + deallocate(aux,stat=info) + endif + else + deallocate(ww,aux,stat=info) + endif + + if (info /= psb_success_) then + + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Deallocate') + goto 9999 + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_base_ainv_solver_apply_vect diff --git a/amgprec/impl/solver/amg_d_base_ainv_solver_cnv.f90 b/amgprec/impl/solver/amg_d_base_ainv_solver_cnv.f90 new file mode 100644 index 00000000..e4e38cf2 --- /dev/null +++ b/amgprec/impl/solver/amg_d_base_ainv_solver_cnv.f90 @@ -0,0 +1,63 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_base_ainv_solver_cnv(sv,info,amold,vmold,imold) + use psb_base_mod + use amg_d_base_ainv_mod, amg_protect_name => amg_d_base_ainv_solver_cnv + Implicit None + ! Arguments + class(amg_d_base_ainv_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 + integer(psb_ipk_) :: i, j, il1, iln, lname, lev + integer(psb_ipk_) :: iam, np + type(psb_ctxt_type) :: ctxt + character(len=80) :: prefix_ + character(len=120) :: fname ! len should be at least 20 more than + logical :: solver_ + ! len of prefix_ + + info = 0 + + if (present(amold)) then + call sv%w%cscnv(info,mold=amold) + call sv%z%cscnv(info,mold=amold) + end if + call sv%dv%cnv(mold=vmold) + +end subroutine amg_d_base_ainv_solver_cnv diff --git a/amgprec/impl/solver/amg_d_base_ainv_solver_dmp.f90 b/amgprec/impl/solver/amg_d_base_ainv_solver_dmp.f90 new file mode 100644 index 00000000..50613060 --- /dev/null +++ b/amgprec/impl/solver/amg_d_base_ainv_solver_dmp.f90 @@ -0,0 +1,93 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_base_ainv_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) + + use psb_base_mod + use amg_d_base_ainv_mod, amg_protect_name => amg_d_base_ainv_solver_dmp + implicit none + class(amg_d_base_ainv_solver_type), intent(in) :: sv + type(psb_desc_type), intent(in) :: desc + integer(psb_ipk_), intent(in) :: level + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix, head + logical, optional, intent(in) :: solver, global_num + ! + integer(psb_ipk_) :: i, j, il1, iln, lname, lev + integer(psb_ipk_) :: iam, np + type(psb_ctxt_type) :: ctxt + character(len=80) :: prefix_ + character(len=120) :: fname ! len should be at least 20 more than + logical :: solver_, global_num_ + ! len of prefix_ + + info = 0 + + if (present(prefix)) then + prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) + else + prefix_ = "dump_ainv_d" + end if + + ctxt = desc%get_context() + call psb_info(ctxt,iam,np) + + if (present(solver)) then + solver_ = solver + else + solver_ = .false. + end if + if (present(global_num)) then + global_num_ = global_num + else + global_num_ = .false. + end if + lname = len_trim(prefix_) + fname = trim(prefix_) + write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam + lname = lname + 5 + + if (solver_) then + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_wmat.mtx' + if (sv%w%is_asb()) & + & call sv%w%print(fname,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx' + if (allocated(sv%d)) & + & call psb_geprt(fname,sv%d,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_zmat.mtx' + if (sv%z%is_asb()) & + & call sv%z%print(fname,head=head) + end if + +end subroutine amg_d_base_ainv_solver_dmp diff --git a/amgprec/impl/solver/amg_d_base_ainv_solver_free.f90 b/amgprec/impl/solver/amg_d_base_ainv_solver_free.f90 new file mode 100644 index 00000000..6b8920db --- /dev/null +++ b/amgprec/impl/solver/amg_d_base_ainv_solver_free.f90 @@ -0,0 +1,70 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_base_ainv_solver_free(sv,info) + + use psb_base_mod + use amg_d_base_ainv_mod, amg_protect_name => amg_d_base_ainv_solver_free + + Implicit None + + ! Arguments + class(amg_d_base_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_d_base_ainv_solver_free' + + call psb_erractionsave(err_act) + info = psb_success_ + call sv%clear_data(info) + + if (allocated(sv%d)) then + deallocate(sv%d,stat=info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + end if + call sv%w%free() + call sv%z%free() + call sv%dv%free(info) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_base_ainv_solver_free diff --git a/amgprec/impl/solver/amg_d_base_ainv_update_a.f90 b/amgprec/impl/solver/amg_d_base_ainv_update_a.f90 new file mode 100644 index 00000000..404e3476 --- /dev/null +++ b/amgprec/impl/solver/amg_d_base_ainv_update_a.f90 @@ -0,0 +1,81 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_base_ainv_update_a(sv,x,desc_data,info) + use amg_d_base_ainv_mod, amg_protect_name => amg_d_base_ainv_update_a + use psb_base_mod + + implicit none + + type(psb_desc_type), intent(in) :: desc_data + class(amg_d_base_ainv_solver_type), intent(inout) :: sv + real(psb_dpk_),intent(in) :: x(:) + integer(psb_ipk_), intent(out) :: info + + ! Local variables + real(psb_dpk_), allocatable :: dd(:), ee(:) + integer(psb_ipk_) :: nrows, ncols, i, j, k, nzr, nzc, ir, ic + + type(psb_d_csc_sparse_mat) :: ac + type(psb_d_csr_sparse_mat) :: ar + + dd = sv%dv%get_vect() + if (size(x) amg_d_invk_solver_bld + + Implicit None + + ! Arguments + type(psb_dspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_d_invk_solver_type), intent(inout) :: sv + 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(:) + integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + type(psb_ctxt_type) :: ctxt + character(len=20) :: name='d_invk_solver_bld', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + + call psb_invk_fact(a,sv%fill_in,sv%inv_fill,& + & sv%w,sv%d,sv%z,desc_a,info,b) + + + if ((info == psb_success_) .and.present(amold)) then + call sv%w%cscnv(info,mold=amold) + if (info == psb_success_) & + & call sv%z%cscnv(info,mold=amold) + end if + + if (info == psb_success_) then + call sv%dv%bld(sv%d,mold=vmold) + end if + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_invk_solver_bld diff --git a/amgprec/impl/solver/amg_d_invk_solver_check.f90 b/amgprec/impl/solver/amg_d_invk_solver_check.f90 new file mode 100644 index 00000000..0f1d44a0 --- /dev/null +++ b/amgprec/impl/solver/amg_d_invk_solver_check.f90 @@ -0,0 +1,64 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_invk_solver_check(sv,info) + + + use psb_base_mod + use amg_d_invk_solver, amg_protect_name => amg_d_invk_solver_check + + Implicit None + + ! Arguments + class(amg_d_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + Integer(Psb_Ipk_) :: err_act + character(len=20) :: name='d_invk_solver_check' + + call psb_erractionsave(err_act) + info = psb_success_ + + call amg_check_def(sv%fill_in,& + & 'Level',izero,is_int_non_negative) + call amg_check_def(sv%inv_fill,& + & 'Level',izero,is_int_non_negative) + + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_invk_solver_check diff --git a/amgprec/impl/solver/amg_d_invk_solver_clone.f90 b/amgprec/impl/solver/amg_d_invk_solver_clone.f90 new file mode 100644 index 00000000..df0c7e79 --- /dev/null +++ b/amgprec/impl/solver/amg_d_invk_solver_clone.f90 @@ -0,0 +1,90 @@ +! +! +! AMG4PSBLAS version 1.0 +! MultiLevel Domain Decomposition Parallel Preconditioners Package +! based on PSBLAS (Parallel Sparse BLAS version 3.0) +! +! (C) Copyright 2008,2009,2010,2010,2012 +! +! Salvatore Filippone University of Rome Tor Vergata +! Alfredo Buttari CNRS-IRIT, Toulouse +! Pasqua D'Ambra ICAR-CNR, Naples +! Daniela di Serafino Second University of Naples +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_invk_solver_clone(sv,svout,info) + + use psb_base_mod + use amg_d_invk_solver, amg_protect_name => amg_d_invk_solver_clone + + Implicit None + + ! Arguments + class(amg_d_invk_solver_type), intent(inout) :: sv + class(amg_d_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + ! Local variables + integer(psb_ipk_) :: err_act + + + info=psb_success_ + call psb_erractionsave(err_act) + + if (allocated(svout)) then + call svout%free(info) + if (info == psb_success_) deallocate(svout, stat=info) + end if + if (info == psb_success_) & + & allocate(amg_d_invk_solver_type :: svout, stat=info) + if (info /= 0) then + info = psb_err_alloc_dealloc_ + goto 9999 + end if + select type(svo => svout) + type is (amg_d_invk_solver_type) + svo%fill_in = sv%fill_in + svo%inv_fill = sv%inv_fill + call psb_safe_ab_cpy(sv%d,svo%d,info) + if (info == psb_success_) & + & call sv%dv%clone(svo%dv,info) + if (info == psb_success_) & + & call sv%w%clone(svo%w,info) + if (info == psb_success_) & + & call sv%z%clone(svo%z,info) + + class default + info = psb_err_internal_error_ + end select + + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_invk_solver_clone diff --git a/amgprec/impl/solver/amg_d_invk_solver_cseti.f90 b/amgprec/impl/solver/amg_d_invk_solver_cseti.f90 new file mode 100644 index 00000000..587b1727 --- /dev/null +++ b/amgprec/impl/solver/amg_d_invk_solver_cseti.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_invk_solver_cseti(sv,what,val,info,idx) + + use psb_base_mod + use amg_d_invk_solver, amg_protect_name => amg_d_invk_solver_cseti + + Implicit None + + ! Arguments + class(amg_d_invk_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_invk_solver_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(psb_toupper(what)) + case('SUB_FILLIN') + sv%fill_in = val + case('INV_FILLIN') + sv%inv_fill = val + case default + call sv%amg_d_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_invk_solver_cseti diff --git a/amgprec/impl/solver/amg_d_invk_solver_descr.f90 b/amgprec/impl/solver/amg_d_invk_solver_descr.f90 new file mode 100644 index 00000000..db0b70db --- /dev/null +++ b/amgprec/impl/solver/amg_d_invk_solver_descr.f90 @@ -0,0 +1,73 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_invk_solver_descr(sv,info,iout,coarse) + + + use psb_base_mod + use amg_d_invk_solver, amg_protect_name => amg_d_invk_solver_descr + + Implicit None + + ! Arguments + class(amg_d_invk_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + ! Local variables + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: me, np + type(psb_ctxt_type) :: ctxt + character(len=20), parameter :: name='amg_d_invk_solver_descr' + integer(psb_ipk_) :: iout_ + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(iout)) then + iout_ = iout + else + iout_ = 6 + endif + + write(iout_,*) ' INVK Approximate Inverse with ILU(N) ' + write(iout_,*) ' Fill level :',sv%fill_in + write(iout_,*) ' Inverse fill level :',sv%inv_fill + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_invk_solver_descr diff --git a/amgprec/impl/solver/amg_d_invk_solver_seti.f90 b/amgprec/impl/solver/amg_d_invk_solver_seti.f90 new file mode 100644 index 00000000..61ba5c51 --- /dev/null +++ b/amgprec/impl/solver/amg_d_invk_solver_seti.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_invk_solver_seti(sv,what,val,info) + + + use psb_base_mod + use amg_d_invk_solver, amg_protect_name => amg_d_invk_solver_seti + + Implicit None + + ! Arguments + class(amg_d_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_invk_solver_seti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) + case(amg_sub_fillin_) + sv%fill_in = val + case(amg_inv_fillin_) + sv%inv_fill = val + case default + ! call sv%amg_d_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_invk_solver_seti diff --git a/amgprec/impl/solver/amg_d_invt_solver_bld.f90 b/amgprec/impl/solver/amg_d_invt_solver_bld.f90 new file mode 100644 index 00000000..e4379895 --- /dev/null +++ b/amgprec/impl/solver/amg_d_invt_solver_bld.f90 @@ -0,0 +1,97 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) + + use psb_base_mod + use psb_d_invt_fact_mod ! This module contains the construction routines + use amg_d_invt_solver, amg_protect_name => amg_d_invt_solver_bld + + Implicit None + + ! Arguments + type(psb_dspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_d_invt_solver_type), intent(inout) :: sv + 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(:) + integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + type(psb_ctxt_type) :: ctxt + character(len=20) :: name='amg_d_invt_solver_bld', ch_err + + info = psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + + call psb_invt_fact(a,sv%fill_in,sv%inv_fill,& + & sv%thresh,sv%inv_thresh,& + & sv%w,sv%d,sv%z,desc_a,info,b) + + if ((info == psb_success_) .and.present(amold)) then + call sv%w%cscnv(info,mold=amold) + if (info == psb_success_) & + & call sv%z%cscnv(info,mold=amold) + end if + + if (info == psb_success_) then + call sv%dv%bld(sv%d,mold=vmold) + end if + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name) + goto 9999 + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_invt_solver_bld diff --git a/amgprec/impl/solver/amg_d_invt_solver_check.f90 b/amgprec/impl/solver/amg_d_invt_solver_check.f90 new file mode 100644 index 00000000..d4b9e161 --- /dev/null +++ b/amgprec/impl/solver/amg_d_invt_solver_check.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_invt_solver_check(sv,info) + + + use psb_base_mod + use amg_d_invt_solver, amg_protect_name => amg_d_invt_solver_check + + Implicit None + + ! Arguments + class(amg_d_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + ! + Integer(Psb_Ipk_) :: err_act + character(len=20) :: name='amg_d_invt_solver_check' + + call psb_erractionsave(err_act) + info = psb_success_ + + call amg_check_def(sv%fill_in,& + & 'Level',izero,is_int_non_negative) + call amg_check_def(sv%inv_fill,& + & 'Level',izero,is_int_non_negative) + call amg_check_def(sv%thresh,& + & 'Eps',dzero,is_legal_d_fact_thrs) + call amg_check_def(sv%inv_thresh,& + & 'Eps',dzero,is_legal_d_fact_thrs) + + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_invt_solver_check diff --git a/amgprec/impl/solver/amg_d_invt_solver_clone.f90 b/amgprec/impl/solver/amg_d_invt_solver_clone.f90 new file mode 100644 index 00000000..f5ba7f6b --- /dev/null +++ b/amgprec/impl/solver/amg_d_invt_solver_clone.f90 @@ -0,0 +1,92 @@ +! +! +! AMG4PSBLAS version 1.0 +! MultiLevel Domain Decomposition Parallel Preconditioners Package +! based on PSBLAS (Parallel Sparse BLAS version 3.0) +! +! (C) Copyright 2008,2009,2010,2010,2012 +! +! Salvatore Filippone University of Rome Tor Vergata +! Alfredo Buttari CNRS-IRIT, Toulouse +! Pasqua D'Ambra ICAR-CNR, Naples +! Daniela di Serafino Second University of Naples +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_invt_solver_clone(sv,svout,info) + + use psb_base_mod + use amg_d_invt_solver, amg_protect_name => amg_d_invt_solver_clone + + Implicit None + + ! Arguments + class(amg_d_invt_solver_type), intent(inout) :: sv + class(amg_d_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + ! Local variables + integer(psb_ipk_) :: err_act + + + info=psb_success_ + call psb_erractionsave(err_act) + + if (allocated(svout)) then + call svout%free(info) + if (info == psb_success_) deallocate(svout, stat=info) + end if + if (info == psb_success_) & + & allocate(amg_d_invt_solver_type :: svout, stat=info) + if (info /= 0) then + info = psb_err_alloc_dealloc_ + goto 9999 + end if + select type(svo => svout) + type is (amg_d_invt_solver_type) + svo%fill_in = sv%fill_in + svo%inv_fill = sv%inv_fill + svo%thresh = sv%thresh + svo%inv_thresh = sv%inv_thresh + call psb_safe_ab_cpy(sv%d,svo%d,info) + if (info == psb_success_) & + & call sv%dv%clone(svo%dv,info) + if (info == psb_success_) & + & call sv%w%clone(svo%w,info) + if (info == psb_success_) & + & call sv%z%clone(svo%z,info) + + class default + info = psb_err_internal_error_ + end select + + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_invt_solver_clone diff --git a/amgprec/impl/solver/amg_d_invt_solver_cseti.f90 b/amgprec/impl/solver/amg_d_invt_solver_cseti.f90 new file mode 100644 index 00000000..76cbe3d4 --- /dev/null +++ b/amgprec/impl/solver/amg_d_invt_solver_cseti.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_invt_solver_cseti(sv,what,val,info,idx) + + use psb_base_mod + use amg_d_invt_solver, amg_protect_name => amg_d_invt_solver_cseti + + Implicit None + + ! Arguments + class(amg_d_invt_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_d_invt_solver_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(psb_toupper(what)) + case('SUB_FILLIN') + sv%fill_in = val + case('INV_FILLIN') + sv%inv_fill = val + case default + call sv%amg_d_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_invt_solver_cseti diff --git a/amgprec/impl/solver/amg_d_invt_solver_csetr.f90 b/amgprec/impl/solver/amg_d_invt_solver_csetr.f90 new file mode 100644 index 00000000..6ba9d572 --- /dev/null +++ b/amgprec/impl/solver/amg_d_invt_solver_csetr.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_invt_solver_csetr(sv,what,val,info,idx) + + use psb_base_mod + use amg_d_invt_solver, amg_protect_name => amg_d_invt_solver_csetr + + Implicit None + + ! Arguments + class(amg_d_invt_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_d_invt_solver_csetr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(psb_toupper(what)) + case('SUB_ILUTHRS') + sv%thresh = val + case('INV_THRESH') + sv%inv_thresh = val + case default + call sv%amg_d_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_invt_solver_csetr diff --git a/amgprec/impl/solver/amg_d_invt_solver_descr.f90 b/amgprec/impl/solver/amg_d_invt_solver_descr.f90 new file mode 100644 index 00000000..abb4e9f0 --- /dev/null +++ b/amgprec/impl/solver/amg_d_invt_solver_descr.f90 @@ -0,0 +1,74 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_invt_solver_descr(sv,info,iout,coarse) + + + use psb_base_mod + use amg_d_invt_solver, amg_protect_name => amg_d_invt_solver_descr + + Implicit None + + ! Arguments + class(amg_d_invt_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + ! Local variables + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ictxt, me, np + character(len=20), parameter :: name='amg_d_invt_solver_descr' + integer(psb_ipk_) :: iout_ + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(iout)) then + iout_ = iout + else + iout_ = 6 + endif + + write(iout_,*) ' INVT Approximate Inverse with ILU(T,P) ' + write(iout_,*) ' Fill level :',sv%fill_in + write(iout_,*) ' Fill threshold :',sv%thresh + write(iout_,*) ' Inverse fill level :',sv%inv_fill + write(iout_,*) ' Inverse fill threshold :',sv%inv_thresh + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_invt_solver_descr diff --git a/amgprec/impl/solver/amg_d_invt_solver_seti.f90 b/amgprec/impl/solver/amg_d_invt_solver_seti.f90 new file mode 100644 index 00000000..6690f4a8 --- /dev/null +++ b/amgprec/impl/solver/amg_d_invt_solver_seti.f90 @@ -0,0 +1,70 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_invt_solver_seti(sv,what,val,info) + + + use psb_base_mod + use amg_d_invt_solver, amg_protect_name => amg_d_invt_solver_seti + + Implicit None + + ! Arguments + class(amg_d_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + Integer(Psb_Ipk_) :: err_act + character(len=20) :: name='amg_d_invt_solver_seti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) + case(amg_sub_fillin_) + sv%fill_in = val + case(amg_inv_fillin_) + sv%inv_fill = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_invt_solver_seti diff --git a/amgprec/impl/solver/amg_d_invt_solver_setr.f90 b/amgprec/impl/solver/amg_d_invt_solver_setr.f90 new file mode 100644 index 00000000..059c76f2 --- /dev/null +++ b/amgprec/impl/solver/amg_d_invt_solver_setr.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_d_invt_solver_setr(sv,what,val,info) + + + use psb_base_mod + use amg_d_invt_solver, amg_protect_name => amg_d_invt_solver_setr + + Implicit None + + ! Arguments + class(amg_d_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + Integer(Psb_Ipk_) :: err_act + character(len=20) :: name='amg_d_invt_solver_setr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(what) + case(amg_sub_iluthrs_) + sv%thresh = val + case(amg_inv_thresh_) + sv%inv_thresh = val + case default + ! call sv%amg_d_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_d_invt_solver_setr diff --git a/amgprec/impl/solver/amg_s_ainv_solver_bld.f90 b/amgprec/impl/solver/amg_s_ainv_solver_bld.f90 new file mode 100644 index 00000000..b1d94bd1 --- /dev/null +++ b/amgprec/impl/solver/amg_s_ainv_solver_bld.f90 @@ -0,0 +1,98 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) + + + use psb_base_mod + use psb_s_ainv_fact_mod + use amg_s_ainv_solver, amg_protect_name => amg_s_ainv_solver_bld + + Implicit None + + ! Arguments + type(psb_sspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_s_ainv_solver_type), intent(inout) :: sv + 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(:) + integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + type(psb_ctxt_type) :: ctxt + character(len=20) :: name='amg_s_ainv_solver_bld', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + call psb_s_ainv_bld(a,sv%alg,sv%fill_in,sv%thresh,& + & sv%w,sv%d,sv%z,desc_a,info,b,iscale=amg_ilu_scale_maxval_) + + if ((info == psb_success_) .and.present(amold)) then + call sv%w%set_asb() + call sv%w%trim() + call sv%z%set_asb() + call sv%z%trim() + call sv%w%cscnv(info,mold=amold) + if (info == psb_success_) & + & call sv%z%cscnv(info,mold=amold) + end if + + if (info == psb_success_) & + & call sv%dv%bld(sv%d,mold=vmold) + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name) + goto 9999 + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_ainv_solver_bld diff --git a/amgprec/impl/solver/amg_s_ainv_solver_check.f90 b/amgprec/impl/solver/amg_s_ainv_solver_check.f90 new file mode 100644 index 00000000..6e834c1a --- /dev/null +++ b/amgprec/impl/solver/amg_s_ainv_solver_check.f90 @@ -0,0 +1,65 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_ainv_solver_check(sv,info) + + + use psb_base_mod + use amg_s_ainv_solver, amg_protect_name => amg_s_ainv_solver_check + + Implicit None + + ! Arguments + class(amg_s_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_s_ainv_solver_check' + + call psb_erractionsave(err_act) + info = psb_success_ + + call amg_check_def(sv%fill_in,& + & 'Nzmin',ione,is_positive_nz_min) + call amg_check_def(sv%thresh,& + & 'Eps',szero,is_legal_s_fact_thrs) + + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_ainv_solver_check diff --git a/amgprec/impl/solver/amg_s_ainv_solver_clone.f90 b/amgprec/impl/solver/amg_s_ainv_solver_clone.f90 new file mode 100644 index 00000000..907ad8a6 --- /dev/null +++ b/amgprec/impl/solver/amg_s_ainv_solver_clone.f90 @@ -0,0 +1,91 @@ +! +! +! AMG4PSBLAS version 1.0 +! MultiLevel Domain Decomposition Parallel Preconditioners Package +! based on PSBLAS (Parallel Sparse BLAS version 3.0) +! +! (C) Copyright 2008,2009,2010,2010,2012 +! +! Salvatore Filippone University of Rome Tor Vergata +! Alfredo Buttari CNRS-IRIT, Toulouse +! Pasqua D'Ambra ICAR-CNR, Naples +! Daniela di Serafino Second University of Naples +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_ainv_solver_clone(sv,svout,info) + + use psb_base_mod + use amg_s_ainv_solver, amg_protect_name => amg_s_ainv_solver_clone + + Implicit None + + ! Arguments + class(amg_s_ainv_solver_type), intent(inout) :: sv + class(amg_s_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + ! Local variables + integer(psb_ipk_) :: err_act + + + info=psb_success_ + call psb_erractionsave(err_act) + + if (allocated(svout)) then + call svout%free(info) + if (info == psb_success_) deallocate(svout, stat=info) + end if + if (info == psb_success_) & + & allocate(amg_s_ainv_solver_type :: svout, stat=info) + if (info /= 0) then + info = psb_err_alloc_dealloc_ + goto 9999 + end if + select type(svo => svout) + type is (amg_s_ainv_solver_type) + svo%alg = sv%alg + svo%fill_in = sv%fill_in + svo%thresh = sv%thresh + call psb_safe_ab_cpy(sv%d,svo%d,info) + if (info == psb_success_) & + & call sv%dv%clone(svo%dv,info) + if (info == psb_success_) & + & call sv%w%clone(svo%w,info) + if (info == psb_success_) & + & call sv%z%clone(svo%z,info) + + class default + info = psb_err_internal_error_ + end select + + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_ainv_solver_clone diff --git a/amgprec/impl/solver/amg_s_ainv_solver_csetc.f90 b/amgprec/impl/solver/amg_s_ainv_solver_csetc.f90 new file mode 100644 index 00000000..c5c01f75 --- /dev/null +++ b/amgprec/impl/solver/amg_s_ainv_solver_csetc.f90 @@ -0,0 +1,79 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_ainv_solver_csetc(sv,what,val,info,idx) + + + use psb_base_mod + use amg_s_ainv_solver, amg_protect_name => amg_s_ainv_solver_csetc + + Implicit None + + ! Arguments + class(amg_s_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_ ) :: err_act, ival + character(len=20) :: name='amg_s_ainv_solver_setc' + + info = psb_success_ + call psb_erractionsave(err_act) + +!!$ select case(psb_toupper(trim(what))) +!!$ case('AINV_ALG') +!!$ sv%alg = sv%stringval(val) +!!$ case default +!!$ call sv%mld_d_base_solver_type%set(what,val,info) +!!$ end select + ival = sv%stringval(val) + + if (ival >=0) then + call sv%set(what,ival,info) + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info, name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_ainv_solver_csetc diff --git a/amgprec/impl/solver/amg_s_ainv_solver_cseti.f90 b/amgprec/impl/solver/amg_s_ainv_solver_cseti.f90 new file mode 100644 index 00000000..b1b08209 --- /dev/null +++ b/amgprec/impl/solver/amg_s_ainv_solver_cseti.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_ainv_solver_cseti(sv,what,val,info,idx) + + use psb_base_mod + use amg_s_ainv_solver, amg_protect_name => amg_s_ainv_solver_cseti + + Implicit None + + ! Arguments + class(amg_s_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_s_ainv_solver_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(psb_toupper(trim(what))) + case('SUB_FILLIN') + sv%fill_in = val + case('AINV_ALG') + sv%alg = val + case default + call sv%amg_s_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_ainv_solver_cseti diff --git a/amgprec/impl/solver/amg_s_ainv_solver_csetr.f90 b/amgprec/impl/solver/amg_s_ainv_solver_csetr.f90 new file mode 100644 index 00000000..50528d52 --- /dev/null +++ b/amgprec/impl/solver/amg_s_ainv_solver_csetr.f90 @@ -0,0 +1,67 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_ainv_solver_csetr(sv,what,val,info,idx) + + use psb_base_mod + use amg_s_ainv_solver, amg_protect_name => amg_s_ainv_solver_csetr + + Implicit None + + ! Arguments + class(amg_s_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_s_ainv_solver_csetr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(psb_toupper(what)) + case('SUB_ILUTHRS') + sv%thresh = val + case default + call sv%amg_s_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_ainv_solver_csetr diff --git a/amgprec/impl/solver/amg_s_ainv_solver_descr.f90 b/amgprec/impl/solver/amg_s_ainv_solver_descr.f90 new file mode 100644 index 00000000..4074723b --- /dev/null +++ b/amgprec/impl/solver/amg_s_ainv_solver_descr.f90 @@ -0,0 +1,73 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_ainv_solver_descr(sv,info,iout,coarse) + + + use psb_base_mod + use amg_s_ainv_solver, amg_protect_name => amg_s_ainv_solver_descr + + Implicit None + + ! Arguments + class(amg_s_ainv_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + ! Local variables + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ictxt, me, np + character(len=20), parameter :: name='amg_s_ainv_solver_descr' + integer(psb_ipk_) :: iout_ + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(iout)) then + iout_ = iout + else + iout_ = 6 + endif + + write(iout_,*) ' AINV: Approximate Inverse with sparse biconjugation ' + write(iout_,*) ' Algorithm variant : ',sv%algname(sv%alg) + write(iout_,*) ' Fill level : ',sv%fill_in + write(iout_,*) ' Fill threshold : ',sv%thresh + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_ainv_solver_descr diff --git a/amgprec/impl/solver/amg_s_ainv_solver_setc.f90 b/amgprec/impl/solver/amg_s_ainv_solver_setc.f90 new file mode 100644 index 00000000..c86fc580 --- /dev/null +++ b/amgprec/impl/solver/amg_s_ainv_solver_setc.f90 @@ -0,0 +1,71 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_ainv_solver_setc(sv,what,val,info) + + + use psb_base_mod + use amg_s_ainv_solver, amg_protect_name => amg_s_ainv_solver_setc + + Implicit None + + ! Arguments + class(amg_s_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act, ival + character(len=20) :: name='amg_s_ainv_solver_setc' + + info = psb_success_ + call psb_erractionsave(err_act) + + ival = sv%stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info, name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_ainv_solver_setc diff --git a/amgprec/impl/solver/amg_s_ainv_solver_seti.f90 b/amgprec/impl/solver/amg_s_ainv_solver_seti.f90 new file mode 100644 index 00000000..8aa73595 --- /dev/null +++ b/amgprec/impl/solver/amg_s_ainv_solver_seti.f90 @@ -0,0 +1,70 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_ainv_solver_seti(sv,what,val,info) + + + use psb_base_mod + use amg_s_ainv_solver, amg_protect_name => amg_s_ainv_solver_seti + + Implicit None + + ! Arguments + class(amg_s_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_s_ainv_solver_seti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) + case(amg_sub_fillin_) + sv%fill_in = val + case(amg_ainv_alg_) + sv%alg = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_ainv_solver_seti diff --git a/amgprec/impl/solver/amg_s_ainv_solver_setr.f90 b/amgprec/impl/solver/amg_s_ainv_solver_setr.f90 new file mode 100644 index 00000000..abe7dead --- /dev/null +++ b/amgprec/impl/solver/amg_s_ainv_solver_setr.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_ainv_solver_setr(sv,what,val,info) + + + use psb_base_mod + use amg_s_ainv_solver, amg_protect_name => amg_s_ainv_solver_setr + + Implicit None + + ! Arguments + class(amg_s_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_s_ainv_solver_setr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(what) + case(amg_sub_iluthrs_) + sv%thresh = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 +!!$ goto 9999 + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_ainv_solver_setr diff --git a/amgprec/impl/solver/amg_s_base_ainv_solver_apply.f90 b/amgprec/impl/solver/amg_s_base_ainv_solver_apply.f90 new file mode 100644 index 00000000..5e0b6155 --- /dev/null +++ b/amgprec/impl/solver/amg_s_base_ainv_solver_apply.f90 @@ -0,0 +1,153 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_base_ainv_solver_apply(alpha,sv,x,beta,y,desc_data,& + & trans,work,info,init,initu) + + use psb_base_mod + use amg_s_base_ainv_mod, amg_protect_name => amg_s_base_ainv_solver_apply + implicit none + type(psb_desc_type), intent(in) :: desc_data + class(amg_s_base_ainv_solver_type), intent(inout) :: sv + real(psb_spk_),intent(inout) :: x(:) + real(psb_spk_),intent(inout) :: y(:) + real(psb_spk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + real(psb_spk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: init + real(psb_spk_),intent(inout), optional :: initu(:) + ! + integer(psb_ipk_) :: n_row,n_col + real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) + integer(psb_ipk_) :: np,me,i, err_act + type(psb_ctxt_type) :: ctxt + character :: trans_ + character(len=20) :: name='d_base_ainv_solver_apply' + + call psb_erractionsave(err_act) + + info = psb_success_ + + trans_ = psb_toupper(trans) + select case(trans_) + case('N') + case('T','C') + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select + ! + ! For non-iterative solvers, init and initu are ignored. + ! + + n_row = psb_cd_get_local_rows(desc_data) + n_col = psb_cd_get_local_cols(desc_data) + + if (n_col <= size(work)) then + ww => work(1:n_col) + if ((4*n_col+n_col) <= size(work)) then + aux => work(n_col+1:) + else + allocate(aux(4*n_col),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/4*n_col/),& + & a_err='real(psb_dpk_)') + goto 9999 + end if + endif + else + allocate(ww(n_col),aux(4*n_col),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/5*n_col/),& + & a_err='real(psb_dpk_)') + goto 9999 + end if + endif + + select case(trans_) + case('N') + call psb_spmm(sone,sv%w,x,szero,ww,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + ww(1:n_row) = ww(1:n_row) * sv%d(1:n_row) + if (info == psb_success_) & + & call psb_spmm(alpha,sv%z,ww,beta,y,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + + case('T','C') + call psb_spmm(sone,sv%z,x,szero,ww,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + ww(1:n_row) = ww(1:n_row) * sv%d(1:n_row) + if (info == psb_success_) & + & call psb_spmm(alpha,sv%w,ww,beta,y,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + + case default + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Invalid TRANS in ainv subsolve') + goto 9999 + end select + + + if (info /= psb_success_) then + + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in subsolve') + goto 9999 + endif + + if (n_col <= size(work)) then + if ((4*n_col+n_col) <= size(work)) then + else + deallocate(aux,stat=info) + endif + else + deallocate(ww,aux,stat=info) + endif + + if (info /= psb_success_) then + + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Deallocate') + goto 9999 + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_base_ainv_solver_apply diff --git a/amgprec/impl/solver/amg_s_base_ainv_solver_apply_vect.f90 b/amgprec/impl/solver/amg_s_base_ainv_solver_apply_vect.f90 new file mode 100644 index 00000000..f7230e6e --- /dev/null +++ b/amgprec/impl/solver/amg_s_base_ainv_solver_apply_vect.f90 @@ -0,0 +1,167 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_base_ainv_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& + & trans,work,wv,info,init,initu) + + use psb_base_mod + use amg_s_base_ainv_mod, amg_protect_name => amg_s_base_ainv_solver_apply_vect + implicit none + type(psb_desc_type), intent(in) :: desc_data + class(amg_s_base_ainv_solver_type), intent(inout) :: sv + type(psb_s_vect_type), intent(inout) :: x + type(psb_s_vect_type), intent(inout) :: y + real(psb_spk_), intent(in) :: alpha,beta + character(len=1), intent(in) :: trans + real(psb_spk_),target, intent(inout) :: work(:) + type(psb_s_vect_type),intent(inout) :: wv(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: init + type(psb_s_vect_type),intent(inout), optional :: initu + ! + integer(psb_ipk_) :: n_row,n_col + real(psb_spk_), pointer :: ww(:), aux(:) + type(psb_s_vect_type) :: tx,ty + integer(psb_ipk_) :: np,me,i, err_act + type(psb_ctxt_type) :: ctxt + character :: trans_ + character(len=20) :: name='d_base_ainv_solver_apply' + + call psb_erractionsave(err_act) + + info = psb_success_ + + trans_ = psb_toupper(trans) + select case(trans_) + case('N') + case('T','C') + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select + ! + ! For non-iterative solvers, init and initu are ignored. + ! + + n_row = psb_cd_get_local_rows(desc_data) + n_col = psb_cd_get_local_cols(desc_data) + + if (n_col <= size(work)) then + ww => work(1:n_col) + if ((4*n_col+n_col) <= size(work)) then + aux => work(n_col+1:) + else + allocate(aux(4*n_col),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/4*n_col/),& + & a_err='real(psb_dpk_)') + goto 9999 + end if + endif + else + allocate(ww(n_col),aux(4*n_col),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/5*n_col/),& + & a_err='real(psb_dpk_)') + goto 9999 + end if + endif + + if (size(wv) < 2) then + info = psb_err_internal_error_ + call psb_errpush(info,name,& + & a_err='invalid wv size') + goto 9999 + end if + + + associate(tx => wv(1), ty => wv(2)) + + select case(trans_) + case('N') + call psb_spmm(sone,sv%w,x,szero,tx,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + if (info == psb_success_) call ty%mlt(sone,sv%dv,tx,szero,info) + if (info == psb_success_) & + & call psb_spmm(alpha,sv%z,ty,beta,y,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + + case('T','C') + call psb_spmm(sone,sv%z,x,szero,tx,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + if (info == psb_success_) call ty%mlt(sone,sv%dv,tx,szero,info) + if (info == psb_success_) & + & call psb_spmm(alpha,sv%w,ty,beta,y,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + + case default + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Invalid TRANS in ainv subsolve') + goto 9999 + end select + + + if (info /= psb_success_) then + + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in subsolve') + goto 9999 + endif + + end associate + + if (n_col <= size(work)) then + if ((4*n_col+n_col) <= size(work)) then + else + deallocate(aux,stat=info) + endif + else + deallocate(ww,aux,stat=info) + endif + + if (info /= psb_success_) then + + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Deallocate') + goto 9999 + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_base_ainv_solver_apply_vect diff --git a/amgprec/impl/solver/amg_s_base_ainv_solver_cnv.f90 b/amgprec/impl/solver/amg_s_base_ainv_solver_cnv.f90 new file mode 100644 index 00000000..468c38db --- /dev/null +++ b/amgprec/impl/solver/amg_s_base_ainv_solver_cnv.f90 @@ -0,0 +1,63 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_base_ainv_solver_cnv(sv,info,amold,vmold,imold) + use psb_base_mod + use amg_s_base_ainv_mod, amg_protect_name => amg_s_base_ainv_solver_cnv + Implicit None + ! Arguments + class(amg_s_base_ainv_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 + integer(psb_ipk_) :: i, j, il1, iln, lname, lev + integer(psb_ipk_) :: iam, np + type(psb_ctxt_type) :: ctxt + character(len=80) :: prefix_ + character(len=120) :: fname ! len should be at least 20 more than + logical :: solver_ + ! len of prefix_ + + info = 0 + + if (present(amold)) then + call sv%w%cscnv(info,mold=amold) + call sv%z%cscnv(info,mold=amold) + end if + call sv%dv%cnv(mold=vmold) + +end subroutine amg_s_base_ainv_solver_cnv diff --git a/amgprec/impl/solver/amg_s_base_ainv_solver_dmp.f90 b/amgprec/impl/solver/amg_s_base_ainv_solver_dmp.f90 new file mode 100644 index 00000000..ad31520c --- /dev/null +++ b/amgprec/impl/solver/amg_s_base_ainv_solver_dmp.f90 @@ -0,0 +1,93 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_base_ainv_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) + + use psb_base_mod + use amg_s_base_ainv_mod, amg_protect_name => amg_s_base_ainv_solver_dmp + implicit none + class(amg_s_base_ainv_solver_type), intent(in) :: sv + type(psb_desc_type), intent(in) :: desc + integer(psb_ipk_), intent(in) :: level + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix, head + logical, optional, intent(in) :: solver, global_num + ! + integer(psb_ipk_) :: i, j, il1, iln, lname, lev + integer(psb_ipk_) :: iam, np + type(psb_ctxt_type) :: ctxt + character(len=80) :: prefix_ + character(len=120) :: fname ! len should be at least 20 more than + logical :: solver_, global_num_ + ! len of prefix_ + + info = 0 + + if (present(prefix)) then + prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) + else + prefix_ = "dump_ainv_d" + end if + + ctxt = desc%get_context() + call psb_info(ctxt,iam,np) + + if (present(solver)) then + solver_ = solver + else + solver_ = .false. + end if + if (present(global_num)) then + global_num_ = global_num + else + global_num_ = .false. + end if + lname = len_trim(prefix_) + fname = trim(prefix_) + write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam + lname = lname + 5 + + if (solver_) then + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_wmat.mtx' + if (sv%w%is_asb()) & + & call sv%w%print(fname,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx' + if (allocated(sv%d)) & + & call psb_geprt(fname,sv%d,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_zmat.mtx' + if (sv%z%is_asb()) & + & call sv%z%print(fname,head=head) + end if + +end subroutine amg_s_base_ainv_solver_dmp diff --git a/amgprec/impl/solver/amg_s_base_ainv_solver_free.f90 b/amgprec/impl/solver/amg_s_base_ainv_solver_free.f90 new file mode 100644 index 00000000..4783e32a --- /dev/null +++ b/amgprec/impl/solver/amg_s_base_ainv_solver_free.f90 @@ -0,0 +1,70 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_base_ainv_solver_free(sv,info) + + use psb_base_mod + use amg_s_base_ainv_mod, amg_protect_name => amg_s_base_ainv_solver_free + + Implicit None + + ! Arguments + class(amg_s_base_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_s_base_ainv_solver_free' + + call psb_erractionsave(err_act) + info = psb_success_ + call sv%clear_data(info) + + if (allocated(sv%d)) then + deallocate(sv%d,stat=info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + end if + call sv%w%free() + call sv%z%free() + call sv%dv%free(info) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_base_ainv_solver_free diff --git a/amgprec/impl/solver/amg_s_base_ainv_update_a.f90 b/amgprec/impl/solver/amg_s_base_ainv_update_a.f90 new file mode 100644 index 00000000..cfdb2771 --- /dev/null +++ b/amgprec/impl/solver/amg_s_base_ainv_update_a.f90 @@ -0,0 +1,81 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_base_ainv_update_a(sv,x,desc_data,info) + use amg_s_base_ainv_mod, amg_protect_name => amg_s_base_ainv_update_a + use psb_base_mod + + implicit none + + type(psb_desc_type), intent(in) :: desc_data + class(amg_s_base_ainv_solver_type), intent(inout) :: sv + real(psb_spk_),intent(in) :: x(:) + integer(psb_ipk_), intent(out) :: info + + ! Local variables + real(psb_spk_), allocatable :: dd(:), ee(:) + integer(psb_ipk_) :: nrows, ncols, i, j, k, nzr, nzc, ir, ic + + type(psb_s_csc_sparse_mat) :: ac + type(psb_s_csr_sparse_mat) :: ar + + dd = sv%dv%get_vect() + if (size(x) amg_s_invk_solver_bld + + Implicit None + + ! Arguments + type(psb_sspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_s_invk_solver_type), intent(inout) :: sv + 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(:) + integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + type(psb_ctxt_type) :: ctxt + character(len=20) :: name='s_invk_solver_bld', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + + call psb_invk_fact(a,sv%fill_in,sv%inv_fill,& + & sv%w,sv%d,sv%z,desc_a,info,b) + + + if ((info == psb_success_) .and.present(amold)) then + call sv%w%cscnv(info,mold=amold) + if (info == psb_success_) & + & call sv%z%cscnv(info,mold=amold) + end if + + if (info == psb_success_) then + call sv%dv%bld(sv%d,mold=vmold) + end if + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_invk_solver_bld diff --git a/amgprec/impl/solver/amg_s_invk_solver_check.f90 b/amgprec/impl/solver/amg_s_invk_solver_check.f90 new file mode 100644 index 00000000..e301a02e --- /dev/null +++ b/amgprec/impl/solver/amg_s_invk_solver_check.f90 @@ -0,0 +1,64 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_invk_solver_check(sv,info) + + + use psb_base_mod + use amg_s_invk_solver, amg_protect_name => amg_s_invk_solver_check + + Implicit None + + ! Arguments + class(amg_s_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + Integer(Psb_Ipk_) :: err_act + character(len=20) :: name='s_invk_solver_check' + + call psb_erractionsave(err_act) + info = psb_success_ + + call amg_check_def(sv%fill_in,& + & 'Level',izero,is_int_non_negative) + call amg_check_def(sv%inv_fill,& + & 'Level',izero,is_int_non_negative) + + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_invk_solver_check diff --git a/amgprec/impl/solver/amg_s_invk_solver_clone.f90 b/amgprec/impl/solver/amg_s_invk_solver_clone.f90 new file mode 100644 index 00000000..f3a62aa6 --- /dev/null +++ b/amgprec/impl/solver/amg_s_invk_solver_clone.f90 @@ -0,0 +1,90 @@ +! +! +! AMG4PSBLAS version 1.0 +! MultiLevel Domain Decomposition Parallel Preconditioners Package +! based on PSBLAS (Parallel Sparse BLAS version 3.0) +! +! (C) Copyright 2008,2009,2010,2010,2012 +! +! Salvatore Filippone University of Rome Tor Vergata +! Alfredo Buttari CNRS-IRIT, Toulouse +! Pasqua D'Ambra ICAR-CNR, Naples +! Daniela di Serafino Second University of Naples +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_invk_solver_clone(sv,svout,info) + + use psb_base_mod + use amg_s_invk_solver, amg_protect_name => amg_s_invk_solver_clone + + Implicit None + + ! Arguments + class(amg_s_invk_solver_type), intent(inout) :: sv + class(amg_s_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + ! Local variables + integer(psb_ipk_) :: err_act + + + info=psb_success_ + call psb_erractionsave(err_act) + + if (allocated(svout)) then + call svout%free(info) + if (info == psb_success_) deallocate(svout, stat=info) + end if + if (info == psb_success_) & + & allocate(amg_s_invk_solver_type :: svout, stat=info) + if (info /= 0) then + info = psb_err_alloc_dealloc_ + goto 9999 + end if + select type(svo => svout) + type is (amg_s_invk_solver_type) + svo%fill_in = sv%fill_in + svo%inv_fill = sv%inv_fill + call psb_safe_ab_cpy(sv%d,svo%d,info) + if (info == psb_success_) & + & call sv%dv%clone(svo%dv,info) + if (info == psb_success_) & + & call sv%w%clone(svo%w,info) + if (info == psb_success_) & + & call sv%z%clone(svo%z,info) + + class default + info = psb_err_internal_error_ + end select + + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_invk_solver_clone diff --git a/amgprec/impl/solver/amg_s_invk_solver_cseti.f90 b/amgprec/impl/solver/amg_s_invk_solver_cseti.f90 new file mode 100644 index 00000000..6f180353 --- /dev/null +++ b/amgprec/impl/solver/amg_s_invk_solver_cseti.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_invk_solver_cseti(sv,what,val,info,idx) + + use psb_base_mod + use amg_s_invk_solver, amg_protect_name => amg_s_invk_solver_cseti + + Implicit None + + ! Arguments + class(amg_s_invk_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_invk_solver_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(psb_toupper(what)) + case('SUB_FILLIN') + sv%fill_in = val + case('INV_FILLIN') + sv%inv_fill = val + case default + call sv%amg_s_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_invk_solver_cseti diff --git a/amgprec/impl/solver/amg_s_invk_solver_descr.f90 b/amgprec/impl/solver/amg_s_invk_solver_descr.f90 new file mode 100644 index 00000000..212ff6be --- /dev/null +++ b/amgprec/impl/solver/amg_s_invk_solver_descr.f90 @@ -0,0 +1,73 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_invk_solver_descr(sv,info,iout,coarse) + + + use psb_base_mod + use amg_s_invk_solver, amg_protect_name => amg_s_invk_solver_descr + + Implicit None + + ! Arguments + class(amg_s_invk_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + ! Local variables + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: me, np + type(psb_ctxt_type) :: ctxt + character(len=20), parameter :: name='amg_s_invk_solver_descr' + integer(psb_ipk_) :: iout_ + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(iout)) then + iout_ = iout + else + iout_ = 6 + endif + + write(iout_,*) ' INVK Approximate Inverse with ILU(N) ' + write(iout_,*) ' Fill level :',sv%fill_in + write(iout_,*) ' Inverse fill level :',sv%inv_fill + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_invk_solver_descr diff --git a/amgprec/impl/solver/amg_s_invk_solver_seti.f90 b/amgprec/impl/solver/amg_s_invk_solver_seti.f90 new file mode 100644 index 00000000..f6f1efee --- /dev/null +++ b/amgprec/impl/solver/amg_s_invk_solver_seti.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_invk_solver_seti(sv,what,val,info) + + + use psb_base_mod + use amg_s_invk_solver, amg_protect_name => amg_s_invk_solver_seti + + Implicit None + + ! Arguments + class(amg_s_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_invk_solver_seti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) + case(amg_sub_fillin_) + sv%fill_in = val + case(amg_inv_fillin_) + sv%inv_fill = val + case default + ! call sv%amg_s_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_invk_solver_seti diff --git a/amgprec/impl/solver/amg_s_invt_solver_bld.f90 b/amgprec/impl/solver/amg_s_invt_solver_bld.f90 new file mode 100644 index 00000000..1e608883 --- /dev/null +++ b/amgprec/impl/solver/amg_s_invt_solver_bld.f90 @@ -0,0 +1,97 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) + + use psb_base_mod + use psb_s_invt_fact_mod ! This module contains the construction routines + use amg_s_invt_solver, amg_protect_name => amg_s_invt_solver_bld + + Implicit None + + ! Arguments + type(psb_sspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_s_invt_solver_type), intent(inout) :: sv + 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(:) + integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + type(psb_ctxt_type) :: ctxt + character(len=20) :: name='amg_s_invt_solver_bld', ch_err + + info = psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + + call psb_invt_fact(a,sv%fill_in,sv%inv_fill,& + & sv%thresh,sv%inv_thresh,& + & sv%w,sv%d,sv%z,desc_a,info,b) + + if ((info == psb_success_) .and.present(amold)) then + call sv%w%cscnv(info,mold=amold) + if (info == psb_success_) & + & call sv%z%cscnv(info,mold=amold) + end if + + if (info == psb_success_) then + call sv%dv%bld(sv%d,mold=vmold) + end if + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name) + goto 9999 + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_invt_solver_bld diff --git a/amgprec/impl/solver/amg_s_invt_solver_check.f90 b/amgprec/impl/solver/amg_s_invt_solver_check.f90 new file mode 100644 index 00000000..41ec3b14 --- /dev/null +++ b/amgprec/impl/solver/amg_s_invt_solver_check.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_invt_solver_check(sv,info) + + + use psb_base_mod + use amg_s_invt_solver, amg_protect_name => amg_s_invt_solver_check + + Implicit None + + ! Arguments + class(amg_s_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + ! + Integer(Psb_Ipk_) :: err_act + character(len=20) :: name='amg_s_invt_solver_check' + + call psb_erractionsave(err_act) + info = psb_success_ + + call amg_check_def(sv%fill_in,& + & 'Level',izero,is_int_non_negative) + call amg_check_def(sv%inv_fill,& + & 'Level',izero,is_int_non_negative) + call amg_check_def(sv%thresh,& + & 'Eps',szero,is_legal_s_fact_thrs) + call amg_check_def(sv%inv_thresh,& + & 'Eps',szero,is_legal_s_fact_thrs) + + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_invt_solver_check diff --git a/amgprec/impl/solver/amg_s_invt_solver_clone.f90 b/amgprec/impl/solver/amg_s_invt_solver_clone.f90 new file mode 100644 index 00000000..f85bc74d --- /dev/null +++ b/amgprec/impl/solver/amg_s_invt_solver_clone.f90 @@ -0,0 +1,92 @@ +! +! +! AMG4PSBLAS version 1.0 +! MultiLevel Domain Decomposition Parallel Preconditioners Package +! based on PSBLAS (Parallel Sparse BLAS version 3.0) +! +! (C) Copyright 2008,2009,2010,2010,2012 +! +! Salvatore Filippone University of Rome Tor Vergata +! Alfredo Buttari CNRS-IRIT, Toulouse +! Pasqua D'Ambra ICAR-CNR, Naples +! Daniela di Serafino Second University of Naples +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_invt_solver_clone(sv,svout,info) + + use psb_base_mod + use amg_s_invt_solver, amg_protect_name => amg_s_invt_solver_clone + + Implicit None + + ! Arguments + class(amg_s_invt_solver_type), intent(inout) :: sv + class(amg_s_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + ! Local variables + integer(psb_ipk_) :: err_act + + + info=psb_success_ + call psb_erractionsave(err_act) + + if (allocated(svout)) then + call svout%free(info) + if (info == psb_success_) deallocate(svout, stat=info) + end if + if (info == psb_success_) & + & allocate(amg_s_invt_solver_type :: svout, stat=info) + if (info /= 0) then + info = psb_err_alloc_dealloc_ + goto 9999 + end if + select type(svo => svout) + type is (amg_s_invt_solver_type) + svo%fill_in = sv%fill_in + svo%inv_fill = sv%inv_fill + svo%thresh = sv%thresh + svo%inv_thresh = sv%inv_thresh + call psb_safe_ab_cpy(sv%d,svo%d,info) + if (info == psb_success_) & + & call sv%dv%clone(svo%dv,info) + if (info == psb_success_) & + & call sv%w%clone(svo%w,info) + if (info == psb_success_) & + & call sv%z%clone(svo%z,info) + + class default + info = psb_err_internal_error_ + end select + + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_invt_solver_clone diff --git a/amgprec/impl/solver/amg_s_invt_solver_cseti.f90 b/amgprec/impl/solver/amg_s_invt_solver_cseti.f90 new file mode 100644 index 00000000..7b9b6c70 --- /dev/null +++ b/amgprec/impl/solver/amg_s_invt_solver_cseti.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_invt_solver_cseti(sv,what,val,info,idx) + + use psb_base_mod + use amg_s_invt_solver, amg_protect_name => amg_s_invt_solver_cseti + + Implicit None + + ! Arguments + class(amg_s_invt_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_s_invt_solver_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(psb_toupper(what)) + case('SUB_FILLIN') + sv%fill_in = val + case('INV_FILLIN') + sv%inv_fill = val + case default + call sv%amg_s_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_invt_solver_cseti diff --git a/amgprec/impl/solver/amg_s_invt_solver_csetr.f90 b/amgprec/impl/solver/amg_s_invt_solver_csetr.f90 new file mode 100644 index 00000000..c9d11958 --- /dev/null +++ b/amgprec/impl/solver/amg_s_invt_solver_csetr.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_invt_solver_csetr(sv,what,val,info,idx) + + use psb_base_mod + use amg_s_invt_solver, amg_protect_name => amg_s_invt_solver_csetr + + Implicit None + + ! Arguments + class(amg_s_invt_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_s_invt_solver_csetr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(psb_toupper(what)) + case('SUB_ILUTHRS') + sv%thresh = val + case('INV_THRESH') + sv%inv_thresh = val + case default + call sv%amg_s_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_invt_solver_csetr diff --git a/amgprec/impl/solver/amg_s_invt_solver_descr.f90 b/amgprec/impl/solver/amg_s_invt_solver_descr.f90 new file mode 100644 index 00000000..3a94f69e --- /dev/null +++ b/amgprec/impl/solver/amg_s_invt_solver_descr.f90 @@ -0,0 +1,74 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_invt_solver_descr(sv,info,iout,coarse) + + + use psb_base_mod + use amg_s_invt_solver, amg_protect_name => amg_s_invt_solver_descr + + Implicit None + + ! Arguments + class(amg_s_invt_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + ! Local variables + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ictxt, me, np + character(len=20), parameter :: name='amg_s_invt_solver_descr' + integer(psb_ipk_) :: iout_ + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(iout)) then + iout_ = iout + else + iout_ = 6 + endif + + write(iout_,*) ' INVT Approximate Inverse with ILU(T,P) ' + write(iout_,*) ' Fill level :',sv%fill_in + write(iout_,*) ' Fill threshold :',sv%thresh + write(iout_,*) ' Inverse fill level :',sv%inv_fill + write(iout_,*) ' Inverse fill threshold :',sv%inv_thresh + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_invt_solver_descr diff --git a/amgprec/impl/solver/amg_s_invt_solver_seti.f90 b/amgprec/impl/solver/amg_s_invt_solver_seti.f90 new file mode 100644 index 00000000..7fa8567d --- /dev/null +++ b/amgprec/impl/solver/amg_s_invt_solver_seti.f90 @@ -0,0 +1,70 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_invt_solver_seti(sv,what,val,info) + + + use psb_base_mod + use amg_s_invt_solver, amg_protect_name => amg_s_invt_solver_seti + + Implicit None + + ! Arguments + class(amg_s_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + Integer(Psb_Ipk_) :: err_act + character(len=20) :: name='amg_s_invt_solver_seti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) + case(amg_sub_fillin_) + sv%fill_in = val + case(amg_inv_fillin_) + sv%inv_fill = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_invt_solver_seti diff --git a/amgprec/impl/solver/amg_s_invt_solver_setr.f90 b/amgprec/impl/solver/amg_s_invt_solver_setr.f90 new file mode 100644 index 00000000..d8bb8052 --- /dev/null +++ b/amgprec/impl/solver/amg_s_invt_solver_setr.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_s_invt_solver_setr(sv,what,val,info) + + + use psb_base_mod + use amg_s_invt_solver, amg_protect_name => amg_s_invt_solver_setr + + Implicit None + + ! Arguments + class(amg_s_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + real(psb_spk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + Integer(Psb_Ipk_) :: err_act + character(len=20) :: name='amg_s_invt_solver_setr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(what) + case(amg_sub_iluthrs_) + sv%thresh = val + case(amg_inv_thresh_) + sv%inv_thresh = val + case default + ! call sv%amg_s_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_s_invt_solver_setr diff --git a/amgprec/impl/solver/amg_z_ainv_solver_bld.f90 b/amgprec/impl/solver/amg_z_ainv_solver_bld.f90 new file mode 100644 index 00000000..3cd0e6a0 --- /dev/null +++ b/amgprec/impl/solver/amg_z_ainv_solver_bld.f90 @@ -0,0 +1,98 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_ainv_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) + + + use psb_base_mod + use psb_z_ainv_fact_mod + use amg_z_ainv_solver, amg_protect_name => amg_z_ainv_solver_bld + + Implicit None + + ! Arguments + type(psb_zspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_z_ainv_solver_type), intent(inout) :: sv + 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(:) + integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + type(psb_ctxt_type) :: ctxt + character(len=20) :: name='amg_z_ainv_solver_bld', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + call psb_z_ainv_bld(a,sv%alg,sv%fill_in,sv%thresh,& + & sv%w,sv%d,sv%z,desc_a,info,b,iscale=amg_ilu_scale_maxval_) + + if ((info == psb_success_) .and.present(amold)) then + call sv%w%set_asb() + call sv%w%trim() + call sv%z%set_asb() + call sv%z%trim() + call sv%w%cscnv(info,mold=amold) + if (info == psb_success_) & + & call sv%z%cscnv(info,mold=amold) + end if + + if (info == psb_success_) & + & call sv%dv%bld(sv%d,mold=vmold) + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name) + goto 9999 + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_ainv_solver_bld diff --git a/amgprec/impl/solver/amg_z_ainv_solver_check.f90 b/amgprec/impl/solver/amg_z_ainv_solver_check.f90 new file mode 100644 index 00000000..56afabb5 --- /dev/null +++ b/amgprec/impl/solver/amg_z_ainv_solver_check.f90 @@ -0,0 +1,65 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_ainv_solver_check(sv,info) + + + use psb_base_mod + use amg_z_ainv_solver, amg_protect_name => amg_z_ainv_solver_check + + Implicit None + + ! Arguments + class(amg_z_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_z_ainv_solver_check' + + call psb_erractionsave(err_act) + info = psb_success_ + + call amg_check_def(sv%fill_in,& + & 'Nzmin',ione,is_positive_nz_min) + call amg_check_def(sv%thresh,& + & 'Eps',dzero,is_legal_d_fact_thrs) + + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_ainv_solver_check diff --git a/amgprec/impl/solver/amg_z_ainv_solver_clone.f90 b/amgprec/impl/solver/amg_z_ainv_solver_clone.f90 new file mode 100644 index 00000000..95b9bc7c --- /dev/null +++ b/amgprec/impl/solver/amg_z_ainv_solver_clone.f90 @@ -0,0 +1,91 @@ +! +! +! AMG4PSBLAS version 1.0 +! MultiLevel Domain Decomposition Parallel Preconditioners Package +! based on PSBLAS (Parallel Sparse BLAS version 3.0) +! +! (C) Copyright 2008,2009,2010,2010,2012 +! +! Salvatore Filippone University of Rome Tor Vergata +! Alfredo Buttari CNRS-IRIT, Toulouse +! Pasqua D'Ambra ICAR-CNR, Naples +! Daniela di Serafino Second University of Naples +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_ainv_solver_clone(sv,svout,info) + + use psb_base_mod + use amg_z_ainv_solver, amg_protect_name => amg_z_ainv_solver_clone + + Implicit None + + ! Arguments + class(amg_z_ainv_solver_type), intent(inout) :: sv + class(amg_z_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + ! Local variables + integer(psb_ipk_) :: err_act + + + info=psb_success_ + call psb_erractionsave(err_act) + + if (allocated(svout)) then + call svout%free(info) + if (info == psb_success_) deallocate(svout, stat=info) + end if + if (info == psb_success_) & + & allocate(amg_z_ainv_solver_type :: svout, stat=info) + if (info /= 0) then + info = psb_err_alloc_dealloc_ + goto 9999 + end if + select type(svo => svout) + type is (amg_z_ainv_solver_type) + svo%alg = sv%alg + svo%fill_in = sv%fill_in + svo%thresh = sv%thresh + call psb_safe_ab_cpy(sv%d,svo%d,info) + if (info == psb_success_) & + & call sv%dv%clone(svo%dv,info) + if (info == psb_success_) & + & call sv%w%clone(svo%w,info) + if (info == psb_success_) & + & call sv%z%clone(svo%z,info) + + class default + info = psb_err_internal_error_ + end select + + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_ainv_solver_clone diff --git a/amgprec/impl/solver/amg_z_ainv_solver_csetc.f90 b/amgprec/impl/solver/amg_z_ainv_solver_csetc.f90 new file mode 100644 index 00000000..aa23356f --- /dev/null +++ b/amgprec/impl/solver/amg_z_ainv_solver_csetc.f90 @@ -0,0 +1,79 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_ainv_solver_csetc(sv,what,val,info,idx) + + + use psb_base_mod + use amg_z_ainv_solver, amg_protect_name => amg_z_ainv_solver_csetc + + Implicit None + + ! Arguments + class(amg_z_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_ ) :: err_act, ival + character(len=20) :: name='amg_z_ainv_solver_setc' + + info = psb_success_ + call psb_erractionsave(err_act) + +!!$ select case(psb_toupper(trim(what))) +!!$ case('AINV_ALG') +!!$ sv%alg = sv%stringval(val) +!!$ case default +!!$ call sv%mld_d_base_solver_type%set(what,val,info) +!!$ end select + ival = sv%stringval(val) + + if (ival >=0) then + call sv%set(what,ival,info) + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info, name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_ainv_solver_csetc diff --git a/amgprec/impl/solver/amg_z_ainv_solver_cseti.f90 b/amgprec/impl/solver/amg_z_ainv_solver_cseti.f90 new file mode 100644 index 00000000..a9682116 --- /dev/null +++ b/amgprec/impl/solver/amg_z_ainv_solver_cseti.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_ainv_solver_cseti(sv,what,val,info,idx) + + use psb_base_mod + use amg_z_ainv_solver, amg_protect_name => amg_z_ainv_solver_cseti + + Implicit None + + ! Arguments + class(amg_z_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_z_ainv_solver_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(psb_toupper(trim(what))) + case('SUB_FILLIN') + sv%fill_in = val + case('AINV_ALG') + sv%alg = val + case default + call sv%amg_z_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_ainv_solver_cseti diff --git a/amgprec/impl/solver/amg_z_ainv_solver_csetr.f90 b/amgprec/impl/solver/amg_z_ainv_solver_csetr.f90 new file mode 100644 index 00000000..7f798a12 --- /dev/null +++ b/amgprec/impl/solver/amg_z_ainv_solver_csetr.f90 @@ -0,0 +1,67 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_ainv_solver_csetr(sv,what,val,info,idx) + + use psb_base_mod + use amg_z_ainv_solver, amg_protect_name => amg_z_ainv_solver_csetr + + Implicit None + + ! Arguments + class(amg_z_ainv_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_z_ainv_solver_csetr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(psb_toupper(what)) + case('SUB_ILUTHRS') + sv%thresh = val + case default + call sv%amg_z_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_ainv_solver_csetr diff --git a/amgprec/impl/solver/amg_z_ainv_solver_descr.f90 b/amgprec/impl/solver/amg_z_ainv_solver_descr.f90 new file mode 100644 index 00000000..1518f235 --- /dev/null +++ b/amgprec/impl/solver/amg_z_ainv_solver_descr.f90 @@ -0,0 +1,73 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_ainv_solver_descr(sv,info,iout,coarse) + + + use psb_base_mod + use amg_z_ainv_solver, amg_protect_name => amg_z_ainv_solver_descr + + Implicit None + + ! Arguments + class(amg_z_ainv_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + ! Local variables + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ictxt, me, np + character(len=20), parameter :: name='amg_z_ainv_solver_descr' + integer(psb_ipk_) :: iout_ + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(iout)) then + iout_ = iout + else + iout_ = 6 + endif + + write(iout_,*) ' AINV: Approximate Inverse with sparse biconjugation ' + write(iout_,*) ' Algorithm variant : ',sv%algname(sv%alg) + write(iout_,*) ' Fill level : ',sv%fill_in + write(iout_,*) ' Fill threshold : ',sv%thresh + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_ainv_solver_descr diff --git a/amgprec/impl/solver/amg_z_ainv_solver_setc.f90 b/amgprec/impl/solver/amg_z_ainv_solver_setc.f90 new file mode 100644 index 00000000..fec47cd5 --- /dev/null +++ b/amgprec/impl/solver/amg_z_ainv_solver_setc.f90 @@ -0,0 +1,71 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_ainv_solver_setc(sv,what,val,info) + + + use psb_base_mod + use amg_z_ainv_solver, amg_protect_name => amg_z_ainv_solver_setc + + Implicit None + + ! Arguments + class(amg_z_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + character(len=*), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act, ival + character(len=20) :: name='amg_z_ainv_solver_setc' + + info = psb_success_ + call psb_erractionsave(err_act) + + ival = sv%stringval(val) + if (ival >=0) then + call sv%set(what,ival,info) + end if + + if (info /= psb_success_) then + info = psb_err_from_subroutine_ + call psb_errpush(info, name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_ainv_solver_setc diff --git a/amgprec/impl/solver/amg_z_ainv_solver_seti.f90 b/amgprec/impl/solver/amg_z_ainv_solver_seti.f90 new file mode 100644 index 00000000..0e34866f --- /dev/null +++ b/amgprec/impl/solver/amg_z_ainv_solver_seti.f90 @@ -0,0 +1,70 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_ainv_solver_seti(sv,what,val,info) + + + use psb_base_mod + use amg_z_ainv_solver, amg_protect_name => amg_z_ainv_solver_seti + + Implicit None + + ! Arguments + class(amg_z_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_z_ainv_solver_seti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) + case(amg_sub_fillin_) + sv%fill_in = val + case(amg_ainv_alg_) + sv%alg = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_ainv_solver_seti diff --git a/amgprec/impl/solver/amg_z_ainv_solver_setr.f90 b/amgprec/impl/solver/amg_z_ainv_solver_setr.f90 new file mode 100644 index 00000000..0ad516e7 --- /dev/null +++ b/amgprec/impl/solver/amg_z_ainv_solver_setr.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_ainv_solver_setr(sv,what,val,info) + + + use psb_base_mod + use amg_z_ainv_solver, amg_protect_name => amg_z_ainv_solver_setr + + Implicit None + + ! Arguments + class(amg_z_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_z_ainv_solver_setr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(what) + case(amg_sub_iluthrs_) + sv%thresh = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 +!!$ goto 9999 + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_ainv_solver_setr diff --git a/amgprec/impl/solver/amg_z_base_ainv_solver_apply.f90 b/amgprec/impl/solver/amg_z_base_ainv_solver_apply.f90 new file mode 100644 index 00000000..b5388e7c --- /dev/null +++ b/amgprec/impl/solver/amg_z_base_ainv_solver_apply.f90 @@ -0,0 +1,153 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_base_ainv_solver_apply(alpha,sv,x,beta,y,desc_data,& + & trans,work,info,init,initu) + + use psb_base_mod + use amg_z_base_ainv_mod, amg_protect_name => amg_z_base_ainv_solver_apply + implicit none + type(psb_desc_type), intent(in) :: desc_data + class(amg_z_base_ainv_solver_type), intent(inout) :: sv + complex(psb_dpk_),intent(inout) :: x(:) + complex(psb_dpk_),intent(inout) :: y(:) + complex(psb_dpk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + complex(psb_dpk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: init + complex(psb_dpk_),intent(inout), optional :: initu(:) + ! + integer(psb_ipk_) :: n_row,n_col + complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) + integer(psb_ipk_) :: np,me,i, err_act + type(psb_ctxt_type) :: ctxt + character :: trans_ + character(len=20) :: name='d_base_ainv_solver_apply' + + call psb_erractionsave(err_act) + + info = psb_success_ + + trans_ = psb_toupper(trans) + select case(trans_) + case('N') + case('T','C') + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select + ! + ! For non-iterative solvers, init and initu are ignored. + ! + + n_row = psb_cd_get_local_rows(desc_data) + n_col = psb_cd_get_local_cols(desc_data) + + if (n_col <= size(work)) then + ww => work(1:n_col) + if ((4*n_col+n_col) <= size(work)) then + aux => work(n_col+1:) + else + allocate(aux(4*n_col),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/4*n_col/),& + & a_err='real(psb_dpk_)') + goto 9999 + end if + endif + else + allocate(ww(n_col),aux(4*n_col),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/5*n_col/),& + & a_err='real(psb_dpk_)') + goto 9999 + end if + endif + + select case(trans_) + case('N') + call psb_spmm(zone,sv%w,x,zzero,ww,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + ww(1:n_row) = ww(1:n_row) * sv%d(1:n_row) + if (info == psb_success_) & + & call psb_spmm(alpha,sv%z,ww,beta,y,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + + case('T','C') + call psb_spmm(zone,sv%z,x,zzero,ww,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + ww(1:n_row) = ww(1:n_row) * sv%d(1:n_row) + if (info == psb_success_) & + & call psb_spmm(alpha,sv%w,ww,beta,y,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + + case default + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Invalid TRANS in ainv subsolve') + goto 9999 + end select + + + if (info /= psb_success_) then + + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in subsolve') + goto 9999 + endif + + if (n_col <= size(work)) then + if ((4*n_col+n_col) <= size(work)) then + else + deallocate(aux,stat=info) + endif + else + deallocate(ww,aux,stat=info) + endif + + if (info /= psb_success_) then + + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Deallocate') + goto 9999 + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_base_ainv_solver_apply diff --git a/amgprec/impl/solver/amg_z_base_ainv_solver_apply_vect.f90 b/amgprec/impl/solver/amg_z_base_ainv_solver_apply_vect.f90 new file mode 100644 index 00000000..0778d659 --- /dev/null +++ b/amgprec/impl/solver/amg_z_base_ainv_solver_apply_vect.f90 @@ -0,0 +1,167 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_base_ainv_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& + & trans,work,wv,info,init,initu) + + use psb_base_mod + use amg_z_base_ainv_mod, amg_protect_name => amg_z_base_ainv_solver_apply_vect + implicit none + type(psb_desc_type), intent(in) :: desc_data + class(amg_z_base_ainv_solver_type), intent(inout) :: sv + type(psb_z_vect_type), intent(inout) :: x + type(psb_z_vect_type), intent(inout) :: y + complex(psb_dpk_), intent(in) :: alpha,beta + character(len=1), intent(in) :: trans + complex(psb_dpk_),target, intent(inout) :: work(:) + type(psb_z_vect_type),intent(inout) :: wv(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: init + type(psb_z_vect_type),intent(inout), optional :: initu + ! + integer(psb_ipk_) :: n_row,n_col + complex(psb_dpk_), pointer :: ww(:), aux(:) + type(psb_z_vect_type) :: tx,ty + integer(psb_ipk_) :: np,me,i, err_act + type(psb_ctxt_type) :: ctxt + character :: trans_ + character(len=20) :: name='d_base_ainv_solver_apply' + + call psb_erractionsave(err_act) + + info = psb_success_ + + trans_ = psb_toupper(trans) + select case(trans_) + case('N') + case('T','C') + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select + ! + ! For non-iterative solvers, init and initu are ignored. + ! + + n_row = psb_cd_get_local_rows(desc_data) + n_col = psb_cd_get_local_cols(desc_data) + + if (n_col <= size(work)) then + ww => work(1:n_col) + if ((4*n_col+n_col) <= size(work)) then + aux => work(n_col+1:) + else + allocate(aux(4*n_col),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/4*n_col/),& + & a_err='real(psb_dpk_)') + goto 9999 + end if + endif + else + allocate(ww(n_col),aux(4*n_col),stat=info) + if (info /= psb_success_) then + info=psb_err_alloc_request_ + call psb_errpush(info,name,i_err=(/5*n_col/),& + & a_err='real(psb_dpk_)') + goto 9999 + end if + endif + + if (size(wv) < 2) then + info = psb_err_internal_error_ + call psb_errpush(info,name,& + & a_err='invalid wv size') + goto 9999 + end if + + + associate(tx => wv(1), ty => wv(2)) + + select case(trans_) + case('N') + call psb_spmm(zone,sv%w,x,zzero,tx,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + if (info == psb_success_) call ty%mlt(zone,sv%dv,tx,zzero,info) + if (info == psb_success_) & + & call psb_spmm(alpha,sv%z,ty,beta,y,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + + case('T','C') + call psb_spmm(zone,sv%z,x,zzero,tx,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + if (info == psb_success_) call ty%mlt(zone,sv%dv,tx,zzero,info) + if (info == psb_success_) & + & call psb_spmm(alpha,sv%w,ty,beta,y,desc_data,info,& + & trans=trans_,work=aux,doswap=.false.) + + case default + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Invalid TRANS in ainv subsolve') + goto 9999 + end select + + + if (info /= psb_success_) then + + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in subsolve') + goto 9999 + endif + + end associate + + if (n_col <= size(work)) then + if ((4*n_col+n_col) <= size(work)) then + else + deallocate(aux,stat=info) + endif + else + deallocate(ww,aux,stat=info) + endif + + if (info /= psb_success_) then + + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Deallocate') + goto 9999 + endif + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_base_ainv_solver_apply_vect diff --git a/amgprec/impl/solver/amg_z_base_ainv_solver_cnv.f90 b/amgprec/impl/solver/amg_z_base_ainv_solver_cnv.f90 new file mode 100644 index 00000000..979dc8c1 --- /dev/null +++ b/amgprec/impl/solver/amg_z_base_ainv_solver_cnv.f90 @@ -0,0 +1,63 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_base_ainv_solver_cnv(sv,info,amold,vmold,imold) + use psb_base_mod + use amg_z_base_ainv_mod, amg_protect_name => amg_z_base_ainv_solver_cnv + Implicit None + ! Arguments + class(amg_z_base_ainv_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 + integer(psb_ipk_) :: i, j, il1, iln, lname, lev + integer(psb_ipk_) :: iam, np + type(psb_ctxt_type) :: ctxt + character(len=80) :: prefix_ + character(len=120) :: fname ! len should be at least 20 more than + logical :: solver_ + ! len of prefix_ + + info = 0 + + if (present(amold)) then + call sv%w%cscnv(info,mold=amold) + call sv%z%cscnv(info,mold=amold) + end if + call sv%dv%cnv(mold=vmold) + +end subroutine amg_z_base_ainv_solver_cnv diff --git a/amgprec/impl/solver/amg_z_base_ainv_solver_dmp.f90 b/amgprec/impl/solver/amg_z_base_ainv_solver_dmp.f90 new file mode 100644 index 00000000..771904d5 --- /dev/null +++ b/amgprec/impl/solver/amg_z_base_ainv_solver_dmp.f90 @@ -0,0 +1,93 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_base_ainv_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num) + + use psb_base_mod + use amg_z_base_ainv_mod, amg_protect_name => amg_z_base_ainv_solver_dmp + implicit none + class(amg_z_base_ainv_solver_type), intent(in) :: sv + type(psb_desc_type), intent(in) :: desc + integer(psb_ipk_), intent(in) :: level + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix, head + logical, optional, intent(in) :: solver, global_num + ! + integer(psb_ipk_) :: i, j, il1, iln, lname, lev + integer(psb_ipk_) :: iam, np + type(psb_ctxt_type) :: ctxt + character(len=80) :: prefix_ + character(len=120) :: fname ! len should be at least 20 more than + logical :: solver_, global_num_ + ! len of prefix_ + + info = 0 + + if (present(prefix)) then + prefix_ = trim(prefix(1:min(len(prefix),len(prefix_)))) + else + prefix_ = "dump_ainv_d" + end if + + ctxt = desc%get_context() + call psb_info(ctxt,iam,np) + + if (present(solver)) then + solver_ = solver + else + solver_ = .false. + end if + if (present(global_num)) then + global_num_ = global_num + else + global_num_ = .false. + end if + lname = len_trim(prefix_) + fname = trim(prefix_) + write(fname(lname+1:lname+5),'(a,i3.3)') '_p',iam + lname = lname + 5 + + if (solver_) then + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_wmat.mtx' + if (sv%w%is_asb()) & + & call sv%w%print(fname,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_diag.mtx' + if (allocated(sv%d)) & + & call psb_geprt(fname,sv%d,head=head) + write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_zmat.mtx' + if (sv%z%is_asb()) & + & call sv%z%print(fname,head=head) + end if + +end subroutine amg_z_base_ainv_solver_dmp diff --git a/amgprec/impl/solver/amg_z_base_ainv_solver_free.f90 b/amgprec/impl/solver/amg_z_base_ainv_solver_free.f90 new file mode 100644 index 00000000..31a07c4d --- /dev/null +++ b/amgprec/impl/solver/amg_z_base_ainv_solver_free.f90 @@ -0,0 +1,70 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_base_ainv_solver_free(sv,info) + + use psb_base_mod + use amg_z_base_ainv_mod, amg_protect_name => amg_z_base_ainv_solver_free + + Implicit None + + ! Arguments + class(amg_z_base_ainv_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_z_base_ainv_solver_free' + + call psb_erractionsave(err_act) + info = psb_success_ + call sv%clear_data(info) + + if (allocated(sv%d)) then + deallocate(sv%d,stat=info) + if (info /= psb_success_) then + info = psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + end if + end if + call sv%w%free() + call sv%z%free() + call sv%dv%free(info) + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_base_ainv_solver_free diff --git a/amgprec/impl/solver/amg_z_base_ainv_update_a.f90 b/amgprec/impl/solver/amg_z_base_ainv_update_a.f90 new file mode 100644 index 00000000..7d2f9496 --- /dev/null +++ b/amgprec/impl/solver/amg_z_base_ainv_update_a.f90 @@ -0,0 +1,81 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_base_ainv_update_a(sv,x,desc_data,info) + use amg_z_base_ainv_mod, amg_protect_name => amg_z_base_ainv_update_a + use psb_base_mod + + implicit none + + type(psb_desc_type), intent(in) :: desc_data + class(amg_z_base_ainv_solver_type), intent(inout) :: sv + complex(psb_dpk_),intent(in) :: x(:) + integer(psb_ipk_), intent(out) :: info + + ! Local variables + complex(psb_dpk_), allocatable :: dd(:), ee(:) + integer(psb_ipk_) :: nrows, ncols, i, j, k, nzr, nzc, ir, ic + + type(psb_z_csc_sparse_mat) :: ac + type(psb_z_csr_sparse_mat) :: ar + + dd = sv%dv%get_vect() + if (size(x) amg_z_invk_solver_bld + + Implicit None + + ! Arguments + type(psb_zspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_z_invk_solver_type), intent(inout) :: sv + 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(:) + integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + type(psb_ctxt_type) :: ctxt + character(len=20) :: name='z_invk_solver_bld', ch_err + + info=psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + + call psb_invk_fact(a,sv%fill_in,sv%inv_fill,& + & sv%w,sv%d,sv%z,desc_a,info,b) + + + if ((info == psb_success_) .and.present(amold)) then + call sv%w%cscnv(info,mold=amold) + if (info == psb_success_) & + & call sv%z%cscnv(info,mold=amold) + end if + + if (info == psb_success_) then + call sv%dv%bld(sv%d,mold=vmold) + end if + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_invk_solver_bld diff --git a/amgprec/impl/solver/amg_z_invk_solver_check.f90 b/amgprec/impl/solver/amg_z_invk_solver_check.f90 new file mode 100644 index 00000000..1c282de3 --- /dev/null +++ b/amgprec/impl/solver/amg_z_invk_solver_check.f90 @@ -0,0 +1,64 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_invk_solver_check(sv,info) + + + use psb_base_mod + use amg_z_invk_solver, amg_protect_name => amg_z_invk_solver_check + + Implicit None + + ! Arguments + class(amg_z_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + Integer(Psb_Ipk_) :: err_act + character(len=20) :: name='z_invk_solver_check' + + call psb_erractionsave(err_act) + info = psb_success_ + + call amg_check_def(sv%fill_in,& + & 'Level',izero,is_int_non_negative) + call amg_check_def(sv%inv_fill,& + & 'Level',izero,is_int_non_negative) + + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_invk_solver_check diff --git a/amgprec/impl/solver/amg_z_invk_solver_clone.f90 b/amgprec/impl/solver/amg_z_invk_solver_clone.f90 new file mode 100644 index 00000000..050c9cd9 --- /dev/null +++ b/amgprec/impl/solver/amg_z_invk_solver_clone.f90 @@ -0,0 +1,90 @@ +! +! +! AMG4PSBLAS version 1.0 +! MultiLevel Domain Decomposition Parallel Preconditioners Package +! based on PSBLAS (Parallel Sparse BLAS version 3.0) +! +! (C) Copyright 2008,2009,2010,2010,2012 +! +! Salvatore Filippone University of Rome Tor Vergata +! Alfredo Buttari CNRS-IRIT, Toulouse +! Pasqua D'Ambra ICAR-CNR, Naples +! Daniela di Serafino Second University of Naples +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_invk_solver_clone(sv,svout,info) + + use psb_base_mod + use amg_z_invk_solver, amg_protect_name => amg_z_invk_solver_clone + + Implicit None + + ! Arguments + class(amg_z_invk_solver_type), intent(inout) :: sv + class(amg_z_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + ! Local variables + integer(psb_ipk_) :: err_act + + + info=psb_success_ + call psb_erractionsave(err_act) + + if (allocated(svout)) then + call svout%free(info) + if (info == psb_success_) deallocate(svout, stat=info) + end if + if (info == psb_success_) & + & allocate(amg_z_invk_solver_type :: svout, stat=info) + if (info /= 0) then + info = psb_err_alloc_dealloc_ + goto 9999 + end if + select type(svo => svout) + type is (amg_z_invk_solver_type) + svo%fill_in = sv%fill_in + svo%inv_fill = sv%inv_fill + call psb_safe_ab_cpy(sv%d,svo%d,info) + if (info == psb_success_) & + & call sv%dv%clone(svo%dv,info) + if (info == psb_success_) & + & call sv%w%clone(svo%w,info) + if (info == psb_success_) & + & call sv%z%clone(svo%z,info) + + class default + info = psb_err_internal_error_ + end select + + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_invk_solver_clone diff --git a/amgprec/impl/solver/amg_z_invk_solver_cseti.f90 b/amgprec/impl/solver/amg_z_invk_solver_cseti.f90 new file mode 100644 index 00000000..b3e2c1ba --- /dev/null +++ b/amgprec/impl/solver/amg_z_invk_solver_cseti.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_invk_solver_cseti(sv,what,val,info,idx) + + use psb_base_mod + use amg_z_invk_solver, amg_protect_name => amg_z_invk_solver_cseti + + Implicit None + + ! Arguments + class(amg_z_invk_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_invk_solver_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(psb_toupper(what)) + case('SUB_FILLIN') + sv%fill_in = val + case('INV_FILLIN') + sv%inv_fill = val + case default + call sv%amg_z_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_invk_solver_cseti diff --git a/amgprec/impl/solver/amg_z_invk_solver_descr.f90 b/amgprec/impl/solver/amg_z_invk_solver_descr.f90 new file mode 100644 index 00000000..042199c5 --- /dev/null +++ b/amgprec/impl/solver/amg_z_invk_solver_descr.f90 @@ -0,0 +1,73 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_invk_solver_descr(sv,info,iout,coarse) + + + use psb_base_mod + use amg_z_invk_solver, amg_protect_name => amg_z_invk_solver_descr + + Implicit None + + ! Arguments + class(amg_z_invk_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + ! Local variables + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: me, np + type(psb_ctxt_type) :: ctxt + character(len=20), parameter :: name='amg_z_invk_solver_descr' + integer(psb_ipk_) :: iout_ + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(iout)) then + iout_ = iout + else + iout_ = 6 + endif + + write(iout_,*) ' INVK Approximate Inverse with ILU(N) ' + write(iout_,*) ' Fill level :',sv%fill_in + write(iout_,*) ' Inverse fill level :',sv%inv_fill + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_invk_solver_descr diff --git a/amgprec/impl/solver/amg_z_invk_solver_seti.f90 b/amgprec/impl/solver/amg_z_invk_solver_seti.f90 new file mode 100644 index 00000000..f5299d6a --- /dev/null +++ b/amgprec/impl/solver/amg_z_invk_solver_seti.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_invk_solver_seti(sv,what,val,info) + + + use psb_base_mod + use amg_z_invk_solver, amg_protect_name => amg_z_invk_solver_seti + + Implicit None + + ! Arguments + class(amg_z_invk_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_invk_solver_seti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) + case(amg_sub_fillin_) + sv%fill_in = val + case(amg_inv_fillin_) + sv%inv_fill = val + case default + ! call sv%amg_z_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_invk_solver_seti diff --git a/amgprec/impl/solver/amg_z_invt_solver_bld.f90 b/amgprec/impl/solver/amg_z_invt_solver_bld.f90 new file mode 100644 index 00000000..6ed14ff1 --- /dev/null +++ b/amgprec/impl/solver/amg_z_invt_solver_bld.f90 @@ -0,0 +1,97 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_invt_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) + + use psb_base_mod + use psb_z_invt_fact_mod ! This module contains the construction routines + use amg_z_invt_solver, amg_protect_name => amg_z_invt_solver_bld + + Implicit None + + ! Arguments + type(psb_zspmat_type), intent(in), target :: a + Type(psb_desc_type), Intent(inout) :: desc_a + class(amg_z_invt_solver_type), intent(inout) :: sv + 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(:) + integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + type(psb_ctxt_type) :: ctxt + character(len=20) :: name='amg_z_invt_solver_bld', ch_err + + info = psb_success_ + call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() + ctxt = desc_a%get_context() + call psb_info(ctxt, me, np) + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' start' + + + call psb_invt_fact(a,sv%fill_in,sv%inv_fill,& + & sv%thresh,sv%inv_thresh,& + & sv%w,sv%d,sv%z,desc_a,info,b) + + if ((info == psb_success_) .and.present(amold)) then + call sv%w%cscnv(info,mold=amold) + if (info == psb_success_) & + & call sv%z%cscnv(info,mold=amold) + end if + + if (info == psb_success_) then + call sv%dv%bld(sv%d,mold=vmold) + end if + + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name) + goto 9999 + end if + + if (debug_level >= psb_debug_outer_) & + & write(debug_unit,*) me,' ',trim(name),' end' + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_invt_solver_bld diff --git a/amgprec/impl/solver/amg_z_invt_solver_check.f90 b/amgprec/impl/solver/amg_z_invt_solver_check.f90 new file mode 100644 index 00000000..761734d7 --- /dev/null +++ b/amgprec/impl/solver/amg_z_invt_solver_check.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_invt_solver_check(sv,info) + + + use psb_base_mod + use amg_z_invt_solver, amg_protect_name => amg_z_invt_solver_check + + Implicit None + + ! Arguments + class(amg_z_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(out) :: info + ! + Integer(Psb_Ipk_) :: err_act + character(len=20) :: name='amg_z_invt_solver_check' + + call psb_erractionsave(err_act) + info = psb_success_ + + call amg_check_def(sv%fill_in,& + & 'Level',izero,is_int_non_negative) + call amg_check_def(sv%inv_fill,& + & 'Level',izero,is_int_non_negative) + call amg_check_def(sv%thresh,& + & 'Eps',dzero,is_legal_d_fact_thrs) + call amg_check_def(sv%inv_thresh,& + & 'Eps',dzero,is_legal_d_fact_thrs) + + if (info /= psb_success_) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_invt_solver_check diff --git a/amgprec/impl/solver/amg_z_invt_solver_clone.f90 b/amgprec/impl/solver/amg_z_invt_solver_clone.f90 new file mode 100644 index 00000000..76257ae9 --- /dev/null +++ b/amgprec/impl/solver/amg_z_invt_solver_clone.f90 @@ -0,0 +1,92 @@ +! +! +! AMG4PSBLAS version 1.0 +! MultiLevel Domain Decomposition Parallel Preconditioners Package +! based on PSBLAS (Parallel Sparse BLAS version 3.0) +! +! (C) Copyright 2008,2009,2010,2010,2012 +! +! Salvatore Filippone University of Rome Tor Vergata +! Alfredo Buttari CNRS-IRIT, Toulouse +! Pasqua D'Ambra ICAR-CNR, Naples +! Daniela di Serafino Second University of Naples +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_invt_solver_clone(sv,svout,info) + + use psb_base_mod + use amg_z_invt_solver, amg_protect_name => amg_z_invt_solver_clone + + Implicit None + + ! Arguments + class(amg_z_invt_solver_type), intent(inout) :: sv + class(amg_z_base_solver_type), allocatable, intent(inout) :: svout + integer(psb_ipk_), intent(out) :: info + ! Local variables + integer(psb_ipk_) :: err_act + + + info=psb_success_ + call psb_erractionsave(err_act) + + if (allocated(svout)) then + call svout%free(info) + if (info == psb_success_) deallocate(svout, stat=info) + end if + if (info == psb_success_) & + & allocate(amg_z_invt_solver_type :: svout, stat=info) + if (info /= 0) then + info = psb_err_alloc_dealloc_ + goto 9999 + end if + select type(svo => svout) + type is (amg_z_invt_solver_type) + svo%fill_in = sv%fill_in + svo%inv_fill = sv%inv_fill + svo%thresh = sv%thresh + svo%inv_thresh = sv%inv_thresh + call psb_safe_ab_cpy(sv%d,svo%d,info) + if (info == psb_success_) & + & call sv%dv%clone(svo%dv,info) + if (info == psb_success_) & + & call sv%w%clone(svo%w,info) + if (info == psb_success_) & + & call sv%z%clone(svo%z,info) + + class default + info = psb_err_internal_error_ + end select + + if (info /= 0) goto 9999 + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_invt_solver_clone diff --git a/amgprec/impl/solver/amg_z_invt_solver_cseti.f90 b/amgprec/impl/solver/amg_z_invt_solver_cseti.f90 new file mode 100644 index 00000000..b61adf17 --- /dev/null +++ b/amgprec/impl/solver/amg_z_invt_solver_cseti.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_invt_solver_cseti(sv,what,val,info,idx) + + use psb_base_mod + use amg_z_invt_solver, amg_protect_name => amg_z_invt_solver_cseti + + Implicit None + + ! Arguments + class(amg_z_invt_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_z_invt_solver_cseti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(psb_toupper(what)) + case('SUB_FILLIN') + sv%fill_in = val + case('INV_FILLIN') + sv%inv_fill = val + case default + call sv%amg_z_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_invt_solver_cseti diff --git a/amgprec/impl/solver/amg_z_invt_solver_csetr.f90 b/amgprec/impl/solver/amg_z_invt_solver_csetr.f90 new file mode 100644 index 00000000..30f1479c --- /dev/null +++ b/amgprec/impl/solver/amg_z_invt_solver_csetr.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_invt_solver_csetr(sv,what,val,info,idx) + + use psb_base_mod + use amg_z_invt_solver, amg_protect_name => amg_z_invt_solver_csetr + + Implicit None + + ! Arguments + class(amg_z_invt_solver_type), intent(inout) :: sv + character(len=*), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: idx + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='amg_z_invt_solver_csetr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(psb_toupper(what)) + case('SUB_ILUTHRS') + sv%thresh = val + case('INV_THRESH') + sv%inv_thresh = val + case default + call sv%amg_z_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_invt_solver_csetr diff --git a/amgprec/impl/solver/amg_z_invt_solver_descr.f90 b/amgprec/impl/solver/amg_z_invt_solver_descr.f90 new file mode 100644 index 00000000..61f8ee37 --- /dev/null +++ b/amgprec/impl/solver/amg_z_invt_solver_descr.f90 @@ -0,0 +1,74 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_invt_solver_descr(sv,info,iout,coarse) + + + use psb_base_mod + use amg_z_invt_solver, amg_protect_name => amg_z_invt_solver_descr + + Implicit None + + ! Arguments + class(amg_z_invt_solver_type), intent(in) :: sv + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse + + ! Local variables + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ictxt, me, np + character(len=20), parameter :: name='amg_z_invt_solver_descr' + integer(psb_ipk_) :: iout_ + + call psb_erractionsave(err_act) + info = psb_success_ + if (present(iout)) then + iout_ = iout + else + iout_ = 6 + endif + + write(iout_,*) ' INVT Approximate Inverse with ILU(T,P) ' + write(iout_,*) ' Fill level :',sv%fill_in + write(iout_,*) ' Fill threshold :',sv%thresh + write(iout_,*) ' Inverse fill level :',sv%inv_fill + write(iout_,*) ' Inverse fill threshold :',sv%inv_thresh + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_invt_solver_descr diff --git a/amgprec/impl/solver/amg_z_invt_solver_seti.f90 b/amgprec/impl/solver/amg_z_invt_solver_seti.f90 new file mode 100644 index 00000000..bc4bca10 --- /dev/null +++ b/amgprec/impl/solver/amg_z_invt_solver_seti.f90 @@ -0,0 +1,70 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_invt_solver_seti(sv,what,val,info) + + + use psb_base_mod + use amg_z_invt_solver, amg_protect_name => amg_z_invt_solver_seti + + Implicit None + + ! Arguments + class(amg_z_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + integer(psb_ipk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + Integer(Psb_Ipk_) :: err_act + character(len=20) :: name='amg_z_invt_solver_seti' + + info = psb_success_ + call psb_erractionsave(err_act) + + select case(what) + case(amg_sub_fillin_) + sv%fill_in = val + case(amg_inv_fillin_) + sv%inv_fill = val + case default +!!$ write(0,*) name,': Error: invalid WHAT' +!!$ info = -2 + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_invt_solver_seti diff --git a/amgprec/impl/solver/amg_z_invt_solver_setr.f90 b/amgprec/impl/solver/amg_z_invt_solver_setr.f90 new file mode 100644 index 00000000..49fd2c4d --- /dev/null +++ b/amgprec/impl/solver/amg_z_invt_solver_setr.f90 @@ -0,0 +1,69 @@ +! +! +! AMG-AINV: Approximate Inverse plugin for +! AMG4PSBLAS version 1.0 +! +! (C) Copyright 2020 +! +! Salvatore Filippone University of Rome Tor Vergata +! +! 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 AMG4PSBLAS 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 AMG4PSBLAS 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 amg_z_invt_solver_setr(sv,what,val,info) + + + use psb_base_mod + use amg_z_invt_solver, amg_protect_name => amg_z_invt_solver_setr + + Implicit None + + ! Arguments + class(amg_z_invt_solver_type), intent(inout) :: sv + integer(psb_ipk_), intent(in) :: what + real(psb_dpk_), intent(in) :: val + integer(psb_ipk_), intent(out) :: info + ! + Integer(Psb_Ipk_) :: err_act + character(len=20) :: name='amg_z_invt_solver_setr' + + call psb_erractionsave(err_act) + info = psb_success_ + + select case(what) + case(amg_sub_iluthrs_) + sv%thresh = val + case(amg_inv_thresh_) + sv%inv_thresh = val + case default + ! call sv%amg_z_base_solver_type%set(what,val,info) + end select + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return +end subroutine amg_z_invt_solver_setr diff --git a/examples/fileread/Makefile b/examples/fileread/Makefile index d9b622d9..2375b30f 100644 --- a/examples/fileread/Makefile +++ b/examples/fileread/Makefile @@ -1,89 +1,89 @@ -MLDDIR=../.. -MLDINCDIR=$(MLDDIR)/include -include $(MLDINCDIR)/Make.inc.amg4psblas -MLDMODDIR=$(MLDDIR)/modules -MLDLIBDIR=$(MLDDIR)/lib -MLD_LIBS=-L$(MLDLIBDIR) -lpsb_krylov -lmld_prec -lpsb_prec -FINCLUDES=$(FMFLAG). $(FMFLAG)$(MLDMODDIR) $(FMFLAG)$(MLDINCDIR) $(PSBLAS_INCLUDES) $(FIFLAG). +AMGDIR=../.. +AMGINCDIR=$(AMGDIR)/include +include $(AMGINCDIR)/Make.inc.amg4psblas +AMGMODDIR=$(AMGDIR)/modules +AMGLIBDIR=$(AMGDIR)/lib +AMG_LIBS=-L$(AMGLIBDIR) -lpsb_krylov -lamg_prec -lpsb_prec +FINCLUDES=$(FMFLAG). $(FMFLAG)$(AMGMODDIR) $(FMFLAG)$(AMGINCDIR) $(PSBLAS_INCLUDES) $(FIFLAG). LINKOPT= -DMOBJS=mld_dexample_ml.o data_input.o -D1OBJS=mld_dexample_1lev.o data_input.o -ZMOBJS=mld_zexample_ml.o data_input.o -Z1OBJS=mld_zexample_1lev.o data_input.o -SMOBJS=mld_sexample_ml.o data_input.o -S1OBJS=mld_sexample_1lev.o data_input.o -CMOBJS=mld_cexample_ml.o data_input.o -C1OBJS=mld_cexample_1lev.o data_input.o +DMOBJS=amg_dexample_ml.o data_input.o +D1OBJS=amg_dexample_1lev.o data_input.o +ZMOBJS=amg_zexample_ml.o data_input.o +Z1OBJS=amg_zexample_1lev.o data_input.o +SMOBJS=amg_sexample_ml.o data_input.o +S1OBJS=amg_sexample_1lev.o data_input.o +CMOBJS=amg_cexample_ml.o data_input.o +C1OBJS=amg_cexample_1lev.o data_input.o EXEDIR=./runs -all: mld_dexample_ml mld_dexample_1lev mld_zexample_ml mld_zexample_1lev\ - mld_sexample_ml mld_sexample_1lev mld_cexample_ml mld_cexample_1lev +all: amg_dexample_ml amg_dexample_1lev amg_zexample_ml amg_zexample_1lev\ + amg_sexample_ml amg_sexample_1lev amg_cexample_ml amg_cexample_1lev -mld_dexample_ml: $(DMOBJS) - $(FLINK) $(LINKOPT) $(DMOBJS) -o mld_dexample_ml \ - $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) - /bin/mv mld_dexample_ml $(EXEDIR) +amg_dexample_ml: $(DMOBJS) + $(FLINK) $(LINKOPT) $(DMOBJS) -o amg_dexample_ml \ + $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) + /bin/mv amg_dexample_ml $(EXEDIR) -mld_dexample_1lev: $(D1OBJS) - $(FLINK) $(LINKOPT) $(D1OBJS) -o mld_dexample_1lev \ - $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) - /bin/mv mld_dexample_1lev $(EXEDIR) +amg_dexample_1lev: $(D1OBJS) + $(FLINK) $(LINKOPT) $(D1OBJS) -o amg_dexample_1lev \ + $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) + /bin/mv amg_dexample_1lev $(EXEDIR) -mld_dexample_ml.o: data_input.o -mld_dexample_1lev.o: data_input.o +amg_dexample_ml.o: data_input.o +amg_dexample_1lev.o: data_input.o -mld_zexample_ml: $(ZMOBJS) - $(FLINK) $(LINKOPT) $(ZMOBJS) -o mld_zexample_ml \ - $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) - /bin/mv mld_zexample_ml $(EXEDIR) +amg_zexample_ml: $(ZMOBJS) + $(FLINK) $(LINKOPT) $(ZMOBJS) -o amg_zexample_ml \ + $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) + /bin/mv amg_zexample_ml $(EXEDIR) -mld_zexample_1lev: $(Z1OBJS) - $(FLINK) $(LINKOPT) $(Z1OBJS) -o mld_zexample_1lev \ - $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) - /bin/mv mld_zexample_1lev $(EXEDIR) +amg_zexample_1lev: $(Z1OBJS) + $(FLINK) $(LINKOPT) $(Z1OBJS) -o amg_zexample_1lev \ + $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) + /bin/mv amg_zexample_1lev $(EXEDIR) -mld_zexample_ml.o: data_input.o -mld_zexample_1lev.o: data_input.o +amg_zexample_ml.o: data_input.o +amg_zexample_1lev.o: data_input.o -mld_sexample_ml: $(SMOBJS) - $(FLINK) $(LINKOPT) $(SMOBJS) -o mld_sexample_ml \ - $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) - /bin/mv mld_sexample_ml $(EXEDIR) +amg_sexample_ml: $(SMOBJS) + $(FLINK) $(LINKOPT) $(SMOBJS) -o amg_sexample_ml \ + $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) + /bin/mv amg_sexample_ml $(EXEDIR) -mld_sexample_1lev: $(S1OBJS) - $(FLINK) $(LINKOPT) $(S1OBJS) -o mld_sexample_1lev \ - $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) - /bin/mv mld_sexample_1lev $(EXEDIR) +amg_sexample_1lev: $(S1OBJS) + $(FLINK) $(LINKOPT) $(S1OBJS) -o amg_sexample_1lev \ + $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) + /bin/mv amg_sexample_1lev $(EXEDIR) -mld_sexample_ml.o: data_input.o -mld_sexample_1lev.o: data_input.o +amg_sexample_ml.o: data_input.o +amg_sexample_1lev.o: data_input.o -mld_cexample_ml: $(CMOBJS) - $(FLINK) $(LINKOPT) $(CMOBJS) -o mld_cexample_ml \ - $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) - /bin/mv mld_cexample_ml $(EXEDIR) +amg_cexample_ml: $(CMOBJS) + $(FLINK) $(LINKOPT) $(CMOBJS) -o amg_cexample_ml \ + $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) + /bin/mv amg_cexample_ml $(EXEDIR) -mld_cexample_1lev: $(C1OBJS) - $(FLINK) $(LINKOPT) $(C1OBJS) -o mld_cexample_1lev \ - $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) - /bin/mv mld_cexample_1lev $(EXEDIR) +amg_cexample_1lev: $(C1OBJS) + $(FLINK) $(LINKOPT) $(C1OBJS) -o amg_cexample_1lev \ + $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) + /bin/mv amg_cexample_1lev $(EXEDIR) -mld_cexample_ml.o: data_input.o -mld_cexample_1lev.o: data_input.o +amg_cexample_ml.o: data_input.o +amg_cexample_1lev.o: data_input.o clean: /bin/rm -f *$(.mod) \ $(DMOBJS) $(D1OBJS) $(ZMOBJS) $(Z1OBJS) \ - $(EXEDIR)/mld_dexample_ml $(EXEDIR)/mld_dexample_1lev \ - $(EXEDIR)/mld_zexample_ml $(EXEDIR)/mld_zexample_1lev \ + $(EXEDIR)/amg_dexample_ml $(EXEDIR)/amg_dexample_1lev \ + $(EXEDIR)/amg_zexample_ml $(EXEDIR)/amg_zexample_1lev \ $(SMOBJS) $(S1OBJS) $(CMOBJS) $(C1OBJS) \ - $(EXEDIR)/mld_sexample_ml $(EXEDIR)/mld_sexample_1lev \ - $(EXEDIR)/mld_cexample_ml $(EXEDIR)/mld_cexample_1lev + $(EXEDIR)/amg_sexample_ml $(EXEDIR)/amg_sexample_1lev \ + $(EXEDIR)/amg_cexample_ml $(EXEDIR)/amg_cexample_1lev lib: (cd ../../; make library) diff --git a/examples/fileread/amg_cexample_ml.f90 b/examples/fileread/amg_cexample_ml.f90 index 36a88c13..d31807a6 100644 --- a/examples/fileread/amg_cexample_ml.f90 +++ b/examples/fileread/amg_cexample_ml.f90 @@ -222,7 +222,7 @@ program amg_cexample_ml ! ILU(0) on the blocks) as pre- and post-smoother, and 8 block-Jacobi ! sweeps (with ILU(0) on the blocks) as coarsest-level solver - call P%init('ML',info) + call P%init(ctxt,'ML',info) call P%set('SMOOTHER_TYPE','BJAC',info) call P%set('COARSE_SOLVE','BJAC',info) call P%set('COARSE_SWEEPS',8,info) @@ -234,7 +234,7 @@ program amg_cexample_ml ! GS sweeps as pre/post-smoother, a distributed coarsest ! matrix, and MUMPS as coarsest-level solver - call P%init('ML',info) + call P%init(ctxt,'ML',info) call P%set('ML_CYCLE','WCYCLE',info) call P%set('SMOOTHER_SWEEPS',2,info) call P%set('COARSE_SOLVE','MUMPS',info) diff --git a/examples/fileread/amg_dexample_ml.f90 b/examples/fileread/amg_dexample_ml.f90 index c809be76..9380d991 100644 --- a/examples/fileread/amg_dexample_ml.f90 +++ b/examples/fileread/amg_dexample_ml.f90 @@ -222,7 +222,7 @@ program amg_dexample_ml ! ILU(0) on the blocks) as pre- and post-smoother, and 8 block-Jacobi ! sweeps (with ILU(0) on the blocks) as coarsest-level solver - call P%init('ML',info) + call P%init(ctxt,'ML',info) call P%set('SMOOTHER_TYPE','BJAC',info) call P%set('COARSE_SOLVE','BJAC',info) call P%set('COARSE_SWEEPS',8,info) @@ -234,7 +234,7 @@ program amg_dexample_ml ! GS sweeps as pre/post-smoother, a distributed coarsest ! matrix, and MUMPS as coarsest-level solver - call P%init('ML',info) + call P%init(ctxt,'ML',info) call P%set('ML_CYCLE','WCYCLE',info) call P%set('SMOOTHER_SWEEPS',2,info) call P%set('COARSE_SOLVE','MUMPS',info) diff --git a/examples/fileread/amg_sexample_ml.f90 b/examples/fileread/amg_sexample_ml.f90 index 1d0e864b..f3156631 100644 --- a/examples/fileread/amg_sexample_ml.f90 +++ b/examples/fileread/amg_sexample_ml.f90 @@ -222,7 +222,7 @@ program amg_sexample_ml ! ILU(0) on the blocks) as pre- and post-smoother, and 8 block-Jacobi ! sweeps (with ILU(0) on the blocks) as coarsest-level solver - call P%init('ML',info) + call P%init(ctxt,'ML',info) call P%set('SMOOTHER_TYPE','BJAC',info) call P%set('COARSE_SOLVE','BJAC',info) call P%set('COARSE_SWEEPS',8,info) @@ -234,7 +234,7 @@ program amg_sexample_ml ! GS sweeps as pre/post-smoother, a distributed coarsest ! matrix, and MUMPS as coarsest-level solver - call P%init('ML',info) + call P%init(ctxt,'ML',info) call P%set('ML_CYCLE','WCYCLE',info) call P%set('SMOOTHER_SWEEPS',2,info) call P%set('COARSE_SOLVE','MUMPS',info) diff --git a/examples/fileread/amg_zexample_ml.f90 b/examples/fileread/amg_zexample_ml.f90 index 2fdc4468..b69c334a 100644 --- a/examples/fileread/amg_zexample_ml.f90 +++ b/examples/fileread/amg_zexample_ml.f90 @@ -222,7 +222,7 @@ program amg_zexample_ml ! ILU(0) on the blocks) as pre- and post-smoother, and 8 block-Jacobi ! sweeps (with ILU(0) on the blocks) as coarsest-level solver - call P%init('ML',info) + call P%init(ctxt,'ML',info) call P%set('SMOOTHER_TYPE','BJAC',info) call P%set('COARSE_SOLVE','BJAC',info) call P%set('COARSE_SWEEPS',8,info) @@ -234,7 +234,7 @@ program amg_zexample_ml ! GS sweeps as pre/post-smoother, a distributed coarsest ! matrix, and MUMPS as coarsest-level solver - call P%init('ML',info) + call P%init(ctxt,'ML',info) call P%set('ML_CYCLE','WCYCLE',info) call P%set('SMOOTHER_SWEEPS',2,info) call P%set('COARSE_SOLVE','MUMPS',info) diff --git a/examples/pdegen/Makefile b/examples/pdegen/Makefile index 7f003246..7a03d5b9 100644 --- a/examples/pdegen/Makefile +++ b/examples/pdegen/Makefile @@ -1,52 +1,52 @@ -MLDDIR=../.. -MLDINCDIR=$(MLDDIR)/include -include $(MLDINCDIR)/Make.inc.amg4psblas -MLDMODDIR=$(MLDDIR)/modules -MLDLIBDIR=$(MLDDIR)/lib -MLD_LIBS=-L$(MLDLIBDIR) -lpsb_krylov -lmld_prec -lpsb_prec -FINCLUDES=$(FMFLAG). $(FMFLAG)$(MLDMODDIR) $(FMFLAG)$(MLDINCDIR) $(PSBLAS_INCLUDES) $(FIFLAG). +AMGDIR=../.. +AMGINCDIR=$(AMGDIR)/include +include $(AMGINCDIR)/Make.inc.amg4psblas +AMGMODDIR=$(AMGDIR)/modules +AMGLIBDIR=$(AMGDIR)/lib +AMG_LIBS=-L$(AMGLIBDIR) -lpsb_krylov -lamg_prec -lpsb_prec +FINCLUDES=$(FMFLAG). $(FMFLAG)$(AMGMODDIR) $(FMFLAG)$(AMGINCDIR) $(PSBLAS_INCLUDES) $(FIFLAG). LINKOPT= -DMOBJS=mld_dexample_ml.o data_input.o mld_dpde_mod.o -D1OBJS=mld_dexample_1lev.o data_input.o mld_dpde_mod.o -SMOBJS=mld_sexample_ml.o data_input.o mld_spde_mod.o -S1OBJS=mld_sexample_1lev.o data_input.o mld_spde_mod.o +DMOBJS=amg_dexample_ml.o data_input.o amg_dpde_mod.o +D1OBJS=amg_dexample_1lev.o data_input.o amg_dpde_mod.o +SMOBJS=amg_sexample_ml.o data_input.o amg_spde_mod.o +S1OBJS=amg_sexample_1lev.o data_input.o amg_spde_mod.o EXEDIR=./runs -all: mld_sexample_ml mld_sexample_1lev mld_dexample_ml mld_dexample_1lev +all: amg_sexample_ml amg_sexample_1lev amg_dexample_ml amg_dexample_1lev -mld_dexample_ml: $(DMOBJS) - $(FLINK) $(LINKOPT) $(DMOBJS) -o mld_dexample_ml \ - $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) - /bin/mv mld_dexample_ml $(EXEDIR) +amg_dexample_ml: $(DMOBJS) + $(FLINK) $(LINKOPT) $(DMOBJS) -o amg_dexample_ml \ + $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) + /bin/mv amg_dexample_ml $(EXEDIR) -mld_dexample_1lev: $(D1OBJS) - $(FLINK) $(LINKOPT) $(D1OBJS) -o mld_dexample_1lev \ - $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) - /bin/mv mld_dexample_1lev $(EXEDIR) +amg_dexample_1lev: $(D1OBJS) + $(FLINK) $(LINKOPT) $(D1OBJS) -o amg_dexample_1lev \ + $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) + /bin/mv amg_dexample_1lev $(EXEDIR) -mld_dexample_ml.o: data_input.o mld_dpde_mod.o -mld_dexample_1lev.o: data_input.o mld_dpde_mod.o +amg_dexample_ml.o: data_input.o amg_dpde_mod.o +amg_dexample_1lev.o: data_input.o amg_dpde_mod.o -mld_sexample_ml: $(SMOBJS) - $(FLINK) $(LINKOPT) $(SMOBJS) -o mld_sexample_ml \ - $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) - /bin/mv mld_sexample_ml $(EXEDIR) +amg_sexample_ml: $(SMOBJS) + $(FLINK) $(LINKOPT) $(SMOBJS) -o amg_sexample_ml \ + $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) + /bin/mv amg_sexample_ml $(EXEDIR) -mld_sexample_1lev: $(S1OBJS) - $(FLINK) $(LINKOPT) $(S1OBJS) -o mld_sexample_1lev \ - $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) - /bin/mv mld_sexample_1lev $(EXEDIR) +amg_sexample_1lev: $(S1OBJS) + $(FLINK) $(LINKOPT) $(S1OBJS) -o amg_sexample_1lev \ + $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) + /bin/mv amg_sexample_1lev $(EXEDIR) -mld_sexample_ml.o: data_input.o mld_spde_mod.o -mld_sexample_1lev.o: data_input.o mld_spde_mod.o +amg_sexample_ml.o: data_input.o amg_spde_mod.o +amg_sexample_1lev.o: data_input.o amg_spde_mod.o clean: /bin/rm -f $(DMOBJS) $(D1OBJS) $(SMOBJS) $(S1OBJS) \ - *$(.mod) $(EXEDIR)/mld_dexample_ml $(EXEDIR)/mld_dexample_1lev\ - $(EXEDIR)/mld_sexample_ml $(EXEDIR)/mld_sexample_1lev + *$(.mod) $(EXEDIR)/amg_dexample_ml $(EXEDIR)/amg_dexample_1lev\ + $(EXEDIR)/amg_sexample_ml $(EXEDIR)/amg_sexample_1lev lib: (cd ../../; make library) diff --git a/tests/fileread/Makefile b/tests/fileread/Makefile index e8fb17d8..187101aa 100644 --- a/tests/fileread/Makefile +++ b/tests/fileread/Makefile @@ -1,51 +1,51 @@ -MLDDIR=../.. -MLDINCDIR=$(MLDDIR)/include -include $(MLDINCDIR)/Make.inc.amg4psblas -MLDMODDIR=$(MLDDIR)/modules -MLDLIBDIR=$(MLDDIR)/lib -MLD_LIBS=-L$(MLDLIBDIR) -lpsb_krylov -lmld_prec -lpsb_prec -FINCLUDES=$(FMFLAG). $(FMFLAG)$(MLDMODDIR) $(FMFLAG)$(MLDINCDIR) $(PSBLAS_INCLUDES) $(FIFLAG). +AMGDIR=../.. +AMGINCDIR=$(AMGDIR)/include +include $(AMGINCDIR)/Make.inc.amg4psblas +AMGMODDIR=$(AMGDIR)/modules +AMGLIBDIR=$(AMGDIR)/lib +AMG_LIBS=-L$(AMGLIBDIR) -lpsb_krylov -lamg_prec -lpsb_prec +FINCLUDES=$(FMFLAG). $(FMFLAG)$(AMGMODDIR) $(FMFLAG)$(AMGINCDIR) $(PSBLAS_INCLUDES) $(FIFLAG). -DFSOBJS=mld_df_sample.o data_input.o -SFSOBJS=mld_sf_sample.o data_input.o -CFSOBJS=mld_cf_sample.o data_input.o -ZFSOBJS=mld_zf_sample.o data_input.o +DFSOBJS=amg_df_sample.o data_input.o +SFSOBJS=amg_sf_sample.o data_input.o +CFSOBJS=amg_cf_sample.o data_input.o +ZFSOBJS=amg_zf_sample.o data_input.o LINKOPT= EXEDIR=./runs -all: mld_sf_sample mld_df_sample mld_cf_sample mld_zf_sample +all: amg_sf_sample amg_df_sample amg_cf_sample amg_zf_sample -mld_df_sample: $(DFSOBJS) - $(FLINK) $(LINKOPT) $(DFSOBJS) -o mld_df_sample \ - $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) - /bin/mv mld_df_sample $(EXEDIR) +amg_df_sample: $(DFSOBJS) + $(FLINK) $(LINKOPT) $(DFSOBJS) -o amg_df_sample \ + $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) + /bin/mv amg_df_sample $(EXEDIR) -mld_sf_sample: $(SFSOBJS) - $(FLINK) $(LINKOPT) $(SFSOBJS) -o mld_sf_sample \ - $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) - /bin/mv mld_sf_sample $(EXEDIR) +amg_sf_sample: $(SFSOBJS) + $(FLINK) $(LINKOPT) $(SFSOBJS) -o amg_sf_sample \ + $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) + /bin/mv amg_sf_sample $(EXEDIR) -mld_cf_sample: $(CFSOBJS) - $(FLINK) $(LINKOPT) $(CFSOBJS) -o mld_cf_sample \ - $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) - /bin/mv mld_cf_sample $(EXEDIR) +amg_cf_sample: $(CFSOBJS) + $(FLINK) $(LINKOPT) $(CFSOBJS) -o amg_cf_sample \ + $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) + /bin/mv amg_cf_sample $(EXEDIR) -mld_zf_sample: $(ZFSOBJS) - $(FLINK) $(LINKOPT) $(ZFSOBJS) -o mld_zf_sample \ - $(MLD_LIBS) $(PSBLAS_LIBS) $(LDLIBS) - /bin/mv mld_zf_sample $(EXEDIR) +amg_zf_sample: $(ZFSOBJS) + $(FLINK) $(LINKOPT) $(ZFSOBJS) -o amg_zf_sample \ + $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) + /bin/mv amg_zf_sample $(EXEDIR) -mld_sf_sample.o: data_input.o -mld_df_sample.o: data_input.o -mld_cf_sample.o: data_input.o -mld_zf_sample.o: data_input.o +amg_sf_sample.o: data_input.o +amg_df_sample.o: data_input.o +amg_cf_sample.o: data_input.o +amg_zf_sample.o: data_input.o clean: /bin/rm -f $(DFSOBJS) $(ZFSOBJS) $(SFSOBJS) $(CFSOBJS) \ - *$(.mod) $(EXEDIR)/mld_sf_sample $(EXEDIR)/mld_cf_sample \ - $(EXEDIR)/mld_df_sample $(EXEDIR)/mld_zf_sample + *$(.mod) $(EXEDIR)/amg_sf_sample $(EXEDIR)/amg_cf_sample \ + $(EXEDIR)/amg_df_sample $(EXEDIR)/amg_zf_sample lib: (cd ../../; make library) diff --git a/tests/fileread/amg_cf_sample.f90 b/tests/fileread/amg_cf_sample.f90 index 24c47662..3103b127 100644 --- a/tests/fileread/amg_cf_sample.f90 +++ b/tests/fileread/amg_cf_sample.f90 @@ -121,7 +121,8 @@ program amg_cf_sample type(precdata) :: p_choice ! sparse matrices - type(psb_cspmat_type) :: a, aux_a + type(psb_cspmat_type) :: a + type(psb_lcspmat_type) :: aux_a ! preconditioner data type(amg_cprec_type) :: prec @@ -135,8 +136,8 @@ program amg_cf_sample type(psb_desc_type):: desc_a type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: iam, np - + integer(psb_ipk_) :: iam, np + integer(psb_lpk_) :: lnp ! solver paramters integer(psb_ipk_) :: iter, ircode, nlv integer(psb_epk_) :: amatsize, precsize, descsize @@ -149,11 +150,12 @@ program amg_cf_sample ! other variables integer(psb_ipk_) :: i, info, j, k, m_problem - integer(psb_ipk_) :: lbw, ubw, prf + integer(psb_lpk_) :: lbw, ubw, prf real(psb_dpk_) :: t1, t2, tprec, thier, tslv real(psb_spk_) :: resmx, resmxp, xdiffn2, xdiffni, xni, xn2 integer(psb_ipk_) :: nrhs, nv - integer(psb_ipk_), allocatable :: ivg(:), ipv(:), perm(:) + integer(psb_ipk_), allocatable :: ivg(:), ipv(:) + integer(psb_lpk_), allocatable :: perm(:) logical :: have_guess=.false., have_ref=.false. call psb_init(ctxt) @@ -324,7 +326,11 @@ program amg_cf_sample if (iam == psb_root_) then write(psb_out_unit,'("Partition type: graph")') write(psb_out_unit,'(" ")') - call build_mtpart(aux_a,np) + ! write(psb_err_unit,'("Build type: graph")') + call aux_a%cscnv(info,type='csr') + lnp = np + call build_mtpart(aux_a,lnp) + endif call distr_mtpart(psb_root_,ctxt) call getv_mtpart(ivg) diff --git a/tests/fileread/amg_df_sample.f90 b/tests/fileread/amg_df_sample.f90 index cd6e0d46..9306bb78 100644 --- a/tests/fileread/amg_df_sample.f90 +++ b/tests/fileread/amg_df_sample.f90 @@ -121,7 +121,8 @@ program amg_df_sample type(precdata) :: p_choice ! sparse matrices - type(psb_dspmat_type) :: a, aux_a + type(psb_dspmat_type) :: a + type(psb_ldspmat_type) :: aux_a ! preconditioner data type(amg_dprec_type) :: prec @@ -135,8 +136,8 @@ program amg_df_sample type(psb_desc_type):: desc_a type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: iam, np - + integer(psb_ipk_) :: iam, np + integer(psb_lpk_) :: lnp ! solver paramters integer(psb_ipk_) :: iter, ircode, nlv integer(psb_epk_) :: amatsize, precsize, descsize @@ -149,11 +150,12 @@ program amg_df_sample ! other variables integer(psb_ipk_) :: i, info, j, k, m_problem - integer(psb_ipk_) :: lbw, ubw, prf + integer(psb_lpk_) :: lbw, ubw, prf real(psb_dpk_) :: t1, t2, tprec, thier, tslv real(psb_dpk_) :: resmx, resmxp, xdiffn2, xdiffni, xni, xn2 integer(psb_ipk_) :: nrhs, nv - integer(psb_ipk_), allocatable :: ivg(:), ipv(:), perm(:) + integer(psb_ipk_), allocatable :: ivg(:), ipv(:) + integer(psb_lpk_), allocatable :: perm(:) logical :: have_guess=.false., have_ref=.false. call psb_init(ctxt) @@ -324,7 +326,11 @@ program amg_df_sample if (iam == psb_root_) then write(psb_out_unit,'("Partition type: graph")') write(psb_out_unit,'(" ")') - call build_mtpart(aux_a,np) + ! write(psb_err_unit,'("Build type: graph")') + call aux_a%cscnv(info,type='csr') + lnp = np + call build_mtpart(aux_a,lnp) + endif call distr_mtpart(psb_root_,ctxt) call getv_mtpart(ivg) diff --git a/tests/fileread/amg_sf_sample.f90 b/tests/fileread/amg_sf_sample.f90 index a6d02565..996617b6 100644 --- a/tests/fileread/amg_sf_sample.f90 +++ b/tests/fileread/amg_sf_sample.f90 @@ -121,7 +121,8 @@ program amg_sf_sample type(precdata) :: p_choice ! sparse matrices - type(psb_sspmat_type) :: a, aux_a + type(psb_sspmat_type) :: a + type(psb_lsspmat_type) :: aux_a ! preconditioner data type(amg_sprec_type) :: prec @@ -135,8 +136,8 @@ program amg_sf_sample type(psb_desc_type):: desc_a type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: iam, np - + integer(psb_ipk_) :: iam, np + integer(psb_lpk_) :: lnp ! solver paramters integer(psb_ipk_) :: iter, ircode, nlv integer(psb_epk_) :: amatsize, precsize, descsize @@ -149,11 +150,12 @@ program amg_sf_sample ! other variables integer(psb_ipk_) :: i, info, j, k, m_problem - integer(psb_ipk_) :: lbw, ubw, prf + integer(psb_lpk_) :: lbw, ubw, prf real(psb_dpk_) :: t1, t2, tprec, thier, tslv real(psb_spk_) :: resmx, resmxp, xdiffn2, xdiffni, xni, xn2 integer(psb_ipk_) :: nrhs, nv - integer(psb_ipk_), allocatable :: ivg(:), ipv(:), perm(:) + integer(psb_ipk_), allocatable :: ivg(:), ipv(:) + integer(psb_lpk_), allocatable :: perm(:) logical :: have_guess=.false., have_ref=.false. call psb_init(ctxt) @@ -324,7 +326,11 @@ program amg_sf_sample if (iam == psb_root_) then write(psb_out_unit,'("Partition type: graph")') write(psb_out_unit,'(" ")') - call build_mtpart(aux_a,np) + ! write(psb_err_unit,'("Build type: graph")') + call aux_a%cscnv(info,type='csr') + lnp = np + call build_mtpart(aux_a,lnp) + endif call distr_mtpart(psb_root_,ctxt) call getv_mtpart(ivg) diff --git a/tests/fileread/amg_zf_sample.f90 b/tests/fileread/amg_zf_sample.f90 index 61cf9c72..612f6db5 100644 --- a/tests/fileread/amg_zf_sample.f90 +++ b/tests/fileread/amg_zf_sample.f90 @@ -121,7 +121,8 @@ program amg_zf_sample type(precdata) :: p_choice ! sparse matrices - type(psb_zspmat_type) :: a, aux_a + type(psb_zspmat_type) :: a + type(psb_lzspmat_type) :: aux_a ! preconditioner data type(amg_zprec_type) :: prec @@ -135,8 +136,8 @@ program amg_zf_sample type(psb_desc_type):: desc_a type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: iam, np - + integer(psb_ipk_) :: iam, np + integer(psb_lpk_) :: lnp ! solver paramters integer(psb_ipk_) :: iter, ircode, nlv integer(psb_epk_) :: amatsize, precsize, descsize @@ -149,11 +150,12 @@ program amg_zf_sample ! other variables integer(psb_ipk_) :: i, info, j, k, m_problem - integer(psb_ipk_) :: lbw, ubw, prf + integer(psb_lpk_) :: lbw, ubw, prf real(psb_dpk_) :: t1, t2, tprec, thier, tslv real(psb_dpk_) :: resmx, resmxp, xdiffn2, xdiffni, xni, xn2 integer(psb_ipk_) :: nrhs, nv - integer(psb_ipk_), allocatable :: ivg(:), ipv(:), perm(:) + integer(psb_ipk_), allocatable :: ivg(:), ipv(:) + integer(psb_lpk_), allocatable :: perm(:) logical :: have_guess=.false., have_ref=.false. call psb_init(ctxt) @@ -324,7 +326,11 @@ program amg_zf_sample if (iam == psb_root_) then write(psb_out_unit,'("Partition type: graph")') write(psb_out_unit,'(" ")') - call build_mtpart(aux_a,np) + ! write(psb_err_unit,'("Build type: graph")') + call aux_a%cscnv(info,type='csr') + lnp = np + call build_mtpart(aux_a,lnp) + endif call distr_mtpart(psb_root_,ctxt) call getv_mtpart(ivg) diff --git a/tests/fileread/runs/mld_cfs.inp b/tests/fileread/runs/amg_cfs.inp similarity index 100% rename from tests/fileread/runs/mld_cfs.inp rename to tests/fileread/runs/amg_cfs.inp diff --git a/tests/fileread/runs/mld_dfs.inp b/tests/fileread/runs/amg_dfs.inp similarity index 100% rename from tests/fileread/runs/mld_dfs.inp rename to tests/fileread/runs/amg_dfs.inp diff --git a/tests/fileread/runs/mld_mat.mtx b/tests/fileread/runs/amg_mat.mtx similarity index 100% rename from tests/fileread/runs/mld_mat.mtx rename to tests/fileread/runs/amg_mat.mtx diff --git a/tests/fileread/runs/mld_rhs.mtx b/tests/fileread/runs/amg_rhs.mtx similarity index 100% rename from tests/fileread/runs/mld_rhs.mtx rename to tests/fileread/runs/amg_rhs.mtx diff --git a/tests/fileread/runs/mld_sfs.inp b/tests/fileread/runs/amg_sfs.inp similarity index 100% rename from tests/fileread/runs/mld_sfs.inp rename to tests/fileread/runs/amg_sfs.inp diff --git a/tests/fileread/runs/mld_sol.mtx b/tests/fileread/runs/amg_sol.mtx similarity index 100% rename from tests/fileread/runs/mld_sol.mtx rename to tests/fileread/runs/amg_sol.mtx diff --git a/tests/fileread/runs/mld_zfs.inp b/tests/fileread/runs/amg_zfs.inp similarity index 100% rename from tests/fileread/runs/mld_zfs.inp rename to tests/fileread/runs/amg_zfs.inp diff --git a/tests/pdegen/Makefile b/tests/pdegen/Makefile index 6e90a96a..5e12f775 100644 --- a/tests/pdegen/Makefile +++ b/tests/pdegen/Makefile @@ -9,42 +9,44 @@ FINCLUDES=$(FMFLAG). $(FMFLAG)$(AMGMODDIR) $(FMFLAG)$(AMGINCDIR) $(PSBLAS_INCLUD LINKOPT= EXEDIR=./runs -all: amg_s_pde3d amg_d_pde3d amg_s_pde2d amg_d_pde2d +all: amg_s_pde3d amg_d_pde3d amg_s_pde2d amg_d_pde2d -amg_d_pde3d: amg_d_pde3d.o data_input.o - $(FLINK) $(LINKOPT) amg_d_pde3d.o data_input.o -o amg_d_pde3d $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) +amg_d_pde3d: amg_d_pde3d.o amg_d_genpde_mod.o amg_d_pde3d_base_mod.o amg_d_pde3d_exp_mod.o amg_d_pde3d_gauss_mod.o data_input.o + $(FLINK) $(LINKOPT) amg_d_pde3d.o amg_d_genpde_mod.o amg_d_pde3d_base_mod.o amg_d_pde3d_exp_mod.o amg_d_pde3d_gauss_mod.o data_input.o -o amg_d_pde3d $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) /bin/mv amg_d_pde3d $(EXEDIR) -amg_s_pde3d: amg_s_pde3d.o data_input.o - $(FLINK) $(LINKOPT) amg_s_pde3d.o data_input.o -o amg_s_pde3d $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) +amg_s_pde3d: amg_s_pde3d.o amg_s_genpde_mod.o amg_s_pde3d_base_mod.o amg_s_pde3d_exp_mod.o amg_s_pde3d_gauss_mod.o data_input.o + $(FLINK) $(LINKOPT) amg_s_pde3d.o amg_s_genpde_mod.o amg_s_pde3d_base_mod.o amg_s_pde3d_exp_mod.o amg_s_pde3d_gauss_mod.o data_input.o -o amg_s_pde3d $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) /bin/mv amg_s_pde3d $(EXEDIR) -amg_d_pde2d: amg_d_pde2d.o data_input.o - $(FLINK) $(LINKOPT) amg_d_pde2d.o data_input.o -o amg_d_pde2d $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) +amg_d_pde2d: amg_d_pde2d.o amg_d_genpde_mod.o amg_d_pde2d_base_mod.o amg_d_pde2d_exp_mod.o amg_d_pde2d_box_mod.o data_input.o + $(FLINK) $(LINKOPT) amg_d_pde2d.o amg_d_genpde_mod.o amg_d_pde2d_base_mod.o amg_d_pde2d_exp_mod.o amg_d_pde2d_box_mod.o data_input.o -o amg_d_pde2d $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) /bin/mv amg_d_pde2d $(EXEDIR) -amg_s_pde2d: amg_s_pde2d.o data_input.o - $(FLINK) $(LINKOPT) amg_s_pde2d.o data_input.o -o amg_s_pde2d $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) +amg_s_pde2d: amg_s_pde2d.o amg_s_genpde_mod.o amg_s_pde2d_base_mod.o amg_s_pde2d_exp_mod.o amg_s_pde2d_box_mod.o data_input.o + $(FLINK) $(LINKOPT) amg_s_pde2d.o amg_s_genpde_mod.o amg_s_pde2d_base_mod.o amg_s_pde2d_exp_mod.o amg_s_pde2d_box_mod.o data_input.o -o amg_s_pde2d $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) /bin/mv amg_s_pde2d $(EXEDIR) amg_d_pde3d_rebld: amg_d_pde3d_rebld.o data_input.o $(FLINK) $(LINKOPT) amg_d_pde3d_rebld.o data_input.o -o amg_d_pde3d_rebld $(AMG_LIBS) $(PSBLAS_LIBS) $(LDLIBS) /bin/mv amg_d_pde3d_rebld $(EXEDIR) -amg_d_pde3d.o amg_s_pde3d.o amg_d_pde2d.o amg_s_pde2d.o: data_input.o +amg_d_pde3d.o amg_s_pde3d.o amg_d_pde2d.o amg_s_pde2d.o: data_input.o + +amg_d_pde3d.o: amg_d_genpde_mod.o amg_d_pde3d_base_mod.o amg_d_pde3d_exp_mod.o amg_d_pde3d_gauss_mod.o +amg_s_pde3d.o: amg_s_genpde_mod.o amg_s_pde3d_base_mod.o amg_s_pde3d_exp_mod.o amg_s_pde3d_gauss_mod.o +amg_d_pde2d.o: amg_d_genpde_mod.o amg_d_pde2d_base_mod.o amg_d_pde2d_exp_mod.o amg_d_pde2d_box_mod.o +amg_s_pde2d.o: amg_s_genpde_mod.o amg_s_pde2d_base_mod.o amg_s_pde2d_exp_mod.o amg_s_pde2d_box_mod.o check: all cd runs && ./amg_d_pde2d f + else + f_ => d_null_func_3d + end if + + if (present(partition)) then + if ((1<= partition).and.(partition <= 3)) then + partition_ = partition + else + write(*,*) 'Invalid partition choice ',partition,' defaulting to 3' + partition_ = 3 + end if + else + partition_ = 3 + end if + deltah = done/(idim+2) + sqdeltah = deltah*deltah + deltah2 = 2.0_psb_dpk_* deltah + + if (present(partition)) then + if ((1<= partition).and.(partition <= 3)) then + partition_ = partition + else + write(*,*) 'Invalid partition choice ',partition,' defaulting to 3' + partition_ = 3 + end if + else + partition_ = 3 + end if + + ! initialize array descriptor and sparse matrix storage. provide an + ! estimate of the number of non zeroes + + m = (1_psb_lpk_*idim)*idim*idim + n = m + nnz = 7*((n+np-1)/np) + if(iam == psb_root_) write(psb_out_unit,'("Generating Matrix (size=",i0,")...")')n + t0 = psb_wtime() + select case(partition_) + case(1) + ! A BLOCK partition + if (present(nrl)) then + nr = nrl + else + ! + ! Using a simple BLOCK distribution. + ! + nt = (m+np-1)/np + nr = max(0,min(nt,m-(iam*nt))) + end if + + nt = nr + call psb_sum(ctxt,nt) + if (nt /= m) then + write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + return + end if + + ! + ! First example of use of CDALL: specify for each process a number of + ! contiguous rows + ! + call psb_cdall(ctxt,desc_a,info,nl=nr) + myidx = desc_a%get_global_indices() + nlr = size(myidx) + + case(2) + ! A partition defined by the user through IV + + if (present(iv)) then + if (size(iv) /= m) then + write(psb_err_unit,*) iam, 'Initialization error: wrong IV size',size(iv),m + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + return + end if + else + write(psb_err_unit,*) iam, 'Initialization error: IV not present' + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + return + end if + + ! + ! Second example of use of CDALL: specify for each row the + ! process that owns it + ! + call psb_cdall(ctxt,desc_a,info,vg=iv) + myidx = desc_a%get_global_indices() + nlr = size(myidx) + + case(3) + ! A 3-dimensional partition + + ! A nifty MPI function will split the process list + npdims = 0 + call mpi_dims_create(np,3,npdims,info) + npx = npdims(1) + npy = npdims(2) + npz = npdims(3) + + allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz)) + ! We can reuse idx2ijk for process indices as well. + call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0) + ! Now let's split the 3D cube in hexahedra + call dist1Didx(bndx,idim,npx) + mynx = bndx(iamx+1)-bndx(iamx) + call dist1Didx(bndy,idim,npy) + myny = bndy(iamy+1)-bndy(iamy) + call dist1Didx(bndz,idim,npz) + mynz = bndz(iamz+1)-bndz(iamz) + + ! How many indices do I own? + nlr = mynx*myny*mynz + allocate(myidx(nlr)) + ! Now, let's generate the list of indices I own + nr = 0 + do i=bndx(iamx),bndx(iamx+1)-1 + do j=bndy(iamy),bndy(iamy+1)-1 + do k=bndz(iamz),bndz(iamz+1)-1 + nr = nr + 1 + call ijk2idx(myidx(nr),i,j,k,idim,idim,idim) + end do + end do + end do + if (nr /= nlr) then + write(psb_err_unit,*) iam,iamx,iamy,iamz, 'Initialization error: NR vs NLR ',& + & nr,nlr,mynx,myny,mynz + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + end if + + ! + ! Third example of use of CDALL: specify for each process + ! the set of global indices it owns. + ! + call psb_cdall(ctxt,desc_a,info,vl=myidx) + + case default + write(psb_err_unit,*) iam, 'Initialization error: should not get here' + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + return + end select + + + if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz) + ! define rhs from boundary conditions; also build initial guess + if (info == psb_success_) call psb_geall(xv,desc_a,info) + if (info == psb_success_) call psb_geall(bv,desc_a,info) + + call psb_barrier(ctxt) + talc = psb_wtime()-t0 + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='allocation rout.' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + ! we build an auxiliary matrix consisting of one row at a + ! time; just a small matrix. might be extended to generate + ! a bunch of rows per call. + ! + allocate(val(20*nb),irow(20*nb),& + &icol(20*nb),stat=info) + if (info /= psb_success_ ) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + + ! loop over rows belonging to current process in a block + ! distribution. + + call psb_barrier(ctxt) + t1 = psb_wtime() + do ii=1, nlr,nb + ib = min(nb,nlr-ii+1) + icoeff = 1 + do k=1,ib + i=ii+k-1 + ! local matrix pointer + glob_row=myidx(i) + ! compute gridpoint coordinates + call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim) + ! x, y, z coordinates + x = (ix-1)*deltah + y = (iy-1)*deltah + z = (iz-1)*deltah + zt(k) = f_(x,y,z) + ! internal point: build discretization + ! + ! term depending on (x-1,y,z) + ! + val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2 + if (ix == 1) then + zt(k) = g(dzero,y,z)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x,y-1,z) + val(icoeff) = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2 + if (iy == 1) then + zt(k) = g(x,dzero,z)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x,y,z-1) + val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2 + if (iz == 1) then + zt(k) = g(x,y,dzero)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + + ! term depending on (x,y,z) + val(icoeff)=(2*done)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah & + & + c(x,y,z) + call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + ! term depending on (x,y,z+1) + val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2 + if (iz == idim) then + zt(k) = g(x,y,done)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x,y+1,z) + val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2 + if (iy == idim) then + zt(k) = g(x,done,z)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x+1,y,z) + val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2 + if (ix==idim) then + zt(k) = g(done,y,z)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + + end do + call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) exit + call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) + if(info /= psb_success_) exit + zt(:)=dzero + call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) + if(info /= psb_success_) exit + end do + + tgen = psb_wtime()-t1 + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='insert rout.' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + deallocate(val,irow,icol) + + call psb_barrier(ctxt) + t1 = psb_wtime() + call psb_cdasb(desc_a,info) + tcdasb = psb_wtime()-t1 + call psb_barrier(ctxt) + t1 = psb_wtime() + if (info == psb_success_) then + if (present(amold)) then + call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold) + else + call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) + end if + end if + call psb_barrier(ctxt) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='asb rout.' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + if (info == psb_success_) call psb_geasb(xv,desc_a,info,mold=vmold) + if (info == psb_success_) call psb_geasb(bv,desc_a,info,mold=vmold) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='asb rout.' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + tasb = psb_wtime()-t1 + call psb_barrier(ctxt) + ttot = psb_wtime() - t0 + + call psb_amx(ctxt,talc) + call psb_amx(ctxt,tgen) + call psb_amx(ctxt,tasb) + call psb_amx(ctxt,ttot) + if(iam == psb_root_) then + tmpfmt = a%get_fmt() + write(psb_out_unit,'("The matrix has been generated and assembled in ",a3," format.")')& + & tmpfmt + write(psb_out_unit,'("-allocation time : ",es12.5)') talc + write(psb_out_unit,'("-coeff. gen. time : ",es12.5)') tgen + write(psb_out_unit,'("-desc asbly time : ",es12.5)') tcdasb + write(psb_out_unit,'("- mat asbly time : ",es12.5)') tasb + write(psb_out_unit,'("-total time : ",es12.5)') ttot + + 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(ctxt) + return + end if + return + end subroutine amg_d_gen_pde3d + + + + ! + ! subroutine to allocate and fill in the coefficient matrix and + ! the rhs. + ! + subroutine amg_d_gen_pde2d(ctxt,idim,a,bv,xv,desc_a,afmt,& + & a1,a2,b1,b2,c,g,info,f,amold,vmold,partition, nrl,iv) + use psb_base_mod + use psb_util_mod + ! + ! Discretizes the partial differential equation + ! + ! d d(u) d d(u) b1 d(u) b2 d(u) + ! - -- a1 ---- - -- a1 ---- + ----- + ------ + c u = f + ! dx dx dy dy dx dy + ! + ! with Dirichlet boundary conditions + ! u = g + ! + ! on the unit square 0<=x,y<=1. + ! + ! + ! Note that if b1=b2=c=0., the PDE is the Laplace equation. + ! + implicit none + procedure(d_func_2d) :: b1,b2,c,a1,a2,g + integer(psb_ipk_) :: idim + type(psb_dspmat_type) :: a + type(psb_d_vect_type) :: xv,bv + type(psb_desc_type) :: desc_a + integer(psb_ipk_) :: info + type(psb_ctxt_type) :: ctxt + character :: afmt*5 + procedure(d_func_2d), optional :: f + class(psb_d_base_sparse_mat), optional :: amold + class(psb_d_base_vect_type), optional :: vmold + integer(psb_ipk_), optional :: partition, nrl,iv(:) + ! Local variables. + + integer(psb_ipk_), parameter :: nb=20 + type(psb_d_csc_sparse_mat) :: acsc + type(psb_d_coo_sparse_mat) :: acoo + type(psb_d_csr_sparse_mat) :: acsr + real(psb_dpk_) :: zt(nb),x,y,z,xph,xmh,yph,ymh,zph,zmh + integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_ + integer(psb_lpk_) :: m,n,glob_row,nt + integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner + ! For 2D partition + ! Note: integer control variables going directly into an MPI call + ! must be 4 bytes, i.e. psb_mpk_ + integer(psb_mpk_) :: npdims(2), npp, minfo + integer(psb_ipk_) :: npx,npy,iamx,iamy,mynx,myny + integer(psb_ipk_), allocatable :: bndx(:),bndy(:) + ! Process grid + integer(psb_ipk_) :: np, iam + integer(psb_ipk_) :: icoeff + integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:) + real(psb_dpk_), allocatable :: val(:) + ! deltah dimension of each grid cell + ! deltat discretization time + real(psb_dpk_) :: deltah, sqdeltah, deltah2, dd + real(psb_dpk_), parameter :: rhs=0.d0,one=done,zero=0.d0 + real(psb_dpk_) :: t0, t1, t2, t3, tasb, talc, ttot, tgen, tcdasb + integer(psb_ipk_) :: err_act + procedure(d_func_2d), pointer :: f_ + character(len=20) :: name, ch_err,tmpfmt + + info = psb_success_ + name = 'create_matrix' + call psb_erractionsave(err_act) + + call psb_info(ctxt, iam, np) + + + if (present(f)) then + f_ => f + else + f_ => d_null_func_2d + end if + + deltah = done/(idim+2) + sqdeltah = deltah*deltah + deltah2 = 2.0_psb_dpk_* deltah + + + if (present(partition)) then + if ((1<= partition).and.(partition <= 3)) then + partition_ = partition + else + write(*,*) 'Invalid partition choice ',partition,' defaulting to 3' + partition_ = 3 + end if + else + partition_ = 3 + end if + + ! initialize array descriptor and sparse matrix storage. provide an + ! estimate of the number of non zeroes + + m = (1_psb_lpk_)*idim*idim + n = m + nnz = 7*((n+np-1)/np) + if(iam == psb_root_) write(psb_out_unit,'("Generating Matrix (size=",i0,")...")')n + t0 = psb_wtime() + select case(partition_) + case(1) + ! A BLOCK partition + if (present(nrl)) then + nr = nrl + else + ! + ! Using a simple BLOCK distribution. + ! + nt = (m+np-1)/np + nr = max(0,min(nt,m-(iam*nt))) + end if + + nt = nr + call psb_sum(ctxt,nt) + if (nt /= m) then + write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + return + end if + + ! + ! First example of use of CDALL: specify for each process a number of + ! contiguous rows + ! + call psb_cdall(ctxt,desc_a,info,nl=nr) + myidx = desc_a%get_global_indices() + nlr = size(myidx) + + case(2) + ! A partition defined by the user through IV + + if (present(iv)) then + if (size(iv) /= m) then + write(psb_err_unit,*) iam, 'Initialization error: wrong IV size',size(iv),m + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + return + end if + else + write(psb_err_unit,*) iam, 'Initialization error: IV not present' + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + return + end if + + ! + ! Second example of use of CDALL: specify for each row the + ! process that owns it + ! + call psb_cdall(ctxt,desc_a,info,vg=iv) + myidx = desc_a%get_global_indices() + nlr = size(myidx) + + case(3) + ! A 2-dimensional partition + + ! A nifty MPI function will split the process list + npdims = 0 + call mpi_dims_create(np,2,npdims,info) + npx = npdims(1) + npy = npdims(2) + + allocate(bndx(0:npx),bndy(0:npy)) + ! We can reuse idx2ijk for process indices as well. + call idx2ijk(iamx,iamy,iam,npx,npy,base=0) + ! Now let's split the 2D square in rectangles + call dist1Didx(bndx,idim,npx) + mynx = bndx(iamx+1)-bndx(iamx) + call dist1Didx(bndy,idim,npy) + myny = bndy(iamy+1)-bndy(iamy) + + ! How many indices do I own? + nlr = mynx*myny + allocate(myidx(nlr)) + ! Now, let's generate the list of indices I own + nr = 0 + do i=bndx(iamx),bndx(iamx+1)-1 + do j=bndy(iamy),bndy(iamy+1)-1 + nr = nr + 1 + call ijk2idx(myidx(nr),i,j,idim,idim) + end do + end do + if (nr /= nlr) then + write(psb_err_unit,*) iam,iamx,iamy, 'Initialization error: NR vs NLR ',& + & nr,nlr,mynx,myny + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + end if + + ! + ! Third example of use of CDALL: specify for each process + ! the set of global indices it owns. + ! + call psb_cdall(ctxt,desc_a,info,vl=myidx) + + case default + write(psb_err_unit,*) iam, 'Initialization error: should not get here' + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + return + end select + + + if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz) + ! define rhs from boundary conditions; also build initial guess + if (info == psb_success_) call psb_geall(xv,desc_a,info) + if (info == psb_success_) call psb_geall(bv,desc_a,info) + + call psb_barrier(ctxt) + talc = psb_wtime()-t0 + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='allocation rout.' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + ! we build an auxiliary matrix consisting of one row at a + ! time; just a small matrix. might be extended to generate + ! a bunch of rows per call. + ! + allocate(val(20*nb),irow(20*nb),& + &icol(20*nb),stat=info) + if (info /= psb_success_ ) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + + ! loop over rows belonging to current process in a block + ! distribution. + + call psb_barrier(ctxt) + t1 = psb_wtime() + do ii=1, nlr,nb + ib = min(nb,nlr-ii+1) + icoeff = 1 + do k=1,ib + i=ii+k-1 + ! local matrix pointer + glob_row=myidx(i) + ! compute gridpoint coordinates + call idx2ijk(ix,iy,glob_row,idim,idim) + ! x, y coordinates + x = (ix-1)*deltah + y = (iy-1)*deltah + + zt(k) = f_(x,y) + ! internal point: build discretization + ! + ! term depending on (x-1,y) + ! + val(icoeff) = -a1(x,y)/sqdeltah-b1(x,y)/deltah2 + if (ix == 1) then + zt(k) = g(dzero,y)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix-1,iy,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x,y-1) + val(icoeff) = -a2(x,y)/sqdeltah-b2(x,y)/deltah2 + if (iy == 1) then + zt(k) = g(x,dzero)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy-1,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + + ! term depending on (x,y) + val(icoeff)=(2*done)*(a1(x,y) + a2(x,y))/sqdeltah + c(x,y) + call ijk2idx(icol(icoeff),ix,iy,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + ! term depending on (x,y+1) + val(icoeff)=-a2(x,y)/sqdeltah+b2(x,y)/deltah2 + if (iy == idim) then + zt(k) = g(x,done)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy+1,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x+1,y) + val(icoeff)=-a1(x,y)/sqdeltah+b1(x,y)/deltah2 + if (ix==idim) then + zt(k) = g(done,y)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix+1,iy,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + + end do + call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) exit + call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) + if(info /= psb_success_) exit + zt(:)=dzero + call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) + if(info /= psb_success_) exit + end do + + tgen = psb_wtime()-t1 + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='insert rout.' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + deallocate(val,irow,icol) + + call psb_barrier(ctxt) + t1 = psb_wtime() + call psb_cdasb(desc_a,info) + tcdasb = psb_wtime()-t1 + call psb_barrier(ctxt) + t1 = psb_wtime() + if (info == psb_success_) then + if (present(amold)) then + call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold) + else + call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) + end if + end if + call psb_barrier(ctxt) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='asb rout.' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + if (info == psb_success_) call psb_geasb(xv,desc_a,info,mold=vmold) + if (info == psb_success_) call psb_geasb(bv,desc_a,info,mold=vmold) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='asb rout.' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + tasb = psb_wtime()-t1 + call psb_barrier(ctxt) + ttot = psb_wtime() - t0 + + call psb_amx(ctxt,talc) + call psb_amx(ctxt,tgen) + call psb_amx(ctxt,tasb) + call psb_amx(ctxt,ttot) + if(iam == psb_root_) then + tmpfmt = a%get_fmt() + write(psb_out_unit,'("The matrix has been generated and assembled in ",a3," format.")')& + & tmpfmt + write(psb_out_unit,'("-allocation time : ",es12.5)') talc + write(psb_out_unit,'("-coeff. gen. time : ",es12.5)') tgen + write(psb_out_unit,'("-desc asbly time : ",es12.5)') tcdasb + write(psb_out_unit,'("- mat asbly time : ",es12.5)') tasb + write(psb_out_unit,'("-total time : ",es12.5)') ttot + + 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(ctxt) + return + end if + return + end subroutine amg_d_gen_pde2d +end module amg_d_genpde_mod diff --git a/tests/pdegen/amg_d_pde2d.f90 b/tests/pdegen/amg_d_pde2d.f90 index 524c55ab..71630e5b 100644 --- a/tests/pdegen/amg_d_pde2d.f90 +++ b/tests/pdegen/amg_d_pde2d.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! AMG4PSBLAS version 1.0 ! Algebraic Multigrid Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2020 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante -! +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the AMG4PSBLAS 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 @@ -33,23 +33,23 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! ! File: amg_d_pde2d.f90 ! ! Program: amg_d_pde2d ! This sample program solves a linear system obtained by discretizing a -! PDE with Dirichlet BCs. -! +! PDE with Dirichlet BCs. +! ! ! The PDE is a general second order equation in 2d ! -! a1 dd(u) a2 dd(u) b1 d(u) b2 d(u) +! a1 dd(u) a2 dd(u) b1 d(u) b2 d(u) ! - ------ - ------ ----- + ------ + c u = f -! dxdx dydy dx dy +! dxdx dydy dx dy ! ! with Dirichlet boundary conditions -! u = g +! u = g ! ! on the unit square 0<=x,y<=1. ! @@ -63,495 +63,27 @@ ! 3. A 2D distribution in which the unit square is partitioned ! into rectangles, each one assigned to a process. ! -module amg_d_pde2d_mod - use psb_base_mod, only : psb_dpk_, psb_ipk_, psb_desc_type,& - & psb_dspmat_type, psb_d_vect_type, dzero,& - & psb_d_base_sparse_mat, psb_d_base_vect_type, psb_i_base_vect_type - - interface - function d_func_2d(x,y) result(val) - import :: psb_dpk_ - real(psb_dpk_), intent(in) :: x,y - real(psb_dpk_) :: val - end function d_func_2d - end interface - - interface amg_gen_pde2d - module procedure amg_d_gen_pde2d - end interface amg_gen_pde2d -contains - - function d_null_func_2d(x,y) result(val) - - real(psb_dpk_), intent(in) :: x,y - real(psb_dpk_) :: val - - val = dzero - - end function d_null_func_2d - - ! - ! functions parametrizing the differential equation - ! - - ! - ! Note: b1 and b2 are the coefficients of the first - ! derivative of the unknown function. The default - ! we apply here is to have them zero, so that the resulting - ! matrix is symmetric/hermitian and suitable for - ! testing with CG and FCG. - ! When testing methods for non-hermitian matrices you can - ! change the B1/B2 functions to e.g. done/sqrt((2*done)) - ! - function b1(x,y) - use psb_base_mod, only : psb_dpk_, done, dzero - implicit none - real(psb_dpk_) :: b1 - real(psb_dpk_), intent(in) :: x,y - b1=dzero - end function b1 - function b2(x,y) - use psb_base_mod, only : psb_dpk_, done, dzero - implicit none - real(psb_dpk_) :: b2 - real(psb_dpk_), intent(in) :: x,y - b2=dzero - end function b2 - function c(x,y) - use psb_base_mod, only : psb_dpk_, done, dzero - implicit none - real(psb_dpk_) :: c - real(psb_dpk_), intent(in) :: x,y - c=0.d0 - end function c - function a1(x,y) - use psb_base_mod, only : psb_dpk_, done, dzero - implicit none - real(psb_dpk_) :: a1 - real(psb_dpk_), intent(in) :: x,y - a1=done/80 - end function a1 - function a2(x,y) - use psb_base_mod, only : psb_dpk_, done, dzero - implicit none - real(psb_dpk_) :: a2 - real(psb_dpk_), intent(in) :: x,y - a2=done/80 - end function a2 - function g(x,y) - use psb_base_mod, only : psb_dpk_, done, dzero - implicit none - real(psb_dpk_) :: g - real(psb_dpk_), intent(in) :: x,y - g = dzero - if (x == done) then - g = done - else if (x == dzero) then - g = exp(-y**2) - end if - end function g - - - ! - ! subroutine to allocate and fill in the coefficient matrix and - ! the rhs. - ! - subroutine amg_d_gen_pde2d(ctxt,idim,a,bv,xv,desc_a,afmt,info,& - & f,amold,vmold,imold,partition,nrl,iv) - use psb_base_mod - use psb_util_mod - ! - ! Discretizes the partial differential equation - ! - ! a1 dd(u) a2 dd(u) b1 d(u) b2 d(u) - ! - ------ - ------ + ----- + ------ + c u = f - ! dxdx dydy dx dy - ! - ! with Dirichlet boundary conditions - ! u = g - ! - ! on the unit square 0<=x,y<=1. - ! - ! - ! Note that if b1=b2=c=0., the PDE is the Laplace equation. - ! - implicit none - integer(psb_ipk_) :: idim - type(psb_dspmat_type) :: a - type(psb_d_vect_type) :: xv,bv - type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: info - character(len=*) :: afmt - procedure(d_func_2d), optional :: f - class(psb_d_base_sparse_mat), optional :: amold - class(psb_d_base_vect_type), optional :: vmold - class(psb_i_base_vect_type), optional :: imold - integer(psb_ipk_), optional :: partition, nrl,iv(:) - - ! Local variables. - - integer(psb_ipk_), parameter :: nb=20 - type(psb_d_csc_sparse_mat) :: acsc - type(psb_d_coo_sparse_mat) :: acoo - type(psb_d_csr_sparse_mat) :: acsr - real(psb_dpk_) :: zt(nb),x,y,z - integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_ - integer(psb_lpk_) :: m,n,glob_row,nt - integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner - ! For 2D partition - ! Note: integer control variables going directly into an MPI call - ! must be 4 bytes, i.e. psb_mpk_ - integer(psb_mpk_) :: npdims(2), npp, minfo - integer(psb_ipk_) :: npx,npy,iamx,iamy,mynx,myny - integer(psb_ipk_), allocatable :: bndx(:),bndy(:) - ! Process grid - integer(psb_ipk_) :: np, iam - integer(psb_ipk_) :: icoeff - integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:) - real(psb_dpk_), allocatable :: val(:) - ! deltah dimension of each grid cell - ! deltat discretization time - real(psb_dpk_) :: deltah, sqdeltah, deltah2 - real(psb_dpk_), parameter :: rhs=dzero,one=done,zero=dzero - real(psb_dpk_) :: t0, t1, t2, t3, tasb, talc, ttot, tgen, tcdasb - integer(psb_ipk_) :: err_act - procedure(d_func_2d), pointer :: f_ - character(len=20) :: name, ch_err,tmpfmt - - info = psb_success_ - name = 'create_matrix' - call psb_erractionsave(err_act) - - call psb_info(ctxt, iam, np) - - - if (present(f)) then - f_ => f - else - f_ => d_null_func_2d - end if - - deltah = done/(idim+1) - sqdeltah = deltah*deltah - deltah2 = (2*done)* deltah - - if (present(partition)) then - if ((1<= partition).and.(partition <= 3)) then - partition_ = partition - else - write(*,*) 'Invalid partition choice ',partition,' defaulting to 3' - partition_ = 3 - end if - else - partition_ = 3 - end if - - ! initialize array descriptor and sparse matrix storage. provide an - ! estimate of the number of non zeroes - - m = (1_psb_lpk_)*idim*idim - n = m - nnz = 7*((n+np-1)/np) - if (iam == psb_root_) write(psb_out_unit,'("Generating Matrix (size=",i0,")...")')n - t0 = psb_wtime() - select case(partition_) - case(1) - ! A BLOCK partition - if (present(nrl)) then - nr = nrl - else - ! - ! Using a simple BLOCK distribution. - ! - nt = (m+np-1)/np - nr = max(0,min(nt,m-(iam*nt))) - end if - - nt = nr - call psb_sum(ctxt,nt) - if (nt /= m) then - write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - return - end if - - ! - ! First example of use of CDALL: specify for each process a number of - ! contiguous rows - ! - call psb_cdall(ctxt,desc_a,info,nl=nr) - myidx = desc_a%get_global_indices() - nlr = size(myidx) - - case(2) - ! A partition defined by the user through IV - - if (present(iv)) then - if (size(iv) /= m) then - write(psb_err_unit,*) iam, 'Initialization error: wrong IV size',size(iv),m - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - return - end if - else - write(psb_err_unit,*) iam, 'Initialization error: IV not present' - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - return - end if - - ! - ! Second example of use of CDALL: specify for each row the - ! process that owns it - ! - call psb_cdall(ctxt,desc_a,info,vg=iv) - myidx = desc_a%get_global_indices() - nlr = size(myidx) - - case(3) - ! A 2-dimensional partition - - ! A nifty MPI function will split the process list - npdims = 0 - call mpi_dims_create(np,2,npdims,info) - npx = npdims(1) - npy = npdims(2) - - allocate(bndx(0:npx),bndy(0:npy)) - ! We can reuse idx2ijk for process indices as well. - call idx2ijk(iamx,iamy,iam,npx,npy,base=0) - ! Now let's split the 2D square in rectangles - call dist1Didx(bndx,idim,npx) - mynx = bndx(iamx+1)-bndx(iamx) - call dist1Didx(bndy,idim,npy) - myny = bndy(iamy+1)-bndy(iamy) - - ! How many indices do I own? - nlr = mynx*myny - allocate(myidx(nlr)) - ! Now, let's generate the list of indices I own - nr = 0 - do i=bndx(iamx),bndx(iamx+1)-1 - do j=bndy(iamy),bndy(iamy+1)-1 - nr = nr + 1 - call ijk2idx(myidx(nr),i,j,idim,idim) - end do - end do - if (nr /= nlr) then - write(psb_err_unit,*) iam,iamx,iamy, 'Initialization error: NR vs NLR ',& - & nr,nlr,mynx,myny - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - end if - - ! - ! Third example of use of CDALL: specify for each process - ! the set of global indices it owns. - ! - call psb_cdall(ctxt,desc_a,info,vl=myidx) - - case default - write(psb_err_unit,*) iam, 'Initialization error: should not get here' - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - return - end select - - - if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz) - ! define rhs from boundary conditions; also build initial guess - if (info == psb_success_) call psb_geall(xv,desc_a,info) - if (info == psb_success_) call psb_geall(bv,desc_a,info) - - call psb_barrier(ctxt) - talc = psb_wtime()-t0 - - if (info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='allocation rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - ! we build an auxiliary matrix consisting of one row at a - ! time; just a small matrix. might be extended to generate - ! a bunch of rows per call. - ! - allocate(val(20*nb),irow(20*nb),& - &icol(20*nb),stat=info) - if (info /= psb_success_ ) then - info=psb_err_alloc_dealloc_ - call psb_errpush(info,name) - goto 9999 - endif - - - ! loop over rows belonging to current process in a block - ! distribution. - - call psb_barrier(ctxt) - t1 = psb_wtime() - do ii=1, nlr,nb - ib = min(nb,nlr-ii+1) - icoeff = 1 - do k=1,ib - i=ii+k-1 - ! local matrix pointer - glob_row=myidx(i) - ! compute gridpoint coordinates - call idx2ijk(ix,iy,glob_row,idim,idim) - ! x, y coordinates - x = (ix-1)*deltah - y = (iy-1)*deltah - - zt(k) = f_(x,y) - ! internal point: build discretization - ! - ! term depending on (x-1,y) - ! - val(icoeff) = -a1(x,y)/sqdeltah-b1(x,y)/deltah2 - if (ix == 1) then - zt(k) = g(dzero,y)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix-1,iy,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x,y-1) - val(icoeff) = -a2(x,y)/sqdeltah-b2(x,y)/deltah2 - if (iy == 1) then - zt(k) = g(x,dzero)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy-1,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - - ! term depending on (x,y) - val(icoeff)=(2*done)*(a1(x,y) + a2(x,y))/sqdeltah + c(x,y) - call ijk2idx(icol(icoeff),ix,iy,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - ! term depending on (x,y+1) - val(icoeff)=-a2(x,y)/sqdeltah+b2(x,y)/deltah2 - if (iy == idim) then - zt(k) = g(x,done)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy+1,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x+1,y) - val(icoeff)=-a1(x,y)/sqdeltah+b1(x,y)/deltah2 - if (ix==idim) then - zt(k) = g(done,y)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix+1,iy,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - - end do - call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) - if(info /= psb_success_) exit - call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) - if(info /= psb_success_) exit - zt(:)=dzero - call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) - if(info /= psb_success_) exit - end do - - tgen = psb_wtime()-t1 - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='insert rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - deallocate(val,irow,icol) - - call psb_barrier(ctxt) - t1 = psb_wtime() - call psb_cdasb(desc_a,info,mold=imold) - tcdasb = psb_wtime()-t1 - call psb_barrier(ctxt) - t1 = psb_wtime() - if (info == psb_success_) then - if (present(amold)) then - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold) - else - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - end if - end if - call psb_barrier(ctxt) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='asb rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - if (info == psb_success_) call psb_geasb(xv,desc_a,info,mold=vmold) - if (info == psb_success_) call psb_geasb(bv,desc_a,info,mold=vmold) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='asb rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - tasb = psb_wtime()-t1 - call psb_barrier(ctxt) - ttot = psb_wtime() - t0 - - call psb_amx(ctxt,talc) - call psb_amx(ctxt,tgen) - call psb_amx(ctxt,tasb) - call psb_amx(ctxt,ttot) - if(iam == psb_root_) then - tmpfmt = a%get_fmt() - write(psb_out_unit,'("The matrix has been generated and assembled in ",a3," format.")')& - & tmpfmt - write(psb_out_unit,'("-allocation time : ",es12.5)') talc - write(psb_out_unit,'("-coeff. gen. time : ",es12.5)') tgen - write(psb_out_unit,'("-desc asbly time : ",es12.5)') tcdasb - write(psb_out_unit,'("- mat asbly time : ",es12.5)') tasb - write(psb_out_unit,'("-total time : ",es12.5)') ttot - - end if - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ctxt,err_act) - - return - end subroutine amg_d_gen_pde2d - -end module amg_d_pde2d_mod - - program amg_d_pde2d use psb_base_mod use amg_prec_mod use psb_krylov_mod use psb_util_mod use data_input - use amg_d_pde2d_mod + use amg_d_pde2d_base_mod + use amg_d_pde2d_exp_mod + use amg_d_pde2d_box_mod + use amg_d_genpde_mod + use amg_ainv_mod + use amg_d_ilu_solver implicit none ! input parameters character(len=20) :: kmethd, ptype - character(len=5) :: afmt + character(len=5) :: afmt, pdecoeff integer(psb_ipk_) :: idim integer(psb_epk_) :: system_size - ! miscellaneous + ! miscellaneous real(psb_dpk_) :: t1, t2, tprec, thier, tslv ! sparse matrix and preconditioner @@ -582,6 +114,9 @@ program amg_d_pde2d type(solverdata) :: s_choice ! preconditioner data + type(amg_d_invt_solver_type) :: invtsv + type(amg_d_invk_solver_type) :: invksv + type(amg_d_ainv_solver_type) :: ainvsv type precdata ! preconditioner type @@ -613,7 +148,9 @@ program amg_d_pde2d character(len=16) :: prol ! prolongation over application of AS character(len=16) :: solve ! local subsolver type: ILU, MILU, ILUT, ! UMF, MUMPS, SLU, FWGS, BWGS, JAC + character(len=16) :: variant ! AINV variant: LLK, etc integer(psb_ipk_) :: fill ! fill-in for incomplete LU factorization + integer(psb_ipk_) :: invfill ! Inverse fill-in for INVK real(psb_dpk_) :: thr ! threshold for ILUT factorization ! AMG post-smoother; ignored by 1-lev preconditioner @@ -624,8 +161,10 @@ program amg_d_pde2d character(len=16) :: prol2 ! prolongation over application of AS character(len=16) :: solve2 ! local subsolver type: ILU, MILU, ILUT, ! UMF, MUMPS, SLU, FWGS, BWGS, JAC + character(len=16) :: variant2 ! AINV variant: LLK, etc integer(psb_ipk_) :: fill2 ! fill-in for incomplete LU factorization - real(psb_dpk_) :: thr2 ! threshold for ILUT factorization + integer(psb_ipk_) :: invfill2 ! Inverse fill-in for INVK + real(psb_dpk_) :: thr2 ! threshold for ILUT factorization ! coarsest-level solver character(len=16) :: cmat ! coarsest matrix layout: REPL, DIST @@ -651,7 +190,7 @@ program amg_d_pde2d call psb_init(ctxt) call psb_info(ctxt,iam,np) - if (iam < 0) then + if (iam < 0) then ! This should not happen, but just in case call psb_exit(ctxt) stop @@ -662,22 +201,37 @@ program amg_d_pde2d ! ! Hello world ! - if (iam == psb_root_) then - write(*,*) 'Welcome to MLD2P4 version: ',amg_version_string_ + if (iam == psb_root_) then + write(*,*) 'Welcome to AMG4PSBLAS version: ',amg_version_string_ write(*,*) 'This is the ',trim(name),' sample program' end if ! ! get parameters ! - call get_parms(ctxt,afmt,idim,s_choice,p_choice) + call get_parms(ctxt,afmt,idim,s_choice,p_choice,pdecoeff) ! - ! allocate and fill in the coefficient matrix, rhs and initial guess + ! allocate and fill in the coefficient matrix, rhs and initial guess ! call psb_barrier(ctxt) t1 = psb_wtime() - call amg_gen_pde2d(ctxt,idim,a,b,x,desc_a,afmt,info) + select case(psb_toupper(trim(pdecoeff))) + case("CONST") + call amg_gen_pde2d(ctxt,idim,a,b,x,desc_a,afmt,& + & a1,a2,b1,b2,c,g,info) + case("EXP") + call amg_gen_pde2d(ctxt,idim,a,b,x,desc_a,afmt,& + & a1_exp,a2_exp,b1_exp,b2_exp,c_exp,g_exp,info) + case("BOX") + call amg_gen_pde2d(ctxt,idim,a,b,x,desc_a,afmt,& + & a1_box,a2_box,b1_box,b2_box,c_box,g_box,info) + case default + info=psb_err_from_subroutine_ + ch_err='amg_gen_pdecoeff' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end select call psb_barrier(ctxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then @@ -687,6 +241,8 @@ program amg_d_pde2d goto 9999 end if + if (iam == psb_root_) & + & write(psb_out_unit,'("PDE Coefficients : ",a)')pdecoeff if (iam == psb_root_) & & write(psb_out_unit,'("Overall matrix creation time : ",es12.5)')t2 if (iam == psb_root_) & @@ -702,7 +258,7 @@ program amg_d_pde2d case ('JACOBI','L1-JACOBI','GS','FWGS','FBGS') ! 1-level sweeps from "outer_sweeps" call prec%set('smoother_sweeps', p_choice%jsweeps, info) - + case ('BJAC') call prec%set('smoother_sweeps', p_choice%jsweeps, info) call prec%set('sub_solve', p_choice%solve, info) @@ -717,8 +273,8 @@ program amg_d_pde2d call prec%set('sub_solve', p_choice%solve, info) call prec%set('sub_fillin', p_choice%fill, info) call prec%set('sub_iluthrs', p_choice%thr, info) - - case ('ML') + + case ('ML') ! multilevel preconditioner call prec%set('ml_cycle', p_choice%mlcycle, info) @@ -747,14 +303,26 @@ program amg_d_pde2d call prec%set('smoother_sweeps', p_choice%jsweeps, info) select case (psb_toupper(p_choice%smther)) - case ('GS','BWGS','FBGS','JACOBI','L1-JACOBI') + case ('GS','BWGS','FBGS','JACOBI','L1-JACOBI','L1-FBGS') ! do nothing case default call prec%set('sub_ovr', p_choice%novr, info) call prec%set('sub_restr', p_choice%restr, info) call prec%set('sub_prol', p_choice%prol, info) - call prec%set('sub_solve', p_choice%solve, info) + select case(trim(psb_toupper(p_choice%solve))) + case('INVK') + call prec%set(invksv, info) + case('INVT') + call prec%set(invtsv, info) + case('AINV') + call prec%set(ainvsv, info) + call prec%set('ainv_alg', p_choice%variant, info) + case default + call prec%set('sub_solve', p_choice%solve, info) + end select + call prec%set('sub_fillin', p_choice%fill, info) + call prec%set('inv_fillin', p_choice%invfill, info) call prec%set('sub_iluthrs', p_choice%thr, info) end select @@ -762,14 +330,26 @@ program amg_d_pde2d call prec%set('smoother_type', p_choice%smther2, info,pos='post') call prec%set('smoother_sweeps', p_choice%jsweeps2, info,pos='post') select case (psb_toupper(p_choice%smther2)) - case ('GS','BWGS','FBGS','JACOBI','L1-JACOBI') + case ('GS','BWGS','FBGS','JACOBI','L1-JACOBI','L1-FBGS') ! do nothing case default call prec%set('sub_ovr', p_choice%novr2, info,pos='post') call prec%set('sub_restr', p_choice%restr2, info,pos='post') call prec%set('sub_prol', p_choice%prol2, info,pos='post') - call prec%set('sub_solve', p_choice%solve2, info,pos='post') + select case(trim(psb_toupper(p_choice%solve2))) + case('INVK') + call prec%set(invksv, info, pos='post') + case('INVT') + call prec%set(invtsv, info, pos='post') + case('AINV') + call prec%set(ainvsv, info, pos='post') + call prec%set('ainv_alg', p_choice%variant2, info, pos='post') + case default + call prec%set('sub_solve', p_choice%solve2, info, pos='post') + end select + call prec%set('sub_fillin', p_choice%fill2, info,pos='post') + call prec%set('inv_fillin', p_choice%invfill2, info,pos='post') call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post') end select end if @@ -783,7 +363,7 @@ program amg_d_pde2d call prec%set('coarse_sweeps', p_choice%cjswp, info) end select - + ! build the preconditioner call psb_barrier(ctxt) t1 = psb_wtime() @@ -813,7 +393,7 @@ program amg_d_pde2d end if ! - ! iterative method parameters + ! iterative method parameters ! call psb_barrier(ctxt) t1 = psb_wtime() @@ -853,9 +433,10 @@ program amg_d_pde2d call psb_sum(ctxt,descsize) call psb_sum(ctxt,precsize) call prec%descr(iout=psb_out_unit) - if (iam == psb_root_) then + if (iam == psb_root_) then write(psb_out_unit,'("Computed solution on ",i8," processors")') np write(psb_out_unit,'("Linear system size : ",i12)') system_size + write(psb_out_unit,'("PDE Coefficients : ",a)') trim(pdecoeff) write(psb_out_unit,'("Krylov method : ",a)') trim(s_choice%kmethd) write(psb_out_unit,'("Preconditioner : ",a)') trim(p_choice%descr) write(psb_out_unit,'("Iterations to convergence : ",i12)') iter @@ -877,7 +458,7 @@ program amg_d_pde2d end if - ! + ! ! cleanup storage and exit ! call psb_gefree(b,desc_a,info) @@ -904,7 +485,7 @@ contains ! ! get iteration parameters from standard input ! - subroutine get_parms(ctxt,afmt,idim,solve,prec) + subroutine get_parms(ctxt,afmt,idim,solve,prec,pdecoeff) implicit none @@ -913,6 +494,7 @@ contains character(len=*) :: afmt type(solverdata) :: solve type(precdata) :: prec + character(len=*) :: pdecoeff integer(psb_ipk_) :: iam, nm, np, inp_unit character(len=1024) :: filename @@ -937,6 +519,7 @@ contains ! call read_data(afmt,inp_unit) ! matrix storage format call read_data(idim,inp_unit) ! Discretization grid size + call read_data(pdecoeff,inp_unit) ! PDE Coefficients ! Krylov solver data call read_data(solve%kmethd,inp_unit) ! Krylov solver call read_data(solve%istopc,inp_unit) ! stopping criterion @@ -954,7 +537,9 @@ contains call read_data(prec%restr,inp_unit) ! restriction over application of AS call read_data(prec%prol,inp_unit) ! prolongation over application of AS call read_data(prec%solve,inp_unit) ! local subsolver + call read_data(prec%variant,inp_unit) ! AINV variant call read_data(prec%fill,inp_unit) ! fill-in for incomplete LU + call read_data(prec%invfill,inp_unit) !Inverse fill-in for INVK call read_data(prec%thr,inp_unit) ! threshold for ILUT ! Second smoother/ AMG post-smoother (if NONE ignored in main) call read_data(prec%smther2,inp_unit) ! smoother type @@ -963,7 +548,9 @@ contains call read_data(prec%restr2,inp_unit) ! restriction over application of AS call read_data(prec%prol2,inp_unit) ! prolongation over application of AS call read_data(prec%solve2,inp_unit) ! local subsolver + call read_data(prec%variant2,inp_unit) ! AINV variant call read_data(prec%fill2,inp_unit) ! fill-in for incomplete LU + call read_data(prec%invfill2,inp_unit) !Inverse fill-in for INVK call read_data(prec%thr2,inp_unit) ! threshold for ILUT ! general AMG data call read_data(prec%mlcycle,inp_unit) ! AMG cycle type @@ -998,6 +585,7 @@ contains call psb_bcast(ctxt,afmt) call psb_bcast(ctxt,idim) + call psb_bcast(ctxt,pdecoeff) call psb_bcast(ctxt,solve%kmethd) call psb_bcast(ctxt,solve%istopc) @@ -1010,29 +598,33 @@ contains call psb_bcast(ctxt,prec%ptype) ! broadcast first (pre-)smoother / 1-lev prec data - call psb_bcast(ctxt,prec%smther) + call psb_bcast(ctxt,prec%smther) call psb_bcast(ctxt,prec%jsweeps) call psb_bcast(ctxt,prec%novr) call psb_bcast(ctxt,prec%restr) call psb_bcast(ctxt,prec%prol) call psb_bcast(ctxt,prec%solve) + call psb_bcast(ctxt,prec%variant) call psb_bcast(ctxt,prec%fill) + call psb_bcast(ctxt,prec%invfill) call psb_bcast(ctxt,prec%thr) - ! broadcast second (post-)smoother + ! broadcast second (post-)smoother call psb_bcast(ctxt,prec%smther2) call psb_bcast(ctxt,prec%jsweeps2) call psb_bcast(ctxt,prec%novr2) call psb_bcast(ctxt,prec%restr2) call psb_bcast(ctxt,prec%prol2) call psb_bcast(ctxt,prec%solve2) + call psb_bcast(ctxt,prec%variant2) call psb_bcast(ctxt,prec%fill2) + call psb_bcast(ctxt,prec%invfill2) call psb_bcast(ctxt,prec%thr2) - + ! broadcast AMG parameters call psb_bcast(ctxt,prec%mlcycle) call psb_bcast(ctxt,prec%outer_sweeps) call psb_bcast(ctxt,prec%maxlevs) - + call psb_bcast(ctxt,prec%aggr_prol) call psb_bcast(ctxt,prec%par_aggr_alg) call psb_bcast(ctxt,prec%aggr_ord) @@ -1044,7 +636,7 @@ contains call psb_bcast(ctxt,prec%athresv) end if call psb_bcast(ctxt,prec%athres) - + call psb_bcast(ctxt,prec%csize) call psb_bcast(ctxt,prec%cmat) call psb_bcast(ctxt,prec%csolve) diff --git a/tests/pdegen/amg_d_pde2d_base_mod.f90 b/tests/pdegen/amg_d_pde2d_base_mod.f90 new file mode 100644 index 00000000..c716d789 --- /dev/null +++ b/tests/pdegen/amg_d_pde2d_base_mod.f90 @@ -0,0 +1,53 @@ +module amg_d_pde2d_base_mod + use psb_base_mod, only : psb_dpk_, dzero, done + real(psb_dpk_), save, private :: epsilon=done/80 +contains + subroutine pde_set_parm(dat) + real(psb_dpk_), intent(in) :: dat + epsilon = dat + end subroutine pde_set_parm + ! + ! functions parametrizing the differential equation + ! + function b1(x,y) + use psb_base_mod, only : psb_dpk_, dzero, done + real(psb_dpk_) :: b1 + real(psb_dpk_), intent(in) :: x,y + b1 = dzero/1.414_psb_dpk_ + end function b1 + function b2(x,y) + use psb_base_mod, only : psb_dpk_, dzero, done + real(psb_dpk_) :: b2 + real(psb_dpk_), intent(in) :: x,y + b2 = dzero/1.414_psb_dpk_ + end function b2 + function c(x,y) + use psb_base_mod, only : psb_dpk_, dzero, done + real(psb_dpk_) :: c + real(psb_dpk_), intent(in) :: x,y + c = dzero + end function c + function a1(x,y) + use psb_base_mod, only : psb_dpk_, dzero, done + real(psb_dpk_) :: a1 + real(psb_dpk_), intent(in) :: x,y + a1=done*epsilon + end function a1 + function a2(x,y) + use psb_base_mod, only : psb_dpk_, dzero, done + real(psb_dpk_) :: a2 + real(psb_dpk_), intent(in) :: x,y + a2=done*epsilon + end function a2 + function g(x,y) + use psb_base_mod, only : psb_dpk_, dzero, done + real(psb_dpk_) :: g + real(psb_dpk_), intent(in) :: x,y + g = dzero + if (x == done) then + g = done + else if (x == dzero) then + g = done + end if + end function g +end module amg_d_pde2d_base_mod diff --git a/tests/pdegen/amg_d_pde2d_box_mod.f90 b/tests/pdegen/amg_d_pde2d_box_mod.f90 new file mode 100644 index 00000000..b5518be2 --- /dev/null +++ b/tests/pdegen/amg_d_pde2d_box_mod.f90 @@ -0,0 +1,53 @@ +module amg_d_pde2d_box_mod + use psb_base_mod, only : psb_dpk_, dzero, done + real(psb_dpk_), save, private :: epsilon=done/80 +contains + subroutine pde_set_parm(dat) + real(psb_dpk_), intent(in) :: dat + epsilon = dat + end subroutine pde_set_parm + ! + ! functions parametrizing the differential equation + ! + function b1_box(x,y) + use psb_base_mod, only : psb_dpk_, dzero, done + real(psb_dpk_) :: b1_box + real(psb_dpk_), intent(in) :: x,y + b1_box = done/1.414_psb_dpk_ + end function b1_box + function b2_box(x,y) + use psb_base_mod, only : psb_dpk_, dzero, done + real(psb_dpk_) :: b2_box + real(psb_dpk_), intent(in) :: x,y + b2_box = done/1.414_psb_dpk_ + end function b2_box + function c_box(x,y) + use psb_base_mod, only : psb_dpk_, dzero, done + real(psb_dpk_) :: c_box + real(psb_dpk_), intent(in) :: x,y + c_box = dzero + end function c_box + function a1_box(x,y) + use psb_base_mod, only : psb_dpk_, dzero, done + real(psb_dpk_) :: a1_box + real(psb_dpk_), intent(in) :: x,y + a1_box=done*epsilon + end function a1_box + function a2_box(x,y) + use psb_base_mod, only : psb_dpk_, dzero, done + real(psb_dpk_) :: a2_box + real(psb_dpk_), intent(in) :: x,y + a2_box=done*epsilon + end function a2_box + function g_box(x,y) + use psb_base_mod, only : psb_dpk_, dzero, done + real(psb_dpk_) :: g_box + real(psb_dpk_), intent(in) :: x,y + g_box = dzero + if (x == done) then + g_box = done + else if (x == dzero) then + g_box = done + end if + end function g_box +end module amg_d_pde2d_box_mod diff --git a/tests/pdegen/amg_d_pde2d_exp_mod.f90 b/tests/pdegen/amg_d_pde2d_exp_mod.f90 new file mode 100644 index 00000000..1929d471 --- /dev/null +++ b/tests/pdegen/amg_d_pde2d_exp_mod.f90 @@ -0,0 +1,53 @@ +module amg_d_pde2d_exp_mod + use psb_base_mod, only : psb_dpk_, done, dzero + real(psb_dpk_), save, private :: epsilon=done/80 +contains + subroutine pde_set_parm(dat) + real(psb_dpk_), intent(in) :: dat + epsilon = dat + end subroutine pde_set_parm + ! + ! functions parametrizing the differential equation + ! + function b1_exp(x,y) + use psb_base_mod, only : psb_dpk_, done, dzero + real(psb_dpk_) :: b1_exp + real(psb_dpk_), intent(in) :: x,y + b1_exp = dzero + end function b1_exp + function b2_exp(x,y) + use psb_base_mod, only : psb_dpk_, done, dzero + real(psb_dpk_) :: b2_exp + real(psb_dpk_), intent(in) :: x,y + b2_exp = dzero + end function b2_exp + function c_exp(x,y) + use psb_base_mod, only : psb_dpk_, done, dzero + real(psb_dpk_) :: c_exp + real(psb_dpk_), intent(in) :: x,y + c_exp = dzero + end function c_exp + function a1_exp(x,y) + use psb_base_mod, only : psb_dpk_, done, dzero + real(psb_dpk_) :: a1_exp + real(psb_dpk_), intent(in) :: x,y + a1=done*epsilon*exp(-(x+y)) + end function a1_exp + function a2_exp(x,y) + use psb_base_mod, only : psb_dpk_, done, dzero + real(psb_dpk_) :: a2_exp + real(psb_dpk_), intent(in) :: x,y + a2=done*epsilon*exp(-(x+y)) + end function a2_exp + function g_exp(x,y) + use psb_base_mod, only : psb_dpk_, done, dzero + real(psb_dpk_) :: g_exp + real(psb_dpk_), intent(in) :: x,y + g_exp = dzero + if (x == done) then + g_exp = done + else if (x == dzero) then + g_exp = done + end if + end function g_exp +end module amg_d_pde2d_exp_mod diff --git a/tests/pdegen/amg_d_pde3d.f90 b/tests/pdegen/amg_d_pde3d.f90 index 43e3591a..13323797 100644 --- a/tests/pdegen/amg_d_pde3d.f90 +++ b/tests/pdegen/amg_d_pde3d.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! AMG4PSBLAS version 1.0 ! Algebraic Multigrid Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2020 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante -! +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the AMG4PSBLAS 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 @@ -33,24 +33,24 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! ! ! File: amg_d_pde3d.f90 ! ! Program: amg_d_pde3d ! This sample program solves a linear system obtained by discretizing a -! PDE with Dirichlet BCs. -! +! PDE with Dirichlet BCs. +! ! ! The PDE is a general second order equation in 3d ! -! a1 dd(u) a2 dd(u) a3 dd(u) b1 d(u) b2 d(u) b3 d(u) +! a1 dd(u) a2 dd(u) a3 dd(u) b1 d(u) b2 d(u) b3 d(u) ! - ------ - ------ - ------ + ----- + ------ + ------ + c u = f -! dxdx dydy dzdz dx dy dz +! dxdx dydy dzdz dx dy dz ! ! with Dirichlet boundary conditions -! u = g +! u = g ! ! on the unit cube 0<=x,y,z<=1. ! @@ -64,534 +64,27 @@ ! 3. A 3D distribution in which the unit cube is partitioned ! into subcubes, each one assigned to a process. ! -module amg_d_pde3d_mod - use psb_base_mod, only : psb_dpk_, psb_ipk_, psb_lpk_, psb_desc_type,& - & psb_dspmat_type, psb_d_vect_type, dzero,& - & psb_d_base_sparse_mat, psb_d_base_vect_type, & - & psb_i_base_vect_type, psb_l_base_vect_type - - interface - function d_func_3d(x,y,z) result(val) - import :: psb_dpk_ - real(psb_dpk_), intent(in) :: x,y,z - real(psb_dpk_) :: val - end function d_func_3d - end interface - - interface amg_gen_pde3d - module procedure amg_d_gen_pde3d - end interface amg_gen_pde3d - - -contains - - function d_null_func_3d(x,y,z) result(val) - - real(psb_dpk_), intent(in) :: x,y,z - real(psb_dpk_) :: val - - val = dzero - - end function d_null_func_3d - ! - ! functions parametrizing the differential equation - ! - ! - ! Note: b1, b2 and b3 are the coefficients of the first - ! derivative of the unknown function. The default - ! we apply here is to have them zero, so that the resulting - ! matrix is symmetric/hermitian and suitable for - ! testing with CG and FCG. - ! When testing methods for non-hermitian matrices you can - ! change the B1/B2/B3 functions to e.g. done/sqrt((3*done)) - ! - function b1(x,y,z) - use psb_base_mod, only : psb_dpk_, done, dzero - implicit none - real(psb_dpk_) :: b1 - real(psb_dpk_), intent(in) :: x,y,z - b1=dzero - end function b1 - function b2(x,y,z) - use psb_base_mod, only : psb_dpk_, done, dzero - implicit none - real(psb_dpk_) :: b2 - real(psb_dpk_), intent(in) :: x,y,z - b2=dzero - end function b2 - function b3(x,y,z) - use psb_base_mod, only : psb_dpk_, done, dzero - implicit none - real(psb_dpk_) :: b3 - real(psb_dpk_), intent(in) :: x,y,z - - b3=dzero - end function b3 - function c(x,y,z) - use psb_base_mod, only : psb_dpk_, done, dzero - implicit none - real(psb_dpk_) :: c - real(psb_dpk_), intent(in) :: x,y,z - c=dzero - end function c - function a1(x,y,z) - use psb_base_mod, only : psb_dpk_, done, dzero - implicit none - real(psb_dpk_) :: a1 - real(psb_dpk_), intent(in) :: x,y,z - a1=done/80 - end function a1 - function a2(x,y,z) - use psb_base_mod, only : psb_dpk_, done, dzero - implicit none - real(psb_dpk_) :: a2 - real(psb_dpk_), intent(in) :: x,y,z - a2=done/80 - end function a2 - function a3(x,y,z) - use psb_base_mod, only : psb_dpk_, done, dzero - implicit none - real(psb_dpk_) :: a3 - real(psb_dpk_), intent(in) :: x,y,z - a3=done/80 - end function a3 - function g(x,y,z) - use psb_base_mod, only : psb_dpk_, done, dzero - implicit none - real(psb_dpk_) :: g - real(psb_dpk_), intent(in) :: x,y,z - g = dzero - if (x == done) then - g = done - else if (x == dzero) then - g = exp(y**2-z**2) - end if - end function g - - - ! - ! subroutine to allocate and fill in the coefficient matrix and - ! the rhs. - ! - subroutine amg_d_gen_pde3d(ctxt,idim,a,bv,xv,desc_a,afmt,info,& - & f,amold,vmold,imold,partition,nrl,iv) - use psb_base_mod - use psb_util_mod - ! - ! Discretizes the partial differential equation - ! - ! a1 dd(u) a2 dd(u) a3 dd(u) b1 d(u) b2 d(u) b3 d(u) - ! - ------ - ------ - ------ + ----- + ------ + ------ + c u = f - ! dxdx dydy dzdz dx dy dz - ! - ! with Dirichlet boundary conditions - ! u = g - ! - ! on the unit cube 0<=x,y,z<=1. - ! - ! - ! Note that if b1=b2=b3=c=0., the PDE is the Laplace equation. - ! - implicit none - integer(psb_ipk_) :: idim - type(psb_dspmat_type) :: a - type(psb_d_vect_type) :: xv,bv - type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: info - character(len=*) :: afmt - procedure(d_func_3d), optional :: f - class(psb_d_base_sparse_mat), optional :: amold - class(psb_d_base_vect_type), optional :: vmold - class(psb_i_base_vect_type), optional :: imold - integer(psb_ipk_), optional :: partition, nrl,iv(:) - - ! Local variables. - - integer(psb_ipk_), parameter :: nb=20 - type(psb_d_csc_sparse_mat) :: acsc - type(psb_d_coo_sparse_mat) :: acoo - type(psb_d_csr_sparse_mat) :: acsr - real(psb_dpk_) :: zt(nb),x,y,z - integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_ - integer(psb_lpk_) :: m,n,glob_row,nt - integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner - ! For 3D partition - ! Note: integer control variables going directly into an MPI call - ! must be 4 bytes, i.e. psb_mpk_ - integer(psb_mpk_) :: npdims(3), npp, minfo - integer(psb_ipk_) :: npx,npy,npz, iamx,iamy,iamz,mynx,myny,mynz - integer(psb_ipk_), allocatable :: bndx(:),bndy(:),bndz(:) - ! Process grid - integer(psb_ipk_) :: np, iam - integer(psb_ipk_) :: icoeff - integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:) - real(psb_dpk_), allocatable :: val(:) - ! deltah dimension of each grid cell - ! deltat discretization time - real(psb_dpk_) :: deltah, sqdeltah, deltah2 - real(psb_dpk_), parameter :: rhs=dzero,one=done,zero=dzero - real(psb_dpk_) :: t0, t1, t2, t3, tasb, talc, ttot, tgen, tcdasb - integer(psb_ipk_) :: err_act - procedure(d_func_3d), pointer :: f_ - character(len=20) :: name, ch_err,tmpfmt - - info = psb_success_ - name = 'create_matrix' - call psb_erractionsave(err_act) - - call psb_info(ctxt, iam, np) - - - if (present(f)) then - f_ => f - else - f_ => d_null_func_3d - end if - - deltah = done/(idim+1) - sqdeltah = deltah*deltah - deltah2 = (2*done)* deltah - - if (present(partition)) then - if ((1<= partition).and.(partition <= 3)) then - partition_ = partition - else - write(*,*) 'Invalid partition choice ',partition,' defaulting to 3' - partition_ = 3 - end if - else - partition_ = 3 - end if - - ! initialize array descriptor and sparse matrix storage. provide an - ! estimate of the number of non zeroes - - m = (1_psb_lpk_*idim)*idim*idim - n = m - nnz = 7*((n+np-1)/np) - if(iam == psb_root_) write(psb_out_unit,'("Generating Matrix (size=",i0,")...")')n - t0 = psb_wtime() - select case(partition_) - case(1) - ! A BLOCK partition - if (present(nrl)) then - nr = nrl - else - ! - ! Using a simple BLOCK distribution. - ! - nt = (m+np-1)/np - nr = max(0,min(nt,m-(iam*nt))) - end if - - nt = nr - call psb_sum(ctxt,nt) - if (nt /= m) then - write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - return - end if - - ! - ! First example of use of CDALL: specify for each process a number of - ! contiguous rows - ! - call psb_cdall(ctxt,desc_a,info,nl=nr) - myidx = desc_a%get_global_indices() - nlr = size(myidx) - - case(2) - ! A partition defined by the user through IV - - if (present(iv)) then - if (size(iv) /= m) then - write(psb_err_unit,*) iam, 'Initialization error: wrong IV size',size(iv),m - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - return - end if - else - write(psb_err_unit,*) iam, 'Initialization error: IV not present' - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - return - end if - - ! - ! Second example of use of CDALL: specify for each row the - ! process that owns it - ! - call psb_cdall(ctxt,desc_a,info,vg=iv) - myidx = desc_a%get_global_indices() - nlr = size(myidx) - - case(3) - ! A 3-dimensional partition - - ! A nifty MPI function will split the process list - npdims = 0 - call mpi_dims_create(np,3,npdims,info) - npx = npdims(1) - npy = npdims(2) - npz = npdims(3) - - allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz)) - ! We can reuse idx2ijk for process indices as well. - call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0) - ! Now let's split the 3D cube in hexahedra - call dist1Didx(bndx,idim,npx) - mynx = bndx(iamx+1)-bndx(iamx) - call dist1Didx(bndy,idim,npy) - myny = bndy(iamy+1)-bndy(iamy) - call dist1Didx(bndz,idim,npz) - mynz = bndz(iamz+1)-bndz(iamz) - - ! How many indices do I own? - nlr = mynx*myny*mynz - allocate(myidx(nlr)) - ! Now, let's generate the list of indices I own - nr = 0 - do i=bndx(iamx),bndx(iamx+1)-1 - do j=bndy(iamy),bndy(iamy+1)-1 - do k=bndz(iamz),bndz(iamz+1)-1 - nr = nr + 1 - call ijk2idx(myidx(nr),i,j,k,idim,idim,idim) - end do - end do - end do - if (nr /= nlr) then - write(psb_err_unit,*) iam,iamx,iamy,iamz, 'Initialization error: NR vs NLR ',& - & nr,nlr,mynx,myny,mynz - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - end if - - ! - ! Third example of use of CDALL: specify for each process - ! the set of global indices it owns. - ! - call psb_cdall(ctxt,desc_a,info,vl=myidx) - - case default - write(psb_err_unit,*) iam, 'Initialization error: should not get here' - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - return - end select - - - if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz) - ! define rhs from boundary conditions; also build initial guess - if (info == psb_success_) call psb_geall(xv,desc_a,info) - if (info == psb_success_) call psb_geall(bv,desc_a,info) - - call psb_barrier(ctxt) - talc = psb_wtime()-t0 - - if (info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='allocation rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - ! we build an auxiliary matrix consisting of one row at a - ! time; just a small matrix. might be extended to generate - ! a bunch of rows per call. - ! - allocate(val(20*nb),irow(20*nb),& - &icol(20*nb),stat=info) - if (info /= psb_success_ ) then - info=psb_err_alloc_dealloc_ - call psb_errpush(info,name) - goto 9999 - endif - - - ! loop over rows belonging to current process in a block - ! distribution. - - call psb_barrier(ctxt) - t1 = psb_wtime() - do ii=1, nlr,nb - ib = min(nb,nlr-ii+1) - icoeff = 1 - do k=1,ib - i=ii+k-1 - ! local matrix pointer - glob_row=myidx(i) - ! compute gridpoint coordinates - call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim) - ! x, y, z coordinates - x = (ix-1)*deltah - y = (iy-1)*deltah - z = (iz-1)*deltah - zt(k) = f_(x,y,z) - ! internal point: build discretization - ! - ! term depending on (x-1,y,z) - ! - val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2 - if (ix == 1) then - zt(k) = g(dzero,y,z)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x,y-1,z) - val(icoeff) = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2 - if (iy == 1) then - zt(k) = g(x,dzero,z)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x,y,z-1) - val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2 - if (iz == 1) then - zt(k) = g(x,y,dzero)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - - ! term depending on (x,y,z) - val(icoeff)=(2*done)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah & - & + c(x,y,z) - call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - ! term depending on (x,y,z+1) - val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2 - if (iz == idim) then - zt(k) = g(x,y,done)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x,y+1,z) - val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2 - if (iy == idim) then - zt(k) = g(x,done,z)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x+1,y,z) - val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2 - if (ix==idim) then - zt(k) = g(done,y,z)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - - end do - call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) - if(info /= psb_success_) exit - call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) - if(info /= psb_success_) exit - zt(:)=dzero - call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) - if(info /= psb_success_) exit - end do - - tgen = psb_wtime()-t1 - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='insert rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - deallocate(val,irow,icol) - - call psb_barrier(ctxt) - t1 = psb_wtime() - call psb_cdasb(desc_a,info,mold=imold) - tcdasb = psb_wtime()-t1 - call psb_barrier(ctxt) - t1 = psb_wtime() - if (info == psb_success_) then - if (present(amold)) then - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold) - else - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - end if - end if - call psb_barrier(ctxt) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='asb rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - if (info == psb_success_) call psb_geasb(xv,desc_a,info,mold=vmold) - if (info == psb_success_) call psb_geasb(bv,desc_a,info,mold=vmold) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='asb rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - tasb = psb_wtime()-t1 - call psb_barrier(ctxt) - ttot = psb_wtime() - t0 - - call psb_amx(ctxt,talc) - call psb_amx(ctxt,tgen) - call psb_amx(ctxt,tasb) - call psb_amx(ctxt,ttot) - if(iam == psb_root_) then - tmpfmt = a%get_fmt() - write(psb_out_unit,'("The matrix has been generated and assembled in ",a3," format.")')& - & tmpfmt - write(psb_out_unit,'("-allocation time : ",es12.5)') talc - write(psb_out_unit,'("-coeff. gen. time : ",es12.5)') tgen - write(psb_out_unit,'("-desc asbly time : ",es12.5)') tcdasb - write(psb_out_unit,'("- mat asbly time : ",es12.5)') tasb - write(psb_out_unit,'("-total time : ",es12.5)') ttot - - end if - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ctxt,err_act) - - return - end subroutine amg_d_gen_pde3d - -end module amg_d_pde3d_mod - program amg_d_pde3d use psb_base_mod use amg_prec_mod use psb_krylov_mod use psb_util_mod use data_input - use amg_d_pde3d_mod + use amg_d_pde3d_base_mod + use amg_d_pde3d_exp_mod + use amg_d_pde3d_gauss_mod + use amg_d_genpde_mod + use amg_ainv_mod + use amg_d_ilu_solver implicit none ! input parameters character(len=20) :: kmethd, ptype - character(len=5) :: afmt + character(len=5) :: afmt, pdecoeff integer(psb_ipk_) :: idim integer(psb_epk_) :: system_size - ! miscellaneous + ! miscellaneous real(psb_dpk_) :: t1, t2, tprec, thier, tslv ! sparse matrix and preconditioner @@ -622,6 +115,9 @@ program amg_d_pde3d type(solverdata) :: s_choice ! preconditioner data + type(amg_d_invt_solver_type) :: invtsv + type(amg_d_invk_solver_type) :: invksv + type(amg_d_ainv_solver_type) :: ainvsv type precdata ! preconditioner type @@ -653,7 +149,9 @@ program amg_d_pde3d character(len=16) :: prol ! prolongation over application of AS character(len=16) :: solve ! local subsolver type: ILU, MILU, ILUT, ! UMF, MUMPS, SLU, FWGS, BWGS, JAC + character(len=16) :: variant ! AINV variant: LLK, etc integer(psb_ipk_) :: fill ! fill-in for incomplete LU factorization + integer(psb_ipk_) :: invfill ! Inverse fill-in for INVK real(psb_dpk_) :: thr ! threshold for ILUT factorization ! AMG post-smoother; ignored by 1-lev preconditioner @@ -664,8 +162,10 @@ program amg_d_pde3d character(len=16) :: prol2 ! prolongation over application of AS character(len=16) :: solve2 ! local subsolver type: ILU, MILU, ILUT, ! UMF, MUMPS, SLU, FWGS, BWGS, JAC + character(len=16) :: variant2 ! AINV variant: LLK, etc integer(psb_ipk_) :: fill2 ! fill-in for incomplete LU factorization - real(psb_dpk_) :: thr2 ! threshold for ILUT factorization + integer(psb_ipk_) :: invfill2 ! Inverse fill-in for INVK + real(psb_dpk_) :: thr2 ! threshold for ILUT factorization ! coarsest-level solver character(len=16) :: cmat ! coarsest matrix layout: REPL, DIST @@ -691,7 +191,7 @@ program amg_d_pde3d call psb_init(ctxt) call psb_info(ctxt,iam,np) - if (iam < 0) then + if (iam < 0) then ! This should not happen, but just in case call psb_exit(ctxt) stop @@ -702,23 +202,40 @@ program amg_d_pde3d ! ! Hello world ! - if (iam == psb_root_) then - write(*,*) 'Welcome to MLD2P4 version: ',amg_version_string_ + if (iam == psb_root_) then + write(*,*) 'Welcome to AMG4PSBLAS version: ',amg_version_string_ write(*,*) 'This is the ',trim(name),' sample program' end if ! ! get parameters ! - call get_parms(ctxt,afmt,idim,s_choice,p_choice) + call get_parms(ctxt,afmt,idim,s_choice,p_choice,pdecoeff) ! - ! allocate and fill in the coefficient matrix, rhs and initial guess + ! allocate and fill in the coefficient matrix, rhs and initial guess ! call psb_barrier(ctxt) t1 = psb_wtime() - call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,info) + select case(psb_toupper(trim(pdecoeff))) + case("CONST") + call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,& + & a1,a2,a3,b1,b2,b3,c,g,info) + case("EXP") + call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,& + & a1_exp,a2_exp,a3_exp,b1_exp,b2_exp,b3_exp,c_exp,g_exp,info) + case("GAUSS") + call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,& + & a1_gauss,a2_gauss,a3_gauss,b1_gauss,b2_gauss,b3_gauss,c_gauss,g_gauss,info) + case default + info=psb_err_from_subroutine_ + ch_err='amg_gen_pdecoeff' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end select + + call psb_barrier(ctxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then @@ -728,6 +245,8 @@ program amg_d_pde3d goto 9999 end if + if (iam == psb_root_) & + & write(psb_out_unit,'("PDE Coefficients : ",a)')pdecoeff if (iam == psb_root_) & & write(psb_out_unit,'("Overall matrix creation time : ",es12.5)')t2 if (iam == psb_root_) & @@ -743,7 +262,7 @@ program amg_d_pde3d case ('JACOBI','L1-JACOBI','GS','FWGS','FBGS') ! 1-level sweeps from "outer_sweeps" call prec%set('smoother_sweeps', p_choice%jsweeps, info) - + case ('BJAC') call prec%set('smoother_sweeps', p_choice%jsweeps, info) call prec%set('sub_solve', p_choice%solve, info) @@ -758,8 +277,8 @@ program amg_d_pde3d call prec%set('sub_solve', p_choice%solve, info) call prec%set('sub_fillin', p_choice%fill, info) call prec%set('sub_iluthrs', p_choice%thr, info) - - case ('ML') + + case ('ML') ! multilevel preconditioner call prec%set('ml_cycle', p_choice%mlcycle, info) @@ -788,14 +307,26 @@ program amg_d_pde3d call prec%set('smoother_sweeps', p_choice%jsweeps, info) select case (psb_toupper(p_choice%smther)) - case ('GS','BWGS','FBGS','JACOBI','L1-JACOBI') + case ('GS','BWGS','FBGS','JACOBI','L1-JACOBI','L1-FBGS') ! do nothing case default call prec%set('sub_ovr', p_choice%novr, info) call prec%set('sub_restr', p_choice%restr, info) call prec%set('sub_prol', p_choice%prol, info) - call prec%set('sub_solve', p_choice%solve, info) + select case(trim(psb_toupper(p_choice%solve))) + case('INVK') + call prec%set(invksv, info) + case('INVT') + call prec%set(invtsv, info) + case('AINV') + call prec%set(ainvsv, info) + call prec%set('ainv_alg', p_choice%variant, info) + case default + call prec%set('sub_solve', p_choice%solve, info) + end select + call prec%set('sub_fillin', p_choice%fill, info) + call prec%set('inv_fillin', p_choice%invfill, info) call prec%set('sub_iluthrs', p_choice%thr, info) end select @@ -803,14 +334,26 @@ program amg_d_pde3d call prec%set('smoother_type', p_choice%smther2, info,pos='post') call prec%set('smoother_sweeps', p_choice%jsweeps2, info,pos='post') select case (psb_toupper(p_choice%smther2)) - case ('GS','BWGS','FBGS','JACOBI','L1-JACOBI') + case ('GS','BWGS','FBGS','JACOBI','L1-JACOBI','L1-FBGS') ! do nothing case default call prec%set('sub_ovr', p_choice%novr2, info,pos='post') call prec%set('sub_restr', p_choice%restr2, info,pos='post') call prec%set('sub_prol', p_choice%prol2, info,pos='post') - call prec%set('sub_solve', p_choice%solve2, info,pos='post') + select case(trim(psb_toupper(p_choice%solve2))) + case('INVK') + call prec%set(invksv, info, pos='post') + case('INVT') + call prec%set(invtsv, info, pos='post') + case('AINV') + call prec%set(ainvsv, info, pos='post') + call prec%set('ainv_alg', p_choice%variant2, info, pos='post') + case default + call prec%set('sub_solve', p_choice%solve2, info, pos='post') + end select + call prec%set('sub_fillin', p_choice%fill2, info,pos='post') + call prec%set('inv_fillin', p_choice%invfill2, info,pos='post') call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post') end select end if @@ -824,7 +367,7 @@ program amg_d_pde3d call prec%set('coarse_sweeps', p_choice%cjswp, info) end select - + ! build the preconditioner call psb_barrier(ctxt) t1 = psb_wtime() @@ -854,7 +397,7 @@ program amg_d_pde3d end if ! - ! iterative method parameters + ! iterative method parameters ! call psb_barrier(ctxt) t1 = psb_wtime() @@ -894,9 +437,10 @@ program amg_d_pde3d call psb_sum(ctxt,descsize) call psb_sum(ctxt,precsize) call prec%descr(iout=psb_out_unit) - if (iam == psb_root_) then + if (iam == psb_root_) then write(psb_out_unit,'("Computed solution on ",i8," processors")') np write(psb_out_unit,'("Linear system size : ",i12)') system_size + write(psb_out_unit,'("PDE Coefficients : ",a)') trim(pdecoeff) write(psb_out_unit,'("Krylov method : ",a)') trim(s_choice%kmethd) write(psb_out_unit,'("Preconditioner : ",a)') trim(p_choice%descr) write(psb_out_unit,'("Iterations to convergence : ",i12)') iter @@ -918,7 +462,7 @@ program amg_d_pde3d end if - ! + ! ! cleanup storage and exit ! call psb_gefree(b,desc_a,info) @@ -945,7 +489,7 @@ contains ! ! get iteration parameters from standard input ! - subroutine get_parms(ctxt,afmt,idim,solve,prec) + subroutine get_parms(ctxt,afmt,idim,solve,prec,pdecoeff) implicit none @@ -954,6 +498,7 @@ contains character(len=*) :: afmt type(solverdata) :: solve type(precdata) :: prec + character(len=*) :: pdecoeff integer(psb_ipk_) :: iam, nm, np, inp_unit character(len=1024) :: filename @@ -978,6 +523,7 @@ contains ! call read_data(afmt,inp_unit) ! matrix storage format call read_data(idim,inp_unit) ! Discretization grid size + call read_data(pdecoeff,inp_unit) ! PDE Coefficients ! Krylov solver data call read_data(solve%kmethd,inp_unit) ! Krylov solver call read_data(solve%istopc,inp_unit) ! stopping criterion @@ -995,7 +541,9 @@ contains call read_data(prec%restr,inp_unit) ! restriction over application of AS call read_data(prec%prol,inp_unit) ! prolongation over application of AS call read_data(prec%solve,inp_unit) ! local subsolver + call read_data(prec%variant,inp_unit) ! AINV variant call read_data(prec%fill,inp_unit) ! fill-in for incomplete LU + call read_data(prec%invfill,inp_unit) !Inverse fill-in for INVK call read_data(prec%thr,inp_unit) ! threshold for ILUT ! Second smoother/ AMG post-smoother (if NONE ignored in main) call read_data(prec%smther2,inp_unit) ! smoother type @@ -1004,7 +552,9 @@ contains call read_data(prec%restr2,inp_unit) ! restriction over application of AS call read_data(prec%prol2,inp_unit) ! prolongation over application of AS call read_data(prec%solve2,inp_unit) ! local subsolver + call read_data(prec%variant2,inp_unit) ! AINV variant call read_data(prec%fill2,inp_unit) ! fill-in for incomplete LU + call read_data(prec%invfill2,inp_unit) !Inverse fill-in for INVK call read_data(prec%thr2,inp_unit) ! threshold for ILUT ! general AMG data call read_data(prec%mlcycle,inp_unit) ! AMG cycle type @@ -1039,6 +589,7 @@ contains call psb_bcast(ctxt,afmt) call psb_bcast(ctxt,idim) + call psb_bcast(ctxt,pdecoeff) call psb_bcast(ctxt,solve%kmethd) call psb_bcast(ctxt,solve%istopc) @@ -1051,29 +602,33 @@ contains call psb_bcast(ctxt,prec%ptype) ! broadcast first (pre-)smoother / 1-lev prec data - call psb_bcast(ctxt,prec%smther) + call psb_bcast(ctxt,prec%smther) call psb_bcast(ctxt,prec%jsweeps) call psb_bcast(ctxt,prec%novr) call psb_bcast(ctxt,prec%restr) call psb_bcast(ctxt,prec%prol) call psb_bcast(ctxt,prec%solve) + call psb_bcast(ctxt,prec%variant) call psb_bcast(ctxt,prec%fill) + call psb_bcast(ctxt,prec%invfill) call psb_bcast(ctxt,prec%thr) - ! broadcast second (post-)smoother + ! broadcast second (post-)smoother call psb_bcast(ctxt,prec%smther2) call psb_bcast(ctxt,prec%jsweeps2) call psb_bcast(ctxt,prec%novr2) call psb_bcast(ctxt,prec%restr2) call psb_bcast(ctxt,prec%prol2) call psb_bcast(ctxt,prec%solve2) + call psb_bcast(ctxt,prec%variant2) call psb_bcast(ctxt,prec%fill2) + call psb_bcast(ctxt,prec%invfill2) call psb_bcast(ctxt,prec%thr2) - + ! broadcast AMG parameters call psb_bcast(ctxt,prec%mlcycle) call psb_bcast(ctxt,prec%outer_sweeps) call psb_bcast(ctxt,prec%maxlevs) - + call psb_bcast(ctxt,prec%aggr_prol) call psb_bcast(ctxt,prec%par_aggr_alg) call psb_bcast(ctxt,prec%aggr_ord) @@ -1085,7 +640,7 @@ contains call psb_bcast(ctxt,prec%athresv) end if call psb_bcast(ctxt,prec%athres) - + call psb_bcast(ctxt,prec%csize) call psb_bcast(ctxt,prec%cmat) call psb_bcast(ctxt,prec%csolve) diff --git a/tests/pdegen/amg_d_pde3d_base_mod.f90 b/tests/pdegen/amg_d_pde3d_base_mod.f90 new file mode 100644 index 00000000..76aad5cd --- /dev/null +++ b/tests/pdegen/amg_d_pde3d_base_mod.f90 @@ -0,0 +1,65 @@ +module amg_d_pde3d_base_mod + use psb_base_mod, only : psb_dpk_, done + real(psb_dpk_), save, private :: epsilon=done/80 +contains + subroutine pde_set_parm(dat) + real(psb_dpk_), intent(in) :: dat + epsilon = dat + end subroutine pde_set_parm + ! + ! functions parametrizing the differential equation + ! + function b1(x,y,z) + use psb_base_mod, only : psb_dpk_, done + real(psb_dpk_) :: b1 + real(psb_dpk_), intent(in) :: x,y,z + b1=done/sqrt(3.0_psb_dpk_) + end function b1 + function b2(x,y,z) + use psb_base_mod, only : psb_dpk_, done + real(psb_dpk_) :: b2 + real(psb_dpk_), intent(in) :: x,y,z + b2=done/sqrt(3.0_psb_dpk_) + end function b2 + function b3(x,y,z) + use psb_base_mod, only : psb_dpk_, done + real(psb_dpk_) :: b3 + real(psb_dpk_), intent(in) :: x,y,z + b3=done/sqrt(3.0_psb_dpk_) + end function b3 + function c(x,y,z) + use psb_base_mod, only : psb_dpk_, done + real(psb_dpk_) :: c + real(psb_dpk_), intent(in) :: x,y,z + c=dzero + end function c + function a1(x,y,z) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: a1 + real(psb_dpk_), intent(in) :: x,y,z + a1=epsilon + end function a1 + function a2(x,y,z) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: a2 + real(psb_dpk_), intent(in) :: x,y,z + a2=epsilon + end function a2 + function a3(x,y,z) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: a3 + real(psb_dpk_), intent(in) :: x,y,z + a3=epsilon + end function a3 + function g(x,y,z) + use psb_base_mod, only : psb_dpk_, done, dzero + real(psb_dpk_) :: g + real(psb_dpk_), intent(in) :: x,y,z + g = dzero + if (x == done) then + g = done + else if (x == dzero) then + g = done + end if + end function g +end module amg_d_pde3d_base_mod diff --git a/tests/pdegen/amg_d_pde3d_exp_mod.f90 b/tests/pdegen/amg_d_pde3d_exp_mod.f90 new file mode 100644 index 00000000..fdbb2970 --- /dev/null +++ b/tests/pdegen/amg_d_pde3d_exp_mod.f90 @@ -0,0 +1,65 @@ +module amg_d_pde3d_exp_mod + use psb_base_mod, only : psb_dpk_, done + real(psb_dpk_), save, private :: epsilon=done/160 +contains + subroutine pde_set_parm(dat) + real(psb_dpk_), intent(in) :: dat + epsilon = dat + end subroutine pde_set_parm + ! + ! functions parametrizing the differential equation + ! + function b1_exp(x,y,z) + use psb_base_mod, only : psb_dpk_, dzero + real(psb_dpk_) :: b1_exp + real(psb_dpk_), intent(in) :: x,y,z + b1_exp=dzero/sqrt(3.0_psb_dpk_) + end function b1_exp + function b2_exp(x,y,z) + use psb_base_mod, only : psb_dpk_, dzero + real(psb_dpk_) :: b2_exp + real(psb_dpk_), intent(in) :: x,y,z + b2_exp=dzero/sqrt(3.0_psb_dpk_) + end function b2_exp + function b3_exp(x,y,z) + use psb_base_mod, only : psb_dpk_, dzero + real(psb_dpk_) :: b3_exp + real(psb_dpk_), intent(in) :: x,y,z + b3_exp=dzero/sqrt(3.0_psb_dpk_) + end function b3_exp + function c_exp(x,y,z) + use psb_base_mod, only : psb_dpk_, dzero + real(psb_dpk_) :: c_exp + real(psb_dpk_), intent(in) :: x,y,z + c_exp=dzero + end function c_exp + function a1_exp(x,y,z) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: a1_exp + real(psb_dpk_), intent(in) :: x,y,z + a1_exp=epsilon*exp(-(x+y+z)) + end function a1_exp + function a2_exp(x,y,z) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: a2_exp + real(psb_dpk_), intent(in) :: x,y,z + a2_exp=epsilon*exp(-(x+y+z)) + end function a2_exp + function a3_exp(x,y,z) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: a3_exp + real(psb_dpk_), intent(in) :: x,y,z + a3_exp=epsilon*exp(-(x+y+z)) + end function a3_exp + function g_exp(x,y,z) + use psb_base_mod, only : psb_dpk_, done, dzero + real(psb_dpk_) :: g_exp + real(psb_dpk_), intent(in) :: x,y,z + g_exp = dzero + if (x == done) then + g_exp = done + else if (x == dzero) then + g_exp = done + end if + end function g_exp +end module amg_d_pde3d_exp_mod diff --git a/tests/pdegen/amg_d_pde3d_gauss_mod.f90 b/tests/pdegen/amg_d_pde3d_gauss_mod.f90 new file mode 100644 index 00000000..3787c76a --- /dev/null +++ b/tests/pdegen/amg_d_pde3d_gauss_mod.f90 @@ -0,0 +1,65 @@ +module amg_d_pde3d_gauss_mod + use psb_base_mod, only : psb_dpk_, done + real(psb_dpk_), save, private :: epsilon=done/80 +contains + subroutine pde_set_parm(dat) + real(psb_dpk_), intent(in) :: dat + epsilon = dat + end subroutine pde_set_parm + ! + ! functions parametrizing the differential equation + ! + function b1_gauss(x,y,z) + use psb_base_mod, only : psb_dpk_, done + real(psb_dpk_) :: b1_gauss + real(psb_dpk_), intent(in) :: x,y,z + b1_gauss=done/sqrt(3.0_psb_dpk_)-2*x*exp(-(x**2+y**2+z**2)) + end function b1_gauss + function b2_gauss(x,y,z) + use psb_base_mod, only : psb_dpk_, done + real(psb_dpk_) :: b2_gauss + real(psb_dpk_), intent(in) :: x,y,z + b2_gauss=done/sqrt(3.0_psb_dpk_)-2*y*exp(-(x**2+y**2+z**2)) + end function b2_gauss + function b3_gauss(x,y,z) + use psb_base_mod, only : psb_dpk_, done + real(psb_dpk_) :: b3_gauss + real(psb_dpk_), intent(in) :: x,y,z + b3_gauss=done/sqrt(3.0_psb_dpk_)-2*z*exp(-(x**2+y**2+z**2)) + end function b3_gauss + function c_gauss(x,y,z) + use psb_base_mod, only : psb_dpk_, dzero + real(psb_dpk_) :: c_gauss + real(psb_dpk_), intent(in) :: x,y,z + c=dzero + end function c_gauss + function a1_gauss(x,y,z) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: a1_gauss + real(psb_dpk_), intent(in) :: x,y,z + a1_gauss=epsilon*exp(-(x**2+y**2+z**2)) + end function a1_gauss + function a2_gauss(x,y,z) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: a2_gauss + real(psb_dpk_), intent(in) :: x,y,z + a2_gauss=epsilon*exp(-(x**2+y**2+z**2)) + end function a2_gauss + function a3_gauss(x,y,z) + use psb_base_mod, only : psb_dpk_ + real(psb_dpk_) :: a3_gauss + real(psb_dpk_), intent(in) :: x,y,z + a3_gauss=epsilon*exp(-(x**2+y**2+z**2)) + end function a3_gauss + function g_gauss(x,y,z) + use psb_base_mod, only : psb_dpk_, done, dzero + real(psb_dpk_) :: g_gauss + real(psb_dpk_), intent(in) :: x,y,z + g_gauss = dzero + if (x == done) then + g_gauss = done + else if (x == dzero) then + g_gauss = done + end if + end function g_gauss +end module amg_d_pde3d_gauss_mod diff --git a/tests/pdegen/amg_s_genpde_mod.f90 b/tests/pdegen/amg_s_genpde_mod.f90 new file mode 100644 index 00000000..a448590f --- /dev/null +++ b/tests/pdegen/amg_s_genpde_mod.f90 @@ -0,0 +1,857 @@ +module amg_s_genpde_mod + + + use psb_base_mod, only : psb_spk_, psb_ipk_, psb_desc_type,& + & psb_sspmat_type, psb_s_vect_type, szero,& + & psb_s_base_sparse_mat, psb_s_base_vect_type, psb_i_base_vect_type + + interface + function s_func_3d(x,y,z) result(val) + import :: psb_spk_ + real(psb_spk_), intent(in) :: x,y,z + real(psb_spk_) :: val + end function s_func_3d + end interface + + interface amg_gen_pde3d + module procedure amg_s_gen_pde3d + end interface amg_gen_pde3d + + interface + function s_func_2d(x,y) result(val) + import :: psb_spk_ + real(psb_spk_), intent(in) :: x,y + real(psb_spk_) :: val + end function s_func_2d + end interface + + interface amg_gen_pde2d + module procedure amg_s_gen_pde2d + end interface amg_gen_pde2d + +contains + + function s_null_func_2d(x,y) result(val) + + real(psb_spk_), intent(in) :: x,y + real(psb_spk_) :: val + + val = szero + + end function s_null_func_2d + + function s_null_func_3d(x,y,z) result(val) + + real(psb_spk_), intent(in) :: x,y,z + real(psb_spk_) :: val + + val = szero + + end function s_null_func_3d + + ! + ! subroutine to allocate and fill in the coefficient matrix and + ! the rhs. + ! + subroutine amg_s_gen_pde3d(ctxt,idim,a,bv,xv,desc_a,afmt,& + & a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,partition, nrl,iv) + use psb_base_mod + use psb_util_mod + ! + ! Discretizes the partial differential equation + ! + ! d a1 d(u) d a1 d(u) d a1 d(u) b1 d(u) b2 d(u) b3 d(u) + ! - ------ - ------ - ------ + ----- + ------ + ------ + c u = f + ! dx dx dy dy dz dz dx dy dz + ! + ! with Dirichlet boundary conditions + ! u = g + ! + ! on the unit cube 0<=x,y,z<=1. + ! + ! + ! Note that if b1=b2=b3=c=0., the PDE is the Laplace equation. + ! + implicit none + procedure(s_func_3d) :: b1,b2,b3,c,a1,a2,a3,g + integer(psb_ipk_) :: idim + type(psb_sspmat_type) :: a + type(psb_s_vect_type) :: xv,bv + type(psb_desc_type) :: desc_a + integer(psb_ipk_) :: info + type(psb_ctxt_type) :: ctxt + character :: afmt*5 + procedure(s_func_3d), optional :: f + class(psb_s_base_sparse_mat), optional :: amold + class(psb_s_base_vect_type), optional :: vmold + integer(psb_ipk_), optional :: partition, nrl,iv(:) + + ! Local variables. + + integer(psb_ipk_), parameter :: nb=20 + type(psb_s_csc_sparse_mat) :: acsc + type(psb_s_coo_sparse_mat) :: acoo + type(psb_s_csr_sparse_mat) :: acsr + real(psb_spk_) :: zt(nb),x,y,z,xph,xmh,yph,ymh,zph,zmh + integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_ + integer(psb_lpk_) :: m,n,glob_row,nt + integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner + ! For 3D partition + ! Note: integer control variables going directly into an MPI call + ! must be 4 bytes, i.e. psb_mpk_ + integer(psb_mpk_) :: npdims(3), npp, minfo + integer(psb_ipk_) :: npx,npy,npz, iamx,iamy,iamz,mynx,myny,mynz + integer(psb_ipk_), allocatable :: bndx(:),bndy(:),bndz(:) + ! Process grid + integer(psb_ipk_) :: np, iam + integer(psb_ipk_) :: icoeff + integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:) + real(psb_spk_), allocatable :: val(:) + ! deltah dimension of each grid cell + ! deltat discretization time + real(psb_spk_) :: deltah, sqdeltah, deltah2 + real(psb_spk_), parameter :: rhs=szero,one=sone,zero=szero + real(psb_dpk_) :: t0, t1, t2, t3, tasb, talc, ttot, tgen, tcdasb + integer(psb_ipk_) :: err_act + procedure(s_func_3d), pointer :: f_ + character(len=20) :: name, ch_err,tmpfmt + + info = psb_success_ + name = 's_create_matrix' + call psb_erractionsave(err_act) + + call psb_info(ctxt, iam, np) + + + if (present(f)) then + f_ => f + else + f_ => s_null_func_3d + end if + + if (present(partition)) then + if ((1<= partition).and.(partition <= 3)) then + partition_ = partition + else + write(*,*) 'Invalid partition choice ',partition,' defaulting to 3' + partition_ = 3 + end if + else + partition_ = 3 + end if + deltah = sone/(idim+2) + sqdeltah = deltah*deltah + deltah2 = 2.0_psb_spk_* deltah + + if (present(partition)) then + if ((1<= partition).and.(partition <= 3)) then + partition_ = partition + else + write(*,*) 'Invalid partition choice ',partition,' defaulting to 3' + partition_ = 3 + end if + else + partition_ = 3 + end if + + ! initialize array descriptor and sparse matrix storage. provide an + ! estimate of the number of non zeroes + + m = (1_psb_lpk_*idim)*idim*idim + n = m + nnz = 7*((n+np-1)/np) + if(iam == psb_root_) write(psb_out_unit,'("Generating Matrix (size=",i0,")...")')n + t0 = psb_wtime() + select case(partition_) + case(1) + ! A BLOCK partition + if (present(nrl)) then + nr = nrl + else + ! + ! Using a simple BLOCK distribution. + ! + nt = (m+np-1)/np + nr = max(0,min(nt,m-(iam*nt))) + end if + + nt = nr + call psb_sum(ctxt,nt) + if (nt /= m) then + write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + return + end if + + ! + ! First example of use of CDALL: specify for each process a number of + ! contiguous rows + ! + call psb_cdall(ctxt,desc_a,info,nl=nr) + myidx = desc_a%get_global_indices() + nlr = size(myidx) + + case(2) + ! A partition defined by the user through IV + + if (present(iv)) then + if (size(iv) /= m) then + write(psb_err_unit,*) iam, 'Initialization error: wrong IV size',size(iv),m + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + return + end if + else + write(psb_err_unit,*) iam, 'Initialization error: IV not present' + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + return + end if + + ! + ! Second example of use of CDALL: specify for each row the + ! process that owns it + ! + call psb_cdall(ctxt,desc_a,info,vg=iv) + myidx = desc_a%get_global_indices() + nlr = size(myidx) + + case(3) + ! A 3-dimensional partition + + ! A nifty MPI function will split the process list + npdims = 0 + call mpi_dims_create(np,3,npdims,info) + npx = npdims(1) + npy = npdims(2) + npz = npdims(3) + + allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz)) + ! We can reuse idx2ijk for process indices as well. + call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0) + ! Now let's split the 3D cube in hexahedra + call dist1Didx(bndx,idim,npx) + mynx = bndx(iamx+1)-bndx(iamx) + call dist1Didx(bndy,idim,npy) + myny = bndy(iamy+1)-bndy(iamy) + call dist1Didx(bndz,idim,npz) + mynz = bndz(iamz+1)-bndz(iamz) + + ! How many indices do I own? + nlr = mynx*myny*mynz + allocate(myidx(nlr)) + ! Now, let's generate the list of indices I own + nr = 0 + do i=bndx(iamx),bndx(iamx+1)-1 + do j=bndy(iamy),bndy(iamy+1)-1 + do k=bndz(iamz),bndz(iamz+1)-1 + nr = nr + 1 + call ijk2idx(myidx(nr),i,j,k,idim,idim,idim) + end do + end do + end do + if (nr /= nlr) then + write(psb_err_unit,*) iam,iamx,iamy,iamz, 'Initialization error: NR vs NLR ',& + & nr,nlr,mynx,myny,mynz + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + end if + + ! + ! Third example of use of CDALL: specify for each process + ! the set of global indices it owns. + ! + call psb_cdall(ctxt,desc_a,info,vl=myidx) + + case default + write(psb_err_unit,*) iam, 'Initialization error: should not get here' + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + return + end select + + + if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz) + ! define rhs from boundary conditions; also build initial guess + if (info == psb_success_) call psb_geall(xv,desc_a,info) + if (info == psb_success_) call psb_geall(bv,desc_a,info) + + call psb_barrier(ctxt) + talc = psb_wtime()-t0 + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='allocation rout.' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + ! we build an auxiliary matrix consisting of one row at a + ! time; just a small matrix. might be extended to generate + ! a bunch of rows per call. + ! + allocate(val(20*nb),irow(20*nb),& + &icol(20*nb),stat=info) + if (info /= psb_success_ ) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + + ! loop over rows belonging to current process in a block + ! distribution. + + call psb_barrier(ctxt) + t1 = psb_wtime() + do ii=1, nlr,nb + ib = min(nb,nlr-ii+1) + icoeff = 1 + do k=1,ib + i=ii+k-1 + ! local matrix pointer + glob_row=myidx(i) + ! compute gridpoint coordinates + call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim) + ! x, y, z coordinates + x = (ix-1)*deltah + y = (iy-1)*deltah + z = (iz-1)*deltah + zt(k) = f_(x,y,z) + ! internal point: build discretization + ! + ! term depending on (x-1,y,z) + ! + val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2 + if (ix == 1) then + zt(k) = g(szero,y,z)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x,y-1,z) + val(icoeff) = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2 + if (iy == 1) then + zt(k) = g(x,szero,z)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x,y,z-1) + val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2 + if (iz == 1) then + zt(k) = g(x,y,szero)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + + ! term depending on (x,y,z) + val(icoeff)=(2*sone)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah & + & + c(x,y,z) + call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + ! term depending on (x,y,z+1) + val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2 + if (iz == idim) then + zt(k) = g(x,y,sone)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x,y+1,z) + val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2 + if (iy == idim) then + zt(k) = g(x,sone,z)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x+1,y,z) + val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2 + if (ix==idim) then + zt(k) = g(sone,y,z)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + + end do + call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) exit + call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) + if(info /= psb_success_) exit + zt(:)=szero + call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) + if(info /= psb_success_) exit + end do + + tgen = psb_wtime()-t1 + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='insert rout.' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + deallocate(val,irow,icol) + + call psb_barrier(ctxt) + t1 = psb_wtime() + call psb_cdasb(desc_a,info) + tcdasb = psb_wtime()-t1 + call psb_barrier(ctxt) + t1 = psb_wtime() + if (info == psb_success_) then + if (present(amold)) then + call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold) + else + call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) + end if + end if + call psb_barrier(ctxt) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='asb rout.' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + if (info == psb_success_) call psb_geasb(xv,desc_a,info,mold=vmold) + if (info == psb_success_) call psb_geasb(bv,desc_a,info,mold=vmold) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='asb rout.' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + tasb = psb_wtime()-t1 + call psb_barrier(ctxt) + ttot = psb_wtime() - t0 + + call psb_amx(ctxt,talc) + call psb_amx(ctxt,tgen) + call psb_amx(ctxt,tasb) + call psb_amx(ctxt,ttot) + if(iam == psb_root_) then + tmpfmt = a%get_fmt() + write(psb_out_unit,'("The matrix has been generated and assembled in ",a3," format.")')& + & tmpfmt + write(psb_out_unit,'("-allocation time : ",es12.5)') talc + write(psb_out_unit,'("-coeff. gen. time : ",es12.5)') tgen + write(psb_out_unit,'("-desc asbly time : ",es12.5)') tcdasb + write(psb_out_unit,'("- mat asbly time : ",es12.5)') tasb + write(psb_out_unit,'("-total time : ",es12.5)') ttot + + 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(ctxt) + return + end if + return + end subroutine amg_s_gen_pde3d + + + + ! + ! subroutine to allocate and fill in the coefficient matrix and + ! the rhs. + ! + subroutine amg_s_gen_pde2d(ctxt,idim,a,bv,xv,desc_a,afmt,& + & a1,a2,b1,b2,c,g,info,f,amold,vmold,partition, nrl,iv) + use psb_base_mod + use psb_util_mod + ! + ! Discretizes the partial differential equation + ! + ! d d(u) d d(u) b1 d(u) b2 d(u) + ! - -- a1 ---- - -- a1 ---- + ----- + ------ + c u = f + ! dx dx dy dy dx dy + ! + ! with Dirichlet boundary conditions + ! u = g + ! + ! on the unit square 0<=x,y<=1. + ! + ! + ! Note that if b1=b2=c=0., the PDE is the Laplace equation. + ! + implicit none + procedure(s_func_2d) :: b1,b2,c,a1,a2,g + integer(psb_ipk_) :: idim + type(psb_sspmat_type) :: a + type(psb_s_vect_type) :: xv,bv + type(psb_desc_type) :: desc_a + integer(psb_ipk_) :: info + type(psb_ctxt_type) :: ctxt + character :: afmt*5 + procedure(s_func_2d), optional :: f + class(psb_s_base_sparse_mat), optional :: amold + class(psb_s_base_vect_type), optional :: vmold + integer(psb_ipk_), optional :: partition, nrl,iv(:) + ! Local variables. + + integer(psb_ipk_), parameter :: nb=20 + type(psb_s_csc_sparse_mat) :: acsc + type(psb_s_coo_sparse_mat) :: acoo + type(psb_s_csr_sparse_mat) :: acsr + real(psb_spk_) :: zt(nb),x,y,z,xph,xmh,yph,ymh,zph,zmh + integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_ + integer(psb_lpk_) :: m,n,glob_row,nt + integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner + ! For 2D partition + ! Note: integer control variables going directly into an MPI call + ! must be 4 bytes, i.e. psb_mpk_ + integer(psb_mpk_) :: npdims(2), npp, minfo + integer(psb_ipk_) :: npx,npy,iamx,iamy,mynx,myny + integer(psb_ipk_), allocatable :: bndx(:),bndy(:) + ! Process grid + integer(psb_ipk_) :: np, iam + integer(psb_ipk_) :: icoeff + integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:) + real(psb_spk_), allocatable :: val(:) + ! deltah dimension of each grid cell + ! deltat discretization time + real(psb_spk_) :: deltah, sqdeltah, deltah2, dd + real(psb_spk_), parameter :: rhs=0.d0,one=sone,zero=0.d0 + real(psb_dpk_) :: t0, t1, t2, t3, tasb, talc, ttot, tgen, tcdasb + integer(psb_ipk_) :: err_act + procedure(s_func_2d), pointer :: f_ + character(len=20) :: name, ch_err,tmpfmt + + info = psb_success_ + name = 'create_matrix' + call psb_erractionsave(err_act) + + call psb_info(ctxt, iam, np) + + + if (present(f)) then + f_ => f + else + f_ => s_null_func_2d + end if + + deltah = sone/(idim+2) + sqdeltah = deltah*deltah + deltah2 = 2.0_psb_spk_* deltah + + + if (present(partition)) then + if ((1<= partition).and.(partition <= 3)) then + partition_ = partition + else + write(*,*) 'Invalid partition choice ',partition,' defaulting to 3' + partition_ = 3 + end if + else + partition_ = 3 + end if + + ! initialize array descriptor and sparse matrix storage. provide an + ! estimate of the number of non zeroes + + m = (1_psb_lpk_)*idim*idim + n = m + nnz = 7*((n+np-1)/np) + if(iam == psb_root_) write(psb_out_unit,'("Generating Matrix (size=",i0,")...")')n + t0 = psb_wtime() + select case(partition_) + case(1) + ! A BLOCK partition + if (present(nrl)) then + nr = nrl + else + ! + ! Using a simple BLOCK distribution. + ! + nt = (m+np-1)/np + nr = max(0,min(nt,m-(iam*nt))) + end if + + nt = nr + call psb_sum(ctxt,nt) + if (nt /= m) then + write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + return + end if + + ! + ! First example of use of CDALL: specify for each process a number of + ! contiguous rows + ! + call psb_cdall(ctxt,desc_a,info,nl=nr) + myidx = desc_a%get_global_indices() + nlr = size(myidx) + + case(2) + ! A partition defined by the user through IV + + if (present(iv)) then + if (size(iv) /= m) then + write(psb_err_unit,*) iam, 'Initialization error: wrong IV size',size(iv),m + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + return + end if + else + write(psb_err_unit,*) iam, 'Initialization error: IV not present' + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + return + end if + + ! + ! Second example of use of CDALL: specify for each row the + ! process that owns it + ! + call psb_cdall(ctxt,desc_a,info,vg=iv) + myidx = desc_a%get_global_indices() + nlr = size(myidx) + + case(3) + ! A 2-dimensional partition + + ! A nifty MPI function will split the process list + npdims = 0 + call mpi_dims_create(np,2,npdims,info) + npx = npdims(1) + npy = npdims(2) + + allocate(bndx(0:npx),bndy(0:npy)) + ! We can reuse idx2ijk for process indices as well. + call idx2ijk(iamx,iamy,iam,npx,npy,base=0) + ! Now let's split the 2D square in rectangles + call dist1Didx(bndx,idim,npx) + mynx = bndx(iamx+1)-bndx(iamx) + call dist1Didx(bndy,idim,npy) + myny = bndy(iamy+1)-bndy(iamy) + + ! How many indices do I own? + nlr = mynx*myny + allocate(myidx(nlr)) + ! Now, let's generate the list of indices I own + nr = 0 + do i=bndx(iamx),bndx(iamx+1)-1 + do j=bndy(iamy),bndy(iamy+1)-1 + nr = nr + 1 + call ijk2idx(myidx(nr),i,j,idim,idim) + end do + end do + if (nr /= nlr) then + write(psb_err_unit,*) iam,iamx,iamy, 'Initialization error: NR vs NLR ',& + & nr,nlr,mynx,myny + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + end if + + ! + ! Third example of use of CDALL: specify for each process + ! the set of global indices it owns. + ! + call psb_cdall(ctxt,desc_a,info,vl=myidx) + + case default + write(psb_err_unit,*) iam, 'Initialization error: should not get here' + info = -1 + call psb_barrier(ctxt) + call psb_abort(ctxt) + return + end select + + + if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz) + ! define rhs from boundary conditions; also build initial guess + if (info == psb_success_) call psb_geall(xv,desc_a,info) + if (info == psb_success_) call psb_geall(bv,desc_a,info) + + call psb_barrier(ctxt) + talc = psb_wtime()-t0 + + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='allocation rout.' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + ! we build an auxiliary matrix consisting of one row at a + ! time; just a small matrix. might be extended to generate + ! a bunch of rows per call. + ! + allocate(val(20*nb),irow(20*nb),& + &icol(20*nb),stat=info) + if (info /= psb_success_ ) then + info=psb_err_alloc_dealloc_ + call psb_errpush(info,name) + goto 9999 + endif + + + ! loop over rows belonging to current process in a block + ! distribution. + + call psb_barrier(ctxt) + t1 = psb_wtime() + do ii=1, nlr,nb + ib = min(nb,nlr-ii+1) + icoeff = 1 + do k=1,ib + i=ii+k-1 + ! local matrix pointer + glob_row=myidx(i) + ! compute gridpoint coordinates + call idx2ijk(ix,iy,glob_row,idim,idim) + ! x, y coordinates + x = (ix-1)*deltah + y = (iy-1)*deltah + + zt(k) = f_(x,y) + ! internal point: build discretization + ! + ! term depending on (x-1,y) + ! + val(icoeff) = -a1(x,y)/sqdeltah-b1(x,y)/deltah2 + if (ix == 1) then + zt(k) = g(szero,y)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix-1,iy,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x,y-1) + val(icoeff) = -a2(x,y)/sqdeltah-b2(x,y)/deltah2 + if (iy == 1) then + zt(k) = g(x,szero)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy-1,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + + ! term depending on (x,y) + val(icoeff)=(2*sone)*(a1(x,y) + a2(x,y))/sqdeltah + c(x,y) + call ijk2idx(icol(icoeff),ix,iy,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + ! term depending on (x,y+1) + val(icoeff)=-a2(x,y)/sqdeltah+b2(x,y)/deltah2 + if (iy == idim) then + zt(k) = g(x,sone)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix,iy+1,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + ! term depending on (x+1,y) + val(icoeff)=-a1(x,y)/sqdeltah+b1(x,y)/deltah2 + if (ix==idim) then + zt(k) = g(sone,y)*(-val(icoeff)) + zt(k) + else + call ijk2idx(icol(icoeff),ix+1,iy,idim,idim) + irow(icoeff) = glob_row + icoeff = icoeff+1 + endif + + end do + call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) + if(info /= psb_success_) exit + call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) + if(info /= psb_success_) exit + zt(:)=szero + call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) + if(info /= psb_success_) exit + end do + + tgen = psb_wtime()-t1 + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='insert rout.' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + deallocate(val,irow,icol) + + call psb_barrier(ctxt) + t1 = psb_wtime() + call psb_cdasb(desc_a,info) + tcdasb = psb_wtime()-t1 + call psb_barrier(ctxt) + t1 = psb_wtime() + if (info == psb_success_) then + if (present(amold)) then + call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold) + else + call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) + end if + end if + call psb_barrier(ctxt) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='asb rout.' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + if (info == psb_success_) call psb_geasb(xv,desc_a,info,mold=vmold) + if (info == psb_success_) call psb_geasb(bv,desc_a,info,mold=vmold) + if(info /= psb_success_) then + info=psb_err_from_subroutine_ + ch_err='asb rout.' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + tasb = psb_wtime()-t1 + call psb_barrier(ctxt) + ttot = psb_wtime() - t0 + + call psb_amx(ctxt,talc) + call psb_amx(ctxt,tgen) + call psb_amx(ctxt,tasb) + call psb_amx(ctxt,ttot) + if(iam == psb_root_) then + tmpfmt = a%get_fmt() + write(psb_out_unit,'("The matrix has been generated and assembled in ",a3," format.")')& + & tmpfmt + write(psb_out_unit,'("-allocation time : ",es12.5)') talc + write(psb_out_unit,'("-coeff. gen. time : ",es12.5)') tgen + write(psb_out_unit,'("-desc asbly time : ",es12.5)') tcdasb + write(psb_out_unit,'("- mat asbly time : ",es12.5)') tasb + write(psb_out_unit,'("-total time : ",es12.5)') ttot + + 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(ctxt) + return + end if + return + end subroutine amg_s_gen_pde2d +end module amg_s_genpde_mod diff --git a/tests/pdegen/amg_s_pde2d.f90 b/tests/pdegen/amg_s_pde2d.f90 index 18078498..4d380e26 100644 --- a/tests/pdegen/amg_s_pde2d.f90 +++ b/tests/pdegen/amg_s_pde2d.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! AMG4PSBLAS version 1.0 ! Algebraic Multigrid Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2020 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante -! +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the AMG4PSBLAS 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 @@ -33,23 +33,23 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! ! File: amg_s_pde2d.f90 ! ! Program: amg_s_pde2d ! This sample program solves a linear system obtained by discretizing a -! PDE with Dirichlet BCs. -! +! PDE with Dirichlet BCs. +! ! ! The PDE is a general second order equation in 2d ! -! a1 dd(u) a2 dd(u) b1 d(u) b2 d(u) +! a1 dd(u) a2 dd(u) b1 d(u) b2 d(u) ! - ------ - ------ ----- + ------ + c u = f -! dxdx dydy dx dy +! dxdx dydy dx dy ! ! with Dirichlet boundary conditions -! u = g +! u = g ! ! on the unit square 0<=x,y<=1. ! @@ -63,495 +63,27 @@ ! 3. A 2D distribution in which the unit square is partitioned ! into rectangles, each one assigned to a process. ! -module amg_s_pde2d_mod - use psb_base_mod, only : psb_spk_, psb_ipk_, psb_desc_type,& - & psb_sspmat_type, psb_s_vect_type, szero,& - & psb_s_base_sparse_mat, psb_s_base_vect_type, psb_i_base_vect_type - - interface - function s_func_2d(x,y) result(val) - import :: psb_spk_ - real(psb_spk_), intent(in) :: x,y - real(psb_spk_) :: val - end function s_func_2d - end interface - - interface amg_gen_pde2d - module procedure amg_s_gen_pde2d - end interface amg_gen_pde2d -contains - - function s_null_func_2d(x,y) result(val) - - real(psb_spk_), intent(in) :: x,y - real(psb_spk_) :: val - - val = szero - - end function s_null_func_2d - - ! - ! functions parametrizing the differential equation - ! - - ! - ! Note: b1 and b2 are the coefficients of the first - ! derivative of the unknown function. The default - ! we apply here is to have them zero, so that the resulting - ! matrix is symmetric/hermitian and suitable for - ! testing with CG and FCG. - ! When testing methods for non-hermitian matrices you can - ! change the B1/B2 functions to e.g. sone/sqrt((2*sone)) - ! - function b1(x,y) - use psb_base_mod, only : psb_spk_, sone, szero - implicit none - real(psb_spk_) :: b1 - real(psb_spk_), intent(in) :: x,y - b1=szero - end function b1 - function b2(x,y) - use psb_base_mod, only : psb_spk_, sone, szero - implicit none - real(psb_spk_) :: b2 - real(psb_spk_), intent(in) :: x,y - b2=szero - end function b2 - function c(x,y) - use psb_base_mod, only : psb_spk_, sone, szero - implicit none - real(psb_spk_) :: c - real(psb_spk_), intent(in) :: x,y - c=0.d0 - end function c - function a1(x,y) - use psb_base_mod, only : psb_spk_, sone, szero - implicit none - real(psb_spk_) :: a1 - real(psb_spk_), intent(in) :: x,y - a1=sone/80 - end function a1 - function a2(x,y) - use psb_base_mod, only : psb_spk_, sone, szero - implicit none - real(psb_spk_) :: a2 - real(psb_spk_), intent(in) :: x,y - a2=sone/80 - end function a2 - function g(x,y) - use psb_base_mod, only : psb_spk_, sone, szero - implicit none - real(psb_spk_) :: g - real(psb_spk_), intent(in) :: x,y - g = szero - if (x == sone) then - g = sone - else if (x == szero) then - g = exp(-y**2) - end if - end function g - - - ! - ! subroutine to allocate and fill in the coefficient matrix and - ! the rhs. - ! - subroutine amg_s_gen_pde2d(ctxt,idim,a,bv,xv,desc_a,afmt,info,& - & f,amold,vmold,imold,partition,nrl,iv) - use psb_base_mod - use psb_util_mod - ! - ! Discretizes the partial differential equation - ! - ! a1 dd(u) a2 dd(u) b1 d(u) b2 d(u) - ! - ------ - ------ + ----- + ------ + c u = f - ! dxdx dydy dx dy - ! - ! with Dirichlet boundary conditions - ! u = g - ! - ! on the unit square 0<=x,y<=1. - ! - ! - ! Note that if b1=b2=c=0., the PDE is the Laplace equation. - ! - implicit none - integer(psb_ipk_) :: idim - type(psb_sspmat_type) :: a - type(psb_s_vect_type) :: xv,bv - type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: info - character(len=*) :: afmt - procedure(s_func_2d), optional :: f - class(psb_s_base_sparse_mat), optional :: amold - class(psb_s_base_vect_type), optional :: vmold - class(psb_i_base_vect_type), optional :: imold - integer(psb_ipk_), optional :: partition, nrl,iv(:) - - ! Local variables. - - integer(psb_ipk_), parameter :: nb=20 - type(psb_s_csc_sparse_mat) :: acsc - type(psb_s_coo_sparse_mat) :: acoo - type(psb_s_csr_sparse_mat) :: acsr - real(psb_spk_) :: zt(nb),x,y,z - integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_ - integer(psb_lpk_) :: m,n,glob_row,nt - integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner - ! For 2D partition - ! Note: integer control variables going directly into an MPI call - ! must be 4 bytes, i.e. psb_mpk_ - integer(psb_mpk_) :: npdims(2), npp, minfo - integer(psb_ipk_) :: npx,npy,iamx,iamy,mynx,myny - integer(psb_ipk_), allocatable :: bndx(:),bndy(:) - ! Process grid - integer(psb_ipk_) :: np, iam - integer(psb_ipk_) :: icoeff - integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:) - real(psb_spk_), allocatable :: val(:) - ! deltah dimension of each grid cell - ! deltat discretization time - real(psb_spk_) :: deltah, sqdeltah, deltah2 - real(psb_spk_), parameter :: rhs=szero,one=sone,zero=szero - real(psb_dpk_) :: t0, t1, t2, t3, tasb, talc, ttot, tgen, tcdasb - integer(psb_ipk_) :: err_act - procedure(s_func_2d), pointer :: f_ - character(len=20) :: name, ch_err,tmpfmt - - info = psb_success_ - name = 'create_matrix' - call psb_erractionsave(err_act) - - call psb_info(ctxt, iam, np) - - - if (present(f)) then - f_ => f - else - f_ => s_null_func_2d - end if - - deltah = sone/(idim+1) - sqdeltah = deltah*deltah - deltah2 = (2*sone)* deltah - - if (present(partition)) then - if ((1<= partition).and.(partition <= 3)) then - partition_ = partition - else - write(*,*) 'Invalid partition choice ',partition,' defaulting to 3' - partition_ = 3 - end if - else - partition_ = 3 - end if - - ! initialize array descriptor and sparse matrix storage. provide an - ! estimate of the number of non zeroes - - m = (1_psb_lpk_)*idim*idim - n = m - nnz = 7*((n+np-1)/np) - if (iam == psb_root_) write(psb_out_unit,'("Generating Matrix (size=",i0,")...")')n - t0 = psb_wtime() - select case(partition_) - case(1) - ! A BLOCK partition - if (present(nrl)) then - nr = nrl - else - ! - ! Using a simple BLOCK distribution. - ! - nt = (m+np-1)/np - nr = max(0,min(nt,m-(iam*nt))) - end if - - nt = nr - call psb_sum(ctxt,nt) - if (nt /= m) then - write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - return - end if - - ! - ! First example of use of CDALL: specify for each process a number of - ! contiguous rows - ! - call psb_cdall(ctxt,desc_a,info,nl=nr) - myidx = desc_a%get_global_indices() - nlr = size(myidx) - - case(2) - ! A partition defined by the user through IV - - if (present(iv)) then - if (size(iv) /= m) then - write(psb_err_unit,*) iam, 'Initialization error: wrong IV size',size(iv),m - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - return - end if - else - write(psb_err_unit,*) iam, 'Initialization error: IV not present' - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - return - end if - - ! - ! Second example of use of CDALL: specify for each row the - ! process that owns it - ! - call psb_cdall(ctxt,desc_a,info,vg=iv) - myidx = desc_a%get_global_indices() - nlr = size(myidx) - - case(3) - ! A 2-dimensional partition - - ! A nifty MPI function will split the process list - npdims = 0 - call mpi_dims_create(np,2,npdims,info) - npx = npdims(1) - npy = npdims(2) - - allocate(bndx(0:npx),bndy(0:npy)) - ! We can reuse idx2ijk for process indices as well. - call idx2ijk(iamx,iamy,iam,npx,npy,base=0) - ! Now let's split the 2D square in rectangles - call dist1Didx(bndx,idim,npx) - mynx = bndx(iamx+1)-bndx(iamx) - call dist1Didx(bndy,idim,npy) - myny = bndy(iamy+1)-bndy(iamy) - - ! How many indices do I own? - nlr = mynx*myny - allocate(myidx(nlr)) - ! Now, let's generate the list of indices I own - nr = 0 - do i=bndx(iamx),bndx(iamx+1)-1 - do j=bndy(iamy),bndy(iamy+1)-1 - nr = nr + 1 - call ijk2idx(myidx(nr),i,j,idim,idim) - end do - end do - if (nr /= nlr) then - write(psb_err_unit,*) iam,iamx,iamy, 'Initialization error: NR vs NLR ',& - & nr,nlr,mynx,myny - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - end if - - ! - ! Third example of use of CDALL: specify for each process - ! the set of global indices it owns. - ! - call psb_cdall(ctxt,desc_a,info,vl=myidx) - - case default - write(psb_err_unit,*) iam, 'Initialization error: should not get here' - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - return - end select - - - if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz) - ! define rhs from boundary conditions; also build initial guess - if (info == psb_success_) call psb_geall(xv,desc_a,info) - if (info == psb_success_) call psb_geall(bv,desc_a,info) - - call psb_barrier(ctxt) - talc = psb_wtime()-t0 - - if (info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='allocation rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - ! we build an auxiliary matrix consisting of one row at a - ! time; just a small matrix. might be extended to generate - ! a bunch of rows per call. - ! - allocate(val(20*nb),irow(20*nb),& - &icol(20*nb),stat=info) - if (info /= psb_success_ ) then - info=psb_err_alloc_dealloc_ - call psb_errpush(info,name) - goto 9999 - endif - - - ! loop over rows belonging to current process in a block - ! distribution. - - call psb_barrier(ctxt) - t1 = psb_wtime() - do ii=1, nlr,nb - ib = min(nb,nlr-ii+1) - icoeff = 1 - do k=1,ib - i=ii+k-1 - ! local matrix pointer - glob_row=myidx(i) - ! compute gridpoint coordinates - call idx2ijk(ix,iy,glob_row,idim,idim) - ! x, y coordinates - x = (ix-1)*deltah - y = (iy-1)*deltah - - zt(k) = f_(x,y) - ! internal point: build discretization - ! - ! term depending on (x-1,y) - ! - val(icoeff) = -a1(x,y)/sqdeltah-b1(x,y)/deltah2 - if (ix == 1) then - zt(k) = g(szero,y)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix-1,iy,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x,y-1) - val(icoeff) = -a2(x,y)/sqdeltah-b2(x,y)/deltah2 - if (iy == 1) then - zt(k) = g(x,szero)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy-1,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - - ! term depending on (x,y) - val(icoeff)=(2*sone)*(a1(x,y) + a2(x,y))/sqdeltah + c(x,y) - call ijk2idx(icol(icoeff),ix,iy,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - ! term depending on (x,y+1) - val(icoeff)=-a2(x,y)/sqdeltah+b2(x,y)/deltah2 - if (iy == idim) then - zt(k) = g(x,sone)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy+1,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x+1,y) - val(icoeff)=-a1(x,y)/sqdeltah+b1(x,y)/deltah2 - if (ix==idim) then - zt(k) = g(sone,y)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix+1,iy,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - - end do - call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) - if(info /= psb_success_) exit - call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) - if(info /= psb_success_) exit - zt(:)=szero - call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) - if(info /= psb_success_) exit - end do - - tgen = psb_wtime()-t1 - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='insert rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - deallocate(val,irow,icol) - - call psb_barrier(ctxt) - t1 = psb_wtime() - call psb_cdasb(desc_a,info,mold=imold) - tcdasb = psb_wtime()-t1 - call psb_barrier(ctxt) - t1 = psb_wtime() - if (info == psb_success_) then - if (present(amold)) then - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold) - else - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - end if - end if - call psb_barrier(ctxt) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='asb rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - if (info == psb_success_) call psb_geasb(xv,desc_a,info,mold=vmold) - if (info == psb_success_) call psb_geasb(bv,desc_a,info,mold=vmold) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='asb rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - tasb = psb_wtime()-t1 - call psb_barrier(ctxt) - ttot = psb_wtime() - t0 - - call psb_amx(ctxt,talc) - call psb_amx(ctxt,tgen) - call psb_amx(ctxt,tasb) - call psb_amx(ctxt,ttot) - if(iam == psb_root_) then - tmpfmt = a%get_fmt() - write(psb_out_unit,'("The matrix has been generated and assembled in ",a3," format.")')& - & tmpfmt - write(psb_out_unit,'("-allocation time : ",es12.5)') talc - write(psb_out_unit,'("-coeff. gen. time : ",es12.5)') tgen - write(psb_out_unit,'("-desc asbly time : ",es12.5)') tcdasb - write(psb_out_unit,'("- mat asbly time : ",es12.5)') tasb - write(psb_out_unit,'("-total time : ",es12.5)') ttot - - end if - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ctxt,err_act) - - return - end subroutine amg_s_gen_pde2d - -end module amg_s_pde2d_mod - - program amg_s_pde2d use psb_base_mod use amg_prec_mod use psb_krylov_mod use psb_util_mod use data_input - use amg_s_pde2d_mod + use amg_s_pde2d_base_mod + use amg_s_pde2d_exp_mod + use amg_s_pde2d_box_mod + use amg_s_genpde_mod + use amg_ainv_mod + use amg_s_ilu_solver implicit none ! input parameters character(len=20) :: kmethd, ptype - character(len=5) :: afmt + character(len=5) :: afmt, pdecoeff integer(psb_ipk_) :: idim integer(psb_epk_) :: system_size - ! miscellaneous + ! miscellaneous real(psb_dpk_) :: t1, t2, tprec, thier, tslv ! sparse matrix and preconditioner @@ -582,6 +114,9 @@ program amg_s_pde2d type(solverdata) :: s_choice ! preconditioner data + type(amg_s_invt_solver_type) :: invtsv + type(amg_s_invk_solver_type) :: invksv + type(amg_s_ainv_solver_type) :: ainvsv type precdata ! preconditioner type @@ -613,7 +148,9 @@ program amg_s_pde2d character(len=16) :: prol ! prolongation over application of AS character(len=16) :: solve ! local subsolver type: ILU, MILU, ILUT, ! UMF, MUMPS, SLU, FWGS, BWGS, JAC + character(len=16) :: variant ! AINV variant: LLK, etc integer(psb_ipk_) :: fill ! fill-in for incomplete LU factorization + integer(psb_ipk_) :: invfill ! Inverse fill-in for INVK real(psb_spk_) :: thr ! threshold for ILUT factorization ! AMG post-smoother; ignored by 1-lev preconditioner @@ -624,8 +161,10 @@ program amg_s_pde2d character(len=16) :: prol2 ! prolongation over application of AS character(len=16) :: solve2 ! local subsolver type: ILU, MILU, ILUT, ! UMF, MUMPS, SLU, FWGS, BWGS, JAC + character(len=16) :: variant2 ! AINV variant: LLK, etc integer(psb_ipk_) :: fill2 ! fill-in for incomplete LU factorization - real(psb_spk_) :: thr2 ! threshold for ILUT factorization + integer(psb_ipk_) :: invfill2 ! Inverse fill-in for INVK + real(psb_spk_) :: thr2 ! threshold for ILUT factorization ! coarsest-level solver character(len=16) :: cmat ! coarsest matrix layout: REPL, DIST @@ -651,7 +190,7 @@ program amg_s_pde2d call psb_init(ctxt) call psb_info(ctxt,iam,np) - if (iam < 0) then + if (iam < 0) then ! This should not happen, but just in case call psb_exit(ctxt) stop @@ -662,22 +201,37 @@ program amg_s_pde2d ! ! Hello world ! - if (iam == psb_root_) then - write(*,*) 'Welcome to MLD2P4 version: ',amg_version_string_ + if (iam == psb_root_) then + write(*,*) 'Welcome to AMG4PSBLAS version: ',amg_version_string_ write(*,*) 'This is the ',trim(name),' sample program' end if ! ! get parameters ! - call get_parms(ctxt,afmt,idim,s_choice,p_choice) + call get_parms(ctxt,afmt,idim,s_choice,p_choice,pdecoeff) ! - ! allocate and fill in the coefficient matrix, rhs and initial guess + ! allocate and fill in the coefficient matrix, rhs and initial guess ! call psb_barrier(ctxt) t1 = psb_wtime() - call amg_gen_pde2d(ctxt,idim,a,b,x,desc_a,afmt,info) + select case(psb_toupper(trim(pdecoeff))) + case("CONST") + call amg_gen_pde2d(ctxt,idim,a,b,x,desc_a,afmt,& + & a1,a2,b1,b2,c,g,info) + case("EXP") + call amg_gen_pde2d(ctxt,idim,a,b,x,desc_a,afmt,& + & a1_exp,a2_exp,b1_exp,b2_exp,c_exp,g_exp,info) + case("BOX") + call amg_gen_pde2d(ctxt,idim,a,b,x,desc_a,afmt,& + & a1_box,a2_box,b1_box,b2_box,c_box,g_box,info) + case default + info=psb_err_from_subroutine_ + ch_err='amg_gen_pdecoeff' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end select call psb_barrier(ctxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then @@ -687,6 +241,8 @@ program amg_s_pde2d goto 9999 end if + if (iam == psb_root_) & + & write(psb_out_unit,'("PDE Coefficients : ",a)')pdecoeff if (iam == psb_root_) & & write(psb_out_unit,'("Overall matrix creation time : ",es12.5)')t2 if (iam == psb_root_) & @@ -702,7 +258,7 @@ program amg_s_pde2d case ('JACOBI','L1-JACOBI','GS','FWGS','FBGS') ! 1-level sweeps from "outer_sweeps" call prec%set('smoother_sweeps', p_choice%jsweeps, info) - + case ('BJAC') call prec%set('smoother_sweeps', p_choice%jsweeps, info) call prec%set('sub_solve', p_choice%solve, info) @@ -717,8 +273,8 @@ program amg_s_pde2d call prec%set('sub_solve', p_choice%solve, info) call prec%set('sub_fillin', p_choice%fill, info) call prec%set('sub_iluthrs', p_choice%thr, info) - - case ('ML') + + case ('ML') ! multilevel preconditioner call prec%set('ml_cycle', p_choice%mlcycle, info) @@ -747,14 +303,26 @@ program amg_s_pde2d call prec%set('smoother_sweeps', p_choice%jsweeps, info) select case (psb_toupper(p_choice%smther)) - case ('GS','BWGS','FBGS','JACOBI','L1-JACOBI') + case ('GS','BWGS','FBGS','JACOBI','L1-JACOBI','L1-FBGS') ! do nothing case default call prec%set('sub_ovr', p_choice%novr, info) call prec%set('sub_restr', p_choice%restr, info) call prec%set('sub_prol', p_choice%prol, info) - call prec%set('sub_solve', p_choice%solve, info) + select case(trim(psb_toupper(p_choice%solve))) + case('INVK') + call prec%set(invksv, info) + case('INVT') + call prec%set(invtsv, info) + case('AINV') + call prec%set(ainvsv, info) + call prec%set('ainv_alg', p_choice%variant, info) + case default + call prec%set('sub_solve', p_choice%solve, info) + end select + call prec%set('sub_fillin', p_choice%fill, info) + call prec%set('inv_fillin', p_choice%invfill, info) call prec%set('sub_iluthrs', p_choice%thr, info) end select @@ -762,14 +330,26 @@ program amg_s_pde2d call prec%set('smoother_type', p_choice%smther2, info,pos='post') call prec%set('smoother_sweeps', p_choice%jsweeps2, info,pos='post') select case (psb_toupper(p_choice%smther2)) - case ('GS','BWGS','FBGS','JACOBI','L1-JACOBI') + case ('GS','BWGS','FBGS','JACOBI','L1-JACOBI','L1-FBGS') ! do nothing case default call prec%set('sub_ovr', p_choice%novr2, info,pos='post') call prec%set('sub_restr', p_choice%restr2, info,pos='post') call prec%set('sub_prol', p_choice%prol2, info,pos='post') - call prec%set('sub_solve', p_choice%solve2, info,pos='post') + select case(trim(psb_toupper(p_choice%solve2))) + case('INVK') + call prec%set(invksv, info, pos='post') + case('INVT') + call prec%set(invtsv, info, pos='post') + case('AINV') + call prec%set(ainvsv, info, pos='post') + call prec%set('ainv_alg', p_choice%variant2, info, pos='post') + case default + call prec%set('sub_solve', p_choice%solve2, info, pos='post') + end select + call prec%set('sub_fillin', p_choice%fill2, info,pos='post') + call prec%set('inv_fillin', p_choice%invfill2, info,pos='post') call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post') end select end if @@ -783,7 +363,7 @@ program amg_s_pde2d call prec%set('coarse_sweeps', p_choice%cjswp, info) end select - + ! build the preconditioner call psb_barrier(ctxt) t1 = psb_wtime() @@ -813,7 +393,7 @@ program amg_s_pde2d end if ! - ! iterative method parameters + ! iterative method parameters ! call psb_barrier(ctxt) t1 = psb_wtime() @@ -853,9 +433,10 @@ program amg_s_pde2d call psb_sum(ctxt,descsize) call psb_sum(ctxt,precsize) call prec%descr(iout=psb_out_unit) - if (iam == psb_root_) then + if (iam == psb_root_) then write(psb_out_unit,'("Computed solution on ",i8," processors")') np write(psb_out_unit,'("Linear system size : ",i12)') system_size + write(psb_out_unit,'("PDE Coefficients : ",a)') trim(pdecoeff) write(psb_out_unit,'("Krylov method : ",a)') trim(s_choice%kmethd) write(psb_out_unit,'("Preconditioner : ",a)') trim(p_choice%descr) write(psb_out_unit,'("Iterations to convergence : ",i12)') iter @@ -877,7 +458,7 @@ program amg_s_pde2d end if - ! + ! ! cleanup storage and exit ! call psb_gefree(b,desc_a,info) @@ -904,7 +485,7 @@ contains ! ! get iteration parameters from standard input ! - subroutine get_parms(ctxt,afmt,idim,solve,prec) + subroutine get_parms(ctxt,afmt,idim,solve,prec,pdecoeff) implicit none @@ -913,6 +494,7 @@ contains character(len=*) :: afmt type(solverdata) :: solve type(precdata) :: prec + character(len=*) :: pdecoeff integer(psb_ipk_) :: iam, nm, np, inp_unit character(len=1024) :: filename @@ -937,6 +519,7 @@ contains ! call read_data(afmt,inp_unit) ! matrix storage format call read_data(idim,inp_unit) ! Discretization grid size + call read_data(pdecoeff,inp_unit) ! PDE Coefficients ! Krylov solver data call read_data(solve%kmethd,inp_unit) ! Krylov solver call read_data(solve%istopc,inp_unit) ! stopping criterion @@ -954,7 +537,9 @@ contains call read_data(prec%restr,inp_unit) ! restriction over application of AS call read_data(prec%prol,inp_unit) ! prolongation over application of AS call read_data(prec%solve,inp_unit) ! local subsolver + call read_data(prec%variant,inp_unit) ! AINV variant call read_data(prec%fill,inp_unit) ! fill-in for incomplete LU + call read_data(prec%invfill,inp_unit) !Inverse fill-in for INVK call read_data(prec%thr,inp_unit) ! threshold for ILUT ! Second smoother/ AMG post-smoother (if NONE ignored in main) call read_data(prec%smther2,inp_unit) ! smoother type @@ -963,7 +548,9 @@ contains call read_data(prec%restr2,inp_unit) ! restriction over application of AS call read_data(prec%prol2,inp_unit) ! prolongation over application of AS call read_data(prec%solve2,inp_unit) ! local subsolver + call read_data(prec%variant2,inp_unit) ! AINV variant call read_data(prec%fill2,inp_unit) ! fill-in for incomplete LU + call read_data(prec%invfill2,inp_unit) !Inverse fill-in for INVK call read_data(prec%thr2,inp_unit) ! threshold for ILUT ! general AMG data call read_data(prec%mlcycle,inp_unit) ! AMG cycle type @@ -998,6 +585,7 @@ contains call psb_bcast(ctxt,afmt) call psb_bcast(ctxt,idim) + call psb_bcast(ctxt,pdecoeff) call psb_bcast(ctxt,solve%kmethd) call psb_bcast(ctxt,solve%istopc) @@ -1010,29 +598,33 @@ contains call psb_bcast(ctxt,prec%ptype) ! broadcast first (pre-)smoother / 1-lev prec data - call psb_bcast(ctxt,prec%smther) + call psb_bcast(ctxt,prec%smther) call psb_bcast(ctxt,prec%jsweeps) call psb_bcast(ctxt,prec%novr) call psb_bcast(ctxt,prec%restr) call psb_bcast(ctxt,prec%prol) call psb_bcast(ctxt,prec%solve) + call psb_bcast(ctxt,prec%variant) call psb_bcast(ctxt,prec%fill) + call psb_bcast(ctxt,prec%invfill) call psb_bcast(ctxt,prec%thr) - ! broadcast second (post-)smoother + ! broadcast second (post-)smoother call psb_bcast(ctxt,prec%smther2) call psb_bcast(ctxt,prec%jsweeps2) call psb_bcast(ctxt,prec%novr2) call psb_bcast(ctxt,prec%restr2) call psb_bcast(ctxt,prec%prol2) call psb_bcast(ctxt,prec%solve2) + call psb_bcast(ctxt,prec%variant2) call psb_bcast(ctxt,prec%fill2) + call psb_bcast(ctxt,prec%invfill2) call psb_bcast(ctxt,prec%thr2) - + ! broadcast AMG parameters call psb_bcast(ctxt,prec%mlcycle) call psb_bcast(ctxt,prec%outer_sweeps) call psb_bcast(ctxt,prec%maxlevs) - + call psb_bcast(ctxt,prec%aggr_prol) call psb_bcast(ctxt,prec%par_aggr_alg) call psb_bcast(ctxt,prec%aggr_ord) @@ -1044,7 +636,7 @@ contains call psb_bcast(ctxt,prec%athresv) end if call psb_bcast(ctxt,prec%athres) - + call psb_bcast(ctxt,prec%csize) call psb_bcast(ctxt,prec%cmat) call psb_bcast(ctxt,prec%csolve) diff --git a/tests/pdegen/amg_s_pde2d_base_mod.f90 b/tests/pdegen/amg_s_pde2d_base_mod.f90 new file mode 100644 index 00000000..a7223a8b --- /dev/null +++ b/tests/pdegen/amg_s_pde2d_base_mod.f90 @@ -0,0 +1,53 @@ +module amg_s_pde2d_base_mod + use psb_base_mod, only : psb_spk_, szero, sone + real(psb_spk_), save, private :: epsilon=sone/80 +contains + subroutine pde_set_parm(dat) + real(psb_spk_), intent(in) :: dat + epsilon = dat + end subroutine pde_set_parm + ! + ! functions parametrizing the differential equation + ! + function b1(x,y) + use psb_base_mod, only : psb_spk_, szero, sone + real(psb_spk_) :: b1 + real(psb_spk_), intent(in) :: x,y + b1 = szero/1.414_psb_spk_ + end function b1 + function b2(x,y) + use psb_base_mod, only : psb_spk_, szero, sone + real(psb_spk_) :: b2 + real(psb_spk_), intent(in) :: x,y + b2 = szero/1.414_psb_spk_ + end function b2 + function c(x,y) + use psb_base_mod, only : psb_spk_, szero, sone + real(psb_spk_) :: c + real(psb_spk_), intent(in) :: x,y + c = szero + end function c + function a1(x,y) + use psb_base_mod, only : psb_spk_, szero, sone + real(psb_spk_) :: a1 + real(psb_spk_), intent(in) :: x,y + a1=sone*epsilon + end function a1 + function a2(x,y) + use psb_base_mod, only : psb_spk_, szero, sone + real(psb_spk_) :: a2 + real(psb_spk_), intent(in) :: x,y + a2=sone*epsilon + end function a2 + function g(x,y) + use psb_base_mod, only : psb_spk_, szero, sone + real(psb_spk_) :: g + real(psb_spk_), intent(in) :: x,y + g = szero + if (x == sone) then + g = sone + else if (x == szero) then + g = sone + end if + end function g +end module amg_s_pde2d_base_mod diff --git a/tests/pdegen/amg_s_pde2d_box_mod.f90 b/tests/pdegen/amg_s_pde2d_box_mod.f90 new file mode 100644 index 00000000..96d3f2f0 --- /dev/null +++ b/tests/pdegen/amg_s_pde2d_box_mod.f90 @@ -0,0 +1,53 @@ +module amg_s_pde2d_box_mod + use psb_base_mod, only : psb_spk_, szero, sone + real(psb_spk_), save, private :: epsilon=sone/80 +contains + subroutine pde_set_parm(dat) + real(psb_spk_), intent(in) :: dat + epsilon = dat + end subroutine pde_set_parm + ! + ! functions parametrizing the differential equation + ! + function b1_box(x,y) + use psb_base_mod, only : psb_spk_, szero, sone + real(psb_spk_) :: b1_box + real(psb_spk_), intent(in) :: x,y + b1_box = sone/1.414_psb_spk_ + end function b1_box + function b2_box(x,y) + use psb_base_mod, only : psb_spk_, szero, sone + real(psb_spk_) :: b2_box + real(psb_spk_), intent(in) :: x,y + b2_box = sone/1.414_psb_spk_ + end function b2_box + function c_box(x,y) + use psb_base_mod, only : psb_spk_, szero, sone + real(psb_spk_) :: c_box + real(psb_spk_), intent(in) :: x,y + c_box = szero + end function c_box + function a1_box(x,y) + use psb_base_mod, only : psb_spk_, szero, sone + real(psb_spk_) :: a1_box + real(psb_spk_), intent(in) :: x,y + a1_box=sone*epsilon + end function a1_box + function a2_box(x,y) + use psb_base_mod, only : psb_spk_, szero, sone + real(psb_spk_) :: a2_box + real(psb_spk_), intent(in) :: x,y + a2_box=sone*epsilon + end function a2_box + function g_box(x,y) + use psb_base_mod, only : psb_spk_, szero, sone + real(psb_spk_) :: g_box + real(psb_spk_), intent(in) :: x,y + g_box = szero + if (x == sone) then + g_box = sone + else if (x == szero) then + g_box = sone + end if + end function g_box +end module amg_s_pde2d_box_mod diff --git a/tests/pdegen/amg_s_pde2d_exp_mod.f90 b/tests/pdegen/amg_s_pde2d_exp_mod.f90 new file mode 100644 index 00000000..bcb944f7 --- /dev/null +++ b/tests/pdegen/amg_s_pde2d_exp_mod.f90 @@ -0,0 +1,53 @@ +module amg_s_pde2d_exp_mod + use psb_base_mod, only : psb_spk_, sone, szero + real(psb_spk_), save, private :: epsilon=sone/80 +contains + subroutine pde_set_parm(dat) + real(psb_spk_), intent(in) :: dat + epsilon = dat + end subroutine pde_set_parm + ! + ! functions parametrizing the differential equation + ! + function b1_exp(x,y) + use psb_base_mod, only : psb_spk_, sone, szero + real(psb_spk_) :: b1_exp + real(psb_spk_), intent(in) :: x,y + b1_exp = szero + end function b1_exp + function b2_exp(x,y) + use psb_base_mod, only : psb_spk_, sone, szero + real(psb_spk_) :: b2_exp + real(psb_spk_), intent(in) :: x,y + b2_exp = szero + end function b2_exp + function c_exp(x,y) + use psb_base_mod, only : psb_spk_, sone, szero + real(psb_spk_) :: c_exp + real(psb_spk_), intent(in) :: x,y + c_exp = szero + end function c_exp + function a1_exp(x,y) + use psb_base_mod, only : psb_spk_, sone, szero + real(psb_spk_) :: a1_exp + real(psb_spk_), intent(in) :: x,y + a1=sone*epsilon*exp(-(x+y)) + end function a1_exp + function a2_exp(x,y) + use psb_base_mod, only : psb_spk_, sone, szero + real(psb_spk_) :: a2_exp + real(psb_spk_), intent(in) :: x,y + a2=sone*epsilon*exp(-(x+y)) + end function a2_exp + function g_exp(x,y) + use psb_base_mod, only : psb_spk_, sone, szero + real(psb_spk_) :: g_exp + real(psb_spk_), intent(in) :: x,y + g_exp = szero + if (x == sone) then + g_exp = sone + else if (x == szero) then + g_exp = sone + end if + end function g_exp +end module amg_s_pde2d_exp_mod diff --git a/tests/pdegen/amg_s_pde3d.f90 b/tests/pdegen/amg_s_pde3d.f90 index 28b44ec2..c17c29db 100644 --- a/tests/pdegen/amg_s_pde3d.f90 +++ b/tests/pdegen/amg_s_pde3d.f90 @@ -1,15 +1,15 @@ -! -! +! +! ! AMG4PSBLAS version 1.0 ! Algebraic Multigrid Package ! based on PSBLAS (Parallel Sparse BLAS version 3.5) -! -! (C) Copyright 2020 -! -! Salvatore Filippone -! Pasqua D'Ambra -! Fabio Durastante -! +! +! (C) Copyright 2020 +! +! Salvatore Filippone +! Pasqua D'Ambra +! Fabio Durastante +! ! Redistribution and use in source and binary forms, with or without ! modification, are permitted provided that the following conditions ! are met: @@ -21,7 +21,7 @@ ! 3. The name of the AMG4PSBLAS 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 @@ -33,24 +33,24 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! +! +! ! ! File: amg_s_pde3d.f90 ! ! Program: amg_s_pde3d ! This sample program solves a linear system obtained by discretizing a -! PDE with Dirichlet BCs. -! +! PDE with Dirichlet BCs. +! ! ! The PDE is a general second order equation in 3d ! -! a1 dd(u) a2 dd(u) a3 dd(u) b1 d(u) b2 d(u) b3 d(u) +! a1 dd(u) a2 dd(u) a3 dd(u) b1 d(u) b2 d(u) b3 d(u) ! - ------ - ------ - ------ + ----- + ------ + ------ + c u = f -! dxdx dydy dzdz dx dy dz +! dxdx dydy dzdz dx dy dz ! ! with Dirichlet boundary conditions -! u = g +! u = g ! ! on the unit cube 0<=x,y,z<=1. ! @@ -64,534 +64,27 @@ ! 3. A 3D distribution in which the unit cube is partitioned ! into subcubes, each one assigned to a process. ! -module amg_s_pde3d_mod - use psb_base_mod, only : psb_spk_, psb_ipk_, psb_lpk_, psb_desc_type,& - & psb_sspmat_type, psb_s_vect_type, szero,& - & psb_s_base_sparse_mat, psb_s_base_vect_type, & - & psb_i_base_vect_type, psb_l_base_vect_type - - interface - function s_func_3d(x,y,z) result(val) - import :: psb_spk_ - real(psb_spk_), intent(in) :: x,y,z - real(psb_spk_) :: val - end function s_func_3d - end interface - - interface amg_gen_pde3d - module procedure amg_s_gen_pde3d - end interface amg_gen_pde3d - - -contains - - function s_null_func_3d(x,y,z) result(val) - - real(psb_spk_), intent(in) :: x,y,z - real(psb_spk_) :: val - - val = szero - - end function s_null_func_3d - ! - ! functions parametrizing the differential equation - ! - ! - ! Note: b1, b2 and b3 are the coefficients of the first - ! derivative of the unknown function. The default - ! we apply here is to have them zero, so that the resulting - ! matrix is symmetric/hermitian and suitable for - ! testing with CG and FCG. - ! When testing methods for non-hermitian matrices you can - ! change the B1/B2/B3 functions to e.g. sone/sqrt((3*sone)) - ! - function b1(x,y,z) - use psb_base_mod, only : psb_spk_, sone, szero - implicit none - real(psb_spk_) :: b1 - real(psb_spk_), intent(in) :: x,y,z - b1=szero - end function b1 - function b2(x,y,z) - use psb_base_mod, only : psb_spk_, sone, szero - implicit none - real(psb_spk_) :: b2 - real(psb_spk_), intent(in) :: x,y,z - b2=szero - end function b2 - function b3(x,y,z) - use psb_base_mod, only : psb_spk_, sone, szero - implicit none - real(psb_spk_) :: b3 - real(psb_spk_), intent(in) :: x,y,z - - b3=szero - end function b3 - function c(x,y,z) - use psb_base_mod, only : psb_spk_, sone, szero - implicit none - real(psb_spk_) :: c - real(psb_spk_), intent(in) :: x,y,z - c=szero - end function c - function a1(x,y,z) - use psb_base_mod, only : psb_spk_, sone, szero - implicit none - real(psb_spk_) :: a1 - real(psb_spk_), intent(in) :: x,y,z - a1=sone/80 - end function a1 - function a2(x,y,z) - use psb_base_mod, only : psb_spk_, sone, szero - implicit none - real(psb_spk_) :: a2 - real(psb_spk_), intent(in) :: x,y,z - a2=sone/80 - end function a2 - function a3(x,y,z) - use psb_base_mod, only : psb_spk_, sone, szero - implicit none - real(psb_spk_) :: a3 - real(psb_spk_), intent(in) :: x,y,z - a3=sone/80 - end function a3 - function g(x,y,z) - use psb_base_mod, only : psb_spk_, sone, szero - implicit none - real(psb_spk_) :: g - real(psb_spk_), intent(in) :: x,y,z - g = szero - if (x == sone) then - g = sone - else if (x == szero) then - g = exp(y**2-z**2) - end if - end function g - - - ! - ! subroutine to allocate and fill in the coefficient matrix and - ! the rhs. - ! - subroutine amg_s_gen_pde3d(ctxt,idim,a,bv,xv,desc_a,afmt,info,& - & f,amold,vmold,imold,partition,nrl,iv) - use psb_base_mod - use psb_util_mod - ! - ! Discretizes the partial differential equation - ! - ! a1 dd(u) a2 dd(u) a3 dd(u) b1 d(u) b2 d(u) b3 d(u) - ! - ------ - ------ - ------ + ----- + ------ + ------ + c u = f - ! dxdx dydy dzdz dx dy dz - ! - ! with Dirichlet boundary conditions - ! u = g - ! - ! on the unit cube 0<=x,y,z<=1. - ! - ! - ! Note that if b1=b2=b3=c=0., the PDE is the Laplace equation. - ! - implicit none - integer(psb_ipk_) :: idim - type(psb_sspmat_type) :: a - type(psb_s_vect_type) :: xv,bv - type(psb_desc_type) :: desc_a - type(psb_ctxt_type) :: ctxt - integer(psb_ipk_) :: info - character(len=*) :: afmt - procedure(s_func_3d), optional :: f - class(psb_s_base_sparse_mat), optional :: amold - class(psb_s_base_vect_type), optional :: vmold - class(psb_i_base_vect_type), optional :: imold - integer(psb_ipk_), optional :: partition, nrl,iv(:) - - ! Local variables. - - integer(psb_ipk_), parameter :: nb=20 - type(psb_s_csc_sparse_mat) :: acsc - type(psb_s_coo_sparse_mat) :: acoo - type(psb_s_csr_sparse_mat) :: acsr - real(psb_spk_) :: zt(nb),x,y,z - integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_ - integer(psb_lpk_) :: m,n,glob_row,nt - integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner - ! For 3D partition - ! Note: integer control variables going directly into an MPI call - ! must be 4 bytes, i.e. psb_mpk_ - integer(psb_mpk_) :: npdims(3), npp, minfo - integer(psb_ipk_) :: npx,npy,npz, iamx,iamy,iamz,mynx,myny,mynz - integer(psb_ipk_), allocatable :: bndx(:),bndy(:),bndz(:) - ! Process grid - integer(psb_ipk_) :: np, iam - integer(psb_ipk_) :: icoeff - integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:) - real(psb_spk_), allocatable :: val(:) - ! deltah dimension of each grid cell - ! deltat discretization time - real(psb_spk_) :: deltah, sqdeltah, deltah2 - real(psb_spk_), parameter :: rhs=szero,one=sone,zero=szero - real(psb_dpk_) :: t0, t1, t2, t3, tasb, talc, ttot, tgen, tcdasb - integer(psb_ipk_) :: err_act - procedure(s_func_3d), pointer :: f_ - character(len=20) :: name, ch_err,tmpfmt - - info = psb_success_ - name = 'create_matrix' - call psb_erractionsave(err_act) - - call psb_info(ctxt, iam, np) - - - if (present(f)) then - f_ => f - else - f_ => s_null_func_3d - end if - - deltah = sone/(idim+1) - sqdeltah = deltah*deltah - deltah2 = (2*sone)* deltah - - if (present(partition)) then - if ((1<= partition).and.(partition <= 3)) then - partition_ = partition - else - write(*,*) 'Invalid partition choice ',partition,' defaulting to 3' - partition_ = 3 - end if - else - partition_ = 3 - end if - - ! initialize array descriptor and sparse matrix storage. provide an - ! estimate of the number of non zeroes - - m = (1_psb_lpk_*idim)*idim*idim - n = m - nnz = 7*((n+np-1)/np) - if(iam == psb_root_) write(psb_out_unit,'("Generating Matrix (size=",i0,")...")')n - t0 = psb_wtime() - select case(partition_) - case(1) - ! A BLOCK partition - if (present(nrl)) then - nr = nrl - else - ! - ! Using a simple BLOCK distribution. - ! - nt = (m+np-1)/np - nr = max(0,min(nt,m-(iam*nt))) - end if - - nt = nr - call psb_sum(ctxt,nt) - if (nt /= m) then - write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - return - end if - - ! - ! First example of use of CDALL: specify for each process a number of - ! contiguous rows - ! - call psb_cdall(ctxt,desc_a,info,nl=nr) - myidx = desc_a%get_global_indices() - nlr = size(myidx) - - case(2) - ! A partition defined by the user through IV - - if (present(iv)) then - if (size(iv) /= m) then - write(psb_err_unit,*) iam, 'Initialization error: wrong IV size',size(iv),m - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - return - end if - else - write(psb_err_unit,*) iam, 'Initialization error: IV not present' - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - return - end if - - ! - ! Second example of use of CDALL: specify for each row the - ! process that owns it - ! - call psb_cdall(ctxt,desc_a,info,vg=iv) - myidx = desc_a%get_global_indices() - nlr = size(myidx) - - case(3) - ! A 3-dimensional partition - - ! A nifty MPI function will split the process list - npdims = 0 - call mpi_dims_create(np,3,npdims,info) - npx = npdims(1) - npy = npdims(2) - npz = npdims(3) - - allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz)) - ! We can reuse idx2ijk for process indices as well. - call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0) - ! Now let's split the 3D cube in hexahedra - call dist1Didx(bndx,idim,npx) - mynx = bndx(iamx+1)-bndx(iamx) - call dist1Didx(bndy,idim,npy) - myny = bndy(iamy+1)-bndy(iamy) - call dist1Didx(bndz,idim,npz) - mynz = bndz(iamz+1)-bndz(iamz) - - ! How many indices do I own? - nlr = mynx*myny*mynz - allocate(myidx(nlr)) - ! Now, let's generate the list of indices I own - nr = 0 - do i=bndx(iamx),bndx(iamx+1)-1 - do j=bndy(iamy),bndy(iamy+1)-1 - do k=bndz(iamz),bndz(iamz+1)-1 - nr = nr + 1 - call ijk2idx(myidx(nr),i,j,k,idim,idim,idim) - end do - end do - end do - if (nr /= nlr) then - write(psb_err_unit,*) iam,iamx,iamy,iamz, 'Initialization error: NR vs NLR ',& - & nr,nlr,mynx,myny,mynz - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - end if - - ! - ! Third example of use of CDALL: specify for each process - ! the set of global indices it owns. - ! - call psb_cdall(ctxt,desc_a,info,vl=myidx) - - case default - write(psb_err_unit,*) iam, 'Initialization error: should not get here' - info = -1 - call psb_barrier(ctxt) - call psb_abort(ctxt) - return - end select - - - if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz) - ! define rhs from boundary conditions; also build initial guess - if (info == psb_success_) call psb_geall(xv,desc_a,info) - if (info == psb_success_) call psb_geall(bv,desc_a,info) - - call psb_barrier(ctxt) - talc = psb_wtime()-t0 - - if (info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='allocation rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - ! we build an auxiliary matrix consisting of one row at a - ! time; just a small matrix. might be extended to generate - ! a bunch of rows per call. - ! - allocate(val(20*nb),irow(20*nb),& - &icol(20*nb),stat=info) - if (info /= psb_success_ ) then - info=psb_err_alloc_dealloc_ - call psb_errpush(info,name) - goto 9999 - endif - - - ! loop over rows belonging to current process in a block - ! distribution. - - call psb_barrier(ctxt) - t1 = psb_wtime() - do ii=1, nlr,nb - ib = min(nb,nlr-ii+1) - icoeff = 1 - do k=1,ib - i=ii+k-1 - ! local matrix pointer - glob_row=myidx(i) - ! compute gridpoint coordinates - call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim) - ! x, y, z coordinates - x = (ix-1)*deltah - y = (iy-1)*deltah - z = (iz-1)*deltah - zt(k) = f_(x,y,z) - ! internal point: build discretization - ! - ! term depending on (x-1,y,z) - ! - val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2 - if (ix == 1) then - zt(k) = g(szero,y,z)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x,y-1,z) - val(icoeff) = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2 - if (iy == 1) then - zt(k) = g(x,szero,z)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x,y,z-1) - val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2 - if (iz == 1) then - zt(k) = g(x,y,szero)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - - ! term depending on (x,y,z) - val(icoeff)=(2*sone)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah & - & + c(x,y,z) - call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - ! term depending on (x,y,z+1) - val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2 - if (iz == idim) then - zt(k) = g(x,y,sone)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x,y+1,z) - val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2 - if (iy == idim) then - zt(k) = g(x,sone,z)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - ! term depending on (x+1,y,z) - val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2 - if (ix==idim) then - zt(k) = g(sone,y,z)*(-val(icoeff)) + zt(k) - else - call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim) - irow(icoeff) = glob_row - icoeff = icoeff+1 - endif - - end do - call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) - if(info /= psb_success_) exit - call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) - if(info /= psb_success_) exit - zt(:)=szero - call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) - if(info /= psb_success_) exit - end do - - tgen = psb_wtime()-t1 - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='insert rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - deallocate(val,irow,icol) - - call psb_barrier(ctxt) - t1 = psb_wtime() - call psb_cdasb(desc_a,info,mold=imold) - tcdasb = psb_wtime()-t1 - call psb_barrier(ctxt) - t1 = psb_wtime() - if (info == psb_success_) then - if (present(amold)) then - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold) - else - call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt) - end if - end if - call psb_barrier(ctxt) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='asb rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - if (info == psb_success_) call psb_geasb(xv,desc_a,info,mold=vmold) - if (info == psb_success_) call psb_geasb(bv,desc_a,info,mold=vmold) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='asb rout.' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - tasb = psb_wtime()-t1 - call psb_barrier(ctxt) - ttot = psb_wtime() - t0 - - call psb_amx(ctxt,talc) - call psb_amx(ctxt,tgen) - call psb_amx(ctxt,tasb) - call psb_amx(ctxt,ttot) - if(iam == psb_root_) then - tmpfmt = a%get_fmt() - write(psb_out_unit,'("The matrix has been generated and assembled in ",a3," format.")')& - & tmpfmt - write(psb_out_unit,'("-allocation time : ",es12.5)') talc - write(psb_out_unit,'("-coeff. gen. time : ",es12.5)') tgen - write(psb_out_unit,'("-desc asbly time : ",es12.5)') tcdasb - write(psb_out_unit,'("- mat asbly time : ",es12.5)') tasb - write(psb_out_unit,'("-total time : ",es12.5)') ttot - - end if - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ctxt,err_act) - - return - end subroutine amg_s_gen_pde3d - -end module amg_s_pde3d_mod - program amg_s_pde3d use psb_base_mod use amg_prec_mod use psb_krylov_mod use psb_util_mod use data_input - use amg_s_pde3d_mod + use amg_s_pde3d_base_mod + use amg_s_pde3d_exp_mod + use amg_s_pde3d_gauss_mod + use amg_s_genpde_mod + use amg_ainv_mod + use amg_s_ilu_solver implicit none ! input parameters character(len=20) :: kmethd, ptype - character(len=5) :: afmt + character(len=5) :: afmt, pdecoeff integer(psb_ipk_) :: idim integer(psb_epk_) :: system_size - ! miscellaneous + ! miscellaneous real(psb_dpk_) :: t1, t2, tprec, thier, tslv ! sparse matrix and preconditioner @@ -622,6 +115,9 @@ program amg_s_pde3d type(solverdata) :: s_choice ! preconditioner data + type(amg_s_invt_solver_type) :: invtsv + type(amg_s_invk_solver_type) :: invksv + type(amg_s_ainv_solver_type) :: ainvsv type precdata ! preconditioner type @@ -653,7 +149,9 @@ program amg_s_pde3d character(len=16) :: prol ! prolongation over application of AS character(len=16) :: solve ! local subsolver type: ILU, MILU, ILUT, ! UMF, MUMPS, SLU, FWGS, BWGS, JAC + character(len=16) :: variant ! AINV variant: LLK, etc integer(psb_ipk_) :: fill ! fill-in for incomplete LU factorization + integer(psb_ipk_) :: invfill ! Inverse fill-in for INVK real(psb_spk_) :: thr ! threshold for ILUT factorization ! AMG post-smoother; ignored by 1-lev preconditioner @@ -664,8 +162,10 @@ program amg_s_pde3d character(len=16) :: prol2 ! prolongation over application of AS character(len=16) :: solve2 ! local subsolver type: ILU, MILU, ILUT, ! UMF, MUMPS, SLU, FWGS, BWGS, JAC + character(len=16) :: variant2 ! AINV variant: LLK, etc integer(psb_ipk_) :: fill2 ! fill-in for incomplete LU factorization - real(psb_spk_) :: thr2 ! threshold for ILUT factorization + integer(psb_ipk_) :: invfill2 ! Inverse fill-in for INVK + real(psb_spk_) :: thr2 ! threshold for ILUT factorization ! coarsest-level solver character(len=16) :: cmat ! coarsest matrix layout: REPL, DIST @@ -691,7 +191,7 @@ program amg_s_pde3d call psb_init(ctxt) call psb_info(ctxt,iam,np) - if (iam < 0) then + if (iam < 0) then ! This should not happen, but just in case call psb_exit(ctxt) stop @@ -702,23 +202,40 @@ program amg_s_pde3d ! ! Hello world ! - if (iam == psb_root_) then - write(*,*) 'Welcome to MLD2P4 version: ',amg_version_string_ + if (iam == psb_root_) then + write(*,*) 'Welcome to AMG4PSBLAS version: ',amg_version_string_ write(*,*) 'This is the ',trim(name),' sample program' end if ! ! get parameters ! - call get_parms(ctxt,afmt,idim,s_choice,p_choice) + call get_parms(ctxt,afmt,idim,s_choice,p_choice,pdecoeff) ! - ! allocate and fill in the coefficient matrix, rhs and initial guess + ! allocate and fill in the coefficient matrix, rhs and initial guess ! call psb_barrier(ctxt) t1 = psb_wtime() - call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,info) + select case(psb_toupper(trim(pdecoeff))) + case("CONST") + call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,& + & a1,a2,a3,b1,b2,b3,c,g,info) + case("EXP") + call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,& + & a1_exp,a2_exp,a3_exp,b1_exp,b2_exp,b3_exp,c_exp,g_exp,info) + case("GAUSS") + call amg_gen_pde3d(ctxt,idim,a,b,x,desc_a,afmt,& + & a1_gauss,a2_gauss,a3_gauss,b1_gauss,b2_gauss,b3_gauss,c_gauss,g_gauss,info) + case default + info=psb_err_from_subroutine_ + ch_err='amg_gen_pdecoeff' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end select + + call psb_barrier(ctxt) t2 = psb_wtime() - t1 if(info /= psb_success_) then @@ -728,6 +245,8 @@ program amg_s_pde3d goto 9999 end if + if (iam == psb_root_) & + & write(psb_out_unit,'("PDE Coefficients : ",a)')pdecoeff if (iam == psb_root_) & & write(psb_out_unit,'("Overall matrix creation time : ",es12.5)')t2 if (iam == psb_root_) & @@ -743,7 +262,7 @@ program amg_s_pde3d case ('JACOBI','L1-JACOBI','GS','FWGS','FBGS') ! 1-level sweeps from "outer_sweeps" call prec%set('smoother_sweeps', p_choice%jsweeps, info) - + case ('BJAC') call prec%set('smoother_sweeps', p_choice%jsweeps, info) call prec%set('sub_solve', p_choice%solve, info) @@ -758,8 +277,8 @@ program amg_s_pde3d call prec%set('sub_solve', p_choice%solve, info) call prec%set('sub_fillin', p_choice%fill, info) call prec%set('sub_iluthrs', p_choice%thr, info) - - case ('ML') + + case ('ML') ! multilevel preconditioner call prec%set('ml_cycle', p_choice%mlcycle, info) @@ -788,14 +307,26 @@ program amg_s_pde3d call prec%set('smoother_sweeps', p_choice%jsweeps, info) select case (psb_toupper(p_choice%smther)) - case ('GS','BWGS','FBGS','JACOBI','L1-JACOBI') + case ('GS','BWGS','FBGS','JACOBI','L1-JACOBI','L1-FBGS') ! do nothing case default call prec%set('sub_ovr', p_choice%novr, info) call prec%set('sub_restr', p_choice%restr, info) call prec%set('sub_prol', p_choice%prol, info) - call prec%set('sub_solve', p_choice%solve, info) + select case(trim(psb_toupper(p_choice%solve))) + case('INVK') + call prec%set(invksv, info) + case('INVT') + call prec%set(invtsv, info) + case('AINV') + call prec%set(ainvsv, info) + call prec%set('ainv_alg', p_choice%variant, info) + case default + call prec%set('sub_solve', p_choice%solve, info) + end select + call prec%set('sub_fillin', p_choice%fill, info) + call prec%set('inv_fillin', p_choice%invfill, info) call prec%set('sub_iluthrs', p_choice%thr, info) end select @@ -803,14 +334,26 @@ program amg_s_pde3d call prec%set('smoother_type', p_choice%smther2, info,pos='post') call prec%set('smoother_sweeps', p_choice%jsweeps2, info,pos='post') select case (psb_toupper(p_choice%smther2)) - case ('GS','BWGS','FBGS','JACOBI','L1-JACOBI') + case ('GS','BWGS','FBGS','JACOBI','L1-JACOBI','L1-FBGS') ! do nothing case default call prec%set('sub_ovr', p_choice%novr2, info,pos='post') call prec%set('sub_restr', p_choice%restr2, info,pos='post') call prec%set('sub_prol', p_choice%prol2, info,pos='post') - call prec%set('sub_solve', p_choice%solve2, info,pos='post') + select case(trim(psb_toupper(p_choice%solve2))) + case('INVK') + call prec%set(invksv, info, pos='post') + case('INVT') + call prec%set(invtsv, info, pos='post') + case('AINV') + call prec%set(ainvsv, info, pos='post') + call prec%set('ainv_alg', p_choice%variant2, info, pos='post') + case default + call prec%set('sub_solve', p_choice%solve2, info, pos='post') + end select + call prec%set('sub_fillin', p_choice%fill2, info,pos='post') + call prec%set('inv_fillin', p_choice%invfill2, info,pos='post') call prec%set('sub_iluthrs', p_choice%thr2, info,pos='post') end select end if @@ -824,7 +367,7 @@ program amg_s_pde3d call prec%set('coarse_sweeps', p_choice%cjswp, info) end select - + ! build the preconditioner call psb_barrier(ctxt) t1 = psb_wtime() @@ -854,7 +397,7 @@ program amg_s_pde3d end if ! - ! iterative method parameters + ! iterative method parameters ! call psb_barrier(ctxt) t1 = psb_wtime() @@ -894,9 +437,10 @@ program amg_s_pde3d call psb_sum(ctxt,descsize) call psb_sum(ctxt,precsize) call prec%descr(iout=psb_out_unit) - if (iam == psb_root_) then + if (iam == psb_root_) then write(psb_out_unit,'("Computed solution on ",i8," processors")') np write(psb_out_unit,'("Linear system size : ",i12)') system_size + write(psb_out_unit,'("PDE Coefficients : ",a)') trim(pdecoeff) write(psb_out_unit,'("Krylov method : ",a)') trim(s_choice%kmethd) write(psb_out_unit,'("Preconditioner : ",a)') trim(p_choice%descr) write(psb_out_unit,'("Iterations to convergence : ",i12)') iter @@ -918,7 +462,7 @@ program amg_s_pde3d end if - ! + ! ! cleanup storage and exit ! call psb_gefree(b,desc_a,info) @@ -945,7 +489,7 @@ contains ! ! get iteration parameters from standard input ! - subroutine get_parms(ctxt,afmt,idim,solve,prec) + subroutine get_parms(ctxt,afmt,idim,solve,prec,pdecoeff) implicit none @@ -954,6 +498,7 @@ contains character(len=*) :: afmt type(solverdata) :: solve type(precdata) :: prec + character(len=*) :: pdecoeff integer(psb_ipk_) :: iam, nm, np, inp_unit character(len=1024) :: filename @@ -978,6 +523,7 @@ contains ! call read_data(afmt,inp_unit) ! matrix storage format call read_data(idim,inp_unit) ! Discretization grid size + call read_data(pdecoeff,inp_unit) ! PDE Coefficients ! Krylov solver data call read_data(solve%kmethd,inp_unit) ! Krylov solver call read_data(solve%istopc,inp_unit) ! stopping criterion @@ -995,7 +541,9 @@ contains call read_data(prec%restr,inp_unit) ! restriction over application of AS call read_data(prec%prol,inp_unit) ! prolongation over application of AS call read_data(prec%solve,inp_unit) ! local subsolver + call read_data(prec%variant,inp_unit) ! AINV variant call read_data(prec%fill,inp_unit) ! fill-in for incomplete LU + call read_data(prec%invfill,inp_unit) !Inverse fill-in for INVK call read_data(prec%thr,inp_unit) ! threshold for ILUT ! Second smoother/ AMG post-smoother (if NONE ignored in main) call read_data(prec%smther2,inp_unit) ! smoother type @@ -1004,7 +552,9 @@ contains call read_data(prec%restr2,inp_unit) ! restriction over application of AS call read_data(prec%prol2,inp_unit) ! prolongation over application of AS call read_data(prec%solve2,inp_unit) ! local subsolver + call read_data(prec%variant2,inp_unit) ! AINV variant call read_data(prec%fill2,inp_unit) ! fill-in for incomplete LU + call read_data(prec%invfill2,inp_unit) !Inverse fill-in for INVK call read_data(prec%thr2,inp_unit) ! threshold for ILUT ! general AMG data call read_data(prec%mlcycle,inp_unit) ! AMG cycle type @@ -1039,6 +589,7 @@ contains call psb_bcast(ctxt,afmt) call psb_bcast(ctxt,idim) + call psb_bcast(ctxt,pdecoeff) call psb_bcast(ctxt,solve%kmethd) call psb_bcast(ctxt,solve%istopc) @@ -1051,29 +602,33 @@ contains call psb_bcast(ctxt,prec%ptype) ! broadcast first (pre-)smoother / 1-lev prec data - call psb_bcast(ctxt,prec%smther) + call psb_bcast(ctxt,prec%smther) call psb_bcast(ctxt,prec%jsweeps) call psb_bcast(ctxt,prec%novr) call psb_bcast(ctxt,prec%restr) call psb_bcast(ctxt,prec%prol) call psb_bcast(ctxt,prec%solve) + call psb_bcast(ctxt,prec%variant) call psb_bcast(ctxt,prec%fill) + call psb_bcast(ctxt,prec%invfill) call psb_bcast(ctxt,prec%thr) - ! broadcast second (post-)smoother + ! broadcast second (post-)smoother call psb_bcast(ctxt,prec%smther2) call psb_bcast(ctxt,prec%jsweeps2) call psb_bcast(ctxt,prec%novr2) call psb_bcast(ctxt,prec%restr2) call psb_bcast(ctxt,prec%prol2) call psb_bcast(ctxt,prec%solve2) + call psb_bcast(ctxt,prec%variant2) call psb_bcast(ctxt,prec%fill2) + call psb_bcast(ctxt,prec%invfill2) call psb_bcast(ctxt,prec%thr2) - + ! broadcast AMG parameters call psb_bcast(ctxt,prec%mlcycle) call psb_bcast(ctxt,prec%outer_sweeps) call psb_bcast(ctxt,prec%maxlevs) - + call psb_bcast(ctxt,prec%aggr_prol) call psb_bcast(ctxt,prec%par_aggr_alg) call psb_bcast(ctxt,prec%aggr_ord) @@ -1085,7 +640,7 @@ contains call psb_bcast(ctxt,prec%athresv) end if call psb_bcast(ctxt,prec%athres) - + call psb_bcast(ctxt,prec%csize) call psb_bcast(ctxt,prec%cmat) call psb_bcast(ctxt,prec%csolve) diff --git a/tests/pdegen/amg_s_pde3d_base_mod.f90 b/tests/pdegen/amg_s_pde3d_base_mod.f90 new file mode 100644 index 00000000..a58a10ca --- /dev/null +++ b/tests/pdegen/amg_s_pde3d_base_mod.f90 @@ -0,0 +1,65 @@ +module amg_s_pde3d_base_mod + use psb_base_mod, only : psb_spk_, sone + real(psb_spk_), save, private :: epsilon=sone/80 +contains + subroutine pde_set_parm(dat) + real(psb_spk_), intent(in) :: dat + epsilon = dat + end subroutine pde_set_parm + ! + ! functions parametrizing the differential equation + ! + function b1(x,y,z) + use psb_base_mod, only : psb_spk_, sone + real(psb_spk_) :: b1 + real(psb_spk_), intent(in) :: x,y,z + b1=sone/sqrt(3.0_psb_spk_) + end function b1 + function b2(x,y,z) + use psb_base_mod, only : psb_spk_, sone + real(psb_spk_) :: b2 + real(psb_spk_), intent(in) :: x,y,z + b2=sone/sqrt(3.0_psb_spk_) + end function b2 + function b3(x,y,z) + use psb_base_mod, only : psb_spk_, sone + real(psb_spk_) :: b3 + real(psb_spk_), intent(in) :: x,y,z + b3=sone/sqrt(3.0_psb_spk_) + end function b3 + function c(x,y,z) + use psb_base_mod, only : psb_spk_, sone + real(psb_spk_) :: c + real(psb_spk_), intent(in) :: x,y,z + c=szero + end function c + function a1(x,y,z) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: a1 + real(psb_spk_), intent(in) :: x,y,z + a1=epsilon + end function a1 + function a2(x,y,z) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: a2 + real(psb_spk_), intent(in) :: x,y,z + a2=epsilon + end function a2 + function a3(x,y,z) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: a3 + real(psb_spk_), intent(in) :: x,y,z + a3=epsilon + end function a3 + function g(x,y,z) + use psb_base_mod, only : psb_spk_, sone, szero + real(psb_spk_) :: g + real(psb_spk_), intent(in) :: x,y,z + g = szero + if (x == sone) then + g = sone + else if (x == szero) then + g = sone + end if + end function g +end module amg_s_pde3d_base_mod diff --git a/tests/pdegen/amg_s_pde3d_exp_mod.f90 b/tests/pdegen/amg_s_pde3d_exp_mod.f90 new file mode 100644 index 00000000..ad8f48c7 --- /dev/null +++ b/tests/pdegen/amg_s_pde3d_exp_mod.f90 @@ -0,0 +1,65 @@ +module amg_s_pde3d_exp_mod + use psb_base_mod, only : psb_spk_, sone + real(psb_spk_), save, private :: epsilon=sone/160 +contains + subroutine pde_set_parm(dat) + real(psb_spk_), intent(in) :: dat + epsilon = dat + end subroutine pde_set_parm + ! + ! functions parametrizing the differential equation + ! + function b1_exp(x,y,z) + use psb_base_mod, only : psb_spk_, szero + real(psb_spk_) :: b1_exp + real(psb_spk_), intent(in) :: x,y,z + b1_exp=szero/sqrt(3.0_psb_spk_) + end function b1_exp + function b2_exp(x,y,z) + use psb_base_mod, only : psb_spk_, szero + real(psb_spk_) :: b2_exp + real(psb_spk_), intent(in) :: x,y,z + b2_exp=szero/sqrt(3.0_psb_spk_) + end function b2_exp + function b3_exp(x,y,z) + use psb_base_mod, only : psb_spk_, szero + real(psb_spk_) :: b3_exp + real(psb_spk_), intent(in) :: x,y,z + b3_exp=szero/sqrt(3.0_psb_spk_) + end function b3_exp + function c_exp(x,y,z) + use psb_base_mod, only : psb_spk_, szero + real(psb_spk_) :: c_exp + real(psb_spk_), intent(in) :: x,y,z + c_exp=szero + end function c_exp + function a1_exp(x,y,z) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: a1_exp + real(psb_spk_), intent(in) :: x,y,z + a1_exp=epsilon*exp(-(x+y+z)) + end function a1_exp + function a2_exp(x,y,z) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: a2_exp + real(psb_spk_), intent(in) :: x,y,z + a2_exp=epsilon*exp(-(x+y+z)) + end function a2_exp + function a3_exp(x,y,z) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: a3_exp + real(psb_spk_), intent(in) :: x,y,z + a3_exp=epsilon*exp(-(x+y+z)) + end function a3_exp + function g_exp(x,y,z) + use psb_base_mod, only : psb_spk_, sone, szero + real(psb_spk_) :: g_exp + real(psb_spk_), intent(in) :: x,y,z + g_exp = szero + if (x == sone) then + g_exp = sone + else if (x == szero) then + g_exp = sone + end if + end function g_exp +end module amg_s_pde3d_exp_mod diff --git a/tests/pdegen/amg_s_pde3d_gauss_mod.f90 b/tests/pdegen/amg_s_pde3d_gauss_mod.f90 new file mode 100644 index 00000000..5e62fa09 --- /dev/null +++ b/tests/pdegen/amg_s_pde3d_gauss_mod.f90 @@ -0,0 +1,65 @@ +module amg_s_pde3d_gauss_mod + use psb_base_mod, only : psb_spk_, sone + real(psb_spk_), save, private :: epsilon=sone/80 +contains + subroutine pde_set_parm(dat) + real(psb_spk_), intent(in) :: dat + epsilon = dat + end subroutine pde_set_parm + ! + ! functions parametrizing the differential equation + ! + function b1_gauss(x,y,z) + use psb_base_mod, only : psb_spk_, sone + real(psb_spk_) :: b1_gauss + real(psb_spk_), intent(in) :: x,y,z + b1_gauss=sone/sqrt(3.0_psb_spk_)-2*x*exp(-(x**2+y**2+z**2)) + end function b1_gauss + function b2_gauss(x,y,z) + use psb_base_mod, only : psb_spk_, sone + real(psb_spk_) :: b2_gauss + real(psb_spk_), intent(in) :: x,y,z + b2_gauss=sone/sqrt(3.0_psb_spk_)-2*y*exp(-(x**2+y**2+z**2)) + end function b2_gauss + function b3_gauss(x,y,z) + use psb_base_mod, only : psb_spk_, sone + real(psb_spk_) :: b3_gauss + real(psb_spk_), intent(in) :: x,y,z + b3_gauss=sone/sqrt(3.0_psb_spk_)-2*z*exp(-(x**2+y**2+z**2)) + end function b3_gauss + function c_gauss(x,y,z) + use psb_base_mod, only : psb_spk_, szero + real(psb_spk_) :: c_gauss + real(psb_spk_), intent(in) :: x,y,z + c=szero + end function c_gauss + function a1_gauss(x,y,z) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: a1_gauss + real(psb_spk_), intent(in) :: x,y,z + a1_gauss=epsilon*exp(-(x**2+y**2+z**2)) + end function a1_gauss + function a2_gauss(x,y,z) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: a2_gauss + real(psb_spk_), intent(in) :: x,y,z + a2_gauss=epsilon*exp(-(x**2+y**2+z**2)) + end function a2_gauss + function a3_gauss(x,y,z) + use psb_base_mod, only : psb_spk_ + real(psb_spk_) :: a3_gauss + real(psb_spk_), intent(in) :: x,y,z + a3_gauss=epsilon*exp(-(x**2+y**2+z**2)) + end function a3_gauss + function g_gauss(x,y,z) + use psb_base_mod, only : psb_spk_, sone, szero + real(psb_spk_) :: g_gauss + real(psb_spk_), intent(in) :: x,y,z + g_gauss = szero + if (x == sone) then + g_gauss = sone + else if (x == szero) then + g_gauss = sone + end if + end function g_gauss +end module amg_s_pde3d_gauss_mod diff --git a/tests/pdegen/runs/amg_pde2d.inp b/tests/pdegen/runs/amg_pde2d.inp index 50f2e9ad..61d0bcec 100644 --- a/tests/pdegen/runs/amg_pde2d.inp +++ b/tests/pdegen/runs/amg_pde2d.inp @@ -1,33 +1,38 @@ %%%%%%%%%%% General arguments % Lines starting with % are ignored. -CSR ! Storage format CSR COO JAD +CSR ! Storage format CSR COO JAD 0200 ! IDIM; domain size. Linear system size is IDIM**2 +CONST ! PDECOEFF: CONST, EXP, BOX Coefficients of the PDE CG ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS FCG GCR RGMRES 2 ! ISTOPC 00500 ! ITMAX 1 ! ITRACE -30 ! IRST (restart for RGMRES and BiCGSTABL) +30 ! IRST (restart for RGMRES and BiCGSTABL) 1.d-6 ! EPS %%%%%%%%%%% Main preconditioner choices %%%%%%%%%%%%%%%% -ML-VCYCLE-FBGS-R-UMF ! Longer descriptive name for preconditioner (up to 20 chars) +ML-VCYCLE-BJAC-D-BJAC ! Longer descriptive name for preconditioner (up to 20 chars) ML ! Preconditioner type: NONE JACOBI GS FBGS BJAC AS ML %%%%%%%%%%% First smoother (for all levels but coarsest) %%%%%%%%%%%%%%%% -BJAC ! Smoother type JACOBI FBGS GS BWGS BJAC AS. For 1-level, repeats previous. +BJAC ! Smoother type JACOBI FBGS GS BWGS BJAC AS. For 1-level, repeats previous. 1 ! Number of sweeps for smoother 0 ! Number of overlap layers for AS preconditioner -HALO ! AS restriction operator: NONE HALO +HALO ! AS restriction operator: NONE HALO NONE ! AS prolongation operator: NONE SUM AVG ILU ! Subdomain solver for BJAC/AS: JACOBI GS BGS ILU ILUT MILU MUMPS SLU UMF +LLK ! AINV variant, ignored otherwise 0 ! Fill level P for ILU(P) and ILU(T,P) +1 ! Inverse Fill level P for INVK 1.d-4 ! Threshold T for ILU(T,P) %%%%%%%%%%% Second smoother, always ignored for non-ML %%%%%%%%%%%%%%%% NONE ! Second (post) smoother, ignored if NONE 1 ! Number of sweeps for (post) smoother 0 ! Number of overlap layers for AS preconditioner -HALO ! AS restriction operator: NONE HALO +HALO ! AS restriction operator: NONE HALO NONE ! AS prolongation operator: NONE SUM AVG ILU ! Subdomain solver for BJAC/AS: JACOBI GS BGS ILU ILUT MILU MUMPS SLU UMF +LLK ! AINV variant, ignored otherwise 0 ! Fill level P for ILU(P) and ILU(T,P) -1.d-4 ! Threshold T for ILU(T,P) +8 ! Inverse Fill level P for INVK +1.d-4 ! Threshold T for ILU(T,P) %%%%%%%%%%% Multilevel parameters %%%%%%%%%%%%%%%% VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MULT ADD 4 ! Number of outer sweeps for ML @@ -39,12 +44,12 @@ NATURAL ! Ordering of aggregation NATURAL DEGREE FILTER ! Filtering of matrix: FILTER NOFILTER -1.5 ! Coarsening ratio, if < 0 use library default -2 ! Number of thresholds in vector, next line ignored if <= 0 -0.05 0.025 ! Thresholds +0.05 0.025 ! Thresholds -0.0100d0 ! Smoothed aggregation threshold, ignored if < 0 %%%%%%%%%%% Coarse level solver %%%%%%%%%%%%%%%% -UMF ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC -UMF ! Coarsest-level subsolver for BJAC: ILU ILUT MILU UMF MUMPS SLU -REPL ! Coarsest-level matrix distribution: DIST REPL +BJAC ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC +ILU ! Coarsest-level subsolver for BJAC: ILU ILUT MILU UMF MUMPS SLU +DIST ! Coarsest-level matrix distribution: DIST REPL 1 ! Coarsest-level fillin P for ILU(P) and ILU(T,P) -1.d-4 ! Coarsest-level threshold T for ILU(T,P) +1.d-4 ! Coarsest-level threshold T for ILU(T,P) 1 ! Number of sweeps for JACOBI/GS/BJAC coarsest-level solver diff --git a/tests/pdegen/runs/amg_pde3d.inp b/tests/pdegen/runs/amg_pde3d.inp index 7d1bcbb7..26e3d719 100644 --- a/tests/pdegen/runs/amg_pde3d.inp +++ b/tests/pdegen/runs/amg_pde3d.inp @@ -1,32 +1,38 @@ %%%%%%%%%%% General arguments % Lines starting with % are ignored. -CSR ! Storage format CSR COO JAD +CSR ! Storage format CSR COO JAD 0080 ! IDIM; domain size. Linear system size is IDIM**3 +CONST ! PDECOEFF: CONST, EXP, GAUSS Coefficients of the PDE BICGSTAB ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS FCG GCR RGMRES 2 ! ISTOPC 00500 ! ITMAX 1 ! ITRACE -30 ! IRST (restart for RGMRES and BiCGSTABL) +30 ! IRST (restart for RGMRES and BiCGSTABL) 1.d-6 ! EPS -ML-VCYCLE-FBGS-R-UMF ! Longer descriptive name for preconditioner (up to 20 chars) +%%%%%%%%%%% Main preconditioner choices %%%%%%%%%%%%%%%% +ML-VCYCLE-BJAC-D-BJAC ! Longer descriptive name for preconditioner (up to 20 chars) ML ! Preconditioner type: NONE JACOBI GS FBGS BJAC AS ML %%%%%%%%%%% First smoother (for all levels but coarsest) %%%%%%%%%%%%%%%% -FBGS ! Smoother type JACOBI FBGS GS BWGS BJAC AS. For 1-level, repeats previous. +FBGS ! Smoother type JACOBI FBGS GS BWGS BJAC AS. For 1-level, repeats previous. 1 ! Number of sweeps for smoother 0 ! Number of overlap layers for AS preconditioner -HALO ! AS restriction operator: NONE HALO +HALO ! AS restriction operator: NONE HALO NONE ! AS prolongation operator: NONE SUM AVG -ILU ! Subdomain solver for BJAC/AS: JACOBI GS BGS ILU ILUT MILU MUMPS SLU UMF +INVK ! Subdomain solver for BJAC/AS: JACOBI GS BGS ILU ILUT MILU MUMPS SLU UMF +LLK ! AINV variant 0 ! Fill level P for ILU(P) and ILU(T,P) +1 ! Inverse Fill level P for INVK 1.d-4 ! Threshold T for ILU(T,P) %%%%%%%%%%% Second smoother, always ignored for non-ML %%%%%%%%%%%%%%%% NONE ! Second (post) smoother, ignored if NONE 1 ! Number of sweeps for (post) smoother 0 ! Number of overlap layers for AS preconditioner -HALO ! AS restriction operator: NONE HALO +HALO ! AS restriction operator: NONE HALO NONE ! AS prolongation operator: NONE SUM AVG ILU ! Subdomain solver for BJAC/AS: JACOBI GS BGS ILU ILUT MILU MUMPS SLU UMF +LLK ! AINV variant 0 ! Fill level P for ILU(P) and ILU(T,P) -1.d-4 ! Threshold T for ILU(T,P) +8 ! Inverse Fill level P for INVK +1.d-4 ! Threshold T for ILU(T,P) %%%%%%%%%%% Multilevel parameters %%%%%%%%%%%%%%%% VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MULT ADD 4 ! Number of outer sweeps for ML @@ -38,12 +44,12 @@ NATURAL ! Ordering of aggregation NATURAL DEGREE NOFILTER ! Filtering of matrix: FILTER NOFILTER -1.5 ! Coarsening ratio, if < 0 use library default -2 ! Number of thresholds in vector, next line ignored if <= 0 -0.05 0.025 ! Thresholds +0.05 0.025 ! Thresholds -0.0100d0 ! Smoothed aggregation threshold, ignored if < 0 %%%%%%%%%%% Coarse level solver %%%%%%%%%%%%%%%% -UMF ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC -UMF ! Coarsest-level subsolver for BJAC: ILU ILUT MILU UMF MUMPS SLU -REPL ! Coarsest-level matrix distribution: DIST REPL +BJAC ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC +ILU ! Coarsest-level subsolver for BJAC: ILU ILUT MILU UMF MUMPS SLU +DIST ! Coarsest-level matrix distribution: DIST REPL 1 ! Coarsest-level fillin P for ILU(P) and ILU(T,P) -1.d-4 ! Coarsest-level threshold T for ILU(T,P) +1.d-4 ! Coarsest-level threshold T for ILU(T,P) 1 ! Number of sweeps for JACOBI/GS/BJAC coarsest-level solver