Updated license statement on all files in preparation for 3.0 release.
Defined i_base_vect and i_vect; also to get through with preprocessing
defined idot and inrm2 even if they are not actually used (and inrm2
really does norm1).
psblas-3.0-maint
Salvatore Filippone 13 years ago
parent b498a99289
commit c0e8ccabea

@ -117,7 +117,8 @@ small cases have been tested but we do not offer full guarantee (yet).
COMPILER NOTES. COMPILER NOTES.
Notes: This code is confirmed to work with the following compilers (or
This code is confirmed to work with the following compilers (or
later versions thereof): later versions thereof):
NAGware 5.2; NAGware 5.2;
XLF 13.1; XLF 13.1;
@ -136,8 +137,8 @@ with both CCE and GNU lower-level compilers.
KNOWN ISSUES. KNOWN ISSUES.
For the GNU compilers 4.6.x we are aware of a number of memory management For the GNU compilers 4.6.x we are aware of a number of memory management
issues that may or may not surface in your applications; all of them issues that might surface in your applications; all of them (that
(that we're aware of) are solved in version 4.7.0. we're aware of) are solved in version 4.7.0.
The Intel compiler up to version 12.1 fails due to a bug in the The Intel compiler up to version 12.1 fails due to a bug in the
handling of generic interfaces. handling of generic interfaces.

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -178,7 +178,7 @@ end subroutine psb_cgatherm
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -223,7 +223,7 @@ end subroutine psb_chalom
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -204,7 +204,7 @@ subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode)
end subroutine psb_covrlm end subroutine psb_covrlm
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -242,7 +242,7 @@ end subroutine psb_covrlm
! x(:) - complex The local part of the dense vector. ! x(:) - complex The local part of the dense vector.
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code. ! info - integer. Return code.
! work - real(optional). A work area. ! work - complex(optional). A work area.
! update - integer(optional). Type of update: ! update - integer(optional). Type of update:
! psb_none_ do nothing ! psb_none_ do nothing
! psb_sum_ sum of overlaps ! psb_sum_ sum of overlaps

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -235,7 +235,7 @@ end subroutine psb_cscatterm
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,3 +1,35 @@
!!$
!!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ 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.
!!$
!!$
! File: psb_cspgather.f90
subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_descriptor_type use psb_descriptor_type
use psb_error_mod use psb_error_mod

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -178,7 +178,7 @@ end subroutine psb_dgatherm
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -223,7 +223,7 @@ end subroutine psb_dhalom
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -499,12 +499,12 @@ subroutine psb_dhalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
call psb_errpush(info,name) call psb_errpush(info,name)
end if end if
err = info err=info
call psb_errcomm(ictxt,err) call psb_errcomm(ictxt,err)
if (err /= 0) goto 9999 if(err /= 0) goto 9999
if (present(alpha)) then if(present(alpha)) then
if (alpha /= done) then if(alpha /= done) then
call x%scal(alpha) call x%scal(alpha)
end if end if
end if end if

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -204,7 +204,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode)
end subroutine psb_dovrlm end subroutine psb_dovrlm
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -235,7 +235,7 @@ end subroutine psb_dscatterm
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,3 +1,35 @@
!!$
!!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ 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.
!!$
!!$
! File: psb_dspgather.f90
subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_descriptor_type use psb_descriptor_type
use psb_error_mod use psb_error_mod

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -174,7 +174,7 @@ end subroutine psb_igatherm
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -227,7 +227,7 @@ end subroutine psb_ihalom
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -203,7 +203,7 @@ end subroutine psb_iovrlm
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -233,7 +233,7 @@ end subroutine psb_iscatterm
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -178,7 +178,7 @@ end subroutine psb_sgatherm
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -223,7 +223,7 @@ end subroutine psb_shalom
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -204,7 +204,7 @@ subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode)
end subroutine psb_sovrlm end subroutine psb_sovrlm
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -235,7 +235,7 @@ end subroutine psb_sscatterm
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,3 +1,35 @@
!!$
!!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ 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.
!!$
!!$
! File: psb_sspgather.f90
subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_descriptor_type use psb_descriptor_type
use psb_error_mod use psb_error_mod

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -178,7 +178,7 @@ end subroutine psb_zgatherm
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -223,7 +223,7 @@ end subroutine psb_zhalom
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -204,7 +204,7 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode)
end subroutine psb_zovrlm end subroutine psb_zovrlm
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -242,7 +242,7 @@ end subroutine psb_zovrlm
! x(:) - complex The local part of the dense vector. ! x(:) - complex The local part of the dense vector.
! desc_a - type(psb_desc_type). The communication descriptor. ! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code. ! info - integer. Return code.
! work - real(optional). A work area. ! work - complex(optional). A work area.
! update - integer(optional). Type of update: ! update - integer(optional). Type of update:
! psb_none_ do nothing ! psb_none_ do nothing
! psb_sum_ sum of overlaps ! psb_sum_ sum of overlaps

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -235,7 +235,7 @@ end subroutine psb_zscatterm
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,3 +1,35 @@
!!$
!!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ 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.
!!$
!!$
! File: psb_zspgather.f90
subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_descriptor_type use psb_descriptor_type
use psb_error_mod use psb_error_mod

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
C C
C Parallel Sparse BLAS version 3.0 C Parallel Sparse BLAS version 3.0
C (C) Copyright 2006, 2007, 2008, 2009, 2010 C (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
C Salvatore Filippone University of Rome Tor Vergata C Salvatore Filippone University of Rome Tor Vergata
C Alfredo Buttari CNRS-IRIT, Toulouse C Alfredo Buttari CNRS-IRIT, Toulouse
C C

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -136,7 +136,7 @@ subroutine psi_idx_cnv1(nv,idxin,desc,info,mask,owned)
end subroutine psi_idx_cnv1 end subroutine psi_idx_cnv1
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -260,7 +260,7 @@ subroutine psi_idx_cnv2(nv,idxin,idxout,desc,info,mask,owned)
end subroutine psi_idx_cnv2 end subroutine psi_idx_cnv2
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -138,7 +138,7 @@ subroutine psi_idx_ins_cnv1(nv,idxin,desc,info,mask,lidx)
end subroutine psi_idx_ins_cnv1 end subroutine psi_idx_ins_cnv1
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -265,7 +265,7 @@ subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask,lidx)
end subroutine psi_idx_ins_cnv2 end subroutine psi_idx_ins_cnv2
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -342,7 +342,7 @@ subroutine psi_idx_ins_cnvs2(idxin,idxout,desc,info,mask,lidx)
end subroutine psi_idx_ins_cnvs2 end subroutine psi_idx_ins_cnvs2
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -1014,440 +1014,440 @@ subroutine psi_iswapidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
return return
end subroutine psi_iswapidxv end subroutine psi_iswapidxv
!!$subroutine psi_iswapdata_vect(flag,beta,y,desc_a,work,info,data) subroutine psi_iswapdata_vect(flag,beta,y,desc_a,work,info,data)
!!$
!!$ use psi_mod, psb_protect_name => psi_iswapdata_vect use psi_mod, psb_protect_name => psi_iswapdata_vect
!!$ use psb_i_base_vect_mod use psb_i_base_vect_mod
!!$ use psb_error_mod use psb_error_mod
!!$ use psb_descriptor_type use psb_descriptor_type
!!$ use psb_penv_mod use psb_penv_mod
!!$#ifdef MPI_MOD #ifdef MPI_MOD
!!$ use mpi use mpi
!!$#endif #endif
!!$ implicit none implicit none
!!$#ifdef MPI_H #ifdef MPI_H
!!$ include 'mpif.h' include 'mpif.h'
!!$#endif #endif
!!$
!!$ integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
!!$ integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
!!$ class(psb_i_base_vect_type) :: y class(psb_i_base_vect_type) :: y
!!$ integer(psb_ipk_) :: beta integer(psb_ipk_) :: beta
!!$ integer(psb_ipk_), target :: work(:) integer(psb_ipk_), target :: work(:)
!!$ type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
!!$ integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
!!$
!!$ ! locals ! locals
!!$ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, data_, err_act
!!$ integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
!!$ character(len=20) :: name character(len=20) :: name
!!$
!!$ info=psb_success_ info=psb_success_
!!$ name='psi_swap_datav' name='psi_swap_datav'
!!$ call psb_erractionsave(err_act) call psb_erractionsave(err_act)
!!$
!!$ ictxt=desc_a%get_context() ictxt=desc_a%get_context()
!!$ call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
!!$ if (np == -1) then if (np == -1) then
!!$ info=psb_err_context_error_ info=psb_err_context_error_
!!$ call psb_errpush(info,name) call psb_errpush(info,name)
!!$ goto 9999 goto 9999
!!$ endif endif
!!$
!!$ if (.not.psb_is_asb_desc(desc_a)) then if (.not.psb_is_asb_desc(desc_a)) then
!!$ info=psb_err_invalid_cd_state_ info=psb_err_invalid_cd_state_
!!$ call psb_errpush(info,name) call psb_errpush(info,name)
!!$ goto 9999 goto 9999
!!$ endif endif
!!$
!!$ icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
!!$
!!$ if(present(data)) then if(present(data)) then
!!$ data_ = data data_ = data
!!$ else else
!!$ data_ = psb_comm_halo_ data_ = psb_comm_halo_
!!$ end if end if
!!$
!!$ call desc_a%get_list(data_,d_idx,totxch,idxr,idxs,info) call desc_a%get_list(data_,d_idx,totxch,idxr,idxs,info)
!!$ if (info /= psb_success_) then if (info /= psb_success_) then
!!$ call psb_errpush(psb_err_internal_error_,name,a_err='psb_cd_get_list') call psb_errpush(psb_err_internal_error_,name,a_err='psb_cd_get_list')
!!$ goto 9999 goto 9999
!!$ end if end if
!!$
!!$ call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swapdata(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info)
!!$ if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
!!$
!!$ call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
!!$ return return
!!$
!!$9999 continue 9999 continue
!!$ call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
!!$ if (err_act == psb_act_abort_) then if (err_act == psb_act_abort_) then
!!$ call psb_error(ictxt) call psb_error(ictxt)
!!$ return return
!!$ end if end if
!!$ return return
!!$end subroutine psi_iswapdata_vect end subroutine psi_iswapdata_vect
!!$
!!$
!!$subroutine psi_iswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info) subroutine psi_iswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
!!$
!!$ use psi_mod, psb_protect_name => psi_iswapidx_vect use psi_mod, psb_protect_name => psi_iswapidx_vect
!!$ use psb_error_mod use psb_error_mod
!!$ use psb_descriptor_type use psb_descriptor_type
!!$ use psb_penv_mod use psb_penv_mod
!!$ use psb_i_base_vect_mod use psb_i_base_vect_mod
!!$#ifdef MPI_MOD #ifdef MPI_MOD
!!$ use mpi use mpi
!!$#endif #endif
!!$ implicit none implicit none
!!$#ifdef MPI_H #ifdef MPI_H
!!$ include 'mpif.h' include 'mpif.h'
!!$#endif #endif
!!$
!!$ integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag
!!$ integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
!!$ class(psb_i_base_vect_type) :: y class(psb_i_base_vect_type) :: y
!!$ integer(psb_ipk_) :: beta integer(psb_ipk_) :: beta
!!$ integer(psb_ipk_), target :: work(:) integer(psb_ipk_), target :: work(:)
!!$ integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
!!$
!!$ ! locals ! locals
!!$ integer(psb_mpik_) :: ictxt, icomm, np, me,& integer(psb_mpik_) :: ictxt, icomm, np, me,&
!!$ & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
!!$ integer(psb_mpik_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpik_), allocatable, dimension(:) :: bsdidx, brvidx,&
!!$ & sdsz, rvsz, prcid, rvhd, sdhd & sdsz, rvsz, prcid, rvhd, sdhd
!!$ integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
!!$ & err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
!!$ & snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
!!$ integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
!!$ logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
!!$ & albf,do_send,do_recv & albf,do_send,do_recv
!!$ logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
!!$
!!$ integer(psb_ipk_), pointer, dimension(:) :: sndbuf, rcvbuf integer(psb_ipk_), pointer, dimension(:) :: sndbuf, rcvbuf
!!$#ifdef HAVE_VOLATILE #ifdef HAVE_VOLATILE
!!$ volatile :: sndbuf, rcvbuf volatile :: sndbuf, rcvbuf
!!$#endif #endif
!!$ character(len=20) :: name character(len=20) :: name
!!$
!!$ info=psb_success_ info=psb_success_
!!$ name='psi_swap_datav' name='psi_swap_datav'
!!$ call psb_erractionsave(err_act) call psb_erractionsave(err_act)
!!$ ictxt = iictxt ictxt = iictxt
!!$ icomm = iicomm icomm = iicomm
!!$ call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
!!$ if (np == -1) then if (np == -1) then
!!$ info=psb_err_context_error_ info=psb_err_context_error_
!!$ call psb_errpush(info,name) call psb_errpush(info,name)
!!$ goto 9999 goto 9999
!!$ endif endif
!!$
!!$ n=1 n=1
!!$
!!$ swap_mpi = iand(flag,psb_swap_mpi_) /= 0 swap_mpi = iand(flag,psb_swap_mpi_) /= 0
!!$ swap_sync = iand(flag,psb_swap_sync_) /= 0 swap_sync = iand(flag,psb_swap_sync_) /= 0
!!$ swap_send = iand(flag,psb_swap_send_) /= 0 swap_send = iand(flag,psb_swap_send_) /= 0
!!$ swap_recv = iand(flag,psb_swap_recv_) /= 0 swap_recv = iand(flag,psb_swap_recv_) /= 0
!!$ do_send = swap_mpi .or. swap_sync .or. swap_send do_send = swap_mpi .or. swap_sync .or. swap_send
!!$ do_recv = swap_mpi .or. swap_sync .or. swap_recv do_recv = swap_mpi .or. swap_sync .or. swap_recv
!!$
!!$ totrcv_ = totrcv * n totrcv_ = totrcv * n
!!$ totsnd_ = totsnd * n totsnd_ = totsnd * n
!!$
!!$ if (swap_mpi) then if (swap_mpi) then
!!$ allocate(sdsz(0:np-1), rvsz(0:np-1), bsdidx(0:np-1),& allocate(sdsz(0:np-1), rvsz(0:np-1), bsdidx(0:np-1),&
!!$ & brvidx(0:np-1), rvhd(0:np-1), sdhd(0:np-1), prcid(0:np-1),& & brvidx(0:np-1), rvhd(0:np-1), sdhd(0:np-1), prcid(0:np-1),&
!!$ & stat=info) & stat=info)
!!$ if(info /= psb_success_) then if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
!!$ goto 9999 goto 9999
!!$ end if end if
!!$
!!$ rvhd(:) = mpi_request_null rvhd(:) = mpi_request_null
!!$ sdsz(:) = 0 sdsz(:) = 0
!!$ rvsz(:) = 0 rvsz(:) = 0
!!$
!!$ ! prepare info for communications ! prepare info for communications
!!$
!!$ pnti = 1 pnti = 1
!!$ snd_pt = 1 snd_pt = 1
!!$ rcv_pt = 1 rcv_pt = 1
!!$ do i=1, totxch do i=1, totxch
!!$ proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$ call psb_get_rank(prcid(proc_to_comm),ictxt,proc_to_comm) call psb_get_rank(prcid(proc_to_comm),ictxt,proc_to_comm)
!!$
!!$ brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
!!$ rvsz(proc_to_comm) = nerv rvsz(proc_to_comm) = nerv
!!$
!!$ bsdidx(proc_to_comm) = snd_pt bsdidx(proc_to_comm) = snd_pt
!!$ sdsz(proc_to_comm) = nesd sdsz(proc_to_comm) = nesd
!!$
!!$ rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
!!$ snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$
!!$ end do end do
!!$
!!$ else else
!!$ allocate(rvhd(totxch),prcid(totxch),stat=info) allocate(rvhd(totxch),prcid(totxch),stat=info)
!!$ if(info /= psb_success_) then if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
!!$ goto 9999 goto 9999
!!$ end if end if
!!$ end if end if
!!$
!!$
!!$ totrcv_ = max(totrcv_,1) totrcv_ = max(totrcv_,1)
!!$ totsnd_ = max(totsnd_,1) totsnd_ = max(totsnd_,1)
!!$ if((totrcv_+totsnd_) < size(work)) then if((totrcv_+totsnd_) < size(work)) then
!!$ sndbuf => work(1:totsnd_) sndbuf => work(1:totsnd_)
!!$ rcvbuf => work(totsnd_+1:totsnd_+totrcv_) rcvbuf => work(totsnd_+1:totsnd_+totrcv_)
!!$ albf=.false. albf=.false.
!!$ else else
!!$ allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info) allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info)
!!$ if(info /= psb_success_) then if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
!!$ goto 9999 goto 9999
!!$ end if end if
!!$ albf=.true. albf=.true.
!!$ end if end if
!!$
!!$
!!$ if (do_send) then if (do_send) then
!!$
!!$ ! Pack send buffers ! Pack send buffers
!!$ pnti = 1 pnti = 1
!!$ snd_pt = 1 snd_pt = 1
!!$ do i=1, totxch do i=1, totxch
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$ idx_pt = 1+pnti+nerv+psb_n_elem_send_ idx_pt = 1+pnti+nerv+psb_n_elem_send_
!!$ call y%gth(nesd,idx(idx_pt:idx_pt+nesd-1),& call y%gth(nesd,idx(idx_pt:idx_pt+nesd-1),&
!!$ & sndbuf(snd_pt:snd_pt+nesd-1)) & sndbuf(snd_pt:snd_pt+nesd-1))
!!$ snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$ end do end do
!!$
!!$ end if end if
!!$
!!$ ! Case SWAP_MPI ! Case SWAP_MPI
!!$ if (swap_mpi) then if (swap_mpi) then
!!$
!!$ ! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
!!$ call mpi_alltoallv(sndbuf,sdsz,bsdidx,& call mpi_alltoallv(sndbuf,sdsz,bsdidx,&
!!$ & psb_mpi_ipk_integer,rcvbuf,rvsz,& & psb_mpi_ipk_integer,rcvbuf,rvsz,&
!!$ & brvidx,psb_mpi_ipk_integer,icomm,iret) & brvidx,psb_mpi_ipk_integer,icomm,iret)
!!$ if(iret /= mpi_success) then if(iret /= mpi_success) then
!!$ ierr(1) = iret ierr(1) = iret
!!$ info=psb_err_mpi_error_ info=psb_err_mpi_error_
!!$ call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,i_err=ierr)
!!$ goto 9999 goto 9999
!!$ end if end if
!!$
!!$ else if (swap_sync) then else if (swap_sync) then
!!$
!!$ pnti = 1 pnti = 1
!!$ snd_pt = 1 snd_pt = 1
!!$ rcv_pt = 1 rcv_pt = 1
!!$ do i=1, totxch do i=1, totxch
!!$ proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$
!!$ if (proc_to_comm < me) then if (proc_to_comm < me) then
!!$ if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ictxt,&
!!$ & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
!!$ if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ictxt,&
!!$ & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
!!$ else if (proc_to_comm > me) then else if (proc_to_comm > me) then
!!$ if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ictxt,&
!!$ & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
!!$ if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ictxt,&
!!$ & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
!!$ else if (proc_to_comm == me) then else if (proc_to_comm == me) then
!!$ if (nesd /= nerv) then if (nesd /= nerv) then
!!$ write(psb_err_unit,*) & write(psb_err_unit,*) &
!!$ & 'Fatal error in swapdata: mismatch on self send',& & 'Fatal error in swapdata: mismatch on self send',&
!!$ & nerv,nesd & nerv,nesd
!!$ end if end if
!!$ rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1) rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1)
!!$ end if end if
!!$ rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
!!$ snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$ end do end do
!!$
!!$
!!$ else if (swap_send .and. swap_recv) then else if (swap_send .and. swap_recv) then
!!$
!!$ ! First I post all the non blocking receives ! First I post all the non blocking receives
!!$ pnti = 1 pnti = 1
!!$ snd_pt = 1 snd_pt = 1
!!$ rcv_pt = 1 rcv_pt = 1
!!$ do i=1, totxch do i=1, totxch
!!$ proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$
!!$ call psb_get_rank(prcid(i),ictxt,proc_to_comm) call psb_get_rank(prcid(i),ictxt,proc_to_comm)
!!$ if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
!!$ p2ptag = psb_int_swap_tag p2ptag = psb_int_swap_tag
!!$ call mpi_irecv(rcvbuf(rcv_pt),nerv,& call mpi_irecv(rcvbuf(rcv_pt),nerv,&
!!$ & psb_mpi_ipk_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag, icomm,rvhd(i),iret) & p2ptag, icomm,rvhd(i),iret)
!!$ end if end if
!!$ rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
!!$ snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$ end do end do
!!$
!!$
!!$ ! Then I post all the blocking sends ! Then I post all the blocking sends
!!$ if (usersend) call mpi_barrier(icomm,iret) if (usersend) call mpi_barrier(icomm,iret)
!!$
!!$ pnti = 1 pnti = 1
!!$ snd_pt = 1 snd_pt = 1
!!$ rcv_pt = 1 rcv_pt = 1
!!$ do i=1, totxch do i=1, totxch
!!$ proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$
!!$ p2ptag = psb_int_swap_tag p2ptag = psb_int_swap_tag
!!$
!!$ if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
!!$ if (usersend) then if (usersend) then
!!$ call mpi_rsend(sndbuf(snd_pt),nesd,& call mpi_rsend(sndbuf(snd_pt),nesd,&
!!$ & psb_mpi_ipk_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag,icomm,iret) & p2ptag,icomm,iret)
!!$ else else
!!$ call mpi_send(sndbuf(snd_pt),nesd,& call mpi_send(sndbuf(snd_pt),nesd,&
!!$ & psb_mpi_ipk_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag,icomm,iret) & p2ptag,icomm,iret)
!!$ end if end if
!!$
!!$ if(iret /= mpi_success) then if(iret /= mpi_success) then
!!$ ierr(1) = iret ierr(1) = iret
!!$ info=psb_err_mpi_error_ info=psb_err_mpi_error_
!!$ call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,i_err=ierr)
!!$ goto 9999 goto 9999
!!$ end if end if
!!$ end if end if
!!$ rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
!!$ snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$ end do end do
!!$
!!$
!!$ pnti = 1 pnti = 1
!!$ do i=1, totxch do i=1, totxch
!!$ proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$
!!$ p2ptag = psb_int_swap_tag p2ptag = psb_int_swap_tag
!!$
!!$ if ((proc_to_comm /= me).and.(nerv>0)) then if ((proc_to_comm /= me).and.(nerv>0)) then
!!$ call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
!!$ if(iret /= mpi_success) then if(iret /= mpi_success) then
!!$ ierr(1) = iret ierr(1) = iret
!!$ info=psb_err_mpi_error_ info=psb_err_mpi_error_
!!$ call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,i_err=ierr)
!!$ goto 9999 goto 9999
!!$ end if end if
!!$ else if (proc_to_comm == me) then else if (proc_to_comm == me) then
!!$ if (nesd /= nerv) then if (nesd /= nerv) then
!!$ write(psb_err_unit,*) & write(psb_err_unit,*) &
!!$ & 'Fatal error in swapdata: mismatch on self send',& & 'Fatal error in swapdata: mismatch on self send',&
!!$ & nerv,nesd & nerv,nesd
!!$ end if end if
!!$ rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1) rcvbuf(rcv_pt:rcv_pt+nerv-1) = sndbuf(snd_pt:snd_pt+nesd-1)
!!$ end if end if
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$ end do end do
!!$
!!$
!!$ else if (swap_send) then else if (swap_send) then
!!$
!!$ pnti = 1 pnti = 1
!!$ snd_pt = 1 snd_pt = 1
!!$ rcv_pt = 1 rcv_pt = 1
!!$ do i=1, totxch do i=1, totxch
!!$ proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$ if (nesd>0) call psb_snd(ictxt,& if (nesd>0) call psb_snd(ictxt,&
!!$ & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
!!$ rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
!!$ snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$ end do end do
!!$
!!$ else if (swap_recv) then else if (swap_recv) then
!!$
!!$ pnti = 1 pnti = 1
!!$ snd_pt = 1 snd_pt = 1
!!$ rcv_pt = 1 rcv_pt = 1
!!$ do i=1, totxch do i=1, totxch
!!$ proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$ if (nerv>0) call psb_rcv(ictxt,& if (nerv>0) call psb_rcv(ictxt,&
!!$ & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
!!$ rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
!!$ snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$ end do end do
!!$
!!$ end if end if
!!$
!!$ if (do_recv) then if (do_recv) then
!!$
!!$ pnti = 1 pnti = 1
!!$ snd_pt = 1 snd_pt = 1
!!$ rcv_pt = 1 rcv_pt = 1
!!$ do i=1, totxch do i=1, totxch
!!$ proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$ idx_pt = 1+pnti+psb_n_elem_recv_ idx_pt = 1+pnti+psb_n_elem_recv_
!!$ call y%sct(nerv,idx(idx_pt:idx_pt+nerv-1),& call y%sct(nerv,idx(idx_pt:idx_pt+nerv-1),&
!!$ & rcvbuf(rcv_pt:rcv_pt+nerv-1),beta) & rcvbuf(rcv_pt:rcv_pt+nerv-1),beta)
!!$ rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
!!$ snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$ end do end do
!!$
!!$ end if end if
!!$
!!$ if (swap_mpi) then if (swap_mpi) then
!!$ deallocate(sdsz,rvsz,bsdidx,brvidx,rvhd,prcid,sdhd,& deallocate(sdsz,rvsz,bsdidx,brvidx,rvhd,prcid,sdhd,&
!!$ & stat=info) & stat=info)
!!$ else else
!!$ deallocate(rvhd,prcid,stat=info) deallocate(rvhd,prcid,stat=info)
!!$ end if end if
!!$ if(info /= psb_success_) then if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
!!$ goto 9999 goto 9999
!!$ end if end if
!!$ if(albf) deallocate(sndbuf,rcvbuf,stat=info) if(albf) deallocate(sndbuf,rcvbuf,stat=info)
!!$ if(info /= psb_success_) then if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
!!$ goto 9999 goto 9999
!!$ end if end if
!!$
!!$ call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
!!$ return return
!!$
!!$9999 continue 9999 continue
!!$ call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
!!$ if (err_act == psb_act_abort_) then if (err_act == psb_act_abort_) then
!!$ call psb_error(ictxt) call psb_error(ictxt)
!!$ return return
!!$ end if end if
!!$ return return
!!$end subroutine psi_iswapidx_vect end subroutine psi_iswapidx_vect
!!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -1041,453 +1041,453 @@ subroutine psi_itranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
end subroutine psi_itranidxv end subroutine psi_itranidxv
!!$subroutine psi_iswaptran_vect(flag,beta,y,desc_a,work,info,data) subroutine psi_iswaptran_vect(flag,beta,y,desc_a,work,info,data)
!!$
!!$ use psi_mod, psb_protect_name => psi_iswaptran_vect use psi_mod, psb_protect_name => psi_iswaptran_vect
!!$ use psb_error_mod use psb_error_mod
!!$ use psb_descriptor_type use psb_descriptor_type
!!$ use psb_penv_mod use psb_penv_mod
!!$ use psb_i_base_vect_mod use psb_i_base_vect_mod
!!$#ifdef MPI_MOD #ifdef MPI_MOD
!!$ use mpi use mpi
!!$#endif #endif
!!$ implicit none implicit none
!!$#ifdef MPI_H #ifdef MPI_H
!!$ include 'mpif.h' include 'mpif.h'
!!$#endif #endif
!!$
!!$ integer(psb_ipk_), intent(in) :: flag integer(psb_ipk_), intent(in) :: flag
!!$ integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
!!$ class(psb_i_base_vect_type) :: y class(psb_i_base_vect_type) :: y
!!$ integer(psb_ipk_) :: beta integer(psb_ipk_) :: beta
!!$ integer(psb_ipk_), target :: work(:) integer(psb_ipk_), target :: work(:)
!!$ type(psb_desc_type),target :: desc_a type(psb_desc_type),target :: desc_a
!!$ integer(psb_ipk_), optional :: data integer(psb_ipk_), optional :: data
!!$
!!$ ! locals ! locals
!!$ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_ integer(psb_ipk_) :: ictxt, np, me, icomm, idxs, idxr, totxch, err_act, data_
!!$ integer(psb_ipk_), pointer :: d_idx(:) integer(psb_ipk_), pointer :: d_idx(:)
!!$ integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
!!$ character(len=20) :: name character(len=20) :: name
!!$
!!$ info=psb_success_ info=psb_success_
!!$ name='psi_swap_tranv' name='psi_swap_tranv'
!!$ call psb_erractionsave(err_act) call psb_erractionsave(err_act)
!!$
!!$ ictxt = desc_a%get_context() ictxt = desc_a%get_context()
!!$ icomm = desc_a%get_mpic() icomm = desc_a%get_mpic()
!!$ call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
!!$ if (np == -1) then if (np == -1) then
!!$ info=psb_err_context_error_ info=psb_err_context_error_
!!$ call psb_errpush(info,name) call psb_errpush(info,name)
!!$ goto 9999 goto 9999
!!$ endif endif
!!$
!!$ if (.not.psb_is_asb_desc(desc_a)) then if (.not.psb_is_asb_desc(desc_a)) then
!!$ info=psb_err_invalid_cd_state_ info=psb_err_invalid_cd_state_
!!$ call psb_errpush(info,name) call psb_errpush(info,name)
!!$ goto 9999 goto 9999
!!$ endif endif
!!$
!!$ if (present(data)) then if (present(data)) then
!!$ data_ = data data_ = data
!!$ else else
!!$ data_ = psb_comm_halo_ data_ = psb_comm_halo_
!!$ end if end if
!!$
!!$ call desc_a%get_list(data_,d_idx,totxch,idxr,idxs,info) call desc_a%get_list(data_,d_idx,totxch,idxr,idxs,info)
!!$ if (info /= psb_success_) then if (info /= psb_success_) then
!!$ call psb_errpush(psb_err_internal_error_,name,a_err='psb_cd_get_list') call psb_errpush(psb_err_internal_error_,name,a_err='psb_cd_get_list')
!!$ goto 9999 goto 9999
!!$ end if end if
!!$
!!$ call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info) call psi_swaptran(ictxt,icomm,flag,beta,y,d_idx,totxch,idxs,idxr,work,info)
!!$ if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
!!$
!!$ call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
!!$ return return
!!$
!!$9999 continue 9999 continue
!!$ call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
!!$ if (err_act == psb_act_abort_) then if (err_act == psb_act_abort_) then
!!$ call psb_error(ictxt) call psb_error(ictxt)
!!$ return return
!!$ end if end if
!!$ return return
!!$end subroutine psi_iswaptran_vect end subroutine psi_iswaptran_vect
!!$
!!$
!!$
!!$subroutine psi_itranidx_vect(iictxt,iicomm,flag,beta,y,idx,& subroutine psi_itranidx_vect(iictxt,iicomm,flag,beta,y,idx,&
!!$ & totxch,totsnd,totrcv,work,info) & totxch,totsnd,totrcv,work,info)
!!$
!!$ use psi_mod, psb_protect_name => psi_itranidx_vect use psi_mod, psb_protect_name => psi_itranidx_vect
!!$ use psb_error_mod use psb_error_mod
!!$ use psb_descriptor_type use psb_descriptor_type
!!$ use psb_penv_mod use psb_penv_mod
!!$ use psb_i_base_vect_mod use psb_i_base_vect_mod
!!$#ifdef MPI_MOD #ifdef MPI_MOD
!!$ use mpi use mpi
!!$#endif #endif
!!$ implicit none implicit none
!!$#ifdef MPI_H #ifdef MPI_H
!!$ include 'mpif.h' include 'mpif.h'
!!$#endif #endif
!!$
!!$ integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag
!!$ integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
!!$ class(psb_i_base_vect_type) :: y class(psb_i_base_vect_type) :: y
!!$ integer(psb_ipk_) :: beta integer(psb_ipk_) :: beta
!!$ integer(psb_ipk_), target :: work(:) integer(psb_ipk_), target :: work(:)
!!$ integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd, totrcv
!!$
!!$ ! locals ! locals
!!$ integer(psb_mpik_) :: ictxt, icomm, np, me,& integer(psb_mpik_) :: ictxt, icomm, np, me,&
!!$ & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret & proc_to_comm, p2ptag, p2pstat(mpi_status_size), iret
!!$ integer(psb_mpik_), allocatable, dimension(:) :: bsdidx, brvidx,& integer(psb_mpik_), allocatable, dimension(:) :: bsdidx, brvidx,&
!!$ & sdsz, rvsz, prcid, rvhd, sdhd & sdsz, rvsz, prcid, rvhd, sdhd
!!$ integer(psb_ipk_) :: nesd, nerv,& integer(psb_ipk_) :: nesd, nerv,&
!!$ & err_act, i, idx_pt, totsnd_, totrcv_,& & err_act, i, idx_pt, totsnd_, totrcv_,&
!!$ & snd_pt, rcv_pt, pnti, n & snd_pt, rcv_pt, pnti, n
!!$ integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
!!$ logical :: swap_mpi, swap_sync, swap_send, swap_recv,& logical :: swap_mpi, swap_sync, swap_send, swap_recv,&
!!$ & albf,do_send,do_recv & albf,do_send,do_recv
!!$ logical, parameter :: usersend=.false. logical, parameter :: usersend=.false.
!!$
!!$ integer(psb_ipk_), pointer, dimension(:) :: sndbuf, rcvbuf integer(psb_ipk_), pointer, dimension(:) :: sndbuf, rcvbuf
!!$#ifdef HAVE_VOLATILE #ifdef HAVE_VOLATILE
!!$ volatile :: sndbuf, rcvbuf volatile :: sndbuf, rcvbuf
!!$#endif #endif
!!$ character(len=20) :: name character(len=20) :: name
!!$
!!$ info=psb_success_ info=psb_success_
!!$ name='psi_swap_tran' name='psi_swap_tran'
!!$ call psb_erractionsave(err_act) call psb_erractionsave(err_act)
!!$ ictxt = iictxt ictxt = iictxt
!!$ icomm = iicomm icomm = iicomm
!!$
!!$ call psb_info(ictxt,me,np) call psb_info(ictxt,me,np)
!!$ if (np == -1) then if (np == -1) then
!!$ info=psb_err_context_error_ info=psb_err_context_error_
!!$ call psb_errpush(info,name) call psb_errpush(info,name)
!!$ goto 9999 goto 9999
!!$ endif endif
!!$
!!$ n=1 n=1
!!$ swap_mpi = iand(flag,psb_swap_mpi_) /= 0 swap_mpi = iand(flag,psb_swap_mpi_) /= 0
!!$ swap_sync = iand(flag,psb_swap_sync_) /= 0 swap_sync = iand(flag,psb_swap_sync_) /= 0
!!$ swap_send = iand(flag,psb_swap_send_) /= 0 swap_send = iand(flag,psb_swap_send_) /= 0
!!$ swap_recv = iand(flag,psb_swap_recv_) /= 0 swap_recv = iand(flag,psb_swap_recv_) /= 0
!!$ do_send = swap_mpi .or. swap_sync .or. swap_send do_send = swap_mpi .or. swap_sync .or. swap_send
!!$ do_recv = swap_mpi .or. swap_sync .or. swap_recv do_recv = swap_mpi .or. swap_sync .or. swap_recv
!!$
!!$ totrcv_ = totrcv * n totrcv_ = totrcv * n
!!$ totsnd_ = totsnd * n totsnd_ = totsnd * n
!!$
!!$ if (swap_mpi) then if (swap_mpi) then
!!$ allocate(sdsz(0:np-1), rvsz(0:np-1), bsdidx(0:np-1),& allocate(sdsz(0:np-1), rvsz(0:np-1), bsdidx(0:np-1),&
!!$ & brvidx(0:np-1), rvhd(0:np-1), sdhd(0:np-1), prcid(0:np-1),& & brvidx(0:np-1), rvhd(0:np-1), sdhd(0:np-1), prcid(0:np-1),&
!!$ & stat=info) & stat=info)
!!$ if(info /= psb_success_) then if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
!!$ goto 9999 goto 9999
!!$ end if end if
!!$
!!$ rvhd(:) = mpi_request_null rvhd(:) = mpi_request_null
!!$ sdsz(:) = 0 sdsz(:) = 0
!!$ rvsz(:) = 0 rvsz(:) = 0
!!$
!!$ ! prepare info for communications ! prepare info for communications
!!$
!!$
!!$ pnti = 1 pnti = 1
!!$ snd_pt = 1 snd_pt = 1
!!$ rcv_pt = 1 rcv_pt = 1
!!$ do i=1, totxch do i=1, totxch
!!$ proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$ call psb_get_rank(prcid(proc_to_comm),ictxt,proc_to_comm) call psb_get_rank(prcid(proc_to_comm),ictxt,proc_to_comm)
!!$
!!$ brvidx(proc_to_comm) = rcv_pt brvidx(proc_to_comm) = rcv_pt
!!$ rvsz(proc_to_comm) = nerv rvsz(proc_to_comm) = nerv
!!$
!!$ bsdidx(proc_to_comm) = snd_pt bsdidx(proc_to_comm) = snd_pt
!!$ sdsz(proc_to_comm) = nesd sdsz(proc_to_comm) = nesd
!!$
!!$ rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
!!$ snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$
!!$ end do end do
!!$
!!$ else else
!!$ allocate(rvhd(totxch),prcid(totxch),stat=info) allocate(rvhd(totxch),prcid(totxch),stat=info)
!!$ if(info /= psb_success_) then if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
!!$ goto 9999 goto 9999
!!$ end if end if
!!$ end if end if
!!$
!!$
!!$ totrcv_ = max(totrcv_,1) totrcv_ = max(totrcv_,1)
!!$ totsnd_ = max(totsnd_,1) totsnd_ = max(totsnd_,1)
!!$ if((totrcv_+totsnd_) < size(work)) then if((totrcv_+totsnd_) < size(work)) then
!!$ sndbuf => work(1:totsnd_) sndbuf => work(1:totsnd_)
!!$ rcvbuf => work(totsnd_+1:totsnd_+totrcv_) rcvbuf => work(totsnd_+1:totsnd_+totrcv_)
!!$ albf=.false. albf=.false.
!!$ else else
!!$ allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info) allocate(sndbuf(totsnd_),rcvbuf(totrcv_), stat=info)
!!$ if(info /= psb_success_) then if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
!!$ goto 9999 goto 9999
!!$ end if end if
!!$ albf=.true. albf=.true.
!!$ end if end if
!!$
!!$
!!$ if (do_send) then if (do_send) then
!!$
!!$ ! Pack send buffers ! Pack send buffers
!!$ pnti = 1 pnti = 1
!!$ snd_pt = 1 snd_pt = 1
!!$ rcv_pt = 1 rcv_pt = 1
!!$ do i=1, totxch do i=1, totxch
!!$ proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$ idx_pt = 1+pnti+psb_n_elem_recv_ idx_pt = 1+pnti+psb_n_elem_recv_
!!$
!!$ call y%gth(nerv,idx(idx_pt:idx_pt+nerv-1),& call y%gth(nerv,idx(idx_pt:idx_pt+nerv-1),&
!!$ & rcvbuf(rcv_pt:rcv_pt+nerv-1)) & rcvbuf(rcv_pt:rcv_pt+nerv-1))
!!$
!!$ rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
!!$ snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$ end do end do
!!$
!!$ end if end if
!!$
!!$ ! Case SWAP_MPI ! Case SWAP_MPI
!!$ if (swap_mpi) then if (swap_mpi) then
!!$
!!$ ! swap elements using mpi_alltoallv ! swap elements using mpi_alltoallv
!!$ call mpi_alltoallv(rcvbuf,rvsz,brvidx,& call mpi_alltoallv(rcvbuf,rvsz,brvidx,&
!!$ & psb_mpi_ipk_integer,& & psb_mpi_ipk_integer,&
!!$ & sndbuf,sdsz,bsdidx,psb_mpi_ipk_integer,icomm,iret) & sndbuf,sdsz,bsdidx,psb_mpi_ipk_integer,icomm,iret)
!!$ if(iret /= mpi_success) then if(iret /= mpi_success) then
!!$ ierr(1) = iret ierr(1) = iret
!!$ info=psb_err_mpi_error_ info=psb_err_mpi_error_
!!$ call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,i_err=ierr)
!!$ goto 9999 goto 9999
!!$ end if end if
!!$
!!$ else if (swap_sync) then else if (swap_sync) then
!!$
!!$ pnti = 1 pnti = 1
!!$ snd_pt = 1 snd_pt = 1
!!$ rcv_pt = 1 rcv_pt = 1
!!$ do i=1, totxch do i=1, totxch
!!$ proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$
!!$ if (proc_to_comm < me) then if (proc_to_comm < me) then
!!$ if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ictxt,&
!!$ & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
!!$ if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ictxt,&
!!$ & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
!!$ else if (proc_to_comm > me) then else if (proc_to_comm > me) then
!!$ if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ictxt,&
!!$ & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
!!$ if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ictxt,&
!!$ & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
!!$ else if (proc_to_comm == me) then else if (proc_to_comm == me) then
!!$ if (nesd /= nerv) then if (nesd /= nerv) then
!!$ write(psb_err_unit,*) & write(psb_err_unit,*) &
!!$ & 'Fatal error in swaptran: mismatch on self send',& & 'Fatal error in swaptran: mismatch on self send',&
!!$ & nerv,nesd & nerv,nesd
!!$ end if end if
!!$ sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1) sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1)
!!$ end if end if
!!$ rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
!!$ snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$
!!$ end do end do
!!$
!!$
!!$ else if (swap_send .and. swap_recv) then else if (swap_send .and. swap_recv) then
!!$
!!$ ! First I post all the non blocking receives ! First I post all the non blocking receives
!!$ pnti = 1 pnti = 1
!!$ snd_pt = 1 snd_pt = 1
!!$ rcv_pt = 1 rcv_pt = 1
!!$ do i=1, totxch do i=1, totxch
!!$ proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$ call psb_get_rank(prcid(i),ictxt,proc_to_comm) call psb_get_rank(prcid(i),ictxt,proc_to_comm)
!!$ if ((nesd>0).and.(proc_to_comm /= me)) then if ((nesd>0).and.(proc_to_comm /= me)) then
!!$ p2ptag = psb_int_swap_tag p2ptag = psb_int_swap_tag
!!$ call mpi_irecv(sndbuf(snd_pt),nesd,& call mpi_irecv(sndbuf(snd_pt),nesd,&
!!$ & psb_mpi_ipk_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag,icomm,rvhd(i),iret) & p2ptag,icomm,rvhd(i),iret)
!!$ end if end if
!!$ rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
!!$ snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$ end do end do
!!$
!!$
!!$ ! Then I post all the blocking sends ! Then I post all the blocking sends
!!$ if (usersend) call mpi_barrier(icomm,iret) if (usersend) call mpi_barrier(icomm,iret)
!!$
!!$ pnti = 1 pnti = 1
!!$ snd_pt = 1 snd_pt = 1
!!$ rcv_pt = 1 rcv_pt = 1
!!$ do i=1, totxch do i=1, totxch
!!$ proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$
!!$ if ((nerv>0).and.(proc_to_comm /= me)) then if ((nerv>0).and.(proc_to_comm /= me)) then
!!$ p2ptag = psb_int_swap_tag p2ptag = psb_int_swap_tag
!!$ if (usersend) then if (usersend) then
!!$ call mpi_rsend(rcvbuf(rcv_pt),nerv,& call mpi_rsend(rcvbuf(rcv_pt),nerv,&
!!$ & psb_mpi_ipk_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag, icomm,iret) & p2ptag, icomm,iret)
!!$ else else
!!$ call mpi_send(rcvbuf(rcv_pt),nerv,& call mpi_send(rcvbuf(rcv_pt),nerv,&
!!$ & psb_mpi_ipk_integer,prcid(i),& & psb_mpi_ipk_integer,prcid(i),&
!!$ & p2ptag, icomm,iret) & p2ptag, icomm,iret)
!!$ end if end if
!!$
!!$ if(iret /= mpi_success) then if(iret /= mpi_success) then
!!$ ierr(1) = iret ierr(1) = iret
!!$ info=psb_err_mpi_error_ info=psb_err_mpi_error_
!!$ call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,i_err=ierr)
!!$ goto 9999 goto 9999
!!$ end if end if
!!$ end if end if
!!$ rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
!!$ snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$
!!$ end do end do
!!$
!!$
!!$ pnti = 1 pnti = 1
!!$ do i=1, totxch do i=1, totxch
!!$ proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$ p2ptag = psb_int_swap_tag p2ptag = psb_int_swap_tag
!!$
!!$ if ((proc_to_comm /= me).and.(nesd>0)) then if ((proc_to_comm /= me).and.(nesd>0)) then
!!$ call mpi_wait(rvhd(i),p2pstat,iret) call mpi_wait(rvhd(i),p2pstat,iret)
!!$ if(iret /= mpi_success) then if(iret /= mpi_success) then
!!$ ierr(1) = iret ierr(1) = iret
!!$ info=psb_err_mpi_error_ info=psb_err_mpi_error_
!!$ call psb_errpush(info,name,i_err=ierr) call psb_errpush(info,name,i_err=ierr)
!!$ goto 9999 goto 9999
!!$ end if end if
!!$ else if (proc_to_comm == me) then else if (proc_to_comm == me) then
!!$ if (nesd /= nerv) then if (nesd /= nerv) then
!!$ write(psb_err_unit,*) & write(psb_err_unit,*) &
!!$ & 'Fatal error in swaptran: mismatch on self send', & & 'Fatal error in swaptran: mismatch on self send', &
!!$ & nerv,nesd & nerv,nesd
!!$ end if end if
!!$ sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1) sndbuf(snd_pt:snd_pt+nesd-1) = rcvbuf(rcv_pt:rcv_pt+nerv-1)
!!$ end if end if
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$ end do end do
!!$
!!$
!!$ else if (swap_send) then else if (swap_send) then
!!$
!!$ pnti = 1 pnti = 1
!!$ snd_pt = 1 snd_pt = 1
!!$ rcv_pt = 1 rcv_pt = 1
!!$ do i=1, totxch do i=1, totxch
!!$ proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$ if (nerv>0) call psb_snd(ictxt,& if (nerv>0) call psb_snd(ictxt,&
!!$ & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm) & rcvbuf(rcv_pt:rcv_pt+nerv-1), proc_to_comm)
!!$ rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
!!$ snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$
!!$ end do end do
!!$
!!$ else if (swap_recv) then else if (swap_recv) then
!!$
!!$ pnti = 1 pnti = 1
!!$ snd_pt = 1 snd_pt = 1
!!$ rcv_pt = 1 rcv_pt = 1
!!$ do i=1, totxch do i=1, totxch
!!$ proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$ if (nesd>0) call psb_rcv(ictxt,& if (nesd>0) call psb_rcv(ictxt,&
!!$ & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm) & sndbuf(snd_pt:snd_pt+nesd-1), proc_to_comm)
!!$ rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
!!$ snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$
!!$ end do end do
!!$
!!$ end if end if
!!$
!!$
!!$ if (do_recv) then if (do_recv) then
!!$
!!$ pnti = 1 pnti = 1
!!$ snd_pt = 1 snd_pt = 1
!!$ rcv_pt = 1 rcv_pt = 1
!!$ do i=1, totxch do i=1, totxch
!!$ proc_to_comm = idx(pnti+psb_proc_id_) proc_to_comm = idx(pnti+psb_proc_id_)
!!$ nerv = idx(pnti+psb_n_elem_recv_) nerv = idx(pnti+psb_n_elem_recv_)
!!$ nesd = idx(pnti+nerv+psb_n_elem_send_) nesd = idx(pnti+nerv+psb_n_elem_send_)
!!$ idx_pt = 1+pnti+nerv+psb_n_elem_send_ idx_pt = 1+pnti+nerv+psb_n_elem_send_
!!$ call y%sct(nesd,idx(idx_pt:idx_pt+nesd-1),& call y%sct(nesd,idx(idx_pt:idx_pt+nesd-1),&
!!$ & sndbuf(snd_pt:snd_pt+nesd-1),beta) & sndbuf(snd_pt:snd_pt+nesd-1),beta)
!!$ rcv_pt = rcv_pt + nerv rcv_pt = rcv_pt + nerv
!!$ snd_pt = snd_pt + nesd snd_pt = snd_pt + nesd
!!$ pnti = pnti + nerv + nesd + 3 pnti = pnti + nerv + nesd + 3
!!$ end do end do
!!$
!!$ end if end if
!!$
!!$
!!$ if (swap_mpi) then if (swap_mpi) then
!!$ deallocate(sdsz,rvsz,bsdidx,brvidx,rvhd,prcid,sdhd,& deallocate(sdsz,rvsz,bsdidx,brvidx,rvhd,prcid,sdhd,&
!!$ & stat=info) & stat=info)
!!$ else else
!!$ deallocate(rvhd,prcid,stat=info) deallocate(rvhd,prcid,stat=info)
!!$ end if end if
!!$ if(info /= psb_success_) then if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
!!$ goto 9999 goto 9999
!!$ end if end if
!!$ if(albf) deallocate(sndbuf,rcvbuf,stat=info) if(albf) deallocate(sndbuf,rcvbuf,stat=info)
!!$ if(info /= psb_success_) then if(info /= psb_success_) then
!!$ call psb_errpush(psb_err_alloc_dealloc_,name) call psb_errpush(psb_err_alloc_dealloc_,name)
!!$ goto 9999 goto 9999
!!$ end if end if
!!$
!!$ call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
!!$ return return
!!$
!!$9999 continue 9999 continue
!!$ call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
!!$ if (err_act == psb_act_abort_) then if (err_act == psb_act_abort_) then
!!$ call psb_error(ictxt) call psb_error(ictxt)
!!$ return return
!!$ end if end if
!!$ return return
!!$end subroutine psi_itranidx_vect end subroutine psi_itranidx_vect
!!$
!!$
!!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
C C
C Parallel Sparse BLAS version 3.0 C Parallel Sparse BLAS version 3.0
C (C) Copyright 2006, 2007, 2008, 2009, 2010 C (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
C Salvatore Filippone University of Rome Tor Vergata C Salvatore Filippone University of Rome Tor Vergata
C Alfredo Buttari CNRS-IRIT, Toulouse C Alfredo Buttari CNRS-IRIT, Toulouse
C C

@ -13,6 +13,7 @@ UTIL_MODS = psb_string_mod.o psb_desc_const_mod.o psb_indx_map_mod.o\
psb_s_linmap_mod.o psb_d_linmap_mod.o psb_c_linmap_mod.o psb_z_linmap_mod.o \ psb_s_linmap_mod.o psb_d_linmap_mod.o psb_c_linmap_mod.o psb_z_linmap_mod.o \
psb_comm_mod.o psb_i_comm_mod.o psb_s_comm_mod.o psb_d_comm_mod.o\ psb_comm_mod.o psb_i_comm_mod.o psb_s_comm_mod.o psb_d_comm_mod.o\
psb_c_comm_mod.o psb_z_comm_mod.o \ psb_c_comm_mod.o psb_z_comm_mod.o \
psb_i_base_vect_mod.o psb_i_vect_mod.o\
psb_d_base_vect_mod.o psb_d_vect_mod.o\ psb_d_base_vect_mod.o psb_d_vect_mod.o\
psb_s_base_vect_mod.o psb_s_vect_mod.o\ psb_s_base_vect_mod.o psb_s_vect_mod.o\
psb_c_base_vect_mod.o psb_c_vect_mod.o\ psb_c_base_vect_mod.o psb_c_vect_mod.o\
@ -62,7 +63,7 @@ psb_s_base_mat_mod.o: psb_s_base_vect_mod.o
psb_d_base_mat_mod.o: psb_d_base_vect_mod.o psb_d_base_mat_mod.o: psb_d_base_vect_mod.o
psb_c_base_mat_mod.o: psb_c_base_vect_mod.o psb_c_base_mat_mod.o: psb_c_base_vect_mod.o
psb_z_base_mat_mod.o: psb_z_base_vect_mod.o psb_z_base_mat_mod.o: psb_z_base_vect_mod.o
psb_c_base_vect_mod.o psb_s_base_vect_mod.o psb_d_base_vect_mod.o psb_z_base_vect_mod.o: psi_serial_mod.o psb_realloc_mod.o psb_i_base_vect_mod.o psb_c_base_vect_mod.o psb_s_base_vect_mod.o psb_d_base_vect_mod.o psb_z_base_vect_mod.o: psi_serial_mod.o psb_realloc_mod.o
psb_s_mat_mod.o: psb_s_base_mat_mod.o psb_s_csr_mat_mod.o psb_s_csc_mat_mod.o psb_s_vect_mod.o psb_s_mat_mod.o: psb_s_base_mat_mod.o psb_s_csr_mat_mod.o psb_s_csc_mat_mod.o psb_s_vect_mod.o
psb_d_mat_mod.o: psb_d_base_mat_mod.o psb_d_csr_mat_mod.o psb_d_csc_mat_mod.o psb_d_vect_mod.o psb_d_mat_mod.o: psb_d_base_mat_mod.o psb_d_csr_mat_mod.o psb_d_csc_mat_mod.o psb_d_vect_mod.o
psb_c_mat_mod.o: psb_c_base_mat_mod.o psb_c_csr_mat_mod.o psb_c_csc_mat_mod.o psb_c_vect_mod.o psb_c_mat_mod.o: psb_c_base_mat_mod.o psb_c_csr_mat_mod.o psb_c_csc_mat_mod.o psb_c_vect_mod.o
@ -75,11 +76,11 @@ psb_mat_mod.o: psb_vect_mod.o psb_s_mat_mod.o psb_d_mat_mod.o psb_c_mat_mod.o ps
error.o psb_realloc_mod.o: psb_error_mod.o error.o psb_realloc_mod.o: psb_error_mod.o
psb_error_impl.o: psb_penv_mod.o psb_error_impl.o: psb_penv_mod.o
psb_spmat_type.o: psb_string_mod.o psb_sort_mod.o psb_spmat_type.o: psb_string_mod.o psb_sort_mod.o
psi_i_mod.o: psb_desc_type.o psi_i_mod.o: psb_desc_type.o psb_i_vect_mod.o
psi_s_mod.o: psb_desc_type.o psb_s_base_vect_mod.o psi_s_mod.o: psb_desc_type.o psb_s_vect_mod.o
psi_d_mod.o: psb_desc_type.o psb_d_base_vect_mod.o psi_d_mod.o: psb_desc_type.o psb_d_vect_mod.o
psi_c_mod.o: psb_desc_type.o psb_c_base_vect_mod.o psi_c_mod.o: psb_desc_type.o psb_c_vect_mod.o
psi_z_mod.o: psb_desc_type.o psb_z_base_vect_mod.o psi_z_mod.o: psb_desc_type.o psb_z_vect_mod.o
psi_mod.o: psb_penv_mod.o psb_desc_type.o psi_serial_mod.o psb_serial_mod.o\ psi_mod.o: psb_penv_mod.o psb_desc_type.o psi_serial_mod.o psb_serial_mod.o\
psi_i_mod.o psi_s_mod.o psi_d_mod.o psi_c_mod.o psi_z_mod.o psi_i_mod.o psi_s_mod.o psi_d_mod.o psi_c_mod.o psi_z_mod.o
psb_desc_type.o: psb_penv_mod.o psb_realloc_mod.o\ psb_desc_type.o: psb_penv_mod.o psb_realloc_mod.o\
@ -103,6 +104,7 @@ psb_base_linmap_mod.o: psb_desc_type.o psb_serial_mod.o psb_comm_mod.o
psb_comm_mod.o: psb_desc_type.o psb_mat_mod.o psb_comm_mod.o: psb_desc_type.o psb_mat_mod.o
psb_check_mod.o: psb_desc_type.o psb_check_mod.o: psb_desc_type.o
psb_serial_mod.o: psb_mat_mod.o psb_string_mod.o psb_sort_mod.o psi_serial_mod.o psb_serial_mod.o: psb_mat_mod.o psb_string_mod.o psb_sort_mod.o psi_serial_mod.o
psb_i_vect_mod.o: psb_i_base_vect_mod.o
psb_s_vect_mod.o: psb_s_base_vect_mod.o psb_s_vect_mod.o: psb_s_base_vect_mod.o
psb_d_vect_mod.o: psb_d_base_vect_mod.o psb_d_vect_mod.o: psb_d_base_vect_mod.o
psb_c_vect_mod.o: psb_c_base_vect_mod.o psb_c_vect_mod.o: psb_c_base_vect_mod.o
@ -123,7 +125,7 @@ psb_psblas_mod.o: psb_s_psblas_mod.o psb_c_psblas_mod.o psb_d_psblas_mod.o psb_
psb_s_psblas_mod.o psb_c_psblas_mod.o psb_d_psblas_mod.o psb_z_psblas_mod.o: psb_mat_mod.o psb_desc_type.o psb_s_psblas_mod.o psb_c_psblas_mod.o psb_d_psblas_mod.o psb_z_psblas_mod.o: psb_mat_mod.o psb_desc_type.o
psb_vect_mod.o: psb_d_vect_mod.o psb_s_vect_mod.o psb_c_vect_mod.o psb_z_vect_mod.o psb_vect_mod.o: psb_d_vect_mod.o psb_s_vect_mod.o psb_c_vect_mod.o psb_z_vect_mod.o
psb_comm_mod.o: psb_i_comm_mod.o psb_s_comm_mod.o psb_d_comm_mod.o psb_c_comm_mod.o psb_z_comm_mod.o psb_comm_mod.o: psb_i_comm_mod.o psb_s_comm_mod.o psb_d_comm_mod.o psb_c_comm_mod.o psb_z_comm_mod.o
psb_i_comm_mod.o: psb_desc_type.o psb_i_comm_mod.o: psb_i_vect_mod.o psb_desc_type.o
psb_s_comm_mod.o: psb_s_vect_mod.o psb_desc_type.o psb_mat_mod.o psb_s_comm_mod.o: psb_s_vect_mod.o psb_desc_type.o psb_mat_mod.o
psb_d_comm_mod.o: psb_d_vect_mod.o psb_desc_type.o psb_mat_mod.o psb_d_comm_mod.o: psb_d_vect_mod.o psb_desc_type.o psb_mat_mod.o
psb_c_comm_mod.o: psb_c_vect_mod.o psb_desc_type.o psb_mat_mod.o psb_c_comm_mod.o: psb_c_vect_mod.o psb_desc_type.o psb_mat_mod.o

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -0,0 +1,807 @@
!!$
!!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ 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_i_base_vect_mod
!
! This module contains the definition of the psb_i_base_vect type which
! is a container for dense vectors.
! This is encapsulated instead of being just a simple array to allow for
! more complicated situations, such as GPU programming, where the memory
! area we are interested in is not easily accessible from the host/Fortran
! side. It is also meant to be encapsulated in an outer type, to allow
! runtime switching as per the STATE design pattern, similar to the
! sparse matrix types.
!
!
module psb_i_base_vect_mod
use psb_const_mod
use psb_error_mod
!> \namespace psb_base_mod \class psb_i_base_vect_type
!! The psb_i_base_vect_type
!! defines a middle level integer(psb_ipk_) encapsulated dense vector.
!! The encapsulation is needed, in place of a simple array, to allow
!! for complicated situations, such as GPU programming, where the memory
!! area we are interested in is not easily accessible from the host/Fortran
!! side. It is also meant to be encapsulated in an outer type, to allow
!! runtime switching as per the STATE design pattern, similar to the
!! sparse matrix types.
!!
type psb_i_base_vect_type
integer(psb_ipk_), allocatable :: v(:)
contains
!
! Constructors/allocators
!
procedure, pass(x) :: bld_x => i_base_bld_x
procedure, pass(x) :: bld_n => i_base_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: all => i_base_all
!
! Insert/set. Assembly and free.
! Assembly does almost nothing here, but is important
! in derived classes.
!
procedure, pass(x) :: ins => i_base_ins
procedure, pass(x) :: zero => i_base_zero
procedure, pass(x) :: asb => i_base_asb
procedure, pass(x) :: free => i_base_free
!
! Sync: centerpiece of handling of external storage.
! Any derived class having extra storage upon sync
! will guarantee that both fortran/host side and
! external side contain the same data. The base
! version is only a placeholder.
!
procedure, pass(x) :: sync => i_base_sync
procedure, pass(x) :: is_host => i_base_is_host
procedure, pass(x) :: is_dev => i_base_is_dev
procedure, pass(x) :: is_sync => i_base_is_sync
procedure, pass(x) :: set_host => i_base_set_host
procedure, pass(x) :: set_dev => i_base_set_dev
procedure, pass(x) :: set_sync => i_base_set_sync
!
! Basic info
procedure, pass(x) :: get_nrows => i_base_get_nrows
procedure, pass(x) :: sizeof => i_base_sizeof
!
! Set/get data from/to an external array; also
! overload assignment.
!
procedure, pass(x) :: get_vect => i_base_get_vect
procedure, pass(x) :: set_scal => i_base_set_scal
procedure, pass(x) :: set_vect => i_base_set_vect
generic, public :: set => set_vect, set_scal
!
! Dot product and AXPBY
!
procedure, pass(x) :: dot_v => i_base_dot_v
procedure, pass(x) :: dot_a => i_base_dot_a
generic, public :: dot => dot_v, dot_a
procedure, pass(y) :: axpby_v => i_base_axpby_v
procedure, pass(y) :: axpby_a => i_base_axpby_a
generic, public :: axpby => axpby_v, axpby_a
!
! Vector by vector multiplication. Need all variants
! to handle multiple requirements from preconditioners
!
procedure, pass(y) :: mlt_v => i_base_mlt_v
procedure, pass(y) :: mlt_a => i_base_mlt_a
procedure, pass(z) :: mlt_a_2 => i_base_mlt_a_2
procedure, pass(z) :: mlt_v_2 => i_base_mlt_v_2
procedure, pass(z) :: mlt_va => i_base_mlt_va
procedure, pass(z) :: mlt_av => i_base_mlt_av
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2, mlt_v_2, mlt_av, mlt_va
!
! Scaling and norms
!
procedure, pass(x) :: scal => i_base_scal
procedure, pass(x) :: nrm2 => i_base_nrm2
procedure, pass(x) :: amax => i_base_amax
procedure, pass(x) :: asum => i_base_asum
!
! Gather/scatter. These are needed for MPI interfacing.
! May have to be reworked.
!
procedure, pass(x) :: gthab => i_base_gthab
procedure, pass(x) :: gthzv => i_base_gthzv
generic, public :: gth => gthab, gthzv
procedure, pass(y) :: sctb => i_base_sctb
generic, public :: sct => sctb
end type psb_i_base_vect_type
public :: psb_i_base_vect
private :: constructor, size_const
interface psb_i_base_vect
module procedure constructor, size_const
end interface psb_i_base_vect
contains
!
! Constructors.
!
function constructor(x) result(this)
integer(psb_ipk_) :: x(:)
type(psb_i_base_vect_type) :: this
integer(psb_ipk_) :: info
this%v = x
call this%asb(size(x,kind=psb_ipk_),info)
end function constructor
function size_const(n) result(this)
integer(psb_ipk_), intent(in) :: n
type(psb_i_base_vect_type) :: this
integer(psb_ipk_) :: info
call this%asb(n,info)
end function size_const
!
! Build from a sample
!
subroutine i_base_bld_x(x,this)
use psb_realloc_mod
integer(psb_ipk_), intent(in) :: this(:)
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_) :: info
call psb_realloc(size(this),x%v,info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,'base_vect_bld')
return
end if
x%v(:) = this(:)
end subroutine i_base_bld_x
!
! Create with size, but no initialization
!
subroutine i_base_bld_n(x,n)
use psb_realloc_mod
integer(psb_ipk_), intent(in) :: n
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_) :: info
call psb_realloc(n,x%v,info)
call x%asb(n,info)
end subroutine i_base_bld_n
subroutine i_base_all(n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
integer(psb_ipk_), intent(in) :: n
class(psb_i_base_vect_type), intent(out) :: x
integer(psb_ipk_), intent(out) :: info
call psb_realloc(n,x%v,info)
end subroutine i_base_all
!
! Insert a bunch of values at specified positions.
!
subroutine i_base_ins(n,irl,val,dupl,x,info)
use psi_serial_mod
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n, dupl
integer(psb_ipk_), intent(in) :: irl(:)
integer(psb_ipk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i
info = 0
if (psb_errstatus_fatal()) return
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
else if (n > min(size(irl),size(val))) then
info = psb_err_invalid_input_
else
select case(dupl)
case(psb_dupl_ovwrt_)
do i = 1, n
!loop over all val's rows
! row actual block row
if (irl(i) > 0) then
! this row belongs to me
! copy i-th row of block val in x
x%v(irl(i)) = val(i)
end if
enddo
case(psb_dupl_add_)
do i = 1, n
!loop over all val's rows
if (irl(i) > 0) then
! this row belongs to me
! copy i-th row of block val in x
x%v(irl(i)) = x%v(irl(i)) + val(i)
end if
enddo
case default
info = 321
!!$ call psb_errpush(info,name)
!!$ goto 9999
end select
end if
if (info /= 0) then
call psb_errpush(info,'base_vect_ins')
return
end if
end subroutine i_base_ins
!
subroutine i_base_zero(x)
use psi_serial_mod
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
if (allocated(x%v)) x%v=izero
end subroutine i_base_zero
!
! Assembly.
! For derived classes: after this the vector
! storage is supposed to be in sync.
!
subroutine i_base_asb(n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
integer(psb_ipk_), intent(in) :: n
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (x%get_nrows() < n) &
& call psb_realloc(n,x%v,info)
if (info /= 0) &
& call psb_errpush(psb_err_alloc_dealloc_,'vect_asb')
end subroutine i_base_asb
subroutine i_base_free(x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(x%v)) deallocate(x%v, stat=info)
if (info /= 0) call &
& psb_errpush(psb_err_alloc_dealloc_,'vect_free')
end subroutine i_base_free
!
! The base version of SYNC & friends does nothing, it's just
! a placeholder.
!
subroutine i_base_sync(x)
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
end subroutine i_base_sync
subroutine i_base_set_host(x)
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
end subroutine i_base_set_host
subroutine i_base_set_dev(x)
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
end subroutine i_base_set_dev
subroutine i_base_set_sync(x)
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
end subroutine i_base_set_sync
function i_base_is_dev(x) result(res)
implicit none
class(psb_i_base_vect_type), intent(in) :: x
logical :: res
res = .false.
end function i_base_is_dev
function i_base_is_host(x) result(res)
implicit none
class(psb_i_base_vect_type), intent(in) :: x
logical :: res
res = .true.
end function i_base_is_host
function i_base_is_sync(x) result(res)
implicit none
class(psb_i_base_vect_type), intent(in) :: x
logical :: res
res = .true.
end function i_base_is_sync
!
! Size info.
!
function i_base_get_nrows(x) result(res)
implicit none
class(psb_i_base_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
if (allocated(x%v)) res = size(x%v)
end function i_base_get_nrows
function i_base_sizeof(x) result(res)
implicit none
class(psb_i_base_vect_type), intent(in) :: x
integer(psb_long_int_k_) :: res
! Force 8-byte integers.
res = (1_psb_long_int_k_ * psb_sizeof_int) * x%get_nrows()
end function i_base_sizeof
!
! Two versions of extracting an array: one of them
! overload the assignment.
!
function i_base_get_vect(x) result(res)
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), allocatable :: res(:)
integer(psb_ipk_) :: info
if (.not.allocated(x%v)) return
call x%sync()
allocate(res(x%get_nrows()),stat=info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect')
return
end if
res(:) = x%v(:)
end function i_base_get_vect
!
! Reset all values
!
subroutine i_base_set_scal(x,val)
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_) :: info
x%v = val
end subroutine i_base_set_scal
subroutine i_base_set_vect(x,val)
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: val(:)
integer(psb_ipk_) :: nr
integer(psb_ipk_) :: info
if (allocated(x%v)) then
nr = min(size(x%v),size(val))
x%v(1:nr) = val(1:nr)
else
x%v = val
end if
end subroutine i_base_set_vect
!
! Dot products
!
function i_base_dot_v(n,x,y) result(res)
implicit none
class(psb_i_base_vect_type), intent(inout) :: x, y
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: res
integer(psb_ipk_), external :: idot
res = izero
!
! Note: this is the base implementation.
! When we get here, we are sure that X is of
! TYPE psb_i_base_vect.
! If Y is not, throw the burden on it, implicitly
! calling dot_a
!
select type(yy => y)
type is (psb_i_base_vect_type)
res = idot(n,x%v,1,y%v,1)
class default
res = y%dot(n,x%v)
end select
end function i_base_dot_v
!
! Base workhorse is good old BLAS1
!
function i_base_dot_a(n,x,y) result(res)
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: y(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: res
integer(psb_ipk_), external :: idot
res = idot(n,y,1,x%v,1)
end function i_base_dot_a
!
! AXPBY is invoked via Y, hence the structure below.
!
subroutine i_base_axpby_v(m,alpha, x, beta, y, info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: m
class(psb_i_base_vect_type), intent(inout) :: x
class(psb_i_base_vect_type), intent(inout) :: y
integer(psb_ipk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
select type(xx => x)
type is (psb_i_base_vect_type)
call psb_geaxpby(m,alpha,x%v,beta,y%v,info)
class default
call y%axpby(m,alpha,x%v,beta,info)
end select
end subroutine i_base_axpby_v
subroutine i_base_axpby_a(m,alpha, x, beta, y, info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_ipk_), intent(in) :: x(:)
class(psb_i_base_vect_type), intent(inout) :: y
integer(psb_ipk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
call psb_geaxpby(m,alpha,x,beta,y%v,info)
end subroutine i_base_axpby_a
!
! Multiple variants of two operations:
! Simple multiplication Y(:) = X(:)*Y(:)
! blas-like: Z(:) = alpha*X(:)*Y(:)+beta*Z(:)
!
! Variants expanded according to the dynamic type
! of the involved entities
!
subroutine i_base_mlt_v(x, y, info)
use psi_serial_mod
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
class(psb_i_base_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
select type(xx => x)
type is (psb_i_base_vect_type)
n = min(size(y%v), size(xx%v))
do i=1, n
y%v(i) = y%v(i)*xx%v(i)
end do
class default
call y%mlt(x%v,info)
end select
end subroutine i_base_mlt_v
subroutine i_base_mlt_a(x, y, info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: x(:)
class(psb_i_base_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
n = min(size(y%v), size(x))
do i=1, n
y%v(i) = y%v(i)*x(i)
end do
end subroutine i_base_mlt_a
subroutine i_base_mlt_a_2(alpha,x,y,beta,z,info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: alpha,beta
integer(psb_ipk_), intent(in) :: y(:)
integer(psb_ipk_), intent(in) :: x(:)
class(psb_i_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
n = min(size(z%v), size(x), size(y))
!!$ write(0,*) 'Mlt_a_2: ',n
if (alpha == izero) then
if (beta == ione) then
return
else
do i=1, n
z%v(i) = beta*z%v(i)
end do
end if
else
if (alpha == ione) then
if (beta == izero) then
do i=1, n
z%v(i) = y(i)*x(i)
end do
else if (beta == ione) then
do i=1, n
z%v(i) = z%v(i) + y(i)*x(i)
end do
else
do i=1, n
z%v(i) = beta*z%v(i) + y(i)*x(i)
end do
end if
else if (alpha == -ione) then
if (beta == izero) then
do i=1, n
z%v(i) = -y(i)*x(i)
end do
else if (beta == ione) then
do i=1, n
z%v(i) = z%v(i) - y(i)*x(i)
end do
else
do i=1, n
z%v(i) = beta*z%v(i) - y(i)*x(i)
end do
end if
else
if (beta == izero) then
do i=1, n
z%v(i) = alpha*y(i)*x(i)
end do
else if (beta == ione) then
do i=1, n
z%v(i) = z%v(i) + alpha*y(i)*x(i)
end do
else
do i=1, n
z%v(i) = beta*z%v(i) + alpha*y(i)*x(i)
end do
end if
end if
end if
end subroutine i_base_mlt_a_2
subroutine i_base_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
use psi_serial_mod
use psb_string_mod
implicit none
integer(psb_ipk_), intent(in) :: alpha,beta
class(psb_i_base_vect_type), intent(inout) :: x
class(psb_i_base_vect_type), intent(inout) :: y
class(psb_i_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
character(len=1), intent(in), optional :: conjgx, conjgy
integer(psb_ipk_) :: i, n
logical :: conjgx_, conjgy_
info = 0
if (.not.psb_i_is_complex_) then
call z%mlt(alpha,x%v,y%v,beta,info)
else
conjgx_=.false.
if (present(conjgx)) conjgx_ = (psb_toupper(conjgx)=='C')
conjgy_=.false.
if (present(conjgy)) conjgy_ = (psb_toupper(conjgy)=='C')
if (conjgx_) x%v=(x%v)
if (conjgy_) y%v=(y%v)
call z%mlt(alpha,x%v,y%v,beta,info)
if (conjgx_) x%v=(x%v)
if (conjgy_) y%v=(y%v)
end if
end subroutine i_base_mlt_v_2
subroutine i_base_mlt_av(alpha,x,y,beta,z,info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: alpha,beta
integer(psb_ipk_), intent(in) :: x(:)
class(psb_i_base_vect_type), intent(inout) :: y
class(psb_i_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
call z%mlt(alpha,x,y%v,beta,info)
end subroutine i_base_mlt_av
subroutine i_base_mlt_va(alpha,x,y,beta,z,info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: alpha,beta
integer(psb_ipk_), intent(in) :: y(:)
class(psb_i_base_vect_type), intent(inout) :: x
class(psb_i_base_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
call z%mlt(alpha,y,x,beta,info)
end subroutine i_base_mlt_va
!
! Simple scaling
!
subroutine i_base_scal(alpha, x)
use psi_serial_mod
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent (in) :: alpha
if (allocated(x%v)) x%v = alpha*x%v
end subroutine i_base_scal
!
! Norms 1, 2 and infinity
!
function i_base_nrm2(n,x) result(res)
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: res
integer(psb_ipk_), external :: inrm2
res = inrm2(n,x%v,1)
end function i_base_nrm2
function i_base_amax(n,x) result(res)
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: res
res = maxval(abs(x%v(1:n)))
end function i_base_amax
function i_base_asum(n,x) result(res)
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: res
res = sum(abs(x%v(1:n)))
end function i_base_asum
!
! Gather: Y = beta * Y + alpha * X(IDX(:))
!
subroutine i_base_gthab(n,idx,alpha,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: alpha, beta, y(:)
class(psb_i_base_vect_type) :: x
call x%sync()
call psi_gth(n,idx,alpha,x%v,beta,y)
end subroutine i_base_gthab
!
! shortcut alpha=1 beta=0
!
subroutine i_base_gthzv(n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: y(:)
class(psb_i_base_vect_type) :: x
call x%sync()
call psi_gth(n,idx,x%v,y)
end subroutine i_base_gthzv
!
! Scatter:
! Y(IDX(:)) = beta*Y(IDX(:)) + X(:)
!
subroutine i_base_sctb(n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: beta, x(:)
class(psb_i_base_vect_type) :: y
call y%sync()
call psi_sct(n,idx,x,beta,y%v)
call y%set_host()
end subroutine i_base_sctb
end module psb_i_base_vect_mod

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$
@ -48,7 +48,16 @@ module psb_i_comm_mod
integer(psb_ipk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), intent(inout), optional, target :: work(:)
integer(psb_ipk_), intent(in), optional :: update,mode integer(psb_ipk_), intent(in), optional :: update,mode
end subroutine psb_iovrlv end subroutine psb_iovrlv
end interface subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode)
use psb_descriptor_type
use psb_i_vect_mod
type(psb_i_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(inout), optional, target :: work(:)
integer(psb_ipk_), intent(in), optional :: update,mode
end subroutine psb_iovrl_vect
end interface psb_ovrl
interface psb_halo interface psb_halo
subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data) subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
@ -56,8 +65,8 @@ module psb_i_comm_mod
integer(psb_ipk_), intent(inout), target :: x(:,:) integer(psb_ipk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), intent(in), optional :: alpha integer(psb_ipk_), intent(in), optional :: alpha
integer(psb_ipk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
end subroutine psb_ihalom end subroutine psb_ihalom
@ -66,12 +75,23 @@ module psb_i_comm_mod
integer(psb_ipk_), intent(inout) :: x(:) integer(psb_ipk_), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
real(psb_dpk_), intent(in), optional :: alpha integer(psb_ipk_), intent(in), optional :: alpha
integer(psb_ipk_), intent(inout), optional, target :: work(:) integer(psb_ipk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran character, intent(in), optional :: tran
end subroutine psb_ihalov end subroutine psb_ihalov
end interface subroutine psb_ihalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
use psb_descriptor_type
use psb_i_vect_mod
type(psb_i_vect_type), intent(inout) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: alpha
integer(psb_ipk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran
end subroutine psb_ihalo_vect
end interface psb_halo
interface psb_scatter interface psb_scatter
@ -91,13 +111,24 @@ module psb_i_comm_mod
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_iscatterv end subroutine psb_iscatterv
end interface end interface psb_scatter
interface psb_gather interface psb_gather
!!$ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
! !$ use psb_descriptor_type
! !$ use psb_mat_mod
! !$ implicit none
! !$ type(psb_ispmat_type), intent(inout) :: loca
! !$ type(psb_ispmat_type), intent(out) :: globa
! !$ type(psb_desc_type), intent(in) :: desc_a
! !$ integer(psb_ipk_), intent(out) :: info
! !$ integer(psb_ipk_), intent(in), optional :: root,dupl
! !$ logical, intent(in), optional :: keepnum,keeploc
! !$ end subroutine psb_isp_allgather
subroutine psb_igatherm(globx, locx, desc_a, info, root) subroutine psb_igatherm(globx, locx, desc_a, info, root)
use psb_descriptor_type use psb_descriptor_type
integer(psb_ipk_), intent(in) :: locx(:,:) integer(psb_ipk_), intent(in) :: locx(:,:)
integer(psb_ipk_), intent(out) :: globx(:,:) integer(psb_ipk_), intent(out), allocatable :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
@ -105,11 +136,20 @@ module psb_i_comm_mod
subroutine psb_igatherv(globx, locx, desc_a, info, root) subroutine psb_igatherv(globx, locx, desc_a, info, root)
use psb_descriptor_type use psb_descriptor_type
integer(psb_ipk_), intent(in) :: locx(:) integer(psb_ipk_), intent(in) :: locx(:)
integer(psb_ipk_), intent(out) :: globx(:) integer(psb_ipk_), intent(out), allocatable :: globx(:)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_igatherv end subroutine psb_igatherv
end interface subroutine psb_igather_vect(globx, locx, desc_a, info, root)
use psb_descriptor_type
use psb_i_vect_mod
type(psb_i_vect_type), intent(inout) :: locx
integer(psb_ipk_), intent(out), allocatable :: globx(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root
end subroutine psb_igather_vect
end interface psb_gather
end module psb_i_comm_mod end module psb_i_comm_mod

@ -0,0 +1,542 @@
!!$
!!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ 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_i_vect_mod
!
! This module contains the definition of the psb_i_vect type which
! is the outer container for dense vectors.
! Therefore all methods simply invoke the corresponding methods of the
! inner component.
!
module psb_i_vect_mod
use psb_i_base_vect_mod
type psb_i_vect_type
class(psb_i_base_vect_type), allocatable :: v
contains
procedure, pass(x) :: get_nrows => i_vect_get_nrows
procedure, pass(x) :: sizeof => i_vect_sizeof
procedure, pass(x) :: dot_v => i_vect_dot_v
procedure, pass(x) :: dot_a => i_vect_dot_a
generic, public :: dot => dot_v, dot_a
procedure, pass(y) :: axpby_v => i_vect_axpby_v
procedure, pass(y) :: axpby_a => i_vect_axpby_a
generic, public :: axpby => axpby_v, axpby_a
procedure, pass(y) :: mlt_v => i_vect_mlt_v
procedure, pass(y) :: mlt_a => i_vect_mlt_a
procedure, pass(z) :: mlt_a_2 => i_vect_mlt_a_2
procedure, pass(z) :: mlt_v_2 => i_vect_mlt_v_2
procedure, pass(z) :: mlt_va => i_vect_mlt_va
procedure, pass(z) :: mlt_av => i_vect_mlt_av
generic, public :: mlt => mlt_v, mlt_a, mlt_a_2,&
& mlt_v_2, mlt_av, mlt_va
procedure, pass(x) :: scal => i_vect_scal
procedure, pass(x) :: nrm2 => i_vect_nrm2
procedure, pass(x) :: amax => i_vect_amax
procedure, pass(x) :: asum => i_vect_asum
procedure, pass(x) :: all => i_vect_all
procedure, pass(x) :: zero => i_vect_zero
procedure, pass(x) :: asb => i_vect_asb
procedure, pass(x) :: sync => i_vect_sync
procedure, pass(x) :: gthab => i_vect_gthab
procedure, pass(x) :: gthzv => i_vect_gthzv
generic, public :: gth => gthab, gthzv
procedure, pass(y) :: sctb => i_vect_sctb
generic, public :: sct => sctb
procedure, pass(x) :: free => i_vect_free
procedure, pass(x) :: ins => i_vect_ins
procedure, pass(x) :: bld_x => i_vect_bld_x
procedure, pass(x) :: bld_n => i_vect_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: get_vect => i_vect_get_vect
procedure, pass(x) :: cnv => i_vect_cnv
procedure, pass(x) :: set_scal => i_vect_set_scal
procedure, pass(x) :: set_vect => i_vect_set_vect
generic, public :: set => set_vect, set_scal
end type psb_i_vect_type
public :: psb_i_vect
private :: constructor, size_const
interface psb_i_vect
module procedure constructor, size_const
end interface psb_i_vect
contains
subroutine i_vect_bld_x(x,invect,mold)
integer(psb_ipk_), intent(in) :: invect(:)
class(psb_i_vect_type), intent(out) :: x
class(psb_i_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(psb_i_base_vect_type :: x%v,stat=info)
endif
if (info == psb_success_) call x%v%bld(invect)
end subroutine i_vect_bld_x
subroutine i_vect_bld_n(x,n,mold)
integer(psb_ipk_), intent(in) :: n
class(psb_i_vect_type), intent(out) :: x
class(psb_i_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_) :: info
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(psb_i_base_vect_type :: x%v,stat=info)
endif
if (info == psb_success_) call x%v%bld(n)
end subroutine i_vect_bld_n
function i_vect_get_vect(x) result(res)
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), allocatable :: res(:)
integer(psb_ipk_) :: info
if (allocated(x%v)) then
res = x%v%get_vect()
end if
end function i_vect_get_vect
subroutine i_vect_set_scal(x,val)
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
end subroutine i_vect_set_scal
subroutine i_vect_set_vect(x,val)
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: val(:)
integer(psb_ipk_) :: info
if (allocated(x%v)) call x%v%set(val)
end subroutine i_vect_set_vect
function constructor(x) result(this)
integer(psb_ipk_) :: x(:)
type(psb_i_vect_type) :: this
integer(psb_ipk_) :: info
allocate(psb_i_base_vect_type :: this%v, stat=info)
if (info == 0) call this%v%bld(x)
call this%asb(size(x,kind=psb_ipk_),info)
end function constructor
function size_const(n) result(this)
integer(psb_ipk_), intent(in) :: n
type(psb_i_vect_type) :: this
integer(psb_ipk_) :: info
allocate(psb_i_base_vect_type :: this%v, stat=info)
call this%asb(n,info)
end function size_const
function i_vect_get_nrows(x) result(res)
implicit none
class(psb_i_vect_type), intent(in) :: x
integer(psb_ipk_) :: res
res = 0
if (allocated(x%v)) res = x%v%get_nrows()
end function i_vect_get_nrows
function i_vect_sizeof(x) result(res)
implicit none
class(psb_i_vect_type), intent(in) :: x
integer(psb_long_int_k_) :: res
res = 0
if (allocated(x%v)) res = x%v%sizeof()
end function i_vect_sizeof
function i_vect_dot_v(n,x,y) result(res)
implicit none
class(psb_i_vect_type), intent(inout) :: x, y
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: res
res = izero
if (allocated(x%v).and.allocated(y%v)) &
& res = x%v%dot(n,y%v)
end function i_vect_dot_v
function i_vect_dot_a(n,x,y) result(res)
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: y(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: res
res = izero
if (allocated(x%v)) &
& res = x%v%dot(n,y)
end function i_vect_dot_a
subroutine i_vect_axpby_v(m,alpha, x, beta, y, info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: m
class(psb_i_vect_type), intent(inout) :: x
class(psb_i_vect_type), intent(inout) :: y
integer(psb_ipk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
if (allocated(x%v).and.allocated(y%v)) then
call y%v%axpby(m,alpha,x%v,beta,info)
else
info = psb_err_invalid_vect_state_
end if
end subroutine i_vect_axpby_v
subroutine i_vect_axpby_a(m,alpha, x, beta, y, info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: m
integer(psb_ipk_), intent(in) :: x(:)
class(psb_i_vect_type), intent(inout) :: y
integer(psb_ipk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
if (allocated(y%v)) &
& call y%v%axpby(m,alpha,x,beta,info)
end subroutine i_vect_axpby_a
subroutine i_vect_mlt_v(x, y, info)
use psi_serial_mod
implicit none
class(psb_i_vect_type), intent(inout) :: x
class(psb_i_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (allocated(x%v).and.allocated(y%v)) &
& call y%v%mlt(x%v,info)
end subroutine i_vect_mlt_v
subroutine i_vect_mlt_a(x, y, info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: x(:)
class(psb_i_vect_type), intent(inout) :: y
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (allocated(y%v)) &
& call y%v%mlt(x,info)
end subroutine i_vect_mlt_a
subroutine i_vect_mlt_a_2(alpha,x,y,beta,z,info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: alpha,beta
integer(psb_ipk_), intent(in) :: y(:)
integer(psb_ipk_), intent(in) :: x(:)
class(psb_i_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (allocated(z%v)) &
& call z%v%mlt(alpha,x,y,beta,info)
end subroutine i_vect_mlt_a_2
subroutine i_vect_mlt_v_2(alpha,x,y,beta,z,info,conjgx,conjgy)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: alpha,beta
class(psb_i_vect_type), intent(inout) :: x
class(psb_i_vect_type), intent(inout) :: y
class(psb_i_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
character(len=1), intent(in), optional :: conjgx, conjgy
integer(psb_ipk_) :: i, n
info = 0
if (allocated(x%v).and.allocated(y%v).and.&
& allocated(z%v)) &
& call z%v%mlt(alpha,x%v,y%v,beta,info,conjgx,conjgy)
end subroutine i_vect_mlt_v_2
subroutine i_vect_mlt_av(alpha,x,y,beta,z,info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: alpha,beta
integer(psb_ipk_), intent(in) :: x(:)
class(psb_i_vect_type), intent(inout) :: y
class(psb_i_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (allocated(z%v).and.allocated(y%v)) &
& call z%v%mlt(alpha,x,y%v,beta,info)
end subroutine i_vect_mlt_av
subroutine i_vect_mlt_va(alpha,x,y,beta,z,info)
use psi_serial_mod
implicit none
integer(psb_ipk_), intent(in) :: alpha,beta
integer(psb_ipk_), intent(in) :: y(:)
class(psb_i_vect_type), intent(inout) :: x
class(psb_i_vect_type), intent(inout) :: z
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i, n
info = 0
if (allocated(z%v).and.allocated(x%v)) &
& call z%v%mlt(alpha,x%v,y,beta,info)
end subroutine i_vect_mlt_va
subroutine i_vect_scal(alpha, x)
use psi_serial_mod
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent (in) :: alpha
if (allocated(x%v)) call x%v%scal(alpha)
end subroutine i_vect_scal
function i_vect_nrm2(n,x) result(res)
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: res
if (allocated(x%v)) then
res = x%v%nrm2(n)
else
res = izero
end if
end function i_vect_nrm2
function i_vect_amax(n,x) result(res)
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: res
if (allocated(x%v)) then
res = x%v%amax(n)
else
res = izero
end if
end function i_vect_amax
function i_vect_asum(n,x) result(res)
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: res
if (allocated(x%v)) then
res = x%v%asum(n)
else
res = izero
end if
end function i_vect_asum
subroutine i_vect_all(n, x, info, mold)
implicit none
integer(psb_ipk_), intent(in) :: n
class(psb_i_vect_type), intent(out) :: x
class(psb_i_base_vect_type), intent(in), optional :: mold
integer(psb_ipk_), intent(out) :: info
if (present(mold)) then
allocate(x%v,stat=info,mold=mold)
else
allocate(psb_i_base_vect_type :: x%v,stat=info)
endif
if (info == 0) then
call x%v%all(n,info)
else
info = psb_err_alloc_dealloc_
end if
end subroutine i_vect_all
subroutine i_vect_zero(x)
use psi_serial_mod
implicit none
class(psb_i_vect_type), intent(inout) :: x
if (allocated(x%v)) call x%v%zero()
end subroutine i_vect_zero
subroutine i_vect_asb(n, x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
integer(psb_ipk_), intent(in) :: n
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%v)) &
& call x%v%asb(n,info)
end subroutine i_vect_asb
subroutine i_vect_sync(x)
implicit none
class(psb_i_vect_type), intent(inout) :: x
if (allocated(x%v)) &
& call x%v%sync()
end subroutine i_vect_sync
subroutine i_vect_gthab(n,idx,alpha,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: alpha, beta, y(:)
class(psb_i_vect_type) :: x
if (allocated(x%v)) &
& call x%v%gth(n,idx,alpha,beta,y)
end subroutine i_vect_gthab
subroutine i_vect_gthzv(n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: y(:)
class(psb_i_vect_type) :: x
if (allocated(x%v)) &
& call x%v%gth(n,idx,y)
end subroutine i_vect_gthzv
subroutine i_vect_sctb(n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: beta, x(:)
class(psb_i_vect_type) :: y
if (allocated(y%v)) &
& call y%v%sct(n,idx,x,beta)
end subroutine i_vect_sctb
subroutine i_vect_free(x, info)
use psi_serial_mod
use psb_realloc_mod
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (allocated(x%v)) then
call x%v%free(info)
if (info == 0) deallocate(x%v,stat=info)
end if
end subroutine i_vect_free
subroutine i_vect_ins(n,irl,val,dupl,x,info)
use psi_serial_mod
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n, dupl
integer(psb_ipk_), intent(in) :: irl(:)
integer(psb_ipk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i
info = 0
if (.not.allocated(x%v)) then
info = psb_err_invalid_vect_state_
return
end if
call x%v%ins(n,irl,val,dupl,info)
end subroutine i_vect_ins
subroutine i_vect_cnv(x,mold)
class(psb_i_vect_type), intent(inout) :: x
class(psb_i_base_vect_type), intent(in) :: mold
class(psb_i_base_vect_type), allocatable :: tmp
integer(psb_ipk_), allocatable :: invect(:)
integer(psb_ipk_) :: info
allocate(tmp,stat=info,mold=mold)
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)
call move_alloc(tmp,x%v)
end subroutine i_vect_cnv
end module psb_i_vect_mod

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

@ -1,6 +1,6 @@
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012
!!$ Salvatore Filippone University of Rome Tor Vergata !!$ Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari CNRS-IRIT, Toulouse !!$ Alfredo Buttari CNRS-IRIT, Toulouse
!!$ !!$

Some files were not shown because too many files have changed in this diff Show More

Loading…
Cancel
Save