!!$ !!$ 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) :: 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 !> 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()) if (err_act /= psb_act_ret_) then call psb_error() end if 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()) if (err_act /= psb_act_ret_) then call psb_error() end if return 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()) if (err_act /= psb_act_ret_) then call psb_error() end if 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()) if (err_act /= psb_act_ret_) then call psb_error() end if 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()) if (err_act /= psb_act_ret_) then call psb_error() end if 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()) if (err_act /= psb_act_ret_) then call psb_error() end if 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()) if (err_act /= psb_act_ret_) then call psb_error() end if 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()) if (err_act /= psb_act_ret_) then call psb_error() end if 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()) if (err_act /= psb_act_ret_) then call psb_error() end if 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()) if (err_act /= psb_act_ret_) then call psb_error() end if 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()) if (err_act /= psb_act_ret_) then call psb_error() end if 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()) if (err_act /= psb_act_ret_) then call psb_error() end if 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()) if (err_act /= psb_act_ret_) then call psb_error() end if 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()) if (err_act /= psb_act_ret_) then call psb_error() end if 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()) if (err_act /= psb_act_ret_) then call psb_error() end if return end subroutine base_clone end module psb_indx_map_mod