Merge psblas-ext into psblas, step 1: ext storage formats.
sfilippone
1 year ago
parent
d1bf46b0b1
commit
1d5faa388d
@ -0,0 +1,84 @@
|
||||
include ../Make.inc
|
||||
#
|
||||
# Libraries used
|
||||
#
|
||||
LIBDIR=../lib
|
||||
INCDIR=../include
|
||||
MODDIR=../modules
|
||||
#
|
||||
# Compilers and such
|
||||
#
|
||||
#CCOPT= -g
|
||||
FINCLUDES=$(FMFLAG). $(FMFLAG)$(INCDIR) $(FMFLAG)$(MODDIR) $(FIFLAG).
|
||||
CINCLUDES=
|
||||
LIBNAME=libpsb_ext.a
|
||||
|
||||
|
||||
FOBJS= psb_d_ell_mat_mod.o psb_d_hll_mat_mod.o \
|
||||
psb_s_hll_mat_mod.o psb_s_ell_mat_mod.o \
|
||||
psb_c_hll_mat_mod.o psb_c_ell_mat_mod.o \
|
||||
psb_z_hll_mat_mod.o psb_z_ell_mat_mod.o \
|
||||
psb_d_dia_mat_mod.o psb_d_hdia_mat_mod.o \
|
||||
psb_s_dia_mat_mod.o psb_s_hdia_mat_mod.o \
|
||||
psb_c_dia_mat_mod.o psb_c_hdia_mat_mod.o \
|
||||
psb_z_dia_mat_mod.o psb_z_hdia_mat_mod.o \
|
||||
psb_s_dns_mat_mod.o psb_d_dns_mat_mod.o \
|
||||
psb_c_dns_mat_mod.o psb_z_dns_mat_mod.o \
|
||||
psi_ext_util_mod.o psi_i_ext_util_mod.o \
|
||||
psi_s_ext_util_mod.o psi_c_ext_util_mod.o \
|
||||
psi_d_ext_util_mod.o psi_z_ext_util_mod.o \
|
||||
psb_ext_mod.o
|
||||
|
||||
COBJS=
|
||||
|
||||
OBJS=$(COBJS) $(FOBJS)
|
||||
|
||||
lib: objs ilib
|
||||
ar cur $(LIBNAME) $(OBJS)
|
||||
/bin/cp -p $(LIBNAME) $(LIBDIR)
|
||||
|
||||
objs: $(OBJS) iobjs
|
||||
/bin/cp -p *$(.mod) $(MODDIR)
|
||||
|
||||
|
||||
|
||||
psb_ext_mod.o: psb_s_dia_mat_mod.o psb_d_dia_mat_mod.o \
|
||||
psb_c_dia_mat_mod.o psb_z_dia_mat_mod.o \
|
||||
psb_d_ell_mat_mod.o psb_d_hll_mat_mod.o \
|
||||
psb_s_hll_mat_mod.o psb_s_ell_mat_mod.o \
|
||||
psb_c_hll_mat_mod.o psb_c_ell_mat_mod.o \
|
||||
psb_z_hll_mat_mod.o psb_z_ell_mat_mod.o \
|
||||
psb_s_hdia_mat_mod.o psb_d_hdia_mat_mod.o \
|
||||
psb_c_hdia_mat_mod.o psb_z_hdia_mat_mod.o \
|
||||
psb_s_dns_mat_mod.o psb_d_dns_mat_mod.o \
|
||||
psb_c_dns_mat_mod.o psb_z_dns_mat_mod.o
|
||||
|
||||
# psb_d_rsb_mat_mod.o psb_d_hdia_mat_mod.o
|
||||
psi_ext_util_mod.o: psi_i_ext_util_mod.o \
|
||||
psi_s_ext_util_mod.o psi_c_ext_util_mod.o \
|
||||
psi_d_ext_util_mod.o psi_z_ext_util_mod.o
|
||||
|
||||
psb_s_dia_mat_mod.o psb_c_dia_mat_mod.o psb_d_dia_mat_mod.o psb_z_dia_mat_mod.o: psi_ext_util_mod.o
|
||||
psb_s_hdia_mat_mod.o psb_c_hdia_mat_mod.o psb_d_hdia_mat_mod.o psb_z_hdia_mat_mod.o: psi_ext_util_mod.o
|
||||
psb_s_hll_mat_mod.o psb_c_hll_mat_mod.o psb_d_hll_mat_mod.o psb_z_hll_mat_mod.o: psi_ext_util_mod.o
|
||||
|
||||
ilib: objs
|
||||
$(MAKE) -C impl lib LIBNAME=$(LIBNAME)
|
||||
|
||||
iobjs: $(OBJS)
|
||||
$(MAKE) -C impl objs
|
||||
|
||||
clean: cclean iclean
|
||||
/bin/rm -f $(FOBJS) *$(.mod) *.a
|
||||
|
||||
cclean:
|
||||
/bin/rm -f $(COBJS)
|
||||
iclean:
|
||||
$(MAKE) -C impl clean
|
||||
|
||||
veryclean: clean
|
||||
/bin/rm -f $(HERE)/$(LIBNAME) $(LIBMOD) *$(.mod)
|
||||
|
||||
|
||||
|
||||
|
||||
@ -0,0 +1,412 @@
|
||||
include ../../Make.inc
|
||||
LIBDIR=../../lib
|
||||
INCDIR=../../include
|
||||
MODDIR=../../modules
|
||||
#
|
||||
# Compilers and such
|
||||
#
|
||||
#CCOPT= -g
|
||||
FINCLUDES=$(FMFLAG).. $(FMFLAG)$(MODDIR) $(FMFLAG)$(INCDIR) $(FIFLAG)..
|
||||
LIBNAME=libpsb_ext.a
|
||||
|
||||
OBJS= \
|
||||
psb_s_cp_dia_from_coo.o \
|
||||
psb_s_cp_dia_to_coo.o \
|
||||
psb_s_cp_ell_from_coo.o \
|
||||
psb_s_cp_ell_from_fmt.o \
|
||||
psb_s_cp_ell_to_coo.o \
|
||||
psb_s_cp_ell_to_fmt.o \
|
||||
psb_s_cp_hdia_from_coo.o \
|
||||
psb_s_cp_hdia_to_coo.o \
|
||||
psb_s_cp_hll_from_coo.o \
|
||||
psb_s_cp_hll_from_fmt.o \
|
||||
psb_s_cp_hll_to_coo.o \
|
||||
psb_s_cp_hll_to_fmt.o \
|
||||
psb_s_dia_aclsum.o \
|
||||
psb_s_dia_allocate_mnnz.o \
|
||||
psb_s_dia_arwsum.o \
|
||||
psb_s_dia_colsum.o \
|
||||
psb_s_dia_csgetptn.o \
|
||||
psb_s_dia_csgetrow.o \
|
||||
psb_s_dia_csmm.o \
|
||||
psb_s_dia_csmv.o \
|
||||
psb_s_dia_get_diag.o \
|
||||
psb_s_dia_maxval.o \
|
||||
psb_s_dia_mold.o \
|
||||
psb_s_dia_print.o \
|
||||
psb_s_dia_reallocate_nz.o \
|
||||
psb_s_dia_reinit.o \
|
||||
psb_s_dia_rowsum.o \
|
||||
psb_s_dia_scal.o \
|
||||
psb_s_dia_scals.o \
|
||||
psb_s_ell_aclsum.o \
|
||||
psb_s_ell_allocate_mnnz.o \
|
||||
psb_s_ell_arwsum.o \
|
||||
psb_s_ell_colsum.o \
|
||||
psb_s_ell_csgetblk.o \
|
||||
psb_s_ell_csgetptn.o \
|
||||
psb_s_ell_csgetrow.o \
|
||||
psb_s_ell_csmm.o \
|
||||
psb_s_ell_csmv.o \
|
||||
psb_s_ell_csnm1.o \
|
||||
psb_s_ell_csnmi.o \
|
||||
psb_s_ell_csput.o \
|
||||
psb_s_ell_cssm.o \
|
||||
psb_s_ell_cssv.o \
|
||||
psb_s_ell_get_diag.o \
|
||||
psb_s_ell_maxval.o \
|
||||
psb_s_ell_mold.o \
|
||||
psb_s_ell_print.o \
|
||||
psb_s_ell_reallocate_nz.o \
|
||||
psb_s_ell_reinit.o \
|
||||
psb_s_ell_rowsum.o \
|
||||
psb_s_ell_scal.o \
|
||||
psb_s_ell_scals.o \
|
||||
psb_s_ell_trim.o \
|
||||
psb_s_hdia_allocate_mnnz.o \
|
||||
psb_s_hdia_csmv.o \
|
||||
psb_s_hdia_mold.o \
|
||||
psb_s_hdia_print.o \
|
||||
psb_s_hll_aclsum.o \
|
||||
psb_s_hll_allocate_mnnz.o \
|
||||
psb_s_hll_arwsum.o \
|
||||
psb_s_hll_colsum.o \
|
||||
psb_s_hll_csgetblk.o \
|
||||
psb_s_hll_csgetptn.o \
|
||||
psb_s_hll_csgetrow.o \
|
||||
psb_s_hll_csmm.o \
|
||||
psb_s_hll_csmv.o \
|
||||
psb_s_hll_csnm1.o \
|
||||
psb_s_hll_csnmi.o \
|
||||
psb_s_hll_csput.o \
|
||||
psb_s_hll_cssm.o \
|
||||
psb_s_hll_cssv.o \
|
||||
psb_s_hll_get_diag.o \
|
||||
psb_s_hll_maxval.o \
|
||||
psb_s_hll_mold.o \
|
||||
psb_s_hll_print.o \
|
||||
psb_s_hll_reallocate_nz.o \
|
||||
psb_s_hll_reinit.o \
|
||||
psb_s_hll_rowsum.o \
|
||||
psb_s_hll_scal.o \
|
||||
psb_s_hll_scals.o \
|
||||
psb_s_mv_dia_from_coo.o \
|
||||
psb_s_mv_ell_from_coo.o \
|
||||
psb_s_mv_ell_from_fmt.o \
|
||||
psb_s_mv_ell_to_coo.o \
|
||||
psb_s_mv_ell_to_fmt.o \
|
||||
psb_s_mv_hdia_from_coo.o \
|
||||
psb_s_mv_hdia_to_coo.o \
|
||||
psb_s_mv_hll_from_coo.o \
|
||||
psb_s_mv_hll_from_fmt.o \
|
||||
psb_s_mv_hll_to_coo.o \
|
||||
psb_s_mv_hll_to_fmt.o \
|
||||
psb_c_cp_dia_from_coo.o \
|
||||
psb_c_cp_dia_to_coo.o \
|
||||
psb_c_cp_ell_from_coo.o \
|
||||
psb_c_cp_ell_from_fmt.o \
|
||||
psb_c_cp_ell_to_coo.o \
|
||||
psb_c_cp_ell_to_fmt.o \
|
||||
psb_c_cp_hdia_from_coo.o \
|
||||
psb_c_cp_hdia_to_coo.o \
|
||||
psb_c_cp_hll_from_coo.o \
|
||||
psb_c_cp_hll_from_fmt.o \
|
||||
psb_c_cp_hll_to_coo.o \
|
||||
psb_c_cp_hll_to_fmt.o \
|
||||
psb_c_dia_aclsum.o \
|
||||
psb_c_dia_allocate_mnnz.o \
|
||||
psb_c_dia_arwsum.o \
|
||||
psb_c_dia_colsum.o \
|
||||
psb_c_dia_csgetptn.o \
|
||||
psb_c_dia_csgetrow.o \
|
||||
psb_c_dia_csmm.o \
|
||||
psb_c_dia_csmv.o \
|
||||
psb_c_dia_get_diag.o \
|
||||
psb_c_dia_maxval.o \
|
||||
psb_c_dia_mold.o \
|
||||
psb_c_dia_print.o \
|
||||
psb_c_dia_reallocate_nz.o \
|
||||
psb_c_dia_reinit.o \
|
||||
psb_c_dia_rowsum.o \
|
||||
psb_c_dia_scal.o \
|
||||
psb_c_dia_scals.o \
|
||||
psb_c_ell_aclsum.o \
|
||||
psb_c_ell_allocate_mnnz.o \
|
||||
psb_c_ell_arwsum.o \
|
||||
psb_c_ell_colsum.o \
|
||||
psb_c_ell_csgetblk.o \
|
||||
psb_c_ell_csgetptn.o \
|
||||
psb_c_ell_csgetrow.o \
|
||||
psb_c_ell_csmm.o \
|
||||
psb_c_ell_csmv.o \
|
||||
psb_c_ell_csnm1.o \
|
||||
psb_c_ell_csnmi.o \
|
||||
psb_c_ell_csput.o \
|
||||
psb_c_ell_cssm.o \
|
||||
psb_c_ell_cssv.o \
|
||||
psb_c_ell_get_diag.o \
|
||||
psb_c_ell_maxval.o \
|
||||
psb_c_ell_mold.o \
|
||||
psb_c_ell_print.o \
|
||||
psb_c_ell_reallocate_nz.o \
|
||||
psb_c_ell_reinit.o \
|
||||
psb_c_ell_rowsum.o \
|
||||
psb_c_ell_scal.o \
|
||||
psb_c_ell_scals.o \
|
||||
psb_c_ell_trim.o \
|
||||
psb_c_hdia_allocate_mnnz.o \
|
||||
psb_c_hdia_csmv.o \
|
||||
psb_c_hdia_mold.o \
|
||||
psb_c_hdia_print.o \
|
||||
psb_c_hll_aclsum.o \
|
||||
psb_c_hll_allocate_mnnz.o \
|
||||
psb_c_hll_arwsum.o \
|
||||
psb_c_hll_colsum.o \
|
||||
psb_c_hll_csgetblk.o \
|
||||
psb_c_hll_csgetptn.o \
|
||||
psb_c_hll_csgetrow.o \
|
||||
psb_c_hll_csmm.o \
|
||||
psb_c_hll_csmv.o \
|
||||
psb_c_hll_csnm1.o \
|
||||
psb_c_hll_csnmi.o \
|
||||
psb_c_hll_csput.o \
|
||||
psb_c_hll_cssm.o \
|
||||
psb_c_hll_cssv.o \
|
||||
psb_c_hll_get_diag.o \
|
||||
psb_c_hll_maxval.o \
|
||||
psb_c_hll_mold.o \
|
||||
psb_c_hll_print.o \
|
||||
psb_c_hll_reallocate_nz.o \
|
||||
psb_c_hll_reinit.o \
|
||||
psb_c_hll_rowsum.o \
|
||||
psb_c_hll_scal.o \
|
||||
psb_c_hll_scals.o \
|
||||
psb_c_mv_dia_from_coo.o \
|
||||
psb_c_mv_ell_from_coo.o \
|
||||
psb_c_mv_ell_from_fmt.o \
|
||||
psb_c_mv_ell_to_coo.o \
|
||||
psb_c_mv_ell_to_fmt.o \
|
||||
psb_c_mv_hdia_from_coo.o \
|
||||
psb_c_mv_hdia_to_coo.o \
|
||||
psb_c_mv_hll_from_coo.o \
|
||||
psb_c_mv_hll_from_fmt.o \
|
||||
psb_c_mv_hll_to_coo.o \
|
||||
psb_c_mv_hll_to_fmt.o \
|
||||
psb_d_cp_dia_from_coo.o \
|
||||
psb_d_cp_dia_to_coo.o \
|
||||
psb_d_cp_ell_from_coo.o \
|
||||
psb_d_cp_ell_from_fmt.o \
|
||||
psb_d_cp_ell_to_coo.o \
|
||||
psb_d_cp_ell_to_fmt.o \
|
||||
psb_d_cp_hdia_from_coo.o \
|
||||
psb_d_cp_hdia_to_coo.o \
|
||||
psb_d_cp_hll_from_coo.o \
|
||||
psb_d_cp_hll_from_fmt.o \
|
||||
psb_d_cp_hll_to_coo.o \
|
||||
psb_d_cp_hll_to_fmt.o \
|
||||
psb_d_dia_aclsum.o \
|
||||
psb_d_dia_allocate_mnnz.o \
|
||||
psb_d_dia_arwsum.o \
|
||||
psb_d_dia_colsum.o \
|
||||
psb_d_dia_csgetptn.o \
|
||||
psb_d_dia_csgetrow.o \
|
||||
psb_d_dia_csmm.o \
|
||||
psb_d_dia_csmv.o \
|
||||
psb_d_dia_get_diag.o \
|
||||
psb_d_dia_maxval.o \
|
||||
psb_d_dia_mold.o \
|
||||
psb_d_dia_print.o \
|
||||
psb_d_dia_reallocate_nz.o \
|
||||
psb_d_dia_reinit.o \
|
||||
psb_d_dia_rowsum.o \
|
||||
psb_d_dia_scal.o \
|
||||
psb_d_dia_scals.o \
|
||||
psb_d_ell_aclsum.o \
|
||||
psb_d_ell_allocate_mnnz.o \
|
||||
psb_d_ell_arwsum.o \
|
||||
psb_d_ell_colsum.o \
|
||||
psb_d_ell_csgetblk.o \
|
||||
psb_d_ell_csgetptn.o \
|
||||
psb_d_ell_csgetrow.o \
|
||||
psb_d_ell_csmm.o \
|
||||
psb_d_ell_csmv.o \
|
||||
psb_d_ell_csnm1.o \
|
||||
psb_d_ell_csnmi.o \
|
||||
psb_d_ell_csput.o \
|
||||
psb_d_ell_cssm.o \
|
||||
psb_d_ell_cssv.o \
|
||||
psb_d_ell_get_diag.o \
|
||||
psb_d_ell_maxval.o \
|
||||
psb_d_ell_mold.o \
|
||||
psb_d_ell_print.o \
|
||||
psb_d_ell_reallocate_nz.o \
|
||||
psb_d_ell_reinit.o \
|
||||
psb_d_ell_rowsum.o \
|
||||
psb_d_ell_scal.o \
|
||||
psb_d_ell_scals.o \
|
||||
psb_d_ell_trim.o \
|
||||
psb_d_hdia_allocate_mnnz.o \
|
||||
psb_d_hdia_csmv.o \
|
||||
psb_d_hdia_mold.o \
|
||||
psb_d_hdia_print.o \
|
||||
psb_d_hll_aclsum.o \
|
||||
psb_d_hll_allocate_mnnz.o \
|
||||
psb_d_hll_arwsum.o \
|
||||
psb_d_hll_colsum.o \
|
||||
psb_d_hll_csgetblk.o \
|
||||
psb_d_hll_csgetptn.o \
|
||||
psb_d_hll_csgetrow.o \
|
||||
psb_d_hll_csmm.o \
|
||||
psb_d_hll_csmv.o \
|
||||
psb_d_hll_csnm1.o \
|
||||
psb_d_hll_csnmi.o \
|
||||
psb_d_hll_csput.o \
|
||||
psb_d_hll_cssm.o \
|
||||
psb_d_hll_cssv.o \
|
||||
psb_d_hll_get_diag.o \
|
||||
psb_d_hll_maxval.o \
|
||||
psb_d_hll_mold.o \
|
||||
psb_d_hll_print.o \
|
||||
psb_d_hll_reallocate_nz.o \
|
||||
psb_d_hll_reinit.o \
|
||||
psb_d_hll_rowsum.o \
|
||||
psb_d_hll_scal.o \
|
||||
psb_d_hll_scals.o \
|
||||
psb_d_mv_dia_from_coo.o \
|
||||
psb_d_mv_ell_from_coo.o \
|
||||
psb_d_mv_ell_from_fmt.o \
|
||||
psb_d_mv_ell_to_coo.o \
|
||||
psb_d_mv_ell_to_fmt.o \
|
||||
psb_d_mv_hdia_from_coo.o \
|
||||
psb_d_mv_hdia_to_coo.o \
|
||||
psb_d_mv_hll_from_coo.o \
|
||||
psb_d_mv_hll_from_fmt.o \
|
||||
psb_d_mv_hll_to_coo.o \
|
||||
psb_d_mv_hll_to_fmt.o \
|
||||
psb_z_cp_dia_from_coo.o \
|
||||
psb_z_cp_dia_to_coo.o \
|
||||
psb_z_cp_ell_from_coo.o \
|
||||
psb_z_cp_ell_from_fmt.o \
|
||||
psb_z_cp_ell_to_coo.o \
|
||||
psb_z_cp_ell_to_fmt.o \
|
||||
psb_z_cp_hdia_from_coo.o \
|
||||
psb_z_cp_hdia_to_coo.o \
|
||||
psb_z_cp_hll_from_coo.o \
|
||||
psb_z_cp_hll_from_fmt.o \
|
||||
psb_z_cp_hll_to_coo.o \
|
||||
psb_z_cp_hll_to_fmt.o \
|
||||
psb_z_dia_aclsum.o \
|
||||
psb_z_dia_allocate_mnnz.o \
|
||||
psb_z_dia_arwsum.o \
|
||||
psb_z_dia_colsum.o \
|
||||
psb_z_dia_csgetptn.o \
|
||||
psb_z_dia_csgetrow.o \
|
||||
psb_z_dia_csmm.o \
|
||||
psb_z_dia_csmv.o \
|
||||
psb_z_dia_get_diag.o \
|
||||
psb_z_dia_maxval.o \
|
||||
psb_z_dia_mold.o \
|
||||
psb_z_dia_print.o \
|
||||
psb_z_dia_reallocate_nz.o \
|
||||
psb_z_dia_reinit.o \
|
||||
psb_z_dia_rowsum.o \
|
||||
psb_z_dia_scal.o \
|
||||
psb_z_dia_scals.o \
|
||||
psb_z_ell_aclsum.o \
|
||||
psb_z_ell_allocate_mnnz.o \
|
||||
psb_z_ell_arwsum.o \
|
||||
psb_z_ell_colsum.o \
|
||||
psb_z_ell_csgetblk.o \
|
||||
psb_z_ell_csgetptn.o \
|
||||
psb_z_ell_csgetrow.o \
|
||||
psb_z_ell_csmm.o \
|
||||
psb_z_ell_csmv.o \
|
||||
psb_z_ell_csnm1.o \
|
||||
psb_z_ell_csnmi.o \
|
||||
psb_z_ell_csput.o \
|
||||
psb_z_ell_cssm.o \
|
||||
psb_z_ell_cssv.o \
|
||||
psb_z_ell_get_diag.o \
|
||||
psb_z_ell_maxval.o \
|
||||
psb_z_ell_mold.o \
|
||||
psb_z_ell_print.o \
|
||||
psb_z_ell_reallocate_nz.o \
|
||||
psb_z_ell_reinit.o \
|
||||
psb_z_ell_rowsum.o \
|
||||
psb_z_ell_scal.o \
|
||||
psb_z_ell_scals.o \
|
||||
psb_z_ell_trim.o \
|
||||
psb_z_hdia_allocate_mnnz.o \
|
||||
psb_z_hdia_csmv.o \
|
||||
psb_z_hdia_mold.o \
|
||||
psb_z_hdia_print.o \
|
||||
psb_z_hll_aclsum.o \
|
||||
psb_z_hll_allocate_mnnz.o \
|
||||
psb_z_hll_arwsum.o \
|
||||
psb_z_hll_colsum.o \
|
||||
psb_z_hll_csgetblk.o \
|
||||
psb_z_hll_csgetptn.o \
|
||||
psb_z_hll_csgetrow.o \
|
||||
psb_z_hll_csmm.o \
|
||||
psb_z_hll_csmv.o \
|
||||
psb_z_hll_csnm1.o \
|
||||
psb_z_hll_csnmi.o \
|
||||
psb_z_hll_csput.o \
|
||||
psb_z_hll_cssm.o \
|
||||
psb_z_hll_cssv.o \
|
||||
psb_z_hll_get_diag.o \
|
||||
psb_z_hll_maxval.o \
|
||||
psb_z_hll_mold.o \
|
||||
psb_z_hll_print.o \
|
||||
psb_z_hll_reallocate_nz.o \
|
||||
psb_z_hll_reinit.o \
|
||||
psb_z_hll_rowsum.o \
|
||||
psb_z_hll_scal.o \
|
||||
psb_z_hll_scals.o \
|
||||
psb_z_mv_dia_from_coo.o \
|
||||
psb_z_mv_ell_from_coo.o \
|
||||
psb_z_mv_ell_from_fmt.o \
|
||||
psb_z_mv_ell_to_coo.o \
|
||||
psb_z_mv_ell_to_fmt.o \
|
||||
psb_z_mv_hdia_from_coo.o \
|
||||
psb_z_mv_hdia_to_coo.o \
|
||||
psb_z_mv_hll_from_coo.o \
|
||||
psb_z_mv_hll_from_fmt.o \
|
||||
psb_z_mv_hll_to_coo.o \
|
||||
psb_z_mv_hll_to_fmt.o \
|
||||
psi_s_xtr_ell_from_coo.o \
|
||||
psi_c_xtr_ell_from_coo.o \
|
||||
psi_d_xtr_ell_from_coo.o \
|
||||
psi_z_xtr_ell_from_coo.o \
|
||||
psi_s_convert_ell_from_coo.o \
|
||||
psi_c_convert_ell_from_coo.o \
|
||||
psi_d_convert_ell_from_coo.o \
|
||||
psi_z_convert_ell_from_coo.o \
|
||||
psi_s_convert_hll_from_coo.o \
|
||||
psi_c_convert_hll_from_coo.o \
|
||||
psi_d_convert_hll_from_coo.o \
|
||||
psi_z_convert_hll_from_coo.o \
|
||||
psi_s_xtr_dia_from_coo.o \
|
||||
psi_c_xtr_dia_from_coo.o \
|
||||
psi_d_xtr_dia_from_coo.o \
|
||||
psi_z_xtr_dia_from_coo.o \
|
||||
psi_s_xtr_coo_from_dia.o \
|
||||
psi_d_xtr_coo_from_dia.o \
|
||||
psi_c_xtr_coo_from_dia.o \
|
||||
psi_z_xtr_coo_from_dia.o \
|
||||
psi_s_convert_dia_from_coo.o \
|
||||
psi_c_convert_dia_from_coo.o \
|
||||
psi_d_convert_dia_from_coo.o \
|
||||
psi_z_convert_dia_from_coo.o \
|
||||
psb_s_dns_mat_impl.o \
|
||||
psb_d_dns_mat_impl.o \
|
||||
psb_c_dns_mat_impl.o \
|
||||
psb_z_dns_mat_impl.o
|
||||
|
||||
objs: $(OBJS)
|
||||
|
||||
lib: objs
|
||||
ar cur ../$(LIBNAME) $(OBJS)
|
||||
|
||||
clean:
|
||||
/bin/rm -f $(OBJS)
|
||||
@ -0,0 +1,70 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_cp_dia_from_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_cp_dia_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_dia_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
|
||||
info = psb_success_
|
||||
if (b%is_dev()) call b%sync()
|
||||
if (b%is_by_rows()) then
|
||||
call psi_convert_dia_from_coo(a,b,info)
|
||||
else
|
||||
! This is to guarantee tmp%is_by_rows()
|
||||
call b%cp_to_coo(tmp,info)
|
||||
call tmp%fix(info)
|
||||
|
||||
if (info /= psb_success_) return
|
||||
call psi_convert_dia_from_coo(a,tmp,info)
|
||||
|
||||
call tmp%free()
|
||||
end if
|
||||
if (info /= 0) goto 9999
|
||||
call a%set_host()
|
||||
|
||||
return
|
||||
|
||||
9999 continue
|
||||
info = psb_err_alloc_dealloc_
|
||||
return
|
||||
|
||||
end subroutine psb_c_cp_dia_from_coo
|
||||
@ -0,0 +1,65 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_cp_dia_to_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_cp_dia_to_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_dia_sparse_mat), intent(in) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
integer(psb_ipk_) :: i, j, k,nr,nza,nc, nzd
|
||||
|
||||
info = psb_success_
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
nza = a%get_nzeros()
|
||||
|
||||
call b%allocate(nr,nc,nza)
|
||||
b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat
|
||||
|
||||
call psi_c_xtr_coo_from_dia(nr,nc,&
|
||||
& b%ia, b%ja, b%val, nzd, &
|
||||
& size(a%data,1),size(a%data,2),&
|
||||
& a%data,a%offset,info)
|
||||
|
||||
call b%set_nzeros(nza)
|
||||
call b%set_host()
|
||||
call b%fix(info)
|
||||
|
||||
end subroutine psb_c_cp_dia_to_coo
|
||||
@ -0,0 +1,71 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_cp_ell_from_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_cp_ell_from_coo
|
||||
use psi_ext_util_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_ell_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc
|
||||
integer(psb_ipk_) :: nzm, ir, ic, k
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
|
||||
info = psb_success_
|
||||
! This is to have fix_coo called behind the scenes
|
||||
if (b%is_dev()) call b%sync()
|
||||
if (b%is_by_rows()) then
|
||||
call psi_c_convert_ell_from_coo(a,b,info)
|
||||
else
|
||||
call b%cp_to_coo(tmp,info)
|
||||
if (info == psb_success_) call psi_c_convert_ell_from_coo(a,tmp,info)
|
||||
if (info == psb_success_) call tmp%free()
|
||||
end if
|
||||
if (info /= psb_success_) goto 9999
|
||||
call a%set_host()
|
||||
|
||||
return
|
||||
|
||||
9999 continue
|
||||
info = psb_err_alloc_dealloc_
|
||||
return
|
||||
|
||||
|
||||
end subroutine psb_c_cp_ell_from_coo
|
||||
@ -0,0 +1,65 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_cp_ell_from_fmt(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_cp_ell_from_fmt
|
||||
implicit none
|
||||
|
||||
class(psb_c_ell_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_base_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select type (b)
|
||||
type is (psb_c_coo_sparse_mat)
|
||||
call a%cp_from_coo(b,info)
|
||||
|
||||
type is (psb_c_ell_sparse_mat)
|
||||
if (b%is_dev()) call b%sync()
|
||||
a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat
|
||||
if (info == 0) call psb_safe_cpy( b%irn, a%irn , info)
|
||||
if (info == 0) call psb_safe_cpy( b%idiag, a%idiag, info)
|
||||
if (info == 0) call psb_safe_cpy( b%ja , a%ja , info)
|
||||
if (info == 0) call psb_safe_cpy( b%val, a%val , info)
|
||||
call a%set_host()
|
||||
|
||||
class default
|
||||
call b%cp_to_coo(tmp,info)
|
||||
if (info == psb_success_) call a%mv_from_coo(tmp,info)
|
||||
end select
|
||||
end subroutine psb_c_cp_ell_from_fmt
|
||||
@ -0,0 +1,69 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_cp_ell_to_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_cp_ell_to_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
Integer(Psb_ipk_) :: i, j, k, nr, nc, nza
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
nza = a%get_nzeros()
|
||||
|
||||
call b%allocate(nr,nc,nza)
|
||||
b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat
|
||||
|
||||
k=0
|
||||
do i=1, nr
|
||||
do j=1,a%irn(i)
|
||||
k = k + 1
|
||||
b%ia(k) = i
|
||||
b%ja(k) = a%ja(i,j)
|
||||
b%val(k) = a%val(i,j)
|
||||
end do
|
||||
end do
|
||||
call b%set_nzeros(a%get_nzeros())
|
||||
call b%fix(info)
|
||||
call b%set_host()
|
||||
|
||||
end subroutine psb_c_cp_ell_to_coo
|
||||
@ -0,0 +1,67 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_cp_ell_to_fmt(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_cp_ell_to_fmt
|
||||
implicit none
|
||||
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select type (b)
|
||||
type is (psb_c_coo_sparse_mat)
|
||||
call a%cp_to_coo(b,info)
|
||||
|
||||
type is (psb_c_ell_sparse_mat)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat
|
||||
if (info == 0) call psb_safe_cpy( a%idiag, b%idiag , info)
|
||||
if (info == 0) call psb_safe_cpy( a%irn, b%irn , info)
|
||||
if (info == 0) call psb_safe_cpy( a%ja , b%ja , info)
|
||||
if (info == 0) call psb_safe_cpy( a%val, b%val , info)
|
||||
call b%set_host()
|
||||
|
||||
class default
|
||||
call a%cp_to_coo(tmp,info)
|
||||
if (info == psb_success_) call b%mv_from_coo(tmp,info)
|
||||
end select
|
||||
|
||||
end subroutine psb_c_cp_ell_to_fmt
|
||||
@ -0,0 +1,222 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_cp_hdia_from_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hdia_mat_mod, psb_protect_name => psb_c_cp_hdia_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_hdia_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
|
||||
info = psb_success_
|
||||
if (b%is_dev()) call b%sync()
|
||||
if (b%is_by_rows()) then
|
||||
call inner_cp_hdia_from_coo(a,b,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
else
|
||||
call b%cp_to_coo(tmp,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
if (.not.tmp%is_by_rows()) call tmp%fix(info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
call inner_cp_hdia_from_coo(a,tmp,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
call tmp%free()
|
||||
end if
|
||||
call a%set_host()
|
||||
|
||||
return
|
||||
|
||||
9999 continue
|
||||
|
||||
info = psb_err_alloc_dealloc_
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine inner_cp_hdia_from_coo(a,tmp,info)
|
||||
use psb_base_mod
|
||||
use psi_ext_util_mod
|
||||
|
||||
implicit none
|
||||
class(psb_c_hdia_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(in) :: tmp
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
integer(psb_ipk_) :: ndiag,mi,mj,dm,bi,w
|
||||
integer(psb_ipk_),allocatable :: d(:), offset(:), irsz(:)
|
||||
integer(psb_ipk_) :: k,i,j,nc,nr,nza, nzd,nd,hacksize,nhacks,iszd,&
|
||||
& ib, ir, kfirst, klast1, hackfirst, hacknext, nzout
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
logical, parameter :: debug=.false.
|
||||
nr = tmp%get_nrows()
|
||||
nc = tmp%get_ncols()
|
||||
nza = tmp%get_nzeros()
|
||||
! If it is sorted then we can lessen memory impact
|
||||
a%psb_c_base_sparse_mat = tmp%psb_c_base_sparse_mat
|
||||
|
||||
hacksize = a%hacksize
|
||||
a%nhacks = (nr+hacksize-1)/hacksize
|
||||
nhacks = a%nhacks
|
||||
|
||||
ndiag = nr+nc-1
|
||||
if (info == psb_success_) call psb_realloc(nr,irsz,info)
|
||||
if (info == psb_success_) call psb_realloc(ndiag,d,info)
|
||||
if (info == psb_success_) call psb_realloc(ndiag,offset,info)
|
||||
if (info == psb_success_) call psb_realloc(nhacks+1,a%hackoffsets,info)
|
||||
if (info /= psb_success_) return
|
||||
|
||||
irsz = 0
|
||||
do k=1,nza
|
||||
ir = tmp%ia(k)
|
||||
irsz(ir) = irsz(ir)+1
|
||||
end do
|
||||
|
||||
a%nzeros = 0
|
||||
d = 0
|
||||
iszd = 0
|
||||
a%hackOffsets(1)=0
|
||||
klast1 = 1
|
||||
do k=1, nhacks
|
||||
i = (k-1)*hacksize + 1
|
||||
ib = min(hacksize,nr-i+1)
|
||||
kfirst = klast1
|
||||
klast1 = kfirst + sum(irsz(i:i+ib-1))
|
||||
! klast1 points to last element of chunk plus 1
|
||||
if (debug) then
|
||||
write(*,*) 'Loop iteration ',k,nhacks,i,ib,nr
|
||||
write(*,*) 'RW:',tmp%ia(kfirst),tmp%ia(klast1-1)
|
||||
write(*,*) 'CL:',tmp%ja(kfirst),tmp%ja(klast1-1)
|
||||
end if
|
||||
call psi_dia_offset_from_coo(nr,nc,(klast1-kfirst),&
|
||||
& tmp%ia(kfirst:klast1-1), tmp%ja(kfirst:klast1-1),&
|
||||
& nd, d, offset, info, initd=.false., cleard=.true.)
|
||||
iszd = iszd + nd
|
||||
a%hackOffsets(k+1)=iszd
|
||||
if (debug) write(*,*) 'From chunk ',k,i,ib,sum(irsz(i:i+ib-1)),': ',nd, iszd
|
||||
if (debug) write(*,*) 'offset ', offset(1:nd)
|
||||
end do
|
||||
if (debug) then
|
||||
write(*,*) 'Hackcount ',nhacks,' Allocation height ',iszd
|
||||
write(*,*) 'Hackoffsets ',a%hackOffsets(:)
|
||||
end if
|
||||
if (info == psb_success_) call psb_realloc(hacksize*iszd,a%diaOffsets,info)
|
||||
if (info == psb_success_) call psb_realloc(hacksize*iszd,a%val,info)
|
||||
if (info /= psb_success_) return
|
||||
klast1 = 1
|
||||
!
|
||||
! Second run: copy elements
|
||||
!
|
||||
do k=1, nhacks
|
||||
i = (k-1)*hacksize + 1
|
||||
ib = min(hacksize,nr-i+1)
|
||||
kfirst = klast1
|
||||
klast1 = kfirst + sum(irsz(i:i+ib-1))
|
||||
! klast1 points to last element of chunk plus 1
|
||||
hackfirst = a%hackoffsets(k)
|
||||
hacknext = a%hackoffsets(k+1)
|
||||
call psi_dia_offset_from_coo(nr,nc,(klast1-kfirst),&
|
||||
& tmp%ia(kfirst:klast1-1), tmp%ja(kfirst:klast1-1),&
|
||||
& nd, d, a%diaOffsets(hackfirst+1:hacknext), info, &
|
||||
& initd=.false., cleard=.false.)
|
||||
if (debug) write(*,*) 'Out from dia_offset: ', a%diaOffsets(hackfirst+1:hacknext)
|
||||
call psi_c_xtr_dia_from_coo(nr,nc,(klast1-kfirst),&
|
||||
& tmp%ia(kfirst:klast1-1), tmp%ja(kfirst:klast1-1),&
|
||||
& tmp%val(kfirst:klast1-1), &
|
||||
& d,hacksize,(hacknext-hackfirst),&
|
||||
& a%val((hacksize*hackfirst)+1:hacksize*hacknext),info,&
|
||||
& initdata=.true.,rdisp=(i-1))
|
||||
|
||||
call countnz(nr,nc,(i-1),hacksize,(hacknext-hackfirst),&
|
||||
& a%diaOffsets(hackfirst+1:hacknext),nzout)
|
||||
a%nzeros = a%nzeros + nzout
|
||||
call cleand(nr,(hacknext-hackfirst),d,a%diaOffsets(hackfirst+1:hacknext))
|
||||
|
||||
end do
|
||||
if (debug) then
|
||||
write(*,*) 'NZEROS: ',a%nzeros, nza
|
||||
write(*,*) 'diaoffsets: ',a%diaOffsets(1:iszd)
|
||||
write(*,*) 'values: '
|
||||
j=0
|
||||
do k=1,nhacks
|
||||
write(*,*) 'Hack No. ',k
|
||||
do i=1,hacksize*(iszd/nhacks)
|
||||
j = j + 1
|
||||
write(*,*) j, a%val(j)
|
||||
end do
|
||||
end do
|
||||
end if
|
||||
end subroutine inner_cp_hdia_from_coo
|
||||
|
||||
subroutine countnz(nr,nc,rdisp,nrd,ncd,offsets,nz)
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: nr,nc,nrd,ncd,rdisp,offsets(:)
|
||||
integer(psb_ipk_), intent(out) :: nz
|
||||
!
|
||||
integer(psb_ipk_) :: i,j,k, ir, jc, m4, ir1, ir2, nrcmdisp, rdisp1
|
||||
nz = 0
|
||||
nrcmdisp = min(nr-rdisp,nc-rdisp)
|
||||
rdisp1 = 1-rdisp
|
||||
do j=1, ncd
|
||||
if (offsets(j)>=0) then
|
||||
ir1 = 1
|
||||
! ir2 = min(nrd,nr - offsets(j) - rdisp_,nc-offsets(j)-rdisp_)
|
||||
ir2 = min(nrd, nrcmdisp - offsets(j))
|
||||
else
|
||||
! ir1 = max(1,1-offsets(j)-rdisp_)
|
||||
ir1 = max(1, rdisp1 - offsets(j))
|
||||
ir2 = min(nrd, nrcmdisp)
|
||||
end if
|
||||
nz = nz + (ir2-ir1+1)
|
||||
end do
|
||||
end subroutine countnz
|
||||
|
||||
subroutine cleand(nr,nd,d,offset)
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: nr,nd,offset(:)
|
||||
integer(psb_ipk_), intent(inout) :: d(:)
|
||||
integer(psb_ipk_) :: i,id
|
||||
|
||||
do i=1,nd
|
||||
id = offset(i) + nr
|
||||
d(id) = 0
|
||||
end do
|
||||
end subroutine cleand
|
||||
|
||||
end subroutine psb_c_cp_hdia_from_coo
|
||||
@ -0,0 +1,84 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_cp_hdia_to_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hdia_mat_mod, psb_protect_name => psb_c_cp_hdia_to_coo
|
||||
use psi_ext_util_mod
|
||||
implicit none
|
||||
|
||||
class(psb_c_hdia_sparse_mat), intent(in) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
integer(psb_ipk_) :: k,i,j,nc,nr,nza, nzd,nd,hacksize,nhacks,iszd,&
|
||||
& ib, ir, kfirst, klast1, hackfirst, hacknext
|
||||
|
||||
info = psb_success_
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
nza = a%get_nzeros()
|
||||
|
||||
call b%allocate(nr,nc,nza)
|
||||
b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat
|
||||
call b%set_nzeros(nza)
|
||||
call b%set_sort_status(psb_unsorted_)
|
||||
nhacks = a%nhacks
|
||||
hacksize = a%hacksize
|
||||
j = 0
|
||||
do k=1, nhacks
|
||||
i = (k-1)*hacksize + 1
|
||||
ib = min(hacksize,nr-i+1)
|
||||
hackfirst = a%hackoffsets(k)
|
||||
hacknext = a%hackoffsets(k+1)
|
||||
call psi_c_xtr_coo_from_dia(nr,nc,&
|
||||
& b%ia(j+1:), b%ja(j+1:), b%val(j+1:), nzd, &
|
||||
& hacksize,(hacknext-hackfirst),&
|
||||
& a%val((hacksize*hackfirst)+1:hacksize*hacknext),&
|
||||
& a%diaOffsets(hackfirst+1:hacknext),info,rdisp=(i-1))
|
||||
!!$ write(*,*) 'diaoffsets',ib,' : ',ib - abs(a%diaOffsets(hackfirst+1:hacknext))
|
||||
!!$ write(*,*) 'sum',ib,j,' : ',sum(ib - abs(a%diaOffsets(hackfirst+1:hacknext)))
|
||||
j = j + nzd
|
||||
end do
|
||||
if (nza /= j) then
|
||||
write(*,*) 'Wrong counts in hdia_to_coo',j,nza
|
||||
info = -8
|
||||
return
|
||||
end if
|
||||
call b%set_host()
|
||||
call b%fix(info)
|
||||
|
||||
end subroutine psb_c_cp_hdia_to_coo
|
||||
@ -0,0 +1,74 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_cp_hll_from_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_cp_hll_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_hll_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
integer(psb_ipk_) :: debug_level, debug_unit, hksz
|
||||
character(len=20) :: name='hll_from_coo'
|
||||
|
||||
info = psb_success_
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
if (b%is_dev()) call b%sync()
|
||||
hksz = psi_get_hksz()
|
||||
if (b%is_by_rows()) then
|
||||
call psi_convert_hll_from_coo(a,hksz,b,info)
|
||||
else
|
||||
! This is to guarantee tmp%is_by_rows()
|
||||
call b%cp_to_coo(tmp,info)
|
||||
call tmp%fix(info)
|
||||
|
||||
if (info /= psb_success_) return
|
||||
call psi_convert_hll_from_coo(a,hksz,tmp,info)
|
||||
|
||||
call tmp%free()
|
||||
end if
|
||||
if (info /= 0) goto 9999
|
||||
call a%set_host()
|
||||
|
||||
return
|
||||
|
||||
9999 continue
|
||||
info = psb_err_alloc_dealloc_
|
||||
return
|
||||
|
||||
end subroutine psb_c_cp_hll_from_coo
|
||||
@ -0,0 +1,70 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_cp_hll_from_fmt(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_cp_hll_from_fmt
|
||||
implicit none
|
||||
|
||||
class(psb_c_hll_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_base_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select type (b)
|
||||
class is (psb_c_coo_sparse_mat)
|
||||
call a%cp_from_coo(b,info)
|
||||
|
||||
class is (psb_c_hll_sparse_mat)
|
||||
! write(0,*) 'From type_hll'
|
||||
if (b%is_dev()) call b%sync()
|
||||
|
||||
a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat
|
||||
if (info == 0) call psb_safe_cpy( b%irn, a%irn , info)
|
||||
if (info == 0) call psb_safe_cpy( b%hkoffs, a%hkoffs, info)
|
||||
if (info == 0) call psb_safe_cpy( b%idiag, a%idiag, info)
|
||||
if (info == 0) call psb_safe_cpy( b%ja , a%ja , info)
|
||||
if (info == 0) call psb_safe_cpy( b%val, a%val , info)
|
||||
if (info == 0) a%hksz = b%hksz
|
||||
if (info == 0) a%nzt = b%nzt
|
||||
call a%set_host()
|
||||
|
||||
class default
|
||||
call b%cp_to_coo(tmp,info)
|
||||
if (info == psb_success_) call a%mv_from_coo(tmp,info)
|
||||
end select
|
||||
end subroutine psb_c_cp_hll_from_fmt
|
||||
@ -0,0 +1,104 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_cp_hll_to_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_cp_hll_to_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
Integer(Psb_ipk_) :: nza, nr, nc,i,j, jj,k,ir, isz,err_act, hksz, hk, mxrwl,&
|
||||
& irs, nzblk, kc
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
nza = a%get_nzeros()
|
||||
|
||||
call b%allocate(nr,nc,nza)
|
||||
b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat
|
||||
|
||||
j = 1
|
||||
kc = 1
|
||||
k = 1
|
||||
hksz = a%hksz
|
||||
do i=1, nr,hksz
|
||||
ir = min(hksz,nr-i+1)
|
||||
irs = (i-1)/hksz
|
||||
hk = irs + 1
|
||||
isz = (a%hkoffs(hk+1)-a%hkoffs(hk))
|
||||
nzblk = sum(a%irn(i:i+ir-1))
|
||||
call inner_copy(i,ir,b%ia(kc:kc+nzblk-1),&
|
||||
& b%ja(kc:kc+nzblk-1),b%val(kc:kc+nzblk-1),&
|
||||
& a%ja(k:k+isz-1),a%val(k:k+isz-1),a%irn(i:i+ir-1),&
|
||||
& hksz)
|
||||
k = k + isz
|
||||
kc = kc + nzblk
|
||||
|
||||
enddo
|
||||
|
||||
call b%set_nzeros(nza)
|
||||
call b%set_host()
|
||||
call b%fix(info)
|
||||
|
||||
contains
|
||||
|
||||
subroutine inner_copy(i,ir,iac,&
|
||||
& jac,valc,ja,val,irn,ld)
|
||||
integer(psb_ipk_) :: i,ir,ld
|
||||
integer(psb_ipk_) :: iac(*),jac(*),ja(ld,*),irn(*)
|
||||
complex(psb_spk_) :: valc(*), val(ld,*)
|
||||
|
||||
integer(psb_ipk_) :: ii,jj,kk, kc,nc
|
||||
kc = 1
|
||||
do ii = 1, ir
|
||||
nc = irn(ii)
|
||||
do jj=1,nc
|
||||
iac(kc) = i+ii-1
|
||||
jac(kc) = ja(ii,jj)
|
||||
valc(kc) = val(ii,jj)
|
||||
kc = kc + 1
|
||||
end do
|
||||
end do
|
||||
|
||||
end subroutine inner_copy
|
||||
|
||||
end subroutine psb_c_cp_hll_to_coo
|
||||
@ -0,0 +1,68 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_cp_hll_to_fmt(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_cp_hll_to_fmt
|
||||
implicit none
|
||||
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select type (b)
|
||||
type is (psb_c_coo_sparse_mat)
|
||||
call a%cp_to_coo(b,info)
|
||||
|
||||
type is (psb_c_hll_sparse_mat)
|
||||
if (a%is_dev()) call a%sync()
|
||||
b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat
|
||||
if (info == 0) call psb_safe_cpy( a%hkoffs, b%hkoffs , info)
|
||||
if (info == 0) call psb_safe_cpy( a%idiag, b%idiag , info)
|
||||
if (info == 0) call psb_safe_cpy( a%irn, b%irn , info)
|
||||
if (info == 0) call psb_safe_cpy( a%ja , b%ja , info)
|
||||
if (info == 0) call psb_safe_cpy( a%val, b%val , info)
|
||||
if (info == 0) b%hksz = a%hksz
|
||||
call b%set_host()
|
||||
|
||||
class default
|
||||
call a%cp_to_coo(tmp,info)
|
||||
if (info == psb_success_) call b%mv_from_coo(tmp,info)
|
||||
end select
|
||||
|
||||
end subroutine psb_c_cp_hll_to_fmt
|
||||
@ -0,0 +1,87 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_dia_aclsum(d,a)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_dia_aclsum
|
||||
implicit none
|
||||
class(psb_c_dia_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_), intent(out) :: d(:)
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, ir1,ir2, nr
|
||||
logical :: tra
|
||||
integer(psb_ipk_) :: err_act, info, int_err(5)
|
||||
character(len=20) :: name='aclsum'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
m = a%get_nrows()
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_small_i_
|
||||
int_err(1) = 1
|
||||
int_err(2) = size(d)
|
||||
int_err(3) = n
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (a%is_unit()) then
|
||||
d = sone
|
||||
else
|
||||
d = szero
|
||||
end if
|
||||
|
||||
nr = size(a%data,1)
|
||||
nc = size(a%data,2)
|
||||
do j=1,nc
|
||||
jc = a%offset(j)
|
||||
if (jc > 0) then
|
||||
ir1 = 1
|
||||
ir2 = nr - jc
|
||||
else
|
||||
ir1 = 1 - jc
|
||||
ir2 = nr
|
||||
end if
|
||||
do i=ir1, ir2
|
||||
d(i+jc) = d(i+jc) + abs(a%data(i,j))
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dia_aclsum
|
||||
@ -0,0 +1,88 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_dia_allocate_mnnz(m,n,a,nz)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_dia_allocate_mnnz
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_c_dia_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(in), optional :: nz
|
||||
Integer(Psb_ipk_) :: err_act, info, nz_
|
||||
character(len=20) :: name='allocate_mnz'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (m < 0) then
|
||||
info = psb_err_iarg_neg_
|
||||
call psb_errpush(info,name,i_err=(/ione/))
|
||||
goto 9999
|
||||
endif
|
||||
if (n < 0) then
|
||||
info = psb_err_iarg_neg_
|
||||
call psb_errpush(info,name,i_err=(/2*ione/))
|
||||
goto 9999
|
||||
endif
|
||||
if (present(nz)) then
|
||||
nz_ = (max(nz,ione) + m -ione )/m
|
||||
else
|
||||
nz_ = ((max(7*m,7*n,ione)+m-ione)/m)
|
||||
end if
|
||||
if (nz_ < 0) then
|
||||
info = psb_err_iarg_neg_
|
||||
call psb_errpush(info,name,i_err=(/3*ione/))
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (info == psb_success_) call psb_realloc(m,nz_,a%data,info)
|
||||
if (info == psb_success_) call psb_realloc(m+n,a%offset,info)
|
||||
if (info == psb_success_) then
|
||||
a%data = 0
|
||||
a%offset = 0
|
||||
call a%set_nrows(m)
|
||||
call a%set_ncols(n)
|
||||
call a%set_bld()
|
||||
call a%set_triangle(.false.)
|
||||
call a%set_unit(.false.)
|
||||
call a%set_dupl(psb_dupl_def_)
|
||||
end if
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dia_allocate_mnnz
|
||||
@ -0,0 +1,87 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_dia_arwsum(d,a)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_dia_arwsum
|
||||
implicit none
|
||||
class(psb_c_dia_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_), intent(out) :: d(:)
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, ir1,ir2, nr
|
||||
logical :: tra
|
||||
integer(psb_ipk_) :: err_act, info, int_err(5)
|
||||
character(len=20) :: name='arwsum'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
m = a%get_nrows()
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_small_i_
|
||||
int_err(1) = 1
|
||||
int_err(2) = size(d)
|
||||
int_err(3) = n
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (a%is_unit()) then
|
||||
d = sone
|
||||
else
|
||||
d = szero
|
||||
end if
|
||||
|
||||
nr = size(a%data,1)
|
||||
nc = size(a%data,2)
|
||||
do j=1,nc
|
||||
jc = a%offset(j)
|
||||
if (jc > 0) then
|
||||
ir1 = 1
|
||||
ir2 = nr - jc
|
||||
else
|
||||
ir1 = 1 - jc
|
||||
ir2 = nr
|
||||
end if
|
||||
do i=ir1, ir2
|
||||
d(i) = d(i) + abs(a%data(i,j))
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dia_arwsum
|
||||
@ -0,0 +1,87 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_dia_colsum(d,a)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_dia_colsum
|
||||
implicit none
|
||||
class(psb_c_dia_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, ir1,ir2, nr
|
||||
logical :: tra
|
||||
integer(psb_ipk_) :: err_act, info, int_err(5)
|
||||
character(len=20) :: name='colsum'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
m = a%get_nrows()
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_small_i_
|
||||
int_err(1) = 1
|
||||
int_err(2) = size(d)
|
||||
int_err(3) = n
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (a%is_unit()) then
|
||||
d = cone
|
||||
else
|
||||
d = czero
|
||||
end if
|
||||
|
||||
nr = size(a%data,1)
|
||||
nc = size(a%data,2)
|
||||
do j=1,nc
|
||||
jc = a%offset(j)
|
||||
if (jc > 0) then
|
||||
ir1 = 1
|
||||
ir2 = nr - jc
|
||||
else
|
||||
ir1 = 1 - jc
|
||||
ir2 = nr
|
||||
end if
|
||||
do i=ir1, ir2
|
||||
d(i+jc) = d(i+jc) + a%data(i,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dia_colsum
|
||||
@ -0,0 +1,188 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_dia_csgetptn(imin,imax,a,nz,ia,ja,info,&
|
||||
& jmin,jmax,iren,append,nzin,rscale,cscale)
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_dia_csgetptn
|
||||
implicit none
|
||||
|
||||
class(psb_c_dia_sparse_mat), intent(in) :: a
|
||||
integer(psb_ipk_), intent(in) :: imin,imax
|
||||
integer(psb_ipk_), intent(out) :: nz
|
||||
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
logical, intent(in), optional :: append
|
||||
integer(psb_ipk_), intent(in), optional :: iren(:)
|
||||
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
|
||||
logical, intent(in), optional :: rscale,cscale
|
||||
|
||||
logical :: append_, rscale_, cscale_
|
||||
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
|
||||
character(len=20) :: name='dia_getptn'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (present(jmin)) then
|
||||
jmin_ = jmin
|
||||
else
|
||||
jmin_ = 1
|
||||
endif
|
||||
if (present(jmax)) then
|
||||
jmax_ = jmax
|
||||
else
|
||||
jmax_ = a%get_ncols()
|
||||
endif
|
||||
|
||||
if ((imax<imin).or.(jmax_<jmin_)) then
|
||||
nz = 0
|
||||
return
|
||||
end if
|
||||
|
||||
if (present(append)) then
|
||||
append_=append
|
||||
else
|
||||
append_=.false.
|
||||
endif
|
||||
if ((append_).and.(present(nzin))) then
|
||||
nzin_ = nzin
|
||||
else
|
||||
nzin_ = 0
|
||||
endif
|
||||
if (present(rscale)) then
|
||||
rscale_ = rscale
|
||||
else
|
||||
rscale_ = .false.
|
||||
endif
|
||||
if (present(cscale)) then
|
||||
cscale_ = cscale
|
||||
else
|
||||
cscale_ = .false.
|
||||
endif
|
||||
if ((rscale_.or.cscale_).and.(present(iren))) then
|
||||
info = psb_err_many_optional_arg_
|
||||
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
|
||||
goto 9999
|
||||
end if
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
call dia_getptn(imin,imax,jmin_,jmax_,a,nz,ia,ja,nzin_,append_,info,iren)
|
||||
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
if (rscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ia(i) = ia(i) - imin + 1
|
||||
end do
|
||||
end if
|
||||
if (cscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ja(i) = ja(i) - jmin_ + 1
|
||||
end do
|
||||
end if
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine dia_getptn(imin,imax,jmin,jmax,a,nz,ia,ja,nzin,append,info,&
|
||||
& iren)
|
||||
implicit none
|
||||
class(psb_c_dia_sparse_mat), intent(in) :: a
|
||||
integer(psb_ipk_) :: imin,imax,jmin,jmax
|
||||
integer(psb_ipk_), intent(out) :: nz
|
||||
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
|
||||
integer(psb_ipk_), intent(in) :: nzin
|
||||
logical, intent(in) :: append
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_), optional :: iren(:)
|
||||
integer(psb_ipk_) :: nzin_, nza, idx,i,j,k, nzt, irw, lrw,&
|
||||
& ir, jc, m4, ir1, ir2, nzc, nr, nc
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name='dia_getptn'
|
||||
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
nza = a%get_nzeros()
|
||||
irw = imin
|
||||
lrw = min(imax,a%get_nrows())
|
||||
if (irw<0) then
|
||||
info = psb_err_pivot_too_small_
|
||||
return
|
||||
end if
|
||||
|
||||
if (append) then
|
||||
nzin_ = nzin
|
||||
else
|
||||
nzin_ = 0
|
||||
endif
|
||||
nz = 0
|
||||
|
||||
nr = size(a%data,1)
|
||||
nc = size(a%data,2)
|
||||
do j=1,nc
|
||||
jc = a%offset(j)
|
||||
if (jc > 0) then
|
||||
ir1 = 1
|
||||
ir2 = nr - jc
|
||||
else
|
||||
ir1 = 1 - jc
|
||||
ir2 = nr
|
||||
end if
|
||||
ir1 = max(irw,ir1)
|
||||
ir1 = max(ir1,jmin-jc)
|
||||
ir2 = min(lrw,ir2)
|
||||
ir2 = min(ir2,jmax-jc)
|
||||
nzc = ir2-ir1+1
|
||||
if (nzc>0) then
|
||||
call psb_ensure_size(nzin_+nzc,ia,info)
|
||||
if (info == 0) call psb_ensure_size(nzin_+nzc,ja,info)
|
||||
do i=ir1, ir2
|
||||
nzin_ = nzin_ + 1
|
||||
nz = nz + 1
|
||||
ia(nzin_) = i
|
||||
ja(nzin_) = i+jc
|
||||
enddo
|
||||
end if
|
||||
enddo
|
||||
|
||||
|
||||
end subroutine dia_getptn
|
||||
|
||||
end subroutine psb_c_dia_csgetptn
|
||||
@ -0,0 +1,199 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_dia_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
|
||||
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_dia_csgetrow
|
||||
implicit none
|
||||
|
||||
class(psb_c_dia_sparse_mat), intent(in) :: a
|
||||
integer(psb_ipk_), intent(in) :: imin,imax
|
||||
integer(psb_ipk_), intent(out) :: nz
|
||||
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
|
||||
complex(psb_spk_), allocatable, intent(inout) :: val(:)
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
logical, intent(in), optional :: append
|
||||
integer(psb_ipk_), intent(in), optional :: iren(:)
|
||||
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
|
||||
logical, intent(in), optional :: rscale,cscale,chksz
|
||||
|
||||
logical :: append_, rscale_, cscale_, chksz_
|
||||
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
|
||||
character(len=20) :: name='dia_getrow'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (present(jmin)) then
|
||||
jmin_ = jmin
|
||||
else
|
||||
jmin_ = 1
|
||||
endif
|
||||
if (present(jmax)) then
|
||||
jmax_ = jmax
|
||||
else
|
||||
jmax_ = a%get_ncols()
|
||||
endif
|
||||
|
||||
if ((imax<imin).or.(jmax_<jmin_)) then
|
||||
nz = 0
|
||||
return
|
||||
end if
|
||||
|
||||
if (present(append)) then
|
||||
append_=append
|
||||
else
|
||||
append_=.false.
|
||||
endif
|
||||
if ((append_).and.(present(nzin))) then
|
||||
nzin_ = nzin
|
||||
else
|
||||
nzin_ = 0
|
||||
endif
|
||||
if (present(rscale)) then
|
||||
rscale_ = rscale
|
||||
else
|
||||
rscale_ = .false.
|
||||
endif
|
||||
if (present(cscale)) then
|
||||
cscale_ = cscale
|
||||
else
|
||||
cscale_ = .false.
|
||||
endif
|
||||
if ((rscale_.or.cscale_).and.(present(iren))) then
|
||||
info = psb_err_many_optional_arg_
|
||||
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
|
||||
goto 9999
|
||||
end if
|
||||
if (present(chksz)) then
|
||||
chksz_ = chksz
|
||||
else
|
||||
chksz_ = .true.
|
||||
endif
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
call dia_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,&
|
||||
& append_,chksz_,info,iren)
|
||||
if (info /= psb_success_) goto 9999
|
||||
if (rscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ia(i) = ia(i) - imin + 1
|
||||
end do
|
||||
end if
|
||||
if (cscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ja(i) = ja(i) - jmin_ + 1
|
||||
end do
|
||||
end if
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine dia_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,&
|
||||
& iren)
|
||||
|
||||
implicit none
|
||||
|
||||
class(psb_c_dia_sparse_mat), intent(in) :: a
|
||||
integer(psb_ipk_) :: imin,imax,jmin,jmax
|
||||
integer(psb_ipk_), intent(out) :: nz
|
||||
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
|
||||
complex(psb_spk_), allocatable, intent(inout) :: val(:)
|
||||
integer(psb_ipk_), intent(in) :: nzin
|
||||
logical, intent(in) :: append,chksz
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_), optional :: iren(:)
|
||||
integer(psb_ipk_) :: nzin_, nza, idx,i,j,k, nzt, irw, lrw,&
|
||||
& ir, jc, m4, ir1, ir2, nzc, nr, nc
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name='dia_getrow'
|
||||
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
info = psb_success_
|
||||
|
||||
nza = a%get_nzeros()
|
||||
irw = imin
|
||||
lrw = min(imax,a%get_nrows())
|
||||
if (irw<0) then
|
||||
info = psb_err_pivot_too_small_
|
||||
return
|
||||
end if
|
||||
|
||||
if (append) then
|
||||
nzin_ = nzin
|
||||
else
|
||||
nzin_ = 0
|
||||
endif
|
||||
nz = 0
|
||||
|
||||
nr = size(a%data,1)
|
||||
nc = size(a%data,2)
|
||||
do j=1,nc
|
||||
jc = a%offset(j)
|
||||
if (jc > 0) then
|
||||
ir1 = 1
|
||||
ir2 = nr - jc
|
||||
else
|
||||
ir1 = 1 - jc
|
||||
ir2 = nr
|
||||
end if
|
||||
ir1 = max(irw,ir1)
|
||||
ir1 = max(ir1,jmin-jc)
|
||||
ir2 = min(lrw,ir2)
|
||||
ir2 = min(ir2,jmax-jc)
|
||||
nzc = ir2-ir1+1
|
||||
if (nzc>0) then
|
||||
if (chksz) then
|
||||
call psb_ensure_size(nzin_+nzc,ia,info)
|
||||
if (info == 0) call psb_ensure_size(nzin_+nzc,ja,info)
|
||||
if (info == 0) call psb_ensure_size(nzin_+nzc,val,info)
|
||||
end if
|
||||
do i=ir1, ir2
|
||||
nzin_ = nzin_ + 1
|
||||
nz = nz + 1
|
||||
val(nzin_) = a%data(i,j)
|
||||
ia(nzin_) = i
|
||||
ja(nzin_) = i+jc
|
||||
enddo
|
||||
end if
|
||||
enddo
|
||||
end subroutine dia_getrow
|
||||
end subroutine psb_c_dia_csgetrow
|
||||
@ -0,0 +1,134 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_dia_csmm(alpha,a,x,beta,y,info,trans)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_dia_csmm
|
||||
implicit none
|
||||
class(psb_c_dia_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
|
||||
complex(psb_spk_), intent(inout) :: y(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
|
||||
character :: trans_
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy
|
||||
logical :: tra, ctra
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_dia_csmm'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
|
||||
if (.not.a%is_asb()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
if (tra.or.ctra) then
|
||||
m = a%get_ncols()
|
||||
n = a%get_nrows()
|
||||
else
|
||||
n = a%get_ncols()
|
||||
m = a%get_nrows()
|
||||
end if
|
||||
|
||||
if (size(x,1)<n) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/3*ione,n/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(y,1)<m) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/5*ione,m/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
nxy = min(size(x,2) , size(y,2) )
|
||||
|
||||
call psb_c_dia_csmm_inner(m,n,nxy,alpha,&
|
||||
& a%data,size(a%data,1,kind=psb_ipk_), size(a%data,2,kind=psb_ipk_), a%offset,&
|
||||
& x,size(x,1,kind=psb_ipk_), beta, y,size(y,1,kind=psb_ipk_))
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine psb_c_dia_csmm_inner(m,n,nxy,alpha,data,nr,nc,off,&
|
||||
&x,ldx,beta,y,ldy)
|
||||
integer(psb_ipk_), intent(in) :: m,n,nr,nc,off(*), ldx,ldy,nxy
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(ldx,*),data(nr,*)
|
||||
complex(psb_spk_), intent(inout) :: y(ldy,*)
|
||||
|
||||
integer(psb_ipk_) :: i,j,k, ir, jc, m4, ir1, ir2
|
||||
|
||||
if (beta == czero) then
|
||||
do i = 1, m
|
||||
y(i,1:nxy) = czero
|
||||
enddo
|
||||
else
|
||||
do i = 1, m
|
||||
y(i,1:nxy) = beta*y(i,1:nxy)
|
||||
end do
|
||||
endif
|
||||
|
||||
do j=1,nc
|
||||
if (off(j) > 0) then
|
||||
ir1 = 1
|
||||
ir2 = nr - off(j)
|
||||
else
|
||||
ir1 = 1 - off(j)
|
||||
ir2 = nr
|
||||
end if
|
||||
do i=ir1, ir2
|
||||
y(i,1:nxy) = y(i,1:nxy) + alpha*data(i,j)*x(i+off(j),1:nxy)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end subroutine psb_c_dia_csmm_inner
|
||||
|
||||
end subroutine psb_c_dia_csmm
|
||||
@ -0,0 +1,135 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_dia_csmv(alpha,a,x,beta,y,info,trans)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_dia_csmv
|
||||
implicit none
|
||||
class(psb_c_dia_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
|
||||
complex(psb_spk_), intent(inout) :: y(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
|
||||
character :: trans_
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc
|
||||
logical :: tra, ctra
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_dia_csmv'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (.not.a%is_asb()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
if (tra.or.ctra) then
|
||||
m = a%get_ncols()
|
||||
n = a%get_nrows()
|
||||
else
|
||||
n = a%get_ncols()
|
||||
m = a%get_nrows()
|
||||
end if
|
||||
|
||||
if (size(x,1)<n) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/3*ione,n/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(y,1)<m) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/5*ione,m/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
call psb_c_dia_csmv_inner(m,n,alpha,size(a%data,1,kind=psb_ipk_),&
|
||||
& size(a%data,2,kind=psb_ipk_),a%data,a%offset,x,beta,y)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine psb_c_dia_csmv_inner(m,n,alpha,nr,nc,data,off,&
|
||||
&x,beta,y)
|
||||
integer(psb_ipk_), intent(in) :: m,n,nr,nc,off(*)
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(*),data(nr,*)
|
||||
complex(psb_spk_), intent(inout) :: y(*)
|
||||
|
||||
integer(psb_ipk_) :: i,j,k, ir, jc, m4, ir1, ir2
|
||||
|
||||
if (beta == czero) then
|
||||
do i = 1, m
|
||||
y(i) = czero
|
||||
enddo
|
||||
else
|
||||
do i = 1, m
|
||||
y(i) = beta*y(i)
|
||||
end do
|
||||
endif
|
||||
|
||||
do j=1,nc
|
||||
if (off(j) > 0) then
|
||||
ir1 = 1
|
||||
ir2 = nr - off(j)
|
||||
else
|
||||
ir1 = 1 - off(j)
|
||||
ir2 = nr
|
||||
end if
|
||||
do i=ir1, ir2
|
||||
y(i) = y(i) + alpha*data(i,j)*x(i+off(j))
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end subroutine psb_c_dia_csmv_inner
|
||||
|
||||
end subroutine psb_c_dia_csmv
|
||||
@ -0,0 +1,75 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_dia_get_diag(a,d,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_dia_get_diag
|
||||
implicit none
|
||||
class(psb_c_dia_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act, mnm, i, j, k
|
||||
character(len=20) :: name='get_diag'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
mnm = min(a%get_nrows(),a%get_ncols())
|
||||
if (size(d) < mnm) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
call psb_errpush(info,name,i_err=(/2*ione,size(d,kind=psb_ipk_)/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
if (a%is_unit()) then
|
||||
d(1:mnm) = cone
|
||||
else
|
||||
do i=1, size(a%offset)
|
||||
if (a%offset(i) == 0) then
|
||||
d(1:mnm) = a%data(1:mnm,i)
|
||||
exit
|
||||
end if
|
||||
end do
|
||||
end if
|
||||
do i=mnm+1,size(d)
|
||||
d(i) = czero
|
||||
end do
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dia_get_diag
|
||||
@ -0,0 +1,54 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
function psb_c_dia_maxval(a) result(res)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_dia_maxval
|
||||
implicit none
|
||||
class(psb_c_dia_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_) :: res
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nr, ir, jc, nc
|
||||
real(psb_dpk_) :: acc
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_maxval'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
if (a%is_unit()) then
|
||||
res = sone
|
||||
else
|
||||
res = szero
|
||||
end if
|
||||
|
||||
res = max(res,maxval(abs(a%data)))
|
||||
|
||||
end function psb_c_dia_maxval
|
||||
@ -0,0 +1,61 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_dia_mold(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_dia_mold
|
||||
implicit none
|
||||
class(psb_c_dia_sparse_mat), intent(in) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout), allocatable :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='dia_mold'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
info = 0
|
||||
if (allocated(b)) then
|
||||
call b%free()
|
||||
deallocate(b,stat=info)
|
||||
end if
|
||||
if (info == 0) allocate(psb_c_dia_sparse_mat :: b, stat=info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dia_mold
|
||||
@ -0,0 +1,148 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_dia_print(iout,a,iv,head,ivr,ivc)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_dia_print
|
||||
implicit none
|
||||
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
class(psb_c_dia_sparse_mat), intent(in) :: a
|
||||
integer(psb_lpk_), intent(in), optional :: iv(:)
|
||||
character(len=*), optional :: head
|
||||
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_dia_print'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
class(psb_c_coo_sparse_mat),allocatable :: acoo
|
||||
|
||||
character(len=80) :: frmt
|
||||
integer(psb_ipk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz, jc, ir1, ir2
|
||||
|
||||
write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general'
|
||||
if (present(head)) write(iout,'(a,a)') '% ',head
|
||||
write(iout,'(a)') '%'
|
||||
write(iout,'(a,a)') '% COO'
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
nz = a%get_nzeros()
|
||||
frmt = psb_c_get_print_frmt(nr,nc,nz,iv,ivr,ivc)
|
||||
write(iout,*) nr, nc, nz
|
||||
|
||||
nc=size(a%data,2)
|
||||
|
||||
|
||||
|
||||
if(present(iv)) then
|
||||
do j=1,nc
|
||||
jc = a%offset(j)
|
||||
if (jc > 0) then
|
||||
ir1 = 1
|
||||
ir2 = nr - jc
|
||||
else
|
||||
ir1 = 1 - jc
|
||||
ir2 = nr
|
||||
end if
|
||||
do i=ir1, ir2
|
||||
write(iout,frmt) iv(i),iv(i+jc),a%data(i,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else if (present(ivr).and..not.present(ivc)) then
|
||||
do j=1,nc
|
||||
jc = a%offset(j)
|
||||
if (jc > 0) then
|
||||
ir1 = 1
|
||||
ir2 = nr - jc
|
||||
else
|
||||
ir1 = 1 - jc
|
||||
ir2 = nr
|
||||
end if
|
||||
do i=ir1, ir2
|
||||
write(iout,frmt) ivr(i),(i+jc),a%data(i,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else if (present(ivr).and.present(ivc)) then
|
||||
do j=1,nc
|
||||
jc = a%offset(j)
|
||||
if (jc > 0) then
|
||||
ir1 = 1
|
||||
ir2 = nr - jc
|
||||
else
|
||||
ir1 = 1 - jc
|
||||
ir2 = nr
|
||||
end if
|
||||
do i=ir1, ir2
|
||||
write(iout,frmt) ivr(i),ivc(i+jc),a%data(i,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else if (.not.present(ivr).and.present(ivc)) then
|
||||
do j=1,nc
|
||||
jc = a%offset(j)
|
||||
if (jc > 0) then
|
||||
ir1 = 1
|
||||
ir2 = nr - jc
|
||||
else
|
||||
ir1 = 1 - jc
|
||||
ir2 = nr
|
||||
end if
|
||||
do i=ir1, ir2
|
||||
write(iout,frmt) (i),ivc(i+jc),a%data(i,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
else if (.not.present(ivr).and..not.present(ivc)) then
|
||||
do j=1,nc
|
||||
jc = a%offset(j)
|
||||
if (jc > 0) then
|
||||
ir1 = 1
|
||||
ir2 = nr - jc
|
||||
else
|
||||
ir1 = 1 - jc
|
||||
ir2 = nr
|
||||
end if
|
||||
do i=ir1, ir2
|
||||
write(iout,frmt) (i),(i+jc),a%data(i,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
endif
|
||||
|
||||
end subroutine psb_c_dia_print
|
||||
@ -0,0 +1,56 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_dia_reallocate_nz(nz,a)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_dia_reallocate_nz
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: nz
|
||||
class(psb_c_dia_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_) :: m, nzrm, ld
|
||||
Integer(Psb_ipk_) :: err_act, info
|
||||
character(len=20) :: name='c_dia_reallocate_nz'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
!
|
||||
! What should this really do???
|
||||
! Ans: NOTHING.
|
||||
!
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dia_reallocate_nz
|
||||
@ -0,0 +1,78 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_dia_reinit(a,clear)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_dia_reinit
|
||||
implicit none
|
||||
|
||||
class(psb_c_dia_sparse_mat), intent(inout) :: a
|
||||
logical, intent(in), optional :: clear
|
||||
|
||||
Integer(Psb_ipk_) :: err_act, info
|
||||
character(len=20) :: name='reinit'
|
||||
logical :: clear_
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
|
||||
if (present(clear)) then
|
||||
clear_ = clear
|
||||
else
|
||||
clear_ = .true.
|
||||
end if
|
||||
|
||||
if (a%is_bld() .or. a%is_upd()) then
|
||||
! do nothing
|
||||
return
|
||||
else if (a%is_asb()) then
|
||||
if (a%is_dev()) call a%sync()
|
||||
if (clear_) a%data(:,:) = czero
|
||||
call a%set_upd()
|
||||
call a%set_host()
|
||||
|
||||
else
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dia_reinit
|
||||
@ -0,0 +1,87 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_dia_rowsum(d,a)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_dia_rowsum
|
||||
implicit none
|
||||
class(psb_c_dia_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, ir1,ir2, nr
|
||||
logical :: tra
|
||||
integer(psb_ipk_) :: err_act, info, int_err(5)
|
||||
character(len=20) :: name='rowsum'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
m = a%get_nrows()
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_small_i_
|
||||
int_err(1) = 1
|
||||
int_err(2) = size(d)
|
||||
int_err(3) = n
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (a%is_unit()) then
|
||||
d = sone
|
||||
else
|
||||
d = szero
|
||||
end if
|
||||
|
||||
nr = size(a%data,1)
|
||||
nc = size(a%data,2)
|
||||
do j=1,nc
|
||||
jc = a%offset(j)
|
||||
if (jc > 0) then
|
||||
ir1 = 1
|
||||
ir2 = nr - jc
|
||||
else
|
||||
ir1 = 1 - jc
|
||||
ir2 = nr
|
||||
end if
|
||||
do i=ir1, ir2
|
||||
d(i) = d(i) + a%data(i,j)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dia_rowsum
|
||||
@ -0,0 +1,108 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_dia_scal(d,a,info,side)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_dia_scal
|
||||
implicit none
|
||||
class(psb_c_dia_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
Integer(Psb_ipk_) :: err_act,mnm, i, j, m, n, ierr(5), nc, jc, nr, ir1, ir2
|
||||
character(len=20) :: name='scal'
|
||||
character :: side_
|
||||
logical :: left
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (a%is_unit()) then
|
||||
call a%make_nonunit()
|
||||
end if
|
||||
|
||||
side_ = 'L'
|
||||
if (present(side)) then
|
||||
side_ = psb_toupper(side)
|
||||
end if
|
||||
|
||||
left = (side_ == 'L')
|
||||
|
||||
if (left) then
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
call psb_errpush(info,name,i_err=(/2*ione,size(d,kind=psb_ipk_)/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1, m
|
||||
a%data(i,:) = a%data(i,:) * d(i)
|
||||
enddo
|
||||
else
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
nr=size(a%data,1)
|
||||
nc=size(a%data,2)
|
||||
do j=1,nc
|
||||
jc = a%offset(j)
|
||||
if (jc > 0) then
|
||||
ir1 = 1
|
||||
ir2 = nr - jc
|
||||
else
|
||||
ir1 = 1 - jc
|
||||
ir2 = nr
|
||||
end if
|
||||
do i=ir1, ir2
|
||||
a%data(i,j) = a%data(i,j) * d(i+jc)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end if
|
||||
call a%set_host()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dia_scal
|
||||
@ -0,0 +1,63 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_dia_scals(d,a,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_dia_scals
|
||||
implicit none
|
||||
class(psb_c_dia_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
Integer(Psb_ipk_) :: err_act,mnm, i, j, m
|
||||
character(len=20) :: name='scal'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (a%is_unit()) then
|
||||
call a%make_nonunit()
|
||||
end if
|
||||
|
||||
a%data(:,:) = a%data(:,:) * d
|
||||
call a%set_host()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dia_scals
|
||||
@ -0,0 +1,724 @@
|
||||
|
||||
!> Function csmv:
|
||||
!! \memberof psb_c_dns_sparse_mat
|
||||
!! \brief Product by a dense rank 1 array.
|
||||
!!
|
||||
!! Compute
|
||||
!! Y = alpha*op(A)*X + beta*Y
|
||||
!!
|
||||
!! \param alpha Scaling factor for Ax
|
||||
!! \param A the input sparse matrix
|
||||
!! \param x(:) the input dense X
|
||||
!! \param beta Scaling factor for y
|
||||
!! \param y(:) the input/output dense Y
|
||||
!! \param info return code
|
||||
!! \param trans [N] Whether to use A (N), its transpose (T)
|
||||
!! or its conjugate transpose (C)
|
||||
!!
|
||||
!
|
||||
subroutine psb_c_dns_csmv(alpha,a,x,beta,y,info,trans)
|
||||
use psb_base_mod
|
||||
use psb_c_dns_mat_mod, psb_protect_name => psb_c_dns_csmv
|
||||
implicit none
|
||||
class(psb_c_dns_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
|
||||
complex(psb_spk_), intent(inout) :: y(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
!
|
||||
character :: trans_
|
||||
integer(psb_ipk_) :: err_act, m, n, lda
|
||||
character(len=20) :: name='c_dns_csmv'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = psb_toupper(trans)
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
|
||||
if (.not.a%is_asb()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
if (trans_ == 'N') then
|
||||
m=a%get_nrows()
|
||||
n=a%get_ncols()
|
||||
else
|
||||
n=a%get_nrows()
|
||||
m=a%get_ncols()
|
||||
end if
|
||||
lda = size(a%val,1)
|
||||
|
||||
|
||||
call cgemv(trans_,a%get_nrows(),a%get_ncols(),alpha,&
|
||||
& a%val,size(a%val,1),x,1,beta,y,1)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dns_csmv
|
||||
|
||||
|
||||
!> Function csmm:
|
||||
!! \memberof psb_c_dns_sparse_mat
|
||||
!! \brief Product by a dense rank 2 array.
|
||||
!!
|
||||
!! Compute
|
||||
!! Y = alpha*op(A)*X + beta*Y
|
||||
!!
|
||||
!! \param alpha Scaling factor for Ax
|
||||
!! \param A the input sparse matrix
|
||||
!! \param x(:,:) the input dense X
|
||||
!! \param beta Scaling factor for y
|
||||
!! \param y(:,:) the input/output dense Y
|
||||
!! \param info return code
|
||||
!! \param trans [N] Whether to use A (N), its transpose (T)
|
||||
!! or its conjugate transpose (C)
|
||||
!!
|
||||
!
|
||||
subroutine psb_c_dns_csmm(alpha,a,x,beta,y,info,trans)
|
||||
use psb_base_mod
|
||||
use psb_c_dns_mat_mod, psb_protect_name => psb_c_dns_csmm
|
||||
implicit none
|
||||
class(psb_c_dns_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
|
||||
complex(psb_spk_), intent(inout) :: y(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
!
|
||||
character :: trans_
|
||||
integer(psb_ipk_) :: err_act,m,n,k, lda, ldx, ldy
|
||||
character(len=20) :: name='c_dns_csmm'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
|
||||
if (.not.a%is_asb()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
if (psb_toupper(trans_)=='N') then
|
||||
m = a%get_nrows()
|
||||
k = a%get_ncols()
|
||||
n = min(size(y,2),size(x,2))
|
||||
else
|
||||
k = a%get_nrows()
|
||||
m = a%get_ncols()
|
||||
n = min(size(y,2),size(x,2))
|
||||
end if
|
||||
lda = size(a%val,1)
|
||||
ldx = size(x,1)
|
||||
ldy = size(y,1)
|
||||
call cgemm(trans_,'N',m,n,k,alpha,a%val,lda,x,ldx,beta,y,ldy)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dns_csmm
|
||||
|
||||
|
||||
|
||||
!
|
||||
!
|
||||
!> Function csnmi:
|
||||
!! \memberof psb_c_dns_sparse_mat
|
||||
!! \brief Operator infinity norm
|
||||
!! CSNMI = MAXVAL(SUM(ABS(A(:,:)),dim=2))
|
||||
!!
|
||||
!
|
||||
function psb_c_dns_csnmi(a) result(res)
|
||||
use psb_base_mod
|
||||
use psb_c_dns_mat_mod, psb_protect_name => psb_c_dns_csnmi
|
||||
implicit none
|
||||
class(psb_c_dns_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_) :: res
|
||||
!
|
||||
integer(psb_ipk_) :: i
|
||||
real(psb_spk_) :: acc
|
||||
|
||||
res = szero
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
do i = 1, a%get_nrows()
|
||||
acc = sum(abs(a%val(i,:)))
|
||||
res = max(res,acc)
|
||||
end do
|
||||
|
||||
end function psb_c_dns_csnmi
|
||||
|
||||
|
||||
!
|
||||
!> Function get_diag:
|
||||
!! \memberof psb_c_dns_sparse_mat
|
||||
!! \brief Extract the diagonal of A.
|
||||
!!
|
||||
!! D(i) = A(i:i), i=1:min(nrows,ncols)
|
||||
!!
|
||||
!! \param d(:) The output diagonal
|
||||
!! \param info return code.
|
||||
!
|
||||
subroutine psb_c_dns_get_diag(a,d,info)
|
||||
use psb_base_mod
|
||||
use psb_c_dns_mat_mod, psb_protect_name => psb_c_dns_get_diag
|
||||
implicit none
|
||||
class(psb_c_dns_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
!
|
||||
integer(psb_ipk_) :: err_act, mnm, i
|
||||
character(len=20) :: name='get_diag'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
mnm = min(a%get_nrows(),a%get_ncols())
|
||||
if (size(d) < mnm) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
call psb_errpush(info,name,i_err=(/2_psb_ipk_,size(d,kind=psb_ipk_)/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
do i=1, mnm
|
||||
d(i) = a%val(i,i)
|
||||
end do
|
||||
do i=mnm+1,size(d)
|
||||
d(i) = czero
|
||||
end do
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dns_get_diag
|
||||
|
||||
|
||||
!
|
||||
!
|
||||
!> Function reallocate_nz
|
||||
!! \memberof psb_c_dns_sparse_mat
|
||||
!! \brief One--parameters version of (re)allocate
|
||||
!!
|
||||
!! \param nz number of nonzeros to allocate for
|
||||
!! i.e. makes sure that the internal storage
|
||||
!! allows for NZ coefficients and their indices.
|
||||
!
|
||||
subroutine psb_c_dns_reallocate_nz(nz,a)
|
||||
use psb_base_mod
|
||||
use psb_c_dns_mat_mod, psb_protect_name => psb_c_dns_reallocate_nz
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: nz
|
||||
class(psb_c_dns_sparse_mat), intent(inout) :: a
|
||||
!
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_dns_reallocate_nz'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
!
|
||||
! This is a no-op, allocation is fixed.
|
||||
!
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dns_reallocate_nz
|
||||
|
||||
!
|
||||
!> Function mold:
|
||||
!! \memberof psb_c_dns_sparse_mat
|
||||
!! \brief Allocate a class(psb_c_dns_sparse_mat) with the
|
||||
!! same dynamic type as the input.
|
||||
!! This is equivalent to allocate( mold= ) and is provided
|
||||
!! for those compilers not yet supporting mold.
|
||||
!! \param b The output variable
|
||||
!! \param info return code
|
||||
!
|
||||
subroutine psb_c_dns_mold(a,b,info)
|
||||
use psb_base_mod
|
||||
use psb_c_dns_mat_mod, psb_protect_name => psb_c_dns_mold
|
||||
implicit none
|
||||
class(psb_c_dns_sparse_mat), intent(in) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout), allocatable :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
!
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='dns_mold'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
|
||||
allocate(psb_c_dns_sparse_mat :: b, stat=info)
|
||||
|
||||
if (info /= 0) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dns_mold
|
||||
|
||||
!
|
||||
!
|
||||
!> Function allocate_mnnz
|
||||
!! \memberof psb_c_dns_sparse_mat
|
||||
!! \brief Three-parameters version of allocate
|
||||
!!
|
||||
!! \param m number of rows
|
||||
!! \param n number of cols
|
||||
!! \param nz [estimated internally] number of nonzeros to allocate for
|
||||
!
|
||||
subroutine psb_c_dns_allocate_mnnz(m,n,a,nz)
|
||||
use psb_base_mod
|
||||
use psb_c_dns_mat_mod, psb_protect_name => psb_c_dns_allocate_mnnz
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_c_dns_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(in), optional :: nz
|
||||
!
|
||||
integer(psb_ipk_) :: err_act, info, nz_
|
||||
character(len=20) :: name='allocate_mnz'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (m < 0) then
|
||||
info = psb_err_iarg_neg_
|
||||
call psb_errpush(info,name,i_err=(/1_psb_ipk_/))
|
||||
goto 9999
|
||||
endif
|
||||
if (n < 0) then
|
||||
info = psb_err_iarg_neg_
|
||||
call psb_errpush(info,name,i_err=(/2_psb_ipk_/))
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
|
||||
! Basic stuff common to all formats
|
||||
call a%set_nrows(m)
|
||||
call a%set_ncols(n)
|
||||
call a%set_triangle(.false.)
|
||||
call a%set_unit(.false.)
|
||||
call a%set_dupl(psb_dupl_def_)
|
||||
call a%set_bld()
|
||||
call a%set_host()
|
||||
|
||||
! We ignore NZ in this case.
|
||||
|
||||
call psb_realloc(m,n,a%val,info)
|
||||
if (info == psb_success_) then
|
||||
a%val = czero
|
||||
a%nnz = 0
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dns_allocate_mnnz
|
||||
|
||||
|
||||
!
|
||||
!
|
||||
!
|
||||
!> Function csgetrow:
|
||||
!! \memberof psb_c_dns_sparse_mat
|
||||
!! \brief Get a (subset of) row(s)
|
||||
!!
|
||||
!! getrow is the basic method by which the other (getblk, clip) can
|
||||
!! be implemented.
|
||||
!!
|
||||
!! Returns the set
|
||||
!! NZ, IA(1:nz), JA(1:nz), VAL(1:NZ)
|
||||
!! each identifying the position of a nonzero in A
|
||||
!! i.e.
|
||||
!! VAL(1:NZ) = A(IA(1:NZ),JA(1:NZ))
|
||||
!! with IMIN<=IA(:)<=IMAX
|
||||
!! with JMIN<=JA(:)<=JMAX
|
||||
!! IA,JA are reallocated as necessary.
|
||||
!!
|
||||
!! \param imin the minimum row index we are interested in
|
||||
!! \param imax the minimum row index we are interested in
|
||||
!! \param nz the number of output coefficients
|
||||
!! \param ia(:) the output row indices
|
||||
!! \param ja(:) the output col indices
|
||||
!! \param val(:) the output coefficients
|
||||
!! \param info return code
|
||||
!! \param jmin [1] minimum col index
|
||||
!! \param jmax [a\%get_ncols()] maximum col index
|
||||
!! \param iren(:) [none] an array to return renumbered indices (iren(ia(:)),iren(ja(:))
|
||||
!! \param rscale [false] map [min(ia(:)):max(ia(:))] onto [1:max(ia(:))-min(ia(:))+1]
|
||||
!! \param cscale [false] map [min(ja(:)):max(ja(:))] onto [1:max(ja(:))-min(ja(:))+1]
|
||||
!! ( iren cannot be specified with rscale/cscale)
|
||||
!! \param append [false] append to ia,ja
|
||||
!! \param nzin [none] if append, then first new entry should go in entry nzin+1
|
||||
!!
|
||||
!
|
||||
subroutine psb_c_dns_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
|
||||
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
|
||||
use psb_base_mod
|
||||
use psb_c_dns_mat_mod, psb_protect_name => psb_c_dns_csgetrow
|
||||
implicit none
|
||||
|
||||
class(psb_c_dns_sparse_mat), intent(in) :: a
|
||||
integer(psb_ipk_), intent(in) :: imin,imax
|
||||
integer(psb_ipk_), intent(out) :: nz
|
||||
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
|
||||
complex(psb_spk_), allocatable, intent(inout) :: val(:)
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
logical, intent(in), optional :: append
|
||||
integer(psb_ipk_), intent(in), optional :: iren(:)
|
||||
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
|
||||
logical, intent(in), optional :: rscale,cscale,chksz
|
||||
!
|
||||
logical :: append_, rscale_, cscale_, chksz_
|
||||
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i,j,k
|
||||
character(len=20) :: name='csget'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (present(jmin)) then
|
||||
jmin_ = jmin
|
||||
else
|
||||
jmin_ = 1
|
||||
endif
|
||||
if (present(jmax)) then
|
||||
jmax_ = jmax
|
||||
else
|
||||
jmax_ = a%get_ncols()
|
||||
endif
|
||||
|
||||
if ((imax<imin).or.(jmax_<jmin_)) then
|
||||
nz = 0
|
||||
return
|
||||
end if
|
||||
|
||||
if (present(append)) then
|
||||
append_=append
|
||||
else
|
||||
append_=.false.
|
||||
endif
|
||||
if ((append_).and.(present(nzin))) then
|
||||
nzin_ = nzin
|
||||
else
|
||||
nzin_ = 0
|
||||
endif
|
||||
if (present(rscale)) then
|
||||
rscale_ = rscale
|
||||
else
|
||||
rscale_ = .false.
|
||||
endif
|
||||
if (present(cscale)) then
|
||||
cscale_ = cscale
|
||||
else
|
||||
cscale_ = .false.
|
||||
endif
|
||||
if (present(chksz)) then
|
||||
chksz_ = chksz
|
||||
else
|
||||
chksz_ = .true.
|
||||
endif
|
||||
|
||||
if ((rscale_.or.cscale_).and.(present(iren))) then
|
||||
info = psb_err_many_optional_arg_
|
||||
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (append) then
|
||||
write(0,*) 'APPEND=TRUE NOT IMPLEMENTED'
|
||||
info = -1
|
||||
call psb_errpush(info,name,a_err='not impl')
|
||||
goto 9999
|
||||
end if
|
||||
nz = count(a%val(imin:imax,jmin_:jmax_) /= czero)
|
||||
|
||||
if (chksz_) then
|
||||
call psb_ensure_size(nzin_+nz,ia,info)
|
||||
if (info == psb_success_) call psb_ensure_size(nzin_+nz,ja,info)
|
||||
if (info == psb_success_) call psb_ensure_size(nzin_+nz,val,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
end if
|
||||
|
||||
k = 0
|
||||
do i=imin,imax
|
||||
do j=jmin_,jmax_
|
||||
if (a%val(i,j) /= czero) then
|
||||
k = k + 1
|
||||
ia(k) = i
|
||||
ja(k) = j
|
||||
val(k) = a%val(i,j)
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
|
||||
if (rscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ia(i) = ia(i) - imin + 1
|
||||
end do
|
||||
end if
|
||||
if (cscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ja(i) = ja(i) - jmin_ + 1
|
||||
end do
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dns_csgetrow
|
||||
|
||||
|
||||
!> Function trim
|
||||
!! \memberof psb_c_dns_sparse_mat
|
||||
!! \brief Memory trim
|
||||
!! Make sure the memory allocation of the sparse matrix is as tight as
|
||||
!! possible given the actual number of nonzeros it contains.
|
||||
!
|
||||
subroutine psb_c_dns_trim(a)
|
||||
use psb_base_mod
|
||||
use psb_c_dns_mat_mod, psb_protect_name => psb_c_dns_trim
|
||||
implicit none
|
||||
class(psb_c_dns_sparse_mat), intent(inout) :: a
|
||||
!
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='trim'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
! Do nothing, we are already at minimum memory.
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_dns_trim
|
||||
|
||||
!
|
||||
!> Function cp_from_coo:
|
||||
!! \memberof psb_c_dns_sparse_mat
|
||||
!! \brief Copy and convert from psb_c_coo_sparse_mat
|
||||
!! Invoked from the target object.
|
||||
!! \param b The input variable
|
||||
!! \param info return code
|
||||
!
|
||||
|
||||
subroutine psb_c_cp_dns_from_coo(a,b,info)
|
||||
use psb_base_mod
|
||||
use psb_c_dns_mat_mod, psb_protect_name => psb_c_cp_dns_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_dns_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
!
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
integer(psb_ipk_) :: nza, nr, i,err_act, nc
|
||||
integer(psb_ipk_), parameter :: maxtry=8
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (.not.b%is_by_rows()) then
|
||||
! This is to have fix_coo called behind the scenes
|
||||
call b%cp_to_coo(tmp,info)
|
||||
call tmp%fix(info)
|
||||
if (info /= psb_success_) return
|
||||
|
||||
nr = tmp%get_nrows()
|
||||
nc = tmp%get_ncols()
|
||||
nza = tmp%get_nzeros()
|
||||
! If it is sorted then we can lessen memory impact
|
||||
a%psb_c_base_sparse_mat = tmp%psb_c_base_sparse_mat
|
||||
|
||||
call psb_realloc(nr,nc,a%val,info)
|
||||
if (info /= 0) goto 9999
|
||||
a%val = czero
|
||||
do i=1, nza
|
||||
a%val(tmp%ia(i),tmp%ja(i)) = tmp%val(i)
|
||||
end do
|
||||
a%nnz = nza
|
||||
call tmp%free()
|
||||
else
|
||||
if (b%is_dev()) call b%sync()
|
||||
nr = b%get_nrows()
|
||||
nc = b%get_ncols()
|
||||
nza = b%get_nzeros()
|
||||
! If it is sorted then we can lessen memory impact
|
||||
a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat
|
||||
|
||||
call psb_realloc(nr,nc,a%val,info)
|
||||
if (info /= 0) goto 9999
|
||||
a%val = czero
|
||||
do i=1, nza
|
||||
a%val(b%ia(i),b%ja(i)) = b%val(i)
|
||||
end do
|
||||
a%nnz = nza
|
||||
end if
|
||||
call a%set_host()
|
||||
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_cp_dns_from_coo
|
||||
|
||||
|
||||
|
||||
!
|
||||
!> Function cp_to_coo:
|
||||
!! \memberof psb_c_dns_sparse_mat
|
||||
!! \brief Copy and convert to psb_c_coo_sparse_mat
|
||||
!! Invoked from the source object.
|
||||
!! \param b The output variable
|
||||
!! \param info return code
|
||||
!
|
||||
|
||||
subroutine psb_c_cp_dns_to_coo(a,b,info)
|
||||
use psb_base_mod
|
||||
use psb_c_dns_mat_mod, psb_protect_name => psb_c_cp_dns_to_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_dns_sparse_mat), intent(in) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
Integer(Psb_Ipk_) :: nza, nr, nc,i,j,k,err_act
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
nza = a%get_nzeros()
|
||||
|
||||
call b%allocate(nr,nc,nza)
|
||||
b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat
|
||||
|
||||
k = 0
|
||||
do i=1,a%get_nrows()
|
||||
do j=1,a%get_ncols()
|
||||
if (a%val(i,j) /= czero) then
|
||||
k = k + 1
|
||||
b%ia(k) = i
|
||||
b%ja(k) = j
|
||||
b%val(k) = a%val(i,j)
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
|
||||
call b%set_nzeros(nza)
|
||||
call b%set_sort_status(psb_row_major_)
|
||||
call b%set_asb()
|
||||
call b%set_host()
|
||||
|
||||
end subroutine psb_c_cp_dns_to_coo
|
||||
|
||||
|
||||
|
||||
!
|
||||
!> Function mv_to_coo:
|
||||
!! \memberof psb_c_dns_sparse_mat
|
||||
!! \brief Convert to psb_c_coo_sparse_mat, freeing the source.
|
||||
!! Invoked from the source object.
|
||||
!! \param b The output variable
|
||||
!! \param info return code
|
||||
!
|
||||
subroutine psb_c_mv_dns_to_coo(a,b,info)
|
||||
use psb_base_mod
|
||||
use psb_c_dns_mat_mod, psb_protect_name => psb_c_mv_dns_to_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_dns_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
|
||||
call a%cp_to_coo(b,info)
|
||||
call a%free()
|
||||
return
|
||||
|
||||
end subroutine psb_c_mv_dns_to_coo
|
||||
|
||||
|
||||
!
|
||||
!> Function mv_from_coo:
|
||||
!! \memberof psb_c_dns_sparse_mat
|
||||
!! \brief Convert from psb_c_coo_sparse_mat, freeing the source.
|
||||
!! Invoked from the target object.
|
||||
!! \param b The input variable
|
||||
!! \param info return code
|
||||
!
|
||||
!
|
||||
subroutine psb_c_mv_dns_from_coo(a,b,info)
|
||||
use psb_base_mod
|
||||
use psb_c_dns_mat_mod, psb_protect_name => psb_c_mv_dns_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_dns_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
info = psb_success_
|
||||
|
||||
call a%cp_from_coo(b,info)
|
||||
call b%free()
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_c_mv_dns_from_coo
|
||||
|
||||
@ -0,0 +1,82 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_aclsum(d,a)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_aclsum
|
||||
implicit none
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_), intent(out) :: d(:)
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc
|
||||
logical :: tra
|
||||
Integer(Psb_ipk_) :: err_act, info, int_err(5)
|
||||
character(len=20) :: name='aclsum'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
m = a%get_nrows()
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_small_i_
|
||||
int_err(1) = 1
|
||||
int_err(2) = size(d)
|
||||
int_err(3) = n
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (a%is_unit()) then
|
||||
d = sone
|
||||
else
|
||||
d = szero
|
||||
end if
|
||||
|
||||
do i=1, m
|
||||
do j=1,a%irn(i)
|
||||
k = a%ja(i,j)
|
||||
d(k) = d(k) + abs(a%val(i,j))
|
||||
end do
|
||||
end do
|
||||
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_ell_aclsum
|
||||
@ -0,0 +1,91 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_allocate_mnnz(m,n,a,nz)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_allocate_mnnz
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_c_ell_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(in), optional :: nz
|
||||
Integer(Psb_ipk_) :: err_act, info, nz_
|
||||
character(len=20) :: name='allocate_mnz'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (m < 0) then
|
||||
info = psb_err_iarg_neg_
|
||||
call psb_errpush(info,name,i_err=(/ione/))
|
||||
goto 9999
|
||||
endif
|
||||
if (n < 0) then
|
||||
info = psb_err_iarg_neg_
|
||||
call psb_errpush(info,name,i_err=(/2*ione/))
|
||||
goto 9999
|
||||
endif
|
||||
if (present(nz)) then
|
||||
nz_ = (max(nz,ione) + m -1 )/m
|
||||
else
|
||||
nz_ = (max(7*m,7*n,ione)+m-1)/m
|
||||
end if
|
||||
if (nz_ < 0) then
|
||||
info = psb_err_iarg_neg_
|
||||
call psb_errpush(info,name,i_err=(/3*ione/))
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (info == psb_success_) call psb_realloc(m,a%irn,info)
|
||||
if (info == psb_success_) call psb_realloc(m,a%idiag,info)
|
||||
if (info == psb_success_) call psb_realloc(m,nz_,a%ja,info)
|
||||
if (info == psb_success_) call psb_realloc(m,nz_,a%val,info)
|
||||
if (info == psb_success_) then
|
||||
a%irn = 0
|
||||
a%idiag = 0
|
||||
a%nzt = -1
|
||||
call a%set_nrows(m)
|
||||
call a%set_ncols(n)
|
||||
call a%set_bld()
|
||||
call a%set_triangle(.false.)
|
||||
call a%set_unit(.false.)
|
||||
call a%set_dupl(psb_dupl_def_)
|
||||
end if
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_ell_allocate_mnnz
|
||||
@ -0,0 +1,78 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_arwsum(d,a)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_arwsum
|
||||
implicit none
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_), intent(out) :: d(:)
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc
|
||||
logical :: tra, is_unit
|
||||
Integer(Psb_ipk_) :: err_act, info, int_err(5)
|
||||
character(len=20) :: name='rowsum'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_small_i_
|
||||
int_err(1) = 1
|
||||
int_err(2) = size(d)
|
||||
int_err(3) = m
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
is_unit = a%is_unit()
|
||||
|
||||
do i = 1, a%get_nrows()
|
||||
if (is_unit) then
|
||||
d(i) = sone
|
||||
else
|
||||
d(i) = szero
|
||||
end if
|
||||
do j=1,a%irn(i)
|
||||
d(i) = d(i) + abs(a%val(i,j))
|
||||
end do
|
||||
end do
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_ell_arwsum
|
||||
@ -0,0 +1,80 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_colsum(d,a)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_colsum
|
||||
implicit none
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc
|
||||
logical :: tra
|
||||
Integer(Psb_ipk_) :: err_act, info, int_err(5)
|
||||
character(len=20) :: name='colsum'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
m = a%get_nrows()
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_small_i_
|
||||
int_err(1) = 1
|
||||
int_err(2) = size(d)
|
||||
int_err(3) = n
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (a%is_unit()) then
|
||||
d = cone
|
||||
else
|
||||
d = czero
|
||||
end if
|
||||
|
||||
do i=1, m
|
||||
do j=1,a%irn(i)
|
||||
k = a%ja(i,j)
|
||||
d(k) = d(k) + (a%val(i,j))
|
||||
end do
|
||||
end do
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_ell_colsum
|
||||
@ -0,0 +1,83 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_csgetblk(imin,imax,a,b,info,&
|
||||
& jmin,jmax,iren,append,rscale,cscale)
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_csgetblk
|
||||
implicit none
|
||||
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(in) :: imin,imax
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
logical, intent(in), optional :: append
|
||||
integer(psb_ipk_), intent(in), optional :: iren(:)
|
||||
integer(psb_ipk_), intent(in), optional :: jmin,jmax
|
||||
logical, intent(in), optional :: rscale,cscale
|
||||
Integer(Psb_ipk_) :: err_act, nzin, nzout
|
||||
character(len=20) :: name='ell_getblk'
|
||||
logical :: append_
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (present(append)) then
|
||||
append_ = append
|
||||
else
|
||||
append_ = .false.
|
||||
endif
|
||||
if (append_) then
|
||||
nzin = a%get_nzeros()
|
||||
else
|
||||
nzin = 0
|
||||
endif
|
||||
|
||||
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
|
||||
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
|
||||
& nzin=nzin, rscale=rscale, cscale=cscale)
|
||||
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call b%set_nzeros(nzin+nzout)
|
||||
call b%set_host()
|
||||
call b%fix(info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_ell_csgetblk
|
||||
@ -0,0 +1,189 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_csgetptn(imin,imax,a,nz,ia,ja,info,&
|
||||
& jmin,jmax,iren,append,nzin,rscale,cscale)
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_csgetptn
|
||||
implicit none
|
||||
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
integer(psb_ipk_), intent(in) :: imin,imax
|
||||
integer(psb_ipk_), intent(out) :: nz
|
||||
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
logical, intent(in), optional :: append
|
||||
integer(psb_ipk_), intent(in), optional :: iren(:)
|
||||
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
|
||||
logical, intent(in), optional :: rscale,cscale
|
||||
|
||||
logical :: append_, rscale_, cscale_
|
||||
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
|
||||
character(len=20) :: name='ell_getptn'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (present(jmin)) then
|
||||
jmin_ = jmin
|
||||
else
|
||||
jmin_ = 1
|
||||
endif
|
||||
if (present(jmax)) then
|
||||
jmax_ = jmax
|
||||
else
|
||||
jmax_ = a%get_ncols()
|
||||
endif
|
||||
|
||||
if ((imax<imin).or.(jmax_<jmin_)) then
|
||||
nz = 0
|
||||
return
|
||||
end if
|
||||
|
||||
if (present(append)) then
|
||||
append_=append
|
||||
else
|
||||
append_=.false.
|
||||
endif
|
||||
if ((append_).and.(present(nzin))) then
|
||||
nzin_ = nzin
|
||||
else
|
||||
nzin_ = 0
|
||||
endif
|
||||
if (present(rscale)) then
|
||||
rscale_ = rscale
|
||||
else
|
||||
rscale_ = .false.
|
||||
endif
|
||||
if (present(cscale)) then
|
||||
cscale_ = cscale
|
||||
else
|
||||
cscale_ = .false.
|
||||
endif
|
||||
if ((rscale_.or.cscale_).and.(present(iren))) then
|
||||
info = psb_err_many_optional_arg_
|
||||
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
call ell_getptn(imin,imax,jmin_,jmax_,a,nz,ia,ja,nzin_,append_,info,iren)
|
||||
|
||||
if (rscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ia(i) = ia(i) - imin + 1
|
||||
end do
|
||||
end if
|
||||
if (cscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ja(i) = ja(i) - jmin_ + 1
|
||||
end do
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine ell_getptn(imin,imax,jmin,jmax,a,nz,ia,ja,nzin,append,info,&
|
||||
& iren)
|
||||
implicit none
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
integer(psb_ipk_) :: imin,imax,jmin,jmax
|
||||
integer(psb_ipk_), intent(out) :: nz
|
||||
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
|
||||
integer(psb_ipk_), intent(in) :: nzin
|
||||
logical, intent(in) :: append
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_), optional :: iren(:)
|
||||
integer(psb_ipk_) :: nzin_, nza, idx,i,j,k, nzt, irw, lrw
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name='ell_getptn'
|
||||
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
|
||||
nza = a%get_nzeros()
|
||||
irw = imin
|
||||
lrw = min(imax,a%get_nrows())
|
||||
if (irw<0) then
|
||||
info = psb_err_pivot_too_small_
|
||||
return
|
||||
end if
|
||||
|
||||
if (append) then
|
||||
nzin_ = nzin
|
||||
else
|
||||
nzin_ = 0
|
||||
endif
|
||||
|
||||
nzt = sum(a%irn(irw:lrw))
|
||||
nz = 0
|
||||
|
||||
call psb_ensure_size(nzin_+nzt,ia,info)
|
||||
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
|
||||
|
||||
if (info /= psb_success_) return
|
||||
|
||||
if (present(iren)) then
|
||||
do i=irw, lrw
|
||||
do j=1,a%irn(i)
|
||||
if ((jmin <= a%ja(i,j)).and.(a%ja(i,j)<=jmax)) then
|
||||
nzin_ = nzin_ + 1
|
||||
nz = nz + 1
|
||||
ia(nzin_) = iren(i)
|
||||
ja(nzin_) = iren(a%ja(i,j))
|
||||
end if
|
||||
enddo
|
||||
end do
|
||||
else
|
||||
do i=irw, lrw
|
||||
do j=1,a%irn(i)
|
||||
if ((jmin <= a%ja(i,j)).and.(a%ja(i,j)<=jmax)) then
|
||||
nzin_ = nzin_ + 1
|
||||
nz = nz + 1
|
||||
ia(nzin_) = (i)
|
||||
ja(nzin_) = (a%ja(i,j))
|
||||
end if
|
||||
enddo
|
||||
end do
|
||||
end if
|
||||
|
||||
end subroutine ell_getptn
|
||||
|
||||
end subroutine psb_c_ell_csgetptn
|
||||
@ -0,0 +1,205 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
|
||||
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_csgetrow
|
||||
implicit none
|
||||
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
integer(psb_ipk_), intent(in) :: imin,imax
|
||||
integer(psb_ipk_), intent(out) :: nz
|
||||
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
|
||||
complex(psb_spk_), allocatable, intent(inout) :: val(:)
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
logical, intent(in), optional :: append
|
||||
integer(psb_ipk_), intent(in), optional :: iren(:)
|
||||
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
|
||||
logical, intent(in), optional :: rscale,cscale,chksz
|
||||
|
||||
logical :: append_, rscale_, cscale_, chksz_
|
||||
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
|
||||
character(len=20) :: name='ell_getrow'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (present(jmin)) then
|
||||
jmin_ = jmin
|
||||
else
|
||||
jmin_ = 1
|
||||
endif
|
||||
if (present(jmax)) then
|
||||
jmax_ = jmax
|
||||
else
|
||||
jmax_ = a%get_ncols()
|
||||
endif
|
||||
|
||||
if ((imax<imin).or.(jmax_<jmin_)) then
|
||||
nz = 0
|
||||
return
|
||||
end if
|
||||
|
||||
if (present(append)) then
|
||||
append_=append
|
||||
else
|
||||
append_=.false.
|
||||
endif
|
||||
if ((append_).and.(present(nzin))) then
|
||||
nzin_ = nzin
|
||||
else
|
||||
nzin_ = 0
|
||||
endif
|
||||
if (present(rscale)) then
|
||||
rscale_ = rscale
|
||||
else
|
||||
rscale_ = .false.
|
||||
endif
|
||||
if (present(cscale)) then
|
||||
cscale_ = cscale
|
||||
else
|
||||
cscale_ = .false.
|
||||
endif
|
||||
if ((rscale_.or.cscale_).and.(present(iren))) then
|
||||
info = psb_err_many_optional_arg_
|
||||
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
|
||||
goto 9999
|
||||
end if
|
||||
if (present(chksz)) then
|
||||
chksz_ = chksz
|
||||
else
|
||||
chksz_ = .true.
|
||||
endif
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
call ell_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,&
|
||||
& append_,chksz_,info,iren)
|
||||
|
||||
if (rscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ia(i) = ia(i) - imin + 1
|
||||
end do
|
||||
end if
|
||||
if (cscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ja(i) = ja(i) - jmin_ + 1
|
||||
end do
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine ell_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,&
|
||||
& iren)
|
||||
|
||||
implicit none
|
||||
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
integer(psb_ipk_) :: imin,imax,jmin,jmax
|
||||
integer(psb_ipk_), intent(out) :: nz
|
||||
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
|
||||
complex(psb_spk_), allocatable, intent(inout) :: val(:)
|
||||
integer(psb_ipk_), intent(in) :: nzin
|
||||
logical, intent(in) :: append,chksz
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_), optional :: iren(:)
|
||||
integer(psb_ipk_) :: nzin_, nza, idx,i,j,k, nzt, irw, lrw
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name='coo_getrow'
|
||||
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
info = psb_success_
|
||||
|
||||
nza = a%get_nzeros()
|
||||
irw = imin
|
||||
lrw = min(imax,a%get_nrows())
|
||||
if (irw<0) then
|
||||
info = psb_err_pivot_too_small_
|
||||
return
|
||||
end if
|
||||
|
||||
if (append) then
|
||||
nzin_ = nzin
|
||||
else
|
||||
nzin_ = 0
|
||||
endif
|
||||
|
||||
nzt = sum(a%irn(irw:lrw))
|
||||
nz = 0
|
||||
|
||||
|
||||
if (chksz) then
|
||||
call psb_ensure_size(nzin_+nzt,ia,info)
|
||||
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
|
||||
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) return
|
||||
|
||||
if (present(iren)) then
|
||||
do i=irw, lrw
|
||||
do j=1,a%irn(i)
|
||||
if ((jmin <= a%ja(i,j)).and.(a%ja(i,j)<=jmax)) then
|
||||
nzin_ = nzin_ + 1
|
||||
nz = nz + 1
|
||||
val(nzin_) = a%val(i,j)
|
||||
ia(nzin_) = iren(i)
|
||||
ja(nzin_) = iren(a%ja(i,j))
|
||||
end if
|
||||
enddo
|
||||
end do
|
||||
else
|
||||
do i=irw, lrw
|
||||
do j=1,a%irn(i)
|
||||
if ((jmin <= a%ja(i,j)).and.(a%ja(i,j)<=jmax)) then
|
||||
nzin_ = nzin_ + 1
|
||||
nz = nz + 1
|
||||
val(nzin_) = a%val(i,j)
|
||||
ia(nzin_) = (i)
|
||||
ja(nzin_) = (a%ja(i,j))
|
||||
end if
|
||||
enddo
|
||||
end do
|
||||
end if
|
||||
|
||||
end subroutine ell_getrow
|
||||
end subroutine psb_c_ell_csgetrow
|
||||
@ -0,0 +1,377 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_csmm(alpha,a,x,beta,y,info,trans)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_csmm
|
||||
implicit none
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
|
||||
complex(psb_spk_), intent(inout) :: y(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
|
||||
character :: trans_
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy
|
||||
complex(psb_spk_), allocatable :: acc(:)
|
||||
logical :: tra, ctra
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_ell_csmm'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
|
||||
if (.not.a%is_asb()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
if (tra.or.ctra) then
|
||||
m = a%get_ncols()
|
||||
n = a%get_nrows()
|
||||
else
|
||||
n = a%get_ncols()
|
||||
m = a%get_nrows()
|
||||
end if
|
||||
|
||||
if (size(x,1)<n) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/3*ione,n/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(y,1)<m) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/5*ione,m/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
nxy = min(size(x,2) , size(y,2) )
|
||||
|
||||
allocate(acc(nxy), stat=info)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
call psb_errpush(info,name,a_err='allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_c_ell_csmm_inner(m,n,nxy,alpha,size(a%ja,2,kind=psb_ipk_),&
|
||||
& a%ja,size(a%ja,1,kind=psb_ipk_),a%val,size(a%val,1,kind=psb_ipk_), &
|
||||
& a%is_triangle(),a%is_unit(),x,size(x,1,kind=psb_ipk_), &
|
||||
& beta,y,size(y,1,kind=psb_ipk_),tra,ctra,acc)
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
subroutine psb_c_ell_csmm_inner(m,n,nxy,alpha,nc,ja,ldj,val,ldv,&
|
||||
& is_triangle,is_unit,x,ldx,beta,y,ldy,tra,ctra,acc)
|
||||
integer(psb_ipk_), intent(in) :: m,n,ldx,ldy,nxy,nc,ldj,ldv
|
||||
integer(psb_ipk_), intent(in) :: ja(ldj,*)
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(ldx,*),val(ldv,*)
|
||||
complex(psb_spk_), intent(inout) :: y(ldy,*)
|
||||
logical, intent(in) :: is_triangle,is_unit,tra, ctra
|
||||
|
||||
complex(psb_spk_), intent(inout) :: acc(*)
|
||||
integer(psb_ipk_) :: i,j,k, ir, jc
|
||||
|
||||
|
||||
if (alpha == czero) then
|
||||
if (beta == czero) then
|
||||
do i = 1, m
|
||||
y(i,1:nxy) = czero
|
||||
enddo
|
||||
else
|
||||
do i = 1, m
|
||||
y(i,1:nxy) = beta*y(i,1:nxy)
|
||||
end do
|
||||
endif
|
||||
return
|
||||
end if
|
||||
|
||||
if (.not.(tra.or.ctra)) then
|
||||
|
||||
if (beta == czero) then
|
||||
|
||||
if (alpha == cone) then
|
||||
do i=1,m
|
||||
acc(1:nxy) = czero
|
||||
do j=1,nc
|
||||
acc(1:nxy) = acc(1:nxy) + val(i,j) * x(ja(i,j),1:nxy)
|
||||
enddo
|
||||
y(i,1:nxy) = acc(1:nxy)
|
||||
end do
|
||||
|
||||
else if (alpha == -cone) then
|
||||
|
||||
do i=1,m
|
||||
acc(1:nxy) = czero
|
||||
do j=1,nc
|
||||
acc(1:nxy) = acc(1:nxy) - val(i,j) * x(ja(i,j),1:nxy)
|
||||
enddo
|
||||
y(i,1:nxy) = acc(1:nxy)
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
do i=1,m
|
||||
acc(1:nxy) = czero
|
||||
do j=1,nc
|
||||
acc(1:nxy) = acc(1:nxy) + val(i,j) * x(ja(i,j),1:nxy)
|
||||
enddo
|
||||
y(i,1:nxy) = alpha*acc(1:nxy)
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
|
||||
else if (beta == cone) then
|
||||
|
||||
if (alpha == cone) then
|
||||
do i=1,m
|
||||
acc(1:nxy) = y(i,1:nxy)
|
||||
do j=1,nc
|
||||
acc(1:nxy) = acc(1:nxy) + val(i,j) * x(ja(i,j),1:nxy)
|
||||
enddo
|
||||
y(i,1:nxy) = acc(1:nxy)
|
||||
end do
|
||||
|
||||
else if (alpha == -cone) then
|
||||
|
||||
do i=1,m
|
||||
acc(1:nxy) = y(i,1:nxy)
|
||||
do j=1,nc
|
||||
acc(1:nxy) = acc(1:nxy) - val(i,j) * x(ja(i,j),1:nxy)
|
||||
enddo
|
||||
y(i,1:nxy) = acc(1:nxy)
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
do i=1,m
|
||||
acc(1:nxy) = czero
|
||||
do j=1,nc
|
||||
acc(1:nxy) = acc(1:nxy) + val(i,j) * x(ja(i,j),1:nxy)
|
||||
enddo
|
||||
y(i,1:nxy) = y(i,1:nxy) + alpha*acc(1:nxy)
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
else if (beta == -cone) then
|
||||
|
||||
if (alpha == cone) then
|
||||
do i=1,m
|
||||
acc(1:nxy) = czero
|
||||
do j=1,nc
|
||||
acc(1:nxy) = acc(1:nxy) + val(i,j) * x(ja(i,j),1:nxy)
|
||||
enddo
|
||||
y(i,1:nxy) = -y(i,1:nxy) + acc(1:nxy)
|
||||
end do
|
||||
|
||||
else if (alpha == -cone) then
|
||||
|
||||
do i=1,m
|
||||
acc(1:nxy) = czero
|
||||
do j=1,nc
|
||||
acc(1:nxy) = acc(1:nxy) + val(i,j) * x(ja(i,j),1:nxy)
|
||||
enddo
|
||||
y(i,1:nxy) = -y(i,1:nxy) -acc(1:nxy)
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
do i=1,m
|
||||
acc(1:nxy) = czero
|
||||
do j=1,nc
|
||||
acc(1:nxy) = acc(1:nxy) + val(i,j) * x(ja(i,j),1:nxy)
|
||||
enddo
|
||||
y(i,1:nxy) = -y(i,1:nxy) + alpha*acc(1:nxy)
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
else
|
||||
|
||||
if (alpha == cone) then
|
||||
do i=1,m
|
||||
acc(1:nxy) = czero
|
||||
do j=1,nc
|
||||
acc(1:nxy) = acc(1:nxy) + val(i,j) * x(ja(i,j),1:nxy)
|
||||
enddo
|
||||
y(i,1:nxy) = beta*y(i,1:nxy) + acc(1:nxy)
|
||||
end do
|
||||
|
||||
else if (alpha == -cone) then
|
||||
|
||||
do i=1,m
|
||||
acc(1:nxy) = czero
|
||||
do j=1,nc
|
||||
acc(1:nxy) = acc(1:nxy) + val(i,j) * x(ja(i,j),1:nxy)
|
||||
enddo
|
||||
y(i,1:nxy) = beta*y(i,1:nxy) - acc(1:nxy)
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
do i=1,m
|
||||
acc(1:nxy) = czero
|
||||
do j=1,nc
|
||||
acc(1:nxy) = acc(1:nxy) + val(i,j) * x(ja(i,j),1:nxy)
|
||||
enddo
|
||||
y(i,1:nxy) = beta*y(i,1:nxy) + alpha*acc(1:nxy)
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
else if (tra) then
|
||||
|
||||
if (beta == czero) then
|
||||
do i=1, m
|
||||
y(i,1:nxy) = czero
|
||||
end do
|
||||
else if (beta == cone) then
|
||||
! Do nothing
|
||||
else if (beta == -cone) then
|
||||
do i=1, m
|
||||
y(i,1:nxy) = -y(i,1:nxy)
|
||||
end do
|
||||
else
|
||||
do i=1, m
|
||||
y(i,1:nxy) = beta*y(i,1:nxy)
|
||||
end do
|
||||
end if
|
||||
|
||||
if (alpha == cone) then
|
||||
|
||||
do i=1,n
|
||||
do j=1,nc
|
||||
ir = ja(i,j)
|
||||
y(ir,1:nxy) = y(ir,1:nxy) + val(i,j)*x(i,1:nxy)
|
||||
end do
|
||||
enddo
|
||||
|
||||
else if (alpha == -cone) then
|
||||
|
||||
do i=1,n
|
||||
do j=1,nc
|
||||
ir = ja(i,j)
|
||||
y(ir,1:nxy) = y(ir,1:nxy) - val(i,j)*x(i,1:nxy)
|
||||
end do
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
do i=1,n
|
||||
do j=1,nc
|
||||
ir = ja(i,j)
|
||||
y(ir,1:nxy) = y(ir,1:nxy) + alpha*val(i,j)*x(i,1:nxy)
|
||||
end do
|
||||
enddo
|
||||
|
||||
end if
|
||||
|
||||
else if (ctra) then
|
||||
|
||||
if (beta == czero) then
|
||||
do i=1, m
|
||||
y(i,1:nxy) = czero
|
||||
end do
|
||||
else if (beta == cone) then
|
||||
! Do nothing
|
||||
else if (beta == -cone) then
|
||||
do i=1, m
|
||||
y(i,1:nxy) = -y(i,1:nxy)
|
||||
end do
|
||||
else
|
||||
do i=1, m
|
||||
y(i,1:nxy) = beta*y(i,1:nxy)
|
||||
end do
|
||||
end if
|
||||
|
||||
if (alpha == cone) then
|
||||
|
||||
do i=1,n
|
||||
do j=1,nc
|
||||
ir = ja(i,j)
|
||||
y(ir,1:nxy) = y(ir,1:nxy) + conjg(val(i,j))*x(i,1:nxy)
|
||||
end do
|
||||
enddo
|
||||
|
||||
else if (alpha == -cone) then
|
||||
|
||||
do i=1,n
|
||||
do j=1,nc
|
||||
ir = ja(i,j)
|
||||
y(ir,1:nxy) = y(ir,1:nxy) - conjg(val(i,j))*x(i,1:nxy)
|
||||
end do
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
do i=1,n
|
||||
do j=1,nc
|
||||
ir = ja(i,j)
|
||||
y(ir,1:nxy) = y(ir,1:nxy) + alpha*conjg(val(i,j))*x(i,1:nxy)
|
||||
end do
|
||||
enddo
|
||||
|
||||
end if
|
||||
|
||||
endif
|
||||
|
||||
if (is_unit) then
|
||||
do i=1, min(m,n)
|
||||
y(i,1:nxy) = y(i,1:nxy) + alpha*x(i,1:nxy)
|
||||
end do
|
||||
end if
|
||||
|
||||
end subroutine psb_c_ell_csmm_inner
|
||||
end subroutine psb_c_ell_csmm
|
||||
@ -0,0 +1,433 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_csmv(alpha,a,x,beta,y,info,trans)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_csmv
|
||||
implicit none
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
|
||||
complex(psb_spk_), intent(inout) :: y(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
|
||||
character :: trans_
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc
|
||||
complex(psb_spk_) :: acc
|
||||
logical :: tra, ctra
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_ell_csmv'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
|
||||
if (.not.a%is_asb()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
if (tra.or.ctra) then
|
||||
m = a%get_ncols()
|
||||
n = a%get_nrows()
|
||||
else
|
||||
n = a%get_ncols()
|
||||
m = a%get_nrows()
|
||||
end if
|
||||
|
||||
if (size(x,1)<n) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/3*ione,n/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(y,1)<m) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/5*ione,m/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
call psb_c_ell_csmv_inner(m,n,alpha,size(a%ja,2,kind=psb_ipk_),&
|
||||
& a%ja,size(a%ja,1,kind=psb_ipk_),a%val,size(a%val,1,kind=psb_ipk_),&
|
||||
& a%is_triangle(),a%is_unit(),&
|
||||
& x,beta,y,tra,ctra)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine psb_c_ell_csmv_inner(m,n,alpha,nc,ja,ldj,val,ldv,&
|
||||
& is_triangle,is_unit, x,beta,y,tra,ctra)
|
||||
integer(psb_ipk_), intent(in) :: m,n,nc,ldj,ldv,ja(ldj,*)
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*)
|
||||
complex(psb_spk_), intent(inout) :: y(*)
|
||||
logical, intent(in) :: is_triangle,is_unit,tra,ctra
|
||||
|
||||
|
||||
integer(psb_ipk_) :: i,j,k, ir, jc, m4
|
||||
complex(psb_spk_) :: acc(4)
|
||||
|
||||
|
||||
if (alpha == czero) then
|
||||
if (beta == czero) then
|
||||
do i = 1, m
|
||||
y(i) = czero
|
||||
enddo
|
||||
else
|
||||
do i = 1, m
|
||||
y(i) = beta*y(i)
|
||||
end do
|
||||
endif
|
||||
return
|
||||
end if
|
||||
|
||||
|
||||
if (.not.(tra.or.ctra)) then
|
||||
|
||||
if (beta == czero) then
|
||||
|
||||
m4 = mod(m,4)
|
||||
do i=1,m4
|
||||
acc(1) = czero
|
||||
do j=1,nc
|
||||
acc(1) = acc(1) + val(i,j) * x(ja(i,j))
|
||||
enddo
|
||||
y(i) = alpha*acc(1)
|
||||
end do
|
||||
|
||||
|
||||
if (alpha == cone) then
|
||||
|
||||
!$omp parallel do private(i, j, acc)
|
||||
do i=m4+1,m,4
|
||||
acc = czero
|
||||
do j=1,nc
|
||||
acc(1:4) = acc(1:4) + val(i:i+3,j) * x(ja(i:i+3,j))
|
||||
enddo
|
||||
y(i:i+3) = acc(1:4)
|
||||
end do
|
||||
|
||||
else if (alpha == -cone) then
|
||||
|
||||
!$omp parallel do private(i, j, acc)
|
||||
do i=m4+1,m,4
|
||||
acc = czero
|
||||
do j=1,nc
|
||||
acc(1:4) = acc(1:4) - val(i:i+3,j) * x(ja(i:i+3,j))
|
||||
enddo
|
||||
y(i:i+3) = acc(1:4)
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
!$omp parallel do private(i, j, acc)
|
||||
do i=m4+1,m,4
|
||||
acc = czero
|
||||
do j=1,nc
|
||||
acc(1:4) = acc(1:4) + val(i:i+3,j) * x(ja(i:i+3,j))
|
||||
enddo
|
||||
y(i:i+3) = alpha * acc(1:4)
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
|
||||
else if (beta == cone) then
|
||||
|
||||
|
||||
m4 = mod(m,4)
|
||||
do i=1,m4
|
||||
acc(1) = czero
|
||||
do j=1,nc
|
||||
acc(1) = acc(1) + val(i,j) * x(ja(i,j))
|
||||
enddo
|
||||
y(i) = y(i) + alpha*acc(1)
|
||||
end do
|
||||
|
||||
if (alpha == cone) then
|
||||
!$omp parallel do private(i, j, acc)
|
||||
do i=m4+1,m,4
|
||||
acc = czero
|
||||
do j=1,nc
|
||||
acc(1:4) = acc(1:4) + val(i:i+3,j) * x(ja(i:i+3,j))
|
||||
enddo
|
||||
y(i:i+3) = y(i:i+3) + acc(1:4)
|
||||
end do
|
||||
|
||||
else if (alpha == -cone) then
|
||||
|
||||
!$omp parallel do private(i, j, acc)
|
||||
do i=m4+1,m,4
|
||||
acc = czero
|
||||
do j=1,nc
|
||||
acc(1:4) = acc(1:4) - val(i:i+3,j) * x(ja(i:i+3,j))
|
||||
enddo
|
||||
y(i:i+3) = y(i:i+3) + acc(1:4)
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
!$omp parallel do private(i, j, acc)
|
||||
do i=m4+1,m,4
|
||||
acc = czero
|
||||
do j=1,nc
|
||||
acc(1:4) = acc(1:4) + val(i:i+3,j) * x(ja(i:i+3,j))
|
||||
enddo
|
||||
y(i:i+3) = y(i:i+3) + alpha*acc(1:4)
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
else if (beta == -cone) then
|
||||
|
||||
m4 = mod(m,4)
|
||||
do i=1,m4
|
||||
acc(1) = czero
|
||||
do j=1,nc
|
||||
acc(1) = acc(1) + val(i,j) * x(ja(i,j))
|
||||
enddo
|
||||
y(i) = - y(i) + alpha*acc(1)
|
||||
end do
|
||||
|
||||
if (alpha == cone) then
|
||||
|
||||
!$omp parallel do private(i, j, acc)
|
||||
do i=m4+1,m,4
|
||||
acc = czero
|
||||
do j=1,nc
|
||||
acc(1:4) = acc(1:4) + val(i:i+3,j) * x(ja(i:i+3,j))
|
||||
enddo
|
||||
y(i:i+3) = -y(i:i+3) + acc(1:4)
|
||||
end do
|
||||
|
||||
else if (alpha == -cone) then
|
||||
|
||||
!$omp parallel do private(i, j, acc)
|
||||
do i=m4+1,m,4
|
||||
acc = czero
|
||||
do j=1,nc
|
||||
acc(1:4) = acc(1:4) - val(i:i+3,j) * x(ja(i:i+3,j))
|
||||
enddo
|
||||
y(i:i+3) = -y(i:i+3) + acc(1:4)
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
!$omp parallel do private(i, j, acc)
|
||||
do i=m4+1,m,4
|
||||
acc = czero
|
||||
do j=1,nc
|
||||
acc(1:4) = acc(1:4) + val(i:i+3,j) * x(ja(i:i+3,j))
|
||||
enddo
|
||||
y(i:i+3) = -y(i:i+3) + alpha*acc(1:4)
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
else
|
||||
|
||||
m4 = mod(m,4)
|
||||
do i=1,m4
|
||||
acc(1) = czero
|
||||
do j=1,nc
|
||||
acc(1) = acc(1) + val(i,j) * x(ja(i,j))
|
||||
enddo
|
||||
y(i) = beta*y(i) + alpha*acc(1)
|
||||
end do
|
||||
|
||||
if (alpha == cone) then
|
||||
|
||||
!$omp parallel do private(i, j, acc)
|
||||
do i=m4+1,m,4
|
||||
acc = czero
|
||||
do j=1,nc
|
||||
acc(1:4) = acc(1:4) + val(i:i+3,j) * x(ja(i:i+3,j))
|
||||
enddo
|
||||
y(i:i+3) = beta*y(i:i+3) + acc(1:4)
|
||||
end do
|
||||
|
||||
else if (alpha == -cone) then
|
||||
|
||||
!$omp parallel do private(i, j, acc)
|
||||
do i=m4+1,m,4
|
||||
acc = czero
|
||||
do j=1,nc
|
||||
acc(1:4) = acc(1:4) - val(i:i+3,j) * x(ja(i:i+3,j))
|
||||
enddo
|
||||
y(i:i+3) = beta*y(i:i+3) + acc(1:4)
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
!$omp parallel do private(i, j, acc)
|
||||
do i=m4+1,m,4
|
||||
acc = czero
|
||||
do j=1,nc
|
||||
acc(1:4) = acc(1:4) + val(i:i+3,j) * x(ja(i:i+3,j))
|
||||
enddo
|
||||
y(i:i+3) = beta*y(i:i+3) + alpha*acc(1:4)
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
else if (tra) then
|
||||
|
||||
if (beta == czero) then
|
||||
do i=1, m
|
||||
y(i) = czero
|
||||
end do
|
||||
else if (beta == cone) then
|
||||
! Do nothing
|
||||
else if (beta == -cone) then
|
||||
do i=1, m
|
||||
y(i) = -y(i)
|
||||
end do
|
||||
else
|
||||
do i=1, m
|
||||
y(i) = beta*y(i)
|
||||
end do
|
||||
end if
|
||||
|
||||
!
|
||||
! Need to think about this.
|
||||
! Transpose does not mix well with ELLPACK.
|
||||
!
|
||||
if (alpha == cone) then
|
||||
|
||||
do i=1,n
|
||||
do j=1,nc
|
||||
ir = ja(i,j)
|
||||
y(ir) = y(ir) + val(i,j)*x(i)
|
||||
end do
|
||||
enddo
|
||||
|
||||
else if (alpha == -cone) then
|
||||
|
||||
do i=1,n
|
||||
do j=1,nc
|
||||
ir = ja(i,j)
|
||||
y(ir) = y(ir) - val(i,j)*x(i)
|
||||
end do
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
do i=1,n
|
||||
do j=1,nc
|
||||
ir = ja(i,j)
|
||||
y(ir) = y(ir) + alpha*val(i,j)*x(i)
|
||||
end do
|
||||
enddo
|
||||
|
||||
end if
|
||||
|
||||
else if (ctra) then
|
||||
|
||||
if (beta == czero) then
|
||||
do i=1, m
|
||||
y(i) = czero
|
||||
end do
|
||||
else if (beta == cone) then
|
||||
! Do nothing
|
||||
else if (beta == -cone) then
|
||||
do i=1, m
|
||||
y(i) = -y(i)
|
||||
end do
|
||||
else
|
||||
do i=1, m
|
||||
y(i) = beta*y(i)
|
||||
end do
|
||||
end if
|
||||
|
||||
!
|
||||
! Need to think about this.
|
||||
! Transpose does not mix well with ELLPACK.
|
||||
!
|
||||
if (alpha == cone) then
|
||||
|
||||
do i=1,n
|
||||
do j=1,nc
|
||||
ir = ja(i,j)
|
||||
y(ir) = y(ir) + conjg(val(i,j))*x(i)
|
||||
end do
|
||||
enddo
|
||||
|
||||
else if (alpha == -cone) then
|
||||
|
||||
do i=1,n
|
||||
do j=1,nc
|
||||
ir = ja(i,j)
|
||||
y(ir) = y(ir) - conjg(val(i,j))*x(i)
|
||||
end do
|
||||
enddo
|
||||
|
||||
else
|
||||
|
||||
do i=1,n
|
||||
do j=1,nc
|
||||
ir = ja(i,j)
|
||||
y(ir) = y(ir) + alpha*conjg(val(i,j))*x(i)
|
||||
end do
|
||||
enddo
|
||||
|
||||
end if
|
||||
|
||||
endif
|
||||
|
||||
if (is_unit) then
|
||||
do i=1, min(m,n)
|
||||
y(i) = y(i) + alpha*x(i)
|
||||
end do
|
||||
end if
|
||||
|
||||
|
||||
end subroutine psb_c_ell_csmv_inner
|
||||
|
||||
end subroutine psb_c_ell_csmv
|
||||
@ -0,0 +1,73 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
|
||||
|
||||
function psb_c_ell_csnm1(a) result(res)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_csnm1
|
||||
|
||||
implicit none
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_) :: res
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
|
||||
real(psb_spk_), allocatable :: vt(:)
|
||||
logical :: tra
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_ell_csnm1'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
res = szero
|
||||
nnz = a%get_nzeros()
|
||||
m = a%get_nrows()
|
||||
n = a%get_ncols()
|
||||
allocate(vt(n),stat=info)
|
||||
if (info /= 0) return
|
||||
if (a%is_unit()) then
|
||||
vt(:) = sone
|
||||
else
|
||||
vt(:) = szero
|
||||
end if
|
||||
do i=1, m
|
||||
do j=1,a%irn(i)
|
||||
k = a%ja(i,j)
|
||||
vt(k) = vt(k) + abs(a%val(i,j))
|
||||
end do
|
||||
end do
|
||||
res = maxval(vt(1:n))
|
||||
deallocate(vt,stat=info)
|
||||
|
||||
return
|
||||
|
||||
end function psb_c_ell_csnm1
|
||||
@ -0,0 +1,58 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
|
||||
|
||||
function psb_c_ell_csnmi(a) result(res)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_csnmi
|
||||
implicit none
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_) :: res
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nr, ir, jc, nc
|
||||
real(psb_spk_) :: acc
|
||||
logical :: tra, is_unit
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_csnmi'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
res = szero
|
||||
is_unit = a%is_unit()
|
||||
do i = 1, a%get_nrows()
|
||||
acc = sum(abs(a%val(i,:)))
|
||||
if (is_unit) acc = acc + sone
|
||||
res = max(res,acc)
|
||||
end do
|
||||
|
||||
end function psb_c_ell_csnmi
|
||||
@ -0,0 +1,208 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_csput_a
|
||||
implicit none
|
||||
|
||||
class(psb_c_ell_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: val(:)
|
||||
integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_ell_csput_a'
|
||||
logical, parameter :: debug=.false.
|
||||
integer(psb_ipk_) :: nza, i,j,k, nzl, isza, int_err(5), debug_level, debug_unit
|
||||
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
|
||||
if (nz <= 0) then
|
||||
info = psb_err_iarg_neg_
|
||||
int_err(1)=1
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
if (size(ia) < nz) then
|
||||
info = psb_err_input_asize_invalid_i_
|
||||
int_err(1)=2
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(ja) < nz) then
|
||||
info = psb_err_input_asize_invalid_i_
|
||||
int_err(1)=3
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
if (size(val) < nz) then
|
||||
info = psb_err_input_asize_invalid_i_
|
||||
int_err(1)=4
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (nz == 0) return
|
||||
|
||||
nza = a%get_nzeros()
|
||||
|
||||
if (a%is_bld()) then
|
||||
! Build phase should only ever be in COO
|
||||
info = psb_err_invalid_mat_state_
|
||||
|
||||
else if (a%is_upd()) then
|
||||
if (a%is_dev()) call a%sync()
|
||||
call psb_c_ell_srch_upd(nz,ia,ja,val,a,&
|
||||
& imin,imax,jmin,jmax,info)
|
||||
|
||||
if (info < 0) then
|
||||
info = psb_err_internal_error_
|
||||
else if (info > 0) then
|
||||
if (debug_level >= psb_debug_serial_) &
|
||||
& write(debug_unit,*) trim(name),&
|
||||
& ': Discarded entries not belonging to us.'
|
||||
info = psb_success_
|
||||
end if
|
||||
call a%set_host()
|
||||
else
|
||||
! State is wrong.
|
||||
info = psb_err_invalid_mat_state_
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
|
||||
contains
|
||||
|
||||
subroutine psb_c_ell_srch_upd(nz,ia,ja,val,a,&
|
||||
& imin,imax,jmin,jmax,info)
|
||||
|
||||
implicit none
|
||||
|
||||
class(psb_c_ell_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax
|
||||
integer(psb_ipk_), intent(in) :: ia(:),ja(:)
|
||||
complex(psb_spk_), intent(in) :: val(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: i,ir,ic, ilr, ilc, ip, &
|
||||
& i1,i2,nr,nc,nnz,dupl
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name='c_ell_srch_upd'
|
||||
|
||||
info = psb_success_
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
|
||||
dupl = a%get_dupl()
|
||||
|
||||
if (.not.a%is_sorted()) then
|
||||
info = -4
|
||||
return
|
||||
end if
|
||||
|
||||
ilr = -1
|
||||
ilc = -1
|
||||
nnz = a%get_nzeros()
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
|
||||
select case(dupl)
|
||||
case(psb_dupl_ovwrt_,psb_dupl_err_)
|
||||
! Overwrite.
|
||||
! Cannot test for error, should have been caught earlier.
|
||||
|
||||
ilr = -1
|
||||
ilc = -1
|
||||
do i=1, nz
|
||||
ir = ia(i)
|
||||
ic = ja(i)
|
||||
|
||||
if ((ir > 0).and.(ir <= nr)) then
|
||||
|
||||
nc = a%irn(ir)
|
||||
ip = psb_bsrch(ic,nc,a%ja(ir,1:nc))
|
||||
if (ip>0) then
|
||||
a%val(ir,ip) = val(i)
|
||||
else
|
||||
info = max(info,3)
|
||||
end if
|
||||
else
|
||||
info = max(info,2)
|
||||
end if
|
||||
|
||||
end do
|
||||
|
||||
case(psb_dupl_add_)
|
||||
! Add
|
||||
ilr = -1
|
||||
ilc = -1
|
||||
do i=1, nz
|
||||
ir = ia(i)
|
||||
ic = ja(i)
|
||||
if ((ir > 0).and.(ir <= nr)) then
|
||||
nc = a%irn(ir)
|
||||
ip = psb_bsrch(ic,nc,a%ja(ir,1:nc))
|
||||
if (ip>0) then
|
||||
a%val(ir,ip) = a%val(ir,ip) + val(i)
|
||||
else
|
||||
info = max(info,3)
|
||||
end if
|
||||
else
|
||||
info = max(info,2)
|
||||
end if
|
||||
end do
|
||||
|
||||
case default
|
||||
info = -3
|
||||
if (debug_level >= psb_debug_serial_) &
|
||||
& write(debug_unit,*) trim(name),&
|
||||
& ': Duplicate handling: ',dupl
|
||||
end select
|
||||
|
||||
end subroutine psb_c_ell_srch_upd
|
||||
end subroutine psb_c_ell_csput_a
|
||||
@ -0,0 +1,375 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_cssm(alpha,a,x,beta,y,info,trans)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_cssm
|
||||
implicit none
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
|
||||
complex(psb_spk_), intent(inout) :: y(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
|
||||
character :: trans_
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy
|
||||
complex(psb_spk_), allocatable :: tmp(:,:), acc(:)
|
||||
logical :: tra, ctra
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_ell_cssm'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
if (.not.a%is_asb()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
m = a%get_nrows()
|
||||
|
||||
if (.not. (a%is_triangle().and.a%is_sorted())) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(x,1)<m) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/3*ione,m/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(y,1)<m) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/5*ione,m/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
nxy = min(size(x,2),size(y,2))
|
||||
|
||||
if (alpha == czero) then
|
||||
if (beta == czero) then
|
||||
do i = 1, m
|
||||
y(i,:) = czero
|
||||
enddo
|
||||
else
|
||||
do i = 1, m
|
||||
y(i,:) = beta*y(i,:)
|
||||
end do
|
||||
endif
|
||||
return
|
||||
end if
|
||||
|
||||
if (beta == czero) then
|
||||
allocate(acc(nxy), stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call inner_ellsm(tra,ctra,a%is_lower(),a%is_unit(),a%get_nrows(),nxy,&
|
||||
& size(a%ja,2,kind=psb_ipk_),a%irn,a%idiag,&
|
||||
& a%ja,size(a%ja,1,kind=psb_ipk_),a%val,size(a%val,1,kind=psb_ipk_),&
|
||||
& x,size(x,1,kind=psb_ipk_),y,size(y,1,kind=psb_ipk_),acc,info)
|
||||
|
||||
if (info /= 0) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (alpha == cone) then
|
||||
! do nothing
|
||||
else if (alpha == -cone) then
|
||||
do i = 1, m
|
||||
y(i,:) = -y(i,:)
|
||||
end do
|
||||
else
|
||||
do i = 1, m
|
||||
y(i,:) = alpha*y(i,:)
|
||||
end do
|
||||
end if
|
||||
else
|
||||
allocate(tmp(m,nxy),acc(nxy), stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call inner_ellsm(tra,ctra,a%is_lower(),a%is_unit(),a%get_nrows(),nxy,&
|
||||
& size(a%ja,2,kind=psb_ipk_),a%irn,a%idiag,&
|
||||
& a%ja,size(a%ja,1,kind=psb_ipk_),a%val,size(a%val,1,kind=psb_ipk_),&
|
||||
& x,size(x,1,kind=psb_ipk_),tmp,size(tmp,1,kind=psb_ipk_),acc,info)
|
||||
|
||||
if (info == 0) &
|
||||
& call psb_geaxpby(m,nxy,alpha,tmp,beta,y,info)
|
||||
|
||||
if (info /= 0) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine inner_ellsm(tra,ctra,lower,unit,n,nc,nxy,irn,idiag,ja,ldj,val,ldv,&
|
||||
& x,ldx,y,ldy,acc,info)
|
||||
implicit none
|
||||
logical, intent(in) :: tra,ctra,lower,unit
|
||||
integer(psb_ipk_), intent(in) :: n,nc,ldj,ldv,nxy,ldx,ldy
|
||||
integer(psb_ipk_), intent(in) :: irn(*),idiag(*), ja(ldj,*)
|
||||
complex(psb_spk_), intent(in) :: val(ldv,*)
|
||||
complex(psb_spk_), intent(in) :: x(ldx,nxy)
|
||||
complex(psb_spk_), intent(out) :: y(ldy,nxy), acc(nxy)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m, ir, jc
|
||||
|
||||
!
|
||||
! The only error condition here is if
|
||||
! the matrix is non-unit and some idiag value is illegal.
|
||||
!
|
||||
info = 0
|
||||
|
||||
if (.not.(tra.or.ctra)) then
|
||||
|
||||
if (lower) then
|
||||
|
||||
if (unit) then
|
||||
do i=1, n
|
||||
acc = czero
|
||||
do j=1,irn(i)
|
||||
acc = acc + val(i,j)*y(ja(i,j),:)
|
||||
end do
|
||||
y(i,:) = x(i,:) - acc
|
||||
end do
|
||||
else if (.not.unit) then
|
||||
do i=1, n
|
||||
acc = czero
|
||||
do j=1,idiag(i)-1
|
||||
acc = acc + val(i,j)*y(ja(i,j),:)
|
||||
end do
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(i,:) = (x(i,:) - acc)/val(i,idiag(i))
|
||||
end do
|
||||
end if
|
||||
|
||||
else if (.not.lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
acc = czero
|
||||
do j=1,irn(i)
|
||||
acc = acc + val(i,j)*y(ja(i,j),:)
|
||||
end do
|
||||
y(i,:) = x(i,:) - acc
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
acc = czero
|
||||
do j=idiag(i)+1, irn(i)
|
||||
acc = acc + val(i,j)*y(ja(i,j),:)
|
||||
end do
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(i,:) = (x(i,:) - acc)/val(i,idiag(i))
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
else if (tra) then
|
||||
|
||||
do i=1, n
|
||||
y(i,:) = x(i,:)
|
||||
end do
|
||||
|
||||
if (lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
acc = y(i,:)
|
||||
do j=1,irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc,:) = y(jc,:) - val(i,j)*acc
|
||||
end do
|
||||
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(i,:) = y(i,:)/val(i,idiag(i))
|
||||
acc = y(i,:)
|
||||
do j=1,idiag(i)
|
||||
jc = ja(i,j)
|
||||
y(jc,:) = y(jc,:) - val(i,j)*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
else if (.not.lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=1, n
|
||||
acc = y(i,:)
|
||||
do j=1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc,:) = y(jc,:) - val(i,j)*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=1, n
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(i,:) = y(i,:)/val(i,idiag(i))
|
||||
acc = y(i,:)
|
||||
do j=idiag(i)+1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc,:) = y(jc,:) - val(i,j)*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
else if (ctra) then
|
||||
|
||||
do i=1, n
|
||||
y(i,:) = x(i,:)
|
||||
end do
|
||||
|
||||
if (lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
acc = y(i,:)
|
||||
do j=1,irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc,:) = y(jc,:) - conjg(val(i,j))*acc
|
||||
end do
|
||||
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(i,:) = y(i,:)/conjg(val(i,idiag(i)))
|
||||
acc = y(i,:)
|
||||
do j=1,idiag(i)
|
||||
jc = ja(i,j)
|
||||
y(jc,:) = y(jc,:) - conjg(val(i,j))*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
else if (.not.lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=1, n
|
||||
acc = y(i,:)
|
||||
do j=1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc,:) = y(jc,:) - conjg(val(i,j))*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=1, n
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(i,:) = y(i,:)/conjg(val(i,idiag(i)))
|
||||
acc = y(i,:)
|
||||
do j=idiag(i)+1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc,:) = y(jc,:) - conjg(val(i,j))*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end if
|
||||
end if
|
||||
end subroutine inner_ellsm
|
||||
end subroutine psb_c_ell_cssm
|
||||
@ -0,0 +1,372 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_cssv(alpha,a,x,beta,y,info,trans)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_cssv
|
||||
implicit none
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
|
||||
complex(psb_spk_), intent(inout) :: y(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
|
||||
character :: trans_
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc
|
||||
complex(psb_spk_) :: acc
|
||||
complex(psb_spk_), allocatable :: tmp(:)
|
||||
logical :: tra, ctra
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_ell_cssv'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
if (.not.a%is_asb()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
m = a%get_nrows()
|
||||
|
||||
if (.not. (a%is_triangle().and.a%is_sorted())) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(x,1)<m) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/3*ione,m/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(y,1)<m) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/5*ione,m/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (alpha == czero) then
|
||||
if (beta == czero) then
|
||||
do i = 1, m
|
||||
y(i) = czero
|
||||
enddo
|
||||
else
|
||||
do i = 1, m
|
||||
y(i) = beta*y(i)
|
||||
end do
|
||||
endif
|
||||
return
|
||||
end if
|
||||
|
||||
if (beta == czero) then
|
||||
|
||||
!!$ write(0,*) 'Into ell_sv',tra,a%is_lower(),a%is_unit(),x(1:m)
|
||||
call inner_ellsv(tra,ctra,a%is_lower(),a%is_unit(),a%get_nrows(),&
|
||||
& size(a%ja,2,kind=psb_ipk_),a%irn,a%idiag,&
|
||||
& a%ja,size(a%ja,1,kind=psb_ipk_),a%val,size(a%val,1,kind=psb_ipk_),&
|
||||
& x,y,info)
|
||||
|
||||
if (info /= 0) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (alpha == cone) then
|
||||
! do nothing
|
||||
else if (alpha == -cone) then
|
||||
do i = 1, m
|
||||
y(i) = -y(i)
|
||||
end do
|
||||
else
|
||||
do i = 1, m
|
||||
y(i) = alpha*y(i)
|
||||
end do
|
||||
end if
|
||||
!!$ write(0,*) 'Out from ell_sv',tra,a%is_lower(),a%is_unit(),y(1:m)
|
||||
else
|
||||
allocate(tmp(m), stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call inner_ellsv(tra,ctra,a%is_lower(),a%is_unit(),a%get_nrows(),&
|
||||
& size(a%ja,2,kind=psb_ipk_),a%irn,a%idiag,&
|
||||
& a%ja,size(a%ja,1,kind=psb_ipk_),a%val,size(a%val,1,kind=psb_ipk_),&
|
||||
& x,tmp,info)
|
||||
|
||||
if (info == 0) &
|
||||
& call psb_geaxpby(m,alpha,tmp,beta,y,info)
|
||||
|
||||
if (info /= 0) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine inner_ellsv(tra,ctra,lower,unit,n,nc,irn,idiag,ja,ldj,val,ldv,x,y,info)
|
||||
implicit none
|
||||
logical, intent(in) :: tra,ctra,lower,unit
|
||||
integer(psb_ipk_), intent(in) :: n,nc,ldj,ldv
|
||||
integer(psb_ipk_), intent(in) :: irn(*),idiag(*), ja(ldj,*)
|
||||
complex(psb_spk_), intent(in) :: val(ldv,*)
|
||||
complex(psb_spk_), intent(in) :: x(*)
|
||||
complex(psb_spk_), intent(out) :: y(*)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m, ir, jc
|
||||
complex(psb_spk_) :: acc
|
||||
|
||||
!
|
||||
! The only error condition here is if
|
||||
! the matrix is non-unit and some idiag value is illegal.
|
||||
!
|
||||
info = 0
|
||||
|
||||
if (.not.(tra.or.ctra)) then
|
||||
|
||||
if (lower) then
|
||||
|
||||
if (unit) then
|
||||
do i=1, n
|
||||
acc = czero
|
||||
do j=1,irn(i)
|
||||
acc = acc + val(i,j)*y(ja(i,j))
|
||||
end do
|
||||
y(i) = x(i) - acc
|
||||
end do
|
||||
else if (.not.unit) then
|
||||
do i=1, n
|
||||
acc = czero
|
||||
do j=1,idiag(i)-1
|
||||
acc = acc + val(i,j)*y(ja(i,j))
|
||||
end do
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(i) = (x(i) - acc)/val(i,idiag(i))
|
||||
end do
|
||||
end if
|
||||
|
||||
else if (.not.lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
acc = czero
|
||||
do j=1,irn(i)
|
||||
acc = acc + val(i,j)*y(ja(i,j))
|
||||
end do
|
||||
y(i) = x(i) - acc
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
acc = czero
|
||||
do j=idiag(i)+1, irn(i)
|
||||
acc = acc + val(i,j)*y(ja(i,j))
|
||||
end do
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(i) = (x(i) - acc)/val(i,idiag(i))
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
else if (tra) then
|
||||
|
||||
do i=1, n
|
||||
y(i) = x(i)
|
||||
end do
|
||||
|
||||
if (lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
acc = y(i)
|
||||
|
||||
do j=1,irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) - val(i,j)*acc
|
||||
end do
|
||||
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(i) = y(i)/val(i,idiag(i))
|
||||
acc = y(i)
|
||||
do j=1,idiag(i)-1
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) - val(i,j)*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
else if (.not.lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=1, n
|
||||
acc = y(i)
|
||||
do j=1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) - val(i,j)*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=1, n
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(i) = y(i)/val(i,idiag(i))
|
||||
acc = y(i)
|
||||
do j=idiag(i)+1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) - val(i,j)*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
else if (ctra) then
|
||||
|
||||
do i=1, n
|
||||
y(i) = x(i)
|
||||
end do
|
||||
|
||||
if (lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
acc = y(i)
|
||||
|
||||
do j=1,irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) - conjg(val(i,j))*acc
|
||||
end do
|
||||
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(i) = y(i)/conjg(val(i,idiag(i)))
|
||||
acc = y(i)
|
||||
do j=1,idiag(i)-1
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) - conjg(val(i,j))*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
else if (.not.lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=1, n
|
||||
acc = y(i)
|
||||
do j=1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) - conjg(val(i,j))*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=1, n
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(i) = y(i)/conjg(val(i,idiag(i)))
|
||||
acc = y(i)
|
||||
do j=idiag(i)+1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) - conjg(val(i,j))*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end if
|
||||
end if
|
||||
end subroutine inner_ellsv
|
||||
end subroutine psb_c_ell_cssv
|
||||
@ -0,0 +1,77 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_get_diag(a,d,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_get_diag
|
||||
implicit none
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
Integer(Psb_ipk_) :: err_act, mnm, i, j, k
|
||||
character(len=20) :: name='get_diag'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
mnm = min(a%get_nrows(),a%get_ncols())
|
||||
if (size(d) < mnm) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
call psb_errpush(info,name,i_err=(/2*ione,size(d,kind=psb_ipk_)/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
if (a%is_unit()) then
|
||||
d(1:mnm) = cone
|
||||
else
|
||||
do i=1, mnm
|
||||
if (1<=a%idiag(i).and.(a%idiag(i)<=size(a%ja,2))) then
|
||||
d(i) = a%val(i,a%idiag(i))
|
||||
else
|
||||
d(i) = czero
|
||||
end if
|
||||
end do
|
||||
end if
|
||||
do i=mnm+1,size(d)
|
||||
d(i) = czero
|
||||
end do
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_ell_get_diag
|
||||
@ -0,0 +1,60 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
|
||||
|
||||
function psb_c_ell_maxval(a) result(res)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_maxval
|
||||
implicit none
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_) :: res
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nr, ir, jc, nc
|
||||
real(psb_spk_) :: acc
|
||||
logical :: tra
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_csnmi'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
if (a%is_unit()) then
|
||||
res = sone
|
||||
else
|
||||
res = szero
|
||||
end if
|
||||
|
||||
do i = 1, a%get_nrows()
|
||||
acc = maxval(abs(a%val(i,:)))
|
||||
res = max(res,acc)
|
||||
end do
|
||||
|
||||
end function psb_c_ell_maxval
|
||||
@ -0,0 +1,63 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_mold(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_mold
|
||||
implicit none
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout), allocatable :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='ell_mold'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
info = 0
|
||||
if (allocated(b)) then
|
||||
call b%free()
|
||||
deallocate(b,stat=info)
|
||||
end if
|
||||
if (info == 0) allocate(psb_c_ell_sparse_mat :: b, stat=info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_ell_mold
|
||||
@ -0,0 +1,99 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_print(iout,a,iv,head,ivr,ivc)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_print
|
||||
implicit none
|
||||
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
integer(psb_lpk_), intent(in), optional :: iv(:)
|
||||
character(len=*), optional :: head
|
||||
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_ell_print'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
character(len=80) :: frmt
|
||||
integer(psb_ipk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz
|
||||
|
||||
|
||||
write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general'
|
||||
if (present(head)) write(iout,'(a,a)') '% ',head
|
||||
write(iout,'(a)') '%'
|
||||
write(iout,'(a,a)') '% ELL'
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
nz = a%get_nzeros()
|
||||
frmt = psb_c_get_print_frmt(nr,nc,nz,iv,ivr,ivc)
|
||||
|
||||
write(iout,*) nr, nc, nz
|
||||
if(present(iv)) then
|
||||
do i=1, nr
|
||||
do j=1,a%irn(i)
|
||||
write(iout,frmt) iv(i),iv(a%ja(i,j)),a%val(i,j)
|
||||
end do
|
||||
enddo
|
||||
else
|
||||
if (present(ivr).and..not.present(ivc)) then
|
||||
do i=1, nr
|
||||
do j=1,a%irn(i)
|
||||
write(iout,frmt) ivr(i),(a%ja(i,j)),a%val(i,j)
|
||||
end do
|
||||
enddo
|
||||
else if (present(ivr).and.present(ivc)) then
|
||||
do i=1, nr
|
||||
do j=1,a%irn(i)
|
||||
write(iout,frmt) ivr(i),ivc(a%ja(i,j)),a%val(i,j)
|
||||
end do
|
||||
enddo
|
||||
else if (.not.present(ivr).and.present(ivc)) then
|
||||
do i=1, nr
|
||||
do j=1,a%irn(i)
|
||||
write(iout,frmt) (i),ivc(a%ja(i,j)),a%val(i,j)
|
||||
end do
|
||||
enddo
|
||||
else if (.not.present(ivr).and..not.present(ivc)) then
|
||||
do i=1, nr
|
||||
do j=1,a%irn(i)
|
||||
write(iout,frmt) (i),(a%ja(i,j)),a%val(i,j)
|
||||
end do
|
||||
enddo
|
||||
endif
|
||||
endif
|
||||
|
||||
end subroutine psb_c_ell_print
|
||||
@ -0,0 +1,66 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_reallocate_nz(nz,a)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_reallocate_nz
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: nz
|
||||
class(psb_c_ell_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_) :: m, nzrm, ld
|
||||
Integer(Psb_ipk_) :: err_act, info
|
||||
character(len=20) :: name='c_ell_reallocate_nz'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
!
|
||||
! What should this really do???
|
||||
!
|
||||
m = a%get_nrows()
|
||||
nzrm = (max(nz,ione)+m-1)/m
|
||||
ld = size(a%ja,1)
|
||||
call psb_realloc(ld,nzrm,a%ja,info)
|
||||
if (info == psb_success_) call psb_realloc(ld,nzrm,a%val,info)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_alloc_dealloc_,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_ell_reallocate_nz
|
||||
@ -0,0 +1,77 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_reinit(a,clear)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_reinit
|
||||
implicit none
|
||||
|
||||
class(psb_c_ell_sparse_mat), intent(inout) :: a
|
||||
logical, intent(in), optional :: clear
|
||||
|
||||
Integer(Psb_ipk_) :: err_act, info
|
||||
character(len=20) :: name='reinit'
|
||||
logical :: clear_
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
|
||||
if (present(clear)) then
|
||||
clear_ = clear
|
||||
else
|
||||
clear_ = .true.
|
||||
end if
|
||||
|
||||
if (a%is_bld() .or. a%is_upd()) then
|
||||
! do nothing
|
||||
return
|
||||
else if (a%is_asb()) then
|
||||
if (a%is_dev()) call a%sync()
|
||||
if (clear_) a%val(:,:) = czero
|
||||
call a%set_upd()
|
||||
call a%set_host()
|
||||
else
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_ell_reinit
|
||||
@ -0,0 +1,77 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_rowsum(d,a)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_rowsum
|
||||
implicit none
|
||||
class(psb_c_ell_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc
|
||||
Integer(Psb_ipk_) :: err_act, info, int_err(5)
|
||||
character(len=20) :: name='rowsum'
|
||||
logical :: is_unit
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_small_i_
|
||||
int_err(1) = 1
|
||||
int_err(2) = size(d)
|
||||
int_err(3) = m
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
is_unit = a%is_unit()
|
||||
do i = 1, a%get_nrows()
|
||||
if (is_unit) then
|
||||
d(i) = cone
|
||||
else
|
||||
d(i) = czero
|
||||
end if
|
||||
do j=1,a%irn(i)
|
||||
d(i) = d(i) + (a%val(i,j))
|
||||
end do
|
||||
end do
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_ell_rowsum
|
||||
@ -0,0 +1,99 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_scal(d,a,info,side)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_scal
|
||||
implicit none
|
||||
class(psb_c_ell_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
Integer(Psb_ipk_) :: err_act,mnm, i, j, m, n, ierr(5)
|
||||
character(len=20) :: name='scal'
|
||||
character :: side_
|
||||
logical :: left
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
if (a%is_unit()) then
|
||||
call a%make_nonunit()
|
||||
end if
|
||||
|
||||
side_ = 'L'
|
||||
if (present(side)) then
|
||||
side_ = psb_toupper(side)
|
||||
end if
|
||||
|
||||
left = (side_ == 'L')
|
||||
|
||||
if (left) then
|
||||
m = a%get_nrows()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
call psb_errpush(info,name,i_err=(/2*ione,size(d,kind=psb_ipk_)/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1, m
|
||||
a%val(i,:) = a%val(i,:) * d(i)
|
||||
enddo
|
||||
else
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = size(d);
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1, m
|
||||
do j=1, a%irn(i)
|
||||
a%val(i,j) = a%val(i,j) * d(a%ja(i,j))
|
||||
end do
|
||||
enddo
|
||||
|
||||
end if
|
||||
|
||||
call a%set_host()
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_ell_scal
|
||||
@ -0,0 +1,63 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_scals(d,a,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_scals
|
||||
implicit none
|
||||
class(psb_c_ell_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
Integer(Psb_ipk_) :: err_act,mnm, i, j, m
|
||||
character(len=20) :: name='scal'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (a%is_unit()) then
|
||||
call a%make_nonunit()
|
||||
end if
|
||||
|
||||
a%val(:,:) = a%val(:,:) * d
|
||||
call a%set_host()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_ell_scals
|
||||
@ -0,0 +1,60 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_ell_trim(a)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_ell_trim
|
||||
implicit none
|
||||
class(psb_c_ell_sparse_mat), intent(inout) :: a
|
||||
Integer(psb_ipk_) :: err_act, info, nz, m, nzm
|
||||
character(len=20) :: name='trim'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
m = max(1_psb_ipk_,a%get_nrows())
|
||||
nzm = max(1_psb_ipk_,maxval(a%irn(1:m)))
|
||||
|
||||
call psb_realloc(m,a%irn,info)
|
||||
if (info == psb_success_) call psb_realloc(m,a%idiag,info)
|
||||
if (info == psb_success_) call psb_realloc(m,nzm,a%ja,info)
|
||||
if (info == psb_success_) call psb_realloc(m,nzm,a%val,info)
|
||||
|
||||
if (info /= psb_success_) goto 9999
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_ell_trim
|
||||
@ -0,0 +1,75 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hdia_allocate_mnnz(m,n,a,nz)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hdia_mat_mod, psb_protect_name => psb_c_hdia_allocate_mnnz
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_c_hdia_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(in), optional :: nz
|
||||
Integer(Psb_ipk_) :: err_act, info, nz_
|
||||
character(len=20) :: name='allocate_mnz'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (m < 0) then
|
||||
info = psb_err_iarg_neg_
|
||||
call psb_errpush(info,name,i_err=(/ione/))
|
||||
goto 9999
|
||||
endif
|
||||
if (n < 0) then
|
||||
info = psb_err_iarg_neg_
|
||||
call psb_errpush(info,name,i_err=(/2*ione/))
|
||||
goto 9999
|
||||
endif
|
||||
if (present(nz)) then
|
||||
nz_ = (max(nz,ione) + m -1 )/m
|
||||
else
|
||||
nz_ = (max(7*m,7*n,ione)+m-1)/m
|
||||
end if
|
||||
if (nz_ < 0) then
|
||||
info = psb_err_iarg_neg_
|
||||
call psb_errpush(info,name,i_err=(/3*ione/))
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_hdia_allocate_mnnz
|
||||
@ -0,0 +1,162 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hdia_csmv(alpha,a,x,beta,y,info,trans)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hdia_mat_mod, psb_protect_name => psb_c_hdia_csmv
|
||||
implicit none
|
||||
class(psb_c_hdia_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
|
||||
complex(psb_spk_), intent(inout) :: y(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
|
||||
character :: trans_
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc,nr,nc
|
||||
integer(psb_ipk_) :: irs,ics, nmx, ni
|
||||
integer(psb_ipk_) :: nhacks, hacksize,maxnzhack, ncd,ib, nzhack, &
|
||||
& hackfirst, hacknext
|
||||
logical :: tra, ctra
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='d_hdia_csmv'
|
||||
logical, parameter :: debug=.false.
|
||||
real :: start, finish
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (.not.a%is_asb()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
if (tra.or.ctra) then
|
||||
m = a%get_ncols()
|
||||
n = a%get_nrows()
|
||||
info = psb_err_transpose_not_n_unsupported_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
else
|
||||
n = a%get_ncols()
|
||||
m = a%get_nrows()
|
||||
end if
|
||||
|
||||
if (size(x,1)<n) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/3*ione,n/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(y,1)<m) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/5*ione,m/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
nhacks = a%nhacks
|
||||
hacksize = a%hacksize
|
||||
|
||||
do k=1, nhacks
|
||||
i = (k-1)*hacksize + 1
|
||||
ib = min(hacksize,m-i+1)
|
||||
hackfirst = a%hackoffsets(k)
|
||||
hacknext = a%hackoffsets(k+1)
|
||||
ncd = hacknext-hackfirst
|
||||
|
||||
call psi_c_inner_dia_csmv(m,n,&
|
||||
& alpha,hacksize,ncd,&
|
||||
& a%val((hacksize*hackfirst)+1:hacksize*hacknext),&
|
||||
& a%diaOffsets(hackfirst+1:hacknext),x,beta,y,info,rdisp=(i-1))
|
||||
|
||||
end do
|
||||
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine psi_c_inner_dia_csmv(nr,nc,alpha,nrd,ncd,data,offsets,&
|
||||
& x,beta,y,info,rdisp)
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: nr,nc,nrd,ncd,offsets(*)
|
||||
integer(psb_ipk_) :: rdisp, info
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(*),data(nrd,ncd)
|
||||
complex(psb_spk_), intent(inout) :: y(*)
|
||||
|
||||
|
||||
integer(psb_ipk_) :: i,j,k, ir, jc, m4, ir1, ir2, nrcmdisp, rdisp1
|
||||
|
||||
info = 0
|
||||
nrcmdisp = min(nr-rdisp,nc-rdisp)
|
||||
rdisp1 = 1-rdisp
|
||||
if (beta == dzero) then
|
||||
do i = 1, min(nrd,nr-rdisp)
|
||||
y(rdisp+i) = dzero
|
||||
enddo
|
||||
else
|
||||
do i = 1, min(nrd,nr-rdisp)
|
||||
y(rdisp+i) = beta*y(i)
|
||||
end do
|
||||
endif
|
||||
do j=1, ncd
|
||||
if (offsets(j)>=0) then
|
||||
ir1 = 1
|
||||
! min(nrd,nr - offsets(j) - rdisp_,nc-offsets(j)-rdisp_)
|
||||
ir2 = min(nrd, nrcmdisp - offsets(j))
|
||||
else
|
||||
! max(1,1-offsets(j)-rdisp_)
|
||||
ir1 = max(1, rdisp1 - offsets(j))
|
||||
ir2 = min(nrd, nrcmdisp)
|
||||
end if
|
||||
jc = ir1 + rdisp + offsets(j)
|
||||
do i=ir1,ir2
|
||||
y(rdisp+i) = y(rdisp+i) + alpha*data(i,j)*x(jc)
|
||||
jc = jc + 1
|
||||
enddo
|
||||
end do
|
||||
end subroutine psi_c_inner_dia_csmv
|
||||
|
||||
end subroutine psb_c_hdia_csmv
|
||||
@ -0,0 +1,63 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hdia_mold(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hdia_mat_mod, psb_protect_name => psb_c_hdia_mold
|
||||
implicit none
|
||||
class(psb_c_hdia_sparse_mat), intent(in) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout), allocatable :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='hdia_mold'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
info = 0
|
||||
if (allocated(b)) then
|
||||
call b%free()
|
||||
deallocate(b,stat=info)
|
||||
end if
|
||||
if (info == 0) allocate(psb_c_hdia_sparse_mat :: b, stat=info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_hdia_mold
|
||||
@ -0,0 +1,121 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hdia_print(iout,a,iv,head,ivr,ivc)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hdia_mat_mod, psb_protect_name => psb_c_hdia_print
|
||||
use psi_ext_util_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
class(psb_c_hdia_sparse_mat), intent(in) :: a
|
||||
integer(psb_lpk_), intent(in), optional :: iv(:)
|
||||
character(len=*), optional :: head
|
||||
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='hdia_print'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
class(psb_c_coo_sparse_mat),allocatable :: acoo
|
||||
|
||||
character(len=80) :: frmt
|
||||
integer(psb_ipk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz
|
||||
integer(psb_ipk_) :: nhacks, hacksize,maxnzhack, k, ncd,ib, nzhack, info,&
|
||||
& hackfirst, hacknext
|
||||
integer(psb_ipk_), allocatable :: ia(:), ja(:)
|
||||
complex(psb_spk_), allocatable :: val(:)
|
||||
|
||||
|
||||
write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general'
|
||||
if (present(head)) write(iout,'(a,a)') '% ',head
|
||||
write(iout,'(a)') '%'
|
||||
write(iout,'(a,a)') '% HDIA'
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
nz = a%get_nzeros()
|
||||
frmt = psb_c_get_print_frmt(nr,nc,nz,iv,ivr,ivc)
|
||||
|
||||
|
||||
nhacks = a%nhacks
|
||||
hacksize = a%hacksize
|
||||
maxnzhack = 0
|
||||
do k=1, nhacks
|
||||
maxnzhack = max(maxnzhack,(a%hackoffsets(k+1)-a%hackoffsets(k)))
|
||||
end do
|
||||
maxnzhack = hacksize*maxnzhack
|
||||
allocate(ia(maxnzhack),ja(maxnzhack),val(maxnzhack),stat=info)
|
||||
if (info /= 0) return
|
||||
|
||||
write(iout,*) nr, nc, nz
|
||||
do k=1, nhacks
|
||||
i = (k-1)*hacksize + 1
|
||||
ib = min(hacksize,nr-i+1)
|
||||
hackfirst = a%hackoffsets(k)
|
||||
hacknext = a%hackoffsets(k+1)
|
||||
ncd = hacknext-hackfirst
|
||||
|
||||
call psi_c_xtr_coo_from_dia(nr,nc,&
|
||||
& ia, ja, val, nzhack,&
|
||||
& hacksize,ncd,&
|
||||
& a%val((hacksize*hackfirst)+1:hacksize*hacknext),&
|
||||
& a%diaOffsets(hackfirst+1:hacknext),info,rdisp=(i-1))
|
||||
!nzhack = sum(ib - abs(a%diaOffsets(hackfirst+1:hacknext)))
|
||||
|
||||
if(present(iv)) then
|
||||
do j=1,nzhack
|
||||
write(iout,frmt) iv(ia(j)),iv(ja(j)),val(j)
|
||||
enddo
|
||||
else
|
||||
if (present(ivr).and..not.present(ivc)) then
|
||||
do j=1,nzhack
|
||||
write(iout,frmt) ivr(ia(j)),ja(j),val(j)
|
||||
enddo
|
||||
else if (present(ivr).and.present(ivc)) then
|
||||
do j=1,nzhack
|
||||
write(iout,frmt) ivr(ia(j)),ivc(ja(j)),val(j)
|
||||
enddo
|
||||
else if (.not.present(ivr).and.present(ivc)) then
|
||||
do j=1,nzhack
|
||||
write(iout,frmt) ia(j),ivc(ja(j)),val(j)
|
||||
enddo
|
||||
else if (.not.present(ivr).and..not.present(ivc)) then
|
||||
do j=1,nzhack
|
||||
write(iout,frmt) ia(j),ja(j),val(j)
|
||||
enddo
|
||||
endif
|
||||
end if
|
||||
|
||||
end do
|
||||
|
||||
end subroutine psb_c_hdia_print
|
||||
@ -0,0 +1,109 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_aclsum(d,a)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_aclsum
|
||||
implicit none
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_), intent(out) :: d(:)
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, hksz, mxrwl
|
||||
logical :: tra
|
||||
Integer(Psb_ipk_) :: err_act, info, int_err(5)
|
||||
character(len=20) :: name='aclsum'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = 0
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
m = a%get_nrows()
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_small_i_
|
||||
int_err(1) = 1
|
||||
int_err(2) = size(d)
|
||||
int_err(3) = n
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (a%is_unit()) then
|
||||
d = sone
|
||||
else
|
||||
d = szero
|
||||
end if
|
||||
|
||||
hksz = a%get_hksz()
|
||||
j = 1
|
||||
do i=1,m,hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call c_hll_aclsum(i,ir,mxrwl,a%irn(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz, &
|
||||
& d,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
j = j + 1
|
||||
end do
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine c_hll_aclsum(ir,m,n,irn,ja,ldj,val,ldv,&
|
||||
& d,info)
|
||||
integer(psb_ipk_), intent(in) :: ir,m,n,ldj,ldv,ja(ldj,*),irn(*)
|
||||
complex(psb_spk_), intent(in) :: val(ldv,*)
|
||||
real(psb_spk_), intent(inout) :: d(*)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i,j,k, m4, jc
|
||||
complex(psb_spk_) :: acc(4), tmp
|
||||
|
||||
info = psb_success_
|
||||
do i=1,m
|
||||
do j=1, irn(i)
|
||||
jc = ja(i,j)
|
||||
d(jc) = d(jc) + abs(val(i,j))
|
||||
end do
|
||||
end do
|
||||
|
||||
end subroutine c_hll_aclsum
|
||||
|
||||
end subroutine psb_c_hll_aclsum
|
||||
@ -0,0 +1,93 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_allocate_mnnz(m,n,a,nz)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_allocate_mnnz
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: m,n
|
||||
class(psb_c_hll_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(in), optional :: nz
|
||||
Integer(Psb_ipk_) :: err_act, info, nz_
|
||||
character(len=20) :: name='allocate_mnz'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (m < 0) then
|
||||
info = psb_err_iarg_neg_
|
||||
call psb_errpush(info,name,i_err=(/ione/))
|
||||
goto 9999
|
||||
endif
|
||||
if (n < 0) then
|
||||
info = psb_err_iarg_neg_
|
||||
call psb_errpush(info,name,i_err=(/2*ione/))
|
||||
goto 9999
|
||||
endif
|
||||
if (present(nz)) then
|
||||
nz_ = (max(nz,ione) + m -1 )/m
|
||||
else
|
||||
nz_ = (max(7*m,7*n,ione)+m-1)/m
|
||||
end if
|
||||
if (nz_ < 0) then
|
||||
info = psb_err_iarg_neg_
|
||||
call psb_errpush(info,name,i_err=(/3*ione/))
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (info == psb_success_) call psb_realloc(m,a%irn,info)
|
||||
if (info == psb_success_) call psb_realloc(m,a%idiag,info)
|
||||
if (info == psb_success_) call psb_realloc(m+1,a%hkoffs,info)
|
||||
if (info == psb_success_) call psb_realloc(m*nz_,a%ja,info)
|
||||
if (info == psb_success_) call psb_realloc(m*nz_,a%val,info)
|
||||
if (info == psb_success_) then
|
||||
a%irn = 0
|
||||
a%idiag = 0
|
||||
call a%set_nrows(m)
|
||||
call a%set_ncols(n)
|
||||
call a%set_bld()
|
||||
call a%set_triangle(.false.)
|
||||
call a%set_unit(.false.)
|
||||
call a%set_dupl(psb_dupl_def_)
|
||||
call a%set_hksz(psb_hksz_def_)
|
||||
call a%set_host()
|
||||
end if
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_hll_allocate_mnnz
|
||||
@ -0,0 +1,108 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_arwsum(d,a)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_arwsum
|
||||
implicit none
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_), intent(out) :: d(:)
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, hksz, mxrwl
|
||||
logical :: tra
|
||||
Integer(Psb_ipk_) :: err_act, info, int_err(5)
|
||||
character(len=20) :: name='arwsum'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = 0
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
m = a%get_nrows()
|
||||
n = a%get_ncols()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_small_i_
|
||||
int_err(1) = 1
|
||||
int_err(2) = size(d)
|
||||
int_err(3) = m
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (a%is_unit()) then
|
||||
d = sone
|
||||
else
|
||||
d = szero
|
||||
end if
|
||||
|
||||
hksz = a%get_hksz()
|
||||
j = 1
|
||||
do i=1,m,hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call c_hll_arwsum(i,ir,mxrwl,a%irn(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz, &
|
||||
& d,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
j = j + 1
|
||||
end do
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine c_hll_arwsum(ir,m,n,irn,ja,ldj,val,ldv,&
|
||||
& d,info)
|
||||
integer(psb_ipk_), intent(in) :: ir,m,n,ldj,ldv,ja(ldj,*),irn(*)
|
||||
complex(psb_spk_), intent(in) :: val(ldv,*)
|
||||
real(psb_spk_), intent(inout) :: d(*)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i,j,k, m4, jc
|
||||
complex(psb_spk_) :: acc(4), tmp
|
||||
|
||||
info = psb_success_
|
||||
do i=1,m
|
||||
do j=1, irn(i)
|
||||
d(ir+i-1) = d(ir+i-1) + abs(val(i,j))
|
||||
end do
|
||||
end do
|
||||
|
||||
end subroutine c_hll_arwsum
|
||||
|
||||
end subroutine psb_c_hll_arwsum
|
||||
@ -0,0 +1,109 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_colsum(d,a)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_colsum
|
||||
implicit none
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, hksz, mxrwl
|
||||
logical :: tra
|
||||
Integer(Psb_ipk_) :: err_act, info, int_err(5)
|
||||
character(len=20) :: name='colsum'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = 0
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
m = a%get_nrows()
|
||||
n = a%get_ncols()
|
||||
if (size(d) < n) then
|
||||
info=psb_err_input_asize_small_i_
|
||||
int_err(1) = 1
|
||||
int_err(2) = size(d)
|
||||
int_err(3) = n
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (a%is_unit()) then
|
||||
d = cone
|
||||
else
|
||||
d = czero
|
||||
end if
|
||||
|
||||
hksz = a%get_hksz()
|
||||
j = 1
|
||||
do i=1,m,hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call c_hll_colsum(i,ir,mxrwl,a%irn(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz, &
|
||||
& d,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
j = j + 1
|
||||
end do
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine c_hll_colsum(ir,m,n,irn,ja,ldj,val,ldv,&
|
||||
& d,info)
|
||||
integer(psb_ipk_), intent(in) :: ir,m,n,ldj,ldv,ja(ldj,*),irn(*)
|
||||
complex(psb_spk_), intent(in) :: val(ldv,*)
|
||||
complex(psb_spk_), intent(inout) :: d(*)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i,j,k, m4, jc
|
||||
complex(psb_spk_) :: acc(4), tmp
|
||||
|
||||
info = psb_success_
|
||||
do i=1,m
|
||||
do j=1, irn(i)
|
||||
jc = ja(i,j)
|
||||
d(jc) = d(jc) + abs(val(i,j))
|
||||
end do
|
||||
end do
|
||||
|
||||
end subroutine c_hll_colsum
|
||||
|
||||
end subroutine psb_c_hll_colsum
|
||||
@ -0,0 +1,83 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_csgetblk(imin,imax,a,b,info,&
|
||||
& jmin,jmax,iren,append,rscale,cscale)
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_csgetblk
|
||||
implicit none
|
||||
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(in) :: imin,imax
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
logical, intent(in), optional :: append
|
||||
integer(psb_ipk_), intent(in), optional :: iren(:)
|
||||
integer(psb_ipk_), intent(in), optional :: jmin,jmax
|
||||
logical, intent(in), optional :: rscale,cscale
|
||||
Integer(Psb_ipk_) :: err_act, nzin, nzout
|
||||
character(len=20) :: name='hll_getblk'
|
||||
logical :: append_
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (present(append)) then
|
||||
append_ = append
|
||||
else
|
||||
append_ = .false.
|
||||
endif
|
||||
if (append_) then
|
||||
nzin = a%get_nzeros()
|
||||
else
|
||||
nzin = 0
|
||||
endif
|
||||
|
||||
call a%csget(imin,imax,nzout,b%ia,b%ja,b%val,info,&
|
||||
& jmin=jmin, jmax=jmax, iren=iren, append=append_, &
|
||||
& nzin=nzin, rscale=rscale, cscale=cscale)
|
||||
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call b%set_nzeros(nzin+nzout)
|
||||
call b%set_host()
|
||||
call b%fix(info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_hll_csgetblk
|
||||
@ -0,0 +1,209 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_csgetptn(imin,imax,a,nz,ia,ja,info,&
|
||||
& jmin,jmax,iren,append,nzin,rscale,cscale)
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_csgetptn
|
||||
implicit none
|
||||
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
integer(psb_ipk_), intent(in) :: imin,imax
|
||||
integer(psb_ipk_), intent(out) :: nz
|
||||
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
logical, intent(in), optional :: append
|
||||
integer(psb_ipk_), intent(in), optional :: iren(:)
|
||||
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
|
||||
logical, intent(in), optional :: rscale,cscale
|
||||
|
||||
logical :: append_, rscale_, cscale_
|
||||
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
|
||||
character(len=20) :: name='hll_getptn'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (present(jmin)) then
|
||||
jmin_ = jmin
|
||||
else
|
||||
jmin_ = 1
|
||||
endif
|
||||
if (present(jmax)) then
|
||||
jmax_ = jmax
|
||||
else
|
||||
jmax_ = a%get_ncols()
|
||||
endif
|
||||
|
||||
if ((imax<imin).or.(jmax_<jmin_)) then
|
||||
nz = 0
|
||||
return
|
||||
end if
|
||||
|
||||
if (present(append)) then
|
||||
append_=append
|
||||
else
|
||||
append_=.false.
|
||||
endif
|
||||
if ((append_).and.(present(nzin))) then
|
||||
nzin_ = nzin
|
||||
else
|
||||
nzin_ = 0
|
||||
endif
|
||||
if (present(rscale)) then
|
||||
rscale_ = rscale
|
||||
else
|
||||
rscale_ = .false.
|
||||
endif
|
||||
if (present(cscale)) then
|
||||
cscale_ = cscale
|
||||
else
|
||||
cscale_ = .false.
|
||||
endif
|
||||
if ((rscale_.or.cscale_).and.(present(iren))) then
|
||||
info = psb_err_many_optional_arg_
|
||||
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
|
||||
goto 9999
|
||||
end if
|
||||
if (a%is_dev()) call a%sync()
|
||||
call hll_getptn(imin,imax,jmin_,jmax_,a,nz,ia,ja,nzin_,append_,info,iren)
|
||||
|
||||
if (rscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ia(i) = ia(i) - imin + 1
|
||||
end do
|
||||
end if
|
||||
if (cscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ja(i) = ja(i) - jmin_ + 1
|
||||
end do
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine hll_getptn(imin,imax,jmin,jmax,a,nz,ia,ja,nzin,append,info,&
|
||||
& iren)
|
||||
implicit none
|
||||
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
integer(psb_ipk_) :: imin,imax,jmin,jmax
|
||||
integer(psb_ipk_), intent(out) :: nz
|
||||
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
|
||||
integer(psb_ipk_), intent(in) :: nzin
|
||||
logical, intent(in) :: append
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_), optional :: iren(:)
|
||||
integer(psb_ipk_) :: nzin_, nza, idx,i,j,k, nzt, irw, lrw, hksz, hk, mxrwl, irs
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name='hll_getptn'
|
||||
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
|
||||
nza = a%get_nzeros()
|
||||
irw = imin
|
||||
lrw = min(imax,a%get_nrows())
|
||||
if (irw<0) then
|
||||
info = psb_err_pivot_too_small_
|
||||
return
|
||||
end if
|
||||
|
||||
if (append) then
|
||||
nzin_ = nzin
|
||||
else
|
||||
nzin_ = 0
|
||||
endif
|
||||
|
||||
nzt = sum(a%irn(irw:lrw))
|
||||
nz = 0
|
||||
|
||||
|
||||
call psb_ensure_size(nzin_+nzt,ia,info)
|
||||
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
|
||||
|
||||
if (info /= psb_success_) return
|
||||
|
||||
hksz = a%get_hksz()
|
||||
|
||||
if (present(iren)) then
|
||||
do i=irw, lrw
|
||||
!
|
||||
! Figure out where row i starts
|
||||
!
|
||||
irs = (i-1)/hksz
|
||||
hk = irs + 1
|
||||
mxrwl = (a%hkoffs(hk+1)-a%hkoffs(hk))/hksz
|
||||
k = a%hkoffs(hk)
|
||||
k = k + (i-(irs*hksz))
|
||||
do j=1,a%irn(i)
|
||||
if ((jmin <= a%ja(k)).and.(a%ja(k)<=jmax)) then
|
||||
nzin_ = nzin_ + 1
|
||||
nz = nz + 1
|
||||
ia(nzin_) = iren(i)
|
||||
ja(nzin_) = iren(a%ja(k))
|
||||
k = k + hksz
|
||||
end if
|
||||
enddo
|
||||
end do
|
||||
else
|
||||
do i=irw, lrw
|
||||
!
|
||||
! Figure out where row i starts
|
||||
!
|
||||
irs = (i-1)/hksz
|
||||
hk = irs + 1
|
||||
mxrwl = (a%hkoffs(hk+1)-a%hkoffs(hk))/hksz
|
||||
k = a%hkoffs(hk)
|
||||
k = k + (i-(irs*hksz))
|
||||
do j=1,a%irn(i)
|
||||
if ((jmin <= a%ja(k)).and.(a%ja(k)<=jmax)) then
|
||||
nzin_ = nzin_ + 1
|
||||
nz = nz + 1
|
||||
ia(nzin_) = (i)
|
||||
ja(nzin_) = (a%ja(k))
|
||||
k = k + hksz
|
||||
end if
|
||||
enddo
|
||||
end do
|
||||
end if
|
||||
|
||||
end subroutine hll_getptn
|
||||
end subroutine psb_c_hll_csgetptn
|
||||
@ -0,0 +1,221 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
|
||||
& jmin,jmax,iren,append,nzin,rscale,cscale,chksz)
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_csgetrow
|
||||
implicit none
|
||||
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
integer(psb_ipk_), intent(in) :: imin,imax
|
||||
integer(psb_ipk_), intent(out) :: nz
|
||||
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
|
||||
complex(psb_spk_), allocatable, intent(inout) :: val(:)
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
logical, intent(in), optional :: append
|
||||
integer(psb_ipk_), intent(in), optional :: iren(:)
|
||||
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
|
||||
logical, intent(in), optional :: rscale,cscale,chksz
|
||||
|
||||
logical :: append_, rscale_, cscale_, chksz_
|
||||
integer(psb_ipk_) :: nzin_, jmin_, jmax_, err_act, i
|
||||
character(len=20) :: name='hll_getrow'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (present(jmin)) then
|
||||
jmin_ = jmin
|
||||
else
|
||||
jmin_ = 1
|
||||
endif
|
||||
if (present(jmax)) then
|
||||
jmax_ = jmax
|
||||
else
|
||||
jmax_ = a%get_ncols()
|
||||
endif
|
||||
|
||||
if ((imax<imin).or.(jmax_<jmin_)) then
|
||||
nz = 0
|
||||
return
|
||||
end if
|
||||
|
||||
if (present(append)) then
|
||||
append_=append
|
||||
else
|
||||
append_=.false.
|
||||
endif
|
||||
if ((append_).and.(present(nzin))) then
|
||||
nzin_ = nzin
|
||||
else
|
||||
nzin_ = 0
|
||||
endif
|
||||
if (present(rscale)) then
|
||||
rscale_ = rscale
|
||||
else
|
||||
rscale_ = .false.
|
||||
endif
|
||||
if (present(cscale)) then
|
||||
cscale_ = cscale
|
||||
else
|
||||
cscale_ = .false.
|
||||
endif
|
||||
if ((rscale_.or.cscale_).and.(present(iren))) then
|
||||
info = psb_err_many_optional_arg_
|
||||
call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
|
||||
goto 9999
|
||||
end if
|
||||
if (present(chksz)) then
|
||||
chksz_ = chksz
|
||||
else
|
||||
chksz_ = .true.
|
||||
endif
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
call hll_getrow(imin,imax,jmin_,jmax_,a,nz,ia,ja,val,nzin_,append_,chksz_,info,&
|
||||
& iren)
|
||||
|
||||
if (rscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ia(i) = ia(i) - imin + 1
|
||||
end do
|
||||
end if
|
||||
if (cscale_) then
|
||||
do i=nzin_+1, nzin_+nz
|
||||
ja(i) = ja(i) - jmin_ + 1
|
||||
end do
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine hll_getrow(imin,imax,jmin,jmax,a,nz,ia,ja,val,nzin,append,chksz,info,&
|
||||
& iren)
|
||||
|
||||
implicit none
|
||||
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
integer(psb_ipk_) :: imin,imax,jmin,jmax
|
||||
integer(psb_ipk_), intent(out) :: nz
|
||||
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
|
||||
complex(psb_spk_), allocatable, intent(inout) :: val(:)
|
||||
integer(psb_ipk_), intent(in) :: nzin
|
||||
logical, intent(in) :: append,chksz
|
||||
integer(psb_ipk_) :: info
|
||||
integer(psb_ipk_), optional :: iren(:)
|
||||
integer(psb_ipk_) :: nzin_, nza, idx,i,j,k, nzt, irw, lrw, hksz, hk, mxrwl, irs
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name='coo_getrow'
|
||||
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
info = psb_success_
|
||||
nza = a%get_nzeros()
|
||||
irw = imin
|
||||
lrw = min(imax,a%get_nrows())
|
||||
if (irw<0) then
|
||||
info = psb_err_pivot_too_small_
|
||||
return
|
||||
end if
|
||||
|
||||
if (append) then
|
||||
nzin_ = nzin
|
||||
else
|
||||
nzin_ = 0
|
||||
endif
|
||||
|
||||
nzt = sum(a%irn(irw:lrw))
|
||||
nz = 0
|
||||
hksz = a%get_hksz()
|
||||
|
||||
if (chksz) then
|
||||
call psb_ensure_size(nzin_+nzt,ia,info)
|
||||
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,ja,info)
|
||||
if (info == psb_success_) call psb_ensure_size(nzin_+nzt,val,info)
|
||||
end if
|
||||
if (info /= psb_success_) return
|
||||
|
||||
if (present(iren)) then
|
||||
do i=irw, lrw
|
||||
!
|
||||
! Figure out where row i starts
|
||||
!
|
||||
irs = (i-1)/hksz
|
||||
hk = irs + 1
|
||||
mxrwl = (a%hkoffs(hk+1)-a%hkoffs(hk))/hksz
|
||||
k = a%hkoffs(hk)
|
||||
k = k + (i-(irs*hksz))
|
||||
do j=1,a%irn(i)
|
||||
if ((jmin <= a%ja(k)).and.(a%ja(k)<=jmax)) then
|
||||
nzin_ = nzin_ + 1
|
||||
nz = nz + 1
|
||||
val(nzin_) = a%val(k)
|
||||
ia(nzin_) = iren(i)
|
||||
ja(nzin_) = iren(a%ja(k))
|
||||
k = k + hksz
|
||||
end if
|
||||
enddo
|
||||
end do
|
||||
else
|
||||
do i=irw, lrw
|
||||
!
|
||||
! Figure out where row i starts
|
||||
!
|
||||
irs = (i-1)/hksz
|
||||
hk = irs + 1
|
||||
mxrwl = (a%hkoffs(hk+1)-a%hkoffs(hk))/hksz
|
||||
k = a%hkoffs(hk)
|
||||
k = k + (i-(irs*hksz))
|
||||
do j=1,a%irn(i)
|
||||
if ((jmin <= a%ja(k)).and.(a%ja(k)<=jmax)) then
|
||||
nzin_ = nzin_ + 1
|
||||
nz = nz + 1
|
||||
val(nzin_) = a%val(k)
|
||||
ia(nzin_) = (i)
|
||||
ja(nzin_) = (a%ja(k))
|
||||
k = k + hksz
|
||||
end if
|
||||
enddo
|
||||
end do
|
||||
end if
|
||||
|
||||
end subroutine hll_getrow
|
||||
end subroutine psb_c_hll_csgetrow
|
||||
@ -0,0 +1,235 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_csmm(alpha,a,x,beta,y,info,trans)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_csmm
|
||||
implicit none
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
|
||||
complex(psb_spk_), intent(inout) :: y(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
|
||||
character :: trans_
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nxy,ldx,ldy,hksz,mxrwl
|
||||
complex(psb_spk_), allocatable :: acc(:)
|
||||
logical :: tra, ctra
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_hll_csmm'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
nxy = min(size(x,2) , size(y,2) )
|
||||
|
||||
|
||||
ldx = size(x,1)
|
||||
ldy = size(y,1)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
|
||||
|
||||
if (tra.or.ctra) then
|
||||
|
||||
m = a%get_ncols()
|
||||
n = a%get_nrows()
|
||||
if (ldx<n) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/3*ione,n/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (ldy<m) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/5*ione,m/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (beta == czero) then
|
||||
do i = 1, m
|
||||
y(i,1:nxy) = czero
|
||||
enddo
|
||||
else
|
||||
do i = 1, m
|
||||
y(i,1:nxy) = beta*y(i,1:nxy)
|
||||
end do
|
||||
endif
|
||||
|
||||
hksz = a%get_hksz()
|
||||
j=1
|
||||
do i=1,n,hksz
|
||||
ir = min(hksz,n-i+1)
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call psb_c_hll_csmm_inner(i,ir,nxy,mxrwl,a%irn(i),&
|
||||
& alpha,a%ja(k),hksz,a%val(k),hksz,&
|
||||
& a%is_triangle(),a%is_unit(),&
|
||||
& x,ldx,cone,y,ldy,tra,ctra,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
j = j + 1
|
||||
end do
|
||||
|
||||
|
||||
else if (.not.tra) then
|
||||
|
||||
n = a%get_ncols()
|
||||
m = a%get_nrows()
|
||||
|
||||
if (ldx<n) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/3*ione,n/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (ldy<m) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/5*ione,m/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
hksz = a%get_hksz()
|
||||
j=1
|
||||
do i=1,m,hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call psb_c_hll_csmm_inner(i,ir,nxy,mxrwl,a%irn(i),&
|
||||
& alpha,a%ja(k),hksz,a%val(k),hksz,&
|
||||
& a%is_triangle(),a%is_unit(),&
|
||||
& x,ldx,beta,y,ldy,tra,ctra,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
j = j + 1
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine psb_c_hll_csmm_inner(ir,m,nc,n,irn,alpha,ja,ldj,val,ldv,&
|
||||
& is_triangle,is_unit,x,ldx,beta,y,ldy,tra,ctra,info)
|
||||
integer(psb_ipk_), intent(in) :: ir,m,n,nc,ldj,ldv,ja(ldj,*),irn(*),ldx,ldy
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(ldx,*),val(ldv,*)
|
||||
complex(psb_spk_), intent(inout) :: y(ldy,*)
|
||||
logical, intent(in) :: is_triangle, is_unit, tra, ctra
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i,j,k, m4, jc
|
||||
complex(psb_spk_) :: acc(4), tmp(nc)
|
||||
|
||||
info = psb_success_
|
||||
if (tra) then
|
||||
|
||||
if (beta == cone) then
|
||||
do i=1,m
|
||||
do j=1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc,1:nc) = y(jc,1:nc) + alpha*val(i,j)*x(ir+i-1,1:nc)
|
||||
end do
|
||||
end do
|
||||
else
|
||||
info = -10
|
||||
|
||||
end if
|
||||
|
||||
else if (ctra) then
|
||||
|
||||
if (beta == cone) then
|
||||
do i=1,m
|
||||
do j=1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc,1:nc) = y(jc,1:nc) + alpha*conjg(val(i,j))*x(ir+i-1,1:nc)
|
||||
end do
|
||||
end do
|
||||
else
|
||||
info = -10
|
||||
end if
|
||||
|
||||
else if (.not.(tra.or.ctra)) then
|
||||
|
||||
if (alpha == czero) then
|
||||
if (beta == czero) then
|
||||
do i=1,m
|
||||
y(ir+i-1,1:nc) = czero
|
||||
end do
|
||||
else
|
||||
do i=1,m
|
||||
y(ir+i-1,1:nc) = beta*y(ir+i-1,1:nc)
|
||||
end do
|
||||
end if
|
||||
|
||||
else
|
||||
if (beta == czero) then
|
||||
do i=1,m
|
||||
tmp(1:nc) = czero
|
||||
do j=1, irn(i)
|
||||
tmp(1:nc) = tmp(1:nc) + val(i,j)*x(ja(i,j),1:nc)
|
||||
end do
|
||||
y(ir+i-1,1:nc) = alpha*tmp(1:nc)
|
||||
end do
|
||||
else
|
||||
do i=1,m
|
||||
tmp(1:nc) = czero
|
||||
do j=1, irn(i)
|
||||
tmp(1:nc) = tmp(1:nc) + val(i,j)*x(ja(i,j),1:nc)
|
||||
end do
|
||||
y(ir+i-1,1:nc) = alpha*tmp(1:nc) + beta*y(ir+i-1,1:nc)
|
||||
end do
|
||||
endif
|
||||
end if
|
||||
end if
|
||||
|
||||
if (is_unit) then
|
||||
do i=1, min(m,n)
|
||||
y(ir+i-1,1:nc) = y(ir+i-1,1:nc) + alpha*x(ir+i-1,1:nc)
|
||||
end do
|
||||
end if
|
||||
|
||||
end subroutine psb_c_hll_csmm_inner
|
||||
end subroutine psb_c_hll_csmm
|
||||
@ -0,0 +1,563 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_csmv(alpha,a,x,beta,y,info,trans)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_csmv
|
||||
implicit none
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
|
||||
complex(psb_spk_), intent(inout) :: y(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
|
||||
character :: trans_
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, ic, hksz, hkpnt, mxrwl, mmhk
|
||||
logical :: tra, ctra
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_hll_csmv'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
|
||||
if (.not.a%is_asb()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
|
||||
if (tra.or.ctra) then
|
||||
|
||||
m = a%get_ncols()
|
||||
n = a%get_nrows()
|
||||
if (size(x,1)<n) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/3*ione,n/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(y,1)<m) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/5*ione,m/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (beta == czero) then
|
||||
do i = 1, m
|
||||
y(i) = czero
|
||||
enddo
|
||||
else
|
||||
do i = 1, m
|
||||
y(i) = beta*y(i)
|
||||
end do
|
||||
endif
|
||||
|
||||
hksz = a%get_hksz()
|
||||
j=1
|
||||
do i=1,n,hksz
|
||||
ir = min(hksz,n-i+1)
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
hkpnt = a%hkoffs(j) + 1
|
||||
call psb_c_hll_csmv_inner(i,ir,mxrwl,a%irn(i),&
|
||||
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,&
|
||||
& a%is_triangle(),a%is_unit(),&
|
||||
& x,cone,y,tra,ctra,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
j = j + 1
|
||||
end do
|
||||
|
||||
|
||||
else if (.not.(tra.or.ctra)) then
|
||||
|
||||
n = a%get_ncols()
|
||||
m = a%get_nrows()
|
||||
hksz = a%get_hksz()
|
||||
|
||||
if (size(x,1)<n) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/3*ione,n/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(y,1)<m) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/5*ione,m/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
if (psi_get_hll_vector()) then
|
||||
|
||||
hksz = a%get_hksz()
|
||||
j = 1
|
||||
mmhk = (m/hksz) * hksz
|
||||
if (mmhk > 0) then
|
||||
select case(hksz)
|
||||
case(4)
|
||||
!$omp parallel do private(i, j,ir,mxrwl, hkpnt)
|
||||
do i=1,mmhk,hksz
|
||||
j = ((i-1)/hksz)+1
|
||||
ir = hksz
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
if (mxrwl>0) then
|
||||
hkpnt = a%hkoffs(j) + 1
|
||||
if (info == psb_success_) &
|
||||
& call psb_c_hll_csmv_notra_4(i,mxrwl,a%irn(i),&
|
||||
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,&
|
||||
& a%is_triangle(),a%is_unit(),&
|
||||
& x,beta,y,info)
|
||||
end if
|
||||
j = j + 1
|
||||
end do
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
case(8)
|
||||
!$omp parallel do private(i, j,ir,mxrwl, hkpnt)
|
||||
do i=1,mmhk,hksz
|
||||
j = ((i-1)/hksz)+1
|
||||
ir = hksz
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
if (mxrwl>0) then
|
||||
hkpnt = a%hkoffs(j) + 1
|
||||
if (info == psb_success_) &
|
||||
&call psb_c_hll_csmv_notra_8(i,mxrwl,a%irn(i),&
|
||||
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,&
|
||||
& a%is_triangle(),a%is_unit(),&
|
||||
& x,beta,y,info)
|
||||
end if
|
||||
j = j + 1
|
||||
end do
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
case(16)
|
||||
!$omp parallel do private(i, j,ir,mxrwl, hkpnt)
|
||||
do i=1,mmhk,hksz
|
||||
j = ((i-1)/hksz)+1
|
||||
ir = hksz
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
if (mxrwl>0) then
|
||||
hkpnt = a%hkoffs(j) + 1
|
||||
if (info == psb_success_) &
|
||||
& call psb_c_hll_csmv_notra_16(i,mxrwl,a%irn(i),&
|
||||
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,&
|
||||
& a%is_triangle(),a%is_unit(),&
|
||||
& x,beta,y,info)
|
||||
end if
|
||||
j = j + 1
|
||||
end do
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
case(24)
|
||||
!$omp parallel do private(i, j,ir,mxrwl, hkpnt)
|
||||
do i=1,mmhk,hksz
|
||||
j = ((i-1)/hksz)+1
|
||||
ir = hksz
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
if (mxrwl>0) then
|
||||
hkpnt = a%hkoffs(j) + 1
|
||||
if (info == psb_success_) &
|
||||
& call psb_c_hll_csmv_notra_24(i,mxrwl,a%irn(i),&
|
||||
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,&
|
||||
& a%is_triangle(),a%is_unit(),&
|
||||
& x,beta,y,info)
|
||||
end if
|
||||
j = j + 1
|
||||
end do
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
case(32)
|
||||
!$omp parallel do private(i, j,ir,mxrwl, hkpnt)
|
||||
do i=1,mmhk,hksz
|
||||
j = ((i-1)/hksz)+1
|
||||
ir = hksz
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
if (mxrwl>0) then
|
||||
hkpnt = a%hkoffs(j) + 1
|
||||
if (info == psb_success_) &
|
||||
& call psb_c_hll_csmv_notra_32(i,mxrwl,a%irn(i),&
|
||||
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,&
|
||||
& a%is_triangle(),a%is_unit(),&
|
||||
& x,beta,y,info)
|
||||
end if
|
||||
j = j + 1
|
||||
end do
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
case default
|
||||
!$omp parallel do private(i, j,ir,mxrwl, hkpnt)
|
||||
do i=1,mmhk,hksz
|
||||
j = ((i-1)/hksz)+1
|
||||
ir = hksz
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
if (mxrwl>0) then
|
||||
hkpnt = a%hkoffs(j) + 1
|
||||
if (info == psb_success_) &
|
||||
& call psb_c_hll_csmv_inner(i,ir,mxrwl,a%irn(i),&
|
||||
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,&
|
||||
& a%is_triangle(),a%is_unit(),&
|
||||
& x,beta,y,tra,ctra,info)
|
||||
end if
|
||||
j = j + 1
|
||||
end do
|
||||
if (info /= psb_success_) goto 9999
|
||||
end select
|
||||
end if
|
||||
if (mmhk < m) then
|
||||
i = mmhk+1
|
||||
ir = m-mmhk
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
if (mxrwl>0) then
|
||||
hkpnt = a%hkoffs(j) + 1
|
||||
call psb_c_hll_csmv_inner(i,ir,mxrwl,a%irn(i),&
|
||||
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,&
|
||||
& a%is_triangle(),a%is_unit(),&
|
||||
& x,beta,y,tra,ctra,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
end if
|
||||
j = j + 1
|
||||
end if
|
||||
|
||||
else
|
||||
|
||||
j=1
|
||||
!$omp parallel do private(i, j,ir,mxrwl, hkpnt)
|
||||
do i=1,m,hksz
|
||||
j = ((i-1)/hksz)+1
|
||||
ir = min(hksz,m-i+1)
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
hkpnt = a%hkoffs(j) + 1
|
||||
if (info == psb_success_) &
|
||||
& call psb_c_hll_csmv_inner(i,ir,mxrwl,a%irn(i),&
|
||||
& alpha,a%ja(hkpnt),hksz,a%val(hkpnt),hksz,&
|
||||
& a%is_triangle(),a%is_unit(),&
|
||||
& x,beta,y,tra,ctra,info)
|
||||
j = j + 1
|
||||
end do
|
||||
if (info /= psb_success_) goto 9999
|
||||
|
||||
end if
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine psb_c_hll_csmv_inner(ir,m,n,irn,alpha,ja,ldj,val,ldv,&
|
||||
& is_triangle,is_unit, x,beta,y,tra,ctra,info)
|
||||
integer(psb_ipk_), intent(in) :: ir,m,n,ldj,ldv,ja(ldj,*),irn(*)
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*)
|
||||
complex(psb_spk_), intent(inout) :: y(*)
|
||||
logical, intent(in) :: is_triangle,is_unit,tra,ctra
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i,j,k, m4, jc
|
||||
complex(psb_spk_) :: acc(4), tmp
|
||||
|
||||
info = psb_success_
|
||||
if (tra) then
|
||||
|
||||
if (beta == cone) then
|
||||
do i=1,m
|
||||
do j=1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) + alpha*val(i,j)*x(ir+i-1)
|
||||
end do
|
||||
end do
|
||||
else
|
||||
info = -10
|
||||
|
||||
end if
|
||||
|
||||
else if (ctra) then
|
||||
|
||||
if (beta == cone) then
|
||||
do i=1,m
|
||||
do j=1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) + alpha*conjg(val(i,j))*x(ir+i-1)
|
||||
end do
|
||||
end do
|
||||
else
|
||||
info = -10
|
||||
|
||||
end if
|
||||
|
||||
else if (.not.(tra.or.ctra)) then
|
||||
|
||||
if (alpha == czero) then
|
||||
if (beta == czero) then
|
||||
do i=1,m
|
||||
y(ir+i-1) = czero
|
||||
end do
|
||||
else
|
||||
do i=1,m
|
||||
y(ir+i-1) = beta*y(ir+i-1)
|
||||
end do
|
||||
end if
|
||||
|
||||
else
|
||||
if (beta == czero) then
|
||||
do i=1,m
|
||||
tmp = czero
|
||||
do j=1, irn(i)
|
||||
tmp = tmp + val(i,j)*x(ja(i,j))
|
||||
end do
|
||||
y(ir+i-1) = alpha*tmp
|
||||
end do
|
||||
else
|
||||
do i=1,m
|
||||
tmp = czero
|
||||
do j=1, irn(i)
|
||||
tmp = tmp + val(i,j)*x(ja(i,j))
|
||||
end do
|
||||
y(ir+i-1) = alpha*tmp + beta*y(ir+i-1)
|
||||
end do
|
||||
endif
|
||||
end if
|
||||
end if
|
||||
|
||||
if (is_unit) then
|
||||
do i=1, min(m,n)
|
||||
y(i) = y(i) + alpha*x(i)
|
||||
end do
|
||||
end if
|
||||
|
||||
end subroutine psb_c_hll_csmv_inner
|
||||
|
||||
subroutine psb_c_hll_csmv_notra_8(ir,n,irn,alpha,ja,ldj,val,ldv,&
|
||||
& is_triangle,is_unit, x,beta,y,info)
|
||||
use psb_base_mod, only : psb_ipk_, psb_spk_, czero, psb_success_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*)
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*)
|
||||
complex(psb_spk_), intent(inout) :: y(*)
|
||||
logical, intent(in) :: is_triangle,is_unit
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_), parameter :: m=8
|
||||
integer(psb_ipk_) :: i,j,k, m4, jc
|
||||
complex(psb_spk_) :: acc(4), tmp(m)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
|
||||
tmp(:) = czero
|
||||
if (alpha /= czero) then
|
||||
do j=1, maxval(irn(1:8))
|
||||
tmp(1:8) = tmp(1:8) + val(1:8,j)*x(ja(1:8,j))
|
||||
end do
|
||||
end if
|
||||
if (beta == czero) then
|
||||
y(ir:ir+8-1) = alpha*tmp(1:8)
|
||||
else
|
||||
y(ir:ir+8-1) = alpha*tmp(1:8) + beta*y(ir:ir+8-1)
|
||||
end if
|
||||
|
||||
|
||||
if (is_unit) then
|
||||
do i=1, min(8,n)
|
||||
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
|
||||
end do
|
||||
end if
|
||||
|
||||
end subroutine psb_c_hll_csmv_notra_8
|
||||
|
||||
subroutine psb_c_hll_csmv_notra_24(ir,n,irn,alpha,ja,ldj,val,ldv,&
|
||||
& is_triangle,is_unit, x,beta,y,info)
|
||||
use psb_base_mod, only : psb_ipk_, psb_spk_, czero, psb_success_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*)
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*)
|
||||
complex(psb_spk_), intent(inout) :: y(*)
|
||||
logical, intent(in) :: is_triangle,is_unit
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_), parameter :: m=24
|
||||
integer(psb_ipk_) :: i,j,k, m4, jc
|
||||
complex(psb_spk_) :: acc(4), tmp(m)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
|
||||
tmp(:) = czero
|
||||
if (alpha /= czero) then
|
||||
do j=1, maxval(irn(1:24))
|
||||
tmp(1:24) = tmp(1:24) + val(1:24,j)*x(ja(1:24,j))
|
||||
end do
|
||||
end if
|
||||
if (beta == czero) then
|
||||
y(ir:ir+24-1) = alpha*tmp(1:24)
|
||||
else
|
||||
y(ir:ir+24-1) = alpha*tmp(1:24) + beta*y(ir:ir+24-1)
|
||||
end if
|
||||
|
||||
|
||||
if (is_unit) then
|
||||
do i=1, min(24,n)
|
||||
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
|
||||
end do
|
||||
end if
|
||||
|
||||
end subroutine psb_c_hll_csmv_notra_24
|
||||
|
||||
subroutine psb_c_hll_csmv_notra_16(ir,n,irn,alpha,ja,ldj,val,ldv,&
|
||||
& is_triangle,is_unit, x,beta,y,info)
|
||||
use psb_base_mod, only : psb_ipk_, psb_spk_, czero, psb_success_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*)
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*)
|
||||
complex(psb_spk_), intent(inout) :: y(*)
|
||||
logical, intent(in) :: is_triangle,is_unit
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_), parameter :: m=16
|
||||
integer(psb_ipk_) :: i,j,k, m4, jc
|
||||
complex(psb_spk_) :: acc(4), tmp(m)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
|
||||
tmp(:) = czero
|
||||
if (alpha /= czero) then
|
||||
do j=1, maxval(irn(1:16))
|
||||
tmp(1:16) = tmp(1:16) + val(1:16,j)*x(ja(1:16,j))
|
||||
end do
|
||||
end if
|
||||
if (beta == czero) then
|
||||
y(ir:ir+16-1) = alpha*tmp(1:16)
|
||||
else
|
||||
y(ir:ir+16-1) = alpha*tmp(1:16) + beta*y(ir:ir+16-1)
|
||||
end if
|
||||
|
||||
|
||||
if (is_unit) then
|
||||
do i=1, min(16,n)
|
||||
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
|
||||
end do
|
||||
end if
|
||||
|
||||
end subroutine psb_c_hll_csmv_notra_16
|
||||
|
||||
subroutine psb_c_hll_csmv_notra_32(ir,n,irn,alpha,ja,ldj,val,ldv,&
|
||||
& is_triangle,is_unit, x,beta,y,info)
|
||||
use psb_base_mod, only : psb_ipk_, psb_spk_, czero, psb_success_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*)
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*)
|
||||
complex(psb_spk_), intent(inout) :: y(*)
|
||||
logical, intent(in) :: is_triangle,is_unit
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_), parameter :: m=32
|
||||
integer(psb_ipk_) :: i,j,k, m4, jc
|
||||
complex(psb_spk_) :: acc(4), tmp(m)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
|
||||
tmp(:) = czero
|
||||
if (alpha /= czero) then
|
||||
do j=1, maxval(irn(1:32))
|
||||
tmp(1:32) = tmp(1:32) + val(1:32,j)*x(ja(1:32,j))
|
||||
end do
|
||||
end if
|
||||
if (beta == czero) then
|
||||
y(ir:ir+32-1) = alpha*tmp(1:32)
|
||||
else
|
||||
y(ir:ir+32-1) = alpha*tmp(1:32) + beta*y(ir:ir+32-1)
|
||||
end if
|
||||
|
||||
|
||||
if (is_unit) then
|
||||
do i=1, min(32,n)
|
||||
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
|
||||
end do
|
||||
end if
|
||||
|
||||
end subroutine psb_c_hll_csmv_notra_32
|
||||
|
||||
subroutine psb_c_hll_csmv_notra_4(ir,n,irn,alpha,ja,ldj,val,ldv,&
|
||||
& is_triangle,is_unit, x,beta,y,info)
|
||||
use psb_base_mod, only : psb_ipk_, psb_spk_, czero, psb_success_
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*)
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*)
|
||||
complex(psb_spk_), intent(inout) :: y(*)
|
||||
logical, intent(in) :: is_triangle,is_unit
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_), parameter :: m=4
|
||||
integer(psb_ipk_) :: i,j,k, m4, jc
|
||||
complex(psb_spk_) :: acc(4), tmp(m)
|
||||
|
||||
info = psb_success_
|
||||
|
||||
|
||||
tmp(:) = czero
|
||||
if (alpha /= czero) then
|
||||
do j=1, maxval(irn(1:4))
|
||||
tmp(1:4) = tmp(1:4) + val(1:4,j)*x(ja(1:4,j))
|
||||
end do
|
||||
end if
|
||||
if (beta == czero) then
|
||||
y(ir:ir+4-1) = alpha*tmp(1:4)
|
||||
else
|
||||
y(ir:ir+4-1) = alpha*tmp(1:4) + beta*y(ir:ir+4-1)
|
||||
end if
|
||||
|
||||
|
||||
if (is_unit) then
|
||||
do i=1, min(4,n)
|
||||
y(ir+i-1) = y(ir+i-1) + alpha*x(ir+i-1)
|
||||
end do
|
||||
end if
|
||||
|
||||
end subroutine psb_c_hll_csmv_notra_4
|
||||
|
||||
end subroutine psb_c_hll_csmv
|
||||
@ -0,0 +1,111 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
|
||||
|
||||
function psb_c_hll_csnm1(a) result(res)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_csnm1
|
||||
|
||||
implicit none
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_) :: res
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info, hksz, mxrwl
|
||||
real(psb_spk_), allocatable :: vt(:)
|
||||
logical :: is_unit
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_hll_csnm1'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
|
||||
res = szero
|
||||
if (a%is_dev()) call a%sync()
|
||||
n = a%get_ncols()
|
||||
m = a%get_nrows()
|
||||
allocate(vt(n),stat=info)
|
||||
if (Info /= 0) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
if (a%is_unit()) then
|
||||
vt = sone
|
||||
else
|
||||
vt = szero
|
||||
end if
|
||||
hksz = a%get_hksz()
|
||||
j=1
|
||||
do i=1,m,hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call psb_c_hll_csnm1_inner(i,ir,mxrwl,a%irn(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& vt,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
j = j + 1
|
||||
end do
|
||||
|
||||
res = maxval(vt)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine psb_c_hll_csnm1_inner(ir,m,n,irn,ja,ldj,val,ldv,&
|
||||
& vt,info)
|
||||
integer(psb_ipk_), intent(in) :: ir,m,n,ldj,ldv,ja(ldj,*),irn(*)
|
||||
complex(psb_spk_), intent(in) :: val(ldv,*)
|
||||
real(psb_spk_), intent(inout) :: vt(*)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i,j,k, m4, jc
|
||||
real(psb_spk_) :: acc(4), tmp
|
||||
|
||||
info = psb_success_
|
||||
do i=1,m
|
||||
do j=1, irn(i)
|
||||
jc = ja(i,j)
|
||||
vt(jc) = vt(jc) + abs(val(i,j))
|
||||
end do
|
||||
end do
|
||||
end subroutine psb_c_hll_csnm1_inner
|
||||
|
||||
end function psb_c_hll_csnm1
|
||||
@ -0,0 +1,104 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
|
||||
|
||||
function psb_c_hll_csnmi(a) result(res)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_csnmi
|
||||
implicit none
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_) :: res
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nr, ir, jc, nc, hksz, mxrwl, info
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
logical :: is_unit
|
||||
character(len=20) :: name='c_csnmi'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
info = 0
|
||||
res = szero
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
n = a%get_ncols()
|
||||
m = a%get_nrows()
|
||||
is_unit = a%is_unit()
|
||||
hksz = a%get_hksz()
|
||||
j=1
|
||||
do i=1,m,hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call psb_c_hll_csnmi_inner(i,ir,mxrwl,a%irn(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& res,is_unit,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
j = j + 1
|
||||
end do
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine psb_c_hll_csnmi_inner(ir,m,n,irn,ja,ldj,val,ldv,&
|
||||
& res,is_unit,info)
|
||||
integer(psb_ipk_), intent(in) :: ir,m,n,ldj,ldv,ja(ldj,*),irn(*)
|
||||
complex(psb_spk_), intent(in) :: val(ldv,*)
|
||||
real(psb_spk_), intent(inout) :: res
|
||||
logical :: is_unit
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i,j,k, m4, jc
|
||||
real(psb_spk_) :: tmp, acc
|
||||
|
||||
info = psb_success_
|
||||
if (is_unit) then
|
||||
tmp = sone
|
||||
else
|
||||
tmp = szero
|
||||
end if
|
||||
do i=1,m
|
||||
acc = tmp
|
||||
do j=1, irn(i)
|
||||
acc = acc + abs(val(i,j))
|
||||
end do
|
||||
res = max(acc,res)
|
||||
end do
|
||||
end subroutine psb_c_hll_csnmi_inner
|
||||
|
||||
end function psb_c_hll_csnmi
|
||||
@ -0,0 +1,233 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_csput_a
|
||||
implicit none
|
||||
|
||||
class(psb_c_hll_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: val(:)
|
||||
integer(psb_ipk_), intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_hll_csput_a'
|
||||
logical, parameter :: debug=.false.
|
||||
integer(psb_ipk_) :: nza, i,j,k, nzl, isza, int_err(5)
|
||||
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
if (nz <= 0) then
|
||||
info = psb_err_iarg_neg_
|
||||
int_err(1)=1
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
if (size(ia) < nz) then
|
||||
info = psb_err_input_asize_invalid_i_
|
||||
int_err(1)=2
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(ja) < nz) then
|
||||
info = psb_err_input_asize_invalid_i_
|
||||
int_err(1)=3
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
if (size(val) < nz) then
|
||||
info = psb_err_input_asize_invalid_i_
|
||||
int_err(1)=4
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (nz == 0) return
|
||||
|
||||
nza = a%get_nzeros()
|
||||
|
||||
if (a%is_bld()) then
|
||||
! Build phase should only ever be in COO
|
||||
info = psb_err_invalid_mat_state_
|
||||
|
||||
else if (a%is_upd()) then
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
call psb_c_hll_srch_upd(nz,ia,ja,val,a,&
|
||||
& imin,imax,jmin,jmax,info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
|
||||
info = psb_err_invalid_mat_state_
|
||||
end if
|
||||
call a%set_host()
|
||||
|
||||
else
|
||||
! State is wrong.
|
||||
info = psb_err_invalid_mat_state_
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine psb_c_hll_srch_upd(nz,ia,ja,val,a,&
|
||||
& imin,imax,jmin,jmax,info)
|
||||
|
||||
implicit none
|
||||
|
||||
class(psb_c_hll_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax
|
||||
integer(psb_ipk_), intent(in) :: ia(:),ja(:)
|
||||
complex(psb_spk_), intent(in) :: val(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: i,ir,ic, ip, i1,i2,nr,nc,nnz,dupl,ng,&
|
||||
& hksz, hk, hkzpnt, ihkr, mxrwl, lastrow
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name='c_hll_srch_upd'
|
||||
|
||||
info = psb_success_
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
|
||||
dupl = a%get_dupl()
|
||||
|
||||
if (.not.a%is_sorted()) then
|
||||
info = -4
|
||||
return
|
||||
end if
|
||||
|
||||
lastrow = -1
|
||||
nnz = a%get_nzeros()
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
hksz = a%get_hksz()
|
||||
|
||||
select case(dupl)
|
||||
case(psb_dupl_ovwrt_,psb_dupl_err_)
|
||||
! Overwrite.
|
||||
! Cannot test for error, should have been caught earlier.
|
||||
|
||||
do i=1, nz
|
||||
ir = ia(i)
|
||||
ic = ja(i)
|
||||
|
||||
if ((ir > 0).and.(ir <= nr)) then
|
||||
if (ir /= lastrow) then
|
||||
hk = ((ir-1)/hksz)
|
||||
lastrow = ir
|
||||
ihkr = ir - hk*hksz
|
||||
hk = hk + 1
|
||||
hkzpnt = a%hkoffs(hk)
|
||||
mxrwl = (a%hkoffs(hk+1) - a%hkoffs(hk))/hksz
|
||||
nc = a%irn(ir)
|
||||
end if
|
||||
|
||||
ip = psb_bsrch(ic,nc,a%ja(hkzpnt+ihkr:hkzpnt+ihkr+(nc-1)*hksz:hksz))
|
||||
if (ip>0) then
|
||||
a%val(hkzpnt+ihkr+(ip-1)*hksz) = val(i)
|
||||
else
|
||||
if (debug_level >= psb_debug_serial_) &
|
||||
& write(debug_unit,*) trim(name),&
|
||||
& ': Was searching ',ic,' in: ',nc,&
|
||||
& ' : ',a%ja(hkzpnt+ir:hkzpnt+ir+(nc-1)*hksz:hksz)
|
||||
info = i
|
||||
return
|
||||
end if
|
||||
|
||||
else
|
||||
if (debug_level >= psb_debug_serial_) &
|
||||
& write(debug_unit,*) trim(name),&
|
||||
& ': Discarding row that does not belong to us.'
|
||||
end if
|
||||
|
||||
end do
|
||||
|
||||
case(psb_dupl_add_)
|
||||
! Add
|
||||
do i=1, nz
|
||||
ir = ia(i)
|
||||
ic = ja(i)
|
||||
if ((ir > 0).and.(ir <= nr)) then
|
||||
if (ir /= lastrow) then
|
||||
hk = ((ir-1)/hksz)
|
||||
lastrow = ir
|
||||
ihkr = ir - hk*hksz
|
||||
hk = hk + 1
|
||||
hkzpnt = a%hkoffs(hk)
|
||||
mxrwl = (a%hkoffs(hk+1) - a%hkoffs(hk))/hksz
|
||||
nc = a%irn(ir)
|
||||
end if
|
||||
|
||||
ip = psb_bsrch(ic,nc,a%ja(hkzpnt+ihkr:hkzpnt+ihkr+(nc-1)*hksz:hksz))
|
||||
if (ip>0) then
|
||||
a%val(hkzpnt+ihkr+(ip-1)*hksz) = val(i)
|
||||
else
|
||||
if (debug_level >= psb_debug_serial_) &
|
||||
& write(debug_unit,*) trim(name),&
|
||||
& ': Was searching ',ic,' in: ',nc,&
|
||||
& ' : ',a%ja(hkzpnt+ir:hkzpnt+ir+(nc-1)*hksz:hksz)
|
||||
info = i
|
||||
return
|
||||
end if
|
||||
|
||||
else
|
||||
if (debug_level >= psb_debug_serial_) &
|
||||
& write(debug_unit,*) trim(name),&
|
||||
& ': Discarding row that does not belong to us.'
|
||||
end if
|
||||
end do
|
||||
|
||||
case default
|
||||
info = -3
|
||||
if (debug_level >= psb_debug_serial_) &
|
||||
& write(debug_unit,*) trim(name),&
|
||||
& ': Duplicate handling: ',dupl
|
||||
end select
|
||||
|
||||
end subroutine psb_c_hll_srch_upd
|
||||
|
||||
end subroutine psb_c_hll_csput_a
|
||||
@ -0,0 +1,506 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_cssm(alpha,a,x,beta,y,info,trans)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_cssm
|
||||
implicit none
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
|
||||
complex(psb_spk_), intent(inout) :: y(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
|
||||
character :: trans_
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, ldx, ldy, hksz, nxy, mk, mxrwl
|
||||
complex(psb_spk_), allocatable :: tmp(:,:), acc(:)
|
||||
logical :: tra, ctra
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_hll_cssm'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
if (.not.a%is_asb()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
m = a%get_nrows()
|
||||
hksz = a%get_hksz()
|
||||
|
||||
if (.not. (a%is_triangle())) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
ldx = size(x,1)
|
||||
ldy = size(y,1)
|
||||
if (ldx<m) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/3_psb_ipk_,m/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (ldy<m) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/5_psb_ipk_,m/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
nxy = min(size(x,2),size(y,2))
|
||||
|
||||
if (alpha == dzero) then
|
||||
if (beta == dzero) then
|
||||
do i = 1, m
|
||||
y(i,:) = dzero
|
||||
enddo
|
||||
else
|
||||
do i = 1, m
|
||||
y(i,:) = beta*y(i,:)
|
||||
end do
|
||||
endif
|
||||
return
|
||||
end if
|
||||
|
||||
allocate(tmp(m,nxy),acc(nxy), stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
|
||||
|
||||
if (beta == czero) then
|
||||
|
||||
if (.not.(tra.or.ctra)) then
|
||||
|
||||
if (a%is_lower()) then
|
||||
do i=1,m,hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
j = (i-1)/hksz + 1
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call inner_hllsm(tra,ctra,a%is_lower(),a%is_unit(),&
|
||||
& i,ir,mxrwl,nxy,a%irn(i),a%idiag(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& x,ldx,y,ldy,acc,info)
|
||||
if (info /= 0) goto 9999
|
||||
end do
|
||||
else
|
||||
|
||||
k = mod(m,hksz)
|
||||
if (k==0) k=hksz
|
||||
do i=m-k+1,1,-hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
j = (i-1)/hksz + 1
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call inner_hllsm(tra,ctra,a%is_lower(),a%is_unit(),&
|
||||
& i,ir,mxrwl,nxy,a%irn(i),a%idiag(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& x,ldx,y,ldy,acc,info)
|
||||
if (info /= 0) goto 9999
|
||||
end do
|
||||
end if
|
||||
|
||||
else if (tra.or.ctra) then
|
||||
|
||||
do i=1, m
|
||||
y(i,:) = x(i,:)
|
||||
end do
|
||||
|
||||
|
||||
if (a%is_lower()) then
|
||||
|
||||
mk = mod(m,hksz)
|
||||
if (k==0) k=hksz
|
||||
do i=m-mk+1,1,-hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
j = (i-1)/hksz + 1
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call inner_hllsm(tra,ctra,a%is_lower(),a%is_unit(),&
|
||||
& i,ir,mxrwl,nxy,a%irn(i),a%idiag(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& x,ldx,y,ldy,acc,info)
|
||||
if (info /= 0) goto 9999
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
do i=1,m,hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
j = (i-1)/hksz + 1
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call inner_hllsm(tra,ctra,a%is_lower(),a%is_unit(),&
|
||||
& i,ir,mxrwl,nxy,a%irn(i),a%idiag(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& x,ldx,y,ldy,acc,info)
|
||||
if (info /= 0) goto 9999
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
if (info /= 0) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (alpha == cone) then
|
||||
! do nothing
|
||||
else if (alpha == -cone) then
|
||||
do i = 1, m
|
||||
y(i,:) = -y(i,:)
|
||||
end do
|
||||
else
|
||||
do i = 1, m
|
||||
y(i,:) = alpha*y(i,:)
|
||||
end do
|
||||
end if
|
||||
|
||||
else
|
||||
|
||||
if (.not.(tra.or.ctra)) then
|
||||
|
||||
if (a%is_lower()) then
|
||||
do i=1,m,hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
j = (i-1)/hksz + 1
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call inner_hllsm(tra,ctra,a%is_lower(),a%is_unit(),&
|
||||
& i,ir,mxrwl,nxy,a%irn(i),a%idiag(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& x,ldx,tmp,m,acc,info)
|
||||
if (info /= 0) goto 9999
|
||||
end do
|
||||
else
|
||||
|
||||
mk = mod(m,hksz)
|
||||
if (k==0) k=hksz
|
||||
do i=m-mk+1,1,-hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
j = (i-1)/hksz + 1
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call inner_hllsm(tra,ctra,a%is_lower(),a%is_unit(),&
|
||||
& i,ir,mxrwl,nxy,a%irn(i),a%idiag(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& x,ldx,tmp,m,acc,info)
|
||||
if (info /= 0) goto 9999
|
||||
end do
|
||||
end if
|
||||
|
||||
else if (tra.or.ctra) then
|
||||
|
||||
do i=1, m
|
||||
tmp(i,:) = x(i,:)
|
||||
end do
|
||||
|
||||
if (a%is_lower()) then
|
||||
|
||||
mk = mod(m,hksz)
|
||||
if (k==0) k=hksz
|
||||
do i=m-mk+1,1,-hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
j = (i-1)/hksz + 1
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call inner_hllsm(tra,ctra,a%is_lower(),a%is_unit(),&
|
||||
& i,ir,mxrwl,nxy,a%irn(i),a%idiag(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& x,ldx,tmp,m,acc,info)
|
||||
if (info /= 0) goto 9999
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
do i=1,m,hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
j = (i-1)/hksz + 1
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call inner_hllsm(tra,ctra,a%is_lower(),a%is_unit(),&
|
||||
& i,ir,mxrwl,nxy,a%irn(i),a%idiag(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& x,ldx,tmp,m,acc,info)
|
||||
if (info /= 0) goto 9999
|
||||
end do
|
||||
|
||||
end if
|
||||
end if
|
||||
|
||||
if (info == 0) &
|
||||
& call psb_geaxpby(m,nxy,alpha,tmp,beta,y(:,1:nxy),info)
|
||||
|
||||
if (info /= 0) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine inner_hllsm(tra,ctra,lower,unit,ie,n,nc,nxy,irn,idiag,&
|
||||
& ja,ldj,val,ldv,x,ldx,y,ldy,acc,info)
|
||||
implicit none
|
||||
logical, intent(in) :: tra,ctra,lower,unit
|
||||
integer(psb_ipk_), intent(in) :: ie,n,nc,ldj,ldv,ldx,ldy, nxy
|
||||
integer(psb_ipk_), intent(in) :: irn(*),idiag(*), ja(ldj,*)
|
||||
complex(psb_spk_), intent(in) :: val(ldv,*)
|
||||
complex(psb_spk_), intent(in) :: x(ldx,nxy)
|
||||
complex(psb_spk_), intent(out) :: y(ldy,nxy)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m, ir, jc
|
||||
complex(psb_spk_) :: acc(nxy)
|
||||
|
||||
!
|
||||
! The only error condition here is if
|
||||
! the matrix is non-unit and some idiag value is illegal.
|
||||
!
|
||||
info = 0
|
||||
if (.not.(tra.or.ctra)) then
|
||||
|
||||
if (lower) then
|
||||
|
||||
if (unit) then
|
||||
do i=1,n
|
||||
acc = czero
|
||||
do j=1,irn(i)
|
||||
acc = acc + val(i,j)*y(ja(i,j),:)
|
||||
end do
|
||||
y(ie+i-1,:) = x(ie+i-1,:) - acc
|
||||
end do
|
||||
else if (.not.unit) then
|
||||
do i=1, n
|
||||
acc = czero
|
||||
do j=1,idiag(i)-1
|
||||
acc = acc + val(i,j)*y(ja(i,j),:)
|
||||
end do
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(ie+i-1,:) = (x(ie+i-1,:) - acc)/val(i,idiag(i))
|
||||
end do
|
||||
end if
|
||||
|
||||
else if (.not.lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
acc = czero
|
||||
do j=1,irn(i)
|
||||
acc = acc + val(i,j)*y(ja(i,j),:)
|
||||
end do
|
||||
y(ie+i-1,:) = x(ie+i-1,:) - acc
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
acc = czero
|
||||
do j=idiag(i)+1, irn(i)
|
||||
acc = acc + val(i,j)*y(ja(i,j),:)
|
||||
end do
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(ie+i-1,:) = (x(ie+i-1,:) - acc)/val(i,idiag(i))
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
else if (tra) then
|
||||
|
||||
if (lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
acc = y(ie+i-1,:)
|
||||
|
||||
do j=1,irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc,:) = y(jc,:) - val(i,j)*acc
|
||||
end do
|
||||
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(ie+i-1,:) = y(ie+i-1,:)/val(i,idiag(i))
|
||||
acc = y(ie+i-1,:)
|
||||
do j=1,idiag(i) -1
|
||||
jc = ja(i,j)
|
||||
y(jc,:) = y(jc,:) - val(i,j)*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
else if (.not.lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=1, n
|
||||
acc = y(ie+i-1,:)
|
||||
do j=1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc,:) = y(jc,:) - val(i,j)*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=1, n
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(ie+i-1,:) = y(ie+i-1,:)/val(i,idiag(i))
|
||||
acc = y(ie+i-1,:)
|
||||
do j=idiag(i)+1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc,:) = y(jc,:) - val(i,j)*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
else if (ctra) then
|
||||
|
||||
if (lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
acc = y(ie+i-1,:)
|
||||
|
||||
do j=1,irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc,:) = y(jc,:) - conjg(val(i,j))*acc
|
||||
end do
|
||||
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(ie+i-1,:) = y(ie+i-1,:)/conjg(val(i,idiag(i)))
|
||||
acc = y(ie+i-1,:)
|
||||
do j=1,idiag(i) -1
|
||||
jc = ja(i,j)
|
||||
y(jc,:) = y(jc,:) - conjg(val(i,j))*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
else if (.not.lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=1, n
|
||||
acc = y(ie+i-1,:)
|
||||
do j=1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc,:) = y(jc,:) - conjg(val(i,j))*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=1, n
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(ie+i-1,:) = y(ie+i-1,:)/conjg(val(i,idiag(i)))
|
||||
acc = y(ie+i-1,:)
|
||||
do j=idiag(i)+1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc,:) = y(jc,:) - conjg(val(i,j))*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end if
|
||||
end if
|
||||
end subroutine inner_hllsm
|
||||
|
||||
|
||||
end subroutine psb_c_hll_cssm
|
||||
@ -0,0 +1,498 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_cssv(alpha,a,x,beta,y,info,trans)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_cssv
|
||||
implicit none
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
|
||||
complex(psb_spk_), intent(inout) :: y(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, optional, intent(in) :: trans
|
||||
|
||||
character :: trans_
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, ic, hksz, hk, mxrwl, noffs, kc, mk
|
||||
complex(psb_spk_) :: acc
|
||||
complex(psb_spk_), allocatable :: tmp(:)
|
||||
logical :: tra, ctra
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_hll_cssv'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (present(trans)) then
|
||||
trans_ = trans
|
||||
else
|
||||
trans_ = 'N'
|
||||
end if
|
||||
if (.not.a%is_asb()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
tra = (psb_toupper(trans_) == 'T')
|
||||
ctra = (psb_toupper(trans_) == 'C')
|
||||
m = a%get_nrows()
|
||||
|
||||
if (.not. (a%is_triangle().and.a%is_sorted())) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(x)<m) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/3*ione,m/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (size(y)<m) then
|
||||
info = 36
|
||||
call psb_errpush(info,name,i_err=(/5*ione,m/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (alpha == czero) then
|
||||
if (beta == czero) then
|
||||
do i = 1, m
|
||||
y(i) = czero
|
||||
enddo
|
||||
else
|
||||
do i = 1, m
|
||||
y(i) = beta*y(i)
|
||||
end do
|
||||
endif
|
||||
return
|
||||
end if
|
||||
|
||||
hksz = a%get_hksz()
|
||||
|
||||
if (beta == czero) then
|
||||
|
||||
if (.not.(tra.or.ctra)) then
|
||||
|
||||
if (a%is_lower()) then
|
||||
do i=1,m,hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
j = (i-1)/hksz + 1
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call inner_hllsv(tra,ctra,a%is_lower(),a%is_unit(),&
|
||||
& i,ir,mxrwl,a%irn(i),a%idiag(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& x,y,info)
|
||||
if (info /= 0) goto 9999
|
||||
end do
|
||||
else
|
||||
|
||||
k = mod(m,hksz)
|
||||
if (k==0) k=hksz
|
||||
do i=m-k+1,1,-hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
j = (i-1)/hksz + 1
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call inner_hllsv(tra,ctra,a%is_lower(),a%is_unit(),&
|
||||
& i,ir,mxrwl,a%irn(i),a%idiag(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& x,y,info)
|
||||
if (info /= 0) goto 9999
|
||||
end do
|
||||
end if
|
||||
|
||||
else if (tra.or.ctra) then
|
||||
|
||||
do i=1, m
|
||||
y(i) = x(i)
|
||||
end do
|
||||
|
||||
|
||||
if (a%is_lower()) then
|
||||
|
||||
mk = mod(m,hksz)
|
||||
if (k==0) k=hksz
|
||||
do i=m-mk+1,1,-hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
j = (i-1)/hksz + 1
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call inner_hllsv(tra,ctra,a%is_lower(),a%is_unit(),&
|
||||
& i,ir,mxrwl,a%irn(i),a%idiag(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& x,y,info)
|
||||
if (info /= 0) goto 9999
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
do i=1,m,hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
j = (i-1)/hksz + 1
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call inner_hllsv(tra,ctra,a%is_lower(),a%is_unit(),&
|
||||
& i,ir,mxrwl,a%irn(i),a%idiag(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& x,y,info)
|
||||
if (info /= 0) goto 9999
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
if (info /= 0) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (alpha == cone) then
|
||||
! do nothing
|
||||
else if (alpha == -cone) then
|
||||
do i = 1, m
|
||||
y(i) = -y(i)
|
||||
end do
|
||||
else
|
||||
do i = 1, m
|
||||
y(i) = alpha*y(i)
|
||||
end do
|
||||
end if
|
||||
|
||||
|
||||
else
|
||||
|
||||
allocate(tmp(m), stat=info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (.not.(tra.or.ctra)) then
|
||||
|
||||
if (a%is_lower()) then
|
||||
do i=1,m,hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
j = (i-1)/hksz + 1
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call inner_hllsv(tra,ctra,a%is_lower(),a%is_unit(),&
|
||||
& i,ir,mxrwl,a%irn(i),a%idiag(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& x,tmp,info)
|
||||
if (info /= 0) goto 9999
|
||||
end do
|
||||
else
|
||||
|
||||
mk = mod(m,hksz)
|
||||
if (k==0) k=hksz
|
||||
do i=m-mk+1,1,-hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
j = (i-1)/hksz + 1
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call inner_hllsv(tra,ctra,a%is_lower(),a%is_unit(),&
|
||||
& i,ir,mxrwl,a%irn(i),a%idiag(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& x,tmp,info)
|
||||
if (info /= 0) goto 9999
|
||||
end do
|
||||
end if
|
||||
|
||||
else if (tra.or.ctra) then
|
||||
|
||||
do i=1, m
|
||||
tmp(i) = x(i)
|
||||
end do
|
||||
|
||||
if (a%is_lower()) then
|
||||
|
||||
mk = mod(m,hksz)
|
||||
if (k==0) k=hksz
|
||||
do i=m-mk+1,1,-hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
j = (i-1)/hksz + 1
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call inner_hllsv(tra,ctra,a%is_lower(),a%is_unit(),&
|
||||
& i,ir,mxrwl,a%irn(i),a%idiag(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& x,tmp,info)
|
||||
if (info /= 0) goto 9999
|
||||
end do
|
||||
|
||||
else
|
||||
|
||||
do i=1,m,hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
j = (i-1)/hksz + 1
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call inner_hllsv(tra,ctra,a%is_lower(),a%is_unit(),&
|
||||
& i,ir,mxrwl,a%irn(i),a%idiag(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& x,tmp,info)
|
||||
if (info /= 0) goto 9999
|
||||
end do
|
||||
|
||||
end if
|
||||
end if
|
||||
|
||||
if (info == 0) &
|
||||
& call psb_geaxpby(m,alpha,tmp,beta,y,info)
|
||||
|
||||
if (info /= 0) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine inner_hllsv(tra,ctra,lower,unit,ie,n,nc,irn,idiag,ja,ldj,val,ldv,x,y,info)
|
||||
implicit none
|
||||
logical, intent(in) :: tra,ctra,lower,unit
|
||||
integer(psb_ipk_), intent(in) :: ie,n,nc,ldj,ldv
|
||||
integer(psb_ipk_), intent(in) :: irn(*),idiag(*), ja(ldj,*)
|
||||
complex(psb_spk_), intent(in) :: val(ldv,*)
|
||||
complex(psb_spk_), intent(in) :: x(*)
|
||||
complex(psb_spk_), intent(out) :: y(*)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m, ir, jc
|
||||
complex(psb_spk_) :: acc
|
||||
|
||||
!
|
||||
! The only error condition here is if
|
||||
! the matrix is non-unit and some idiag value is illegal.
|
||||
!
|
||||
info = 0
|
||||
if (.not.(tra.or.ctra)) then
|
||||
|
||||
if (lower) then
|
||||
|
||||
if (unit) then
|
||||
do i=1,n
|
||||
acc = czero
|
||||
do j=1,irn(i)
|
||||
acc = acc + val(i,j)*y(ja(i,j))
|
||||
end do
|
||||
y(ie+i-1) = x(ie+i-1) - acc
|
||||
end do
|
||||
else if (.not.unit) then
|
||||
do i=1, n
|
||||
acc = czero
|
||||
do j=1,idiag(i)-1
|
||||
acc = acc + val(i,j)*y(ja(i,j))
|
||||
end do
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(ie+i-1) = (x(ie+i-1) - acc)/val(i,idiag(i))
|
||||
end do
|
||||
end if
|
||||
|
||||
else if (.not.lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
acc = czero
|
||||
do j=1,irn(i)
|
||||
acc = acc + val(i,j)*y(ja(i,j))
|
||||
end do
|
||||
y(ie+i-1) = x(ie+i-1) - acc
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
acc = czero
|
||||
do j=idiag(i)+1, irn(i)
|
||||
acc = acc + val(i,j)*y(ja(i,j))
|
||||
end do
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(ie+i-1) = (x(ie+i-1) - acc)/val(i,idiag(i))
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
else if (tra) then
|
||||
|
||||
if (lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
acc = y(ie+i-1)
|
||||
|
||||
do j=1,irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) - val(i,j)*acc
|
||||
end do
|
||||
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(ie+i-1) = y(ie+i-1)/val(i,idiag(i))
|
||||
acc = y(ie+i-1)
|
||||
do j=1,idiag(i) -1
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) - val(i,j)*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
else if (.not.lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=1, n
|
||||
acc = y(ie+i-1)
|
||||
do j=1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) - val(i,j)*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=1, n
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(ie+i-1) = y(ie+i-1)/val(i,idiag(i))
|
||||
acc = y(ie+i-1)
|
||||
do j=idiag(i)+1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) - val(i,j)*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
else if (ctra) then
|
||||
|
||||
if (lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
acc = y(ie+i-1)
|
||||
|
||||
do j=1,irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) - conjg(val(i,j))*acc
|
||||
end do
|
||||
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=n, 1, -1
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(ie+i-1) = y(ie+i-1)/conjg(val(i,idiag(i)))
|
||||
acc = y(ie+i-1)
|
||||
do j=1,idiag(i) -1
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) - conjg(val(i,j))*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
else if (.not.lower) then
|
||||
|
||||
if (unit) then
|
||||
|
||||
do i=1, n
|
||||
acc = y(ie+i-1)
|
||||
do j=1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) - conjg(val(i,j))*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
else if (.not.unit) then
|
||||
|
||||
do i=1, n
|
||||
if (idiag(i) <= 0) then
|
||||
info = -1
|
||||
return
|
||||
endif
|
||||
y(ie+i-1) = y(ie+i-1)/conjg(val(i,idiag(i)))
|
||||
acc = y(ie+i-1)
|
||||
do j=idiag(i)+1, irn(i)
|
||||
jc = ja(i,j)
|
||||
y(jc) = y(jc) - conjg(val(i,j))*acc
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end if
|
||||
end if
|
||||
end subroutine inner_hllsv
|
||||
end subroutine psb_c_hll_cssv
|
||||
@ -0,0 +1,110 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_get_diag(a,d,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_get_diag
|
||||
implicit none
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
Integer(Psb_ipk_) :: err_act, mnm, i, j, k, ke, hksz, ld,ir, mxrwl
|
||||
character(len=20) :: name='get_diag'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
mnm = min(a%get_nrows(),a%get_ncols())
|
||||
ld = size(d)
|
||||
if (ld< mnm) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
call psb_errpush(info,name,i_err=(/2*ione,ld/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (a%is_triangle().and.a%is_unit()) then
|
||||
d(1:mnm) = cone
|
||||
else
|
||||
|
||||
hksz = a%get_hksz()
|
||||
j=1
|
||||
do i=1,mnm,hksz
|
||||
ir = min(hksz,mnm-i+1)
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
ke = a%hkoffs(j+1)
|
||||
call psb_c_hll_get_diag_inner(ir,a%irn(i:i+ir-1),&
|
||||
& a%ja(k:ke),hksz,a%val(k:ke),hksz,&
|
||||
& a%idiag(i:i+ir-1),d(i:i+ir-1),info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
j = j + 1
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
do i=mnm+1,size(d)
|
||||
d(i) = czero
|
||||
end do
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine psb_c_hll_get_diag_inner(m,irn,ja,ldj,val,ldv,&
|
||||
& idiag,d,info)
|
||||
integer(psb_ipk_), intent(in) :: m,ldj,ldv,ja(ldj,*),irn(*), idiag(*)
|
||||
complex(psb_spk_), intent(in) :: val(ldv,*)
|
||||
complex(psb_spk_), intent(inout) :: d(*)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i,j,k, m4, jc
|
||||
|
||||
info = psb_success_
|
||||
|
||||
do i=1,m
|
||||
if (idiag(i) /= 0) then
|
||||
d(i) = val(i,idiag(i))
|
||||
else
|
||||
d(i) = czero
|
||||
end if
|
||||
end do
|
||||
|
||||
end subroutine psb_c_hll_get_diag_inner
|
||||
|
||||
end subroutine psb_c_hll_get_diag
|
||||
@ -0,0 +1,45 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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.
|
||||
!
|
||||
|
||||
|
||||
function psb_c_hll_maxval(a) result(res)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_maxval
|
||||
implicit none
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
real(psb_spk_) :: res
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
res = maxval(abs(a%val(:)))
|
||||
if (a%is_unit()) res = max(res,sone)
|
||||
|
||||
end function psb_c_hll_maxval
|
||||
@ -0,0 +1,65 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_mold(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_mold
|
||||
implicit none
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout), allocatable :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
character(len=20) :: name='hll_mold'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_get_erraction(err_act)
|
||||
|
||||
info = 0
|
||||
if (allocated(b)) then
|
||||
call b%free()
|
||||
deallocate(b,stat=info)
|
||||
end if
|
||||
if (info == 0) allocate(psb_c_hll_sparse_mat :: b, stat=info)
|
||||
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info, name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_hll_mold
|
||||
@ -0,0 +1,134 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_print(iout,a,iv,head,ivr,ivc)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_print
|
||||
implicit none
|
||||
|
||||
integer(psb_ipk_), intent(in) :: iout
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
integer(psb_lpk_), intent(in), optional :: iv(:)
|
||||
character(len=*), optional :: head
|
||||
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='c_hll_print'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
character(len=80) :: frmt
|
||||
integer(psb_ipk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz, k, hksz, hk, mxrwl,ir, ix
|
||||
|
||||
|
||||
write(iout,'(a)') '%%MatrixMarket matrix coordinate real general'
|
||||
if (present(head)) write(iout,'(a,a)') '% ',head
|
||||
write(iout,'(a)') '%'
|
||||
write(iout,'(a,a)') '% COO'
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
nz = a%get_nzeros()
|
||||
frmt = psb_c_get_print_frmt(nr,nc,nz,iv,ivr,ivc)
|
||||
|
||||
hksz = a%get_hksz()
|
||||
|
||||
write(iout,*) nr, nc, nz
|
||||
if(present(iv)) then
|
||||
do i=1, nr
|
||||
irs = (i-1)/hksz
|
||||
hk = irs + 1
|
||||
mxrwl = (a%hkoffs(hk+1)-a%hkoffs(hk))/hksz
|
||||
k = a%hkoffs(hk)
|
||||
k = k + (i-(irs*hksz))
|
||||
do j=1,a%irn(i)
|
||||
write(iout,frmt) iv(i),iv(a%ja(k)),a%val(k)
|
||||
k = k + hksz
|
||||
end do
|
||||
enddo
|
||||
else
|
||||
if (present(ivr).and..not.present(ivc)) then
|
||||
do i=1, nr
|
||||
irs = (i-1)/hksz
|
||||
hk = irs + 1
|
||||
mxrwl = (a%hkoffs(hk+1)-a%hkoffs(hk))/hksz
|
||||
k = a%hkoffs(hk)
|
||||
k = k + (i-(irs*hksz))
|
||||
do j=1,a%irn(i)
|
||||
write(iout,frmt) ivr(i),(a%ja(k)),a%val(k)
|
||||
k = k + hksz
|
||||
end do
|
||||
enddo
|
||||
else if (present(ivr).and.present(ivc)) then
|
||||
do i=1, nr
|
||||
irs = (i-1)/hksz
|
||||
hk = irs + 1
|
||||
mxrwl = (a%hkoffs(hk+1)-a%hkoffs(hk))/hksz
|
||||
k = a%hkoffs(hk)
|
||||
k = k + (i-(irs*hksz))
|
||||
do j=1,a%irn(i)
|
||||
write(iout,frmt) ivr(i),ivc(a%ja(k)),a%val(k)
|
||||
k = k + hksz
|
||||
end do
|
||||
enddo
|
||||
else if (.not.present(ivr).and.present(ivc)) then
|
||||
do i=1, nr
|
||||
irs = (i-1)/hksz
|
||||
hk = irs + 1
|
||||
mxrwl = (a%hkoffs(hk+1)-a%hkoffs(hk))/hksz
|
||||
k = a%hkoffs(hk)
|
||||
k = k + (i-(irs*hksz))
|
||||
do j=1,a%irn(i)
|
||||
write(iout,frmt) (i),ivc(a%ja(k)),a%val(k)
|
||||
k = k + hksz
|
||||
end do
|
||||
enddo
|
||||
|
||||
else if (.not.present(ivr).and..not.present(ivc)) then
|
||||
|
||||
do i=1, nr
|
||||
irs = (i-1)/hksz
|
||||
hk = irs + 1
|
||||
mxrwl = (a%hkoffs(hk+1)-a%hkoffs(hk))/hksz
|
||||
k = a%hkoffs(hk)
|
||||
k = k + (i-(irs*hksz))
|
||||
do j=1,a%irn(i)
|
||||
write(iout,frmt) (i),(a%ja(k)),a%val(k)
|
||||
k = k + hksz
|
||||
end do
|
||||
enddo
|
||||
endif
|
||||
endif
|
||||
|
||||
end subroutine psb_c_hll_print
|
||||
@ -0,0 +1,64 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_reallocate_nz(nz,a)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_reallocate_nz
|
||||
implicit none
|
||||
integer(psb_ipk_), intent(in) :: nz
|
||||
class(psb_c_hll_sparse_mat), intent(inout) :: a
|
||||
integer(psb_ipk_) :: m, nzrm,nz_
|
||||
Integer(Psb_ipk_) :: err_act, info
|
||||
character(len=20) :: name='c_hll_reallocate_nz'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
!
|
||||
! What should this really do???
|
||||
!
|
||||
nz_ = max(nz,ione)
|
||||
call psb_realloc(nz_,a%ja,info)
|
||||
if (info == psb_success_) call psb_realloc(nz_,a%val,info)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_alloc_dealloc_,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_hll_reallocate_nz
|
||||
@ -0,0 +1,77 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_reinit(a,clear)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_reinit
|
||||
implicit none
|
||||
|
||||
class(psb_c_hll_sparse_mat), intent(inout) :: a
|
||||
logical, intent(in), optional :: clear
|
||||
|
||||
Integer(Psb_ipk_) :: err_act, info
|
||||
character(len=20) :: name='reinit'
|
||||
logical :: clear_
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
|
||||
|
||||
if (present(clear)) then
|
||||
clear_ = clear
|
||||
else
|
||||
clear_ = .true.
|
||||
end if
|
||||
|
||||
if (a%is_bld() .or. a%is_upd()) then
|
||||
! do nothing
|
||||
return
|
||||
else if (a%is_asb()) then
|
||||
if (a%is_dev()) call a%sync()
|
||||
if (clear_) a%val(:) = czero
|
||||
call a%set_upd()
|
||||
call a%set_host()
|
||||
else
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_hll_reinit
|
||||
@ -0,0 +1,110 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_rowsum(d,a)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_rowsum
|
||||
implicit none
|
||||
class(psb_c_hll_sparse_mat), intent(in) :: a
|
||||
complex(psb_spk_), intent(out) :: d(:)
|
||||
|
||||
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, hksz, mxrwl
|
||||
logical :: tra
|
||||
Integer(Psb_ipk_) :: err_act, info, int_err(5)
|
||||
character(len=20) :: name='rowsum'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = 0
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
m = a%get_nrows()
|
||||
n = a%get_ncols()
|
||||
if (size(d) < m) then
|
||||
info=psb_err_input_asize_small_i_
|
||||
int_err(1) = 1
|
||||
int_err(2) = size(d)
|
||||
int_err(3) = m
|
||||
call psb_errpush(info,name,i_err=int_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
if (a%is_unit()) then
|
||||
d = cone
|
||||
else
|
||||
d = czero
|
||||
end if
|
||||
hksz = a%get_hksz()
|
||||
j = 1
|
||||
do i=1,m,hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call c_hll_rowsum(i,ir,mxrwl,a%irn(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz, &
|
||||
& d,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
j = j + 1
|
||||
end do
|
||||
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine c_hll_rowsum(ir,m,n,irn,ja,ldj,val,ldv,&
|
||||
& d,info)
|
||||
integer(psb_ipk_), intent(in) :: ir,m,n,ldj,ldv,ja(ldj,*),irn(*)
|
||||
complex(psb_spk_), intent(in) :: val(ldv,*)
|
||||
complex(psb_spk_), intent(inout) :: d(*)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i,j,k, m4, jc
|
||||
complex(psb_spk_) :: acc(4), tmp
|
||||
|
||||
info = psb_success_
|
||||
do i=1,m
|
||||
do j=1, irn(i)
|
||||
d(ir+i-1) = d(ir+i-1) + (val(i,j))
|
||||
end do
|
||||
end do
|
||||
|
||||
end subroutine c_hll_rowsum
|
||||
|
||||
end subroutine psb_c_hll_rowsum
|
||||
@ -0,0 +1,135 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_scal(d,a,info,side)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_scal
|
||||
implicit none
|
||||
class(psb_c_hll_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
character, intent(in), optional :: side
|
||||
|
||||
Integer(Psb_ipk_) :: err_act,mnm, i, j, m, n, ierr(5), ld, k, mxrwl, hksz, ir
|
||||
character(len=20) :: name='scal'
|
||||
character :: side_
|
||||
logical :: left
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
info = psb_err_missing_override_method_
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
|
||||
side_ = 'L'
|
||||
if (present(side)) then
|
||||
side_ = psb_toupper(side)
|
||||
end if
|
||||
|
||||
left = (side_ == 'L')
|
||||
|
||||
ld = size(d)
|
||||
if (left) then
|
||||
m = a%get_nrows()
|
||||
if (ld < m) then
|
||||
ierr(1) = 2; ierr(2) = ld;
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
else
|
||||
n = a%get_ncols()
|
||||
if (ld < n) then
|
||||
info=psb_err_input_asize_invalid_i_
|
||||
ierr(1) = 2; ierr(2) = ld;
|
||||
call psb_errpush(info,name,i_err=ierr)
|
||||
goto 9999
|
||||
end if
|
||||
end if
|
||||
|
||||
hksz = a%get_hksz()
|
||||
j = 1
|
||||
do i=1,m,hksz
|
||||
ir = min(hksz,m-i+1)
|
||||
mxrwl = (a%hkoffs(j+1) - a%hkoffs(j))/hksz
|
||||
k = a%hkoffs(j) + 1
|
||||
call psb_c_hll_scal_inner(i,ir,mxrwl,a%irn(i),&
|
||||
& a%ja(k),hksz,a%val(k),hksz,&
|
||||
& left,d,info)
|
||||
if (info /= psb_success_) goto 9999
|
||||
j = j + 1
|
||||
end do
|
||||
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
contains
|
||||
|
||||
subroutine psb_c_hll_scal_inner(ir,m,n,irn,ja,ldj,val,ldv,left,d,info)
|
||||
integer(psb_ipk_), intent(in) :: ir,m,n,ldj,ldv,ja(ldj,*),irn(*)
|
||||
complex(psb_spk_), intent(in) :: d(*)
|
||||
complex(psb_spk_), intent(inout) :: val(ldv,*)
|
||||
logical, intent(in) :: left
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i,j,k, m4, jc
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (left) then
|
||||
do i=1,m
|
||||
do j=1, irn(i)
|
||||
val(i,j) = val(i,j)*d(ir+i-1)
|
||||
end do
|
||||
end do
|
||||
else
|
||||
do i=1,m
|
||||
do j=1, irn(i)
|
||||
jc = ja(i,j)
|
||||
val(i,j) = val(i,j)*d(jc)
|
||||
end do
|
||||
end do
|
||||
|
||||
end if
|
||||
|
||||
end subroutine psb_c_hll_scal_inner
|
||||
|
||||
|
||||
end subroutine psb_c_hll_scal
|
||||
@ -0,0 +1,63 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_hll_scals(d,a,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_hll_scals
|
||||
implicit none
|
||||
class(psb_c_hll_sparse_mat), intent(inout) :: a
|
||||
complex(psb_spk_), intent(in) :: d
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
Integer(Psb_ipk_) :: err_act,mnm, i, j, m
|
||||
character(len=20) :: name='scal'
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
if (a%is_unit()) then
|
||||
call a%make_nonunit()
|
||||
end if
|
||||
|
||||
a%val(:) = a%val(:) * d
|
||||
call a%set_host()
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
return
|
||||
|
||||
end subroutine psb_c_hll_scals
|
||||
@ -0,0 +1,62 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_mv_dia_from_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_mv_dia_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_dia_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (.not.b%is_by_rows()) call b%fix(info)
|
||||
if (info /= psb_success_) return
|
||||
|
||||
call a%cp_from_coo(b,info)
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
call b%free()
|
||||
|
||||
return
|
||||
|
||||
9999 continue
|
||||
info = psb_err_alloc_dealloc_
|
||||
return
|
||||
|
||||
end subroutine psb_c_mv_dia_from_coo
|
||||
@ -0,0 +1,55 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_mv_dia_to_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_dia_mat_mod, psb_protect_name => psb_c_mv_dia_to_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_dia_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
integer(psb_ipk_) :: nza, nr, nc,i,j,k,irw, idl,err_act
|
||||
|
||||
info = psb_success_
|
||||
|
||||
call a%cp_to_coo(b,info)
|
||||
if (info /= 0) goto 9999
|
||||
call a%free()
|
||||
|
||||
return
|
||||
|
||||
9999 continue
|
||||
info = psb_err_alloc_dealloc_
|
||||
return
|
||||
end subroutine psb_c_mv_dia_to_coo
|
||||
@ -0,0 +1,56 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_mv_ell_from_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_mv_ell_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_ell_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
Integer(Psb_ipk_) :: nza, nr, i,j,k, idl,err_act, nc, nzm, ir, ic
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (.not.b%is_by_rows()) call b%fix(info)
|
||||
if (info /= psb_success_) return
|
||||
|
||||
call a%cp_from_coo(b,info)
|
||||
call b%free()
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_c_mv_ell_from_coo
|
||||
@ -0,0 +1,67 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_mv_ell_from_fmt(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_mv_ell_from_fmt
|
||||
implicit none
|
||||
|
||||
class(psb_c_ell_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select type (b)
|
||||
type is (psb_c_coo_sparse_mat)
|
||||
call a%mv_from_coo(b,info)
|
||||
|
||||
type is (psb_c_ell_sparse_mat)
|
||||
if (b%is_dev()) call b%sync()
|
||||
a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat
|
||||
call move_alloc(b%irn, a%irn)
|
||||
call move_alloc(b%idiag, a%idiag)
|
||||
call move_alloc(b%ja, a%ja)
|
||||
call move_alloc(b%val, a%val)
|
||||
call b%free()
|
||||
call a%set_host()
|
||||
|
||||
class default
|
||||
call b%mv_to_coo(tmp,info)
|
||||
if (info == psb_success_) call a%mv_from_coo(tmp,info)
|
||||
end select
|
||||
|
||||
end subroutine psb_c_mv_ell_from_fmt
|
||||
@ -0,0 +1,89 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_mv_ell_to_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_mv_ell_to_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_ell_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
Integer(Psb_ipk_) :: nza, nr, nc,i,j,k,irw, idl,err_act
|
||||
|
||||
info = psb_success_
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
nza = a%get_nzeros()
|
||||
|
||||
! Taking a path slightly slower but with less memory footprint
|
||||
deallocate(a%idiag)
|
||||
b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat
|
||||
|
||||
call psb_realloc(nza,b%ia,info)
|
||||
if (info == 0) call psb_realloc(nza,b%ja,info)
|
||||
if (info /= 0) goto 9999
|
||||
k=0
|
||||
do i=1, nr
|
||||
do j=1,a%irn(i)
|
||||
k = k + 1
|
||||
b%ia(k) = i
|
||||
b%ja(k) = a%ja(i,j)
|
||||
end do
|
||||
end do
|
||||
deallocate(a%ja, stat=info)
|
||||
|
||||
if (info == 0) call psb_realloc(nza,b%val,info)
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
k=0
|
||||
do i=1, nr
|
||||
do j=1,a%irn(i)
|
||||
k = k + 1
|
||||
b%val(k) = a%val(i,j)
|
||||
end do
|
||||
end do
|
||||
call a%free()
|
||||
call b%set_nzeros(nza)
|
||||
call b%set_host()
|
||||
call b%fix(info)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
info = psb_err_alloc_dealloc_
|
||||
return
|
||||
end subroutine psb_c_mv_ell_to_coo
|
||||
@ -0,0 +1,67 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_mv_ell_to_fmt(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_ell_mat_mod, psb_protect_name => psb_c_mv_ell_to_fmt
|
||||
implicit none
|
||||
|
||||
class(psb_c_ell_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select type (b)
|
||||
type is (psb_c_coo_sparse_mat)
|
||||
call a%mv_to_coo(b,info)
|
||||
! Need to fix trivial copies!
|
||||
type is (psb_c_ell_sparse_mat)
|
||||
if (a%is_dev()) call a%sync()
|
||||
b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat
|
||||
call move_alloc(a%irn, b%irn)
|
||||
call move_alloc(a%idiag, b%idiag)
|
||||
call move_alloc(a%ja, b%ja)
|
||||
call move_alloc(a%val, b%val)
|
||||
call a%free()
|
||||
call b%set_host()
|
||||
|
||||
class default
|
||||
call a%mv_to_coo(tmp,info)
|
||||
if (info == psb_success_) call b%mv_from_coo(tmp,info)
|
||||
end select
|
||||
|
||||
end subroutine psb_c_mv_ell_to_fmt
|
||||
@ -0,0 +1,60 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_mv_hdia_from_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hdia_mat_mod, psb_protect_name => psb_c_mv_hdia_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_hdia_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
Integer(Psb_ipk_) :: err_act
|
||||
|
||||
info = psb_success_
|
||||
|
||||
if (.not.(b%is_by_rows())) call b%fix(info)
|
||||
if (info /= psb_success_) return
|
||||
|
||||
call a%cp_from_coo(b,info)
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
call b%free()
|
||||
|
||||
return
|
||||
|
||||
9999 continue
|
||||
info = psb_err_alloc_dealloc_
|
||||
return
|
||||
|
||||
end subroutine psb_c_mv_hdia_from_coo
|
||||
@ -0,0 +1,55 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_mv_hdia_to_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hdia_mat_mod, psb_protect_name => psb_c_mv_hdia_to_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_hdia_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
integer(psb_ipk_) :: nza, nr, nc,i,j,k,irw, idl,err_act
|
||||
|
||||
info = psb_success_
|
||||
|
||||
call a%cp_to_coo(b,info)
|
||||
if (info /= 0) goto 9999
|
||||
call a%free()
|
||||
|
||||
return
|
||||
|
||||
9999 continue
|
||||
info = psb_err_alloc_dealloc_
|
||||
return
|
||||
end subroutine psb_c_mv_hdia_to_coo
|
||||
@ -0,0 +1,58 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_mv_hll_from_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_mv_hll_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_hll_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
integer(psb_ipk_) :: hksz
|
||||
info = psb_success_
|
||||
if (.not.b%is_by_rows()) call b%fix(info)
|
||||
hksz = psi_get_hksz()
|
||||
call psi_convert_hll_from_coo(a,hksz,b,info)
|
||||
if (info /= 0) goto 9999
|
||||
call b%free()
|
||||
|
||||
return
|
||||
|
||||
9999 continue
|
||||
info = psb_err_alloc_dealloc_
|
||||
return
|
||||
|
||||
end subroutine psb_c_mv_hll_from_coo
|
||||
@ -0,0 +1,70 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_mv_hll_from_fmt(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_mv_hll_from_fmt
|
||||
implicit none
|
||||
|
||||
class(psb_c_hll_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select type (b)
|
||||
type is (psb_c_coo_sparse_mat)
|
||||
call a%mv_from_coo(b,info)
|
||||
|
||||
type is (psb_c_hll_sparse_mat)
|
||||
if (b%is_dev()) call b%sync()
|
||||
a%psb_c_base_sparse_mat = b%psb_c_base_sparse_mat
|
||||
call move_alloc(b%irn, a%irn)
|
||||
call move_alloc(b%idiag, a%idiag)
|
||||
call move_alloc(b%hkoffs, a%hkoffs)
|
||||
call move_alloc(b%ja, a%ja)
|
||||
call move_alloc(b%val, a%val)
|
||||
a%hksz = b%hksz
|
||||
a%nzt = b%nzt
|
||||
call b%free()
|
||||
call a%set_host()
|
||||
|
||||
class default
|
||||
call b%mv_to_coo(tmp,info)
|
||||
if (info == psb_success_) call a%mv_from_coo(tmp,info)
|
||||
end select
|
||||
|
||||
end subroutine psb_c_mv_hll_from_fmt
|
||||
@ -0,0 +1,56 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_mv_hll_to_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_mv_hll_to_coo
|
||||
implicit none
|
||||
|
||||
class(psb_c_hll_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
info = psb_success_
|
||||
|
||||
call a%cp_to_coo(b,info)
|
||||
|
||||
if (info /= psb_success_) goto 9999
|
||||
call a%free()
|
||||
|
||||
return
|
||||
|
||||
9999 continue
|
||||
info = psb_err_alloc_dealloc_
|
||||
return
|
||||
end subroutine psb_c_mv_hll_to_coo
|
||||
@ -0,0 +1,69 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_c_mv_hll_to_fmt(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_c_hll_mat_mod, psb_protect_name => psb_c_mv_hll_to_fmt
|
||||
implicit none
|
||||
|
||||
class(psb_c_hll_sparse_mat), intent(inout) :: a
|
||||
class(psb_c_base_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_c_coo_sparse_mat) :: tmp
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select type (b)
|
||||
type is (psb_c_coo_sparse_mat)
|
||||
call a%mv_to_coo(b,info)
|
||||
! Need to fix trivial copies!
|
||||
type is (psb_c_hll_sparse_mat)
|
||||
if (a%is_dev()) call a%sync()
|
||||
b%psb_c_base_sparse_mat = a%psb_c_base_sparse_mat
|
||||
call move_alloc(a%irn, b%irn)
|
||||
call move_alloc(a%hkoffs, b%hkoffs)
|
||||
call move_alloc(a%idiag, b%idiag)
|
||||
call move_alloc(a%ja, b%ja)
|
||||
call move_alloc(a%val, b%val)
|
||||
b%hksz = a%hksz
|
||||
call a%free()
|
||||
call b%set_host()
|
||||
|
||||
class default
|
||||
call a%mv_to_coo(tmp,info)
|
||||
if (info == psb_success_) call b%mv_from_coo(tmp,info)
|
||||
end select
|
||||
|
||||
end subroutine psb_c_mv_hll_to_fmt
|
||||
@ -0,0 +1,70 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_d_cp_dia_from_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_d_dia_mat_mod, psb_protect_name => psb_d_cp_dia_from_coo
|
||||
implicit none
|
||||
|
||||
class(psb_d_dia_sparse_mat), intent(inout) :: a
|
||||
class(psb_d_coo_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_d_coo_sparse_mat) :: tmp
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
|
||||
info = psb_success_
|
||||
if (b%is_dev()) call b%sync()
|
||||
if (b%is_by_rows()) then
|
||||
call psi_convert_dia_from_coo(a,b,info)
|
||||
else
|
||||
! This is to guarantee tmp%is_by_rows()
|
||||
call b%cp_to_coo(tmp,info)
|
||||
call tmp%fix(info)
|
||||
|
||||
if (info /= psb_success_) return
|
||||
call psi_convert_dia_from_coo(a,tmp,info)
|
||||
|
||||
call tmp%free()
|
||||
end if
|
||||
if (info /= 0) goto 9999
|
||||
call a%set_host()
|
||||
|
||||
return
|
||||
|
||||
9999 continue
|
||||
info = psb_err_alloc_dealloc_
|
||||
return
|
||||
|
||||
end subroutine psb_d_cp_dia_from_coo
|
||||
@ -0,0 +1,65 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_d_cp_dia_to_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_d_dia_mat_mod, psb_protect_name => psb_d_cp_dia_to_coo
|
||||
implicit none
|
||||
|
||||
class(psb_d_dia_sparse_mat), intent(in) :: a
|
||||
class(psb_d_coo_sparse_mat), intent(inout) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
integer(psb_ipk_) :: i, j, k,nr,nza,nc, nzd
|
||||
|
||||
info = psb_success_
|
||||
if (a%is_dev()) call a%sync()
|
||||
|
||||
nr = a%get_nrows()
|
||||
nc = a%get_ncols()
|
||||
nza = a%get_nzeros()
|
||||
|
||||
call b%allocate(nr,nc,nza)
|
||||
b%psb_d_base_sparse_mat = a%psb_d_base_sparse_mat
|
||||
|
||||
call psi_d_xtr_coo_from_dia(nr,nc,&
|
||||
& b%ia, b%ja, b%val, nzd, &
|
||||
& size(a%data,1),size(a%data,2),&
|
||||
& a%data,a%offset,info)
|
||||
|
||||
call b%set_nzeros(nza)
|
||||
call b%set_host()
|
||||
call b%fix(info)
|
||||
|
||||
end subroutine psb_d_cp_dia_to_coo
|
||||
@ -0,0 +1,71 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_d_cp_ell_from_coo(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_d_ell_mat_mod, psb_protect_name => psb_d_cp_ell_from_coo
|
||||
use psi_ext_util_mod
|
||||
implicit none
|
||||
|
||||
class(psb_d_ell_sparse_mat), intent(inout) :: a
|
||||
class(psb_d_coo_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_d_coo_sparse_mat) :: tmp
|
||||
Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc
|
||||
integer(psb_ipk_) :: nzm, ir, ic, k
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
|
||||
info = psb_success_
|
||||
! This is to have fix_coo called behind the scenes
|
||||
if (b%is_dev()) call b%sync()
|
||||
if (b%is_by_rows()) then
|
||||
call psi_d_convert_ell_from_coo(a,b,info)
|
||||
else
|
||||
call b%cp_to_coo(tmp,info)
|
||||
if (info == psb_success_) call psi_d_convert_ell_from_coo(a,tmp,info)
|
||||
if (info == psb_success_) call tmp%free()
|
||||
end if
|
||||
if (info /= psb_success_) goto 9999
|
||||
call a%set_host()
|
||||
|
||||
return
|
||||
|
||||
9999 continue
|
||||
info = psb_err_alloc_dealloc_
|
||||
return
|
||||
|
||||
|
||||
end subroutine psb_d_cp_ell_from_coo
|
||||
@ -0,0 +1,65 @@
|
||||
! Parallel Sparse BLAS GPU plugin
|
||||
! (C) Copyright 2013
|
||||
!
|
||||
! Salvatore Filippone
|
||||
! Alessandro Fanfarillo
|
||||
!
|
||||
! 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_d_cp_ell_from_fmt(a,b,info)
|
||||
|
||||
use psb_base_mod
|
||||
use psb_d_ell_mat_mod, psb_protect_name => psb_d_cp_ell_from_fmt
|
||||
implicit none
|
||||
|
||||
class(psb_d_ell_sparse_mat), intent(inout) :: a
|
||||
class(psb_d_base_sparse_mat), intent(in) :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
!locals
|
||||
type(psb_d_coo_sparse_mat) :: tmp
|
||||
|
||||
info = psb_success_
|
||||
|
||||
select type (b)
|
||||
type is (psb_d_coo_sparse_mat)
|
||||
call a%cp_from_coo(b,info)
|
||||
|
||||
type is (psb_d_ell_sparse_mat)
|
||||
if (b%is_dev()) call b%sync()
|
||||
a%psb_d_base_sparse_mat = b%psb_d_base_sparse_mat
|
||||
if (info == 0) call psb_safe_cpy( b%irn, a%irn , info)
|
||||
if (info == 0) call psb_safe_cpy( b%idiag, a%idiag, info)
|
||||
if (info == 0) call psb_safe_cpy( b%ja , a%ja , info)
|
||||
if (info == 0) call psb_safe_cpy( b%val, a%val , info)
|
||||
call a%set_host()
|
||||
|
||||
class default
|
||||
call b%cp_to_coo(tmp,info)
|
||||
if (info == psb_success_) call a%mv_from_coo(tmp,info)
|
||||
end select
|
||||
end subroutine psb_d_cp_ell_from_fmt
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue