fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-17 03:12:15 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
base/modules/psb_desc_const_mod.f90
 base/modules/psb_desc_type.f90
 base/modules/psb_gen_block_map_mod.f03
 base/modules/psb_glist_map_mod.f03
 base/modules/psb_hash_map_mod.f03
 base/modules/psb_indx_map_mod.f03
 base/modules/psb_list_map_mod.f03
 base/modules/psb_repl_map_mod.f03
 base/modules/psi_comm_buffers_mod.F90
 base/modules/psi_p2p_mod.F90
 base/modules/psi_reduce_mod.F90
 base/tools/psb_cd_set_bld.f90

Add headers for recent INDXMAP work.
This commit is contained in:
Salvatore Filippone
2010-12-16 14:55:11 +00:00
parent 44c059beba
commit 66cefd1e41
12 changed files with 1755 additions and 1135 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psb_desc_const_mod.f90
+36
View File
@@ -1,3 +1,39 @@
!!$
!!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010
!!$ 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_const_mod
! Auxiliary module for descriptor: constant values.
!
module psb_desc_const_mod
!
! Communication, prolongation & restriction
base/modules/psb_desc_type.f90
+33 -112
View File
@@ -47,17 +47,9 @@ module psb_descriptor_type
! type: psb_desc_type
!
! Communication Descriptor data structure.
!| type psb_idxmap_type
!| integer :: state
!| integer, allocatable :: loc_to_glob(:)
!| integer, allocatable :: glob_to_loc(:)
!| integer :: hashvsize, hashvmask
!| integer, allocatable :: hashv(:), glb_lc(:,:)
!| type(psb_hash_type) :: hash
!| end type psb_idxmap_type
!
!
!| type psb_desc_type
!| class(psb_indx_map), allocatable :: indxmap
!| integer, allocatable :: matrix_data(:)
!| integer, allocatable :: halo_index(:), ext_index(:)
!| integer, allocatable :: bnd_elem(:)
@@ -77,25 +69,30 @@ module psb_descriptor_type
! 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).
!
! Most general info about the descriptor is stored in the matrix_data
! component, including the STATE which can be PSB_DESC_BLD_,
! PSB_DESC_ASB_ or PSB_DESC_REPL_.
! Upon allocation with PSB_CDALL the descriptor enters the BLD state;
! then the user can specify the discretization pattern with PSB_CDINS;
! the call to PSB_CDASB puts the descriptor in the PSB_ASB_ state.
!
! PSB_DESC_REPL_ is a special value that specifies a replicated index space,
! and is only entered by the psb_cdrep call. Currently it is only
! used in the last level of some multilevel preconditioners.
!
! The LOC_TO_GLOB, GLOB_TO_LOC, GLB_LC, HASHV and HASH data structures
! inside IDXMAP implement the mapping between local and global indices,
! according to the following guidelines:
! 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%matrix_dat(psb_n_row_))
! 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).
!
@@ -109,36 +106,9 @@ module psb_descriptor_type
! form the HALO of the current process. Halo indices are assigned local indices
! from N_ROW+1 to N_COL (inclusive).
!
! 5. Regardless of the descriptor state, LOC_TO_GLOB(I), I=1:N_COL always
! contains the global index corresponding to local index I; the upper bound
! N_COL moves during the descriptor build process (see CDINS).
! 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. This
! mapping can take two forms according to the value returned by
! psb_cd_choose_large_state:
! i. If the global index space size is not too large, it is possible to store
! a complete mapping in GLOB_TO_LOC: each entry contains the corresponding
! local index (if there is one), or an encoded value identifying the process
! owning that index. This array is filled in at initialization time CDALL,
! and thus it is available throughout the insertion phase. The local storage
! will thus be N_COL + N_GLOB
! ii. If the global index space is very large (larger than the threshold value
! which may be set by the user), then it is not advisable to have such an
! array.
! In this case we only record the global indices that do have a
! local counterpart, so that the local storage will be proportional to
! N_COL.
! The idea is that glb_lc(:,1) will hold sorted global indices, and
! glb_lc(:,2) the corresponding local indices, so that we may do a binary search.
! To cut down the search time we partition glb_lc into a set of lists
! addressed by hashv(:) based on the value of the lowest
! PSB_HASH_BITS bits of the global index.
! During the build phase glb_lc() will store the indices of the internal points,
! i.e. local indices 1:NROW, since those are known ad CDALL time.
! The halo indices that we encounter during the build phase are put in
! a PSB_HASH_TYPE data structure, which implements a very simple hash; this
! hash will nonetheless be quite fast at low occupancy rates.
! At assembly time, we move everything into hashv(:) and glb_lc(:,:).
! 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:
@@ -181,10 +151,10 @@ module psb_descriptor_type
! 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; if we are in the
! LARGE case (as described above) 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 have
! the space to encode the owning process index in the GLOB_TO_LOC mapping); thus
! 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).
!
@@ -219,9 +189,8 @@ module psb_descriptor_type
! 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 (the default threshold
! assumes that you are willing to spend up to 4 MB on each process for the
! glob_to_loc mapping)
! 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.
@@ -434,59 +403,11 @@ contains
end function psb_is_asb_desc
logical function psb_is_ok_dec(dectype)
integer :: dectype
psb_is_ok_dec = ((dectype == psb_desc_asb_).or.(dectype == psb_desc_bld_).or.&
&(dectype == psb_cd_ovl_asb_).or.(dectype == psb_cd_ovl_bld_).or.&
&(dectype == psb_desc_upd_).or.&
&(dectype == psb_desc_repl_))
end function psb_is_ok_dec
logical function psb_is_bld_dec(dectype)
integer :: dectype
psb_is_bld_dec = (dectype == psb_desc_bld_).or.(dectype == psb_cd_ovl_bld_)
end function psb_is_bld_dec
logical function psb_is_upd_dec(dectype)
integer :: dectype
psb_is_upd_dec = (dectype == psb_desc_upd_)
end function psb_is_upd_dec
logical function psb_is_repl_dec(dectype)
integer :: dectype
psb_is_repl_dec = (dectype == psb_desc_repl_)
end function psb_is_repl_dec
logical function psb_is_asb_dec(dectype)
integer :: dectype
psb_is_asb_dec = (dectype == psb_desc_asb_).or.&
& (dectype == psb_desc_repl_).or.(dectype == psb_cd_ovl_asb_)
end function psb_is_asb_dec
logical function psb_is_ovl_dec(dectype)
integer :: dectype
psb_is_ovl_dec = (dectype == psb_cd_ovl_bld_).or.&
& (dectype == psb_cd_ovl_asb_)
end function psb_is_ovl_dec
integer function psb_cd_get_local_rows(desc)
type(psb_desc_type), intent(in) :: desc
if (psb_is_ok_desc(desc)) then
psb_cd_get_local_rows = desc%matrix_data(psb_n_row_)
psb_cd_get_local_rows = desc%indxmap%get_lr()
else
psb_cd_get_local_rows = -1
endif
@@ -496,7 +417,7 @@ contains
type(psb_desc_type), intent(in) :: desc
if (psb_is_ok_desc(desc)) then
psb_cd_get_local_cols = desc%matrix_data(psb_n_col_)
psb_cd_get_local_cols = desc%indxmap%get_lc()
else
psb_cd_get_local_cols = -1
endif
@@ -506,7 +427,7 @@ contains
type(psb_desc_type), intent(in) :: desc
if (psb_is_ok_desc(desc)) then
psb_cd_get_global_rows = desc%matrix_data(psb_m_)
psb_cd_get_global_rows = desc%indxmap%get_gr()
else
psb_cd_get_global_rows = -1
endif
@@ -517,7 +438,7 @@ contains
type(psb_desc_type), intent(in) :: desc
if (psb_is_ok_desc(desc)) then
psb_cd_get_global_cols = desc%matrix_data(psb_n_)
psb_cd_get_global_cols = desc%indxmap%get_gc()
else
psb_cd_get_global_cols = -1
endif
base/modules/psb_gen_block_map_mod.f03
+47
View File
@@ -1,3 +1,50 @@
!!$
!!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010
!!$ 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_gen_block_map_mod
! Defines the GEN_BLOCK_MAP type.
!
! It is the implementation of the general BLOCK distribution,
! i.e. process I gets the I-th block of consecutive indices.
! It needs to store the limits of the owned block, plus the global
! indices of the local halo.
! The choice is to store the boundaries of ALL blocks, since in general
! there will be few processes, compared to indices, so it is possible
! to answer the ownership question without resorting to data exchange
! (well, the data exchange is needed but only once at initial allocation
! time).
!
!
module psb_gen_block_map_mod
use psb_const_mod
use psb_desc_const_mod
base/modules/psb_glist_map_mod.f03
+43
View File
@@ -1,3 +1,46 @@
!!$
!!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010
!!$ 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_glist_map_mod
! Defines the GLIST_MAP type.
!
! This is almost identical to the LIST_MAP type, but it has an additional
! vector of size GLOB_ROWS giving, for each index, the owning process.
! This implies that:
! 1. We have room for such an additional vector;
! 2. There are no overlap (only one process owns a given index).
!
!
module psb_glist_map_mod
use psb_const_mod
use psb_desc_const_mod
base/modules/psb_hash_map_mod.f03
+1029 -975
View File
File diff suppressed because it is too large Load Diff
base/modules/psb_indx_map_mod.f03
+122 -47
View File
@@ -1,7 +1,82 @@
!!$
!!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010
!!$ 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.
!
! 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
! 6. Query the indx state.
! 7. 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).
!
! 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).
!
!
!
!
!
!
module psb_indx_map_mod
use psb_const_mod
use psb_desc_const_mod
type :: psb_indx_map
integer :: state = psb_desc_null_
@@ -39,7 +114,7 @@ module psb_indx_map_mod
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, pass(idxmap) :: get_fmt => base_get_fmt
procedure, pass(idxmap) :: asb => base_asb
@@ -91,84 +166,84 @@ module psb_indx_map_mod
integer, intent(out) :: info
end subroutine psb_indx_map_fnd_owner
end interface
contains
function base_get_state(idxmap) result(val)
implicit none
class(psb_indx_map), intent(in) :: idxmap
integer :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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, intent(in) :: val
idxmap%state = val
end subroutine base_set_state
@@ -176,15 +251,15 @@ contains
implicit none
class(psb_indx_map), intent(inout) :: idxmap
integer, 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, intent(in) :: val
idxmap%global_rows = val
end subroutine base_set_gr
@@ -192,7 +267,7 @@ contains
implicit none
class(psb_indx_map), intent(inout) :: idxmap
integer, intent(in) :: val
idxmap%global_cols = val
end subroutine base_set_gc
@@ -200,7 +275,7 @@ contains
implicit none
class(psb_indx_map), intent(inout) :: idxmap
integer, intent(in) :: val
idxmap%local_rows = val
end subroutine base_set_lr
@@ -208,7 +283,7 @@ contains
implicit none
class(psb_indx_map), intent(inout) :: idxmap
integer, intent(in) :: val
idxmap%local_cols = val
end subroutine base_set_lc
@@ -216,11 +291,11 @@ contains
implicit none
class(psb_indx_map), intent(inout) :: idxmap
integer, intent(in) :: val
idxmap%mpic = val
end subroutine base_set_mpic
function base_row_extendable(idxmap) result(val)
implicit none
class(psb_indx_map), intent(in) :: idxmap
@@ -234,15 +309,15 @@ contains
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
@@ -250,14 +325,14 @@ contains
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
@@ -265,7 +340,7 @@ contains
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
@@ -273,7 +348,7 @@ contains
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
@@ -281,12 +356,12 @@ contains
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
@@ -333,19 +408,19 @@ contains
Integer :: 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
@@ -360,14 +435,14 @@ contains
Integer :: 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
@@ -453,7 +528,7 @@ contains
call psb_error()
end if
return
end subroutine base_g2ls2
@@ -547,7 +622,7 @@ contains
integer, intent(out) :: idxout
integer, intent(out) :: info
logical, intent(in), optional :: mask
Integer :: err_act
character(len=20) :: name='base_g2l_ins'
logical, parameter :: debug=.false.
@@ -563,7 +638,7 @@ contains
call psb_error()
end if
return
end subroutine base_g2ls2_ins
@@ -625,7 +700,7 @@ contains
implicit none
class(psb_indx_map), intent(inout) :: idxmap
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='base_asb'
logical, parameter :: debug=.false.
@@ -641,14 +716,14 @@ contains
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
Integer :: err_act
character(len=20) :: name='base_free'
logical, parameter :: debug=.false.
@@ -712,7 +787,7 @@ contains
end if
return
end subroutine base_init_vl
end module psb_indx_map_mod
base/modules/psb_list_map_mod.f03
+41
View File
@@ -1,3 +1,44 @@
!!$
!!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010
!!$ 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_list_map_mod
! Defines the LIST_MAP type.
!
! This is essentially the original PSBLAS index map. We assume that
! 1. We have room for GLOB_TO_LOC and LOC_TO_GLOB
! 2. There could be an overlap, so we don't store explicitly who owns an index.
!
!
module psb_list_map_mod
use psb_const_mod
use psb_desc_const_mod
base/modules/psb_repl_map_mod.f03
+42
View File
@@ -1,3 +1,45 @@
!!$
!!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010
!!$ 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_repl_map_mod
! Defines the REPL_MAP type.
! This is a replicated index space. It is also used
! when NP=1. The answer to the query for the owning process
! is always the local process, after all it's supposed to be
! replicated; also, global to local index mapping is just the
! identity, only thing to be done is to check the bounds.
!
!
module psb_repl_map_mod
use psb_const_mod
use psb_desc_const_mod
base/modules/psi_comm_buffers_mod.F90
+44
View File
@@ -13,6 +13,7 @@ module mpi
integer, parameter :: mpi_double_complex = 6
integer, parameter :: mpi_character = 7
integer, parameter :: mpi_logical = 8
integer, parameter :: mpi_integer2 = 9
integer, parameter :: mpi_comm_null = -1
integer, parameter :: mpi_comm_world = 1
@@ -31,6 +32,7 @@ module psi_comm_buffers_mod
integer, private, parameter:: psb_logical_type = psb_dcomplex_type + 1
integer, private, parameter:: psb_char_type = psb_logical_type + 1
integer, private, parameter:: psb_int8_type = psb_char_type + 1
integer, private, parameter:: psb_int2_type = psb_int8_type + 1
type psb_buffer_node
@@ -39,6 +41,7 @@ module psi_comm_buffers_mod
integer :: buffer_type
integer(psb_int_k_), allocatable :: intbuf(:)
integer(psb_long_int_k_), allocatable :: int8buf(:)
integer(2), allocatable :: int2buf(:)
real(psb_spk_), allocatable :: realbuf(:)
real(psb_dpk_), allocatable :: doublebuf(:)
complex(psb_spk_), allocatable :: complexbuf(:)
@@ -64,6 +67,11 @@ module psi_comm_buffers_mod
module procedure psi_i8snd
end interface
#endif
#if defined(SHORT_INTEGERS)
interface psi_snd
module procedure psi_i2snd
end interface
#endif
contains
@@ -288,6 +296,42 @@ contains
end subroutine psi_i8snd
#endif
#if defined(SHORT_INTEGERS)
subroutine psi_i2snd(icontxt,tag,dest,buffer,mesg_queue)
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer :: icontxt, tag, dest
integer(2), allocatable, intent(inout) :: buffer(:)
type(psb_buffer_queue) :: mesg_queue
type(psb_buffer_node), pointer :: node
integer :: info
allocate(node, stat=info)
if (info /= 0) then
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
node%icontxt = icontxt
node%buffer_type = psb_int2_type
call move_alloc(buffer,node%int2buf)
if (info /= 0) then
write(psb_err_unit,*) 'Fatal memory error inside communication subsystem'
return
end if
call mpi_isend(node%int2buf,size(node%int2buf),mpi_integer2,&
& dest,tag,icontxt,node%request,info)
call psb_insert_node(mesg_queue,node)
call psb_test_nodes(mesg_queue)
end subroutine psi_i2snd
#endif
subroutine psi_ssnd(icontxt,tag,dest,buffer,mesg_queue)
#ifdef MPI_MOD
base/modules/psi_p2p_mod.F90
+188
View File
@@ -34,6 +34,15 @@ module psi_p2p_mod
end interface
#endif
#if defined(SHORT_INTEGERS)
interface psb_snd
module procedure psb_i2snds, psb_i2sndv, psb_i2sndm
end interface
interface psb_rcv
module procedure psb_i2rcvs, psb_i2rcvv, psb_i2rcvm
end interface
#endif
@@ -45,6 +54,7 @@ module psi_p2p_mod
integer, private, parameter:: psb_logical_tag = psb_dcomplex_tag + 1
integer, private, parameter:: psb_char_tag = psb_logical_tag + 1
integer, private, parameter:: psb_int8_tag = psb_char_tag + 1
integer, private, parameter:: psb_int2_tag = psb_int8_tag + 1
integer, parameter:: psb_int_swap_tag = psb_int_tag + psb_int_tag
integer, parameter:: psb_real_swap_tag = psb_real_tag + psb_int_tag
@@ -54,6 +64,7 @@ module psi_p2p_mod
integer, parameter:: psb_logical_swap_tag = psb_logical_tag + psb_int_tag
integer, parameter:: psb_char_swap_tag = psb_char_tag + psb_int_tag
integer, parameter:: psb_int8_swap_tag = psb_int8_tag + psb_int_tag
integer, parameter:: psb_int2_swap_tag = psb_int2_tag + psb_int_tag
contains
@@ -692,6 +703,95 @@ contains
#endif
end subroutine psb_i8sndm
#endif
#if defined(SHORT_INTEGERS)
subroutine psb_i2snds(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer, intent(in) :: ictxt
integer(2), intent(in) :: dat
integer, intent(in) :: dst
integer(2), allocatable :: dat_(:)
integer :: info
#if defined(SERIAL_MPI)
! do nothing
#else
allocate(dat_(1), stat=info)
dat_(1) = dat
call psi_snd(ictxt,psb_int2_tag,dst,dat_,psb_mesg_queue)
#endif
end subroutine psb_i2snds
subroutine psb_i2sndv(ictxt,dat,dst)
use psi_comm_buffers_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer, intent(in) :: ictxt
integer(2), intent(in) :: dat(:)
integer, intent(in) :: dst
integer(2), allocatable :: dat_(:)
integer :: info
#if defined(SERIAL_MPI)
#else
allocate(dat_(size(dat)), stat=info)
dat_(:) = dat(:)
call psi_snd(ictxt,psb_int2_tag,dst,dat_,psb_mesg_queue)
#endif
end subroutine psb_i2sndv
subroutine psb_i2sndm(ictxt,dat,dst,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer, intent(in) :: ictxt
integer(2), intent(in) :: dat(:,:)
integer, intent(in) :: dst
integer, intent(in), optional :: m
integer(2), allocatable :: dat_(:)
integer :: info ,i,j,k,m_,n_
#if defined(SERIAL_MPI)
#else
if (present(m)) then
m_ = m
else
m_ = size(dat,1)
end if
n_ = size(dat,2)
allocate(dat_(m_*n_), stat=info)
k=1
do j=1,n_
do i=1, m_
dat_(k) = dat(i,j)
k = k + 1
end do
end do
call psi_snd(ictxt,psb_int2_tag,dst,dat_,psb_mesg_queue)
#endif
end subroutine psb_i2sndm
#endif
! !!!!!!!!!!!!!!!!!!!!!!!!
@@ -1336,4 +1436,92 @@ contains
#endif
#if defined(SHORT_INTEGERS)
subroutine psb_i2rcvs(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer, intent(in) :: ictxt
integer(2), intent(out) :: dat
integer, intent(in) :: src
integer :: info
integer :: status(mpi_status_size)
#if defined(SERIAL_MPI)
! do nothing
#else
call mpi_recv(dat,1,mpi_integer2,src,psb_int2_tag,ictxt,status,info)
call psb_test_nodes(psb_mesg_queue)
#endif
end subroutine psb_i2rcvs
subroutine psb_i2rcvv(ictxt,dat,src)
use psi_comm_buffers_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer, intent(in) :: ictxt
integer(2), intent(out) :: dat(:)
integer, intent(in) :: src
integer :: info
integer :: status(mpi_status_size)
#if defined(SERIAL_MPI)
#else
call mpi_recv(dat,size(dat),mpi_integer2,src,psb_int2_tag,ictxt,status,info)
call psb_test_nodes(psb_mesg_queue)
#endif
end subroutine psb_i2rcvv
subroutine psb_i2rcvm(ictxt,dat,src,m)
use psi_comm_buffers_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer, intent(in) :: ictxt
integer(2), intent(out) :: dat(:,:)
integer, intent(in) :: src
integer, intent(in), optional :: m
integer :: info ,i,j,k,m_,n_, ld, mp_rcv_type
integer :: status(mpi_status_size)
#if defined(SERIAL_MPI)
! What should we do here??
#else
if (present(m)) then
m_ = m
ld = size(dat,1)
n_ = size(dat,2)
call mpi_type_vector(n_,m_,ld,mpi_integer2,mp_rcv_type,info)
if (info == mpi_success) call mpi_type_commit(mp_rcv_type,info)
if (info == mpi_success) call mpi_recv(dat,1,mp_rcv_type,src,&
& psb_int2_tag,ictxt,status,info)
if (info == mpi_success) call mpi_type_free(mp_rcv_type,info)
else
call mpi_recv(dat,size(dat),mpi_integer2,src,&
& psb_int2_tag,ictxt,status,info)
end if
if (info /= mpi_success) then
write(psb_err_unit,*) 'Error in psb_recv', info
end if
call psb_test_nodes(psb_mesg_queue)
#endif
end subroutine psb_i2rcvm
#endif
end module psi_p2p_mod
base/modules/psi_reduce_mod.F90
+129
View File
@@ -57,6 +57,11 @@ module psi_reduce_mod
& psb_dsums, psb_dsumv, psb_dsumm,&
& psb_zsums, psb_zsumv, psb_zsumm
end interface
#if defined(SHORT_INTEGERS)
interface psb_sum
module procedure psb_i2sums, psb_i2sumv, psb_i2summ
end interface psb_sum
#endif
#if !defined(LONG_INTEGERS)
interface psb_sum
module procedure psb_i8sums, psb_i8sumv, psb_i8summ
@@ -2674,6 +2679,130 @@ contains
end subroutine psb_isumm
#if defined(SHORT_INTEGERS)
subroutine psb_i2sums(ictxt,dat,root)
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer, intent(in) :: ictxt
integer(2), intent(inout) :: dat
integer, intent(in), optional :: root
integer :: root_
integer(2) :: dat_
integer :: iam, np, info
#if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np)
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
call mpi_allreduce(dat,dat_,1,mpi_integer2,mpi_sum,ictxt,info)
dat = dat_
else
call mpi_reduce(dat,dat_,1,mpi_integer2,mpi_sum,root_,ictxt,info)
dat = dat_
endif
#endif
end subroutine psb_i2sums
subroutine psb_i2sumv(ictxt,dat,root)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer, intent(in) :: ictxt
integer(2), intent(inout) :: dat(:)
integer, intent(in), optional :: root
integer :: root_
integer(2), allocatable :: dat_(:)
integer :: iam, np, info
#if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np)
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
call psb_realloc(size(dat),dat_,info)
dat_=dat
if (info == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& mpi_integer2,mpi_sum,ictxt,info)
else
if (iam == root_) then
call psb_realloc(size(dat),dat_,info)
dat_=dat
call mpi_reduce(dat_,dat,size(dat),mpi_integer2,mpi_sum,root_,ictxt,info)
else
call mpi_reduce(dat,dat_,size(dat),mpi_integer2,mpi_sum,root_,ictxt,info)
end if
endif
#endif
end subroutine psb_i2sumv
subroutine psb_i2summ(ictxt,dat,root)
use psb_realloc_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
integer, intent(in) :: ictxt
integer(2), intent(inout) :: dat(:,:)
integer, intent(in), optional :: root
integer :: root_
integer(2), allocatable :: dat_(:,:)
integer :: iam, np, info
#if !defined(SERIAL_MPI)
call psb_info(ictxt,iam,np)
if (present(root)) then
root_ = root
else
root_ = -1
endif
if (root_ == -1) then
call psb_realloc(size(dat,1),size(dat,2),dat_,info)
dat_=dat
if (info == psb_success_) call mpi_allreduce(dat_,dat,size(dat),&
& mpi_integer2,mpi_sum,ictxt,info)
else
if (iam == root_) then
call psb_realloc(size(dat,1),size(dat,2),dat_,info)
dat_=dat
call mpi_reduce(dat_,dat,size(dat),mpi_integer2,mpi_sum,root_,ictxt,info)
else
call mpi_reduce(dat,dat_,size(dat),mpi_integer2,mpi_sum,root_,ictxt,info)
end if
endif
#endif
end subroutine psb_i2summ
#endif
#if !defined(LONG_INTEGERS)
subroutine psb_i8sums(ictxt,dat,root)
base/tools/psb_cd_set_bld.f90
+1 -1
View File
@@ -39,7 +39,7 @@ subroutine psb_cd_set_ovl_bld(desc,info)
if (info == psb_success_) then
if (desc%indxmap%row_extendable()) then
call desc%indxmap%set_state(psb_desc_ovl_bld_)
desc%matrix_data(psb_dec_type_) = psb_cd_ovl_bld_
desc%matrix_data(psb_dec_type_) = psb_desc_ovl_bld_
else
info = psb_err_invalid_cd_state_
end if