diff --git a/base/internals/psi_bld_tmphalo.f90 b/base/internals/psi_bld_tmphalo.f90 index 1842f92e..3fa0f52f 100644 --- a/base/internals/psi_bld_tmphalo.f90 +++ b/base/internals/psi_bld_tmphalo.f90 @@ -100,8 +100,8 @@ subroutine psi_bld_tmphalo(desc,info) helem(i) = n_row+i ! desc%loc_to_glob(n_row+i) end do - call desc%indxmap%l2gip(helem(1:nh),info) - call desc%indxmap%fnd_owner(helem(1:nh),hproc,info) + call desc%l2gip(helem(1:nh),info) + call desc%fnd_owner(helem(1:nh),hproc,info) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='fnd_owner') diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index a9746e03..3c1a5c7b 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -81,7 +81,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%indxmap%get_ctxt() + ictxt = desc_a%get_ctxt() call psb_info(ictxt,me,np) if (np == -1) then @@ -107,8 +107,8 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info & write(debug_unit,*) me,' ',trim(name),': calling extract_dep_list' mode = 1 - call psi_extract_dep_list(desc_a%indxmap%get_ctxt(),& - & desc_a%indxmap%is_bld(), desc_a%indxmap%is_upd(),& + call psi_extract_dep_list(ictxt,& + & desc_a%is_bld(), desc_a%is_upd(),& & index_in, dep_list,length_dl,np,max(1,dl_lda),mode,info) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='extrct_dl') diff --git a/base/internals/psi_desc_index.F90 b/base/internals/psi_desc_index.F90 index a3a91cc7..1549ccea 100644 --- a/base/internals/psi_desc_index.F90 +++ b/base/internals/psi_desc_index.F90 @@ -145,8 +145,8 @@ subroutine psi_desc_index(desc,index_in,dep_list,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc%indxmap%get_ctxt() - icomm = desc%indxmap%get_mpic() + ictxt = desc%get_context() + icomm = desc%get_mpic() call psb_info(ictxt,me,np) if (np == -1) then info = psb_err_context_error_ @@ -261,7 +261,7 @@ subroutine psi_desc_index(desc,index_in,dep_list,& end do else - call desc%indxmap%l2g(index_in(i+1:i+nerv),& + call desc%l2g(index_in(i+1:i+nerv),& & sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),& & info) @@ -310,13 +310,13 @@ subroutine psi_desc_index(desc,index_in,dep_list,& i = i + 1 nerv = sdsz(proc+1) desc_index(i) = nerv - call desc%indxmap%g2l(sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),& + call desc%g2l(sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),& & desc_index(i+1:i+nerv),info) i = i + nerv + 1 nesd = rvsz(proc+1) desc_index(i) = nesd - call desc%indxmap%g2l(rcvbuf(brvindx(proc+1)+1:brvindx(proc+1)+nesd),& + call desc%g2l(rcvbuf(brvindx(proc+1)+1:brvindx(proc+1)+nesd),& & desc_index(i+1:i+nesd),info) i = i + nesd + 1 end do diff --git a/base/internals/psi_fnd_owner.F90 b/base/internals/psi_fnd_owner.F90 index a133650e..b477e4c6 100644 --- a/base/internals/psi_fnd_owner.F90 +++ b/base/internals/psi_fnd_owner.F90 @@ -109,10 +109,10 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info) goto 9999 end if - call desc%indxmap%fnd_owner(idx(1:nv),iprc,info) + call desc%fnd_owner(idx(1:nv),iprc,info) if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='indxmap%fnd_owner') + call psb_errpush(psb_err_from_subroutine_,name,a_err='desc%fnd_owner') goto 9999 end if call psb_erractionrestore(err_act) diff --git a/base/modules/psb_desc_mod.F90 b/base/modules/psb_desc_mod.F90 index b779c324..36d0b14d 100644 --- a/base/modules/psb_desc_mod.F90 +++ b/base/modules/psb_desc_mod.F90 @@ -40,8 +40,6 @@ module psb_desc_mod use psb_desc_const_mod use psb_indx_map_mod use psb_i_vect_mod -!!$ -!!$ use psb_hash_mod implicit none @@ -227,7 +225,8 @@ module psb_desc_mod 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_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 @@ -243,6 +242,7 @@ module psb_desc_mod 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 @@ -293,7 +293,7 @@ module psb_desc_mod 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_g2ls2_ins, cd_g2lv1_ins, cd_g2lv2_ins, cd_fnd_owner integer(psb_ipk_), private, save :: cd_large_threshold=psb_default_large_threshold @@ -1566,4 +1566,44 @@ contains end subroutine cd_g2lv2_ins + + subroutine cd_fnd_owner(idx,iprc,desc,info) + use psb_error_mod + implicit none + integer(psb_ipk_), intent(in) :: idx(:) + integer(psb_ipk_), allocatable, intent(out) :: iprc(:) + class(psb_desc_type), intent(in) :: 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 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + Return + + end subroutine cd_fnd_owner + + end module psb_desc_mod diff --git a/base/modules/psb_desc_mod.f90 b/base/modules/psb_desc_mod.f90 deleted file mode 100644 index 3fa4689c..00000000 --- a/base/modules/psb_desc_mod.f90 +++ /dev/null @@ -1,1047 +0,0 @@ -!!$ -!!$ 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_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 -!!$ -!!$ use psb_hash_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 - 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(:) - - class(psb_indx_map), allocatable :: indxmap - 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_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) :: 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 - - end type psb_desc_type - - - interface - subroutine psb_cd_clone(desc, desc_out, info) - import psb_desc_type, psb_ipk_ - class(psb_desc_type), intent(inout), target :: desc - class(psb_desc_type), intent(inout) :: desc_out - integer(psb_ipk_), intent(out) :: info - end subroutine psb_cd_clone - end interface - - 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 - - - private :: nullify_desc - - integer(psb_ipk_), private, save :: cd_large_threshold=psb_default_large_threshold - - -contains - - function psb_cd_sizeof(desc) result(val) - implicit none - !....Parameters... - - class(psb_desc_type), intent(in) :: desc - integer(psb_long_int_k_) :: val - - val = 0 - if (allocated(desc%halo_index)) val = val + psb_sizeof_int*size(desc%halo_index) - if (allocated(desc%ext_index)) val = val + psb_sizeof_int*size(desc%ext_index) - if (allocated(desc%bnd_elem)) val = val + psb_sizeof_int*size(desc%bnd_elem) - if (allocated(desc%ovrlap_index)) val = val + psb_sizeof_int*size(desc%ovrlap_index) - if (allocated(desc%ovrlap_elem)) val = val + psb_sizeof_int*size(desc%ovrlap_elem) - if (allocated(desc%ovr_mst_idx)) val = val + psb_sizeof_int*size(desc%ovr_mst_idx) - if (allocated(desc%lprm)) val = val + psb_sizeof_int*size(desc%lprm) - if (allocated(desc%idx_space)) val = val + psb_sizeof_int*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_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_cd_set_large_threshold - - function psb_cd_get_large_threshold() result(val) - implicit none - integer(psb_ipk_) :: val - val = cd_large_threshold - end function psb_cd_get_large_threshold - - logical function psb_cd_choose_large_state(ictxt,m) - use psb_penv_mod - - implicit none - integer(psb_ipk_), intent(in) :: ictxt,m - !locals - integer(psb_ipk_) :: np,me - - call psb_info(ictxt, 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 process. - ! - psb_cd_choose_large_state = & - & (m > psb_cd_get_large_threshold()) .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 (psb_is_ok_desc(desc)) 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 (psb_is_ok_desc(desc)) 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_ipk_) :: val - class(psb_desc_type), intent(in) :: desc - - if (psb_is_ok_desc(desc)) 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_ipk_) :: val - class(psb_desc_type), intent(in) :: desc - - if (psb_is_ok_desc(desc)) then - val = desc%indxmap%get_gc() - else - val = -1 - endif - - end function psb_cd_get_global_cols - - function psb_cd_get_context(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_ctxt() - else - val = -1 - 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 - - - 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 - integer(psb_ipk_) :: np,me,ictxt,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() - - ictxt = psb_cd_get_context(desc) - - call psb_info(ictxt, 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 continue - call psb_erractionrestore(err_act) - - if (err_act == psb_act_ret_) then - return - else - call psb_error(ictxt) - end if - 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 - integer(psb_ipk_) :: np,me,ictxt,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() - - ictxt = psb_cd_get_context(desc) - - call psb_info(ictxt, 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 continue - call psb_erractionrestore(err_act) - - if (err_act == psb_act_ret_) then - return - else - call psb_error(ictxt) - end if - 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.... - integer(psb_ipk_) :: ictxt,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 continue - call psb_erractionrestore(err_act) - - if (err_act == psb_act_ret_) then - return - else - if (ictxt == -1) then - call psb_error() - else - call psb_error(ictxt) - end if - end if - 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%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_in - 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_in, 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_in - type(psb_desc_type), intent(inout) :: desc_out - integer(psb_ipk_), intent(out) :: info - - !locals - integer(psb_ipk_) :: np,me,ictxt, 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_in is empty. - ! - if (desc_in%is_valid()) then - ictxt = psb_cd_get_context(desc_in) - call psb_info(ictxt,me,np) - - if (info == psb_success_) & - & call psb_move_alloc( desc_in%halo_index , desc_out%halo_index , info) - if (info == psb_success_) & - & call psb_move_alloc( desc_in%bnd_elem , desc_out%bnd_elem , info) - if (info == psb_success_) & - & call psb_move_alloc( desc_in%ovrlap_elem , desc_out%ovrlap_elem , info) - if (info == psb_success_) & - & call psb_move_alloc( desc_in%ovrlap_index, desc_out%ovrlap_index , info) - if (info == psb_success_) & - & call psb_move_alloc( desc_in%ovr_mst_idx , desc_out%ovr_mst_idx , info) - if (info == psb_success_) & - & call psb_move_alloc( desc_in%ext_index , desc_out%ext_index , info) - if (info == psb_success_) & - & call psb_move_alloc( desc_in%lprm , desc_out%lprm , info) - if (info == psb_success_) & - & call psb_move_alloc( desc_in%idx_space , desc_out%idx_space , info) - if (info == psb_success_) & - & call move_alloc(desc_in%indxmap, desc_out%indxmap) - if (info == psb_success_) & - & call desc_in%v_halo_index%clone(desc_out%v_halo_index,info) - if (info == psb_success_) & - & call desc_in%v_ext_index%clone(desc_out%v_ext_index,info) - if (info == psb_success_) & - & call desc_in%v_ovrlap_index%clone(desc_out%v_ovrlap_index,info) - if (info == psb_success_) & - & call desc_in%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_in%free(info) - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - - if (err_act == psb_act_ret_) then - return - else - call psb_error() - end if - return - - end subroutine psb_cdtransfer - - Subroutine psb_cd_get_recv_idx(tmp,desc,data,info,toglob) - - 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 - logical, intent(in) :: toglob - - ! .. Local Scalars .. - integer(psb_ipk_) :: incnt, outcnt, j, np, me, ictxt, l_tmp,& - & idx, gidx, 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() - - ictxt = psb_cd_get_context(desc) - call psb_info(ictxt, 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=-ione) - if (info /= psb_success_) then - info=psb_err_from_subroutine_ - call psb_errpush(info,name,a_err='psb_ensure_size') - goto 9999 - end if - if (toglob) then - 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 - else - tmp(outcnt) = proc - tmp(outcnt+1) = 1 - tmp(outcnt+2) = idx - tmp(outcnt+3) = -1 - end if - outcnt = outcnt+3 - end Do - incnt = incnt+n_elem_recv+n_elem_send+3 - end Do - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error(ictxt) - return - end if - Return - - end Subroutine psb_cd_get_recv_idx - - - 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 - - -end module psb_desc_mod diff --git a/base/tools/psb_ccdbldext.F90 b/base/tools/psb_ccdbldext.F90 index 844c8163..2b01b9be 100644 --- a/base/tools/psb_ccdbldext.F90 +++ b/base/tools/psb_ccdbldext.F90 @@ -259,7 +259,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) Do j=0,n_elem_recv-1 idx = ovrlap(counter+psb_elem_recv_+j) - call desc_ov%indxmap%l2g(idx,gidx,info) + call desc_ov%l2g(idx,gidx,info) If (gidx < 0) then info=-3 call psb_errpush(info,name) @@ -360,7 +360,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) end If idx = halo(counter+psb_elem_recv_+j) - call desc_ov%indxmap%l2g(idx,gidx,info) + call desc_ov%l2g(idx,gidx,info) If (gidx < 0) then info=-3 call psb_errpush(info,name) @@ -404,7 +404,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) Do j=0,n_elem_send-1 idx = halo(counter+psb_elem_send_+j) - call desc_ov%indxmap%l2g(idx,gidx,info) + call desc_ov%l2g(idx,gidx,info) If (gidx < 0) then info=-3 call psb_errpush(info,name) @@ -440,7 +440,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) call psb_errpush(info,name,a_err='psb_ensure_size') goto 9999 end if - call desc_ov%indxmap%l2g(icol(1:n_elem),& + call desc_ov%l2g(icol(1:n_elem),& & works(idxs+tot_elem+1:idxs+tot_elem+n_elem),& & info) @@ -529,7 +529,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) & write(debug_unit,*) me,' ',trim(name),& & ': going for first idx_cnv', desc_ov%indxmap%get_state() - call desc_ov%indxmap%g2l(workr(1:iszr),maskr(1:iszr),info) + call desc_ov%g2l(workr(1:iszr),maskr(1:iszr),info) iszs = count(maskr(1:iszr)<=0) if (iszs > size(works)) call psb_realloc(iszs,works,info) j = 0 @@ -549,7 +549,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & ': going for fnd_owner', desc_ov%indxmap%get_state() - call desc_a%indxmap%fnd_owner(works(1:iszs),temp,info) + call desc_a%fnd_owner(works(1:iszs),temp,info) n_col = desc_ov%get_local_cols() if (debug_level >= psb_debug_outer_) & @@ -559,7 +559,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) do i=1,iszs idx = works(i) n_col = desc_ov%get_local_cols() - call desc_ov%indxmap%g2l_ins(idx,lidx,info) + call desc_ov%g2l_ins(idx,lidx,info) if (desc_ov%get_local_cols() > n_col ) then ! ! This is a new index. Assigning a local index as diff --git a/base/tools/psb_cins.f90 b/base/tools/psb_cins.f90 index 651dae00..7fad014f 100644 --- a/base/tools/psb_cins.f90 +++ b/base/tools/psb_cins.f90 @@ -134,7 +134,7 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_) case(psb_dupl_ovwrt_) @@ -280,7 +280,7 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if call x%ins(m,irl,val,dupl_,info) if (info /= 0) then @@ -400,7 +400,7 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if do i=1,n @@ -569,7 +569,7 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_) diff --git a/base/tools/psb_cspins.f90 b/base/tools/psb_cspins.f90 index f936aa0e..17ad9ff6 100644 --- a/base/tools/psb_cspins.f90 +++ b/base/tools/psb_cspins.f90 @@ -128,8 +128,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) goto 9999 end if - call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) - call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0)) + call desc_a%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) + call desc_a%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0)) if (info /= psb_success_) then ierr(1) = info @@ -174,8 +174,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) goto 9999 end if - call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info) - call desc_a%indxmap%g2l(ja(1:nz),jla(1:nz),info) + call desc_a%g2l(ia(1:nz),ila(1:nz),info) + call desc_a%g2l(ja(1:nz),jla(1:nz),info) call a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info) if (info /= psb_success_) then @@ -277,8 +277,8 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) goto 9999 end if - call desc_ar%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) - call desc_ac%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0)) + call desc_ar%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) + call desc_ac%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0)) if (psb_errstatus_fatal()) then ierr(1) = info diff --git a/base/tools/psb_dcdbldext.F90 b/base/tools/psb_dcdbldext.F90 index 47c063c7..12b33ed8 100644 --- a/base/tools/psb_dcdbldext.F90 +++ b/base/tools/psb_dcdbldext.F90 @@ -259,7 +259,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) Do j=0,n_elem_recv-1 idx = ovrlap(counter+psb_elem_recv_+j) - call desc_ov%indxmap%l2g(idx,gidx,info) + call desc_ov%l2g(idx,gidx,info) If (gidx < 0) then info=-3 call psb_errpush(info,name) @@ -360,7 +360,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) end If idx = halo(counter+psb_elem_recv_+j) - call desc_ov%indxmap%l2g(idx,gidx,info) + call desc_ov%l2g(idx,gidx,info) If (gidx < 0) then info=-3 call psb_errpush(info,name) @@ -404,7 +404,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) Do j=0,n_elem_send-1 idx = halo(counter+psb_elem_send_+j) - call desc_ov%indxmap%l2g(idx,gidx,info) + call desc_ov%l2g(idx,gidx,info) If (gidx < 0) then info=-3 call psb_errpush(info,name) @@ -440,7 +440,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) call psb_errpush(info,name,a_err='psb_ensure_size') goto 9999 end if - call desc_ov%indxmap%l2g(icol(1:n_elem),& + call desc_ov%l2g(icol(1:n_elem),& & works(idxs+tot_elem+1:idxs+tot_elem+n_elem),& & info) @@ -529,7 +529,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) & write(debug_unit,*) me,' ',trim(name),& & ': going for first idx_cnv', desc_ov%indxmap%get_state() - call desc_ov%indxmap%g2l(workr(1:iszr),maskr(1:iszr),info) + call desc_ov%g2l(workr(1:iszr),maskr(1:iszr),info) iszs = count(maskr(1:iszr)<=0) if (iszs > size(works)) call psb_realloc(iszs,works,info) j = 0 @@ -549,7 +549,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & ': going for fnd_owner', desc_ov%indxmap%get_state() - call desc_a%indxmap%fnd_owner(works(1:iszs),temp,info) + call desc_a%fnd_owner(works(1:iszs),temp,info) n_col = desc_ov%get_local_cols() if (debug_level >= psb_debug_outer_) & @@ -559,7 +559,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) do i=1,iszs idx = works(i) n_col = desc_ov%get_local_cols() - call desc_ov%indxmap%g2l_ins(idx,lidx,info) + call desc_ov%g2l_ins(idx,lidx,info) if (desc_ov%get_local_cols() > n_col ) then ! ! This is a new index. Assigning a local index as diff --git a/base/tools/psb_dins.f90 b/base/tools/psb_dins.f90 index 385f0575..eb2ccb9e 100644 --- a/base/tools/psb_dins.f90 +++ b/base/tools/psb_dins.f90 @@ -134,7 +134,7 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_) case(psb_dupl_ovwrt_) @@ -280,7 +280,7 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if call x%ins(m,irl,val,dupl_,info) if (info /= 0) then @@ -400,7 +400,7 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if do i=1,n @@ -569,7 +569,7 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_) diff --git a/base/tools/psb_dspins.f90 b/base/tools/psb_dspins.f90 index 56a3be17..af05d760 100644 --- a/base/tools/psb_dspins.f90 +++ b/base/tools/psb_dspins.f90 @@ -128,8 +128,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) goto 9999 end if - call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) - call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0)) + call desc_a%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) + call desc_a%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0)) if (info /= psb_success_) then ierr(1) = info @@ -174,8 +174,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) goto 9999 end if - call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info) - call desc_a%indxmap%g2l(ja(1:nz),jla(1:nz),info) + call desc_a%g2l(ia(1:nz),ila(1:nz),info) + call desc_a%g2l(ja(1:nz),jla(1:nz),info) call a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info) if (info /= psb_success_) then @@ -277,8 +277,8 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) goto 9999 end if - call desc_ar%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) - call desc_ac%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0)) + call desc_ar%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) + call desc_ac%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0)) if (psb_errstatus_fatal()) then ierr(1) = info diff --git a/base/tools/psb_scdbldext.F90 b/base/tools/psb_scdbldext.F90 index b92a7354..cfec406b 100644 --- a/base/tools/psb_scdbldext.F90 +++ b/base/tools/psb_scdbldext.F90 @@ -259,7 +259,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) Do j=0,n_elem_recv-1 idx = ovrlap(counter+psb_elem_recv_+j) - call desc_ov%indxmap%l2g(idx,gidx,info) + call desc_ov%l2g(idx,gidx,info) If (gidx < 0) then info=-3 call psb_errpush(info,name) @@ -360,7 +360,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) end If idx = halo(counter+psb_elem_recv_+j) - call desc_ov%indxmap%l2g(idx,gidx,info) + call desc_ov%l2g(idx,gidx,info) If (gidx < 0) then info=-3 call psb_errpush(info,name) @@ -404,7 +404,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) Do j=0,n_elem_send-1 idx = halo(counter+psb_elem_send_+j) - call desc_ov%indxmap%l2g(idx,gidx,info) + call desc_ov%l2g(idx,gidx,info) If (gidx < 0) then info=-3 call psb_errpush(info,name) @@ -440,7 +440,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) call psb_errpush(info,name,a_err='psb_ensure_size') goto 9999 end if - call desc_ov%indxmap%l2g(icol(1:n_elem),& + call desc_ov%l2g(icol(1:n_elem),& & works(idxs+tot_elem+1:idxs+tot_elem+n_elem),& & info) @@ -529,7 +529,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) & write(debug_unit,*) me,' ',trim(name),& & ': going for first idx_cnv', desc_ov%indxmap%get_state() - call desc_ov%indxmap%g2l(workr(1:iszr),maskr(1:iszr),info) + call desc_ov%g2l(workr(1:iszr),maskr(1:iszr),info) iszs = count(maskr(1:iszr)<=0) if (iszs > size(works)) call psb_realloc(iszs,works,info) j = 0 @@ -549,7 +549,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & ': going for fnd_owner', desc_ov%indxmap%get_state() - call desc_a%indxmap%fnd_owner(works(1:iszs),temp,info) + call desc_a%fnd_owner(works(1:iszs),temp,info) n_col = desc_ov%get_local_cols() if (debug_level >= psb_debug_outer_) & @@ -559,7 +559,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) do i=1,iszs idx = works(i) n_col = desc_ov%get_local_cols() - call desc_ov%indxmap%g2l_ins(idx,lidx,info) + call desc_ov%g2l_ins(idx,lidx,info) if (desc_ov%get_local_cols() > n_col ) then ! ! This is a new index. Assigning a local index as diff --git a/base/tools/psb_sins.f90 b/base/tools/psb_sins.f90 index 6023b626..9fc964da 100644 --- a/base/tools/psb_sins.f90 +++ b/base/tools/psb_sins.f90 @@ -134,7 +134,7 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_) case(psb_dupl_ovwrt_) @@ -280,7 +280,7 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if call x%ins(m,irl,val,dupl_,info) if (info /= 0) then @@ -400,7 +400,7 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if do i=1,n @@ -569,7 +569,7 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_) diff --git a/base/tools/psb_sspins.f90 b/base/tools/psb_sspins.f90 index b3110bbe..a93eea52 100644 --- a/base/tools/psb_sspins.f90 +++ b/base/tools/psb_sspins.f90 @@ -128,8 +128,8 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) goto 9999 end if - call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) - call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0)) + call desc_a%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) + call desc_a%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0)) if (info /= psb_success_) then ierr(1) = info @@ -174,8 +174,8 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) goto 9999 end if - call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info) - call desc_a%indxmap%g2l(ja(1:nz),jla(1:nz),info) + call desc_a%g2l(ia(1:nz),ila(1:nz),info) + call desc_a%g2l(ja(1:nz),jla(1:nz),info) call a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info) if (info /= psb_success_) then @@ -277,8 +277,8 @@ subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) goto 9999 end if - call desc_ar%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) - call desc_ac%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0)) + call desc_ar%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) + call desc_ac%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0)) if (psb_errstatus_fatal()) then ierr(1) = info diff --git a/base/tools/psb_zcdbldext.F90 b/base/tools/psb_zcdbldext.F90 index 8fb88fa6..0b5a21a2 100644 --- a/base/tools/psb_zcdbldext.F90 +++ b/base/tools/psb_zcdbldext.F90 @@ -259,7 +259,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) Do j=0,n_elem_recv-1 idx = ovrlap(counter+psb_elem_recv_+j) - call desc_ov%indxmap%l2g(idx,gidx,info) + call desc_ov%l2g(idx,gidx,info) If (gidx < 0) then info=-3 call psb_errpush(info,name) @@ -360,7 +360,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) end If idx = halo(counter+psb_elem_recv_+j) - call desc_ov%indxmap%l2g(idx,gidx,info) + call desc_ov%l2g(idx,gidx,info) If (gidx < 0) then info=-3 call psb_errpush(info,name) @@ -404,7 +404,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) Do j=0,n_elem_send-1 idx = halo(counter+psb_elem_send_+j) - call desc_ov%indxmap%l2g(idx,gidx,info) + call desc_ov%l2g(idx,gidx,info) If (gidx < 0) then info=-3 call psb_errpush(info,name) @@ -440,7 +440,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) call psb_errpush(info,name,a_err='psb_ensure_size') goto 9999 end if - call desc_ov%indxmap%l2g(icol(1:n_elem),& + call desc_ov%l2g(icol(1:n_elem),& & works(idxs+tot_elem+1:idxs+tot_elem+n_elem),& & info) @@ -529,7 +529,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) & write(debug_unit,*) me,' ',trim(name),& & ': going for first idx_cnv', desc_ov%indxmap%get_state() - call desc_ov%indxmap%g2l(workr(1:iszr),maskr(1:iszr),info) + call desc_ov%g2l(workr(1:iszr),maskr(1:iszr),info) iszs = count(maskr(1:iszr)<=0) if (iszs > size(works)) call psb_realloc(iszs,works,info) j = 0 @@ -549,7 +549,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),& & ': going for fnd_owner', desc_ov%indxmap%get_state() - call desc_a%indxmap%fnd_owner(works(1:iszs),temp,info) + call desc_a%fnd_owner(works(1:iszs),temp,info) n_col = desc_ov%get_local_cols() if (debug_level >= psb_debug_outer_) & @@ -559,7 +559,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) do i=1,iszs idx = works(i) n_col = desc_ov%get_local_cols() - call desc_ov%indxmap%g2l_ins(idx,lidx,info) + call desc_ov%g2l_ins(idx,lidx,info) if (desc_ov%get_local_cols() > n_col ) then ! ! This is a new index. Assigning a local index as diff --git a/base/tools/psb_zins.f90 b/base/tools/psb_zins.f90 index 6ded6f52..4a3426cc 100644 --- a/base/tools/psb_zins.f90 +++ b/base/tools/psb_zins.f90 @@ -134,7 +134,7 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_) case(psb_dupl_ovwrt_) @@ -280,7 +280,7 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if call x%ins(m,irl,val,dupl_,info) if (info /= 0) then @@ -400,7 +400,7 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if do i=1,n @@ -569,7 +569,7 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl,local) if (local_) then irl(1:m) = irw(1:m) else - call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.) + call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.) end if select case(dupl_) diff --git a/base/tools/psb_zspins.f90 b/base/tools/psb_zspins.f90 index 5deb87ba..d514059d 100644 --- a/base/tools/psb_zspins.f90 +++ b/base/tools/psb_zspins.f90 @@ -128,8 +128,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) goto 9999 end if - call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) - call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0)) + call desc_a%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) + call desc_a%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0)) if (info /= psb_success_) then ierr(1) = info @@ -174,8 +174,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) goto 9999 end if - call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info) - call desc_a%indxmap%g2l(ja(1:nz),jla(1:nz),info) + call desc_a%g2l(ia(1:nz),ila(1:nz),info) + call desc_a%g2l(ja(1:nz),jla(1:nz),info) call a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info) if (info /= psb_success_) then @@ -277,8 +277,8 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) goto 9999 end if - call desc_ar%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) - call desc_ac%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0)) + call desc_ar%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) + call desc_ac%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0)) if (psb_errstatus_fatal()) then ierr(1) = info diff --git a/test/fileread/cf_sample.f90 b/test/fileread/cf_sample.f90 index c3f81611..a4a45d04 100644 --- a/test/fileread/cf_sample.f90 +++ b/test/fileread/cf_sample.f90 @@ -283,7 +283,7 @@ program cf_sample write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize write(psb_out_unit,'("Storage type for DESC_A : ",a)')& - & desc_a%indxmap%get_fmt() + & desc_a%get_fmt() end if call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) diff --git a/test/fileread/df_sample.f90 b/test/fileread/df_sample.f90 index c4062374..f1fee276 100644 --- a/test/fileread/df_sample.f90 +++ b/test/fileread/df_sample.f90 @@ -289,7 +289,7 @@ program df_sample write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize write(psb_out_unit,'("Storage type for DESC_A : ",a)')& - & desc_a%indxmap%get_fmt() + & desc_a%get_fmt() end if !!$ call psb_precdump(prec,info,prefix=trim(mtrx_file)//'_') diff --git a/test/fileread/sf_sample.f90 b/test/fileread/sf_sample.f90 index c6f64b16..7b200d97 100644 --- a/test/fileread/sf_sample.f90 +++ b/test/fileread/sf_sample.f90 @@ -286,7 +286,7 @@ program sf_sample write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize write(psb_out_unit,'("Storage type for DESC_A : ",a)')& - & desc_a%indxmap%get_fmt() + & desc_a%get_fmt() end if !!$ call psb_precdump(prec,info,prefix=trim(mtrx_file)//'_') diff --git a/test/fileread/zf_sample.f90 b/test/fileread/zf_sample.f90 index 71bf3c4e..c87928de 100644 --- a/test/fileread/zf_sample.f90 +++ b/test/fileread/zf_sample.f90 @@ -283,7 +283,7 @@ program zf_sample write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize write(psb_out_unit,'("Storage type for DESC_A : ",a)')& - & desc_a%indxmap%get_fmt() + & desc_a%get_fmt() end if call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) diff --git a/test/kernel/d_file_spmv.f90 b/test/kernel/d_file_spmv.f90 index 21357761..3d139d3e 100644 --- a/test/kernel/d_file_spmv.f90 +++ b/test/kernel/d_file_spmv.f90 @@ -275,7 +275,7 @@ program d_file_spmv write(psb_out_unit,'("MBYTES/S : ",F20.3)') bdwdth bdwdth = times*nbytes/(tt2*1.d6) write(psb_out_unit,'("MBYTES/S (trans): ",F20.3)') bdwdth - write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt() + write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt() end if diff --git a/test/kernel/pdgenspmv.f90 b/test/kernel/pdgenspmv.f90 index b734d6af..fe9b33ce 100644 --- a/test/kernel/pdgenspmv.f90 +++ b/test/kernel/pdgenspmv.f90 @@ -169,7 +169,7 @@ program pdgenspmv write(psb_out_unit,'("MBYTES/S : ",F20.3)') bdwdth bdwdth = times*nbytes/(tt2*1.d6) write(psb_out_unit,'("MBYTES/S (trans): ",F20.3)') bdwdth - write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt() + write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt() write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize end if diff --git a/test/pargen/ppde2d.f90 b/test/pargen/ppde2d.f90 index 301e28c9..02d9031b 100644 --- a/test/pargen/ppde2d.f90 +++ b/test/pargen/ppde2d.f90 @@ -243,7 +243,7 @@ program ppde2d write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize - write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt() + write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt() end if diff --git a/test/pargen/ppde3d.f90 b/test/pargen/ppde3d.f90 index 00a7b499..7fb33f9d 100644 --- a/test/pargen/ppde3d.f90 +++ b/test/pargen/ppde3d.f90 @@ -256,7 +256,7 @@ program ppde3d write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize - write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt() + write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt() end if diff --git a/test/pargen/spde2d.f90 b/test/pargen/spde2d.f90 index 15037661..27dc18b3 100644 --- a/test/pargen/spde2d.f90 +++ b/test/pargen/spde2d.f90 @@ -242,7 +242,7 @@ program spde2d write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize - write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt() + write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt() end if diff --git a/test/pargen/spde3d.f90 b/test/pargen/spde3d.f90 index 5c5431e9..8c30a7df 100644 --- a/test/pargen/spde3d.f90 +++ b/test/pargen/spde3d.f90 @@ -256,7 +256,7 @@ program spde3d write(psb_out_unit,'("Total memory occupation for A: ",i12)')amatsize write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize - write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt() + write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt() end if