fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
Changelog
 base/modules/Makefile
 base/modules/psb_ip_reord_mod.f90
 base/newserial/Makefile
 base/newserial/psbn_base_mat_mod.f03
 base/newserial/psbn_coo_mat.f03
 base/newserial/psbn_d_base_mat_mod.f03
 base/newserial/psbn_d_coo_impl.f03
 base/newserial/psbn_mat_mod.f03
 base/serial/Makefile
 base/serial/psb_ip_reord_mod.f90
 config/pac.m4


Reworked base_mat to include COO (everybody must know about COO to
define A%TO_COO() and A%FROM_COO)
psblas3-type-indexed
Salvatore Filippone 16 years ago
parent eddf493ae9
commit 0ce5545cea
11 changed files with 2923 additions and 1957 deletions
Show Stats Download Patch File Download Diff File

376
Changelog
Unescape Escape View File

@ -1,372 +1,15 @@
2008/09/18: Defined psb_sizeof to be integer(8). Added support
into psb_sum, psb_amx and other reductions for long int
scalars.
2008/09/16: Implemented new scheme for index conversion.
Changed cdall with an option to suppress global checks.
2008/09/02: Improved psi_fnd_owner performace.
2008/09/01: Better timings in the pargen test cases.
2008/08/28: Changed CDALL in case of VL to handle overlapped indices.
2008/07/28: New sorting/reordering modules.
2008/07/24: Addded HTML version of user's guide.
2008/07/22: Fixed I/O for Harwell-Boeing and Matrix Market examples
2008/05/27: Merged single precision branch.
2008/04/28: Fixed trimming space in sparse matrix conversion.
Fixed performance issue in cdins.
2008/03/25: Fix performance bug in psi_idx_ins_cnv. Changed names of
some internal components of preconditioner data structure.
=======
2009/01/27: Renamed psb_transfer into psb_move_alloc.
2009/01/08: Require GNU Fortran 4.3 or later.
2008/11/04: Repackaged and streamlined linear maps.
2008/10/16: Fixed internal structure of psb_inter_desc.
2008/09/23: Fix borderline cases where one process does not own any
indices from the global space.
2008/09/18: Defined psb_sizeof to be integer(8). Added support
into psb_sum, psb_amx and other reductions for long int
scalars.
2008/09/16: Implemented new scheme for index conversion.
Changed cdall with an option to suppress global checks.
2008/09/02: Improved psi_fnd_owner performace.
2008/09/01: Better timings in the pargen test cases.
2008/08/28: Changed CDALL in case of VL to handle overlapped indices.
2008/07/28: New sorting/reordering modules.
2008/07/24: Addded HTML version of user's guide.
2008/07/22: Fixed I/O for Harwell-Boeing and Matrix Market examples
2008/05/27: Merged single precision branch.
2008/04/28: Fixed trimming space in sparse matrix conversion.
Fixed performance issue in cdins.
2008/03/25: Fix performance bug in psi_idx_ins_cnv. Changed names of
some internal components of preconditioner data structure.
>>>>>>> .merge-dx.r3587
2008/03/27: Merged the experimental branch for implementing the AVL tree
data structure in Fortran instead of relying on C and passing
functions around to perform comparisons. There seems to be
some performance advantage, although not very large.
2008/03/25: Merged in changes from the 2.2-maint branch re: error
messages, performance bug in psi_idx_ins_cnv.
2008/02/26: New psb_linmap_init, psb_linmap_ins, psb_linmap_asb for a
general linear operator mapping among index spaces.
2008/02/18: Branched off for Version 2.2
2008/02/08: Merged changes from intermesh branch: we now have an
inter_desc_type object. Currently we only implement the
version needed for aggregation algorithms in the algebraic
multigrid preconditioners, but we'll define more general
(linear) maps soon enough.
2008/01/25: Various changes to variables controlling conditional
compilation on the Fortran side: removed NETLIB_BLACS, now
HAVE_METIS HAVE_ESSL_BLACS HAVE_KSENDID.
Files impacted: Make.inc.XXX, base/modules/psb_penv_mod,
util/psb_metispart_mod
2008/01/18: Centralized convergence checks. Still partial for RGMRES.
2008/01/14: Merged changes for handling of transpose vs. overlap.
2008/01/10: Changed name of GMRESR into RGMRES for consistency.
2007/12/21: Merged in debug infrastructure, internal and html docs.
2007/11/14: Fix INTENT(IN) on X vector in preconditioner routines.
2007/10/15: Repackaged the sorting routines in a submodule of their
own, adding some heap management and heapsort utilities for the
benefit of the multilevel preconditioners.
2007/09/28: Moved gelp and csrp to serial. Changed interface to
sphalo: the new one makes more sense.
Updated documentation.
2007/09/14: Second round of serial changes: merged into trunk, fixed
JAD regeneration and srch_upd now works.
2007/09/10: First round of serial changes: implemented serial
psb_spcnv unifying multiple functionalities.
2007/09/04: Implemented RGMRES for complex data.
2007/06/04: Fixed implementation of fctint and coins: assume size
arrays caused troubles on some compilers. Documentation of
set_large_threshold.
2007/05/22: Defined psb_precinit.
2007/05/15: Defined psb_sizeof.
2007/05/15: Merged in various fixes coming from tests on SP5 and
HP-Itanium.
2007/04/08: Changed the implementation of psb_sp_getrow & friends.
2007/03/27: Merged in changes for enabling compilation on SUN.
2007/02/22: Fixed various misalignments between real and complex.
Defined new psb_sp_clip routines.
Fixed psb_rwextd.
Changed the USE statements, minimizing size of modules and
maximizing consistency checks.
2007/02/01: Merged serial version: we provide a minimal fake mpi to
allow compiling and running without mpi and blacs. Only
tested with gnu42 so far.
2007/01/23: Defined new field ext_index in desc_type, and
fixed long standing inconsistency in usage of overlap for
AS preconditioners. Modified halo to accept selector for
halo_index vs. ext_index.
2007/01/11: Migrated repository to SVN.
2007/01/11: MLD2P4 has been moved to the new org. Now tackling the
test dirs.
2007/01/09: First try at reorganizing directories. Subdir MLD2P4 still
to be fixed. Documentation still to be updated.
2006/12/11: Documented options in glob_to_loc.
2006/12/06: Fixed raw aggregation.
2006/12/05: Taken out extra interfaces; inserted use modules with ONLY
clauses where appropriate.
2006/11/30: Fixed a bug in raw aggregation. Note: raw aggregation
gives different results from smoothed with omega=0.0,
because in the latter we have explicitly stored zero
coefficients that would be absent in the first, thus
generating different ILU factorizations.
2006/11/28: Merged the mods for descriptors of large index spaces to
avoid having the GLOB_TO_LOC array. Took the chance to
reorganize the descriptor build routines and define some
access functions for descriptor features and entries, so
as not to use the descriptor components directly. Tested
with AS, 2- and 3- level Post smoothers.
2006/11/09: The allocatable version works, but under gcc42 there is a
compiler bug when using -fbounds-check.
2006/11/08: Merged the allocatable version; hope everything works!
2006/11/08: Branched version psblas2-2-0-maint, and defined tag
2.0.2.6
2006/11/02: Done in the allocatable branch: repackaging of cdasb and
friends, taking out AVL trees where they were not
absolutely needed, and new dcsrmv routine.
2006/11/01: Merged changes in the handling of data exchange.
2006/10/03: Merged in the multilevel preconditioner stuff. This is
still experimental, especially the interfaces are not
stable yet.
2006/10/03: Declared version 2.0.2.5 for reference purposes.
2006/10/03: Fixed a bunch of minor bugs, incuding the sorting routines
imsr and imsrx. Added a default call to blacs_exit inside
psb_exit fixed a bad termination in test/pargen/ppde90.f90
2006/09/02: Declared version 2.0.2, after having fixed a lot of
details in the environment routines.
2006/07/25: Defined a new psb_wtime function. Modified precset to
have a non-optional INFO dummy argument.
2006/07/06: Fixed bug in swaptran. Added psb_krylov generic interface.
2006/07/04: Ooops, the GetRow mod in SMMP is a performance hit.
Need to investigate further.
2006/06/21: Bug fix in hb_read when dealing with symmetric matrices.
2006/06/20: Rewritten symbmm and numbmm from SMMP to be intependent of
CSR storage by using GetRow. Still need to test for
performance.
2006/06/16: Defined GetRow. This way we may close the mat objects.
Next we will rewrite SMMP to only make use of GetRow,
not to rely on CSR storage format.
2006/05/29: Added BLACS-like routines for data communication,
broadcasts, reductions, send/receive.
2006/05/25: Added environment management routines.
2006/05/03: Bug fixes, plus some change in the internals for SPINS,
preparing hooks for insertion with local numbering.
2006/04/24: Minor changes to the interface of dense tools routines,
trying to achieve a uniform look & feel.
Rewritten documentation; it is now reasonable, though not
perfect, except for the preconditioner routines.
We can now declare RC3.
2006/04/21: A bunch of fixes related to various matrix initialization
problems that were revealed while testing on SP5.
2006/04/18: Changed interface to spasb and csdp: better handling of
regeneration. To be tested further for sophisticated uses.
2006/03/31: We declare RC2 now. Improved I/O routines in test/Fileread.
2006/03/24: We have a complex version now, working (not necessarily bug free).
2006/03/15: Started move to complex version.
2006/03/01: Complete restructure of PREC section.
2006/02/01: New naming scheme.
2006/01/01: New multilevel preconditioning wih smoothed aggregation.
2005/09 : Now enabled UMFPACK complete factorization as basis for AS.
2005/05/04: Now enabled SuperLU complete factorization as basis for AS.
2005/04/29: First version with decoupled 2-level.
2005/04/06: Started work on decoupling the preconditioner aggregation
for 2-level from the main factorization.
2005/03/30: First version of new DSC/SP allocate/insert/assembly
routines.
2005/03/17: First version of RGMRES. To be refined.
2005/03/08: dSwapTran aligned with dSwapData. Taken out SwapOverlap.
also moved onto iSwapX.
2005/03/07: dSwapData rewritten to achieve: 1. better performance;
2. more flexible functionality. It is now possible to
avoid SwapOvrlap entirely, relying on just SwapData.
SwapTran is still alive, since it reads the descriptors in
"transpose" mode. Also, added work areas to preconditioner
routine, to avoid excessive allocation in the halo/overlap
exchange.
2005/03/04: Had to put in a workaround for a gfortran bug:
tolower/toupper cannot be functions.
2005/02/09: Explicit storage choice for the smoother. This seems
to be changing a little bit the actual preconditioner.
To be evaluated further.
2005/02/08: Renamed F90_PSPREC to PSB_PRCAPLY and Preconditioner to
PSB_PRCBLD. Changed the way PRCAPLY decides what to do.
Still needs a PSB_PRCSET to be called before PRCBLD.
2005/01/28: Started moving functionalities to a SERIAL F90 layer. Also
defined a new COMM layer, to enable implementing SPMM
directly in F90.
2005/01/20: Finally taken out a direct call to the F77 DCSDP from
SPASB.
2005/01/18: After much work, we now have 2-level Additive Schwarz
prototype implemented and working. We now start a major
code cleanup that will take some time. Mainly we want to
move a lot of the serial F77 functionality into a new F95
serial layer, to simplify the parallel F95 code.
2004/11/25: Following the introduction of Additive Shwarz and
variants, we have now renamed DECOMP_ and friends as
DESC_; this makes things more readable. Sooner or later
we're going to merge this into mainline, but this version
is still very much in a state of flux.
2004/07/18: For use with gfortran we need to declare the pointer
components with NULL() initialization. This rules out
VAST and PGI.
2004/07/15: First development version with gfortran from the current
snapshot of gcc 3.5.0.
It is now possible in PSI_dSwapData to opt for
SEND|RECEIVE|SYNC data exchange; plan is to extend to all
data exchange functions, plus making it available as an
option from the F90 level.
2004/07/06: Merged in a lot of stuff coming mainly from the ASM
development; full merge will have to wait a little more.
Among other things:
use of psimod
new choice parms for overlap
new data exchange for swapdata, to be extended.
multicolumn CSMM.
use psrealloc
new format for marking a matrix as suitable for update.
2003/12/09: Changed DSALLOC and DSASB to make sure whenever a dense
matrix is allocated it is also zeroed out.
2003/10/13: Added call to BLACS_SET in the solvers to ensure global
heterogeneous coherence in the combine operations.
2003/09/30: Added LOC_TO_GLOB and GLOB_TO_LOC support routines.
2003/09/30: Changed interface for smart update capabilities: choose
with optional parameters in ASB routines.
2003/09/16: IFC 7.0 had a strange behaviour in the test programs:
sometimes the declaration of PARTS dummy argument with an
INTERFACE would not work, requiring an EXTERNAL
declaration. The proper INTERFACE works now with 7.1.
2003/03/10: Halo data exchange in F90_PSHALO can now be applied to
integer data; create appropriate support routines.
2002/12/05: Initial version of Fileread sample programs.
2002/11/19: Fixes for JAD preconditioner.
2002/11/19: Methods for patterns: create a descriptor without a
matrix.
2001/11/16: Reviewed the interfaces: in the tools section we really
need the POINTER attribute for dense vectors, but not in
the computational routines; taking it out allows more
flexibility.
2001/09/16: Smart update capabilities.
2001/03/16: Renumbering routines.
2001/01/14: Added extensions to compute multiple DOTs and AMAXs at once;
=======
Changelog. A lot less detailed than usual, at least for past
history.
2009/08/25: New configure flag
--enable-serial
for serial-only compilation.
2009/06/24: Changed order of arguments in sp_scal to make it uniform with
rest of library.
2009/05/15: Changed interface to matdist.
2009/05/12: Added support for NAG Fortran compiler
2009/03/16: Release 2.3.1
2009/01/27: Renamed psb_transfer into psb_move_alloc.
2009/01/08: Require GNU Fortran 4.3 or later.
2008/11/04: Repackaged and streamlined linear maps.
@ -703,4 +346,3 @@ history.
2001/01/14: Added extensions to compute multiple DOTs and AMAXs at once;
>>>>>>> .merge-dx.r3592

3
base/modules/Makefile
Unescape Escape View File

@ -5,7 +5,7 @@ UTIL_MODS = psb_string_mod.o psb_spmat_type.o \
psb_desc_type.o psb_sort_mod.o psb_penv_mod.o \
psb_serial_mod.o psb_tools_mod.o psb_blacs_mod.o \
psb_linmap_type_mod.o psb_comm_mod.o psb_psblas_mod.o \
psi_serial_mod.o psi_mod.o \
psi_serial_mod.o psi_mod.o psb_ip_reord_mod.o\
psb_check_mod.o psb_gps_mod.o psb_linmap_mod.o psb_hash_mod.o
MODULES=$(BASIC_MODS) $(UTIL_MODS)
@ -26,6 +26,7 @@ lib: $(BASIC_MODS) blacsmod $(UTIL_MODS) $(OBJS) $(LIBMOD)
psb_realloc_mod.o : psb_error_mod.o
psb_spmat_type.o : psb_realloc_mod.o psb_error_mod.o psb_const_mod.o psb_string_mod.o psb_sort_mod.o
psb_error_mod.o: psb_const_mod.o
psb_ip_reord_mod.o: psb_const_mod.o
psb_penv_mod.o: psb_const_mod.o psb_error_mod.o psb_realloc_mod.o psb_blacs_mod.o
psb_blacs_mod.o: psb_const_mod.o
psi_serial_mod.o: psb_const_mod.o psb_realloc_mod.o

0
base/serial/psb_ip_reord_mod.f90 → base/modules/psb_ip_reord_mod.f90
Unescape Escape View File

4
base/newserial/Makefile
Unescape Escape View File

@ -1,6 +1,7 @@
include ../../Make.inc
MODULES = psbn_base_mat_mod.o psbn_d_base_mat_mod.o psbn_coo_mat.o psbn_csr_mat.o psbn_mat_mod.o
MODULES = psbn_base_mat_mod.o psbn_d_base_mat_mod.o psbn_d_coo_impl.o
# psbn_csr_mat.o
LIBMOD=
@ -18,6 +19,7 @@ lib: $(MODULES) $(OBJS) $(LIBMOD)
psbn_mat_mod.o: psbn_base_mat_mod.o
psbn_coo_mat.o psbn_csr_mat.o: psbn_d_base_mat_mod.o
psbn_d_mat_impl.o: psbn_d_base_mat_mod.o
clean:
/bin/rm -f $(MODULES) $(OBJS) $(MPFOBJS) *$(.mod)

124
base/newserial/psbn_base_mat_mod.f03
Unescape Escape View File

@ -2,6 +2,7 @@ module psbn_base_mat_mod
use psb_const_mod
integer, parameter :: psbn_invalid_ = -1
integer, parameter :: psbn_spmat_null_=0, psbn_spmat_bld_=1
integer, parameter :: psbn_spmat_asb_=2, psbn_spmat_upd_=4
@ -29,12 +30,29 @@ module psbn_base_mat_mod
integer, private :: state, duplicate
logical, private :: triangle, unitd, upper, sorted
contains
procedure, pass(a) :: set_nrows
procedure, pass(a) :: set_ncols
procedure, pass(a) :: set_dupl
procedure, pass(a) :: set_state
procedure, pass(a) :: set_null
procedure, pass(a) :: set_bld
procedure, pass(a) :: set_upd
procedure, pass(a) :: set_asb
procedure, pass(a) :: set_sorted
procedure, pass(a) :: set_upper
procedure, pass(a) :: set_lower
procedure, pass(a) :: set_triangle
procedure, pass(a) :: set_unit
procedure, pass(a) :: get_nrows
procedure, pass(a) :: get_ncols
procedure, pass(a) :: get_nzeros
procedure, pass(a) :: get_size
procedure, pass(a) :: get_state
procedure, pass(a) :: get_dupl
procedure, pass(a) :: is_null
procedure, pass(a) :: is_bld
procedure, pass(a) :: is_upd
@ -81,6 +99,112 @@ contains
res = a%n
end function get_ncols
subroutine set_nrows(m,a)
class(psbn_base_sparse_mat), intent(inout) :: a
integer, intent(in) :: m
a%m = m
end subroutine set_nrows
subroutine set_ncols(n,a)
class(psbn_base_sparse_mat), intent(inout) :: a
integer, intent(in) :: n
a%n = n
end subroutine set_ncols
subroutine set_state(n,a)
class(psbn_base_sparse_mat), intent(inout) :: a
integer, intent(in) :: n
a%state = n
end subroutine set_state
subroutine set_dupl(n,a)
class(psbn_base_sparse_mat), intent(inout) :: a
integer, intent(in) :: n
a%duplicate = n
end subroutine set_dupl
subroutine set_null(a)
class(psbn_base_sparse_mat), intent(inout) :: a
a%state = psbn_spmat_null_
end subroutine set_null
subroutine set_bld(a)
class(psbn_base_sparse_mat), intent(inout) :: a
a%state = psbn_spmat_bld_
end subroutine set_bld
subroutine set_upd(a)
class(psbn_base_sparse_mat), intent(inout) :: a
a%state = psbn_spmat_upd_
end subroutine set_upd
subroutine set_asb(a)
class(psbn_base_sparse_mat), intent(inout) :: a
a%state = psbn_spmat_asb_
end subroutine set_asb
subroutine set_sorted(a,val)
class(psbn_base_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: val
if (present(val)) then
a%sorted = val
else
a%sorted = .true.
end if
end subroutine set_sorted
subroutine set_triangle(a,val)
class(psbn_base_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: val
if (present(val)) then
a%triangle = val
else
a%triangle = .true.
end if
end subroutine set_triangle
subroutine set_unit(a,val)
class(psbn_base_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: val
if (present(val)) then
a%unitd = val
else
a%unitd = .true.
end if
end subroutine set_unit
subroutine set_lower(a,val)
class(psbn_base_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: val
if (present(val)) then
a%upper = .not.val
else
a%upper = .false.
end if
end subroutine set_lower
subroutine set_upper(a,val)
class(psbn_base_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: val
if (present(val)) then
a%upper = val
else
a%upper = .true.
end if
end subroutine set_upper
function is_triangle(a) result(res)
class(psbn_base_sparse_mat), intent(in) :: a
logical :: res

1577
base/newserial/psbn_coo_mat.f03
View File

File diff suppressed because it is too large Load Diff

561
base/newserial/psbn_d_base_mat_mod.f03
Unescape Escape View File

@ -12,11 +12,269 @@ module psbn_d_base_mat_mod
procedure, pass(a) :: d_base_cssm
generic, public :: psbn_cssm => d_base_cssm, d_base_cssv
procedure, pass(a) :: csins
procedure, pass(a) :: to_coo
procedure, pass(a) :: from_coo
end type psbn_d_base_sparse_mat
type, extends(psbn_d_base_sparse_mat) :: psbn_d_coo_sparse_mat
integer :: nnz
integer, allocatable :: ia(:), ja(:)
real(psb_dpk_), allocatable :: val(:)
contains
procedure, pass(a) :: get_nzeros => d_coo_get_nzeros
procedure, pass(a) :: set_nzeros => d_coo_set_nzeros
procedure, pass(a) :: d_base_csmm => d_coo_csmm
procedure, pass(a) :: d_base_csmv => d_coo_csmv
procedure, pass(a) :: d_base_cssm => d_coo_cssm
procedure, pass(a) :: d_base_cssv => d_coo_cssv
procedure, pass(a) :: csins => d_coo_csins
procedure, pass(a) :: reallocate_nz => d_coo_reallocate_nz
procedure, pass(a) :: to_coo => d_coo_to_coo
procedure, pass(a) :: from_coo => d_coo_from_coo
procedure, pass(a) :: fix => d_fix_coo
end type psbn_d_coo_sparse_mat
interface
subroutine d_fix_coo_impl(a,info,idir)
use psb_const_mod
import psbn_d_coo_sparse_mat
class(psbn_d_coo_sparse_mat), intent(inout) :: a
integer, intent(out) :: info
integer, intent(in), optional :: idir
end subroutine d_fix_coo_impl
end interface
interface
subroutine d_coo_to_coo_impl(a,b,info)
use psb_const_mod
import psbn_d_coo_sparse_mat
class(psbn_d_coo_sparse_mat), intent(in) :: a
class(psbn_d_coo_sparse_mat), intent(out) :: b
integer, intent(out) :: info
end subroutine d_coo_to_coo_impl
end interface
interface
subroutine d_coo_from_coo_impl(a,b,info)
use psb_const_mod
import psbn_d_coo_sparse_mat
class(psbn_d_coo_sparse_mat), intent(inout) :: a
class(psbn_d_coo_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine d_coo_from_coo_impl
end interface
interface
subroutine d_coo_csins_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
use psb_const_mod
import psbn_d_coo_sparse_mat
class(psbn_d_coo_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
integer, intent(out) :: info
integer, intent(in), optional :: gtl(:)
end subroutine d_coo_csins_impl
end interface
interface d_coo_cssm_impl
subroutine d_coo_cssv_impl(alpha,a,x,beta,y,info,trans)
use psb_const_mod
import psbn_d_coo_sparse_mat
class(psbn_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
end subroutine d_coo_cssv_impl
subroutine d_coo_cssm_impl(alpha,a,x,beta,y,info,trans)
use psb_const_mod
import psbn_d_coo_sparse_mat
class(psbn_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
real(psb_dpk_), intent(inout) :: y(:,:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
end subroutine d_coo_cssm_impl
end interface
interface d_coo_csmm_impl
subroutine d_coo_csmv_impl(alpha,a,x,beta,y,info,trans)
use psb_const_mod
import psbn_d_coo_sparse_mat
class(psbn_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
end subroutine d_coo_csmv_impl
subroutine d_coo_csmm_impl(alpha,a,x,beta,y,info,trans)
use psb_const_mod
import psbn_d_coo_sparse_mat
class(psbn_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
real(psb_dpk_), intent(inout) :: y(:,:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
end subroutine d_coo_csmm_impl
end interface
contains
subroutine to_coo(a,b,info)
use psb_error_mod
use psb_realloc_mod
class(psbn_d_base_sparse_mat), intent(in) :: a
class(psbn_d_coo_sparse_mat), intent(out) :: b
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='to_coo'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = 700
call psb_errpush(info,name)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine to_coo
subroutine d_fix_coo(a,info,idir)
use psb_error_mod
use psb_const_mod
class(psbn_d_coo_sparse_mat), intent(inout) :: a
integer, intent(out) :: info
integer, intent(in), optional :: idir
Integer :: err_act
character(len=20) :: name='fix_coo'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
call d_fix_coo_impl(a,info,idir)
if (info /= 0) goto 9999
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
call psb_errpush(info,name)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine d_fix_coo
subroutine d_coo_to_coo(a,b,info)
use psb_error_mod
use psb_realloc_mod
class(psbn_d_coo_sparse_mat), intent(in) :: a
class(psbn_d_coo_sparse_mat), intent(out) :: b
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='to_coo'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
call d_coo_to_coo_impl(a,b,info)
if (info /= 0) goto 9999
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
call psb_errpush(info,name)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine d_coo_to_coo
subroutine d_coo_from_coo(a,b,info)
use psb_error_mod
use psb_realloc_mod
class(psbn_d_coo_sparse_mat), intent(inout) :: a
class(psbn_d_coo_sparse_mat), intent(in) :: b
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='from_coo'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
call d_coo_from_coo_impl(a,b,info)
if (info /= 0) goto 9999
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
call psb_errpush(info,name)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine d_coo_from_coo
subroutine from_coo(a,b,info)
use psb_error_mod
use psb_realloc_mod
class(psbn_d_base_sparse_mat), intent(inout) :: a
class(psbn_d_coo_sparse_mat), intent(in) :: b
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='from_coo'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = 700
call psb_errpush(info,name)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine from_coo
subroutine csins(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
use psb_error_mod
use psb_realloc_mod
@ -150,4 +408,305 @@ contains
end subroutine d_base_cssv
subroutine d_coo_reallocate_nz(nz,a)
use psb_error_mod
use psb_realloc_mod
integer, intent(in) :: nz
class(psbn_d_coo_sparse_mat), intent(inout) :: a
Integer :: err_act
character(len=20) :: name='d_coo_reallocate_nz'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
call psb_realloc(nx,a%ia,a%ja,a%val,info)
if (info /= 0) then
call psb_errpush(4000,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 d_coo_reallocate_nz
function d_coo_get_nzeros(a) result(res)
class(psbn_d_coo_sparse_mat), intent(in) :: a
integer :: res
res = a%nnz
end function d_coo_get_nzeros
subroutine d_coo_set_nzeros(nz,a)
integer, intent(in) :: nz
class(psbn_d_coo_sparse_mat), intent(inout) :: a
a%nnz = nz
end subroutine d_coo_set_nzeros
subroutine d_coo_csins(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
use psb_error_mod
use psb_realloc_mod
class(psbn_d_coo_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
integer, intent(out) :: info
integer, intent(in), optional :: gtl(:)
Integer :: err_act
character(len=20) :: name='d_coo_csins'
logical, parameter :: debug=.false.
integer :: nza, i,j,k, nzl, isza, int_err(5)
call psb_erractionsave(err_act)
info = 0
if (nz <= 0) then
info = 10
int_err(1)=1
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
if (size(ia) < nz) then
info = 35
int_err(1)=2
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
if (size(ja) < nz) then
info = 35
int_err(1)=3
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
if (size(val) < nz) then
info = 35
int_err(1)=4
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
if (nz == 0) return
call d_coo_csins_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
if (info /= 0) goto 9999
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 d_coo_csins
subroutine d_coo_csmv(alpha,a,x,beta,y,info,trans)
use psb_error_mod
class(psbn_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
character :: trans_
integer :: i,j,k,m,n, nnz, ir, jc
real(psb_dpk_) :: acc
logical :: tra
Integer :: err_act
character(len=20) :: name='d_coo_csmv'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (.not.a%is_asb()) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
call d_coo_csmm_impl(alpha,a,x,beta,y,info,trans)
if (info /= 0) goto 9999
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 d_coo_csmv
subroutine d_coo_csmm(alpha,a,x,beta,y,info,trans)
use psb_error_mod
class(psbn_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
real(psb_dpk_), intent(inout) :: y(:,:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
character :: trans_
integer :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_dpk_), allocatable :: acc(:)
logical :: tra
Integer :: err_act
character(len=20) :: name='d_coo_csmm'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
call d_coo_csmm_impl(alpha,a,x,beta,y,info,trans)
if (info /= 0) goto 9999
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 d_coo_csmm
subroutine d_coo_cssv(alpha,a,x,beta,y,info,trans)
use psb_error_mod
class(psbn_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
character :: trans_
integer :: i,j,k,m,n, nnz, ir, jc
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: tmp(:)
logical :: tra
Integer :: err_act
character(len=20) :: name='d_coo_cssv'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (.not.a%is_asb()) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
if (.not. (a%is_triangle())) then
write(0,*) 'Called SM on a non-triangular mat!'
info = 1121
call psb_errpush(info,name)
goto 9999
end if
call d_coo_cssm_impl(alpha,a,x,beta,y,info,trans)
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 d_coo_cssv
subroutine d_coo_cssm(alpha,a,x,beta,y,info,trans)
use psb_error_mod
class(psbn_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
real(psb_dpk_), intent(inout) :: y(:,:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
character :: trans_
integer :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: tmp(:,:)
logical :: tra
Integer :: err_act
character(len=20) :: name='d_coo_csmm'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (.not.a%is_asb()) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
if (.not. (a%is_triangle())) then
write(0,*) 'Called SM on a non-triangular mat!'
info = 1121
call psb_errpush(info,name)
goto 9999
end if
call d_coo_cssm_impl(alpha,a,x,beta,y,info,trans)
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 d_coo_cssm
end module psbn_d_base_mat_mod

1845
base/newserial/psbn_d_coo_impl.f03
View File

File diff suppressed because it is too large Load Diff

369
base/newserial/psbn_mat_mod.f03
Unescape Escape View File

@ -9,6 +9,30 @@ module psbn_d_mat_mod
contains
procedure, pass(a) :: get_nrows
procedure, pass(a) :: get_ncols
procedure, pass(a) :: get_nzeros
procedure, pass(a) :: get_size
procedure, pass(a) :: get_state
procedure, pass(a) :: get_dupl
procedure, pass(a) :: is_null
procedure, pass(a) :: is_bld
procedure, pass(a) :: is_upd
procedure, pass(a) :: is_asb
procedure, pass(a) :: is_sorted
procedure, pass(a) :: is_upper
procedure, pass(a) :: is_lower
procedure, pass(a) :: is_triangle
procedure, pass(a) :: is_unit
procedure, pass(a) :: get_neigh
procedure, pass(a) :: allocate_mn
procedure, pass(a) :: allocate_mnnz
procedure, pass(a) :: reallocate_nz
procedure, pass(a) :: free
generic, public :: allocate => allocate_mn, allocate_mnnz
generic, public :: reallocate => reallocate_nz
procedure, pass(a) :: d_csmv
procedure, pass(a) :: d_csmm
generic, public :: psbn_csmm => d_csmm, d_csmv
@ -21,6 +45,351 @@ module psbn_d_mat_mod
contains
function get_dupl(a) result(res)
use psb_error_mod
class(psbn_d_sparse_mat), intent(in) :: a
integer :: res
if (allocated(a%a)) then
res = a%a%get_dupl
else
res = psbn_invalid_
end if
end function get_dupl
function get_state(a) result(res)
class(psbn_d_sparse_mat), intent(in) :: a
integer :: res
if (allocated(a%a)) then
res = a%a%get_state()
else
res = psbn_spmat_null_
end if
end function get_state
function get_nrows(a) result(res)
class(psbn_d_sparse_mat), intent(in) :: a
integer :: res
if (allocated(a%a)) then
res = a%a%get_nrows()
else
res = 0
end if
end function get_nrows
function get_ncols(a) result(res)
class(psbn_d_sparse_mat), intent(in) :: a
integer :: res
if (allocated(a%a)) then
res = a%a%get_ncols()
else
res = 0
end if
end function get_ncols
function is_triangle(a) result(res)
class(psbn_d_sparse_mat), intent(in) :: a
logical :: res
if (allocated(a%a)) then
res = a%a%is_triangle()
else
res = .false.
end if
end function is_triangle
function is_unit(a) result(res)
class(psbn_d_sparse_mat), intent(in) :: a
logical :: res
if (allocated(a%a)) then
res = a%a%is_unit()
else
res = .false.
end if
end function is_unit
function is_upper(a) result(res)
class(psbn_d_sparse_mat), intent(in) :: a
logical :: res
if (allocated(a%a)) then
res = a%a%is_upper()
else
res = .false.
end if
end function is_upper
function is_lower(a) result(res)
class(psbn_d_sparse_mat), intent(in) :: a
logical :: res
if (allocated(a%a)) then
res = .not. a%a%is_upper()
else
res = .false.
end if
end function is_lower
function is_null(a) result(res)
class(psbn_d_sparse_mat), intent(in) :: a
logical :: res
if (allocated(a%a)) then
res = a%a%is_null()
else
res = .true.
end if
end function is_null
function is_bld(a) result(res)
class(psbn_d_sparse_mat), intent(in) :: a
logical :: res
if (allocated(a%a)) then
res = a%a%is_bld()
else
res = .false.
end if
end function is_bld
function is_upd(a) result(res)
class(psbn_d_sparse_mat), intent(in) :: a
logical :: res
if (allocated(a%a)) then
res = a%a%is_upd()
else
res = .false.
end if
end function is_upd
function is_asb(a) result(res)
class(psbn_d_sparse_mat), intent(in) :: a
logical :: res
if (allocated(a%a)) then
res = a%a%is_asb()
else
res = .false.
end if
end function is_asb
function is_sorted(a) result(res)
class(psbn_d_sparse_mat), intent(in) :: a
logical :: res
if (allocated(a%a)) then
res = a%a%is_sorted()
else
res = .false.
end if
end function is_sorted
function get_nzeros(a) result(res)
use psb_error_mod
class(psbn_d_sparse_mat), intent(in) :: a
integer :: res
Integer :: err_act
character(len=20) :: name='get_nzeros'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
res = a%a%get_nzeros()
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
end function get_nzeros
function get_size(a) result(res)
use psb_error_mod
class(psbn_d_sparse_mat), intent(in) :: a
integer :: res
Integer :: err_act
character(len=20) :: name='get_size'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
res = a%a%get_size()
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 function get_size
subroutine get_neigh(a,idx,neigh,n,info,lev)
use psb_error_mod
class(psbn_d_sparse_mat), intent(in) :: a
integer, intent(in) :: idx
integer, intent(out) :: n
integer, allocatable, intent(out) :: neigh(:)
integer, intent(out) :: info
integer, optional, intent(in) :: lev
Integer :: err_act
character(len=20) :: name='get_neigh'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
call a%a%get_neigh(idx,neigh,n,info,lev)
if (info /= 0) goto 9999
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 get_neigh
subroutine allocate_mn(m,n,a)
use psb_error_mod
integer, intent(in) :: m,n
class(psbn_d_sparse_mat), intent(inout) :: a
Integer :: err_act
character(len=20) :: name='allocate_mn'
logical, parameter :: debug=.false.
call psb_erractionsave(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(700,name)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine allocate_mn
subroutine allocate_mnnz(m,n,nz,a)
use psb_error_mod
integer, intent(in) :: m,n,nz
class(psbn_d_sparse_mat), intent(inout) :: a
Integer :: err_act
character(len=20) :: name='allocate_mnz'
logical, parameter :: debug=.false.
call psb_erractionsave(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(700,name)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine allocate_mnnz
subroutine reallocate_nz(nz,a)
use psb_error_mod
integer, intent(in) :: nz
class(psbn_d_sparse_mat), intent(inout) :: a
Integer :: err_act
character(len=20) :: name='reallocate_nz'
logical, parameter :: debug=.false.
call psb_erractionsave(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(700,name)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
end subroutine reallocate_nz
subroutine free(a)
use psb_error_mod
class(psbn_d_sparse_mat), intent(inout) :: a
Integer :: err_act
character(len=20) :: name='free'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
call a%a%free()
return
end subroutine free
subroutine d_csmm(alpha,a,x,beta,y,info,trans)
use psb_error_mod
class(psbn_d_sparse_mat), intent(in) :: a

4
base/serial/Makefile
Unescape Escape View File

@ -26,7 +26,7 @@ FOBJS = psb_cest.o psb_dcoins.o psb_dcsmm.o psb_dcsmv.o \
psb_cgelp.o psb_cspgtdiag.o psb_cspgtblk.o psb_cspgetrow.o\
psb_ccssm.o psb_ccssv.o psb_ccsmm.o psb_ccsmv.o psb_ctransp.o psb_ctransc.o\
psb_cspclip.o psb_crwextd.o psb_cspscal.o\
psb_cnumbmm.o psb_csymbmm.o psb_cneigh.o psb_ip_reord_mod.o
psb_cnumbmm.o psb_csymbmm.o psb_cneigh.o
# psb_dcsrp.o psb_zcsrp.o\
LIBDIR=..
@ -43,7 +43,7 @@ lib1: $(FOBJS)
psb_scoins.o psb_dcoins.o psb_zcoins.o: psb_update_mod.o
psb_sspgetrow.o psb_dspgetrow.o psb_zspgetrow.o: psb_getrow_mod.o
psb_sspcnv.o psb_dspcnv.o pzb_zspcnv.o: psb_regen_mod.o
psb_sfixcoo.o psb_dfixcoo.o psb_cfixcoo.o psb_zfixcoo.o: psb_ip_reord_mod.o
#psb_sfixcoo.o psb_dfixcoo.o psb_cfixcoo.o psb_zfixcoo.o: psb_ip_reord_mod.o
auxd: psb_ip_reord_mod.o
(cd aux; make lib)

17
config/pac.m4
Unescape Escape View File

@ -300,19 +300,20 @@ dnl
AC_DEFUN([PAC_ARG_SERIAL_MPI],
[
AC_MSG_CHECKING([whether we want serial (fake) mpi])
AC_ARG_WITH(serial-mpi,
AC_HELP_STRING([--with-serial-mpi],
[Specify whether to enable a fake mpi library to run in serial mode.
--with-serial-mpi={yes|no}]),
AC_ARG_ENABLE(serial,
AC_HELP_STRING([--enable-serial],
[Specify whether to enable a fake mpi library to run in serial mode. ]),
[
pac_cv_serial_mpi="${withval}";
],
[pac_cv_serial_mpi="no";]
pac_cv_serial_mpi="yes";
]
dnl ,
dnl [pac_cv_serial_mpi="no";]
)
if test x"$pac_cv_serial_mpi" == x"yes" ; then
AC_MSG_RESULT([yes.])
else
AC_MSG_RESULT([no.])
pac_cv_serial_mpi="no";
AC_MSG_RESULT([no.])
fi
]
)

Write Preview
Loading…
Cancel
Save