psblas3/base/modules/desc/psb_desc_mod.F90

!   
!                Parallel Sparse BLAS  version 3.5
!      (C) Copyright 2006-2018
!        Salvatore Filippone    
!        Alfredo Buttari      
!   
!    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_desc_mod
!    Defines a communication descriptor
!

module psb_desc_mod
  use psb_const_mod
  use psb_desc_const_mod
  use psb_indx_map_mod
  use psb_i_vect_mod

  implicit none

  !
  !  type: psb_desc_type
  !  
  !  Communication Descriptor data structure.
  !
  !|  type psb_desc_type
  !|     class(psb_indx_map), allocatable :: indxmap
  !|     integer(psb_ipk_), allocatable  :: halo_index(:), ext_index(:)
  !|     integer(psb_ipk_), allocatable  :: bnd_elem(:)
  !|     integer(psb_ipk_), allocatable  :: ovrlap_index(:)
  !|     integer(psb_ipk_), allocatable  :: ovrlap_elem(:,:)
  !|     integer(psb_ipk_), allocatable  :: ovr_mst_idx(:)
  !|     integer(psb_ipk_), allocatable  :: lprm(:)
  !|     integer(psb_ipk_), allocatable  :: idx_space(:)
  !|     type(psb_desc_type), pointer :: base_desc => null()
  !|  end type psb_desc_type
  !
  !  
  !  This is the most important data structure: it holds all the data 
  !  necessary to organize data exchange. The pattern of communication 
  !  among processes depends not only on the allocation of portions of 
  !  the index space to the various processes, but also on the underlying
  !  mesh discretization pattern. Thus building a communication descriptor is
  !  very much linked to building a sparse matrix (since the matrix sparsity 
  !  pattern embodies the topology of the discretization graph).
  !
  !  This is a two-level data structure: it combines an INDX_MAP with
  !  a set of auxiliary lists.
  !  For a complete description of INDX_MAP see its own file, but the
  !  idea here is the following: the INDX_MAP contains information about
  !  the index space and its allocation to the various processors.
  !  In particular, besides the communicator, it contains the data relevant
  !  to the following queries:
  !  1. How many global rows/columns?
  !  2. How many local  rows/columns?
  !  3. Convert between local and global indices
  !  4. Add to local indices.
  !  5. Find (one of) the owner(s) of a given index
  !  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).
  !  There are multiple ways to represent an INDX_MAP internally, hence it is
  !  a CLASS variable, which can take different forms, more or less memory hungry. 
  !
  !  Guidelines
  !
  !  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). 
  !
  !  6. The descriptor also contains the inverse global-to-local mapping.
  !
  !  7. The data exchange is based on lists of local indices to be exchanged; all the 
  !     lists have the same format, as follows:
  !     the list is  composed of variable dimension blocks, one for each process to 
  !     communicate with; each block contains indices of local elements to be 
  !     exchanged. We do choose the order of communications:  do not change 
  !     the sequence of blocks unless you know what you're doing, or you'll 
  !     risk a deadlock. NOTE: This is the format when the state is PSB_ASB_.
  !     See below for BLD. The end-of-list is marked with a -1. 
  !
  !|  notation        stored in                   explanation
  !|  --------------- --------------------------- -----------------------------------
  !|  process_id      index_v(p+proc_id_)      identifier of process with which 
  !|                                                data is  exchanged.
  !|  n_elements_recv index_v(p+n_elem_recv_)  number of elements to receive.
  !|  elements_recv   index_v(p+elem_recv_+i)  indexes of local elements to
  !|                                              receive. these are stored in the
  !|                                              array from location p+elem_recv_ to
  !|                                              location p+elem_recv_+
  !|                                              index_v(p+n_elem_recv_)-1.
  !|  n_elements_send index_v(p+n_elem_send_)  number of elements to send.
  !|  elements_send   index_v(p+elem_send_+i)  indexes of local elements to
  !|                                              send. these are stored in the
  !|                                              array from location p+elem_send_ to
  !|                                              location p+elem_send_+
  !|                                              index_v(p+n_elem_send_)-1.
  !
  !     This organization is valid for both halo and overlap indices; overlap entries
  !     need to be updated to ensure that a variable at a given global index 
  !     (assigned to multiple processes) has the same value. The way to resolve the 
  !     issue is to exchange the data and then sum (or average) the values. See
  !     psb_ovrl subroutine. 
  !  
  !  8. When the descriptor is in the BLD state the INDEX vectors contains only 
  !     the indices to be received, organized as  a sequence of entries of
  !     the form (proc,N,(lx1,lx2,...,lxn)) with owning process, number of indices
  !     (most often but not necessarily N=1), list of local indices.  
  !     This is because we only know the list of halo indices to be received 
  !     as we go about building the sparse matrix pattern, and we want the build 
  !     phase to be loosely synchronized. Thus we record the indices we have to ask 
  !     for, and at the time we call PSB_CDASB we match all the requests to figure 
  !     out who should be sending what to whom.
  !     However this implies that we know who owns the indices; 
  !     this is actually only true for the OVERLAP list 
  !     that is filled in at CDALL time, and not for the HALO (remember: we do not
  !     necessarily have the space to encode the owning process index); thus 
  !     the HALO list is rebuilt during the CDASB process 
  !     (in the psi_ldsc_pre_halo subroutine). 
  !  
  !  9. Yet another twist comes about when building an extended descriptor with 
  !     the psb_cdbldext subroutine. In this case we are reaching out 
  !     layer by layer, but we may use the results in two ways:
  !      i. To build a descriptor with the same "owned" indices, but with an 
  !         extended halo, with additional layers; in this case the requests 
  !         go into halo_index;
  !     ii. To build a descriptor suitable for overlapped Schwarz-type computations.
  !         In this case we end up with more "owned" indices than in the base 
  !         descriptor, so that what was a halo index in the base becomes an overlap
  !         index in the extended descriptor. In this case we build three lists: 
  !         ovrlap_index    the indices that overlap
  !         halo_index      the halo indices (of the extended descriptor)
  !         ext_index       the indices of elements that need to be gathered to 
  !                         map the original index space onto the new (overlapped) 
  !                         index space. 
  !     So, ext_index has the same format as the others, but is only used in the 
  !     context of Schwarz-type computations; otherwise it is empty (i.e. 
  !     it only contains the end-of-list marker -1). 
  !
  ! 10. ovrlap_elem contains a list of overlap indices together with their degree
  !     of overlap, i.e. the number of processes "owning" the, and the "master"
  !     process whose value has to be considered authoritative when the need arises.
  !     
  ! 11. ovr_mst_idx is a list defining a retrieve of a copy of the values for
  !     overlap entries from their respecitve "master" processes by means of
  !     an halo exchange call. This is used for those cases where there is
  !     an overlap in the base data distribution.
  !
  ! It is complex, but it does the following:
  !  1. Allows a purely local matrix/stencil buildup phase, requiring only 
  !     one synch point at the end (CDASB)
  !  2. Takes shortcuts when the problem size is not too large
  !  
  !  3. Supports restriction/prolongation operators with the same routines 
  !     just choosing (in the swapdata/swaptran internals) on which index list 
  !     they should work. 
  !
  !
  !


  type psb_desc_type
    class(psb_indx_map), allocatable :: indxmap

    integer(psb_ipk_), allocatable   :: halo_index(:)
    integer(psb_ipk_), allocatable   :: ext_index(:)
    integer(psb_ipk_), allocatable   :: ovrlap_index(:)
    integer(psb_ipk_), allocatable   :: ovr_mst_idx(:)

    type(psb_i_vect_type)            :: v_halo_index
    type(psb_i_vect_type)            :: v_ext_index
    type(psb_i_vect_type)            :: v_ovrlap_index
    type(psb_i_vect_type)            :: v_ovr_mst_idx 

    integer(psb_ipk_), allocatable   :: ovrlap_elem(:,:)
    integer(psb_ipk_), allocatable   :: bnd_elem(:)
    integer(psb_ipk_), allocatable   :: lprm(:)
    type(psb_desc_type), pointer     :: base_desc => null()
    integer(psb_ipk_), allocatable   :: idx_space(:)
  contains
    procedure, pass(desc) :: is_ok           => psb_is_ok_desc
    procedure, pass(desc) :: is_valid        => psb_is_valid_desc
    procedure, pass(desc) :: is_upd          => psb_is_upd_desc
    procedure, pass(desc) :: is_bld          => psb_is_bld_desc
    procedure, pass(desc) :: is_asb          => psb_is_asb_desc
    procedure, pass(desc) :: is_ovl          => psb_is_ovl_desc
    procedure, pass(desc) :: is_repl         => psb_is_repl_desc
    procedure, pass(desc) :: get_mpic        => psb_cd_get_mpic
    procedure, pass(desc) :: get_dectype     => psb_cd_get_dectype
    procedure, pass(desc) :: get_context     => psb_cd_get_context    
    procedure, pass(desc) :: get_ctxt        => psb_cd_get_context    
    procedure, pass(desc) :: get_local_rows  => psb_cd_get_local_rows
    procedure, pass(desc) :: get_local_cols  => psb_cd_get_local_cols
    procedure, pass(desc) :: get_global_rows => psb_cd_get_global_rows
    procedure, pass(desc) :: get_global_cols => psb_cd_get_global_cols
    procedure, pass(desc) :: get_global_indices => psb_cd_get_global_indices
    procedure, pass(desc) :: get_p_adjcncy   => cd_get_p_adjcncy
    procedure, pass(desc) :: set_p_adjcncy   => cd_set_p_adjcncy
    procedure, pass(desc) :: xtnd_p_adjcncy  => cd_xtnd_p_adjcncy    
    procedure, pass(desc) :: a_get_list      => psb_cd_get_list
    procedure, pass(desc) :: v_get_list      => psb_cd_v_get_list
    generic, public       :: get_list => a_get_list, v_get_list
    procedure, pass(desc) :: sizeof          => psb_cd_sizeof
    procedure, pass(desc) :: clone           => psb_cd_clone
    procedure, pass(desc) :: cnv             => psb_cd_cnv
    procedure, pass(desc) :: free            => psb_cdfree
    procedure, pass(desc) :: destroy         => psb_cd_destroy
    procedure, pass(desc) :: nullify         => nullify_desc

    procedure, pass(desc) :: get_fmt         => cd_get_fmt
    procedure, pass(desc) :: fnd_owner       => cd_fnd_owner
    procedure, pass(desc) :: l2gs1           => cd_l2gs1
    procedure, pass(desc) :: l2gs2           => cd_l2gs2
    procedure, pass(desc) :: l2gv1           => cd_l2gv1
    procedure, pass(desc) :: l2gv2           => cd_l2gv2
    generic, public       :: l2g             => l2gs2, l2gv2
    generic, public       :: l2gip           => l2gs1, l2gv1                            

    procedure, pass(desc) :: g2ls1           => cd_g2ls1
    procedure, pass(desc) :: g2ls2           => cd_g2ls2
    procedure, pass(desc) :: g2lv1           => cd_g2lv1
    procedure, pass(desc) :: g2lv2           => cd_g2lv2
    generic, public       :: g2l             => g2ls2, g2lv2
    generic, public       :: g2lip           => g2ls1, g2lv1

    procedure, pass(desc) :: g2ls1_ins       => cd_g2ls1_ins
    procedure, pass(desc) :: g2ls2_ins       => cd_g2ls2_ins
    procedure, pass(desc) :: g2lv1_ins       => cd_g2lv1_ins
    procedure, pass(desc) :: g2lv2_ins       => cd_g2lv2_ins
    generic, public       :: g2l_ins         => g2ls2_ins, g2lv2_ins
    generic, public       :: g2lip_ins       => g2ls1_ins, g2lv1_ins
    

  end type psb_desc_type

      
  interface psb_sizeof
    module procedure psb_cd_sizeof
  end interface psb_sizeof

  interface psb_move_alloc
    module procedure psb_cdtransfer
  end interface psb_move_alloc

  interface psb_free
    module procedure psb_cdfree
  end interface psb_free

  interface psb_cd_set_large_threshold    
    module procedure  psb_i_cd_set_large_threshold
  end interface psb_cd_set_large_threshold

#if defined(IPK4) && defined(LPK8)
  interface psb_cd_set_large_threshold    
    module procedure  psb_l_cd_set_large_threshold
  end interface psb_cd_set_large_threshold
#endif

  interface psb_set_sp_a2av_alg
    module procedure psb_m_set_sp_a2av_alg, psb_e_set_sp_a2av_alg
  end interface psb_set_sp_a2av_alg

  interface psb_get_sp_a2av_alg
    module procedure psb_m_get_sp_a2av_alg
  end interface psb_get_sp_a2av_alg

  private :: nullify_desc, cd_get_fmt,&
       & cd_l2gs1, cd_l2gs2, cd_l2gv1, cd_l2gv2, cd_g2ls1,&
       & cd_g2ls2, cd_g2lv1, cd_g2lv2, cd_g2ls1_ins,&
       & cd_g2ls2_ins, cd_g2lv1_ins, cd_g2lv2_ins, cd_fnd_owner


  integer(psb_lpk_), private, save :: cd_large_threshold = psb_default_large_threshold
  integer(psb_ipk_), private, save :: sp_a2av_alg        = psb_sp_a2av_smpl_triad_ 

contains 

  function psb_m_get_sp_a2av_alg() result(val)
    implicit none
    integer(psb_mpk_) :: val
    val = sp_a2av_alg
  end function psb_m_get_sp_a2av_alg

  subroutine psb_m_set_sp_a2av_alg(val) 
    implicit none
    integer(psb_mpk_), intent(in) :: val

    if ((psb_sp_a2av_alg_min_ <= val).and.(val<=psb_sp_a2av_alg_max_)) &
         &  sp_a2av_alg = val
  end subroutine psb_m_set_sp_a2av_alg
  
  subroutine psb_e_set_sp_a2av_alg(val) 
    implicit none
    integer(psb_epk_), intent(in) :: val

    if ((psb_sp_a2av_alg_min_ <= val).and.(val<=psb_sp_a2av_alg_max_)) &
         &  sp_a2av_alg = val
  end subroutine psb_e_set_sp_a2av_alg
  
  
  function psb_cd_sizeof(desc)  result(val)
    implicit none
    !....Parameters...

    class(psb_desc_type), intent(in) :: desc
    integer(psb_epk_) :: val

    val = 0 
    val = val + psb_sizeof_ip*psb_size(desc%halo_index)
    val = val + psb_sizeof_ip*psb_size(desc%ext_index)
    val = val + psb_sizeof_ip*psb_size(desc%bnd_elem)
    val = val + psb_sizeof_ip*psb_size(desc%ovrlap_index)
    val = val + psb_sizeof_ip*psb_size(desc%ovrlap_elem)
    val = val + psb_sizeof_ip*psb_size(desc%ovr_mst_idx)
    val = val + psb_sizeof_ip*psb_size(desc%lprm)
    val = val + psb_sizeof_ip*psb_size(desc%idx_space)
    if (allocated(desc%indxmap))  val = val + desc%indxmap%sizeof()
    val = val + desc%v_halo_index%sizeof()
    val = val + desc%v_ext_index%sizeof()
    val = val + desc%v_ovrlap_index%sizeof()
    val = val + desc%v_ovr_mst_idx%sizeof()

  end function psb_cd_sizeof



  subroutine psb_i_cd_set_large_threshold(ith)
    implicit none 
    integer(psb_ipk_), intent(in) :: ith
    if (ith > 0) then 
      cd_large_threshold = ith
    end if
  end subroutine psb_i_cd_set_large_threshold

  subroutine psb_l_cd_set_large_threshold(ith)
    implicit none 
    integer(psb_lpk_), intent(in) :: ith
    if (ith > 0) then 
      cd_large_threshold = ith
    end if
  end subroutine psb_l_cd_set_large_threshold

  function  psb_cd_get_large_threshold() result(val)
    implicit none 
    integer(psb_lpk_) :: val
    val  = cd_large_threshold 
  end function psb_cd_get_large_threshold
  
  function  psb_cd_is_large_size(m) result(val)
    use psb_penv_mod

    implicit none
    integer(psb_lpk_), intent(in) :: m
    logical :: val
    !locals
    val = (m > psb_cd_get_large_threshold()) 
  end function psb_cd_is_large_size

  function  psb_cd_choose_large_state(ctxt,m) result(val)
    use psb_penv_mod

    implicit none
    type(psb_ctxt_type), intent(in) :: ctxt
    integer(psb_lpk_), intent(in)   :: m
    logical :: val
    !locals
    integer(psb_ipk_) :: np,me

    call psb_info(ctxt, me, np)
    ! 
    ! Since the hashed lists take up (somewhat) more than 2*N_COL integers,
    ! it makes no sense to use them if you don't have at least 
    ! 3 processes, no matter what the size of the index space. 
    !
    val = psb_cd_is_large_size(m) .and. (np > 2)
  end function psb_cd_choose_large_state

  subroutine psb_nullify_desc(desc)
    implicit none 
    type(psb_desc_type), intent(inout) :: desc
    ! We have nothing left to do here.
    ! Perhaps we should delete this subroutine? 
    nullify(desc%base_desc)

  end subroutine psb_nullify_desc

  subroutine nullify_desc(desc)
    implicit none 
    class(psb_desc_type), intent(inout) :: desc
    ! We have nothing left to do here.
    ! Perhaps we should delete this subroutine? 
    nullify(desc%base_desc)

  end subroutine nullify_desc

  function psb_is_ok_desc(desc) result(val)
    implicit none 
    class(psb_desc_type), intent(in) :: desc
    logical                          :: val 
    
    val = .false.
    if (allocated(desc%indxmap)) &
         & val = desc%indxmap%is_valid()

  end function psb_is_ok_desc

  function psb_is_valid_desc(desc) result(val)
    implicit none 
    class(psb_desc_type), intent(in) :: desc
    logical                          :: val 
    
    val = .false.
    if (allocated(desc%indxmap)) &
         & val = desc%indxmap%is_valid()

  end function psb_is_valid_desc

  function psb_is_bld_desc(desc) result(val)
    implicit none 
    class(psb_desc_type), intent(in) :: desc
    logical                         :: val 

    val = .false.
    if (allocated(desc%indxmap)) &
         & val = desc%indxmap%is_bld()

  end function psb_is_bld_desc

  function psb_is_upd_desc(desc)  result(val)
    implicit none 
    class(psb_desc_type), intent(in) :: desc
    logical                          :: val 

    val = .false.
    if (allocated(desc%indxmap)) &
         & val = desc%indxmap%is_upd()

  end function psb_is_upd_desc

  function psb_is_repl_desc(desc) result(val)
    implicit none 
    class(psb_desc_type), intent(in) :: desc
    logical                          :: val 

    val = .false.
    if (allocated(desc%indxmap)) &
         & val = desc%indxmap%is_repl()

  end function psb_is_repl_desc

  function psb_is_ovl_desc(desc) result(val)
    implicit none 
    class(psb_desc_type), intent(in) :: desc
    logical                          :: val 

    val = .false.
    if (allocated(desc%indxmap)) &
         & val = desc%indxmap%is_ovl()

  end function psb_is_ovl_desc


  function psb_is_asb_desc(desc) result(val)
    implicit none 
    class(psb_desc_type), intent(in) :: desc
    logical                          :: val 

    val = .false.
    if (allocated(desc%indxmap)) &
         & val = desc%indxmap%is_asb()

  end function psb_is_asb_desc

  function psb_cd_get_local_rows(desc) result(val)
    implicit none 
    integer(psb_ipk_) :: val 
    class(psb_desc_type), intent(in) :: desc

    if (allocated(desc%indxmap)) then 
      val = desc%indxmap%get_lr()
    else
      val = -1
    endif
  end function psb_cd_get_local_rows

  function psb_cd_get_local_cols(desc) result(val)
    implicit none 
    integer(psb_ipk_) :: val 
    class(psb_desc_type), intent(in) :: desc

    if (allocated(desc%indxmap)) then 
      val = desc%indxmap%get_lc()
    else
      val = -1
    endif
  end function psb_cd_get_local_cols

  function psb_cd_get_global_rows(desc) result(val)
    implicit none 
    integer(psb_lpk_) :: val 
    class(psb_desc_type), intent(in) :: desc

    if (allocated(desc%indxmap)) then 
      val = desc%indxmap%get_gr()
    else
      val = -1
    endif

  end function psb_cd_get_global_rows

  function psb_cd_get_global_cols(desc) result(val)
    implicit none 
    integer(psb_lpk_) :: val 
    class(psb_desc_type), intent(in) :: desc

    if (allocated(desc%indxmap)) then 
      val = desc%indxmap%get_gc()
    else
      val = -1
    endif

  end function psb_cd_get_global_cols

  function psb_cd_get_global_indices(desc,owned) result(val)
    implicit none 
    integer(psb_lpk_), allocatable   :: val(:)
    class(psb_desc_type), intent(in) :: desc
    logical, intent(in), optional    :: owned

    logical :: owned_
    integer(psb_ipk_) :: i, nr, info
    
    owned_=.true.
    if (present(owned)) owned_=owned

    
    if (allocated(desc%indxmap)) then 
      if (owned_) then
        nr = desc%get_local_rows()
      else
        nr = desc%get_local_cols()
      end if
      nr = max(nr,0)
      allocate(val(nr))
      do i=1, nr
        val(i) = i
      end do
      call desc%l2gip(val,info,owned=owned_)
    else
      allocate(val(0))
    endif

  end function psb_cd_get_global_indices

 
  function cd_get_fmt(desc) result(val)
    implicit none 
    character(len=5) :: val 
    class(psb_desc_type), intent(in) :: desc

    if (allocated(desc%indxmap)) then 
      val = desc%indxmap%get_fmt()
    else
      val = 'NULL'
    endif

  end function cd_get_fmt

  function psb_cd_get_context(desc) result(val)
    use psb_error_mod
    implicit none 
    type(psb_ctxt_type) :: val 
    class(psb_desc_type), intent(in) :: desc
    
    if (allocated(desc%indxmap)) then
      val = desc%indxmap%get_ctxt()    
    else
      ! At this point, val should a non-ALLOCATED
      ! ctxt component, which suits us just fine. 
      !call psb_errpush(psb_err_invalid_cd_state_,'psb_cd_get_context')
      !call psb_error()
    end if
  end function psb_cd_get_context

  function psb_cd_get_dectype(desc) result(val)
    use psb_error_mod
    implicit none 
    integer(psb_ipk_) :: val 
    class(psb_desc_type), intent(in) :: desc

    if (allocated(desc%indxmap)) then
      val = desc%indxmap%get_state()    
    else
      val = -1
!!$      call psb_errpush(psb_err_invalid_cd_state_,'psb_cd_get_dectype')
!!$      call psb_error()
    end if

  end function psb_cd_get_dectype

  function psb_cd_get_mpic(desc) result(val)
    use psb_error_mod
    implicit none 
    integer(psb_ipk_) :: val 
    class(psb_desc_type), intent(in) :: desc

    if (allocated(desc%indxmap)) then
      val = desc%indxmap%get_mpic()    
    else
      val = -1
!!$      call psb_errpush(psb_err_invalid_cd_state_,'psb_cd_get_mpic')
!!$      call psb_error()
    end if

  end function psb_cd_get_mpic


  function cd_get_p_adjcncy(desc) result(val)
    implicit none 
    integer(psb_ipk_), allocatable   :: val(:)
    class(psb_desc_type), intent(in) :: desc

    if (allocated(desc%indxmap)) then 
      val = desc%indxmap%get_p_adjcncy()
    endif

  end function cd_get_p_adjcncy

  subroutine cd_set_p_adjcncy(desc,val)
    implicit none 
    class(psb_desc_type), intent(inout) :: desc
    integer(psb_ipk_), intent(in)  :: val(:)
    if (allocated(desc%indxmap)) then 
      call desc%indxmap%xtnd_p_adjcncy(val)
    endif
  end subroutine cd_set_p_adjcncy

  subroutine cd_xtnd_p_adjcncy(desc,val)
    implicit none 
    class(psb_desc_type), intent(inout) :: desc
    integer(psb_ipk_), intent(in)  :: val(:)
    if (allocated(desc%indxmap)) then 
      call desc%indxmap%xtnd_p_adjcncy(val)
    endif
  end subroutine cd_xtnd_p_adjcncy
  
  subroutine psb_cd_set_ovl_asb(desc,info)
    !
    ! Change state of a descriptor into ovl_build. 
    implicit none
    type(psb_desc_type), intent(inout) :: desc
    integer(psb_ipk_) :: info

    info = 0
    if (psb_is_asb_desc(desc)) &
         & call desc%indxmap%set_state(psb_desc_ovl_asb_)

  end subroutine psb_cd_set_ovl_asb


  subroutine psb_get_xch_idx(idx,totxch,totsnd,totrcv)
    implicit none 
    integer(psb_ipk_), intent(in)  :: idx(:)
    integer(psb_ipk_), intent(out) :: totxch,totsnd,totrcv

    integer(psb_ipk_) :: ip, nerv, nesd
    character(len=20), parameter  :: name='psb_get_xch_idx'    

    totxch = 0
    totsnd = 0
    totrcv = 0
    ip     = 1

    do 
      if (ip > size(idx)) then 
        write(psb_err_unit,*) trim(name),': Warning: out of size of input vector '
        exit
      end if
      if (idx(ip) == -1) exit
      totxch = totxch+1
      nerv   = idx(ip+psb_n_elem_recv_)
      nesd   = idx(ip+nerv+psb_n_elem_send_)
      totsnd = totsnd + nesd
      totrcv = totrcv + nerv
      ip     = ip+nerv+nesd+3
    end do

  end subroutine psb_get_xch_idx


  subroutine psb_get_v_xch_idx(idx,totxch,totsnd,totrcv)
    implicit none 
    class(psb_i_base_vect_type), intent(in)  :: idx
    integer(psb_ipk_), intent(out) :: totxch,totsnd,totrcv

    integer(psb_ipk_) :: ip, nerv, nesd
    character(len=20), parameter  :: name='psb_get_v_xch_idx'    

    call psb_get_xch_idx(idx%v,totxch,totsnd,totrcv)

  end subroutine psb_get_v_xch_idx



  subroutine psb_cd_get_list(data,desc,ipnt,totxch,idxr,idxs,info)
    use psb_const_mod
    use psb_error_mod
    use psb_penv_mod

    implicit none
    integer(psb_ipk_), intent(in)  :: data
    integer(psb_ipk_), pointer     :: ipnt(:)
    class(psb_desc_type), target   :: desc
    integer(psb_ipk_), intent(out) :: totxch,idxr,idxs,info

    !locals
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_)   :: np, me, err_act, debug_level, debug_unit
    logical, parameter  :: debug=.false., debugprt=.false.
    character(len=20), parameter :: name='psb_cd_get_list'

    info = psb_success_
    call psb_erractionsave(err_act)
    debug_unit  = psb_get_debug_unit()
    debug_level = psb_get_debug_level()

    ctxt = psb_cd_get_context(desc)

    call psb_info(ctxt, me, np)

    select case(data) 
    case(psb_comm_halo_) 
      ipnt   => desc%halo_index
    case(psb_comm_ovr_) 
      ipnt   => desc%ovrlap_index
    case(psb_comm_ext_) 
      ipnt   => desc%ext_index
      if (debug_level >= psb_debug_ext_) then
        if (.not.associated(desc%base_desc)) then
          write(debug_unit,*) trim(name),&
               & ': Warning: trying to get ext_index on a descriptor ',&
               & 'which does not have a base_desc!'
        end if
        if (.not.psb_is_ovl_desc(desc)) then
          write(debug_unit,*) trim(name),&
               & ': Warning: trying to get ext_index on a descriptor ',&
               & 'which is not overlap-extended!'
        end if
      end if
    case(psb_comm_mov_) 
      ipnt   => desc%ovr_mst_idx
    case default
      info=psb_err_from_subroutine_
      call psb_errpush(info,name,a_err='wrong Data selector')
      goto 9999
    end select
    call psb_get_xch_idx(ipnt,totxch,idxs,idxr)


    call psb_erractionrestore(err_act)
    return


9999 call psb_error_handler(err_act)

    return

  end subroutine psb_cd_get_list


  subroutine psb_cd_v_get_list(data,desc,ipnt,totxch,idxr,idxs,info)
    use psb_const_mod
    use psb_error_mod
    use psb_penv_mod
    implicit none
    integer(psb_ipk_), intent(in)        :: data
    class(psb_i_base_vect_type), pointer :: ipnt
    class(psb_desc_type), target         :: desc
    integer(psb_ipk_), intent(out)       :: totxch,idxr,idxs,info

    !locals
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_)   :: np, me, err_act, debug_level, debug_unit
    logical, parameter  :: debug=.false., debugprt=.false.
    character(len=20), parameter :: name='psb_cd_v_get_list'

    info = psb_success_
    call psb_erractionsave(err_act)
    debug_unit  = psb_get_debug_unit()
    debug_level = psb_get_debug_level()

    ctxt = psb_cd_get_context(desc)

    call psb_info(ctxt, me, np)

    select case(data) 
    case(psb_comm_halo_) 
      ipnt   => desc%v_halo_index%v
      if (.not.allocated(desc%v_halo_index%v)) &
           & info = psb_err_inconsistent_index_lists_
    case(psb_comm_ovr_) 
      ipnt   => desc%v_ovrlap_index%v
      if (.not.allocated(desc%v_ovrlap_index%v)) &
           & info = psb_err_inconsistent_index_lists_
    case(psb_comm_ext_) 
      ipnt   => desc%v_ext_index%v
      if (.not.allocated(desc%v_ext_index%v)) &
           & info = psb_err_inconsistent_index_lists_
      if (debug_level >= psb_debug_ext_) then
        if (.not.associated(desc%base_desc)) then
          write(debug_unit,*) trim(name),&
               & ': Warning: trying to get ext_index on a descriptor ',&
               & 'which does not have a base_desc!'
        end if
        if (.not.psb_is_ovl_desc(desc)) then
          write(debug_unit,*) trim(name),&
               & ': Warning: trying to get ext_index on a descriptor ',&
               & 'which is not overlap-extended!'
        end if
      end if
    case(psb_comm_mov_) 
      ipnt   => desc%v_ovr_mst_idx%v
      if (.not.allocated(desc%v_ovr_mst_idx%v)) &
           & info = psb_err_inconsistent_index_lists_
      
    case default
      info=psb_err_from_subroutine_
    end select
    if (info /= psb_success_) then
      call psb_errpush(info,name,a_err='wrong Data selector')
      goto 9999
    end if
    
    call psb_get_v_xch_idx(ipnt,totxch,idxs,idxr)


    call psb_erractionrestore(err_act)
    return

9999 call psb_error_handler(err_act)

    return

  end subroutine psb_cd_v_get_list

  !
  ! Subroutine: psb_cdfree
  !   Frees a descriptor data structure.
  ! 
  ! Arguments: 
  !    desc_a   - type(psb_desc_type).         The communication descriptor to be freed.
  !    info     - integer.                       return code.
  subroutine psb_cdfree(desc,info)
    !...free descriptor structure...
    use psb_const_mod
    use psb_error_mod
    use psb_penv_mod
    implicit none
    !....parameters...
    class(psb_desc_type), intent(inout) :: desc
    integer(psb_ipk_), intent(out)      :: info
    !...locals....
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_)   :: np, me, err_act
    character(len=20)   :: name

    info=psb_success_
    call psb_erractionsave(err_act)
    name = 'psb_cdfree'

    call desc%destroy()

    call psb_erractionrestore(err_act)
    return


9999 call psb_error_handler(err_act)
    return

  end subroutine psb_cdfree

  !
  ! Subroutine: psb_cdfree
  !   Frees a descriptor data structure.
  ! 
  ! Arguments: 
  !    desc_a   - type(psb_desc_type).         The communication descriptor to be freed.
  subroutine psb_cd_destroy(desc)
    !...free descriptor structure...
    use psb_const_mod
    use psb_error_mod
    use psb_penv_mod
    implicit none
    !....parameters...
    class(psb_desc_type), intent(inout) :: desc
    !...locals....
    integer(psb_ipk_) :: info

    if (allocated(desc%halo_index)) &
         &  deallocate(desc%halo_index,stat=info)

    if (allocated(desc%ext_index)) &
         &  deallocate(desc%ext_index,stat=info)

    if (allocated(desc%bnd_elem)) &
         &    deallocate(desc%bnd_elem,stat=info)

    if (allocated(desc%ovrlap_index)) &
         & deallocate(desc%ovrlap_index,stat=info)
    
    if (allocated(desc%ovrlap_elem)) &
         & deallocate(desc%ovrlap_elem,stat=info)

    if (allocated(desc%ovr_mst_idx)) &
         & deallocate(desc%ovr_mst_idx,stat=info)

    if (allocated(desc%lprm)) &
         & deallocate(desc%lprm,stat=info)

    if (allocated(desc%idx_space)) &
         & deallocate(desc%idx_space,stat=info)

    if (allocated(desc%indxmap)) then 
      call desc%indxmap%free()
      deallocate(desc%indxmap, stat=info)
    end if
    call desc%v_halo_index%free(info)
    call desc%v_ovrlap_index%free(info)
    call desc%v_ext_index%free(info)
    call desc%v_ovr_mst_idx%free(info)

    call desc%nullify()

    return

  end subroutine psb_cd_destroy
  !
  ! Subroutine: psb_cdtransfer
  !   Transfers data and allocation from in to out; behaves like MOVE_ALLOC, i.e.
  !   the IN arg is empty (and deallocated) upon exit. 
  !
  ! 
  ! Arguments: 
  !    desc  - type(psb_desc_type).         The communication descriptor to be 
  !                                               transferred.
  !    desc_out - type(psb_desc_type).         The output communication descriptor.
  !    info     - integer.                       Return code.
  subroutine psb_cdtransfer(desc, desc_out, info)

    use psb_realloc_mod
    use psb_const_mod
    use psb_error_mod
    use psb_penv_mod

    implicit none
    !....parameters...

    type(psb_desc_type), intent(inout) :: desc
    type(psb_desc_type), intent(inout) :: desc_out
    integer(psb_ipk_), intent(out)     :: info

    !locals
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_)   :: np, me, err_act
    integer(psb_ipk_)   :: debug_level, debug_unit
    character(len=20)   :: name

    if (psb_get_errstatus() /= 0) return 
    info = psb_success_
    call psb_erractionsave(err_act)
    name = 'psb_cdtransfer'
    debug_unit  = psb_get_debug_unit()
    debug_level = psb_get_debug_level()
    !
    ! Note: this  might be called even
    ! when desc is empty.
    ! 
    if (desc%is_valid()) then 
      ctxt = desc%get_ctxt()
      call psb_info(ctxt,me,np)

      if (info == psb_success_)  &
           & call psb_move_alloc( desc%halo_index  ,    desc_out%halo_index   , info)
      if (info == psb_success_)  &
           & call psb_move_alloc( desc%bnd_elem    ,    desc_out%bnd_elem     , info)
      if (info == psb_success_)  &
           & call psb_move_alloc( desc%ovrlap_elem ,    desc_out%ovrlap_elem  , info)
      if (info == psb_success_)  &
           & call psb_move_alloc( desc%ovrlap_index,    desc_out%ovrlap_index , info)
      if (info == psb_success_)  &
           & call psb_move_alloc( desc%ovr_mst_idx ,    desc_out%ovr_mst_idx  , info)
      if (info == psb_success_)  &
           & call psb_move_alloc( desc%ext_index   ,    desc_out%ext_index    , info)
      if (info == psb_success_)  &
           & call psb_move_alloc( desc%lprm        ,    desc_out%lprm         , info)
      if (info == psb_success_)  &
           & call psb_move_alloc( desc%idx_space   ,    desc_out%idx_space    , info)
      if (info == psb_success_) &
           & call move_alloc(desc%indxmap, desc_out%indxmap)
      if (info == psb_success_) &
           & call desc%v_halo_index%clone(desc_out%v_halo_index,info)
      if (info == psb_success_) &
           & call desc%v_ext_index%clone(desc_out%v_ext_index,info)
      if (info == psb_success_) &
           & call desc%v_ovrlap_index%clone(desc_out%v_ovrlap_index,info)
      if (info == psb_success_) &
           & call desc%v_ovr_mst_idx%clone(desc_out%v_ovr_mst_idx,info)

      if (info /= psb_success_) then
        info = psb_err_from_subroutine_
        call psb_errpush(info,name)
        goto 9999
      endif
      if (debug_level >= psb_debug_ext_) &
           & write(debug_unit,*) me,' ',trim(name),': end'
    else
      call desc_out%free(info)
    end if
    call desc%free(info)

    call psb_erractionrestore(err_act)
    return
    

9999 call psb_error_handler(err_act)

    return

  end subroutine psb_cdtransfer
  !
  ! Subroutine: psb_cd_clone
  !   Copies data and allocation from in to out.
  !
  ! 
  ! Arguments: 
  !    desc  - type(psb_desc_type).         The communication descriptor to be 
  !                                               transferred.
  !    desc_out - type(psb_desc_type).         The output communication descriptor.
  !    info     - integer.                       Return code.
  subroutine psb_cd_clone(desc, desc_out, info)

    use psb_error_mod
    use psb_penv_mod
    use psb_realloc_mod
    implicit none
    !....parameters...

    class(psb_desc_type), intent(inout), target :: desc
    class(psb_desc_type), intent(inout)         :: desc_out
    integer(psb_ipk_), intent(out)              :: info
    !locals
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_)   :: np, me, err_act
    integer(psb_ipk_)   :: debug_level, debug_unit
    character(len=20)   :: name

    debug_unit  = psb_get_debug_unit()
    debug_level = psb_get_debug_level()

    if (psb_get_errstatus() /= 0) return 
    info = psb_success_
    call psb_erractionsave(err_act)
    name = 'psb_cdcpy'

    call desc_out%free(info)
    if ((info == psb_success_).and.desc%is_valid()) then 
      ctxt = desc%get_ctxt()

      ! check on blacs grid 
      call psb_info(ctxt, me, np)
      if (debug_level >= psb_debug_ext_) &
           & write(debug_unit,*) me,' ',trim(name),': Entered'
      if (np == -1) then
        info = psb_err_context_error_
        call psb_errpush(info,name)
        goto 9999
      endif

      desc_out%base_desc  => desc%base_desc
      if (info == psb_success_)&
           & call psb_safe_ab_cpy(desc%halo_index,desc_out%halo_index,info)
      if (info == psb_success_)&
           & call psb_safe_ab_cpy(desc%ext_index,desc_out%ext_index,info)
      if (info == psb_success_)&
           & call psb_safe_ab_cpy(desc%ovrlap_index,&
           & desc_out%ovrlap_index,info)
      if (info == psb_success_)&
           & call psb_safe_ab_cpy(desc%bnd_elem,desc_out%bnd_elem,info)
      if (info == psb_success_)&
           & call psb_safe_ab_cpy(desc%ovrlap_elem,desc_out%ovrlap_elem,info)
      if (info == psb_success_)&
           & call psb_safe_ab_cpy(desc%ovr_mst_idx,desc_out%ovr_mst_idx,info)
      if (info == psb_success_)&
           & call psb_safe_ab_cpy(desc%lprm,desc_out%lprm,info)
      if (info == psb_success_)&
           & call psb_safe_ab_cpy(desc%idx_space,desc_out%idx_space,info)
      if ((info == psb_success_).and.(allocated(desc%indxmap))) &
           & call desc%indxmap%clone(desc_out%indxmap,info)
      if (info == psb_success_) &
           & call desc%v_halo_index%clone(desc_out%v_halo_index,info)
      if (info == psb_success_) &
           & call desc%v_ext_index%clone(desc_out%v_ext_index,info)
      if (info == psb_success_) &
           & call desc%v_ovrlap_index%clone(desc_out%v_ovrlap_index,info)
      if (info == psb_success_) &
           & call desc%v_ovr_mst_idx%clone(desc_out%v_ovr_mst_idx,info)

    end if
    if (info /= psb_success_) then
      info = psb_err_from_subroutine_
      call psb_errpush(info,name)
      goto 9999
    endif
    if (debug_level >= psb_debug_ext_) &
         & write(debug_unit,*) me,' ',trim(name),': Done'

    call psb_erractionrestore(err_act)
    return

9999 call psb_error_handler(ctxt,err_act)

    return

  end subroutine psb_cd_clone

  
  Subroutine psb_cd_get_recv_idx(tmp,desc,data,info)
    use psb_error_mod
    use psb_penv_mod
    use psb_realloc_mod
    Implicit None
    integer(psb_ipk_), allocatable, intent(out) :: tmp(:)
    integer(psb_ipk_), intent(in)               :: data
    Type(psb_desc_type), Intent(in), target     :: desc
    integer(psb_ipk_), intent(out)              :: info

    !     .. Local Scalars ..
    type(psb_ctxt_type) ::  ctxt
    integer(psb_ipk_)   ::  incnt, outcnt, j, np, me, l_tmp,&
         & idx, proc, n_elem_send, n_elem_recv
    integer(psb_ipk_), pointer   :: idxlist(:)
    integer(psb_ipk_) :: debug_level, debug_unit, err_act
    character(len=20)    :: name

    name  = 'psb_cd_get_recv_idx'
    info  = psb_success_
    call psb_erractionsave(err_act)
    debug_unit  = psb_get_debug_unit()
    debug_level = psb_get_debug_level()

    ctxt = desc%get_context()
    call psb_info(ctxt, me, np)

    select case(data)
    case(psb_comm_halo_)
      idxlist => desc%halo_index
    case(psb_comm_ovr_)
      idxlist => desc%ovrlap_index
    case(psb_comm_ext_)
      idxlist => desc%ext_index
    case(psb_comm_mov_)
      idxlist => desc%ovr_mst_idx
      write(psb_err_unit,*) 'Warning: unusual request getidx on ovr_mst_idx'
    case default
      info=psb_err_from_subroutine_
      call psb_errpush(info,name,a_err='wrong Data selector')
      goto 9999
    end select

    l_tmp = 3*size(idxlist)

    allocate(tmp(l_tmp),stat=info)
    if (info /= psb_success_) then 
      info = psb_err_from_subroutine_
      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
      goto 9999      
    end if

    incnt  = 1
    outcnt = 1
    tmp(:) = -1
    Do While (idxlist(incnt) /= -1)
      proc        = idxlist(incnt+psb_proc_id_)
      n_elem_recv = idxlist(incnt+psb_n_elem_recv_)
      n_elem_send = idxlist(incnt+n_elem_recv+psb_n_elem_send_)

      Do j=0,n_elem_recv-1
        idx = idxlist(incnt+psb_elem_recv_+j)
        call psb_ensure_size((outcnt+3),tmp,info,pad=-1_psb_ipk_)
        if (info /= psb_success_) then
          info=psb_err_from_subroutine_
          call psb_errpush(info,name,a_err='psb_ensure_size')
          goto 9999
        end if
        tmp(outcnt)   = proc
        tmp(outcnt+1) = 1
        tmp(outcnt+2) = idx
        tmp(outcnt+3) = -1
        outcnt          = outcnt+3
      end Do
      incnt = incnt+n_elem_recv+n_elem_send+3
    end Do

    call psb_erractionrestore(err_act)
    return

9999 call psb_error_handler(ctxt,err_act)

    return

  end Subroutine psb_cd_get_recv_idx
  
  Subroutine psb_cd_get_recv_idx_glob(tmp,desc,data,info)

    use psb_error_mod
    use psb_penv_mod
    use psb_realloc_mod
    Implicit None
    integer(psb_lpk_), allocatable, intent(out) :: tmp(:)
    integer(psb_ipk_), intent(in)               :: data
    type(psb_desc_type), Intent(in), target     :: desc
    integer(psb_ipk_), intent(out)              :: info

    !     .. Local Scalars ..
    type(psb_ctxt_type) :: ctxt
    integer(psb_ipk_)   ::  incnt, outcnt, j, np, me, l_tmp,&
         & idx, proc, n_elem_send, n_elem_recv
    integer(psb_ipk_), pointer   :: idxlist(:)
    integer(psb_lpk_) :: gidx
    integer(psb_ipk_) :: debug_level, debug_unit, err_act
    character(len=20) :: name

    name  = 'psb_cd_get_recv_idx'
    info  = psb_success_
    call psb_erractionsave(err_act)
    debug_unit  = psb_get_debug_unit()
    debug_level = psb_get_debug_level()

    ctxt = desc%get_context()
    call psb_info(ctxt, me, np)

    select case(data)
    case(psb_comm_halo_)
      idxlist => desc%halo_index
    case(psb_comm_ovr_)
      idxlist => desc%ovrlap_index
    case(psb_comm_ext_)
      idxlist => desc%ext_index
    case(psb_comm_mov_)
      idxlist => desc%ovr_mst_idx
      write(psb_err_unit,*) 'Warning: unusual request getidx on ovr_mst_idx'
    case default
      info=psb_err_from_subroutine_
      call psb_errpush(info,name,a_err='wrong Data selector')
      goto 9999
    end select

    l_tmp = 3*size(idxlist)

    allocate(tmp(l_tmp),stat=info)
    if (info /= psb_success_) then 
      info = psb_err_from_subroutine_
      call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
      goto 9999      
    end if

    incnt  = 1
    outcnt = 1
    tmp(:) = -1
    Do While (idxlist(incnt) /= -1)
      proc        = idxlist(incnt+psb_proc_id_)
      n_elem_recv = idxlist(incnt+psb_n_elem_recv_)
      n_elem_send = idxlist(incnt+n_elem_recv+psb_n_elem_send_)

      Do j=0,n_elem_recv-1
        idx = idxlist(incnt+psb_elem_recv_+j)
        call psb_ensure_size((outcnt+3),tmp,info,pad=-1_psb_lpk_)
        if (info /= psb_success_) then
          info=psb_err_from_subroutine_
          call psb_errpush(info,name,a_err='psb_ensure_size')
          goto 9999
        end if
        call desc%indxmap%l2g(idx,gidx,info)
        If (gidx < 0) then 
          info=-3
          call psb_errpush(info,name)
          goto 9999
        endif
        tmp(outcnt)   = proc
        tmp(outcnt+1) = 1
        tmp(outcnt+2) = gidx
        tmp(outcnt+3) = -1

        outcnt          = outcnt+3
      end Do
      incnt = incnt+n_elem_recv+n_elem_send+3
    end Do

    call psb_erractionrestore(err_act)
    return

9999 call psb_error_handler(ctxt,err_act)

    return

  end Subroutine psb_cd_get_recv_idx_glob

  subroutine psb_cd_cnv(desc, mold)
    class(psb_desc_type), intent(inout), target :: desc
    class(psb_i_base_vect_type), intent(in)     :: mold
    
    call desc%v_halo_index%cnv(mold)
    call desc%v_ext_index%cnv(mold)
    call desc%v_ovrlap_index%cnv(mold)
    call desc%v_ovr_mst_idx%cnv(mold)

  end subroutine psb_cd_cnv


  subroutine cd_l2gs1(idx,desc,info,mask,owned)
    use psb_error_mod 
    implicit none 
    class(psb_desc_type), intent(in) :: desc
    integer(psb_lpk_), 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='cd_l2g'

    info  = psb_success_
    call psb_erractionsave(err_act)

    if (allocated(desc%indxmap)) then 
      call desc%indxmap%l2gip(idx,info,mask=mask,owned=owned)
    else
      info = psb_err_invalid_cd_state_
    end if
    if (info /= psb_success_) then 
      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 cd_l2gs1

  subroutine cd_l2gs2(idxin,idxout,desc,info,mask,owned)
    use psb_error_mod
    implicit none 
    class(psb_desc_type), intent(in) :: desc
    integer(psb_ipk_), intent(in)    :: idxin
    integer(psb_lpk_), 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='cd_l2g'
    logical, parameter :: debug=.false.

    info  = psb_success_
    call psb_erractionsave(err_act)

    if (allocated(desc%indxmap)) then 
      call desc%indxmap%l2g(idxin,idxout,info,mask=mask,owned=owned)
    else
      info = psb_err_invalid_cd_state_
    end if
    if (info /= psb_success_) then 
      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 cd_l2gs2


  subroutine cd_l2gv1(idx,desc,info,mask,owned)
    use psb_error_mod
    implicit none 
    class(psb_desc_type), intent(in) :: desc
    integer(psb_lpk_), 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='cd_l2g'
    logical, parameter :: debug=.false.

    info  = psb_success_
    call psb_erractionsave(err_act)

    if (allocated(desc%indxmap)) then 
      call desc%indxmap%l2gip(idx,info,mask=mask,owned=owned)
    else
      info = psb_err_invalid_cd_state_
    end if
    if (info /= psb_success_) then 
      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 cd_l2gv1

  subroutine cd_l2gv2(idxin,idxout,desc,info,mask,owned)
    use psb_error_mod
    implicit none 
    class(psb_desc_type), intent(in) :: desc
    integer(psb_ipk_), intent(in)    :: idxin(:)
    integer(psb_lpk_), 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='cd_l2g'
    logical, parameter :: debug=.false.

    info  = psb_success_
    call psb_erractionsave(err_act)

    if (allocated(desc%indxmap)) then 
      call desc%indxmap%l2g(idxin,idxout,info,mask=mask,owned=owned)
    else
      info = psb_err_invalid_cd_state_
    end if
    if (info /= psb_success_) then 
      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 cd_l2gv2


  subroutine cd_g2ls1(idx,desc,info,mask,owned)
    use psb_error_mod
    implicit none 
    class(psb_desc_type), intent(in) :: desc
    integer(psb_lpk_), 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='cd_g2l'
    logical, parameter :: debug=.false.

    info  = psb_success_
    call psb_erractionsave(err_act)

    if (allocated(desc%indxmap)) then 
      call desc%indxmap%g2lip(idx,info,mask=mask,owned=owned)
    else
      info = psb_err_invalid_cd_state_
    end if
    if (info /= psb_success_) then 
      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 cd_g2ls1

  subroutine cd_g2ls2(idxin,idxout,desc,info,mask,owned)
    use psb_error_mod
    implicit none 
    class(psb_desc_type), intent(in) :: desc
    integer(psb_lpk_), 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='cd_g2l'
    logical, parameter :: debug=.false.

    info  = psb_success_
    call psb_erractionsave(err_act)

    if (allocated(desc%indxmap)) then 
      call desc%indxmap%g2l(idxin,idxout,info,mask=mask,owned=owned)
    else
      info = psb_err_invalid_cd_state_
    end if
    if (info /= psb_success_) then 
      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 cd_g2ls2


  subroutine cd_g2lv1(idx,desc,info,mask,owned)
    use psb_error_mod
    implicit none 
    class(psb_desc_type), intent(in) :: desc
    integer(psb_lpk_), 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='cd_g2l'
    logical, parameter :: debug=.false.

    info  = psb_success_
    call psb_erractionsave(err_act)

    if (allocated(desc%indxmap)) then 
      call desc%indxmap%g2lip(idx,info,mask=mask,owned=owned)
    else
      info = psb_err_invalid_cd_state_
    end if
    if (info /= psb_success_) then 
      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 cd_g2lv1

  subroutine cd_g2lv2(idxin,idxout,desc,info,mask,owned)
    use psb_error_mod
    implicit none 
    class(psb_desc_type), intent(in) :: desc
    integer(psb_lpk_), 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='cd_g2l'
    logical, parameter :: debug=.false.


    info  = psb_success_
    call psb_erractionsave(err_act)

    if (allocated(desc%indxmap)) then 
      call desc%indxmap%g2l(idxin,idxout,info,mask=mask,owned=owned)
    else
      info = psb_err_invalid_cd_state_
    end if
    if (info /= psb_success_) then 
      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 cd_g2lv2



  subroutine cd_g2ls1_ins(idx,desc,info,mask, lidx)
    use psb_error_mod
    implicit none 
    class(psb_desc_type), intent(inout) :: desc
    integer(psb_lpk_), 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='cd_g2l_ins'
    logical, parameter :: debug=.false.

    info  = psb_success_
    call psb_erractionsave(err_act)

    if (allocated(desc%indxmap)) then 
      call desc%indxmap%g2lip_ins(idx,info,mask=mask,lidx=lidx)
    else
      info = psb_err_invalid_cd_state_
    end if
    if (info /= psb_success_) then 
      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 cd_g2ls1_ins

  subroutine cd_g2ls2_ins(idxin,idxout,desc,info,mask, lidx)
    use psb_error_mod
    implicit none 
    class(psb_desc_type), intent(inout) :: desc
    integer(psb_lpk_), 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='cd_g2l_ins'
    logical, parameter :: debug=.false.


    info  = psb_success_
    call psb_erractionsave(err_act)

    if (allocated(desc%indxmap)) then 
      call desc%indxmap%g2l_ins(idxin,idxout,info,mask=mask,lidx=lidx)
    else
      info = psb_err_invalid_cd_state_
    end if
    if (info /= psb_success_) then 
      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 cd_g2ls2_ins


  subroutine cd_g2lv1_ins(idx,desc,info,mask, lidx)
    use psb_error_mod
    implicit none 
    class(psb_desc_type), intent(inout) :: desc
    integer(psb_lpk_), 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='cd_g2l_ins'
    logical, parameter :: debug=.false.


    info  = psb_success_
    call psb_erractionsave(err_act)

    if (allocated(desc%indxmap)) then 
      call desc%indxmap%g2lip_ins(idx,info,mask=mask,lidx=lidx)
    else
      info = psb_err_invalid_cd_state_
    end if
    if (info /= psb_success_) then 
      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 cd_g2lv1_ins

  subroutine cd_g2lv2_ins(idxin,idxout,desc,info,mask,lidx)
    use psb_error_mod
    implicit none 
    class(psb_desc_type), intent(inout) :: desc
    integer(psb_lpk_), 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='cd_g2l_ins'
    logical, parameter :: debug=.false.


    info  = psb_success_
    call psb_erractionsave(err_act)

    if (allocated(desc%indxmap)) then 
      call desc%indxmap%g2l_ins(idxin,idxout,info,mask=mask,lidx=lidx)
    else
      info = psb_err_invalid_cd_state_
    end if
    if (info /= psb_success_) then 
      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 cd_g2lv2_ins


  subroutine cd_fnd_owner(idx,iprc,desc,info)
    use psb_error_mod
    implicit none 
    integer(psb_lpk_), intent(in)       :: idx(:)
    integer(psb_ipk_), allocatable, intent(out) ::  iprc(:)
    class(psb_desc_type), intent(inout) :: desc
    integer(psb_ipk_), intent(out)      :: info
    integer(psb_ipk_)  :: err_act
    character(len=20)  :: name='cd_fnd_owner'
    logical, parameter :: debug=.false.


    info  = psb_success_
    call psb_erractionsave(err_act)

    if (allocated(desc%indxmap)) then 
      call desc%indxmap%fnd_owner(idx,iprc,info)
    else
      info = psb_err_invalid_cd_state_
    end if
    if (info /= psb_success_) then 
      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 cd_fnd_owner


end module psb_desc_mod