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

psblas3:

Browse Source 
.
 Make.inc.in
 base/comm/Makefile
 base/internals/Makefile
 base/internals/psi_exist_ovr_elem.f
 base/internals/psi_exist_ovr_elem.f90
 base/internals/psi_list_search.f
 base/internals/psi_list_search.f90
 base/internals/psi_srtlist.f90
 base/internals/srtlist.f
 base/modules/Makefile
 base/serial/Makefile
 base/serial/f77
 base/serial/f77/Makefile
 base/serial/f77/caxpby.f
 base/serial/f77/cnumbmm.f
 base/serial/f77/daxpby.f
 base/serial/f77/dnumbmm.f
 base/serial/f77/iaxpby.f
 base/serial/f77/saxpby.f
 base/serial/f77/snumbmm.f
 base/serial/f77/symbmm.f
 base/serial/f77/zaxpby.f
 base/serial/f77/znumbmm.f
 base/serial/psb_aspxpby.f90
 base/serial/psi_c_serial_impl.f90
 base/serial/psi_d_serial_impl.f90
 base/serial/psi_i_serial_impl.f90
 base/serial/psi_s_serial_impl.f90
 base/serial/psi_z_serial_impl.f90
 base/serial/smmp.f90
 base/tools/Makefile
 configure.ac
 configure
 prec/psb_d_bjacprec.f90
 prec/psb_d_diagprec.f90
 prec/psb_d_nullprec.f90
 test/fileread/Makefile
 test/hello/Makefile
 test/kernel/Makefile
 test/pargen/Makefile
 test/serial/Makefile
 test/torture/Makefile
 test/util/Makefile

Merged changes from fixprec branch.
trunk
Salvatore Filippone 8 years ago
parent 5473b6e783
commit 077998c1bd
42 changed files with 5567 additions and 8968 deletions
Show Stats Download Patch File Download Diff File

10
Make.inc.in
Unescape Escape View File

@ -11,10 +11,8 @@
# The following ones are the variables used by the PSBLAS make scripts.
F90=@F90@
FC=@FC@
CC=@CC@
F90COPT=@F90COPT@
FCOPT=@FCOPT@
CCOPT=@CCOPT@
FMFLAG=@FMFLAG@
@ -22,12 +20,10 @@ FIFLAG=@FIFLAG@
EXTRA_OPT=@EXTRA_OPT@
# These three should be always set!
MPF90=@MPF90@
MPF77=@MPF77@
MPCC=@MPCC@
MPFC=@MPIFC@
MPCC=@MPICC@
F90LINK=$(MPF90)
FLINK=$(MPF77)
FLINK=$(MPFC)
LIBS=@LIBS@

2
base/comm/Makefile
Unescape Escape View File

@ -21,7 +21,7 @@ lib: interns mpfobjs $(OBJS)
interns:
cd internals && $(MAKE) lib
mpfobjs:
$(MAKE) $(MPFOBJS) F90="$(MPF90)" FC="$(MPF90)" FCOPT="$(F90COPT)"
$(MAKE) $(MPFOBJS) FC="$(MPFC)"
clean:

9
base/internals/Makefile
Unescape Escape View File

@ -2,11 +2,8 @@ include ../../Make.inc
FOBJS = psi_compute_size.o psi_crea_bnd_elem.o psi_crea_index.o \
psi_crea_ovr_elem.o psi_bld_tmpovrl.o psi_dl_check.o \
psi_bld_tmphalo.o\
psi_sort_dl.o \
psi_desc_impl.o
FOBJS2 = psi_exist_ovr_elem.o psi_list_search.o srtlist.o
psi_bld_tmphalo.o psi_sort_dl.o \
psi_desc_impl.o psi_exist_ovr_elem.o psi_list_search.o psi_srtlist.o
MPFOBJS = psi_desc_index.o psi_extrct_dl.o \
psi_fnd_owner.o psb_indx_map_fnd_owner.o
@ -24,7 +21,7 @@ lib: mpfobjs $(FOBJS) $(FOBJS2) $(COBJS) $(MPFOBJS2) $(MPFOBJS)
$(FOBJS) $(FBOJS2): $(MODDIR)/psi_mod.o
mpfobjs:
(make $(MPFOBJS) F90="$(MPF90)" FC="$(MPF90)" FCOPT="$(F90COPT)")
(make $(FOBJS2) F90="$(MPF77)" FC="$(MPF77)" FCOPT="$(FCOPT)")
clean:
/bin/rm -f $(MPFOBJS) $(FOBJS) $(COBJS) $(FOBJS2) $(MPFOBJS2) *$(.mod)

74
base/internals/psi_exist_ovr_elem.f
Unescape Escape View File

@ -1,74 +0,0 @@
C
C Parallel Sparse BLAS version 3.5
C (C) Copyright 2006, 2010, 2015, 2017
C Salvatore Filippone Cranfield University
C Alfredo Buttari CNRS-IRIT, Toulouse
C
C Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions
C are met:
C 1. Redistributions of source code must retain the above copyright
C notice, this list of conditions and the following disclaimer.
C 2. Redistributions in binary form must reproduce the above copyright
C notice, this list of conditions, and the following disclaimer in the
C documentation and/or other materials provided with the distribution.
C 3. The name of the PSBLAS group or the names of its contributors may
C not be used to endorse or promote products derived from this
C software without specific written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
C TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
C PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
C BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
C CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
C SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
C INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
C CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
C ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
C POSSIBILITY OF SUCH DAMAGE.
C
C
INTEGER FUNCTION PSI_EXIST_OVR_ELEM(OVR_ELEM,
+ DIM_LIST,ELEM_SEARCHED)
use psb_const_mod
C PURPOSE:
C == = ====
C
C If ELEM_SEARCHED exist in the list OVR_ELEM returns its position in
C the list, else returns -1
C
C
C INPUT
C == = ===
C OVRLAP_ELEMENT_D.: Contains for all overlap points belonging to
C the current process:
C 1. overlap point index
C 2. Number of domains sharing that overlap point
C the end is marked by a -1...............................
C
C DIM_LIST..........: Dimension of list OVRLAP_ELEMENT_D
C
C ELEM_SEARCHED.....:point's Local index identifier to be searched.
IMPLICIT NONE
C ....Scalars parameters....
INTEGER(psb_ipk_) :: DIM_LIST,ELEM_SEARCHED
C ...Array Parameters....
INTEGER(psb_ipk_) :: OVR_ELEM(DIM_LIST,*)
C ...Local Scalars....
INTEGER(psb_ipk_) :: I
I=1
DO WHILE ((I.LE.DIM_LIST).AND.(OVR_ELEM(I,1).NE.ELEM_SEARCHED))
I=I+1
ENDDO
IF ((I.LE.DIM_LIST).AND.(OVR_ELEM(I,1).EQ.ELEM_SEARCHED)) THEN
PSI_EXIST_OVR_ELEM=I
ELSE
PSI_EXIST_OVR_ELEM=-1
ENDIF
END

73
base/internals/psi_exist_ovr_elem.f90
Unescape Escape View File

@ -0,0 +1,73 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006, 2010, 2015, 2017
! Salvatore Filippone Cranfield University
! 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.
!
!
integer function psi_exist_ovr_elem(ovr_elem, dim_list,elem_searched)
use psb_const_mod
! PURPOSE:
! == = ====
!
! If ELEM_SEARCHED exist in the list OVR_ELEM returns its position in
! the list, else returns -1
!
!
! INPUT
! == = ===
! OVRLAP_ELEMENT_D.: Contains for all overlap points belonging to
! the current process:
! 1. overlap point index
! 2. Number of domains sharing that overlap point
! the end is marked by a -1...............................
!
! DIM_LIST..........: Dimension of list OVRLAP_ELEMENT_D
!
! ELEM_SEARCHED.....:point's Local index identifier to be searched.
implicit none
! ....Scalars parameters....
integer(psb_ipk_) :: dim_list,elem_searched
! ...array parameters....
integer(psb_ipk_) :: ovr_elem(dim_list,*)
! ...local scalars....
integer(psb_ipk_) :: i
i=1
do while ((i.le.dim_list).and.(ovr_elem(i,1).ne.elem_searched))
i=i+1
enddo
if ((i.le.dim_list).and.(ovr_elem(i,1).eq.elem_searched)) then
psi_exist_ovr_elem=i
else
psi_exist_ovr_elem=-1
endif
end function psi_exist_ovr_elem

57
base/internals/psi_list_search.f
Unescape Escape View File

@ -1,57 +0,0 @@
C
C Parallel Sparse BLAS version 3.5
C (C) Copyright 2006, 2010, 2015, 2017
C Salvatore Filippone Cranfield University
C Alfredo Buttari CNRS-IRIT, Toulouse
C
C Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions
C are met:
C 1. Redistributions of source code must retain the above copyright
C notice, this list of conditions and the following disclaimer.
C 2. Redistributions in binary form must reproduce the above copyright
C notice, this list of conditions, and the following disclaimer in the
C documentation and/or other materials provided with the distribution.
C 3. The name of the PSBLAS group or the names of its contributors may
C not be used to endorse or promote products derived from this
C software without specific written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
C TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
C PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
C BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
C CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
C SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
C INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
C CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
C ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
C POSSIBILITY OF SUCH DAMAGE.
C
C
INTEGER FUNCTION PSI_LIST_SEARCH(LIST,LENGHT_LIST,ELEM)
use psb_const_mod
C !RETURNS POSITION OF ELEM IN A ARRAY LIST
C !OF LENGHT LENGHT_LIST, IF THIS ELEMENT NOT EXISTS
C !RETURNS -1
INTEGER(psb_ipk_) :: LIST(*)
INTEGER(psb_ipk_) :: LENGHT_LIST
INTEGER(psb_ipk_) :: ELEM
INTEGER(psb_ipk_) :: I
I=1
DO WHILE ((I.LE.LENGHT_LIST).AND.(LIST(I).NE.ELEM))
I=I+1
ENDDO
IF (I.LE.LENGHT_LIST) THEN
IF (LIST(I).EQ.ELEM) THEN
PSI_LIST_SEARCH=I
ELSE
PSI_LIST_SEARCH=-1
ENDIF
ELSE
PSI_LIST_SEARCH=-1
ENDIF
END

58
base/internals/psi_list_search.f90
Unescape Escape View File

@ -0,0 +1,58 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006, 2010, 2015, 2017
! Salvatore Filippone Cranfield University
! 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.
!
!
integer function psi_list_search(list,lenght_list,elem)
use psb_const_mod
implicit none
!returns position of elem in a array list
!of lenght lenght_list, if this element does not exist
!returns -1
integer(psb_ipk_) :: list(*)
integer(psb_ipk_) :: lenght_list
integer(psb_ipk_) :: elem
integer(psb_ipk_) :: i
i=1
do while ((i.le.lenght_list).and.(list(i).ne.elem))
i=i+1
enddo
if (i.le.lenght_list) then
if (list(i).eq.elem) then
psi_list_search=i
else
psi_list_search=-1
endif
else
psi_list_search=-1
endif
end function psi_list_search

203
base/internals/psi_srtlist.f90
Unescape Escape View File

@ -0,0 +1,203 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006, 2010, 2015, 2017
! Salvatore Filippone Cranfield University
! 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.
!
!
!**********************************************************************
! *
! The communication step among processors at each *
! matrix-vector product is a variable all-to-all *
! collective communication that we reimplement *
! in terms of point-to-point communications. *
! The data in input is a list of dependencies: *
! for each node a list of all the nodes it has to *
! communicate with. The lists are guaranteed to be *
! symmetric, i.e. for each pair (I,J) there is a *
! pair (J,I). The idea is to organize the ordering *
! so that at each communication step as many *
! processors as possible are communicating at the *
! same time, i.e. a step is defined by the fact *
! that all edges (I,J) in it have no common node. *
! *
! Formulation of the problem is: *
! Given an undirected graph (forest): *
! Find the shortest series of steps to cancel all *
! graph edges, where at each step all edges belonging *
! to a matching in the graph are canceled. *
! *
! An obvious lower bound to the optimum number of steps *
! is the largest degree of any node in the graph. *
! *
! The algorithm proceeds as follows: *
! 1. Build a list of all edges, e.g. copy the *
! dependencies lists keeping only (I,J) with I<J *
! 2. Compute an auxiliary vector with the degree of *
! each node of the graph. *
! 3. While there are edges in the graph do: *
! 4. Weight the edges with the sum of the degrees *
! of their nodes and sort them into descending order *
! 5. Scan the list of edges; if neither node of the *
! edge has been marked yet, cancel the edge and mark *
! the two nodes *
! 6. If no edge was chosen but the graph is nonempty *
! raise an error condition *
! 7. Queue the edges in the matchin to the output *
! sequence; *
! 8. Decrease by 1 the degree of all marked nodes, *
! then clear all marks *
! 9. Cycle to 3. *
! 10. For each node: scan the edge sequence; if an *
! edge has the node as an endpoint, queue the other *
! node in the dependency list for the current one *
! *
!**********************************************************************
subroutine srtlist(dep_list,dl_lda,ldl,np,dg,dgp,upd, edges,idx,ich,info)
use psb_serial_mod
implicit none
integer(psb_ipk_) :: np, dl_lda, info
integer(psb_ipk_) :: dep_list(dl_lda,*), ldl(*),dg(*), dgp(*),&
& idx(*), upd(*),edges(2,*),ich(*)
integer(psb_ipk_) :: i,j, nedges,ip1,ip2,nch,ip,iedge,&
& i1,ix,ist,iswap(2)
integer(psb_ipk_) :: no_comm
parameter (no_comm=-1)
if (np .lt. 0) then
info = 1
return
endif
!
! dg contains number of communications
!
do i=1, np
dg(i)=ldl(i)
enddo
nedges = 0
do i=1, np
do j=1, dg(i)
ip = dep_list(j,i) + 1
if (ip.gt.i) nedges = nedges + 1
enddo
enddo
iedge = 0
do i=1, np
do j=1, dg(i)
ip = dep_list(j,i) + 1
if (ip.gt.i) then
iedge = iedge + 1
edges(1,iedge) = i
edges(2,iedge) = ip
endif
enddo
enddo
ist = 1
do while (ist.le.nedges)
do i=1, np
upd(i) = 0
enddo
do i=ist, nedges
dgp(i) = -(dg(edges(1,i))+dg(edges(2,i)))
enddo
call psb_msort(dgp(ist:nedges),ix=idx(ist:nedges))
i1 = ist
nch = 0
do i = ist, nedges
ix = idx(i)+ist-1
ip1 = edges(1,ix)
ip2 = edges(2,ix)
if ((upd(ip1).eq.0).and.(upd(ip2).eq.0)) then
upd(ip1) = -1
upd(ip2) = -1
nch = nch + 1
ich(nch) = ix
endif
enddo
if (nch.eq.0) then
write(psb_err_unit,*)&
& 'srtlist ?????? impossible error !!!!!?????',&
& nedges,ist
do i=ist, nedges
ix = idx(i)+ist-1
write(psb_err_unit,*)&
& 'SRTLIST: Edge:',ix,edges(1,ix),&
& edges(2,ix),dgp(ix)
enddo
info = psb_err_input_value_invalid_i_
return
endif
call psb_msort(ich(1:nch))
do i=1, nch
iswap(1) = edges(1,ist)
iswap(2) = edges(2,ist)
edges(1,ist) = edges(1,ich(i))
edges(2,ist) = edges(2,ich(i))
edges(1,ich(i)) = iswap(1)
edges(2,ich(i)) = iswap(2)
ist = ist + 1
enddo
do i=1, np
dg(i) = dg(i) + upd(i)
enddo
enddo
do i=1, np
if (dg(i).ne.0) then
write(psb_err_unit,*)&
& 'SRTLIST Error on exit:',i,dg(i)
endif
dg(i) = 0
enddo
do j=1,nedges
i = edges(1,j)
dg(i) = dg(i)+1
dep_list(dg(i),i) = edges(2,j)-1
i = edges(2,j)
dg(i) = dg(i)+1
dep_list(dg(i),i) = edges(1,j)-1
enddo
do i=1, np
if (dg(i).ne.ldl(i)) then
write(psb_err_unit,*) &
& 'SRTLIST Mismatch on output',i,dg(i),ldl(i)
endif
enddo
return
end subroutine srtlist

215
base/internals/srtlist.f
Unescape Escape View File

@ -1,215 +0,0 @@
C
C Parallel Sparse BLAS version 3.5
C (C) Copyright 2006, 2010, 2015, 2017
C Salvatore Filippone Cranfield University
C Alfredo Buttari CNRS-IRIT, Toulouse
C
C Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions
C are met:
C 1. Redistributions of source code must retain the above copyright
C notice, this list of conditions and the following disclaimer.
C 2. Redistributions in binary form must reproduce the above copyright
C notice, this list of conditions, and the following disclaimer in the
C documentation and/or other materials provided with the distribution.
C 3. The name of the PSBLAS group or the names of its contributors may
C not be used to endorse or promote products derived from this
C software without specific written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
C TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
C PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
C BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
C CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
C SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
C INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
C CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
C ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
C POSSIBILITY OF SUCH DAMAGE.
C
C
***********************************************************************
* *
* The communication step among processors at each *
* matrix-vector product is a variable all-to-all *
* collective communication that we reimplement *
* in terms of point-to-point communications. *
* The data in input is a list of dependencies: *
* for each node a list of all the nodes it has to *
* communicate with. The lists are guaranteed to be *
* symmetric, i.e. for each pair (I,J) there is a *
* pair (J,I). The idea is to organize the ordering *
* so that at each communication step as many *
* processors as possible are communicating at the *
* same time, i.e. a step is defined by the fact *
* that all edges (I,J) in it have no common node. *
* *
* Formulation of the problem is: *
* Given an undirected graph (forest): *
* Find the shortest series of steps to cancel all *
* graph edges, where at each step all edges belonging *
* to a matching in the graph are canceled. *
* *
* An obvious lower bound to the optimum number of steps *
* is the largest degree of any node in the graph. *
* *
* The algorithm proceeds as follows: *
* 1. Build a list of all edges, e.g. copy the *
* dependencies lists keeping only (I,J) with I<J *
* 2. Compute an auxiliary vector with the degree of *
* each node of the graph. *
* 3. While there are edges in the graph do: *
* 4. Weight the edges with the sum of the degrees *
* of their nodes and sort them into descending order *
* 5. Scan the list of edges; if neither node of the *
* edge has been marked yet, cancel the edge and mark *
* the two nodes *
* 6. If no edge was chosen but the graph is nonempty *
* raise an error condition *
* 7. Queue the edges in the matchin to the output *
* sequence; *
* 8. Decrease by 1 the degree of all marked nodes, *
* then clear all marks *
* 9. Cycle to 3. *
* 10. For each node: scan the edge sequence; if an *
* edge has the node as an endpoint, queue the other *
* node in the dependency list for the current one *
* *
***********************************************************************
SUBROUTINE SRTLIST(DEP_LIST,DL_LDA,LDL,NP,dg,dgp,upd,
+ edges,idx,ich,INFO)
use psb_serial_mod
IMPLICIT NONE
INTEGER(psb_ipk_) :: NP, DL_LDA, INFO
INTEGER(psb_ipk_) :: DEP_LIST(DL_LDA,*), LDL(*),DG(*), DGP(*),
+ IDX(*), UPD(*),EDGES(2,*),ICH(*)
INTEGER(psb_ipk_) :: I,J, NEDGES,IP1,IP2,NCH,IP,IEDGE,
+ I1,IX,IST,ISWAP(2)
INTEGER(psb_ipk_) :: NO_COMM
PARAMETER (NO_COMM=-1)
IF (NP .LT. 0) THEN
INFO = 1
RETURN
ENDIF
C
C dg contains number of communications
C
DO I=1, NP
DG(I)=LDL(I)
ENDDO
NEDGES = 0
DO I=1, NP
DO J=1, DG(I)
IP = DEP_LIST(J,I) + 1
c$$$ write(psb_err_unit,*)
c$$$ 'SRTLIST Input :',i,ip
IF (IP.GT.I)
+ NEDGES = NEDGES + 1
ENDDO
ENDDO
IEDGE = 0
DO I=1, NP
DO J=1, DG(I)
IP = DEP_LIST(J,I) + 1
IF (IP.GT.I) THEN
IEDGE = IEDGE + 1
EDGES(1,IEDGE) = I
EDGES(2,IEDGE) = IP
ENDIF
ENDDO
ENDDO
IST = 1
DO WHILE (IST.LE.NEDGES)
DO I=1, NP
UPD(I) = 0
ENDDO
DO I=IST, NEDGES
DGP(I) = -(DG(EDGES(1,I))+DG(EDGES(2,I)))
ENDDO
call psb_msort(dgp(ist:nedges),ix=idx(ist:nedges))
I1 = IST
NCH = 0
DO I = IST, NEDGES
IX = IDX(I)+IST-1
IP1 = EDGES(1,IX)
IP2 = EDGES(2,IX)
IF ((UPD(IP1).eq.0).AND.(UPD(IP2).eq.0)) THEN
UPD(IP1) = -1
UPD(IP2) = -1
NCH = NCH + 1
ICH(NCH) = IX
ENDIF
ENDDO
IF (NCH.eq.0) THEN
write(psb_err_unit,*)
+ 'SRTLIST ?????? Impossible error !!!!!?????',
+ nedges,ist
do i=ist, nedges
IX = IDX(I)+IST-1
write(psb_err_unit,*)
+ 'SRTLIST: Edge:',ix,edges(1,ix),
+ edges(2,ix),dgp(ix)
enddo
info = psb_err_input_value_invalid_i_
return
ENDIF
call psb_msort(ich(1:nch))
DO I=1, NCH
ISWAP(1) = EDGES(1,IST)
ISWAP(2) = EDGES(2,IST)
EDGES(1,IST) = EDGES(1,ICH(I))
EDGES(2,IST) = EDGES(2,ICH(I))
EDGES(1,ICH(I)) = ISWAP(1)
EDGES(2,ICH(I)) = ISWAP(2)
IST = IST + 1
ENDDO
DO I=1, NP
DG(I) = DG(I) + UPD(I)
ENDDO
ENDDO
DO I=1, NP
IF (DG(I).NE.0) THEN
write(psb_err_unit,*)
+ 'SRTLIST Error on exit:',i,dg(i)
ENDIF
DG(I) = 0
ENDDO
DO J=1,NEDGES
I = EDGES(1,J)
DG(I) = DG(I)+1
DEP_LIST(DG(I),I) = EDGES(2,J)-1
I = EDGES(2,J)
DG(I) = DG(I)+1
DEP_LIST(DG(I),I) = EDGES(1,J)-1
ENDDO
DO I=1, NP
IF (DG(I).NE.LDL(I)) THEN
write(psb_err_unit,*)
+ 'SRTLIST Mismatch on output',i,dg(i),ldl(i)
ENDIF
ENDDO
c$$$ write(psb_err_unit,*)
c$$$ 'Output communication:',t2-t1
c$$$ do i=1,np
c$$$ do j=1,ldl(i)
c$$$ write(psb_err_unit,*)
c$$$ 'SRTLIST', i,dep_list(j,i)+1
c$$$ enddo
c$$$ enddo
RETURN
END

12
base/modules/Makefile
Unescape Escape View File

@ -156,22 +156,22 @@ psblas/psb_s_psblas_mod.o psblas/psb_c_psblas_mod.o psblas/psb_d_psblas_mod.o ps
psb_base_mod.o: $(MODULES)
psi_penv_mod.o: psi_penv_mod.F90 $(BASIC_MODS)
$(F90) $(FINCLUDES) $(FDEFINES) $(F90COPT) $(EXTRA_OPT) -c $< -o $@
$(FC) $(FINCLUDES) $(FDEFINES) $(FCOPT) $(EXTRA_OPT) -c $< -o $@
psb_penv_mod.o: psb_penv_mod.F90 $(COMMINT) $(BASIC_MODS)
$(F90) $(FINCLUDES) $(FDEFINES) $(F90COPT) $(EXTRA_OPT) -c $< -o $@
$(FC) $(FINCLUDES) $(FDEFINES) $(FCOPT) $(EXTRA_OPT) -c $< -o $@
psi_comm_buffers_mod.o: psi_comm_buffers_mod.F90 $(BASIC_MODS)
$(F90) $(FINCLUDES) $(FDEFINES) $(F90COPT) $(EXTRA_OPT) -c $< -o $@
$(FC) $(FINCLUDES) $(FDEFINES) $(FCOPT) $(EXTRA_OPT) -c $< -o $@
psi_p2p_mod.o: psi_p2p_mod.F90 $(BASIC_MODS)
$(F90) $(FINCLUDES) $(FDEFINES) $(F90COPT) $(EXTRA_OPT) -c $< -o $@
$(FC) $(FINCLUDES) $(FDEFINES) $(FCOPT) $(EXTRA_OPT) -c $< -o $@
psi_bcast_mod.o: psi_bcast_mod.F90 $(BASIC_MODS)
$(F90) $(FINCLUDES) $(FDEFINES) $(F90COPT) $(EXTRA_OPT) -c $< -o $@
$(FC) $(FINCLUDES) $(FDEFINES) $(FCOPT) $(EXTRA_OPT) -c $< -o $@
psi_reduce_mod.o: psi_reduce_mod.F90 $(BASIC_MODS)
$(F90) $(FINCLUDES) $(FDEFINES) $(F90COPT) $(EXTRA_OPT) -c $< -o $@
$(FC) $(FINCLUDES) $(FDEFINES) $(FCOPT) $(EXTRA_OPT) -c $< -o $@
clean:
/bin/rm -f $(MODULES) $(OBJS) $(MPFOBJS) *$(.mod)

10
base/serial/Makefile
Unescape Escape View File

@ -8,19 +8,19 @@ FOBJS = psb_lsame.o psi_i_serial_impl.o \
psb_sspspmm.o psb_dspspmm.o psb_cspspmm.o psb_zspspmm.o \
psb_ssymbmm.o psb_dsymbmm.o psb_csymbmm.o psb_zsymbmm.o \
psb_snumbmm.o psb_dnumbmm.o psb_cnumbmm.o psb_znumbmm.o \
smmp.o \
psb_sgeprt.o psb_dgeprt.o psb_cgeprt.o psb_zgeprt.o\
psb_spdot_srtd.o psb_aspxpby.o psb_spge_dot.o\
psb_sgelp.o psb_dgelp.o psb_cgelp.o psb_zgelp.o \
psb_samax_s.o psb_damax_s.o psb_camax_s.o psb_zamax_s.o \
psb_sasum_s.o psb_dasum_s.o psb_casum_s.o psb_zasum_s.o
# psb_sort_impl.o
LIBDIR=..
INCDIR=..
MODDIR=../modules
FINCLUDES=$(FMFLAG). $(FMFLAG)$(MODDIR) $(FMFLAG)$(INCDIR)
lib: f77d impld sortd lib1 $(FOBJS)
lib: impld sortd lib1 $(FOBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(FOBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
@ -28,18 +28,12 @@ lib: f77d impld sortd lib1 $(FOBJS)
lib1: $(FOBJS)
f77d:
cd f77 && $(MAKE) lib
impld:
cd impl && $(MAKE) lib
sortd:
cd sort && $(MAKE) lib
clean:
/bin/rm -f $(FOBJS) *$(.mod)
(cd f77; $(MAKE) clean)
(cd impl; $(MAKE) clean)
(cd sort; $(MAKE) clean)

39
base/serial/f77/Makefile
Unescape Escape View File

@ -1,39 +0,0 @@
include ../../../Make.inc
#
# The object files
#
FOBJS = iaxpby.o daxpby.o saxpby.o \
caxpby.o zaxpby.o symbmm.o \
cnumbmm.o dnumbmm.o snumbmm.o znumbmm.o
OBJS=$(FOBJS)
#
# Where the library should go, and how it is called.
# Note that we are regenerating most of libsparker.a on the fly.
LIBDIR=../..
INCDIR=../..
MODDIR=../../modules
FINCLUDES=$(FMFLAG). $(FMFLAG)$(MODDIR) $(FMFLAG)$(INCDIR)
LIBFILE=$(LIBDIR)/$(LIBNAME)
#
# No change should be needed below
#
default: lib
lib: $(OBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(OBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
clean: cleanobjs
veryclean: cleanobjs
cleanobjs:
/bin/rm -f $(OBJS)

200
base/serial/f77/caxpby.f
Unescape Escape View File

@ -1,200 +0,0 @@
C
C Parallel Sparse BLAS version 3.5
C (C) Copyright 2006, 2010, 2015, 2017
C Salvatore Filippone Cranfield University
C Alfredo Buttari CNRS-IRIT, Toulouse
C
C Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions
C are met:
C 1. Redistributions of source code must retain the above copyright
C notice, this list of conditions and the following disclaimer.
C 2. Redistributions in binary form must reproduce the above copyright
C notice, this list of conditions, and the following disclaimer in the
C documentation and/or other materials provided with the distribution.
C 3. The name of the PSBLAS group or the names of its contributors may
C not be used to endorse or promote products derived from this
C software without specific written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
C TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
C PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
C BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
C CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
C SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
C INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
C CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
C ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
C POSSIBILITY OF SUCH DAMAGE.
C
C
subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
use psb_const_mod
complex(psb_spk_), parameter :: one=(1.0,0.0)
complex(psb_spk_), parameter :: zero=(0.0,0.0)
integer(psb_ipk_) :: n, m, lldx, lldy, info
complex(psb_spk_) X(lldx,*), Y(lldy,*)
complex(psb_spk_) alpha, beta
integer(psb_ipk_) :: i, j
integer(psb_ipk_) :: int_err(5)
character name*20
name='caxpby'
C
C Error handling
C
info = psb_success_
if (m.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (n.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=n
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldx.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=5
int_err(2)=1
int_err(3)=lldx
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldy.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=8
int_err(2)=1
int_err(3)=lldy
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
endif
if (alpha.eq.zero) then
if (beta.eq.zero) then
do j=1, n
do i=1,m
y(i,j) = zero
enddo
enddo
else if (beta.eq.one) then
c$$$
c$$$ Do nothing!
c$$$
else if (beta.eq.-one) then
do j=1,n
do i=1,m
y(i,j) = - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.one) then
if (beta.eq.zero) then
do j=1,n
do i=1,m
y(i,j) = x(i,j)
enddo
enddo
else if (beta.eq.one) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-one) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = x(i,j) + beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.-one) then
if (beta.eq.zero) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j)
enddo
enddo
else if (beta.eq.one) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-one) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j)
enddo
enddo
endif
else
if (beta.eq.zero) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j)
enddo
enddo
else if (beta.eq.one) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-one) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo
enddo
endif
endif
return
9999 continue
call fcpsb_serror()
return
end

85
base/serial/f77/cnumbmm.f
Unescape Escape View File

@ -1,85 +0,0 @@
c == =====================================================================
c Sparse Matrix Multiplication Package
c
c Randolph E. Bank and Craig C. Douglas
c
c na.bank@na-net.ornl.gov and na.cdouglas@na-net.ornl.gov
c
c Compile this with the following command (or a similar one):
c
c f77 -c -O smmp.f
c
c == =====================================================================
subroutine cnumbmm(n, m, l,
* ia, ja, diaga, a,
* ib, jb, diagb, b,
* ic, jc, diagc, c,
* temp)
c
use psb_const_mod
integer(psb_ipk_) :: ia(*), ja(*), diaga,
* ib(*), jb(*), diagb,
* ic(*), jc(*), diagc
c
complex(psb_spk_) :: a(*), b(*), c(*), temp(*),ajj
c
c numeric matrix multiply c=a*b
c
maxlmn = max(l,m,n)
do 10 i = 1,maxlmn
temp(i) = 0.
10 continue
minlm = min(l,m)
minln = min(l,n)
minmn = min(m,n)
c
c c = a*b
c
do 50 i = 1,n
do 30 jj = ia(i),ia(i+1)
c a = d + ...
if (jj.eq.ia(i+1)) then
if (diaga.eq.0 .or. i.gt.minmn) goto 30
j = i
ajj = a(i)
else
j=ja(jj)
ajj = a(jj)
endif
c b = d + ...
if (diagb.eq.1 .and. j.le.minlm)
* temp(j) = temp(j) + ajj * b(j)
if ((j<1).or.(j>m)) then
write(psb_err_unit,*)
+ ' NUMBMM: Problem with A ',i,jj,j,m
endif
do 20 k = ib(j),ib(j+1)-1
if((jb(k)<1).or. (jb(k) > maxlmn)) then
write(psb_err_unit,*)
+ ' NUMBMM: jb problem',j,k,jb(k),maxlmn
else
temp(jb(k)) = temp(jb(k)) + ajj * b(k)
endif
20 continue
30 continue
c c = d + ...
if (diagc.eq.1 .and. i.le.minln) then
c(i) = temp(i)
temp(i) = 0.
endif
c$$$ if (mod(i,100) == 1)
c$$$ + write(psb_err_unit,*)
c$$$ ' NUMBMM: Fixing row ',i,ic(i),ic(i+1)-1
do 40 j = ic(i),ic(i+1)-1
if((jc(j)<1).or. (jc(j) > maxlmn)) then
write(psb_err_unit,*)
+ ' NUMBMM: output problem',i,j,jc(j),maxlmn
else
c(j) = temp(jc(j))
temp(jc(j)) = 0.
endif
40 continue
50 continue
return
end

198
base/serial/f77/daxpby.f
Unescape Escape View File

@ -1,198 +0,0 @@
C
C Parallel Sparse BLAS version 3.5
C (C) Copyright 2006, 2010, 2015, 2017
C Salvatore Filippone Cranfield University
C Alfredo Buttari CNRS-IRIT, Toulouse
C
C Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions
C are met:
C 1. Redistributions of source code must retain the above copyright
C notice, this list of conditions and the following disclaimer.
C 2. Redistributions in binary form must reproduce the above copyright
C notice, this list of conditions, and the following disclaimer in the
C documentation and/or other materials provided with the distribution.
C 3. The name of the PSBLAS group or the names of its contributors may
C not be used to endorse or promote products derived from this
C software without specific written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
C TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
C PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
C BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
C CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
C SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
C INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
C CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
C ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
C POSSIBILITY OF SUCH DAMAGE.
C
C
subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
use psb_const_mod
integer(psb_ipk_) :: n, m, lldx, lldy, info
real(psb_dpk_) X(lldx,*), Y(lldy,*)
real(psb_dpk_) alpha, beta
integer(psb_ipk_) :: i, j
integer(psb_ipk_) :: int_err(5)
character name*20
name='daxpby'
C
C Error handling
C
info = psb_success_
if (m.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (n.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=n
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldx.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=5
int_err(2)=1
int_err(3)=lldx
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldy.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=8
int_err(2)=1
int_err(3)=lldy
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
endif
if (alpha.eq.dzero) then
if (beta.eq.dzero) then
do j=1, n
do i=1,m
y(i,j) = dzero
enddo
enddo
else if (beta.eq.done) then
c$$$
c$$$ Do nothing!
c$$$
else if (beta.eq.-done) then
do j=1,n
do i=1,m
y(i,j) = - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.done) then
if (beta.eq.dzero) then
do j=1,n
do i=1,m
y(i,j) = x(i,j)
enddo
enddo
else if (beta.eq.done) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-done) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = x(i,j) + beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.-done) then
if (beta.eq.dzero) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j)
enddo
enddo
else if (beta.eq.done) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-done) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j)
enddo
enddo
endif
else
if (beta.eq.dzero) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j)
enddo
enddo
else if (beta.eq.done) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-done) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo
enddo
endif
endif
return
9999 continue
call fcpsb_serror()
return
end

85
base/serial/f77/dnumbmm.f
Unescape Escape View File

@ -1,85 +0,0 @@
c == =====================================================================
c Sparse Matrix Multiplication Package
c
c Randolph E. Bank and Craig C. Douglas
c
c na.bank@na-net.ornl.gov and na.cdouglas@na-net.ornl.gov
c
c Compile this with the following command (or a similar one):
c
c f77 -c -O smmp.f
c
c == =====================================================================
subroutine dnumbmm(n, m, l,
* ia, ja, diaga, a,
* ib, jb, diagb, b,
* ic, jc, diagc, c,
* temp)
use psb_const_mod
c
integer(psb_ipk_) :: ia(*), ja(*), diaga,
* ib(*), jb(*), diagb,
* ic(*), jc(*), diagc
c
real(psb_dpk_) :: a(*), b(*), c(*), temp(*),ajj
c
c numeric matrix multiply c=a*b
c
maxlmn = max(l,m,n)
do 10 i = 1,maxlmn
temp(i) = 0.
10 continue
minlm = min(l,m)
minln = min(l,n)
minmn = min(m,n)
c
c c = a*b
c
do 50 i = 1,n
do 30 jj = ia(i),ia(i+1)
c a = d + ...
if (jj.eq.ia(i+1)) then
if (diaga.eq.0 .or. i.gt.minmn) goto 30
j = i
ajj = a(i)
else
j=ja(jj)
ajj = a(jj)
endif
c b = d + ...
if (diagb.eq.1 .and. j.le.minlm)
* temp(j) = temp(j) + ajj * b(j)
if ((j<1).or.(j>m)) then
write(psb_err_unit,*)
+ ' NUMBMM: Problem with A ',i,jj,j,m
endif
do 20 k = ib(j),ib(j+1)-1
if((jb(k)<1).or. (jb(k) > maxlmn)) then
write(psb_err_unit,*)
+ ' NUMBMM: jb problem',j,k,jb(k),maxlmn
else
temp(jb(k)) = temp(jb(k)) + ajj * b(k)
endif
20 continue
30 continue
c c = d + ...
if (diagc.eq.1 .and. i.le.minln) then
c(i) = temp(i)
temp(i) = 0.
endif
c$$$ if (mod(i,100) == 1)
c$$$ + write(psb_err_unit,*)
c$$$ ' NUMBMM: Fixing row ',i,ic(i),ic(i+1)-1
do 40 j = ic(i),ic(i+1)-1
if((jc(j)<1).or. (jc(j) > maxlmn)) then
write(psb_err_unit,*)
+ ' NUMBMM: output problem',i,j,jc(j),maxlmn
else
c(j) = temp(jc(j))
temp(jc(j)) = 0.
endif
40 continue
50 continue
return
end

198
base/serial/f77/iaxpby.f
Unescape Escape View File

@ -1,198 +0,0 @@
C
C Parallel Sparse BLAS version 3.5
C (C) Copyright 2006, 2010, 2015, 2017
C Salvatore Filippone Cranfield University
C Alfredo Buttari CNRS-IRIT, Toulouse
C
C Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions
C are met:
C 1. Redistributions of source code must retain the above copyright
C notice, this list of conditions and the following disclaimer.
C 2. Redistributions in binary form must reproduce the above copyright
C notice, this list of conditions, and the following disclaimer in the
C documentation and/or other materials provided with the distribution.
C 3. The name of the PSBLAS group or the names of its contributors may
C not be used to endorse or promote products derived from this
C software without specific written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
C TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
C PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
C BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
C CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
C SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
C INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
C CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
C ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
C POSSIBILITY OF SUCH DAMAGE.
C
C
subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
use psb_const_mod
integer n, m, lldx, lldy, info
integer(psb_ipk_) X(lldx,*), Y(lldy,*)
integer(psb_ipk_) alpha, beta
integer(psb_ipk_) :: i, j
integer(psb_ipk_) :: int_err(5)
character name*20
name='saxpby'
C
C Error handling
C
info = psb_success_
if (m.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (n.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=n
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldx.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=5
int_err(2)=1
int_err(3)=lldx
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldy.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=8
int_err(2)=1
int_err(3)=lldy
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
endif
if (alpha.eq.izero) then
if (beta.eq.izero) then
do j=1, n
do i=1,m
y(i,j) = izero
enddo
enddo
else if (beta.eq.ione) then
c$$$
c$$$ Do nothing!
c$$$
else if (beta.eq.-ione) then
do j=1,n
do i=1,m
y(i,j) = - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.ione) then
if (beta.eq.izero) then
do j=1,n
do i=1,m
y(i,j) = x(i,j)
enddo
enddo
else if (beta.eq.ione) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-ione) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = x(i,j) + beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.-ione) then
if (beta.eq.izero) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j)
enddo
enddo
else if (beta.eq.ione) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-ione) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j)
enddo
enddo
endif
else
if (beta.eq.izero) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j)
enddo
enddo
else if (beta.eq.ione) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-ione) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo
enddo
endif
endif
return
9999 continue
call fcpsb_serror()
return
end

198
base/serial/f77/saxpby.f
Unescape Escape View File

@ -1,198 +0,0 @@
C
C Parallel Sparse BLAS version 3.5
C (C) Copyright 2006, 2010, 2015, 2017
C Salvatore Filippone Cranfield University
C Alfredo Buttari CNRS-IRIT, Toulouse
C
C Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions
C are met:
C 1. Redistributions of source code must retain the above copyright
C notice, this list of conditions and the following disclaimer.
C 2. Redistributions in binary form must reproduce the above copyright
C notice, this list of conditions, and the following disclaimer in the
C documentation and/or other materials provided with the distribution.
C 3. The name of the PSBLAS group or the names of its contributors may
C not be used to endorse or promote products derived from this
C software without specific written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
C TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
C PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
C BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
C CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
C SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
C INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
C CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
C ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
C POSSIBILITY OF SUCH DAMAGE.
C
C
subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
use psb_const_mod
integer n, m, lldx, lldy, info
real(psb_spk_) X(lldx,*), Y(lldy,*)
real(psb_spk_) alpha, beta
integer(psb_ipk_) :: i, j
integer(psb_ipk_) :: int_err(5)
character name*20
name='saxpby'
C
C Error handling
C
info = psb_success_
if (m.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (n.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=n
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldx.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=5
int_err(2)=1
int_err(3)=lldx
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldy.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=8
int_err(2)=1
int_err(3)=lldy
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
endif
if (alpha.eq.szero) then
if (beta.eq.szero) then
do j=1, n
do i=1,m
y(i,j) = szero
enddo
enddo
else if (beta.eq.sone) then
c$$$
c$$$ Do nothing!
c$$$
else if (beta.eq.-sone) then
do j=1,n
do i=1,m
y(i,j) = - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.sone) then
if (beta.eq.szero) then
do j=1,n
do i=1,m
y(i,j) = x(i,j)
enddo
enddo
else if (beta.eq.sone) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-sone) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = x(i,j) + beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.-sone) then
if (beta.eq.szero) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j)
enddo
enddo
else if (beta.eq.sone) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-sone) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j)
enddo
enddo
endif
else
if (beta.eq.szero) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j)
enddo
enddo
else if (beta.eq.sone) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-sone) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo
enddo
endif
endif
return
9999 continue
call fcpsb_serror()
return
end

85
base/serial/f77/snumbmm.f
Unescape Escape View File

@ -1,85 +0,0 @@
c == =====================================================================
c Sparse Matrix Multiplication Package
c
c Randolph E. Bank and Craig C. Douglas
c
c na.bank@na-net.ornl.gov and na.cdouglas@na-net.ornl.gov
c
c Compile this with the following command (or a similar one):
c
c f77 -c -O smmp.f
c
c == =====================================================================
subroutine snumbmm(n, m, l,
* ia, ja, diaga, a,
* ib, jb, diagb, b,
* ic, jc, diagc, c,
* temp)
use psb_const_mod
c
integer(psb_ipk_) :: ia(*), ja(*), diaga,
* ib(*), jb(*), diagb,
* ic(*), jc(*), diagc
c
real(psb_spk_) :: a(*), b(*), c(*), temp(*),ajj
c
c numeric matrix multiply c=a*b
c
maxlmn = max(l,m,n)
do 10 i = 1,maxlmn
temp(i) = 0.
10 continue
minlm = min(l,m)
minln = min(l,n)
minmn = min(m,n)
c
c c = a*b
c
do 50 i = 1,n
do 30 jj = ia(i),ia(i+1)
c a = d + ...
if (jj.eq.ia(i+1)) then
if (diaga.eq.0 .or. i.gt.minmn) goto 30
j = i
ajj = a(i)
else
j=ja(jj)
ajj = a(jj)
endif
c b = d + ...
if (diagb.eq.1 .and. j.le.minlm)
* temp(j) = temp(j) + ajj * b(j)
if ((j<1).or.(j>m)) then
write(psb_err_unit,*)
+ ' NUMBMM: Problem with A ',i,jj,j,m
endif
do 20 k = ib(j),ib(j+1)-1
if((jb(k)<1).or. (jb(k) > maxlmn)) then
write(psb_err_unit,*)
+ ' NUMBMM: jb problem',j,k,jb(k),maxlmn
else
temp(jb(k)) = temp(jb(k)) + ajj * b(k)
endif
20 continue
30 continue
c c = d + ...
if (diagc.eq.1 .and. i.le.minln) then
c(i) = temp(i)
temp(i) = 0.
endif
c$$$ if (mod(i,100) == 1)
c$$$ + write(psb_err_unit,*)
c$$$ ' NUMBMM: Fixing row ',i,ic(i),ic(i+1)-1
do 40 j = ic(i),ic(i+1)-1
if((jc(j)<1).or. (jc(j) > maxlmn)) then
write(psb_err_unit,*)
+ ' NUMBMM: output problem',i,j,jc(j),maxlmn
else
c(j) = temp(jc(j))
temp(jc(j)) = 0.
endif
40 continue
50 continue
return
end

119
base/serial/f77/symbmm.f
Unescape Escape View File

@ -1,119 +0,0 @@
c == =====================================================================
c Sparse Matrix Multiplication Package
c
c Randolph E. Bank and Craig C. Douglas
c
c na.bank@na-net.ornl.gov and na.cdouglas@na-net.ornl.gov
c
c Compile this with the following command (or a similar one):
c
c f77 -c -O smmp.f
c
c == =====================================================================
subroutine symbmm
* (n, m, l,
* ia, ja, diaga,
* ib, jb, diagb,
* ic, jc, diagc,
* index)
use psb_const_mod
use psb_realloc_mod
use psb_sort_mod, only: psb_msort
c
integer(psb_ipk_) :: ia(*), ja(*), diaga,
* ib(*), jb(*), diagb, diagc, index(*)
integer(psb_ipk_), allocatable :: ic(:),jc(:)
integer(psb_ipk_) :: nze, info
c
c symbolic matrix multiply c=a*b
c
if (size(ic) < n+1) then
write(psb_err_unit,*)
+ 'Called realloc in SYMBMM '
call psb_realloc(n+1,ic,info)
if (info /= psb_success_) then
write(psb_err_unit,*)
+ 'realloc failed in SYMBMM ',info
end if
endif
maxlmn = max(l,m,n)
do 10 i=1,maxlmn
index(i)=0
10 continue
if (diagc.eq.0) then
ic(1)=1
else
ic(1)=n+2
endif
minlm = min(l,m)
minmn = min(m,n)
c
c main loop
c
do 50 i=1,n
istart=-1
length=0
c
c merge row lists
c
do 30 jj=ia(i),ia(i+1)
c a = d + ...
if (jj.eq.ia(i+1)) then
if (diaga.eq.0 .or. i.gt.minmn) goto 30
j = i
else
j=ja(jj)
endif
c b = d + ...
if (index(j).eq.0 .and. diagb.eq.1 .and. j.le.minlm)then
index(j)=istart
istart=j
length=length+1
endif
if ((j<1).or.(j>m)) then
write(psb_err_unit,*)
+ ' SymbMM: Problem with A ',i,jj,j,m
endif
do 20 k=ib(j),ib(j+1)-1
if ((jb(k)<1).or.(jb(k)>maxlmn)) then
write(psb_err_unit,*)
+ 'Problem in SYMBMM 1:',j,k,jb(k),maxlmn
else
if(index(jb(k)).eq.0) then
index(jb(k))=istart
istart=jb(k)
length=length+1
endif
endif
20 continue
30 continue
c
c row i of jc
c
if (diagc.eq.1 .and. index(i).ne.0) length = length - 1
ic(i+1)=ic(i)+length
if (ic(i+1) > size(jc)) then
if (n > (2*i)) then
nze = max(ic(i+1), ic(i)*((n+i-1)/i))
else
nze = max(ic(i+1), nint((dble(ic(i))*(dble(n)/i))) )
endif
call psb_realloc(nze,jc,info)
end if
do 40 j= ic(i),ic(i+1)-1
if (diagc.eq.1 .and. istart.eq.i) then
istart = index(istart)
index(i) = 0
endif
jc(j)=istart
istart=index(istart)
index(jc(j))=0
40 continue
call psb_msort(jc(ic(i):ic(i)+length -1))
index(i) = 0
50 continue
return
end

200
base/serial/f77/zaxpby.f
Unescape Escape View File

@ -1,200 +0,0 @@
C
C Parallel Sparse BLAS version 3.5
C (C) Copyright 2006, 2010, 2015, 2017
C Salvatore Filippone Cranfield University
C Alfredo Buttari CNRS-IRIT, Toulouse
C
C Redistribution and use in source and binary forms, with or without
C modification, are permitted provided that the following conditions
C are met:
C 1. Redistributions of source code must retain the above copyright
C notice, this list of conditions and the following disclaimer.
C 2. Redistributions in binary form must reproduce the above copyright
C notice, this list of conditions, and the following disclaimer in the
C documentation and/or other materials provided with the distribution.
C 3. The name of the PSBLAS group or the names of its contributors may
C not be used to endorse or promote products derived from this
C software without specific written permission.
C
C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
C ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
C TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
C PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
C BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
C CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
C SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
C INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
C CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
C ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
C POSSIBILITY OF SUCH DAMAGE.
C
C
subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
use psb_const_mod
complex(psb_dpk_), parameter :: one=(1.0d0,0.0d0)
complex(psb_dpk_), parameter :: zero=(0.0d0,0.0d0)
integer(psb_ipk_) :: n, m, lldx, lldy, info
complex(psb_dpk_) X(lldx,*), Y(lldy,*)
complex(psb_dpk_) alpha, beta
integer(psb_ipk_) :: i, j
integer(psb_ipk_) :: int_err(5)
character name*20
name='zaxpby'
C
C Error handling
C
info = psb_success_
if (m.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (n.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=n
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldx.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=5
int_err(2)=1
int_err(3)=lldx
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldy.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=8
int_err(2)=1
int_err(3)=lldy
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
endif
if (alpha.eq.zero) then
if (beta.eq.zero) then
do j=1, n
do i=1,m
y(i,j) = zero
enddo
enddo
else if (beta.eq.one) then
c$$$
c$$$ Do nothing!
c$$$
else if (beta.eq.-one) then
do j=1,n
do i=1,m
y(i,j) = - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.one) then
if (beta.eq.zero) then
do j=1,n
do i=1,m
y(i,j) = x(i,j)
enddo
enddo
else if (beta.eq.one) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-one) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = x(i,j) + beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.-one) then
if (beta.eq.zero) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j)
enddo
enddo
else if (beta.eq.one) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-one) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j)
enddo
enddo
endif
else
if (beta.eq.zero) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j)
enddo
enddo
else if (beta.eq.one) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-one) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo
enddo
endif
endif
return
9999 continue
call fcpsb_serror()
return
end

85
base/serial/f77/znumbmm.f
Unescape Escape View File

@ -1,85 +0,0 @@
c == =====================================================================
c Sparse Matrix Multiplication Package
c
c Randolph E. Bank and Craig C. Douglas
c
c na.bank@na-net.ornl.gov and na.cdouglas@na-net.ornl.gov
c
c Compile this with the following command (or a similar one):
c
c f77 -c -O smmp.f
c
c == =====================================================================
subroutine znumbmm(n, m, l,
* ia, ja, diaga, a,
* ib, jb, diagb, b,
* ic, jc, diagc, c,
* temp)
c
use psb_const_mod
integer(psb_ipk_) :: ia(*), ja(*), diaga,
* ib(*), jb(*), diagb,
* ic(*), jc(*), diagc
c
complex(psb_dpk_) :: a(*), b(*), c(*), temp(*),ajj
c
c numeric matrix multiply c=a*b
c
maxlmn = max(l,m,n)
do 10 i = 1,maxlmn
temp(i) = 0.
10 continue
minlm = min(l,m)
minln = min(l,n)
minmn = min(m,n)
c
c c = a*b
c
do 50 i = 1,n
do 30 jj = ia(i),ia(i+1)
c a = d + ...
if (jj.eq.ia(i+1)) then
if (diaga.eq.0 .or. i.gt.minmn) goto 30
j = i
ajj = a(i)
else
j=ja(jj)
ajj = a(jj)
endif
c b = d + ...
if (diagb.eq.1 .and. j.le.minlm)
* temp(j) = temp(j) + ajj * b(j)
if ((j<1).or.(j>m)) then
write(psb_err_unit,*)
+ ' NUMBMM: Problem with A ',i,jj,j,m
endif
do 20 k = ib(j),ib(j+1)-1
if((jb(k)<1).or. (jb(k) > maxlmn)) then
write(psb_err_unit,*)
+ ' NUMBMM: jb problem',j,k,jb(k),maxlmn
else
temp(jb(k)) = temp(jb(k)) + ajj * b(k)
endif
20 continue
30 continue
c c = d + ...
if (diagc.eq.1 .and. i.le.minln) then
c(i) = temp(i)
temp(i) = 0.
endif
c$$$ if (mod(i,100) == 1)
c$$$ + write(psb_err_unit,*)
c$$$ ' NUMBMM: Fixing row ',i,ic(i),ic(i+1)-1
do 40 j = ic(i),ic(i+1)-1
if((jc(j)<1).or. (jc(j) > maxlmn)) then
write(psb_err_unit,*)
+ ' NUMBMM: output problem',i,j,jc(j),maxlmn
else
c(j) = temp(jc(j))
temp(jc(j)) = 0.
endif
40 continue
50 continue
return
end

31
base/serial/psb_aspxpby.f90
Unescape Escape View File

@ -1,3 +1,34 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006, 2010, 2015, 2017
! Salvatore Filippone Cranfield University
! 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.
!
!
subroutine psb_s_aspxpby(alpha, nx, ix, x, beta, y, info)
use psb_const_mod
integer(psb_ipk_), intent(in) :: nx

202
base/serial/psi_c_serial_impl.f90
Unescape Escape View File

@ -1,3 +1,34 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006, 2010, 2015, 2017
! Salvatore Filippone Cranfield University
! 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.
!
!
subroutine psi_caxpby(m,n,alpha, x, beta, y, info)
use psb_const_mod
@ -394,3 +425,174 @@ subroutine psi_csctv(n,idx,x,beta,y)
end do
end if
end subroutine psi_csctv
subroutine caxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
use psb_const_mod
use psb_error_mod
implicit none
complex(psb_spk_), parameter :: one=(1.0,0.0)
complex(psb_spk_), parameter :: zero=(0.0,0.0)
integer(psb_ipk_) :: n, m, lldx, lldy, info
complex(psb_spk_) X(lldx,*), Y(lldy,*)
complex(psb_spk_) alpha, beta
integer(psb_ipk_) :: i, j
integer(psb_ipk_) :: int_err(5)
character name*20
name='caxpby'
!
! Error handling
!
info = psb_success_
if (m.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (n.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=n
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldx.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=5
int_err(2)=1
int_err(3)=lldx
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldy.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=8
int_err(2)=1
int_err(3)=lldy
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
endif
if (alpha.eq.zero) then
if (beta.eq.zero) then
do j=1, n
do i=1,m
y(i,j) = zero
enddo
enddo
else if (beta.eq.one) then
!$$$
!$$$ Do nothing!
!$$$
else if (beta.eq.-one) then
do j=1,n
do i=1,m
y(i,j) = - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.one) then
if (beta.eq.zero) then
do j=1,n
do i=1,m
y(i,j) = x(i,j)
enddo
enddo
else if (beta.eq.one) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-one) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = x(i,j) + beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.-one) then
if (beta.eq.zero) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j)
enddo
enddo
else if (beta.eq.one) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-one) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j)
enddo
enddo
endif
else
if (beta.eq.zero) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j)
enddo
enddo
else if (beta.eq.one) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-one) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo
enddo
endif
endif
return
9999 continue
call fcpsb_serror()
return
end subroutine caxpby

200
base/serial/psi_d_serial_impl.f90
Unescape Escape View File

@ -1,3 +1,34 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006, 2010, 2015, 2017
! Salvatore Filippone Cranfield University
! 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.
!
!
subroutine psi_daxpby(m,n,alpha, x, beta, y, info)
use psb_const_mod
@ -394,3 +425,172 @@ subroutine psi_dsctv(n,idx,x,beta,y)
end do
end if
end subroutine psi_dsctv
subroutine daxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
use psb_const_mod
use psb_error_mod
implicit none
integer(psb_ipk_) :: n, m, lldx, lldy, info
real(psb_dpk_) X(lldx,*), Y(lldy,*)
real(psb_dpk_) alpha, beta
integer(psb_ipk_) :: i, j
integer(psb_ipk_) :: int_err(5)
character name*20
name='daxpby'
!
! Error handling
!
info = psb_success_
if (m.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (n.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=n
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldx.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=5
int_err(2)=1
int_err(3)=lldx
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldy.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=8
int_err(2)=1
int_err(3)=lldy
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
endif
if (alpha.eq.dzero) then
if (beta.eq.dzero) then
do j=1, n
do i=1,m
y(i,j) = dzero
enddo
enddo
else if (beta.eq.done) then
!
! Do nothing!
!
else if (beta.eq.-done) then
do j=1,n
do i=1,m
y(i,j) = - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.done) then
if (beta.eq.dzero) then
do j=1,n
do i=1,m
y(i,j) = x(i,j)
enddo
enddo
else if (beta.eq.done) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-done) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = x(i,j) + beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.-done) then
if (beta.eq.dzero) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j)
enddo
enddo
else if (beta.eq.done) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-done) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j)
enddo
enddo
endif
else
if (beta.eq.dzero) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j)
enddo
enddo
else if (beta.eq.done) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-done) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo
enddo
endif
endif
return
9999 continue
call fcpsb_serror()
return
end subroutine daxpby

200
base/serial/psi_i_serial_impl.f90
Unescape Escape View File

@ -1,3 +1,34 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006, 2010, 2015, 2017
! Salvatore Filippone Cranfield University
! 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.
!
!
subroutine psi_iaxpby(m,n,alpha, x, beta, y, info)
use psb_const_mod
@ -394,3 +425,172 @@ subroutine psi_isctv(n,idx,x,beta,y)
end do
end if
end subroutine psi_isctv
subroutine iaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
use psb_const_mod
use psb_error_mod
implicit none
integer n, m, lldx, lldy, info
integer(psb_ipk_) X(lldx,*), Y(lldy,*)
integer(psb_ipk_) alpha, beta
integer(psb_ipk_) :: i, j
integer(psb_ipk_) :: int_err(5)
character name*20
name='iaxpby'
!
! Error handling
!
info = psb_success_
if (m.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (n.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=n
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldx.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=5
int_err(2)=1
int_err(3)=lldx
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldy.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=8
int_err(2)=1
int_err(3)=lldy
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
endif
if (alpha.eq.izero) then
if (beta.eq.izero) then
do j=1, n
do i=1,m
y(i,j) = izero
enddo
enddo
else if (beta.eq.ione) then
!
! Do nothing!
!
else if (beta.eq.-ione) then
do j=1,n
do i=1,m
y(i,j) = - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.ione) then
if (beta.eq.izero) then
do j=1,n
do i=1,m
y(i,j) = x(i,j)
enddo
enddo
else if (beta.eq.ione) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-ione) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = x(i,j) + beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.-ione) then
if (beta.eq.izero) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j)
enddo
enddo
else if (beta.eq.ione) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-ione) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j)
enddo
enddo
endif
else
if (beta.eq.izero) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j)
enddo
enddo
else if (beta.eq.ione) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-ione) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo
enddo
endif
endif
return
9999 continue
call fcpsb_serror()
return
end subroutine iaxpby

198
base/serial/psi_s_serial_impl.f90
Unescape Escape View File

@ -1,3 +1,34 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006, 2010, 2015, 2017
! Salvatore Filippone Cranfield University
! 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.
!
!
subroutine psi_saxpby(m,n,alpha, x, beta, y, info)
use psb_const_mod
@ -394,3 +425,170 @@ subroutine psi_ssctv(n,idx,x,beta,y)
end do
end if
end subroutine psi_ssctv
subroutine saxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
use psb_const_mod
integer n, m, lldx, lldy, info
real(psb_spk_) X(lldx,*), Y(lldy,*)
real(psb_spk_) alpha, beta
integer(psb_ipk_) :: i, j
integer(psb_ipk_) :: int_err(5)
character name*20
name='saxpby'
!
! Error handling
!
info = psb_success_
if (m.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (n.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=n
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldx.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=5
int_err(2)=1
int_err(3)=lldx
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldy.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=8
int_err(2)=1
int_err(3)=lldy
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
endif
if (alpha.eq.szero) then
if (beta.eq.szero) then
do j=1, n
do i=1,m
y(i,j) = szero
enddo
enddo
else if (beta.eq.sone) then
!
! Do nothing!
!
else if (beta.eq.-sone) then
do j=1,n
do i=1,m
y(i,j) = - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.sone) then
if (beta.eq.szero) then
do j=1,n
do i=1,m
y(i,j) = x(i,j)
enddo
enddo
else if (beta.eq.sone) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-sone) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = x(i,j) + beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.-sone) then
if (beta.eq.szero) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j)
enddo
enddo
else if (beta.eq.sone) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-sone) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j)
enddo
enddo
endif
else
if (beta.eq.szero) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j)
enddo
enddo
else if (beta.eq.sone) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-sone) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo
enddo
endif
endif
return
9999 continue
call fcpsb_serror()
return
end subroutine saxpby

202
base/serial/psi_z_serial_impl.f90
Unescape Escape View File

@ -1,3 +1,34 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006, 2010, 2015, 2017
! Salvatore Filippone Cranfield University
! 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.
!
!
subroutine psi_zaxpby(m,n,alpha, x, beta, y, info)
use psb_const_mod
@ -394,3 +425,174 @@ subroutine psi_zsctv(n,idx,x,beta,y)
end do
end if
end subroutine psi_zsctv
subroutine zaxpby(m, n, alpha, X, lldx, beta, Y, lldy, info)
use psb_const_mod
use psb_error_mod
implicit none
complex(psb_dpk_), parameter :: one=(1.0d0,0.0d0)
complex(psb_dpk_), parameter :: zero=(0.0d0,0.0d0)
integer(psb_ipk_) :: n, m, lldx, lldy, info
complex(psb_dpk_) X(lldx,*), Y(lldy,*)
complex(psb_dpk_) alpha, beta
integer(psb_ipk_) :: i, j
integer(psb_ipk_) :: int_err(5)
character name*20
name='zaxpby'
!
! Error handling
!
info = psb_success_
if (m.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (n.lt.0) then
info=psb_err_iarg_neg_
int_err(1)=1
int_err(2)=n
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldx.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=5
int_err(2)=1
int_err(3)=lldx
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
else if (lldy.lt.max(1,m)) then
info=psb_err_iarg_not_gtia_ii_
int_err(1)=8
int_err(2)=1
int_err(3)=lldy
int_err(4)=m
call fcpsb_errpush(info,name,int_err)
goto 9999
endif
if (alpha.eq.zero) then
if (beta.eq.zero) then
do j=1, n
do i=1,m
y(i,j) = zero
enddo
enddo
else if (beta.eq.one) then
!
! Do nothing!
!
else if (beta.eq.-one) then
do j=1,n
do i=1,m
y(i,j) = - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.one) then
if (beta.eq.zero) then
do j=1,n
do i=1,m
y(i,j) = x(i,j)
enddo
enddo
else if (beta.eq.one) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-one) then
do j=1,n
do i=1,m
y(i,j) = x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = x(i,j) + beta*y(i,j)
enddo
enddo
endif
else if (alpha.eq.-one) then
if (beta.eq.zero) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j)
enddo
enddo
else if (beta.eq.one) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-one) then
do j=1,n
do i=1,m
y(i,j) = -x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = -x(i,j) + beta*y(i,j)
enddo
enddo
endif
else
if (beta.eq.zero) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j)
enddo
enddo
else if (beta.eq.one) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + y(i,j)
enddo
enddo
else if (beta.eq.-one) then
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) - y(i,j)
enddo
enddo
else
do j=1,n
do i=1,m
y(i,j) = alpha*x(i,j) + beta*y(i,j)
enddo
enddo
endif
endif
return
9999 continue
call fcpsb_serror()
return
end subroutine zaxpby

477
base/serial/smmp.f90
Unescape Escape View File

@ -0,0 +1,477 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006, 2010, 2015, 2017
! Salvatore Filippone Cranfield University
! 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.
!
!
! Original code adapted from:
! == =====================================================================
! Sparse Matrix Multiplication Package
!
! Randolph E. Bank and Craig C. Douglas
!
! na.bank@na-net.ornl.gov and na.cdouglas@na-net.ornl.gov
!
! Compile this with the following command (or a similar one):
!
! f77 -c -O smmp.f
!
! == =====================================================================
subroutine symbmm(n, m, l, ia, ja, diaga, ib, jb, diagb,&
& ic, jc, diagc, index)
use psb_const_mod
use psb_realloc_mod
use psb_sort_mod, only: psb_msort
!
integer(psb_ipk_) :: ia(*), ja(*), diaga, &
& ib(*), jb(*), diagb, diagc, index(*)
integer(psb_ipk_), allocatable :: ic(:),jc(:)
integer(psb_ipk_) :: nze, info
!
! symbolic matrix multiply c=a*b
!
if (size(ic) < n+1) then
write(psb_err_unit,*)&
& 'Called realloc in SYMBMM '
call psb_realloc(n+1,ic,info)
if (info /= psb_success_) then
write(psb_err_unit,*)&
& 'realloc failed in SYMBMM ',info
end if
endif
maxlmn = max(l,m,n)
do i=1,maxlmn
index(i)=0
end do
if (diagc.eq.0) then
ic(1)=1
else
ic(1)=n+2
endif
minlm = min(l,m)
minmn = min(m,n)
!
! main loop
!
do i=1,n
istart=-1
length=0
!
! merge row lists
!
rowi: do jj=ia(i),ia(i+1)
! a = d + ...
if (jj.eq.ia(i+1)) then
if (diaga.eq.0 .or. i.gt.minmn) cycle rowi
j = i
else
j=ja(jj)
endif
! b = d + ...
if (index(j).eq.0 .and. diagb.eq.1 .and. j.le.minlm)then
index(j)=istart
istart=j
length=length+1
endif
if ((j<1).or.(j>m)) then
write(psb_err_unit,*)&
& ' SymbMM: Problem with A ',i,jj,j,m
endif
do k=ib(j),ib(j+1)-1
if ((jb(k)<1).or.(jb(k)>maxlmn)) then
write(psb_err_unit,*)&
& 'Problem in SYMBMM 1:',j,k,jb(k),maxlmn
else
if(index(jb(k)).eq.0) then
index(jb(k))=istart
istart=jb(k)
length=length+1
endif
endif
end do
end do rowi
!
! row i of jc
!
if (diagc.eq.1 .and. index(i).ne.0) length = length - 1
ic(i+1)=ic(i)+length
if (ic(i+1) > size(jc)) then
if (n > (2*i)) then
nze = max(ic(i+1), ic(i)*((n+i-1)/i))
else
nze = max(ic(i+1), nint((dble(ic(i))*(dble(n)/i))) )
endif
call psb_realloc(nze,jc,info)
end if
do j= ic(i),ic(i+1)-1
if (diagc.eq.1 .and. istart.eq.i) then
istart = index(istart)
index(i) = 0
endif
jc(j)=istart
istart=index(istart)
index(jc(j))=0
end do
call psb_msort(jc(ic(i):ic(i)+length -1))
index(i) = 0
end do
return
end subroutine symbmm
! == =====================================================================
! Sparse Matrix Multiplication Package
!
! Randolph E. Bank and Craig C. Douglas
!
! na.bank@na-net.ornl.gov and na.cdouglas@na-net.ornl.gov
!
! Compile this with the following command (or a similar one):
!
! f77 -c -O smmp.f
!
! == =====================================================================
subroutine cnumbmm(n, m, l, ia, ja, diaga, a, ib, jb, diagb, b,&
& ic, jc, diagc, c, temp)
!
use psb_const_mod
integer(psb_ipk_) :: ia(*), ja(*), diaga,&
& ib(*), jb(*), diagb, ic(*), jc(*), diagc
!
complex(psb_spk_) :: a(*), b(*), c(*), temp(*),ajj
!
! numeric matrix multiply c=a*b
!
maxlmn = max(l,m,n)
do i = 1,maxlmn
temp(i) = 0.
end do
minlm = min(l,m)
minln = min(l,n)
minmn = min(m,n)
!
! c = a*b
!
do i = 1,n
rowi: do jj = ia(i),ia(i+1)
! a = d + ...
if (jj.eq.ia(i+1)) then
if (diaga.eq.0 .or. i.gt.minmn) cycle rowi
j = i
ajj = a(i)
else
j=ja(jj)
ajj = a(jj)
endif
! b = d + ...
if (diagb.eq.1 .and. j.le.minlm) &
& temp(j) = temp(j) + ajj * b(j)
if ((j<1).or.(j>m)) then
write(psb_err_unit,*)&
& ' NUMBMM: Problem with A ',i,jj,j,m
endif
do k = ib(j),ib(j+1)-1
if((jb(k)<1).or. (jb(k) > maxlmn)) then
write(psb_err_unit,*)&
& ' NUMBMM: jb problem',j,k,jb(k),maxlmn
else
temp(jb(k)) = temp(jb(k)) + ajj * b(k)
endif
end do
end do rowi
! c = d + ...
if (diagc.eq.1 .and. i.le.minln) then
c(i) = temp(i)
temp(i) = 0.
endif
!$$$ if (mod(i,100) == 1)
!$$$ + write(psb_err_unit,*)
!$$$ ' NUMBMM: Fixing row ',i,ic(i),ic(i+1)-1
do j = ic(i),ic(i+1)-1
if((jc(j)<1).or. (jc(j) > maxlmn)) then
write(psb_err_unit,*)&
& ' NUMBMM: output problem',i,j,jc(j),maxlmn
else
c(j) = temp(jc(j))
temp(jc(j)) = 0.
endif
end do
end do
return
end subroutine cnumbmm
! == =====================================================================
! Sparse Matrix Multiplication Package
!
! Randolph E. Bank and Craig C. Douglas
!
! na.bank@na-net.ornl.gov and na.cdouglas@na-net.ornl.gov
!
! Compile this with the following command (or a similar one):
!
! f77 -c -O smmp.f
!
! == =====================================================================
subroutine dnumbmm(n, m, l, ia, ja, diaga, a, ib, jb, diagb, b,&
& ic, jc, diagc, c, temp)
use psb_const_mod
!
integer(psb_ipk_) :: ia(*), ja(*), diaga, ib(*), jb(*), diagb,&
& ic(*), jc(*), diagc
!
real(psb_dpk_) :: a(*), b(*), c(*), temp(*),ajj
!
! numeric matrix multiply c=a*b
!
maxlmn = max(l,m,n)
do i = 1,maxlmn
temp(i) = 0.
end do
minlm = min(l,m)
minln = min(l,n)
minmn = min(m,n)
!
! c = a*b
!
do i = 1,n
rowi: do jj = ia(i),ia(i+1)
! a = d + ...
if (jj.eq.ia(i+1)) then
if (diaga.eq.0 .or. i.gt.minmn) cycle rowi
j = i
ajj = a(i)
else
j=ja(jj)
ajj = a(jj)
endif
! b = d + ...
if (diagb.eq.1 .and. j.le.minlm) &
& temp(j) = temp(j) + ajj * b(j)
if ((j<1).or.(j>m)) then
write(psb_err_unit,*)&
& ' NUMBMM: Problem with A ',i,jj,j,m
endif
do k = ib(j),ib(j+1)-1
if((jb(k)<1).or. (jb(k) > maxlmn)) then
write(psb_err_unit,*)&
& ' NUMBMM: jb problem',j,k,jb(k),maxlmn
else
temp(jb(k)) = temp(jb(k)) + ajj * b(k)
endif
end do
end do rowi
! c = d + ...
if (diagc.eq.1 .and. i.le.minln) then
c(i) = temp(i)
temp(i) = 0.
endif
!$$$ if (mod(i,100) == 1)
!$$$ + write(psb_err_unit,*)
!$$$ ' NUMBMM: Fixing row ',i,ic(i),ic(i+1)-1
do j = ic(i),ic(i+1)-1
if((jc(j)<1).or. (jc(j) > maxlmn)) then
write(psb_err_unit,*)&
& ' NUMBMM: output problem',i,j,jc(j),maxlmn
else
c(j) = temp(jc(j))
temp(jc(j)) = 0.
endif
end do
end do
return
end subroutine dnumbmm
! == =====================================================================
! Sparse Matrix Multiplication Package
!
! Randolph E. Bank and Craig C. Douglas
!
! na.bank@na-net.ornl.gov and na.cdouglas@na-net.ornl.gov
!
! Compile this with the following command (or a similar one):
!
! f77 -c -O smmp.f
!
! == =====================================================================
subroutine snumbmm(n, m, l, ia, ja, diaga, a, ib, jb, diagb, b,&
& ic, jc, diagc, c, temp)
use psb_const_mod
!
integer(psb_ipk_) :: ia(*), ja(*), diaga, ib(*), jb(*), diagb,&
& ic(*), jc(*), diagc
!
real(psb_spk_) :: a(*), b(*), c(*), temp(*),ajj
!
! numeric matrix multiply c=a*b
!
maxlmn = max(l,m,n)
do i = 1,maxlmn
temp(i) = 0.
end do
minlm = min(l,m)
minln = min(l,n)
minmn = min(m,n)
!
! c = a*b
!
do i = 1,n
rowi: do jj = ia(i),ia(i+1)
! a = d + ...
if (jj.eq.ia(i+1)) then
if (diaga.eq.0 .or. i.gt.minmn) cycle rowi
j = i
ajj = a(i)
else
j=ja(jj)
ajj = a(jj)
endif
! b = d + ...
if (diagb.eq.1 .and. j.le.minlm) &
& temp(j) = temp(j) + ajj * b(j)
if ((j<1).or.(j>m)) then
write(psb_err_unit,*)&
& ' NUMBMM: Problem with A ',i,jj,j,m
endif
do k = ib(j),ib(j+1)-1
if((jb(k)<1).or. (jb(k) > maxlmn)) then
write(psb_err_unit,*)&
& ' NUMBMM: jb problem',j,k,jb(k),maxlmn
else
temp(jb(k)) = temp(jb(k)) + ajj * b(k)
endif
end do
end do rowi
! c = d + ...
if (diagc.eq.1 .and. i.le.minln) then
c(i) = temp(i)
temp(i) = 0.
endif
!$$$ if (mod(i,100) == 1)
!$$$ + write(psb_err_unit,*)
!$$$ ' NUMBMM: Fixing row ',i,ic(i),ic(i+1)-1
do j = ic(i),ic(i+1)-1
if((jc(j)<1).or. (jc(j) > maxlmn)) then
write(psb_err_unit,*)&
& ' NUMBMM: output problem',i,j,jc(j),maxlmn
else
c(j) = temp(jc(j))
temp(jc(j)) = 0.
endif
end do
end do
return
end subroutine snumbmm
! == =====================================================================
! Sparse Matrix Multiplication Package
!
! Randolph E. Bank and Craig C. Douglas
!
! na.bank@na-net.ornl.gov and na.cdouglas@na-net.ornl.gov
!
! Compile this with the following command (or a similar one):
!
! f77 -c -O smmp.f
!
! == =====================================================================
subroutine znumbmm(n, m, l, ia, ja, diaga, a, ib, jb, diagb, b,&
& ic, jc, diagc, c, temp)
!
use psb_const_mod
integer(psb_ipk_) :: ia(*), ja(*), diaga, ib(*), jb(*), diagb,&
& ic(*), jc(*), diagc
!
complex(psb_dpk_) :: a(*), b(*), c(*), temp(*),ajj
!
! numeric matrix multiply c=a*b
!
maxlmn = max(l,m,n)
do i = 1,maxlmn
temp(i) = 0.
end do
minlm = min(l,m)
minln = min(l,n)
minmn = min(m,n)
!
! c = a*b
!
do i = 1,n
rowi: do jj = ia(i),ia(i+1)
! a = d + ...
if (jj.eq.ia(i+1)) then
if (diaga.eq.0 .or. i.gt.minmn) cycle rowi
j = i
ajj = a(i)
else
j=ja(jj)
ajj = a(jj)
endif
! b = d + ...
if (diagb.eq.1 .and. j.le.minlm) &
& temp(j) = temp(j) + ajj * b(j)
if ((j<1).or.(j>m)) then
write(psb_err_unit,*)&
& ' NUMBMM: Problem with A ',i,jj,j,m
endif
do k = ib(j),ib(j+1)-1
if((jb(k)<1).or. (jb(k) > maxlmn)) then
write(psb_err_unit,*)&
& ' NUMBMM: jb problem',j,k,jb(k),maxlmn
else
temp(jb(k)) = temp(jb(k)) + ajj * b(k)
endif
end do
end do rowi
! c = d + ...
if (diagc.eq.1 .and. i.le.minln) then
c(i) = temp(i)
temp(i) = 0.
endif
do j = ic(i),ic(i+1)-1
if((jc(j)<1).or. (jc(j) > maxlmn)) then
write(psb_err_unit,*)&
& ' NUMBMM: output problem',i,j,jc(j),maxlmn
else
c(j) = temp(jc(j))
temp(jc(j)) = 0.
endif
end do
end do
return
end subroutine znumbmm

2
base/tools/Makefile
Unescape Escape View File

@ -35,7 +35,7 @@ lib: mpfobjs $(FOBJS)
mpfobjs:
(make $(MPFOBJS) F90="$(MPF90)" FC="$(MPF90)" FCOPT="$(F90COPT)")
(make $(MPFOBJS) FC="$(MPFC)")
clean:
/bin/rm -f $(MPFOBJS) $(FOBJS)

10599
configure vendored
View File

File diff suppressed because it is too large Load Diff

162
configure.ac
Unescape Escape View File

@ -36,11 +36,11 @@ dnl NOTE : There is no cross compilation support.
###############################################################################
# NOTE: the literal for version (the second argument to AC_INIT should be a literal!)
AC_INIT([PSBLAS],3.4, salvatore.filippone@uniroma2.it)
AC_INIT([PSBLAS],3.5, salvatore.filippone@cranfield.ac.uk)
# VERSION is the file containing the PSBLAS version code
# FIXME
psblas_cv_version="3.4"
psblas_cv_version="3.5"
# A sample source file
AC_CONFIG_SRCDIR([base/modules/psb_base_mod.f90])
@ -57,13 +57,13 @@ AC_MSG_NOTICE([
Be sure to specify the library paths of your interest. Examples:
./configure --with-libs=-L/some/directory/LIB <- will append to LIBS
FC=mpif90 F77=$FC CC=mpicc ./configure <- will force FC,CC,F77
FC=mpif90 CC=mpicc ./configure <- will force FC,CC
See ./configure --help=short fore more info.
--------------------------------------------------------------------------------
])
###############################################################################
# Compilers detection: FC,F77,CC should be set, if found.
# Compilers detection: FC,CC should be set, if found.
###############################################################################
#
# Installation.
@ -94,10 +94,16 @@ case $samplesdir in
esac
AC_MSG_RESULT([$INSTALL_DIR $INSTALL_INCLUDEDIR $INSTALL_LIBDIR $INSTALL_DOCSDIR $INSTALL_SAMPLESDIR])
# Note that the following line won't save from troubles.
dnl
dnl We set our own FC flags, ignore those from AC_PROG_FC but not those from the
dnl environment variable. Same for C
dnl
save_FCFLAGS="$FCFLAGS";
AC_PROG_FC([ftn xlf2003_r xlf2003 xlf95_r xlf95 xlf90 xlf pgf95 pgf90 ifort ifc nagfor gfortran])
AC_PROG_F77([ftn xlf pgf77 ifort ifc nagfor gfortran])
FCFLAGS="$save_FCFLAGS";
save_CFLAGS="$CFLAGS";
AC_PROG_CC([xlc pgcc icc gcc cc ])
CFLAGS="$save_CFLAGS";
dnl AC_PROG_CXX
dnl AC_PROG_F90 doesn't exist, at the time of writing this !
@ -124,7 +130,6 @@ PAC_ARG_SERIAL_MPI
if test x"$pac_cv_serial_mpi" == x"yes" ; then
FAKEMPI="fakempi.o";
MPIFC="$FC";
MPIF77="$F77";
MPICC="$CC";
else
AC_LANG([C])
@ -144,22 +149,13 @@ fi
ACX_MPI([], [AC_MSG_ERROR([[Cannot find any suitable MPI implementation for Fortran]])])
AC_LANG(Fortran 77)
if test "X$MPIF77" = "X" ; then
# This is our MPIFC compiler preference: it will override ACX_MPI's first try.
AC_CHECK_PROGS([MPIF77],[mpxlf mpf77 mpif77 ftn])
fi
ACX_MPI([], [AC_MSG_ERROR([[Cannot find any suitable MPI implementation for Fortran 77]])])
FC="$MPIFC" ;
F77="$MPIF77";
CC="$MPICC";
fi
# We leave a default language for the next checks.
dnl AC_LANG([Fortran 77])
AC_LANG([C])
dnl Now on, MPIFC should be set, as MPIF77 and MPICC
dnl Now on, MPIFC should be set, and MPICC
###############################################################################
# Sanity checks, although redundant (useful when debugging this configure.ac)!
@ -180,8 +176,6 @@ fi
dnl NOTE : no spaces before the comma, and no brackets before the second argument!
PAC_ARG_WITH_FLAGS(ccopt,CCOPT)
PAC_ARG_WITH_FLAGS(fcopt,FCOPT)
#PAC_ARG_WITH_FLAGS(f90copt,F90COPT)
#PAC_ARG_WITH_FLAGS(ldflags,LDFLAGS)
PAC_ARG_WITH_LIBS
PAC_ARG_WITH_FLAGS(clibs,CLIBS)
PAC_ARG_WITH_FLAGS(flibs,FLIBS)
@ -196,10 +190,8 @@ PAC_ARG_WITH_FLAGS(module-path,MODULE_PATH)
###############################################################################
dnl Library oriented Autotools facilities (we don't care about this for now)
dnl AC_PROG_LIBTOOL
dnl AM_MAINTAINER_MODE
AC_PROG_RANLIB
dnl system's ranlib will be found, too
AM_INIT_AUTOMAKE
dnl Specify required version of autoconf.
@ -250,7 +242,6 @@ if test x"$psblas_cv_fc" == "x" ; then
elif eval "$MPIFC -v 2>&1 | grep NAG 2>/dev/null" ; then
psblas_cv_fc="nag"
FC="$MPIFC"
F77="$MPIFC"
else
psblas_cv_fc=""
# unsupported MPI Fortran compiler
@ -263,10 +254,7 @@ PAC_HAVE_MODERN_GFORTRAN(
[AC_MSG_ERROR([Bailing out.])]
)
fi
# TODO : SEE _AC_PROG_FC_V
# TODO : AC_MSG_ERROR(see "$ac_cv_prog_FC_fc")
# AC_MSG_NOTICE( "ac_cv_prog_FC_fc : $ac_cv_prog_FC_fc")
###############################################################################
###############################################################################
# Linking, symbol mangling, and misc tests
@ -280,10 +268,6 @@ if test X"$ac_cv_sizeof_void_p" == X"8" ; then
CDEFINES="-DPtr64Bits $CDEFINES"
fi
AC_LANG([Fortran])
if test "X$psblas_cv_fc" == X"pg" ; then
save_FC=$FC
FC=$F77
fi
__AC_FC_NAME_MANGLING
if test "X$psblas_cv_fc" == X"pg" ; then
FC=$save_FC
@ -341,8 +325,10 @@ AC_MSG_RESULT([ $pac_f_c_names ])
###############################################################################
# Make.inc generation logic
###############################################################################
F90COPT="$FCOPT"
# Honor CFLAGS if they were specified explicitly, but --with-ccopt take precedence
if test "X$CCOPT" == "X" ; then
CCOPT="$CFLAGS";
fi
if test "X$CCOPT" == "X" ; then
if test "X$psblas_cv_fc" == "Xgcc" ; then
# note that no space should be placed around the equality symbol in assignements
@ -374,6 +360,10 @@ if test "X$CCOPT" == "X" ; then
fi
#CFLAGS="${CCOPT}"
# Honor FCFLAGS if they were specified explicitly, but --with-fcopt take precedence
if test "X$FCOPT" == "X" ; then
FCOPT="$FCFLAGS";
fi
if test "X$FCOPT" == "X" ; then
if test "X$psblas_cv_fc" == "Xgcc" ; then
# note that no space should be placed around the equality symbol in assignations
@ -405,71 +395,25 @@ if test "X$FCOPT" == "X" ; then
fi
if test "X$psblas_cv_fc" == X"nag" ; then
# Add needed options
FCOPT="$FCOPT -dcfuns -f2003 -wmismatch=mpi_scatterv,mpi_alltoallv,mpi_gatherv,mpi_allgatherv"
fi
#FFLAGS="${FCOPT}"
if test "X$F90COPT" == "X" ; then
if test "X$psblas_cv_fc" == "Xgcc" ; then
# note that no space should be placed around the equality symbol in assignations
# Note : 'native' is valid _only_ on GCC/x86 (32/64 bits)
F90COPT="-O3 $F90COPT"
elif test "X$psblas_cv_fc" == X"xlf" ; then
# XL compiler : consider using -qarch=auto
F90COPT="-O3 -qarch=auto -qsuffix=f=f90:cpp=F90 -qlanglvl=extended $F90COPT"
elif test "X$psblas_cv_fc" == X"ifc" ; then
# other compilers ..
F90COPT="-O3 $F90COPT"
elif test "X$psblas_cv_fc" == X"pg" ; then
# other compilers ..
F90COPT="-fast $F90COPT"
elif test "X$psblas_cv_fc" == X"sun" ; then
F90COPT="-fast $F90COPT"
elif test "X$psblas_cv_fc" == X"cray" ; then
MPIFC="ftn"
F90COPT="-O3 -em $F90COPT"
elif test "X$psblas_cv_fc" == X"nag" ; then
# NAG compiler
F90COPT="-O2"
else
# other compilers ..
F90COPT="-O2 $F90COPT"
fi
else
echo "Found FCFLAGS $F90COPT"
#F90COPT="${FCFLAGS}"
fi
if test "X$psblas_cv_fc" == X"nag" ; then
# Add needed options
F90COPT="$F90COPT -dcfuns -f2003 -wmismatch=mpi_scatterv,mpi_alltoallv,mpi_gatherv,mpi_allgatherv"
FCOPT="$FCOPT -dcfuns -f2003 -wmismatch=mpi_scatterv,mpi_alltoallv,mpi_gatherv,mpi_allgatherv"
EXTRA_OPT="-mismatch_all"
fi
#FCFLAGS="${F90COPT}"
# COPT,FCOPT, F90COPT are aliases for FFLAGS,CFLAGS,FCFLAGS .
# COPT,FCOPT are aliases for CFLAGS,FCFLAGS .
##############################################################################
# Compilers variables selection
##############################################################################
F90=${FC}
MPF90=${MPIFC}
FC=${FC}
MPF77=${MPIFC}
CC=${CC}
MPCC=${MPICC}
##############################################################################
# Choice of our compilers, needed by Make.inc
##############################################################################
if test "X$FLINK" == "X" ; then
FLINK=${MPF77}
fi
if test "X$F90LINK" == "X" ; then
F90LINK=${MPF90}
FLINK=${MPF90}
fi
##############################################################################
@ -753,11 +697,8 @@ AC_SUBST(PRECMODNAME)
AC_SUBST(METHDMODNAME)
AC_SUBST(UTILMODNAME)
AC_SUBST(BASELIBNAME)
AC_SUBST(F90)
AC_SUBST(F90COPT)
AC_SUBST(MPF90)
AC_SUBST(MPF77)
AC_SUBST(MPCC)
AC_SUBST(MPIFC)
AC_SUBST(MPICC)
AC_SUBST(FCOPT)
AC_SUBST(CCOPT)
AC_SUBST(EXTRA_OPT)
@ -765,9 +706,7 @@ AC_SUBST(FAKEMPI)
AC_SUBST(FIFLAG)
AC_SUBST(FMFLAG)
AC_SUBST(MODEXT)
AC_SUBST(MPIF77)
AC_SUBST(FLINK)
AC_SUBST(F90LINK)
AC_SUBST(LIBS)
AC_SUBST(AR)
AC_SUBST(RANLIB)
@ -800,14 +739,10 @@ FDEFINES=$(PSBFDEFINES)
# These should be portable rules, arent they?
.c.o:
$(CC) $(CCOPT) $(CINCLUDES) $(CDEFINES) -c $< -o $@
.f.o:
$(FC) $(FCOPT) $(FINCLUDES) -c $< -o $@
.f90.o:
$(F90) $(F90COPT) $(FINCLUDES) -c $< -o $@
.F.o:
$(FC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $< -o $@
$(FC) $(FCOPT) $(FINCLUDES) -c $< -o $@
.F90.o:
$(F90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $< -o $@'
$(FC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $< -o $@'
AC_SUBST(PSBLASRULES)
@ -830,55 +765,22 @@ dnl Please note that brackets around variable identifiers are absolutely needed
AC_MSG_NOTICE([
${PACKAGE_NAME} ${psblas_cv_version} has been configured as follows:
MPF90 : ${MPF90}
MPF77 : ${MPF77}
MPCC : ${MPICC}
dnl F90LINK : ${F90LINK}
MPIFC : ${MPIFC}
MPICC : ${MPICC}
FLINK : ${FLINK}
FDEFINES : ${FDEFINES}
CDEFINES : ${CDEFINES}
dnl CFLAGS : ${CFLAGS}
dnl FFLAGS : ${FFLAGS}
dnl FCFLAGS : ${FCFLAGS}
MODEXT : ${MODEXT}
FMFLAG : ${FMFLAG}
F90COPT : ${F90COPT}
FCOPT : ${FCOPT}
CCOPT : ${CCOPT}
dnl ESSL/PESSL : ${psblas_cv_have_essl} / ${psblas_cv_have_pessl}
BLAS : ${BLAS_LIBS}
dnl BLACS : ${BLACS_LIBS}
METIS detected : ${psblas_cv_have_metis}
AMD detected : ${psblas_cv_have_amd}
dnl SuperLU detected : ${psblas_cv_have_superlu}
dnl SuperLU_Dist detected : ${psblas_cv_have_superludist}
dnl UMFPack detected : ${psblas_cv_have_umfpack}
dnl F90 : ${F90}
dnl FC : ${FC}
dnl CC : ${CC}
dnl F77 : ${F77}
dnl FMFLAG : ${FMFLAG}
dnl FIFLAG : ${FIFLAG}
dnl MPICXX : ${MPICXX}
dnl MPIF77 : ${MPIF77}
dnl MPIFC : ${MPIFC}
dnl MPIF90 : ${MPIF90}
dnl MPCC : ${MPCC}
dnl AR : ${AR}
dnl RANLIB : ${RANLIB}
LIBS : ${LIBS}
dnl FIXME : CLIBS seems an useless variable..
dnl FIXME : FLIBS seems an useless variable..
dnl FIXME : LIBS seems an useless variable..
dnl CLIBS : ${CLIBS}
dnl FLIBS : ${CLIBS}
dnl LIBS : ${LIBS}
dnl Note : we should use LDLIBS sooner or later!
LDLIBS : ${LDLIBS}

1
prec/psb_d_bjacprec.f90
Unescape Escape View File

@ -134,6 +134,7 @@ module psb_d_bjacprec
contains
subroutine psb_d_bjac_precdescr(prec,iout,root)
use psb_penv_mod
use psb_penv_mod
use psb_error_mod
implicit none

2
prec/psb_d_diagprec.f90
Unescape Escape View File

@ -161,6 +161,8 @@ contains
subroutine psb_d_diag_precdescr(prec,iout,root)
use psb_penv_mod
use psb_error_mod
use psb_penv_mod
use psb_error_mod
Implicit None

2
prec/psb_d_nullprec.f90
Unescape Escape View File

@ -159,6 +159,8 @@ contains
subroutine psb_d_null_precdescr(prec,iout,root)
use psb_penv_mod
use psb_error_mod
use psb_penv_mod
use psb_error_mod
Implicit None

8
test/fileread/Makefile
Unescape Escape View File

@ -22,16 +22,16 @@ all: psb_sf_sample psb_df_sample psb_cf_sample psb_zf_sample
psb_sf_sample.o psb_df_sample.o psb_cf_sample.o psb_zf_sample.o: getp.o
psb_sf_sample: $(SFOBJS)
$(F90LINK) $(LOPT) $(SFOBJS) -o psb_sf_sample $(PSBLAS_LIB) $(LDLIBS)
$(FLINK) $(LOPT) $(SFOBJS) -o psb_sf_sample $(PSBLAS_LIB) $(LDLIBS)
/bin/mv psb_sf_sample $(EXEDIR)
psb_df_sample: $(DFOBJS)
$(F90LINK) $(LOPT) $(DFOBJS) -o psb_df_sample $(PSBLAS_LIB) $(LDLIBS)
$(FLINK) $(LOPT) $(DFOBJS) -o psb_df_sample $(PSBLAS_LIB) $(LDLIBS)
/bin/mv psb_df_sample $(EXEDIR)
psb_cf_sample: $(CFOBJS)
$(F90LINK) $(LOPT) $(CFOBJS) -o psb_cf_sample $(PSBLAS_LIB) $(LDLIBS)
$(FLINK) $(LOPT) $(CFOBJS) -o psb_cf_sample $(PSBLAS_LIB) $(LDLIBS)
/bin/mv psb_cf_sample $(EXEDIR)
psb_zf_sample: $(ZFOBJS)
$(F90LINK) $(LOPT) $(ZFOBJS) -o psb_zf_sample $(PSBLAS_LIB) $(LDLIBS)
$(FLINK) $(LOPT) $(ZFOBJS) -o psb_zf_sample $(PSBLAS_LIB) $(LDLIBS)
/bin/mv psb_zf_sample $(EXEDIR)
.f90.o:

4
test/hello/Makefile
Unescape Escape View File

@ -18,11 +18,11 @@ EXEDIR=./runs
all: hello pingpong
hello: hello.o
$(F90LINK) hello.o -o hello $(PSBLAS_LIB) $(LDLIBS)
$(FLINK) hello.o -o hello $(PSBLAS_LIB) $(LDLIBS)
/bin/mv hello $(EXEDIR)
pingpong: pingpong.o
$(F90LINK) pingpong.o -o pingpong $(PSBLAS_LIB) $(LDLIBS)
$(FLINK) pingpong.o -o pingpong $(PSBLAS_LIB) $(LDLIBS)
/bin/mv pingpong $(EXEDIR)

6
test/kernel/Makefile
Unescape Escape View File

@ -20,16 +20,16 @@ all: d_file_spmv s_file_spmv pdgenspmv
d_file_spmv: $(DTOBJS)
$(F90LINK) $(LOPT) $(DTOBJS) -o d_file_spmv $(PSBLAS_LIB) $(LDLIBS)
$(FLINK) $(LOPT) $(DTOBJS) -o d_file_spmv $(PSBLAS_LIB) $(LDLIBS)
/bin/mv d_file_spmv $(EXEDIR)
pdgenspmv: $(DPGOBJS)
$(F90LINK) $(LOPT) $(DPGOBJS) -o pdgenspmv $(PSBLAS_LIB) $(LDLIBS)
$(FLINK) $(LOPT) $(DPGOBJS) -o pdgenspmv $(PSBLAS_LIB) $(LDLIBS)
/bin/mv pdgenspmv $(EXEDIR)
s_file_spmv: $(STOBJS)
$(F90LINK) $(LOPT) $(STOBJS) -o s_file_spmv $(PSBLAS_LIB) $(LDLIBS)
$(FLINK) $(LOPT) $(STOBJS) -o s_file_spmv $(PSBLAS_LIB) $(LDLIBS)
/bin/mv s_file_spmv $(EXEDIR)

8
test/pargen/Makefile
Unescape Escape View File

@ -19,21 +19,21 @@ all: psb_d_pde3d psb_s_pde3d psb_d_pde2d psb_s_pde2d
psb_d_pde3d: psb_d_pde3d.o
$(F90LINK) psb_d_pde3d.o -o psb_d_pde3d $(PSBLAS_LIB) $(LDLIBS)
$(FLINK) psb_d_pde3d.o -o psb_d_pde3d $(PSBLAS_LIB) $(LDLIBS)
/bin/mv psb_d_pde3d $(EXEDIR)
psb_s_pde3d: psb_s_pde3d.o
$(F90LINK) psb_s_pde3d.o -o psb_s_pde3d $(PSBLAS_LIB) $(LDLIBS)
$(FLINK) psb_s_pde3d.o -o psb_s_pde3d $(PSBLAS_LIB) $(LDLIBS)
/bin/mv psb_s_pde3d $(EXEDIR)
psb_d_pde2d: psb_d_pde2d.o
$(F90LINK) psb_d_pde2d.o -o psb_d_pde2d $(PSBLAS_LIB) $(LDLIBS)
$(FLINK) psb_d_pde2d.o -o psb_d_pde2d $(PSBLAS_LIB) $(LDLIBS)
/bin/mv psb_d_pde2d $(EXEDIR)
psb_s_pde2d: psb_s_pde2d.o
$(F90LINK) psb_s_pde2d.o -o psb_s_pde2d $(PSBLAS_LIB) $(LDLIBS)
$(FLINK) psb_s_pde2d.o -o psb_s_pde2d $(PSBLAS_LIB) $(LDLIBS)
/bin/mv psb_s_pde2d $(EXEDIR)

2
test/serial/Makefile
Unescape Escape View File

@ -19,7 +19,7 @@ all: d_matgen
psb_d_xyz_impl.o d_matgen.o: psb_d_xyz_mat_mod.o
d_matgen: d_matgen.o psb_d_xyz_mat_mod.o psb_d_xyz_impl.o
$(F90LINK) $(LINKOPT) d_matgen.o psb_d_xyz_mat_mod.o psb_d_xyz_impl.o \
$(FLINK) $(LINKOPT) d_matgen.o psb_d_xyz_mat_mod.o psb_d_xyz_impl.o \
-o d_matgen $(PSBLAS_LIB) $(LDLIBS)
/bin/cp -p $(CPUPDFLAG) d_matgen $(EXEDIR)
# /bin/mv d_matgen $(EXEDIR)

4
test/torture/Makefile
Unescape Escape View File

@ -19,14 +19,14 @@ psb_mvsv_tester.o: psb_s_mvsv_tester.o psb_d_mvsv_tester.o psb_c_mvsv_tester.o \
psb_z_mvsv_tester.o
psbtf: $(PSBTOBJS)
$(F90LINK) $(PSBTOBJS) -o psbtf $(PSBLAS_LIB) $(LDLIBS)
$(FLINK) $(PSBTOBJS) -o psbtf $(PSBLAS_LIB) $(LDLIBS)
/bin/mv psbtf $(EXEDIR)
psbtf.o: psb_mvsv_tester.o
.f90.o:
$(MPF90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
$(MPFC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $<
clean:

10
test/util/Makefile
Unescape Escape View File

@ -20,16 +20,16 @@ MMHBOBJS=$(ZH2MOBJS) $(DH2MOBJS) $(DM2HOBJS) $(ZM2HOBJS)
all: dhb2mm zhb2mm dmm2hb zmm2hb
dhb2mm: $(DH2MOBJS)
$(MPF90) -o dhb2mm $(DH2MOBJS) $(PSBLAS_LIB) $(LDLIBS)
$(MPFC) -o dhb2mm $(DH2MOBJS) $(PSBLAS_LIB) $(LDLIBS)
dmm2hb: $(DM2HOBJS)
$(MPF90) -o dmm2hb $(DM2HOBJS) $(PSBLAS_LIB) $(LDLIBS)
$(MPFC) -o dmm2hb $(DM2HOBJS) $(PSBLAS_LIB) $(LDLIBS)
zhb2mm: $(ZH2MOBJS)
$(MPF90) -o zhb2mm $(ZH2MOBJS) $(PSBLAS_LIB) $(LDLIBS)
$(MPFC) -o zhb2mm $(ZH2MOBJS) $(PSBLAS_LIB) $(LDLIBS)
zmm2hb: $(ZM2HOBJS)
$(MPF90) -o zmm2hb $(ZM2HOBJS) $(PSBLAS_LIB) $(LDLIBS)
$(MPFC) -o zmm2hb $(ZM2HOBJS) $(PSBLAS_LIB) $(LDLIBS)
.f90.o:
$(MPF90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
$(MPFC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $<
clean:
/bin/rm -f $(MMHBOBJS) dhb2mm zhb2mm dmm2hb zmm2hb

Write Preview
Loading…
Cancel
Save