psblas3/base/modules/psb_indx_map_mod.f90

!!$ 
!!$              Parallel Sparse BLAS  version 3.1
!!$    (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012, 2013
!!$                       Salvatore Filippone    University of Rome Tor Vergata
!!$                       Alfredo Buttari        CNRS-IRIT, Toulouse
!!$ 
!!$  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 PSBLAS 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 PSBLAS 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.
!!$ 
!!$  
!
!
! package: psb_indx_map_mod
!    Defines the PSB_INDX_MAP class.
!
!
!
module psb_indx_map_mod
  use psb_const_mod
  use psb_desc_const_mod

  !
  !> \namespace  psb_base_mod  \class  psb_indx_map
  !! \brief Object to handle the mapping between global and local indices.
  !!
  !!
  !!  In particular, besides the communicator, it contains the data relevant
  !!  to the following queries:
  !!  
  !!  -  How many global rows/columns?
  !!  
  !!  -  How many local  rows/columns?
  !!  
  !!  -  Convert between local and global indices
  !!  
  !!  -  Add to local indices.
  !!  
  !!  -  Find (one of) the owner(s) of a given index
  !!  
  !!  -  Query the indx state.
  !!    
  !!  -  Does the dynamic class support extensions of the rows? I.e., can
  !!     it have overlap? for instance, the BLOCK cannot, it would run afoul
  !!     of the glob_to_loc translation. 
  !!  
  !!  Checking for the existence of overlap is very expensive, thus
  !!  it is done at build time (for extended-halo cases it can be inferred from
  !!  the construction process).
  !!
  !!  The object can be in the NULL, BUILD or ASSEMBLED state.
  !!  
  !!  Rules/constraints:
  !!  
  !!  1. Each global index I is owned by at least one process;
  !!
  !!  2. On each process, indices from 1 to N_ROW (desc%indxmap%get_lr())
  !!     are locally owned; the value of N_ROW can be determined upon allocation 
  !!     based on the index distribution (see also the interface to CDALL).
  !!
  !!  3. If a global index is owned by more than one process, we have an OVERLAP
  !!     in which case the sum of all the N_ROW values is greater than the total 
  !!     size of the index space; 
  !!
  !!  4. During the buildup of the descriptor, according to the user specified 
  !!     stencil, we also take notice of indices that are not owned by the current
  !!     process, but whose value is needed to proceed with the computation; these 
  !!     form the HALO of the current process. Halo indices are assigned local indices
  !!     from N_ROW+1 to N_COL (inclusive).
  !!
  !!  5. The upper bound  N_COL moves during the descriptor build process (see CDINS). 
  !!
  !!
  !!  This is the base version of the class; as such, it only contains
  !!  methods for getting/setting the common attributes, whereas
  !!  the index translation methods are only implemented at the derived
  !!  class level.
  !!  Note that the INIT method is defined in the derived methods, and
  !!  is specialized for them; a better solution would have to have
  !!  a constructor for each specific class, with the name of the class,
  !!  but this is not yet working on many compilers, most notably GNU. 
  !!
  !!  Note: the CLONE method was implemented as a workaround for a problem
  !!  with SOURCE= allocation on GNU. Might be removed later on. 
  !!
  type      :: psb_indx_map
    !> State of the map 
    integer(psb_ipk_) :: state          = psb_desc_null_    
    !> Communication context
    integer(psb_mpik_) :: ictxt          = -1
    !> MPI communicator
    integer(psb_mpik_) :: mpic           = -1
    !> Number of global rows
    integer(psb_ipk_) :: global_rows    = -1
    !> Number of global columns
    integer(psb_ipk_) :: global_cols    = -1
    !> Number of local rows
    integer(psb_ipk_) :: local_rows     = -1
    !> Number of local columns
    integer(psb_ipk_) :: local_cols     = -1
    !> A pointer to the user-defined parts subroutine
    procedure(psb_parts), nopass, pointer  :: parts => null()
    !> The global vector assigning indices to processes, temp copy
    integer(psb_ipk_), allocatable :: tempvg(:)
    !> Reserved for future use. 
    integer(psb_ipk_), allocatable :: oracle(:,:)

  contains

    procedure, pass(idxmap)  :: get_state => base_get_state
    procedure, pass(idxmap)  :: set_state => base_set_state
    procedure, pass(idxmap)  :: is_null   => base_is_null
    procedure, nopass        :: is_repl   => base_is_repl
    procedure, pass(idxmap)  :: is_bld    => base_is_bld
    procedure, pass(idxmap)  :: is_upd    => base_is_upd
    procedure, pass(idxmap)  :: is_asb    => base_is_asb
    procedure, pass(idxmap)  :: is_valid  => base_is_valid
    procedure, pass(idxmap)  :: is_ovl    => base_is_ovl
    procedure, pass(idxmap)  :: get_gr    => base_get_gr
    procedure, pass(idxmap)  :: get_gc    => base_get_gc
    procedure, pass(idxmap)  :: get_lr    => base_get_lr
    procedure, pass(idxmap)  :: get_lc    => base_get_lc
    procedure, pass(idxmap)  :: get_ctxt  => base_get_ctxt
    procedure, pass(idxmap)  :: get_mpic  => base_get_mpic
    procedure, pass(idxmap)  :: sizeof    => base_sizeof
    procedure, pass(idxmap)  :: set_null  => base_set_null
    procedure, nopass        :: row_extendable => base_row_extendable

    procedure, pass(idxmap)  :: set_gr    => base_set_gr
    procedure, pass(idxmap)  :: set_gc    => base_set_gc
    procedure, pass(idxmap)  :: set_lr    => base_set_lr
    procedure, pass(idxmap)  :: set_lc    => base_set_lc
    procedure, pass(idxmap)  :: set_ctxt  => base_set_ctxt
    procedure, pass(idxmap)  :: set_mpic  => base_set_mpic

    procedure, nopass        :: get_fmt   => base_get_fmt

    procedure, pass(idxmap)  :: asb   => base_asb
    procedure, pass(idxmap)  :: free  => base_free
    procedure, pass(idxmap)  :: clone => base_clone
    procedure, pass(idxmap)  :: reinit => base_reinit

    procedure, pass(idxmap)  :: l2gs1  => base_l2gs1
    procedure, pass(idxmap)  :: l2gs2  => base_l2gs2
    procedure, pass(idxmap)  :: l2gv1  => base_l2gv1
    procedure, pass(idxmap)  :: l2gv2  => base_l2gv2
    generic, public          :: l2g =>   l2gs2, l2gv2
    generic, public          :: l2gip => l2gs1, l2gv1

    procedure, pass(idxmap)  :: g2ls1  => base_g2ls1
    procedure, pass(idxmap)  :: g2ls2  => base_g2ls2
    procedure, pass(idxmap)  :: g2lv1  => base_g2lv1
    procedure, pass(idxmap)  :: g2lv2  => base_g2lv2
    generic, public          :: g2l =>   g2ls2, g2lv2
    generic, public          :: g2lip => g2ls1, g2lv1

    procedure, pass(idxmap)  :: g2ls1_ins  => base_g2ls1_ins
    procedure, pass(idxmap)  :: g2ls2_ins  => base_g2ls2_ins
    procedure, pass(idxmap)  :: g2lv1_ins  => base_g2lv1_ins
    procedure, pass(idxmap)  :: g2lv2_ins  => base_g2lv2_ins
    generic, public          :: g2l_ins =>   g2ls2_ins, g2lv2_ins
    generic, public          :: g2lip_ins => g2ls1_ins, g2lv1_ins

    procedure, pass(idxmap)  :: fnd_owner => psb_indx_map_fnd_owner
    procedure, pass(idxmap)  :: init_vl   => base_init_vl
    generic, public          :: init      => init_vl

  end type psb_indx_map

  private :: base_get_state, base_set_state, base_is_repl, base_is_bld,&
       & base_is_upd, base_is_asb, base_is_valid, base_is_ovl,&
       & base_get_gr, base_get_gc, base_get_lr, base_get_lc, base_get_ctxt,&
       & base_get_mpic, base_sizeof, base_set_null, base_set_gr,&
       & base_set_gc, base_set_lr, base_set_lc, base_set_ctxt,&
       & base_set_mpic, base_get_fmt, base_asb, base_free,&
       & base_l2gs1, base_l2gs2, base_l2gv1, base_l2gv2,&
       & base_g2ls1, base_g2ls2, base_g2lv1, base_g2lv2,&
       & base_g2ls1_ins, base_g2ls2_ins, base_g2lv1_ins,&
       & base_g2lv2_ins, base_init_vl, base_is_null,&
       & base_row_extendable, base_clone, base_reinit
  
  !> Function: psb_indx_map_fnd_owner
  !! \memberof psb_indx_map
  !! \brief  Find the process owning indices
  !!
  !!  Given a list of indices IDX, return the processes owning
  !!  them. The base class provides the default implementation,
  !!  which is simply aggregating the requests and converting on
  !!  each proces who then builds its part of the solution.
  !!  This implies that in general this routine is a
  !!  synchronization point; for some derived classes it is
  !!  possible to answer locally, but this should not be relied
  !!  upon. 
  !!
  !!  \param idx(:) The set of indices (local to each process)
  !!  \param iprc(:) The processes owning them
  !!  \param info    return code. 
  !!

  interface 
    subroutine psb_indx_map_fnd_owner(idx,iprc,idxmap,info)
      import :: psb_indx_map, psb_ipk_
      implicit none 
      integer(psb_ipk_), intent(in) :: idx(:)
      integer(psb_ipk_), allocatable, intent(out) ::  iprc(:)
      class(psb_indx_map), intent(in) :: idxmap
      integer(psb_ipk_), intent(out) :: info
    end subroutine psb_indx_map_fnd_owner
  end interface

contains


  !> 
  !! \memberof psb_indx_map
  !! \brief  Print a descriptive name
  function base_get_fmt() result(res)
    implicit none 
    character(len=5) :: res
    res = 'NULL'
  end function base_get_fmt


  function base_get_state(idxmap) result(val)
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    integer(psb_ipk_) :: val

    val = idxmap%state

  end function base_get_state


  function base_get_gr(idxmap) result(val)
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    integer(psb_ipk_) :: val

    val = idxmap%global_rows

  end function base_get_gr


  function base_get_gc(idxmap) result(val)
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    integer(psb_ipk_) :: val

    val = idxmap%global_cols

  end function base_get_gc


  function base_get_lr(idxmap) result(val)
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    integer(psb_ipk_) :: val

    val = idxmap%local_rows

  end function base_get_lr


  function base_get_lc(idxmap) result(val)
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    integer(psb_ipk_) :: val

    val = idxmap%local_cols

  end function base_get_lc


  function base_get_ctxt(idxmap) result(val)
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    integer(psb_mpik_) :: val

    val = idxmap%ictxt

  end function base_get_ctxt


  function base_get_mpic(idxmap) result(val)
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    integer(psb_mpik_) :: val

    val = idxmap%mpic

  end function base_get_mpic


  subroutine base_set_state(idxmap,val)
    implicit none 
    class(psb_indx_map), intent(inout) :: idxmap
    integer(psb_ipk_), intent(in)  :: val

    idxmap%state = val
  end subroutine base_set_state

  subroutine base_set_ctxt(idxmap,val)
    implicit none 
    class(psb_indx_map), intent(inout) :: idxmap
    integer(psb_mpik_), intent(in)  :: val

    idxmap%ictxt = val
  end subroutine base_set_ctxt

  subroutine base_set_gr(idxmap,val)
    implicit none 
    class(psb_indx_map), intent(inout) :: idxmap
    integer(psb_ipk_), intent(in)  :: val

    idxmap%global_rows = val
  end subroutine base_set_gr

  subroutine base_set_gc(idxmap,val)
    implicit none 
    class(psb_indx_map), intent(inout) :: idxmap
    integer(psb_ipk_), intent(in)  :: val

    idxmap%global_cols = val
  end subroutine base_set_gc

  subroutine base_set_lr(idxmap,val)
    implicit none 
    class(psb_indx_map), intent(inout) :: idxmap
    integer(psb_ipk_), intent(in)  :: val

    idxmap%local_rows = val
  end subroutine base_set_lr

  subroutine base_set_lc(idxmap,val)
    implicit none 
    class(psb_indx_map), intent(inout) :: idxmap
    integer(psb_ipk_), intent(in)  :: val

    idxmap%local_cols = val
  end subroutine base_set_lc

  subroutine base_set_mpic(idxmap,val)
    implicit none 
    class(psb_indx_map), intent(inout) :: idxmap
    integer(psb_mpik_), intent(in)  :: val

    idxmap%mpic = val
  end subroutine base_set_mpic


  !> 
  !! \memberof psb_indx_map
  !! \brief  Is the class capable of having overlapped rows?
  function base_row_extendable() result(val)
    implicit none 
    logical :: val
    val = .false.
  end function base_row_extendable

  function base_is_repl() result(val)
    implicit none 
    logical :: val
    val = .false.
  end function base_is_repl

  function base_is_null(idxmap) result(val)
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    logical :: val
    val =  (idxmap%state == psb_desc_null_)
  end function base_is_null


  function base_is_bld(idxmap) result(val)
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    logical :: val
    val = (idxmap%state == psb_desc_bld_).or.&
         & (idxmap%state == psb_desc_ovl_bld_)
  end function base_is_bld

  function base_is_upd(idxmap) result(val)
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    logical :: val
    val = (idxmap%state == psb_desc_upd_)
  end function base_is_upd

  function base_is_asb(idxmap) result(val)
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    logical :: val
    val = (idxmap%state == psb_desc_asb_).or.&
         & (idxmap%state == psb_desc_ovl_asb_)
  end function base_is_asb

  function base_is_valid(idxmap) result(val)
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    logical :: val
    val = idxmap%is_bld().or.idxmap%is_upd().or.idxmap%is_asb()
  end function base_is_valid


  function base_is_ovl(idxmap) result(val)
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    logical :: val
    val = (idxmap%state == psb_desc_ovl_bld_).or.&
         & (idxmap%state == psb_desc_ovl_asb_)
  end function base_is_ovl

  function base_sizeof(idxmap) result(val)
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    integer(psb_long_int_k_) :: val

    val = 8 * psb_sizeof_int
  end function base_sizeof


  !> 
  !! \memberof psb_indx_map
  !! \brief  Local to global, scalar, in place
  subroutine base_l2gs1(idx,idxmap,info,mask,owned)
    use psb_error_mod 
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    integer(psb_ipk_), intent(inout) :: idx
    integer(psb_ipk_), intent(out)   :: info 
    logical, intent(in), optional :: mask
    logical, intent(in), optional :: owned
    integer(psb_ipk_) :: err_act
    character(len=20)  :: name='base_l2g'
    logical, parameter :: debug=.false.

    call psb_get_erraction(err_act)
    ! This is the base version. If we get here
    ! it means the derived class is incomplete,
    ! so we throw an error.
    call psb_errpush(psb_err_missing_override_method_,&
         & name,a_err=idxmap%get_fmt())

    call psb_error_handler(err_act)
    return

  end subroutine base_l2gs1

  subroutine base_l2gs2(idxin,idxout,idxmap,info,mask,owned)
    use psb_error_mod
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    integer(psb_ipk_), intent(in)    :: idxin
    integer(psb_ipk_), intent(out)   :: idxout
    integer(psb_ipk_), intent(out)   :: info 
    logical, intent(in), optional :: mask
    logical, intent(in), optional :: owned

    integer(psb_ipk_) :: err_act
    character(len=20)  :: name='base_l2g'
    logical, parameter :: debug=.false.

    call psb_get_erraction(err_act)
    ! This is the base version. If we get here
    ! it means the derived class is incomplete,
    ! so we throw an error.
    call psb_errpush(psb_err_missing_override_method_,&
         & name,a_err=idxmap%get_fmt())

    call psb_error_handler(err_act)

  end subroutine base_l2gs2


  subroutine base_l2gv1(idx,idxmap,info,mask,owned)
    use psb_error_mod
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    integer(psb_ipk_), intent(inout) :: idx(:)
    integer(psb_ipk_), intent(out)   :: info 
    logical, intent(in), optional :: mask(:)
    logical, intent(in), optional :: owned
    integer(psb_ipk_) :: err_act
    character(len=20)  :: name='base_l2g'
    logical, parameter :: debug=.false.

    call psb_get_erraction(err_act)
    ! This is the base version. If we get here
    ! it means the derived class is incomplete,
    ! so we throw an error.
    call psb_errpush(psb_err_missing_override_method_,&
         & name,a_err=idxmap%get_fmt())

    call psb_error_handler(err_act)
    return
  end subroutine base_l2gv1

  subroutine base_l2gv2(idxin,idxout,idxmap,info,mask,owned)
    use psb_error_mod
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    integer(psb_ipk_), intent(in)    :: idxin(:)
    integer(psb_ipk_), intent(out)   :: idxout(:)
    integer(psb_ipk_), intent(out)   :: info 
    logical, intent(in), optional :: mask(:)
    logical, intent(in), optional :: owned
    integer(psb_ipk_) :: err_act
    character(len=20)  :: name='base_l2g'
    logical, parameter :: debug=.false.

    call psb_get_erraction(err_act)
    ! This is the base version. If we get here
    ! it means the derived class is incomplete,
    ! so we throw an error.
    call psb_errpush(psb_err_missing_override_method_,&
         & name,a_err=idxmap%get_fmt())

    call psb_error_handler(err_act)
    return

  end subroutine base_l2gv2


  subroutine base_g2ls1(idx,idxmap,info,mask,owned)
    use psb_error_mod
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    integer(psb_ipk_), intent(inout) :: idx
    integer(psb_ipk_), intent(out)   :: info 
    logical, intent(in), optional :: mask
    logical, intent(in), optional :: owned
    integer(psb_ipk_) :: err_act
    character(len=20)  :: name='base_g2l'
    logical, parameter :: debug=.false.

    call psb_get_erraction(err_act)
    ! This is the base version. If we get here
    ! it means the derived class is incomplete,
    ! so we throw an error.
    call psb_errpush(psb_err_missing_override_method_,&
         & name,a_err=idxmap%get_fmt())

    call psb_error_handler(err_act)
    return

  end subroutine base_g2ls1

  subroutine base_g2ls2(idxin,idxout,idxmap,info,mask,owned)
    use psb_error_mod
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    integer(psb_ipk_), intent(in)    :: idxin
    integer(psb_ipk_), intent(out)   :: idxout
    integer(psb_ipk_), intent(out)   :: info 
    logical, intent(in), optional :: mask
    logical, intent(in), optional :: owned

    integer(psb_ipk_) :: err_act
    character(len=20)  :: name='base_g2l'
    logical, parameter :: debug=.false.

    call psb_get_erraction(err_act)
    ! This is the base version. If we get here
    ! it means the derived class is incomplete,
    ! so we throw an error.
    call psb_errpush(psb_err_missing_override_method_,&
         & name,a_err=idxmap%get_fmt())

    call psb_error_handler(err_act)
    return

  end subroutine base_g2ls2


  subroutine base_g2lv1(idx,idxmap,info,mask,owned)
    use psb_error_mod
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    integer(psb_ipk_), intent(inout) :: idx(:)
    integer(psb_ipk_), intent(out)   :: info 
    logical, intent(in), optional :: mask(:)
    logical, intent(in), optional :: owned
    integer(psb_ipk_) :: err_act
    character(len=20)  :: name='base_g2l'
    logical, parameter :: debug=.false.

    call psb_get_erraction(err_act)
    ! This is the base version. If we get here
    ! it means the derived class is incomplete,
    ! so we throw an error.
    call psb_errpush(psb_err_missing_override_method_,&
         & name,a_err=idxmap%get_fmt())

    call psb_error_handler(err_act)
    return

  end subroutine base_g2lv1

  subroutine base_g2lv2(idxin,idxout,idxmap,info,mask,owned)
    use psb_error_mod
    implicit none 
    class(psb_indx_map), intent(in) :: idxmap
    integer(psb_ipk_), intent(in)    :: idxin(:)
    integer(psb_ipk_), intent(out)   :: idxout(:)
    integer(psb_ipk_), intent(out)   :: info 
    logical, intent(in), optional :: mask(:)
    logical, intent(in), optional :: owned

    integer(psb_ipk_) :: err_act
    character(len=20)  :: name='base_g2l'
    logical, parameter :: debug=.false.

    call psb_get_erraction(err_act)
    ! This is the base version. If we get here
    ! it means the derived class is incomplete,
    ! so we throw an error.
    call psb_errpush(psb_err_missing_override_method_,&
         & name,a_err=idxmap%get_fmt())

    call psb_error_handler(err_act)
    return


  end subroutine base_g2lv2



  subroutine base_g2ls1_ins(idx,idxmap,info,mask, lidx)
    use psb_error_mod
    implicit none 
    class(psb_indx_map), intent(inout) :: idxmap
    integer(psb_ipk_), intent(inout) :: idx
    integer(psb_ipk_), intent(out)   :: info 
    logical, intent(in), optional :: mask
    integer(psb_ipk_), intent(in), optional :: lidx
    integer(psb_ipk_) :: err_act
    character(len=20)  :: name='base_g2l_ins'
    logical, parameter :: debug=.false.

    call psb_get_erraction(err_act)
    ! This is the base version. If we get here
    ! it means the derived class is incomplete,
    ! so we throw an error.
    call psb_errpush(psb_err_missing_override_method_,&
         & name,a_err=idxmap%get_fmt())

    call psb_error_handler(err_act)
    return

  end subroutine base_g2ls1_ins

  subroutine base_g2ls2_ins(idxin,idxout,idxmap,info,mask, lidx)
    use psb_error_mod
    implicit none 
    class(psb_indx_map), intent(inout) :: idxmap
    integer(psb_ipk_), intent(in)    :: idxin
    integer(psb_ipk_), intent(out)   :: idxout
    integer(psb_ipk_), intent(out)   :: info 
    logical, intent(in), optional :: mask
    integer(psb_ipk_), intent(in), optional :: lidx

    integer(psb_ipk_) :: err_act
    character(len=20)  :: name='base_g2l_ins'
    logical, parameter :: debug=.false.

    call psb_get_erraction(err_act)
    ! This is the base version. If we get here
    ! it means the derived class is incomplete,
    ! so we throw an error.
    call psb_errpush(psb_err_missing_override_method_,&
         & name,a_err=idxmap%get_fmt())

    call psb_error_handler(err_act)
    return

  end subroutine base_g2ls2_ins


  subroutine base_g2lv1_ins(idx,idxmap,info,mask, lidx)
    use psb_error_mod
    implicit none 
    class(psb_indx_map), intent(inout) :: idxmap
    integer(psb_ipk_), intent(inout) :: idx(:)
    integer(psb_ipk_), intent(out)   :: info 
    logical, intent(in), optional :: mask(:)
    integer(psb_ipk_), intent(in), optional :: lidx(:)

    integer(psb_ipk_) :: err_act
    character(len=20)  :: name='base_g2l_ins'
    logical, parameter :: debug=.false.

    call psb_get_erraction(err_act)
    ! This is the base version. If we get here
    ! it means the derived class is incomplete,
    ! so we throw an error.
    call psb_errpush(psb_err_missing_override_method_,&
         & name,a_err=idxmap%get_fmt())

    call psb_error_handler(err_act)
    return

  end subroutine base_g2lv1_ins

  subroutine base_g2lv2_ins(idxin,idxout,idxmap,info,mask,lidx)
    use psb_error_mod
    implicit none 
    class(psb_indx_map), intent(inout) :: idxmap
    integer(psb_ipk_), intent(in)    :: idxin(:)
    integer(psb_ipk_), intent(out)   :: idxout(:)
    integer(psb_ipk_), intent(out)   :: info 
    logical, intent(in), optional :: mask(:)
    integer(psb_ipk_), intent(in), optional :: lidx(:)

    integer(psb_ipk_) :: err_act
    character(len=20)  :: name='base_g2l_ins'
    logical, parameter :: debug=.false.

    call psb_get_erraction(err_act)
    ! This is the base version. If we get here
    ! it means the derived class is incomplete,
    ! so we throw an error.
    call psb_errpush(psb_err_missing_override_method_,&
         & name,a_err=idxmap%get_fmt())

    call psb_error_handler(err_act)
    return

  end subroutine base_g2lv2_ins


  subroutine base_asb(idxmap,info)
    use psb_error_mod
    implicit none 
    class(psb_indx_map), intent(inout) :: idxmap
    integer(psb_ipk_), intent(out) :: info

    integer(psb_ipk_) :: err_act
    character(len=20)  :: name='base_asb'
    logical, parameter :: debug=.false.

    call psb_get_erraction(err_act)
    ! This is the base version. If we get here
    ! it means the derived class is incomplete,
    ! so we throw an error.
    call psb_errpush(psb_err_missing_override_method_,&
         & name,a_err=idxmap%get_fmt())

    call psb_error_handler(err_act)
    return

  end subroutine base_asb

  subroutine base_free(idxmap)
    use psb_error_mod
    implicit none 
    class(psb_indx_map), intent(inout) :: idxmap

    ! almost nothing to be done here
    idxmap%state          = -1 
    idxmap%ictxt          = -1
    idxmap%mpic           = -1
    idxmap%global_rows    = -1
    idxmap%global_cols    = -1
    idxmap%local_rows     = -1
    idxmap%local_cols     = -1

    return

  end subroutine base_free

  subroutine base_set_null(idxmap)
    implicit none 
    class(psb_indx_map), intent(inout) :: idxmap

    idxmap%state          = psb_desc_null_
    idxmap%ictxt          = -1
    idxmap%mpic           = -1
    idxmap%global_rows    = -1
    idxmap%global_cols    = -1
    idxmap%local_rows     = -1
    idxmap%local_cols     = -1

  end subroutine base_set_null

  subroutine base_init_vl(idxmap,ictxt,vl,info)
    use psb_penv_mod
    use psb_error_mod
    implicit none 
    class(psb_indx_map), intent(inout) :: idxmap
    integer(psb_mpik_), intent(in)  :: ictxt
    integer(psb_ipk_), intent(in)  :: vl(:)
    integer(psb_ipk_), intent(out) :: info
    integer(psb_ipk_) :: err_act
    character(len=20)  :: name='base_init_vl'
    logical, parameter :: debug=.false.

    call psb_get_erraction(err_act)
    ! This is the base version. If we get here
    ! it means the derived class is incomplete,
    ! so we throw an error.
    call psb_errpush(psb_err_missing_override_method_,&
         & name,a_err=idxmap%get_fmt())

  call psb_error_handler(err_act)
    return
  end subroutine base_init_vl

  subroutine base_clone(idxmap,outmap,info)
    use psb_penv_mod
    use psb_error_mod
    implicit none 
    class(psb_indx_map), intent(inout)    :: idxmap
    class(psb_indx_map), allocatable, intent(out) :: outmap
    integer(psb_ipk_), intent(out) :: info
    integer(psb_ipk_) :: err_act
    character(len=20)  :: name='base_clone'
    logical, parameter :: debug=.false.

    info = psb_success_

    call psb_get_erraction(err_act)
    ! This is the base version. If we get here
    ! it means the derived class is incomplete,
    ! so we throw an error.
    call psb_errpush(psb_err_missing_override_method_,&
         & name,a_err=idxmap%get_fmt())

    call psb_error_handler(err_act)
    return
  end subroutine base_clone


  subroutine base_reinit(idxmap,info)
    use psb_penv_mod
    use psb_error_mod
    implicit none 
    class(psb_indx_map), intent(inout)    :: idxmap
    integer(psb_ipk_), intent(out) :: info
    integer(psb_ipk_) :: err_act
    character(len=20)  :: name='base_reinit'
    logical, parameter :: debug=.false.

    info = psb_success_

    call psb_get_erraction(err_act)
    ! This is the base version. If we get here
    ! it means the derived class is incomplete,
    ! so we throw an error.
    call psb_errpush(psb_err_missing_override_method_,&
         & name,a_err=idxmap%get_fmt())

    call psb_error_handler(err_act)
    return
  end subroutine base_reinit

end module psb_indx_map_mod