mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-18 11:52:11 +00:00
psblas3-mcbind:
. 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 docs/html/footnode.html docs/html/img1.png docs/html/img10.png docs/html/img100.png docs/html/img101.png docs/html/img102.png docs/html/img103.png docs/html/img104.png docs/html/img105.png docs/html/img106.png docs/html/img107.png docs/html/img108.png docs/html/img109.png docs/html/img11.png docs/html/img110.png docs/html/img111.png docs/html/img112.png docs/html/img113.png docs/html/img114.png docs/html/img115.png docs/html/img116.png docs/html/img117.png docs/html/img118.png docs/html/img119.png docs/html/img12.png docs/html/img120.png docs/html/img121.png docs/html/img122.png docs/html/img123.png docs/html/img124.png docs/html/img125.png docs/html/img126.png docs/html/img127.png docs/html/img128.png docs/html/img129.png docs/html/img13.png docs/html/img130.png docs/html/img131.png docs/html/img132.png docs/html/img133.png docs/html/img134.png docs/html/img135.png docs/html/img136.png docs/html/img137.png docs/html/img138.png docs/html/img139.png docs/html/img14.png docs/html/img140.png docs/html/img142.png docs/html/img144.png docs/html/img145.png docs/html/img146.png docs/html/img147.png docs/html/img148.png docs/html/img149.png docs/html/img15.png docs/html/img150.png docs/html/img151.png docs/html/img152.png docs/html/img153.png docs/html/img154.png docs/html/img155.png docs/html/img156.png docs/html/img157.png docs/html/img158.png docs/html/img159.png docs/html/img16.png docs/html/img160.png docs/html/img161.png docs/html/img162.png docs/html/img163.png docs/html/img164.png docs/html/img165.png docs/html/img166.png docs/html/img17.png docs/html/img18.png docs/html/img19.png docs/html/img2.png docs/html/img20.png docs/html/img21.png docs/html/img22.png docs/html/img23.png docs/html/img24.png docs/html/img25.png docs/html/img26.png docs/html/img27.png docs/html/img28.png docs/html/img29.png docs/html/img3.png docs/html/img30.png docs/html/img31.png docs/html/img32.png docs/html/img33.png docs/html/img34.png docs/html/img35.png docs/html/img36.png docs/html/img37.png docs/html/img38.png docs/html/img39.png docs/html/img4.png docs/html/img40.png docs/html/img41.png docs/html/img42.png docs/html/img43.png docs/html/img44.png docs/html/img45.png docs/html/img46.png docs/html/img47.png docs/html/img48.png docs/html/img49.png docs/html/img5.png docs/html/img50.png docs/html/img51.png docs/html/img52.png docs/html/img53.png docs/html/img54.png docs/html/img55.png docs/html/img56.png docs/html/img57.png docs/html/img58.png docs/html/img59.png docs/html/img6.png docs/html/img60.png docs/html/img61.png docs/html/img62.png docs/html/img63.png docs/html/img64.png docs/html/img65.png docs/html/img66.png docs/html/img67.png docs/html/img68.png docs/html/img69.png docs/html/img7.png docs/html/img70.png docs/html/img71.png docs/html/img72.png docs/html/img73.png docs/html/img74.png docs/html/img75.png docs/html/img76.png docs/html/img77.png docs/html/img78.png docs/html/img79.png docs/html/img8.png docs/html/img80.png docs/html/img81.png docs/html/img82.png docs/html/img83.png docs/html/img84.png docs/html/img85.png docs/html/img86.png docs/html/img87.png docs/html/img88.png docs/html/img89.png docs/html/img9.png docs/html/img90.png docs/html/img91.png docs/html/img92.png docs/html/img93.png docs/html/img94.png docs/html/img95.png docs/html/img96.png docs/html/img97.png docs/html/img98.png docs/html/img99.png docs/html/index.html docs/html/node1.html docs/html/node10.html docs/html/node100.html docs/html/node101.html docs/html/node102.html docs/html/node103.html docs/html/node104.html docs/html/node105.html docs/html/node106.html docs/html/node107.html docs/html/node108.html docs/html/node109.html docs/html/node11.html docs/html/node110.html docs/html/node111.html docs/html/node112.html docs/html/node113.html docs/html/node114.html docs/html/node115.html docs/html/node116.html docs/html/node117.html docs/html/node118.html docs/html/node119.html docs/html/node12.html docs/html/node120.html docs/html/node121.html docs/html/node122.html docs/html/node123.html docs/html/node124.html docs/html/node125.html docs/html/node126.html docs/html/node127.html docs/html/node128.html docs/html/node129.html docs/html/node13.html docs/html/node130.html docs/html/node14.html docs/html/node15.html docs/html/node16.html docs/html/node17.html docs/html/node18.html docs/html/node19.html docs/html/node2.html docs/html/node20.html docs/html/node21.html docs/html/node22.html docs/html/node23.html docs/html/node24.html docs/html/node25.html docs/html/node26.html docs/html/node27.html docs/html/node28.html docs/html/node29.html docs/html/node3.html docs/html/node30.html docs/html/node31.html docs/html/node32.html docs/html/node33.html docs/html/node34.html docs/html/node35.html docs/html/node36.html docs/html/node37.html docs/html/node38.html docs/html/node39.html docs/html/node4.html docs/html/node40.html docs/html/node41.html docs/html/node42.html docs/html/node43.html docs/html/node44.html docs/html/node45.html docs/html/node46.html docs/html/node47.html docs/html/node48.html docs/html/node49.html docs/html/node5.html docs/html/node50.html docs/html/node51.html docs/html/node52.html docs/html/node53.html docs/html/node54.html docs/html/node55.html docs/html/node56.html docs/html/node57.html docs/html/node58.html docs/html/node59.html docs/html/node6.html docs/html/node60.html docs/html/node61.html docs/html/node62.html docs/html/node63.html docs/html/node64.html docs/html/node65.html docs/html/node66.html docs/html/node67.html docs/html/node68.html docs/html/node69.html docs/html/node7.html docs/html/node70.html docs/html/node71.html docs/html/node72.html docs/html/node73.html docs/html/node74.html docs/html/node75.html docs/html/node76.html docs/html/node77.html docs/html/node78.html docs/html/node79.html docs/html/node8.html docs/html/node80.html docs/html/node81.html docs/html/node82.html docs/html/node83.html docs/html/node84.html docs/html/node85.html docs/html/node86.html docs/html/node87.html docs/html/node88.html docs/html/node89.html docs/html/node9.html docs/html/node90.html docs/html/node91.html docs/html/node92.html docs/html/node93.html docs/html/node94.html docs/html/node95.html docs/html/node96.html docs/html/node97.html docs/html/node98.html docs/html/node99.html docs/html/userhtml.html docs/psblas-3.4.pdf docs/psblas-3.5.pdf docs/src/Makefile docs/src/precs.tex docs/src/userguide.tex docs/src/userhtml.tex prec/impl/psb_c_bjacprec_impl.f90 prec/impl/psb_c_diagprec_impl.f90 prec/impl/psb_c_prec_type_impl.f90 prec/impl/psb_cprecbld.f90 prec/impl/psb_cprecinit.f90 prec/impl/psb_d_bjacprec_impl.f90 prec/impl/psb_d_diagprec_impl.f90 prec/impl/psb_d_prec_type_impl.f90 prec/impl/psb_dprecbld.f90 prec/impl/psb_dprecinit.f90 prec/impl/psb_s_bjacprec_impl.f90 prec/impl/psb_s_diagprec_impl.f90 prec/impl/psb_s_prec_type_impl.f90 prec/impl/psb_sprecbld.f90 prec/impl/psb_sprecinit.f90 prec/impl/psb_z_bjacprec_impl.f90 prec/impl/psb_z_diagprec_impl.f90 prec/impl/psb_z_prec_type_impl.f90 prec/impl/psb_zprecbld.f90 prec/impl/psb_zprecinit.f90 prec/psb_c_base_prec_mod.f90 prec/psb_c_bjacprec.f90 prec/psb_c_diagprec.f90 prec/psb_c_nullprec.f90 prec/psb_c_prec_mod.f90 prec/psb_c_prec_type.f90 prec/psb_d_base_prec_mod.f90 prec/psb_d_bjacprec.f90 prec/psb_d_diagprec.f90 prec/psb_d_nullprec.f90 prec/psb_d_prec_mod.f90 prec/psb_d_prec_type.f90 prec/psb_s_base_prec_mod.f90 prec/psb_s_bjacprec.f90 prec/psb_s_diagprec.f90 prec/psb_s_nullprec.f90 prec/psb_s_prec_mod.f90 prec/psb_s_prec_type.f90 prec/psb_z_base_prec_mod.f90 prec/psb_z_bjacprec.f90 prec/psb_z_diagprec.f90 prec/psb_z_nullprec.f90 prec/psb_z_prec_mod.f90 prec/psb_z_prec_type.f90 test/fileread/Makefile test/fileread/psb_cf_sample.f90 test/fileread/psb_df_sample.f90 test/fileread/psb_sf_sample.f90 test/fileread/psb_zf_sample.f90 test/hello/Makefile test/kernel/Makefile test/pargen/Makefile test/pargen/psb_d_pde2d.f90 test/pargen/psb_d_pde3d.f90 test/pargen/psb_s_pde2d.f90 test/pargen/psb_s_pde3d.f90 test/serial/Makefile test/torture/Makefile test/util/Makefile Merged changes from trunk.
This commit is contained in:
Salvatore Filippone
+3
-7
@@ -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@
|
||||
|
||||
|
||||
+1
-1
@@ -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:
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
+1
-1
@@ -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)
|
||||
|
||||
+32
-127
@@ -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 !
|
||||
@@ -132,7 +138,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])
|
||||
@@ -152,22 +157,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)!
|
||||
@@ -188,8 +184,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)
|
||||
@@ -204,10 +198,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.
|
||||
@@ -258,7 +250,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
|
||||
@@ -271,10 +262,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
|
||||
@@ -288,10 +276,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
|
||||
@@ -349,8 +333,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
|
||||
@@ -382,6 +368,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
|
||||
@@ -413,56 +403,17 @@ 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
|
||||
|
||||
|
||||
# COPT,FCOPT are aliases for CFLAGS,FCFLAGS .
|
||||
##############################################################################
|
||||
# Compilers variables selection
|
||||
##############################################################################
|
||||
F90=${FC}
|
||||
MPF90=${MPIFC}
|
||||
FC=${FC}
|
||||
MPF77=${MPIFC}
|
||||
CC=${CC}
|
||||
MPCC=${MPICC}
|
||||
CCOPT="$CCOPT $C99OPT"
|
||||
|
||||
|
||||
@@ -470,11 +421,7 @@ CCOPT="$CCOPT $C99OPT"
|
||||
# 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
|
||||
|
||||
##############################################################################
|
||||
@@ -759,11 +706,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)
|
||||
@@ -771,9 +715,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)
|
||||
@@ -806,14 +748,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)
|
||||
@@ -836,55 +774,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}
|
||||
|
||||
|
||||
@@ -18,7 +18,7 @@ original version by: Nikos Drakos, CBLU, University of Leeds
|
||||
|
||||
<LINK REL="STYLESHEET" HREF="userhtml.css">
|
||||
|
||||
<LINK REL="previous" HREF="node131.html">
|
||||
<LINK REL="previous" HREF="node132.html">
|
||||
<LINK REL="up" HREF="userhtml.html">
|
||||
</HEAD>
|
||||
|
||||
@@ -140,12 +140,12 @@ sample scatter/gather routines.
|
||||
.
|
||||
</PRE>
|
||||
</DD>
|
||||
<DT><A NAME="foot7956">... method</A><A
|
||||
HREF="node130.html#tex2html31"><SUP>4</SUP></A></DT>
|
||||
<DT><A NAME="foot8033">... method</A><A
|
||||
HREF="node131.html#tex2html31"><SUP>4</SUP></A></DT>
|
||||
<DD>Note:
|
||||
the implementation is for <IMG
|
||||
WIDTH="62" HEIGHT="32" ALIGN="MIDDLE" BORDER="0"
|
||||
SRC="img162.png"
|
||||
WIDTH="61" HEIGHT="32" ALIGN="MIDDLE" BORDER="0"
|
||||
SRC="img163.png"
|
||||
ALT="$FCG(1)$">.
|
||||
|
||||
<PRE>.
|
||||
|
||||
Binary file not shown.
|
Before Width: | Height: | Size: 193 B After Width: | Height: | Size: 200 B |
Binary file not shown.
|
Before Width: | Height: | Size: 358 B After Width: | Height: | Size: 401 B |
Binary file not shown.
|
Before Width: | Height: | Size: 338 B After Width: | Height: | Size: 367 B |
Binary file not shown.
|
Before Width: | Height: | Size: 219 B After Width: | Height: | Size: 221 B |
Binary file not shown.
|
Before Width: | Height: | Size: 315 B After Width: | Height: | Size: 341 B |
Binary file not shown.
|
Before Width: | Height: | Size: 259 B After Width: | Height: | Size: 258 B |
Binary file not shown.
|
Before Width: | Height: | Size: 184 B After Width: | Height: | Size: 184 B |
Binary file not shown.
|
Before Width: | Height: | Size: 616 B After Width: | Height: | Size: 736 B |
Binary file not shown.
|
Before Width: | Height: | Size: 331 B After Width: | Height: | Size: 373 B |
Binary file not shown.
|
Before Width: | Height: | Size: 134 B After Width: | Height: | Size: 134 B |
Binary file not shown.
|
Before Width: | Height: | Size: 254 B After Width: | Height: | Size: 251 B |
Binary file not shown.
|
Before Width: | Height: | Size: 355 B After Width: | Height: | Size: 387 B |
Binary file not shown.
|
Before Width: | Height: | Size: 466 B After Width: | Height: | Size: 529 B |
Binary file not shown.
|
Before Width: | Height: | Size: 240 B After Width: | Height: | Size: 263 B |
Binary file not shown.
|
Before Width: | Height: | Size: 233 B After Width: | Height: | Size: 244 B |
Binary file not shown.
|
Before Width: | Height: | Size: 221 B After Width: | Height: | Size: 222 B |
Binary file not shown.
|
Before Width: | Height: | Size: 363 B After Width: | Height: | Size: 374 B |
Binary file not shown.
|
Before Width: | Height: | Size: 203 B After Width: | Height: | Size: 222 B |
Binary file not shown.
|
Before Width: | Height: | Size: 244 B After Width: | Height: | Size: 259 B |
Binary file not shown.
|
Before Width: | Height: | Size: 780 B After Width: | Height: | Size: 804 B |
Binary file not shown.
|
Before Width: | Height: | Size: 369 B After Width: | Height: | Size: 408 B |
Binary file not shown.
|
Before Width: | Height: | Size: 387 B After Width: | Height: | Size: 419 B |
Binary file not shown.
|
Before Width: | Height: | Size: 325 B After Width: | Height: | Size: 354 B |
Binary file not shown.
|
Before Width: | Height: | Size: 123 B After Width: | Height: | Size: 129 B |
Binary file not shown.
|
Before Width: | Height: | Size: 298 B After Width: | Height: | Size: 310 B |
Binary file not shown.
|
Before Width: | Height: | Size: 801 B After Width: | Height: | Size: 835 B |
Binary file not shown.
|
Before Width: | Height: | Size: 299 B After Width: | Height: | Size: 335 B |
Binary file not shown.
|
Before Width: | Height: | Size: 491 B After Width: | Height: | Size: 497 B |
Binary file not shown.
|
Before Width: | Height: | Size: 384 B After Width: | Height: | Size: 403 B |
Binary file not shown.
|
Before Width: | Height: | Size: 239 B After Width: | Height: | Size: 266 B |
Binary file not shown.
|
Before Width: | Height: | Size: 488 B After Width: | Height: | Size: 533 B |
Binary file not shown.
|
Before Width: | Height: | Size: 530 B After Width: | Height: | Size: 544 B |
Binary file not shown.
|
Before Width: | Height: | Size: 318 B After Width: | Height: | Size: 334 B |
Binary file not shown.
|
Before Width: | Height: | Size: 223 B After Width: | Height: | Size: 223 B |
Binary file not shown.
|
Before Width: | Height: | Size: 2.9 KiB After Width: | Height: | Size: 2.9 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 484 B After Width: | Height: | Size: 519 B |
Binary file not shown.
|
Before Width: | Height: | Size: 517 B After Width: | Height: | Size: 604 B |
Binary file not shown.
|
Before Width: | Height: | Size: 498 B After Width: | Height: | Size: 577 B |
Binary file not shown.
|
Before Width: | Height: | Size: 208 B After Width: | Height: | Size: 208 B |
Binary file not shown.
|
Before Width: | Height: | Size: 527 B After Width: | Height: | Size: 568 B |
Binary file not shown.
|
Before Width: | Height: | Size: 675 B After Width: | Height: | Size: 743 B |
Binary file not shown.
|
Before Width: | Height: | Size: 244 B After Width: | Height: | Size: 246 B |
Binary file not shown.
|
Before Width: | Height: | Size: 499 B After Width: | Height: | Size: 521 B |
Binary file not shown.
|
Before Width: | Height: | Size: 259 B After Width: | Height: | Size: 259 B |
Binary file not shown.
|
Before Width: | Height: | Size: 488 B After Width: | Height: | Size: 570 B |
Binary file not shown.
|
Before Width: | Height: | Size: 580 B After Width: | Height: | Size: 650 B |
Binary file not shown.
|
Before Width: | Height: | Size: 234 B After Width: | Height: | Size: 237 B |
Binary file not shown.
|
Before Width: | Height: | Size: 8.0 KiB After Width: | Height: | Size: 8.4 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 987 B After Width: | Height: | Size: 1.1 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 710 B After Width: | Height: | Size: 710 B |
Binary file not shown.
|
Before Width: | Height: | Size: 808 B After Width: | Height: | Size: 875 B |
Binary file not shown.
|
Before Width: | Height: | Size: 846 B After Width: | Height: | Size: 848 B |
Binary file not shown.
|
Before Width: | Height: | Size: 1.0 KiB After Width: | Height: | Size: 1.0 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 1.2 KiB After Width: | Height: | Size: 1.2 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 218 B After Width: | Height: | Size: 218 B |
Binary file not shown.
|
Before Width: | Height: | Size: 922 B After Width: | Height: | Size: 931 B |
Binary file not shown.
|
Before Width: | Height: | Size: 997 B After Width: | Height: | Size: 1001 B |
Binary file not shown.
|
Before Width: | Height: | Size: 1.0 KiB After Width: | Height: | Size: 1.0 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 1008 B After Width: | Height: | Size: 1009 B |
Binary file not shown.
|
Before Width: | Height: | Size: 327 B After Width: | Height: | Size: 372 B |
Binary file not shown.
|
Before Width: | Height: | Size: 406 B After Width: | Height: | Size: 433 B |
Binary file not shown.
|
Before Width: | Height: | Size: 809 B After Width: | Height: | Size: 262 B |
Binary file not shown.
|
Before Width: | Height: | Size: 600 B After Width: | Height: | Size: 916 B |
Binary file not shown.
|
Before Width: | Height: | Size: 591 B After Width: | Height: | Size: 675 B |
Binary file not shown.
|
Before Width: | Height: | Size: 207 B After Width: | Height: | Size: 591 B |
Binary file not shown.
|
Before Width: | Height: | Size: 187 B After Width: | Height: | Size: 187 B |
Binary file not shown.
|
Before Width: | Height: | Size: 383 B After Width: | Height: | Size: 210 B |
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user