Switched from RKR to KRM, templated implementation

amgprec/Makefile

@@ -15,7 +15,7 @@ DMODOBJS=amg_d_prec_type.o \
 	amg_d_base_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_rkr_solver.o
+	amg_d_invk_solver.o amg_d_invt_solver.o amg_d_krm_solver.o
 #amg_d_bcmatch_aggregator_mod.o
 
 SMODOBJS=amg_s_prec_type.o amg_s_ilu_fact_mod.o \
@@ -26,7 +26,7 @@ SMODOBJS=amg_s_prec_type.o amg_s_ilu_fact_mod.o \
 	amg_s_base_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 amg_s_rkr_solver.o
+	amg_s_invk_solver.o amg_s_invt_solver.o amg_s_krm_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 \
@@ -36,7 +36,7 @@ ZMODOBJS=amg_z_prec_type.o amg_z_ilu_fact_mod.o \
 	amg_z_base_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 amg_z_rkr_solver.o
+	amg_z_invk_solver.o amg_z_invt_solver.o amg_z_krm_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 \
@@ -46,7 +46,7 @@ CMODOBJS=amg_c_prec_type.o amg_c_ilu_fact_mod.o \
 	amg_c_base_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 amg_c_rkr_solver.o
+	amg_c_invk_solver.o amg_c_invt_solver.o amg_c_krm_solver.o
 
 
 
@@ -80,15 +80,15 @@ 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_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
-amg_s_rkr_solver.o: amg_s_prec_type.o  amg_s_base_solver_mod.o 
-amg_d_rkr_solver.o: amg_d_prec_type.o  amg_d_base_solver_mod.o 
-amg_c_rkr_solver.o: amg_c_prec_type.o  amg_c_base_solver_mod.o 
-amg_z_rkr_solver.o: amg_z_prec_type.o  amg_z_base_solver_mod.o 	
-
-amg_s_prec_mod.o: amg_s_rkr_solver.o
-amg_d_prec_mod.o: amg_d_rkr_solver.o 
-amg_c_prec_mod.o: amg_c_rkr_solver.o 
-amg_z_prec_mod.o: amg_z_rkr_solver.o 
+amg_s_krm_solver.o: amg_s_prec_type.o  amg_s_base_solver_mod.o 
+amg_d_krm_solver.o: amg_d_prec_type.o  amg_d_base_solver_mod.o 
+amg_c_krm_solver.o: amg_c_prec_type.o  amg_c_base_solver_mod.o 
+amg_z_krm_solver.o: amg_z_prec_type.o  amg_z_base_solver_mod.o 	
+
+amg_s_prec_mod.o: amg_s_krm_solver.o
+amg_d_prec_mod.o: amg_d_krm_solver.o 
+amg_c_prec_mod.o: amg_c_krm_solver.o 
+amg_z_prec_mod.o: amg_z_krm_solver.o 
 
 $(SINNEROBJS) $(SOUTEROBJS): $(SMODOBJS)
 $(DINNEROBJS) $(DOUTEROBJS): $(DMODOBJS)

amgprec/amg_c_krm_solver.f90

@@ -0,0 +1,590 @@
+!
+!
+!                             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
+!
+!    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.
+!
+! moved here from amg4psblas-extension
+!
+!
+!                             AMG4PSBLAS  Extensions
+!
+!    (C) Copyright 2019
+!
+!                        Salvatore Filippone  Cranfield University
+!        Pasqua D'Ambra         IAC-CNR, Naples, IT
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+!
+! File: amg_c_krm_solver_mod.f90
+!
+! Module: amg_c_krm_solver_mod
+!
+module amg_c_krm_solver
+
+  use amg_c_base_solver_mod
+  use amg_c_prec_type
+
+  type, extends(amg_c_base_solver_type) :: amg_c_krm_solver_type
+    !
+    logical               :: global
+    character(len=16)     :: method, kprec, sub_solve
+    integer(psb_ipk_)     :: irst, istopc, itmax, itrace, i_sub_solve
+    integer(psb_ipk_)     :: fillin
+    real(psb_spk_)      :: eps
+    type(amg_cprec_type)  :: prec
+    type(psb_desc_type)   :: desc_local
+    type(psb_cspmat_type) :: a_local
+    type(psb_c_vect_type) :: x_local, z_local
+    type(psb_cspmat_type), pointer  :: a=>null()
+  contains
+    !
+    !
+    procedure, pass(sv) :: dump    => c_krm_solver_dmp
+    procedure, pass(sv) :: check   => c_krm_solver_check
+    procedure, pass(sv) :: clone   => c_krm_solver_clone
+    procedure, pass(sv) :: clone_settings   => c_krm_solver_clone_settings
+    procedure, pass(sv) :: cnv     => c_krm_solver_cnv
+    procedure, pass(sv) :: apply_v => amg_c_krm_solver_apply_vect
+    procedure, pass(sv) :: apply_a => amg_c_krm_solver_apply
+    procedure, pass(sv) :: clear_data  => c_krm_solver_clear_data
+    procedure, pass(sv) :: free    => c_krm_solver_free
+    procedure, pass(sv) :: cseti   => c_krm_solver_cseti
+    procedure, pass(sv) :: csetc   => c_krm_solver_csetc
+    procedure, pass(sv) :: csetr   => c_krm_solver_csetr
+    procedure, pass(sv) :: sizeof  => c_krm_solver_sizeof
+    procedure, pass(sv) :: get_nzeros => c_krm_solver_get_nzeros
+    !procedure, nopass   :: get_id  => c_krm_solver_get_id
+    procedure, pass(sv) :: is_global => c_krm_solver_is_global
+    procedure, nopass   :: is_iterative => c_krm_solver_is_iterative
+
+
+    !
+    ! These methods are specific for the new solver type
+    ! and therefore need to be overridden
+    !
+    procedure, pass(sv) :: descr   => c_krm_solver_descr
+    procedure, pass(sv) :: default => c_krm_solver_default
+    procedure, pass(sv) :: build   => amg_c_krm_solver_bld
+    procedure, nopass   :: get_fmt => c_krm_solver_get_fmt
+  end type amg_c_krm_solver_type
+
+
+  private ::  c_krm_solver_get_fmt, c_krm_solver_descr, c_krm_solver_default
+
+  interface
+    subroutine amg_c_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
+         & trans,work,wv,info,init,initu)
+      import :: psb_desc_type, amg_c_krm_solver_type, psb_c_vect_type, psb_spk_, &
+           & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
+      implicit none
+      type(psb_desc_type), intent(in)             :: desc_data
+      class(amg_c_krm_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_krm_solver_apply_vect
+  end interface
+
+  interface
+    subroutine amg_c_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
+         & trans,work,info,init,initu)
+      import :: psb_desc_type, amg_c_krm_solver_type, psb_c_vect_type, psb_spk_, &
+           & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, psb_ipk_
+      implicit none
+      type(psb_desc_type), intent(in)      :: desc_data
+      class(amg_c_krm_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_krm_solver_apply
+  end interface
+
+  interface
+    subroutine amg_c_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
+      import :: psb_desc_type, amg_c_krm_solver_type, psb_c_vect_type, psb_spk_, &
+           & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type,&
+           & psb_ipk_, psb_i_base_vect_type
+      implicit none
+      type(psb_cspmat_type), intent(in), target           :: a
+      Type(psb_desc_type), Intent(inout)                  :: desc_a
+      class(amg_c_krm_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_krm_solver_bld
+  end interface
+
+
+contains
+
+  !
+  !
+  subroutine c_krm_solver_default(sv)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_c_krm_solver_type), intent(inout) :: sv
+
+    sv%method     = 'bicgstab'
+    sv%kprec      = 'bjac'
+    sv%sub_solve  = 'ilu'
+    sv%i_sub_solve  = -1
+    sv%fillin = 1
+    sv%irst   = 30
+    sv%istopc = 2
+    sv%itmax  = 40
+    sv%itrace = -1
+    sv%eps    = 1.d-6
+    sv%global = .false.
+
+    return
+  end subroutine c_krm_solver_default
+
+  function c_krm_solver_get_nzeros(sv) result(val)
+
+    implicit none
+    ! Arguments
+    class(amg_c_krm_solver_type), intent(in) :: sv
+    integer(psb_epk_) :: val
+
+    val = sv%prec%get_nzeros()
+
+    return
+  end function c_krm_solver_get_nzeros
+
+  function c_krm_solver_sizeof(sv) result(val)
+
+    implicit none
+    ! Arguments
+    class(amg_c_krm_solver_type), intent(in) :: sv
+    integer(psb_epk_) :: val
+
+    val = sv%prec%sizeof() + sv%desc_local%sizeof() + sv%a_local%sizeof()
+
+    return
+  end function c_krm_solver_sizeof
+
+
+  subroutine c_krm_solver_check(sv,info)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_c_krm_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)              :: info
+    integer(psb_ipk_) :: err_act
+    character(len=20) :: name='c_krm_solver_check'
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+
+
+    if (info /= psb_success_) goto 9999
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine c_krm_solver_check
+
+  subroutine c_krm_solver_cseti(sv,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_c_krm_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='c_krm_solver_cseti'
+
+    info = psb_success_
+    call psb_erractionsave(err_act)
+
+    select case(psb_toupper(trim(what)))
+    case('KRM_IRST')
+      sv%irst = val
+    case('KRM_ISTOPC')
+      sv%istopc = val
+    case('KRM_ITMAX')
+      sv%itmax = val
+    case('KRM_ITRACE')
+      sv%itrace = val
+    case('KRM_SUB_SOLVE')
+      sv%i_sub_solve = val
+    case('KRM_FILLIN')
+      sv%fillin = val
+    case default
+      call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
+    end select
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine c_krm_solver_cseti
+
+  subroutine c_krm_solver_csetc(sv,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_c_krm_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='c_krm_solver_csetc'
+
+    info = psb_success_
+    call psb_erractionsave(err_act)
+
+
+    select case(psb_toupper(trim(what)))
+    case('KRM_METHOD')
+      sv%method = psb_toupper(trim(val))
+    case('KRM_KPREC')
+      sv%kprec = psb_toupper(trim(val))
+    case('KRM_SUB_SOLVE')
+      sv%sub_solve = psb_toupper(trim(val))
+    case('KRM_GLOBAL')
+      select case(psb_toupper(trim(val)))
+      case('LOCAL','FALSE')
+        sv%global = .false.
+      case('GLOBAL','TRUE')
+        sv%global =.true.
+      end select
+    case default
+      call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
+    end select
+
+
+    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 c_krm_solver_csetc
+
+  subroutine c_krm_solver_csetr(sv,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_c_krm_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='c_krm_solver_csetr'
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+
+    select case(psb_toupper(what))
+    case('KRM_EPS')
+      sv%eps = val
+    case default
+      call sv%amg_c_base_solver_type%set(what,val,info,idx=idx)
+    end select
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine c_krm_solver_csetr
+
+  subroutine c_krm_solver_clear_data(sv,info)
+    use psb_base_mod, only : psb_exit
+    Implicit None
+
+    ! Arguments
+    class(amg_c_krm_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)                :: info
+    integer(psb_ipk_) :: err_act
+    type(psb_ctxt_type)  :: l_ctxt
+    character(len=20)  :: name='c_krm_solver_free'
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+
+    call sv%prec%free(info)
+    call sv%a_local%free()
+    call sv%x_local%free(info)
+    call sv%z_local%free(info)
+    if ((.not.sv%global).and.sv%desc_local%is_ok()) then
+      l_ctxt=sv%desc_local%get_context()
+      call psb_exit(l_ctxt,close=.false.)
+    end if
+    call sv%desc_local%free(info)
+    nullify(sv%a)
+    call psb_erractionrestore(err_act)
+    return
+  end subroutine c_krm_solver_clear_data
+
+
+  subroutine c_krm_solver_free(sv,info)
+    use psb_base_mod, only : psb_exit
+    Implicit None
+
+    ! Arguments
+    class(amg_c_krm_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)                :: info
+    integer(psb_ipk_)  :: err_act
+    type(psb_ctxt_type) :: l_ctxt
+    character(len=20)  :: name='c_krm_solver_free'
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+
+    call sv%clear_data(info)
+
+    call psb_erractionrestore(err_act)
+    return
+  end subroutine c_krm_solver_free
+
+  function c_krm_solver_get_fmt() result(val)
+    implicit none
+    character(len=32)  :: val
+
+    val = "KRM solver"
+  end function c_krm_solver_get_fmt
+
+  subroutine c_krm_solver_descr(sv,info,iout,coarse)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_c_krm_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
+    character(len=20), parameter :: name='amg_c_krm_solver_descr'
+    integer(psb_ipk_) :: iout_
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+    if (present(iout)) then
+      iout_ = iout
+    else
+      iout_ = psb_out_unit
+    endif
+
+    if (sv%global) then
+      write(iout_,*) '  Krylov solver (global)'
+    else
+      write(iout_,*) '  Krylov solver (local) '
+    end if
+    write(iout_,*) '    method: ',sv%method
+    write(iout_,*) '     kprec: ',sv%kprec
+    if (sv%i_sub_solve > 0) then
+      write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
+    else
+      write(iout_,*) ' sub_solve: ',sv%sub_solve
+    end if
+    write(iout_,*) '     itmax: ',sv%itmax
+    write(iout_,*) '       eps: ',sv%eps
+    write(iout_,*) '    fillin: ',sv%fillin
+
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine c_krm_solver_descr
+
+  subroutine c_krm_solver_cnv(sv,info,amold,vmold,imold)
+    implicit none
+    class(amg_c_krm_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
+
+    call sv%prec%cnv(info,amold=amold,vmold=vmold,imold=imold)
+
+  end subroutine c_krm_solver_cnv
+
+  subroutine c_krm_solver_clone(sv,svout,info)
+    Implicit None
+
+    ! Arguments
+    class(amg_c_krm_solver_type), intent(inout)               :: sv
+    class(amg_c_base_solver_type), allocatable, intent(inout) :: svout
+    integer(psb_ipk_), intent(out)              :: info
+
+    info = psb_success_
+
+    call svout%free(info)
+    allocate(svout,stat=info,mold=sv)
+    select type(so=>svout)
+    class is(amg_c_krm_solver_type)
+      so%method = sv%method
+      so%kprec  = sv%kprec
+      so%sub_solve = sv%sub_solve
+      so%i_sub_solve = sv%i_sub_solve
+      so%fillin = sv%fillin
+      so%irst   = sv%irst
+      so%istopc = sv%istopc
+      so%itmax  = sv%itmax
+      so%itrace = sv%itrace
+      so%global = sv%global
+      so%eps    = sv%eps
+      call sv%a_local%clone(so%a_local,info)
+      call sv%desc_local%clone(so%desc_local,info)
+      call sv%prec%clone(so%prec,info)
+    class default
+      info = psb_err_internal_error_
+    end select
+
+  end subroutine c_krm_solver_clone
+
+
+  subroutine c_krm_solver_clone_settings(sv,svout,info)
+    Implicit None
+
+    ! Arguments
+    class(amg_c_krm_solver_type), intent(inout)               :: sv
+    class(amg_c_base_solver_type), intent(inout) :: svout
+    integer(psb_ipk_), intent(out)              :: info
+
+    info = psb_success_
+
+    select type(so=>svout)
+    class is(amg_c_krm_solver_type)
+      so%method = sv%method
+      so%kprec  = sv%kprec
+      so%sub_solve = sv%sub_solve
+      so%i_sub_solve = sv%i_sub_solve
+      so%fillin = sv%fillin
+      so%irst   = sv%irst
+      so%istopc = sv%istopc
+      so%itmax  = sv%itmax
+      so%itrace = sv%itrace
+      so%global = sv%global
+      so%eps    = sv%eps
+    class default
+      info = psb_err_internal_error_
+    end select
+
+  end subroutine c_krm_solver_clone_settings
+
+  subroutine c_krm_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
+    implicit none
+    class(amg_c_krm_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
+
+
+    call sv%prec%dump(info,prefix=prefix,head=head)
+
+  end subroutine c_krm_solver_dmp
+  !
+  ! Notify whether KRM is used as a global solver
+  !
+  function c_krm_solver_is_global(sv) result(val)
+    implicit none
+    class(amg_c_krm_solver_type), intent(in) :: sv
+    logical  :: val
+
+    val = (sv%global)
+  end function c_krm_solver_is_global
+  !
+  function c_krm_solver_is_iterative() result(val)
+    implicit none
+    logical  :: val
+
+    val = .true.
+  end function c_krm_solver_is_iterative
+
+end module amg_c_krm_solver

amgprec/amg_c_prec_mod.f90

@@ -55,7 +55,7 @@ module amg_c_prec_mod
   use amg_c_ainv_solver
   use amg_c_invk_solver
   use amg_c_invt_solver
-  use amg_c_rkr_solver
+  use amg_c_krm_solver
 
   interface amg_extprol_bld
     subroutine amg_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)

amgprec/amg_d_krm_solver.f90

@@ -0,0 +1,590 @@
+!
+!
+!                             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
+!
+!    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.
+!
+! moved here from amg4psblas-extension
+!
+!
+!                             AMG4PSBLAS  Extensions
+!
+!    (C) Copyright 2019
+!
+!                        Salvatore Filippone  Cranfield University
+!        Pasqua D'Ambra         IAC-CNR, Naples, IT
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+!
+! File: amg_d_krm_solver_mod.f90
+!
+! Module: amg_d_krm_solver_mod
+!
+module amg_d_krm_solver
+
+  use amg_d_base_solver_mod
+  use amg_d_prec_type
+
+  type, extends(amg_d_base_solver_type) :: amg_d_krm_solver_type
+    !
+    logical               :: global
+    character(len=16)     :: method, kprec, sub_solve
+    integer(psb_ipk_)     :: irst, istopc, itmax, itrace, i_sub_solve
+    integer(psb_ipk_)     :: fillin
+    real(psb_dpk_)      :: eps
+    type(amg_dprec_type)  :: prec
+    type(psb_desc_type)   :: desc_local
+    type(psb_dspmat_type) :: a_local
+    type(psb_d_vect_type) :: x_local, z_local
+    type(psb_dspmat_type), pointer  :: a=>null()
+  contains
+    !
+    !
+    procedure, pass(sv) :: dump    => d_krm_solver_dmp
+    procedure, pass(sv) :: check   => d_krm_solver_check
+    procedure, pass(sv) :: clone   => d_krm_solver_clone
+    procedure, pass(sv) :: clone_settings   => d_krm_solver_clone_settings
+    procedure, pass(sv) :: cnv     => d_krm_solver_cnv
+    procedure, pass(sv) :: apply_v => amg_d_krm_solver_apply_vect
+    procedure, pass(sv) :: apply_a => amg_d_krm_solver_apply
+    procedure, pass(sv) :: clear_data  => d_krm_solver_clear_data
+    procedure, pass(sv) :: free    => d_krm_solver_free
+    procedure, pass(sv) :: cseti   => d_krm_solver_cseti
+    procedure, pass(sv) :: csetc   => d_krm_solver_csetc
+    procedure, pass(sv) :: csetr   => d_krm_solver_csetr
+    procedure, pass(sv) :: sizeof  => d_krm_solver_sizeof
+    procedure, pass(sv) :: get_nzeros => d_krm_solver_get_nzeros
+    !procedure, nopass   :: get_id  => d_krm_solver_get_id
+    procedure, pass(sv) :: is_global => d_krm_solver_is_global
+    procedure, nopass   :: is_iterative => d_krm_solver_is_iterative
+
+
+    !
+    ! These methods are specific for the new solver type
+    ! and therefore need to be overridden
+    !
+    procedure, pass(sv) :: descr   => d_krm_solver_descr
+    procedure, pass(sv) :: default => d_krm_solver_default
+    procedure, pass(sv) :: build   => amg_d_krm_solver_bld
+    procedure, nopass   :: get_fmt => d_krm_solver_get_fmt
+  end type amg_d_krm_solver_type
+
+
+  private ::  d_krm_solver_get_fmt, d_krm_solver_descr, d_krm_solver_default
+
+  interface
+    subroutine amg_d_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
+         & trans,work,wv,info,init,initu)
+      import :: psb_desc_type, amg_d_krm_solver_type, psb_d_vect_type, psb_dpk_, &
+           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
+      implicit none
+      type(psb_desc_type), intent(in)             :: desc_data
+      class(amg_d_krm_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_krm_solver_apply_vect
+  end interface
+
+  interface
+    subroutine amg_d_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
+         & trans,work,info,init,initu)
+      import :: psb_desc_type, amg_d_krm_solver_type, psb_d_vect_type, psb_dpk_, &
+           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
+      implicit none
+      type(psb_desc_type), intent(in)      :: desc_data
+      class(amg_d_krm_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_krm_solver_apply
+  end interface
+
+  interface
+    subroutine amg_d_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
+      import :: psb_desc_type, amg_d_krm_solver_type, psb_d_vect_type, psb_dpk_, &
+           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
+           & psb_ipk_, psb_i_base_vect_type
+      implicit none
+      type(psb_dspmat_type), intent(in), target           :: a
+      Type(psb_desc_type), Intent(inout)                  :: desc_a
+      class(amg_d_krm_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_krm_solver_bld
+  end interface
+
+
+contains
+
+  !
+  !
+  subroutine d_krm_solver_default(sv)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_d_krm_solver_type), intent(inout) :: sv
+
+    sv%method     = 'bicgstab'
+    sv%kprec      = 'bjac'
+    sv%sub_solve  = 'ilu'
+    sv%i_sub_solve  = -1
+    sv%fillin = 1
+    sv%irst   = 30
+    sv%istopc = 2
+    sv%itmax  = 40
+    sv%itrace = -1
+    sv%eps    = 1.d-6
+    sv%global = .false.
+
+    return
+  end subroutine d_krm_solver_default
+
+  function d_krm_solver_get_nzeros(sv) result(val)
+
+    implicit none
+    ! Arguments
+    class(amg_d_krm_solver_type), intent(in) :: sv
+    integer(psb_epk_) :: val
+
+    val = sv%prec%get_nzeros()
+
+    return
+  end function d_krm_solver_get_nzeros
+
+  function d_krm_solver_sizeof(sv) result(val)
+
+    implicit none
+    ! Arguments
+    class(amg_d_krm_solver_type), intent(in) :: sv
+    integer(psb_epk_) :: val
+
+    val = sv%prec%sizeof() + sv%desc_local%sizeof() + sv%a_local%sizeof()
+
+    return
+  end function d_krm_solver_sizeof
+
+
+  subroutine d_krm_solver_check(sv,info)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_d_krm_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)              :: info
+    integer(psb_ipk_) :: err_act
+    character(len=20) :: name='d_krm_solver_check'
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+
+
+    if (info /= psb_success_) goto 9999
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine d_krm_solver_check
+
+  subroutine d_krm_solver_cseti(sv,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_d_krm_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_krm_solver_cseti'
+
+    info = psb_success_
+    call psb_erractionsave(err_act)
+
+    select case(psb_toupper(trim(what)))
+    case('KRM_IRST')
+      sv%irst = val
+    case('KRM_ISTOPC')
+      sv%istopc = val
+    case('KRM_ITMAX')
+      sv%itmax = val
+    case('KRM_ITRACE')
+      sv%itrace = val
+    case('KRM_SUB_SOLVE')
+      sv%i_sub_solve = val
+    case('KRM_FILLIN')
+      sv%fillin = val
+    case default
+      call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
+    end select
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine d_krm_solver_cseti
+
+  subroutine d_krm_solver_csetc(sv,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_d_krm_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='d_krm_solver_csetc'
+
+    info = psb_success_
+    call psb_erractionsave(err_act)
+
+
+    select case(psb_toupper(trim(what)))
+    case('KRM_METHOD')
+      sv%method = psb_toupper(trim(val))
+    case('KRM_KPREC')
+      sv%kprec = psb_toupper(trim(val))
+    case('KRM_SUB_SOLVE')
+      sv%sub_solve = psb_toupper(trim(val))
+    case('KRM_GLOBAL')
+      select case(psb_toupper(trim(val)))
+      case('LOCAL','FALSE')
+        sv%global = .false.
+      case('GLOBAL','TRUE')
+        sv%global =.true.
+      end select
+    case default
+      call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
+    end select
+
+
+    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 d_krm_solver_csetc
+
+  subroutine d_krm_solver_csetr(sv,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_d_krm_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='d_krm_solver_csetr'
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+
+    select case(psb_toupper(what))
+    case('KRM_EPS')
+      sv%eps = val
+    case default
+      call sv%amg_d_base_solver_type%set(what,val,info,idx=idx)
+    end select
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine d_krm_solver_csetr
+
+  subroutine d_krm_solver_clear_data(sv,info)
+    use psb_base_mod, only : psb_exit
+    Implicit None
+
+    ! Arguments
+    class(amg_d_krm_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)                :: info
+    integer(psb_ipk_) :: err_act
+    type(psb_ctxt_type)  :: l_ctxt
+    character(len=20)  :: name='d_krm_solver_free'
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+
+    call sv%prec%free(info)
+    call sv%a_local%free()
+    call sv%x_local%free(info)
+    call sv%z_local%free(info)
+    if ((.not.sv%global).and.sv%desc_local%is_ok()) then
+      l_ctxt=sv%desc_local%get_context()
+      call psb_exit(l_ctxt,close=.false.)
+    end if
+    call sv%desc_local%free(info)
+    nullify(sv%a)
+    call psb_erractionrestore(err_act)
+    return
+  end subroutine d_krm_solver_clear_data
+
+
+  subroutine d_krm_solver_free(sv,info)
+    use psb_base_mod, only : psb_exit
+    Implicit None
+
+    ! Arguments
+    class(amg_d_krm_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)                :: info
+    integer(psb_ipk_)  :: err_act
+    type(psb_ctxt_type) :: l_ctxt
+    character(len=20)  :: name='d_krm_solver_free'
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+
+    call sv%clear_data(info)
+
+    call psb_erractionrestore(err_act)
+    return
+  end subroutine d_krm_solver_free
+
+  function d_krm_solver_get_fmt() result(val)
+    implicit none
+    character(len=32)  :: val
+
+    val = "KRM solver"
+  end function d_krm_solver_get_fmt
+
+  subroutine d_krm_solver_descr(sv,info,iout,coarse)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_d_krm_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
+    character(len=20), parameter :: name='amg_d_krm_solver_descr'
+    integer(psb_ipk_) :: iout_
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+    if (present(iout)) then
+      iout_ = iout
+    else
+      iout_ = psb_out_unit
+    endif
+
+    if (sv%global) then
+      write(iout_,*) '  Krylov solver (global)'
+    else
+      write(iout_,*) '  Krylov solver (local) '
+    end if
+    write(iout_,*) '    method: ',sv%method
+    write(iout_,*) '     kprec: ',sv%kprec
+    if (sv%i_sub_solve > 0) then
+      write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
+    else
+      write(iout_,*) ' sub_solve: ',sv%sub_solve
+    end if
+    write(iout_,*) '     itmax: ',sv%itmax
+    write(iout_,*) '       eps: ',sv%eps
+    write(iout_,*) '    fillin: ',sv%fillin
+
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine d_krm_solver_descr
+
+  subroutine d_krm_solver_cnv(sv,info,amold,vmold,imold)
+    implicit none
+    class(amg_d_krm_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
+
+    call sv%prec%cnv(info,amold=amold,vmold=vmold,imold=imold)
+
+  end subroutine d_krm_solver_cnv
+
+  subroutine d_krm_solver_clone(sv,svout,info)
+    Implicit None
+
+    ! Arguments
+    class(amg_d_krm_solver_type), intent(inout)               :: sv
+    class(amg_d_base_solver_type), allocatable, intent(inout) :: svout
+    integer(psb_ipk_), intent(out)              :: info
+
+    info = psb_success_
+
+    call svout%free(info)
+    allocate(svout,stat=info,mold=sv)
+    select type(so=>svout)
+    class is(amg_d_krm_solver_type)
+      so%method = sv%method
+      so%kprec  = sv%kprec
+      so%sub_solve = sv%sub_solve
+      so%i_sub_solve = sv%i_sub_solve
+      so%fillin = sv%fillin
+      so%irst   = sv%irst
+      so%istopc = sv%istopc
+      so%itmax  = sv%itmax
+      so%itrace = sv%itrace
+      so%global = sv%global
+      so%eps    = sv%eps
+      call sv%a_local%clone(so%a_local,info)
+      call sv%desc_local%clone(so%desc_local,info)
+      call sv%prec%clone(so%prec,info)
+    class default
+      info = psb_err_internal_error_
+    end select
+
+  end subroutine d_krm_solver_clone
+
+
+  subroutine d_krm_solver_clone_settings(sv,svout,info)
+    Implicit None
+
+    ! Arguments
+    class(amg_d_krm_solver_type), intent(inout)               :: sv
+    class(amg_d_base_solver_type), intent(inout) :: svout
+    integer(psb_ipk_), intent(out)              :: info
+
+    info = psb_success_
+
+    select type(so=>svout)
+    class is(amg_d_krm_solver_type)
+      so%method = sv%method
+      so%kprec  = sv%kprec
+      so%sub_solve = sv%sub_solve
+      so%i_sub_solve = sv%i_sub_solve
+      so%fillin = sv%fillin
+      so%irst   = sv%irst
+      so%istopc = sv%istopc
+      so%itmax  = sv%itmax
+      so%itrace = sv%itrace
+      so%global = sv%global
+      so%eps    = sv%eps
+    class default
+      info = psb_err_internal_error_
+    end select
+
+  end subroutine d_krm_solver_clone_settings
+
+  subroutine d_krm_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
+    implicit none
+    class(amg_d_krm_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
+
+
+    call sv%prec%dump(info,prefix=prefix,head=head)
+
+  end subroutine d_krm_solver_dmp
+  !
+  ! Notify whether KRM is used as a global solver
+  !
+  function d_krm_solver_is_global(sv) result(val)
+    implicit none
+    class(amg_d_krm_solver_type), intent(in) :: sv
+    logical  :: val
+
+    val = (sv%global)
+  end function d_krm_solver_is_global
+  !
+  function d_krm_solver_is_iterative() result(val)
+    implicit none
+    logical  :: val
+
+    val = .true.
+  end function d_krm_solver_is_iterative
+
+end module amg_d_krm_solver

amgprec/amg_d_prec_mod.f90

@@ -55,7 +55,7 @@ module amg_d_prec_mod
   use amg_d_ainv_solver
   use amg_d_invk_solver
   use amg_d_invt_solver
-  use amg_d_rkr_solver
+  use amg_d_krm_solver
 
   interface amg_extprol_bld
     subroutine amg_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)

amgprec/amg_s_krm_solver.f90

@@ -0,0 +1,590 @@
+!
+!
+!                             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
+!
+!    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.
+!
+! moved here from amg4psblas-extension
+!
+!
+!                             AMG4PSBLAS  Extensions
+!
+!    (C) Copyright 2019
+!
+!                        Salvatore Filippone  Cranfield University
+!        Pasqua D'Ambra         IAC-CNR, Naples, IT
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+!
+! File: amg_s_krm_solver_mod.f90
+!
+! Module: amg_s_krm_solver_mod
+!
+module amg_s_krm_solver
+
+  use amg_s_base_solver_mod
+  use amg_s_prec_type
+
+  type, extends(amg_s_base_solver_type) :: amg_s_krm_solver_type
+    !
+    logical               :: global
+    character(len=16)     :: method, kprec, sub_solve
+    integer(psb_ipk_)     :: irst, istopc, itmax, itrace, i_sub_solve
+    integer(psb_ipk_)     :: fillin
+    real(psb_spk_)      :: eps
+    type(amg_sprec_type)  :: prec
+    type(psb_desc_type)   :: desc_local
+    type(psb_sspmat_type) :: a_local
+    type(psb_s_vect_type) :: x_local, z_local
+    type(psb_sspmat_type), pointer  :: a=>null()
+  contains
+    !
+    !
+    procedure, pass(sv) :: dump    => s_krm_solver_dmp
+    procedure, pass(sv) :: check   => s_krm_solver_check
+    procedure, pass(sv) :: clone   => s_krm_solver_clone
+    procedure, pass(sv) :: clone_settings   => s_krm_solver_clone_settings
+    procedure, pass(sv) :: cnv     => s_krm_solver_cnv
+    procedure, pass(sv) :: apply_v => amg_s_krm_solver_apply_vect
+    procedure, pass(sv) :: apply_a => amg_s_krm_solver_apply
+    procedure, pass(sv) :: clear_data  => s_krm_solver_clear_data
+    procedure, pass(sv) :: free    => s_krm_solver_free
+    procedure, pass(sv) :: cseti   => s_krm_solver_cseti
+    procedure, pass(sv) :: csetc   => s_krm_solver_csetc
+    procedure, pass(sv) :: csetr   => s_krm_solver_csetr
+    procedure, pass(sv) :: sizeof  => s_krm_solver_sizeof
+    procedure, pass(sv) :: get_nzeros => s_krm_solver_get_nzeros
+    !procedure, nopass   :: get_id  => s_krm_solver_get_id
+    procedure, pass(sv) :: is_global => s_krm_solver_is_global
+    procedure, nopass   :: is_iterative => s_krm_solver_is_iterative
+
+
+    !
+    ! These methods are specific for the new solver type
+    ! and therefore need to be overridden
+    !
+    procedure, pass(sv) :: descr   => s_krm_solver_descr
+    procedure, pass(sv) :: default => s_krm_solver_default
+    procedure, pass(sv) :: build   => amg_s_krm_solver_bld
+    procedure, nopass   :: get_fmt => s_krm_solver_get_fmt
+  end type amg_s_krm_solver_type
+
+
+  private ::  s_krm_solver_get_fmt, s_krm_solver_descr, s_krm_solver_default
+
+  interface
+    subroutine amg_s_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
+         & trans,work,wv,info,init,initu)
+      import :: psb_desc_type, amg_s_krm_solver_type, psb_s_vect_type, psb_spk_, &
+           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
+      implicit none
+      type(psb_desc_type), intent(in)             :: desc_data
+      class(amg_s_krm_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_krm_solver_apply_vect
+  end interface
+
+  interface
+    subroutine amg_s_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
+         & trans,work,info,init,initu)
+      import :: psb_desc_type, amg_s_krm_solver_type, psb_s_vect_type, psb_spk_, &
+           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, psb_ipk_
+      implicit none
+      type(psb_desc_type), intent(in)      :: desc_data
+      class(amg_s_krm_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_krm_solver_apply
+  end interface
+
+  interface
+    subroutine amg_s_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
+      import :: psb_desc_type, amg_s_krm_solver_type, psb_s_vect_type, psb_spk_, &
+           & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type,&
+           & psb_ipk_, psb_i_base_vect_type
+      implicit none
+      type(psb_sspmat_type), intent(in), target           :: a
+      Type(psb_desc_type), Intent(inout)                  :: desc_a
+      class(amg_s_krm_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_krm_solver_bld
+  end interface
+
+
+contains
+
+  !
+  !
+  subroutine s_krm_solver_default(sv)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_s_krm_solver_type), intent(inout) :: sv
+
+    sv%method     = 'bicgstab'
+    sv%kprec      = 'bjac'
+    sv%sub_solve  = 'ilu'
+    sv%i_sub_solve  = -1
+    sv%fillin = 1
+    sv%irst   = 30
+    sv%istopc = 2
+    sv%itmax  = 40
+    sv%itrace = -1
+    sv%eps    = 1.d-6
+    sv%global = .false.
+
+    return
+  end subroutine s_krm_solver_default
+
+  function s_krm_solver_get_nzeros(sv) result(val)
+
+    implicit none
+    ! Arguments
+    class(amg_s_krm_solver_type), intent(in) :: sv
+    integer(psb_epk_) :: val
+
+    val = sv%prec%get_nzeros()
+
+    return
+  end function s_krm_solver_get_nzeros
+
+  function s_krm_solver_sizeof(sv) result(val)
+
+    implicit none
+    ! Arguments
+    class(amg_s_krm_solver_type), intent(in) :: sv
+    integer(psb_epk_) :: val
+
+    val = sv%prec%sizeof() + sv%desc_local%sizeof() + sv%a_local%sizeof()
+
+    return
+  end function s_krm_solver_sizeof
+
+
+  subroutine s_krm_solver_check(sv,info)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_s_krm_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)              :: info
+    integer(psb_ipk_) :: err_act
+    character(len=20) :: name='s_krm_solver_check'
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+
+
+    if (info /= psb_success_) goto 9999
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine s_krm_solver_check
+
+  subroutine s_krm_solver_cseti(sv,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_s_krm_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='s_krm_solver_cseti'
+
+    info = psb_success_
+    call psb_erractionsave(err_act)
+
+    select case(psb_toupper(trim(what)))
+    case('KRM_IRST')
+      sv%irst = val
+    case('KRM_ISTOPC')
+      sv%istopc = val
+    case('KRM_ITMAX')
+      sv%itmax = val
+    case('KRM_ITRACE')
+      sv%itrace = val
+    case('KRM_SUB_SOLVE')
+      sv%i_sub_solve = val
+    case('KRM_FILLIN')
+      sv%fillin = val
+    case default
+      call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
+    end select
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine s_krm_solver_cseti
+
+  subroutine s_krm_solver_csetc(sv,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_s_krm_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='s_krm_solver_csetc'
+
+    info = psb_success_
+    call psb_erractionsave(err_act)
+
+
+    select case(psb_toupper(trim(what)))
+    case('KRM_METHOD')
+      sv%method = psb_toupper(trim(val))
+    case('KRM_KPREC')
+      sv%kprec = psb_toupper(trim(val))
+    case('KRM_SUB_SOLVE')
+      sv%sub_solve = psb_toupper(trim(val))
+    case('KRM_GLOBAL')
+      select case(psb_toupper(trim(val)))
+      case('LOCAL','FALSE')
+        sv%global = .false.
+      case('GLOBAL','TRUE')
+        sv%global =.true.
+      end select
+    case default
+      call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
+    end select
+
+
+    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 s_krm_solver_csetc
+
+  subroutine s_krm_solver_csetr(sv,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_s_krm_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='s_krm_solver_csetr'
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+
+    select case(psb_toupper(what))
+    case('KRM_EPS')
+      sv%eps = val
+    case default
+      call sv%amg_s_base_solver_type%set(what,val,info,idx=idx)
+    end select
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine s_krm_solver_csetr
+
+  subroutine s_krm_solver_clear_data(sv,info)
+    use psb_base_mod, only : psb_exit
+    Implicit None
+
+    ! Arguments
+    class(amg_s_krm_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)                :: info
+    integer(psb_ipk_) :: err_act
+    type(psb_ctxt_type)  :: l_ctxt
+    character(len=20)  :: name='s_krm_solver_free'
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+
+    call sv%prec%free(info)
+    call sv%a_local%free()
+    call sv%x_local%free(info)
+    call sv%z_local%free(info)
+    if ((.not.sv%global).and.sv%desc_local%is_ok()) then
+      l_ctxt=sv%desc_local%get_context()
+      call psb_exit(l_ctxt,close=.false.)
+    end if
+    call sv%desc_local%free(info)
+    nullify(sv%a)
+    call psb_erractionrestore(err_act)
+    return
+  end subroutine s_krm_solver_clear_data
+
+
+  subroutine s_krm_solver_free(sv,info)
+    use psb_base_mod, only : psb_exit
+    Implicit None
+
+    ! Arguments
+    class(amg_s_krm_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)                :: info
+    integer(psb_ipk_)  :: err_act
+    type(psb_ctxt_type) :: l_ctxt
+    character(len=20)  :: name='s_krm_solver_free'
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+
+    call sv%clear_data(info)
+
+    call psb_erractionrestore(err_act)
+    return
+  end subroutine s_krm_solver_free
+
+  function s_krm_solver_get_fmt() result(val)
+    implicit none
+    character(len=32)  :: val
+
+    val = "KRM solver"
+  end function s_krm_solver_get_fmt
+
+  subroutine s_krm_solver_descr(sv,info,iout,coarse)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_s_krm_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
+    character(len=20), parameter :: name='amg_s_krm_solver_descr'
+    integer(psb_ipk_) :: iout_
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+    if (present(iout)) then
+      iout_ = iout
+    else
+      iout_ = psb_out_unit
+    endif
+
+    if (sv%global) then
+      write(iout_,*) '  Krylov solver (global)'
+    else
+      write(iout_,*) '  Krylov solver (local) '
+    end if
+    write(iout_,*) '    method: ',sv%method
+    write(iout_,*) '     kprec: ',sv%kprec
+    if (sv%i_sub_solve > 0) then
+      write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
+    else
+      write(iout_,*) ' sub_solve: ',sv%sub_solve
+    end if
+    write(iout_,*) '     itmax: ',sv%itmax
+    write(iout_,*) '       eps: ',sv%eps
+    write(iout_,*) '    fillin: ',sv%fillin
+
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine s_krm_solver_descr
+
+  subroutine s_krm_solver_cnv(sv,info,amold,vmold,imold)
+    implicit none
+    class(amg_s_krm_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
+
+    call sv%prec%cnv(info,amold=amold,vmold=vmold,imold=imold)
+
+  end subroutine s_krm_solver_cnv
+
+  subroutine s_krm_solver_clone(sv,svout,info)
+    Implicit None
+
+    ! Arguments
+    class(amg_s_krm_solver_type), intent(inout)               :: sv
+    class(amg_s_base_solver_type), allocatable, intent(inout) :: svout
+    integer(psb_ipk_), intent(out)              :: info
+
+    info = psb_success_
+
+    call svout%free(info)
+    allocate(svout,stat=info,mold=sv)
+    select type(so=>svout)
+    class is(amg_s_krm_solver_type)
+      so%method = sv%method
+      so%kprec  = sv%kprec
+      so%sub_solve = sv%sub_solve
+      so%i_sub_solve = sv%i_sub_solve
+      so%fillin = sv%fillin
+      so%irst   = sv%irst
+      so%istopc = sv%istopc
+      so%itmax  = sv%itmax
+      so%itrace = sv%itrace
+      so%global = sv%global
+      so%eps    = sv%eps
+      call sv%a_local%clone(so%a_local,info)
+      call sv%desc_local%clone(so%desc_local,info)
+      call sv%prec%clone(so%prec,info)
+    class default
+      info = psb_err_internal_error_
+    end select
+
+  end subroutine s_krm_solver_clone
+
+
+  subroutine s_krm_solver_clone_settings(sv,svout,info)
+    Implicit None
+
+    ! Arguments
+    class(amg_s_krm_solver_type), intent(inout)               :: sv
+    class(amg_s_base_solver_type), intent(inout) :: svout
+    integer(psb_ipk_), intent(out)              :: info
+
+    info = psb_success_
+
+    select type(so=>svout)
+    class is(amg_s_krm_solver_type)
+      so%method = sv%method
+      so%kprec  = sv%kprec
+      so%sub_solve = sv%sub_solve
+      so%i_sub_solve = sv%i_sub_solve
+      so%fillin = sv%fillin
+      so%irst   = sv%irst
+      so%istopc = sv%istopc
+      so%itmax  = sv%itmax
+      so%itrace = sv%itrace
+      so%global = sv%global
+      so%eps    = sv%eps
+    class default
+      info = psb_err_internal_error_
+    end select
+
+  end subroutine s_krm_solver_clone_settings
+
+  subroutine s_krm_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
+    implicit none
+    class(amg_s_krm_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
+
+
+    call sv%prec%dump(info,prefix=prefix,head=head)
+
+  end subroutine s_krm_solver_dmp
+  !
+  ! Notify whether KRM is used as a global solver
+  !
+  function s_krm_solver_is_global(sv) result(val)
+    implicit none
+    class(amg_s_krm_solver_type), intent(in) :: sv
+    logical  :: val
+
+    val = (sv%global)
+  end function s_krm_solver_is_global
+  !
+  function s_krm_solver_is_iterative() result(val)
+    implicit none
+    logical  :: val
+
+    val = .true.
+  end function s_krm_solver_is_iterative
+
+end module amg_s_krm_solver

amgprec/amg_s_prec_mod.f90

@@ -55,7 +55,7 @@ module amg_s_prec_mod
   use amg_s_ainv_solver
   use amg_s_invk_solver
   use amg_s_invt_solver
-  use amg_s_rkr_solver
+  use amg_s_krm_solver
 
   interface amg_extprol_bld
     subroutine amg_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)

amgprec/amg_z_krm_solver.f90

@@ -0,0 +1,590 @@
+!
+!
+!                             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
+!
+!    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.
+!
+! moved here from amg4psblas-extension
+!
+!
+!                             AMG4PSBLAS  Extensions
+!
+!    (C) Copyright 2019
+!
+!                        Salvatore Filippone  Cranfield University
+!        Pasqua D'Ambra         IAC-CNR, Naples, IT
+!
+!    Redistribution and use in source and binary forms, with or without
+!    modification, are permitted provided that the following conditions
+!    are met:
+!      1. Redistributions of source code must retain the above copyright
+!         notice, this list of conditions and the following disclaimer.
+!      2. Redistributions in binary form must reproduce the above copyright
+!         notice, this list of conditions, and the following disclaimer in the
+!         documentation and/or other materials provided with the distribution.
+!      3. The name of the MLD2P4 group or the names of its contributors may
+!         not be used to endorse or promote products derived from this
+!         software without specific written permission.
+!
+!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+!    ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+!    TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+!    PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS
+!    BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+!    CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+!    SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+!    INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+!    CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+!    ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+!    POSSIBILITY OF SUCH DAMAGE.
+!
+!
+!
+! File: amg_z_krm_solver_mod.f90
+!
+! Module: amg_z_krm_solver_mod
+!
+module amg_z_krm_solver
+
+  use amg_z_base_solver_mod
+  use amg_z_prec_type
+
+  type, extends(amg_z_base_solver_type) :: amg_z_krm_solver_type
+    !
+    logical               :: global
+    character(len=16)     :: method, kprec, sub_solve
+    integer(psb_ipk_)     :: irst, istopc, itmax, itrace, i_sub_solve
+    integer(psb_ipk_)     :: fillin
+    real(psb_dpk_)      :: eps
+    type(amg_zprec_type)  :: prec
+    type(psb_desc_type)   :: desc_local
+    type(psb_zspmat_type) :: a_local
+    type(psb_z_vect_type) :: x_local, z_local
+    type(psb_zspmat_type), pointer  :: a=>null()
+  contains
+    !
+    !
+    procedure, pass(sv) :: dump    => z_krm_solver_dmp
+    procedure, pass(sv) :: check   => z_krm_solver_check
+    procedure, pass(sv) :: clone   => z_krm_solver_clone
+    procedure, pass(sv) :: clone_settings   => z_krm_solver_clone_settings
+    procedure, pass(sv) :: cnv     => z_krm_solver_cnv
+    procedure, pass(sv) :: apply_v => amg_z_krm_solver_apply_vect
+    procedure, pass(sv) :: apply_a => amg_z_krm_solver_apply
+    procedure, pass(sv) :: clear_data  => z_krm_solver_clear_data
+    procedure, pass(sv) :: free    => z_krm_solver_free
+    procedure, pass(sv) :: cseti   => z_krm_solver_cseti
+    procedure, pass(sv) :: csetc   => z_krm_solver_csetc
+    procedure, pass(sv) :: csetr   => z_krm_solver_csetr
+    procedure, pass(sv) :: sizeof  => z_krm_solver_sizeof
+    procedure, pass(sv) :: get_nzeros => z_krm_solver_get_nzeros
+    !procedure, nopass   :: get_id  => z_krm_solver_get_id
+    procedure, pass(sv) :: is_global => z_krm_solver_is_global
+    procedure, nopass   :: is_iterative => z_krm_solver_is_iterative
+
+
+    !
+    ! These methods are specific for the new solver type
+    ! and therefore need to be overridden
+    !
+    procedure, pass(sv) :: descr   => z_krm_solver_descr
+    procedure, pass(sv) :: default => z_krm_solver_default
+    procedure, pass(sv) :: build   => amg_z_krm_solver_bld
+    procedure, nopass   :: get_fmt => z_krm_solver_get_fmt
+  end type amg_z_krm_solver_type
+
+
+  private ::  z_krm_solver_get_fmt, z_krm_solver_descr, z_krm_solver_default
+
+  interface
+    subroutine amg_z_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
+         & trans,work,wv,info,init,initu)
+      import :: psb_desc_type, amg_z_krm_solver_type, psb_z_vect_type, psb_dpk_, &
+           & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
+      implicit none
+      type(psb_desc_type), intent(in)             :: desc_data
+      class(amg_z_krm_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_krm_solver_apply_vect
+  end interface
+
+  interface
+    subroutine amg_z_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
+         & trans,work,info,init,initu)
+      import :: psb_desc_type, amg_z_krm_solver_type, psb_z_vect_type, psb_dpk_, &
+           & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, psb_ipk_
+      implicit none
+      type(psb_desc_type), intent(in)      :: desc_data
+      class(amg_z_krm_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_krm_solver_apply
+  end interface
+
+  interface
+    subroutine amg_z_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
+      import :: psb_desc_type, amg_z_krm_solver_type, psb_z_vect_type, psb_dpk_, &
+           & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type,&
+           & psb_ipk_, psb_i_base_vect_type
+      implicit none
+      type(psb_zspmat_type), intent(in), target           :: a
+      Type(psb_desc_type), Intent(inout)                  :: desc_a
+      class(amg_z_krm_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_krm_solver_bld
+  end interface
+
+
+contains
+
+  !
+  !
+  subroutine z_krm_solver_default(sv)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_z_krm_solver_type), intent(inout) :: sv
+
+    sv%method     = 'bicgstab'
+    sv%kprec      = 'bjac'
+    sv%sub_solve  = 'ilu'
+    sv%i_sub_solve  = -1
+    sv%fillin = 1
+    sv%irst   = 30
+    sv%istopc = 2
+    sv%itmax  = 40
+    sv%itrace = -1
+    sv%eps    = 1.d-6
+    sv%global = .false.
+
+    return
+  end subroutine z_krm_solver_default
+
+  function z_krm_solver_get_nzeros(sv) result(val)
+
+    implicit none
+    ! Arguments
+    class(amg_z_krm_solver_type), intent(in) :: sv
+    integer(psb_epk_) :: val
+
+    val = sv%prec%get_nzeros()
+
+    return
+  end function z_krm_solver_get_nzeros
+
+  function z_krm_solver_sizeof(sv) result(val)
+
+    implicit none
+    ! Arguments
+    class(amg_z_krm_solver_type), intent(in) :: sv
+    integer(psb_epk_) :: val
+
+    val = sv%prec%sizeof() + sv%desc_local%sizeof() + sv%a_local%sizeof()
+
+    return
+  end function z_krm_solver_sizeof
+
+
+  subroutine z_krm_solver_check(sv,info)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_z_krm_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)              :: info
+    integer(psb_ipk_) :: err_act
+    character(len=20) :: name='z_krm_solver_check'
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+
+
+    if (info /= psb_success_) goto 9999
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+
+  end subroutine z_krm_solver_check
+
+  subroutine z_krm_solver_cseti(sv,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_z_krm_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='z_krm_solver_cseti'
+
+    info = psb_success_
+    call psb_erractionsave(err_act)
+
+    select case(psb_toupper(trim(what)))
+    case('KRM_IRST')
+      sv%irst = val
+    case('KRM_ISTOPC')
+      sv%istopc = val
+    case('KRM_ITMAX')
+      sv%itmax = val
+    case('KRM_ITRACE')
+      sv%itrace = val
+    case('KRM_SUB_SOLVE')
+      sv%i_sub_solve = val
+    case('KRM_FILLIN')
+      sv%fillin = val
+    case default
+      call sv%amg_z_base_solver_type%set(what,val,info,idx=idx)
+    end select
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine z_krm_solver_cseti
+
+  subroutine z_krm_solver_csetc(sv,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_z_krm_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='z_krm_solver_csetc'
+
+    info = psb_success_
+    call psb_erractionsave(err_act)
+
+
+    select case(psb_toupper(trim(what)))
+    case('KRM_METHOD')
+      sv%method = psb_toupper(trim(val))
+    case('KRM_KPREC')
+      sv%kprec = psb_toupper(trim(val))
+    case('KRM_SUB_SOLVE')
+      sv%sub_solve = psb_toupper(trim(val))
+    case('KRM_GLOBAL')
+      select case(psb_toupper(trim(val)))
+      case('LOCAL','FALSE')
+        sv%global = .false.
+      case('GLOBAL','TRUE')
+        sv%global =.true.
+      end select
+    case default
+      call sv%amg_z_base_solver_type%set(what,val,info,idx=idx)
+    end select
+
+
+    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 z_krm_solver_csetc
+
+  subroutine z_krm_solver_csetr(sv,what,val,info,idx)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_z_krm_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='z_krm_solver_csetr'
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+
+    select case(psb_toupper(what))
+    case('KRM_EPS')
+      sv%eps = val
+    case default
+      call sv%amg_z_base_solver_type%set(what,val,info,idx=idx)
+    end select
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine z_krm_solver_csetr
+
+  subroutine z_krm_solver_clear_data(sv,info)
+    use psb_base_mod, only : psb_exit
+    Implicit None
+
+    ! Arguments
+    class(amg_z_krm_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)                :: info
+    integer(psb_ipk_) :: err_act
+    type(psb_ctxt_type)  :: l_ctxt
+    character(len=20)  :: name='z_krm_solver_free'
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+
+    call sv%prec%free(info)
+    call sv%a_local%free()
+    call sv%x_local%free(info)
+    call sv%z_local%free(info)
+    if ((.not.sv%global).and.sv%desc_local%is_ok()) then
+      l_ctxt=sv%desc_local%get_context()
+      call psb_exit(l_ctxt,close=.false.)
+    end if
+    call sv%desc_local%free(info)
+    nullify(sv%a)
+    call psb_erractionrestore(err_act)
+    return
+  end subroutine z_krm_solver_clear_data
+
+
+  subroutine z_krm_solver_free(sv,info)
+    use psb_base_mod, only : psb_exit
+    Implicit None
+
+    ! Arguments
+    class(amg_z_krm_solver_type), intent(inout) :: sv
+    integer(psb_ipk_), intent(out)                :: info
+    integer(psb_ipk_)  :: err_act
+    type(psb_ctxt_type) :: l_ctxt
+    character(len=20)  :: name='z_krm_solver_free'
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+
+    call sv%clear_data(info)
+
+    call psb_erractionrestore(err_act)
+    return
+  end subroutine z_krm_solver_free
+
+  function z_krm_solver_get_fmt() result(val)
+    implicit none
+    character(len=32)  :: val
+
+    val = "KRM solver"
+  end function z_krm_solver_get_fmt
+
+  subroutine z_krm_solver_descr(sv,info,iout,coarse)
+
+    Implicit None
+
+    ! Arguments
+    class(amg_z_krm_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
+    character(len=20), parameter :: name='amg_z_krm_solver_descr'
+    integer(psb_ipk_) :: iout_
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+    if (present(iout)) then
+      iout_ = iout
+    else
+      iout_ = psb_out_unit
+    endif
+
+    if (sv%global) then
+      write(iout_,*) '  Krylov solver (global)'
+    else
+      write(iout_,*) '  Krylov solver (local) '
+    end if
+    write(iout_,*) '    method: ',sv%method
+    write(iout_,*) '     kprec: ',sv%kprec
+    if (sv%i_sub_solve > 0) then
+      write(iout_,*) ' sub_solve: ',amg_fact_names(sv%i_sub_solve)
+    else
+      write(iout_,*) ' sub_solve: ',sv%sub_solve
+    end if
+    write(iout_,*) '     itmax: ',sv%itmax
+    write(iout_,*) '       eps: ',sv%eps
+    write(iout_,*) '    fillin: ',sv%fillin
+
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine z_krm_solver_descr
+
+  subroutine z_krm_solver_cnv(sv,info,amold,vmold,imold)
+    implicit none
+    class(amg_z_krm_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
+
+    call sv%prec%cnv(info,amold=amold,vmold=vmold,imold=imold)
+
+  end subroutine z_krm_solver_cnv
+
+  subroutine z_krm_solver_clone(sv,svout,info)
+    Implicit None
+
+    ! Arguments
+    class(amg_z_krm_solver_type), intent(inout)               :: sv
+    class(amg_z_base_solver_type), allocatable, intent(inout) :: svout
+    integer(psb_ipk_), intent(out)              :: info
+
+    info = psb_success_
+
+    call svout%free(info)
+    allocate(svout,stat=info,mold=sv)
+    select type(so=>svout)
+    class is(amg_z_krm_solver_type)
+      so%method = sv%method
+      so%kprec  = sv%kprec
+      so%sub_solve = sv%sub_solve
+      so%i_sub_solve = sv%i_sub_solve
+      so%fillin = sv%fillin
+      so%irst   = sv%irst
+      so%istopc = sv%istopc
+      so%itmax  = sv%itmax
+      so%itrace = sv%itrace
+      so%global = sv%global
+      so%eps    = sv%eps
+      call sv%a_local%clone(so%a_local,info)
+      call sv%desc_local%clone(so%desc_local,info)
+      call sv%prec%clone(so%prec,info)
+    class default
+      info = psb_err_internal_error_
+    end select
+
+  end subroutine z_krm_solver_clone
+
+
+  subroutine z_krm_solver_clone_settings(sv,svout,info)
+    Implicit None
+
+    ! Arguments
+    class(amg_z_krm_solver_type), intent(inout)               :: sv
+    class(amg_z_base_solver_type), intent(inout) :: svout
+    integer(psb_ipk_), intent(out)              :: info
+
+    info = psb_success_
+
+    select type(so=>svout)
+    class is(amg_z_krm_solver_type)
+      so%method = sv%method
+      so%kprec  = sv%kprec
+      so%sub_solve = sv%sub_solve
+      so%i_sub_solve = sv%i_sub_solve
+      so%fillin = sv%fillin
+      so%irst   = sv%irst
+      so%istopc = sv%istopc
+      so%itmax  = sv%itmax
+      so%itrace = sv%itrace
+      so%global = sv%global
+      so%eps    = sv%eps
+    class default
+      info = psb_err_internal_error_
+    end select
+
+  end subroutine z_krm_solver_clone_settings
+
+  subroutine z_krm_solver_dmp(sv,desc,level,info,prefix,head,solver,global_num)
+    implicit none
+    class(amg_z_krm_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
+
+
+    call sv%prec%dump(info,prefix=prefix,head=head)
+
+  end subroutine z_krm_solver_dmp
+  !
+  ! Notify whether KRM is used as a global solver
+  !
+  function z_krm_solver_is_global(sv) result(val)
+    implicit none
+    class(amg_z_krm_solver_type), intent(in) :: sv
+    logical  :: val
+
+    val = (sv%global)
+  end function z_krm_solver_is_global
+  !
+  function z_krm_solver_is_iterative() result(val)
+    implicit none
+    logical  :: val
+
+    val = .true.
+  end function z_krm_solver_is_iterative
+
+end module amg_z_krm_solver

amgprec/amg_z_prec_mod.f90

@@ -55,7 +55,7 @@ module amg_z_prec_mod
   use amg_z_ainv_solver
   use amg_z_invk_solver
   use amg_z_invt_solver
-  use amg_z_rkr_solver
+  use amg_z_krm_solver
 
   interface amg_extprol_bld
     subroutine amg_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)

amgprec/impl/amg_ccprecset.F90

@@ -319,7 +319,7 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #if defined(HAVE_MUMPS_)
   use amg_c_mumps_solver
 #endif
-  use amg_c_rkr_solver, only : amg_c_rkr_solver_type
+  use amg_c_krm_solver, only : amg_c_krm_solver_type
 
 
   implicit none
@@ -558,11 +558,11 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
-          case('RKR')
+          case('KRM')
             block
-              type(amg_c_rkr_solver_type)          :: rkr_slv
+              type(amg_c_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
-              call p%precv(nlev_)%set(rkr_slv,info)
+              call p%precv(nlev_)%set(krm_slv,info)
               call p%precv(nlev_)%default()
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
@@ -708,11 +708,11 @@ subroutine amg_ccprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
-          case('RKR')
+          case('KRM')
             block
-              type(amg_c_rkr_solver_type)          :: rkr_slv
+              type(amg_c_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
-              call p%precv(nlev_)%set(rkr_slv,info)
+              call p%precv(nlev_)%set(krm_slv,info)
               call p%precv(nlev_)%default()
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block

amgprec/impl/amg_dcprecset.F90

@@ -331,7 +331,7 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #if defined(HAVE_MUMPS_)
   use amg_d_mumps_solver
 #endif
-  use amg_d_rkr_solver, only : amg_d_rkr_solver_type
+  use amg_d_krm_solver, only : amg_d_krm_solver_type
 
 
   implicit none
@@ -584,11 +584,11 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
-          case('RKR')
+          case('KRM')
             block
-              type(amg_d_rkr_solver_type)          :: rkr_slv
+              type(amg_d_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
-              call p%precv(nlev_)%set(rkr_slv,info)
+              call p%precv(nlev_)%set(krm_slv,info)
               call p%precv(nlev_)%default()
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
@@ -748,11 +748,11 @@ subroutine amg_dcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
-          case('RKR')
+          case('KRM')
             block
-              type(amg_d_rkr_solver_type)          :: rkr_slv
+              type(amg_d_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
-              call p%precv(nlev_)%set(rkr_slv,info)
+              call p%precv(nlev_)%set(krm_slv,info)
               call p%precv(nlev_)%default()
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block

amgprec/impl/amg_scprecset.F90

@@ -319,7 +319,7 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #if defined(HAVE_MUMPS_)
   use amg_s_mumps_solver
 #endif
-  use amg_s_rkr_solver, only : amg_s_rkr_solver_type
+  use amg_s_krm_solver, only : amg_s_krm_solver_type
 
 
   implicit none
@@ -558,11 +558,11 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
-          case('RKR')
+          case('KRM')
             block
-              type(amg_s_rkr_solver_type)          :: rkr_slv
+              type(amg_s_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
-              call p%precv(nlev_)%set(rkr_slv,info)
+              call p%precv(nlev_)%set(krm_slv,info)
               call p%precv(nlev_)%default()
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
@@ -708,11 +708,11 @@ subroutine amg_scprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
-          case('RKR')
+          case('KRM')
             block
-              type(amg_s_rkr_solver_type)          :: rkr_slv
+              type(amg_s_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
-              call p%precv(nlev_)%set(rkr_slv,info)
+              call p%precv(nlev_)%set(krm_slv,info)
               call p%precv(nlev_)%default()
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block

amgprec/impl/amg_zcprecset.F90

@@ -331,7 +331,7 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
 #if defined(HAVE_MUMPS_)
   use amg_z_mumps_solver
 #endif
-  use amg_z_rkr_solver, only : amg_z_rkr_solver_type
+  use amg_z_krm_solver, only : amg_z_krm_solver_type
 
 
   implicit none
@@ -584,11 +584,11 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
             call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
             call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
             call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
-          case('RKR')
+          case('KRM')
             block
-              type(amg_z_rkr_solver_type)          :: rkr_slv
+              type(amg_z_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
-              call p%precv(nlev_)%set(rkr_slv,info)
+              call p%precv(nlev_)%set(krm_slv,info)
               call p%precv(nlev_)%default()
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block
@@ -748,11 +748,11 @@ subroutine amg_zcprecsetc(p,what,string,info,ilev,ilmax,pos,idx)
           call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_l1_bjac_,info,pos=pos)
           call p%precv(nlev_)%set('SUB_SOLVE',amg_gs_,info,pos=pos)
           call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
-          case('RKR')
+          case('KRM')
             block
-              type(amg_z_rkr_solver_type)          :: rkr_slv
+              type(amg_z_krm_solver_type)          :: krm_slv
               call p%precv(nlev_)%set('SMOOTHER_TYPE',amg_bjac_,info,pos=pos)
-              call p%precv(nlev_)%set(rkr_slv,info)
+              call p%precv(nlev_)%set(krm_slv,info)
               call p%precv(nlev_)%default()
               call p%precv(nlev_)%set('COARSE_MAT',amg_distr_mat_,info,pos=pos)
             end block

amgprec/impl/solver/Makefile

@@ -53,6 +53,7 @@ amg_c_ilu_solver_dmp.o \
 amg_c_mumps_solver_apply.o \
 amg_c_mumps_solver_apply_vect.o \
 amg_c_mumps_solver_bld.o \
+amg_c_krm_solver_impl.o \
 amg_d_base_solver_apply.o \
 amg_d_base_solver_apply_vect.o \
 amg_d_base_solver_bld.o \
@@ -99,6 +100,7 @@ amg_d_ilu_solver_dmp.o \
 amg_d_mumps_solver_apply.o \
 amg_d_mumps_solver_apply_vect.o \
 amg_d_mumps_solver_bld.o \
+amg_d_krm_solver_impl.o \
 amg_s_base_solver_apply.o \
 amg_s_base_solver_apply_vect.o \
 amg_s_base_solver_bld.o \
@@ -145,6 +147,7 @@ amg_s_ilu_solver_dmp.o \
 amg_s_mumps_solver_apply.o \
 amg_s_mumps_solver_apply_vect.o \
 amg_s_mumps_solver_bld.o \
+amg_s_krm_solver_impl.o \
 amg_z_base_solver_apply.o \
 amg_z_base_solver_apply_vect.o \
 amg_z_base_solver_bld.o \
@@ -286,7 +289,8 @@ 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_descr.o \
+amg_z_krm_solver_impl.o 
 
 LIBNAME=libamg_prec.a
 

amgprec/impl/solver/amg_c_krm_solver_impl.f90

@@ -69,22 +69,22 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !
 !
-! File: amg_c_rkr_solver_impl.f90
+! File: amg_c_krm_solver_impl.f90
 !
-!  This is the implementation file corresponding to amg_c_rkr_solver_mod.
+!  This is the implementation file corresponding to amg_c_krm_solver_mod.
 !
 !
-subroutine amg_c_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold)
+subroutine amg_c_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold)
 
   use psb_base_mod
-  use amg_c_rkr_solver, amg_protect_name => amg_c_rkr_solver_bld
+  use amg_c_krm_solver, amg_protect_name => amg_c_krm_solver_bld
 
   Implicit None
 
   ! Arguments
   type(psb_cspmat_type), intent(inout), target        :: a
   Type(psb_desc_type), Intent(inout)                  :: desc_a
-  class(amg_c_rkr_solver_type), intent(inout)         :: sv
+  class(amg_c_krm_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
@@ -94,7 +94,7 @@ subroutine amg_c_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold)
   integer(psb_lpk_) :: lnr
   integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
   type(psb_ctxt_type) :: ctxt, l_ctxt
-  character(len=20)   :: name='c_rkr_solver_bld', ch_err
+  character(len=20)   :: name='@Z@_krm_solver_bld', ch_err
 
   info=psb_success_
   call psb_erractionsave(err_act)
@@ -159,18 +159,18 @@ subroutine amg_c_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold)
 9999 call psb_error_handler(err_act)
 
   return
-end subroutine amg_c_rkr_solver_bld
+end subroutine amg_c_krm_solver_bld
 
-subroutine amg_c_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
+subroutine amg_c_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
      & trans,work,wv,info,init,initu)
 
   use psb_base_mod
   use psb_krylov_mod
-  use amg_c_rkr_solver, amg_protect_name => amg_c_rkr_solver_apply_vect
+  use amg_c_krm_solver, amg_protect_name => amg_c_krm_solver_apply_vect
 
   Implicit None
   type(psb_desc_type), intent(in)             :: desc_data
-  class(amg_c_rkr_solver_type), intent(inout) :: sv
+  class(amg_c_krm_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
@@ -184,7 +184,7 @@ subroutine amg_c_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
   type(psb_c_vect_type)   :: z
   integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
   type(psb_ctxt_type) :: ctxt
-  character(len=20) :: name='c_rkr_solver_apply_v', ch_err
+  character(len=20) :: name='@Z@_krm_solver_apply_v', ch_err
 
   info=psb_success_
   call psb_erractionsave(err_act)
@@ -224,16 +224,16 @@ subroutine amg_c_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
 9999 call psb_error_handler(err_act)
 
   return
-end subroutine amg_c_rkr_solver_apply_vect
+end subroutine amg_c_krm_solver_apply_vect
 
 
-subroutine amg_c_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
+subroutine amg_c_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
      & trans,work,info,init,initu)
   use psb_base_mod
-  use amg_c_rkr_solver, amg_protect_name => amg_c_rkr_solver_apply
+  use amg_c_krm_solver, amg_protect_name => amg_c_krm_solver_apply
   implicit none
   type(psb_desc_type), intent(in)      :: desc_data
-  class(amg_c_rkr_solver_type), intent(inout) :: sv
+  class(amg_c_krm_solver_type), intent(inout) :: sv
   complex(psb_spk_),intent(inout)         :: x(:)
   complex(psb_spk_),intent(inout)         :: y(:)
   complex(psb_spk_),intent(in)            :: alpha,beta
@@ -245,7 +245,7 @@ subroutine amg_c_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
   complex(psb_spk_), allocatable    :: z(:)
   integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
   type(psb_ctxt_type) :: ctxt
-  character(len=20) :: name='c_rkr_solver_apply', ch_err
+  character(len=20) :: name='@Z@_krm_solver_apply', ch_err
 
   info=psb_success_
   call psb_erractionsave(err_act)
@@ -268,4 +268,4 @@ subroutine amg_c_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
 9999 call psb_error_handler(err_act)
 
   return
-end subroutine amg_c_rkr_solver_apply
+end subroutine amg_c_krm_solver_apply

amgprec/impl/solver/amg_d_krm_solver_impl.f90

@@ -69,22 +69,22 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !
 !
-! File: amg_d_rkr_solver_impl.f90
+! File: amg_d_krm_solver_impl.f90
 !
-!  This is the implementation file corresponding to amg_d_rkr_solver_mod.
+!  This is the implementation file corresponding to amg_d_krm_solver_mod.
 !
 !
-subroutine amg_d_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold)
+subroutine amg_d_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold)
 
   use psb_base_mod
-  use amg_d_rkr_solver, amg_protect_name => amg_d_rkr_solver_bld
+  use amg_d_krm_solver, amg_protect_name => amg_d_krm_solver_bld
 
   Implicit None
 
   ! Arguments
   type(psb_dspmat_type), intent(inout), target        :: a
   Type(psb_desc_type), Intent(inout)                  :: desc_a
-  class(amg_d_rkr_solver_type), intent(inout)         :: sv
+  class(amg_d_krm_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
@@ -94,7 +94,7 @@ subroutine amg_d_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold)
   integer(psb_lpk_) :: lnr
   integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
   type(psb_ctxt_type) :: ctxt, l_ctxt
-  character(len=20)   :: name='d_rkr_solver_bld', ch_err
+  character(len=20)   :: name='@Z@_krm_solver_bld', ch_err
 
   info=psb_success_
   call psb_erractionsave(err_act)
@@ -159,18 +159,18 @@ subroutine amg_d_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold)
 9999 call psb_error_handler(err_act)
 
   return
-end subroutine amg_d_rkr_solver_bld
+end subroutine amg_d_krm_solver_bld
 
-subroutine amg_d_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
+subroutine amg_d_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
      & trans,work,wv,info,init,initu)
 
   use psb_base_mod
   use psb_krylov_mod
-  use amg_d_rkr_solver, amg_protect_name => amg_d_rkr_solver_apply_vect
+  use amg_d_krm_solver, amg_protect_name => amg_d_krm_solver_apply_vect
 
   Implicit None
   type(psb_desc_type), intent(in)             :: desc_data
-  class(amg_d_rkr_solver_type), intent(inout) :: sv
+  class(amg_d_krm_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
@@ -184,7 +184,7 @@ subroutine amg_d_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
   type(psb_d_vect_type)   :: z
   integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
   type(psb_ctxt_type) :: ctxt
-  character(len=20) :: name='d_rkr_solver_apply_v', ch_err
+  character(len=20) :: name='@Z@_krm_solver_apply_v', ch_err
 
   info=psb_success_
   call psb_erractionsave(err_act)
@@ -224,16 +224,16 @@ subroutine amg_d_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
 9999 call psb_error_handler(err_act)
 
   return
-end subroutine amg_d_rkr_solver_apply_vect
+end subroutine amg_d_krm_solver_apply_vect
 
 
-subroutine amg_d_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
+subroutine amg_d_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
      & trans,work,info,init,initu)
   use psb_base_mod
-  use amg_d_rkr_solver, amg_protect_name => amg_d_rkr_solver_apply
+  use amg_d_krm_solver, amg_protect_name => amg_d_krm_solver_apply
   implicit none
   type(psb_desc_type), intent(in)      :: desc_data
-  class(amg_d_rkr_solver_type), intent(inout) :: sv
+  class(amg_d_krm_solver_type), intent(inout) :: sv
   real(psb_dpk_),intent(inout)         :: x(:)
   real(psb_dpk_),intent(inout)         :: y(:)
   real(psb_dpk_),intent(in)            :: alpha,beta
@@ -245,7 +245,7 @@ subroutine amg_d_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
   real(psb_dpk_), allocatable    :: z(:)
   integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
   type(psb_ctxt_type) :: ctxt
-  character(len=20) :: name='d_rkr_solver_apply', ch_err
+  character(len=20) :: name='@Z@_krm_solver_apply', ch_err
 
   info=psb_success_
   call psb_erractionsave(err_act)
@@ -268,4 +268,4 @@ subroutine amg_d_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
 9999 call psb_error_handler(err_act)
 
   return
-end subroutine amg_d_rkr_solver_apply
+end subroutine amg_d_krm_solver_apply

amgprec/impl/solver/amg_s_krm_solver_impl.f90

@@ -69,22 +69,22 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !
 !
-! File: amg_s_rkr_solver_impl.f90
+! File: amg_s_krm_solver_impl.f90
 !
-!  This is the implementation file corresponding to amg_s_rkr_solver_mod.
+!  This is the implementation file corresponding to amg_s_krm_solver_mod.
 !
 !
-subroutine amg_s_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold)
+subroutine amg_s_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold)
 
   use psb_base_mod
-  use amg_s_rkr_solver, amg_protect_name => amg_s_rkr_solver_bld
+  use amg_s_krm_solver, amg_protect_name => amg_s_krm_solver_bld
 
   Implicit None
 
   ! Arguments
   type(psb_sspmat_type), intent(inout), target        :: a
   Type(psb_desc_type), Intent(inout)                  :: desc_a
-  class(amg_s_rkr_solver_type), intent(inout)         :: sv
+  class(amg_s_krm_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
@@ -94,7 +94,7 @@ subroutine amg_s_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold)
   integer(psb_lpk_) :: lnr
   integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
   type(psb_ctxt_type) :: ctxt, l_ctxt
-  character(len=20)   :: name='s_rkr_solver_bld', ch_err
+  character(len=20)   :: name='@Z@_krm_solver_bld', ch_err
 
   info=psb_success_
   call psb_erractionsave(err_act)
@@ -159,18 +159,18 @@ subroutine amg_s_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold)
 9999 call psb_error_handler(err_act)
 
   return
-end subroutine amg_s_rkr_solver_bld
+end subroutine amg_s_krm_solver_bld
 
-subroutine amg_s_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
+subroutine amg_s_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
      & trans,work,wv,info,init,initu)
 
   use psb_base_mod
   use psb_krylov_mod
-  use amg_s_rkr_solver, amg_protect_name => amg_s_rkr_solver_apply_vect
+  use amg_s_krm_solver, amg_protect_name => amg_s_krm_solver_apply_vect
 
   Implicit None
   type(psb_desc_type), intent(in)             :: desc_data
-  class(amg_s_rkr_solver_type), intent(inout) :: sv
+  class(amg_s_krm_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
@@ -184,7 +184,7 @@ subroutine amg_s_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
   type(psb_s_vect_type)   :: z
   integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
   type(psb_ctxt_type) :: ctxt
-  character(len=20) :: name='s_rkr_solver_apply_v', ch_err
+  character(len=20) :: name='@Z@_krm_solver_apply_v', ch_err
 
   info=psb_success_
   call psb_erractionsave(err_act)
@@ -224,16 +224,16 @@ subroutine amg_s_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
 9999 call psb_error_handler(err_act)
 
   return
-end subroutine amg_s_rkr_solver_apply_vect
+end subroutine amg_s_krm_solver_apply_vect
 
 
-subroutine amg_s_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
+subroutine amg_s_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
      & trans,work,info,init,initu)
   use psb_base_mod
-  use amg_s_rkr_solver, amg_protect_name => amg_s_rkr_solver_apply
+  use amg_s_krm_solver, amg_protect_name => amg_s_krm_solver_apply
   implicit none
   type(psb_desc_type), intent(in)      :: desc_data
-  class(amg_s_rkr_solver_type), intent(inout) :: sv
+  class(amg_s_krm_solver_type), intent(inout) :: sv
   real(psb_spk_),intent(inout)         :: x(:)
   real(psb_spk_),intent(inout)         :: y(:)
   real(psb_spk_),intent(in)            :: alpha,beta
@@ -245,7 +245,7 @@ subroutine amg_s_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
   real(psb_spk_), allocatable    :: z(:)
   integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
   type(psb_ctxt_type) :: ctxt
-  character(len=20) :: name='s_rkr_solver_apply', ch_err
+  character(len=20) :: name='@Z@_krm_solver_apply', ch_err
 
   info=psb_success_
   call psb_erractionsave(err_act)
@@ -268,4 +268,4 @@ subroutine amg_s_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
 9999 call psb_error_handler(err_act)
 
   return
-end subroutine amg_s_rkr_solver_apply
+end subroutine amg_s_krm_solver_apply

amgprec/impl/solver/amg_z_krm_solver_impl.f90

@@ -69,22 +69,22 @@
 !    POSSIBILITY OF SUCH DAMAGE.
 !
 !
-! File: amg_z_rkr_solver_impl.f90
+! File: amg_z_krm_solver_impl.f90
 !
-!  This is the implementation file corresponding to amg_z_rkr_solver_mod.
+!  This is the implementation file corresponding to amg_z_krm_solver_mod.
 !
 !
-subroutine amg_z_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold)
+subroutine amg_z_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold)
 
   use psb_base_mod
-  use amg_z_rkr_solver, amg_protect_name => amg_z_rkr_solver_bld
+  use amg_z_krm_solver, amg_protect_name => amg_z_krm_solver_bld
 
   Implicit None
 
   ! Arguments
   type(psb_zspmat_type), intent(inout), target        :: a
   Type(psb_desc_type), Intent(inout)                  :: desc_a
-  class(amg_z_rkr_solver_type), intent(inout)         :: sv
+  class(amg_z_krm_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
@@ -94,7 +94,7 @@ subroutine amg_z_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold)
   integer(psb_lpk_) :: lnr
   integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
   type(psb_ctxt_type) :: ctxt, l_ctxt
-  character(len=20)   :: name='z_rkr_solver_bld', ch_err
+  character(len=20)   :: name='@Z@_krm_solver_bld', ch_err
 
   info=psb_success_
   call psb_erractionsave(err_act)
@@ -159,18 +159,18 @@ subroutine amg_z_rkr_solver_bld(a,desc_a,sv,info,b,amold,vmold)
 9999 call psb_error_handler(err_act)
 
   return
-end subroutine amg_z_rkr_solver_bld
+end subroutine amg_z_krm_solver_bld
 
-subroutine amg_z_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
+subroutine amg_z_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
      & trans,work,wv,info,init,initu)
 
   use psb_base_mod
   use psb_krylov_mod
-  use amg_z_rkr_solver, amg_protect_name => amg_z_rkr_solver_apply_vect
+  use amg_z_krm_solver, amg_protect_name => amg_z_krm_solver_apply_vect
 
   Implicit None
   type(psb_desc_type), intent(in)             :: desc_data
-  class(amg_z_rkr_solver_type), intent(inout) :: sv
+  class(amg_z_krm_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
@@ -184,7 +184,7 @@ subroutine amg_z_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
   type(psb_z_vect_type)   :: z
   integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
   type(psb_ctxt_type) :: ctxt
-  character(len=20) :: name='z_rkr_solver_apply_v', ch_err
+  character(len=20) :: name='@Z@_krm_solver_apply_v', ch_err
 
   info=psb_success_
   call psb_erractionsave(err_act)
@@ -224,16 +224,16 @@ subroutine amg_z_rkr_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
 9999 call psb_error_handler(err_act)
 
   return
-end subroutine amg_z_rkr_solver_apply_vect
+end subroutine amg_z_krm_solver_apply_vect
 
 
-subroutine amg_z_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
+subroutine amg_z_krm_solver_apply(alpha,sv,x,beta,y,desc_data,&
      & trans,work,info,init,initu)
   use psb_base_mod
-  use amg_z_rkr_solver, amg_protect_name => amg_z_rkr_solver_apply
+  use amg_z_krm_solver, amg_protect_name => amg_z_krm_solver_apply
   implicit none
   type(psb_desc_type), intent(in)      :: desc_data
-  class(amg_z_rkr_solver_type), intent(inout) :: sv
+  class(amg_z_krm_solver_type), intent(inout) :: sv
   complex(psb_dpk_),intent(inout)         :: x(:)
   complex(psb_dpk_),intent(inout)         :: y(:)
   complex(psb_dpk_),intent(in)            :: alpha,beta
@@ -245,7 +245,7 @@ subroutine amg_z_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
   complex(psb_dpk_), allocatable    :: z(:)
   integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level
   type(psb_ctxt_type) :: ctxt
-  character(len=20) :: name='z_rkr_solver_apply', ch_err
+  character(len=20) :: name='@Z@_krm_solver_apply', ch_err
 
   info=psb_success_
   call psb_erractionsave(err_act)
@@ -268,4 +268,4 @@ subroutine amg_z_rkr_solver_apply(alpha,sv,x,beta,y,desc_data,&
 9999 call psb_error_handler(err_act)
 
   return
-end subroutine amg_z_rkr_solver_apply
+end subroutine amg_z_krm_solver_apply