diff --git a/Makefile b/Makefile index a0f5ec3e..4a79afce 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ include Make.inc -all: dirs based precd kryld utild cbindd libd +all: dirs based precd kryld utild cbindd extd libd @echo "=====================================" @echo "PSBLAS libraries Compilation Successful." @@ -12,15 +12,17 @@ dirs: precd: based utild: based kryld: precd +extd: based cbindd: based precd kryld utild -libd: based precd kryld utild cbindd +libd: based precd kryld utild cbindd extd $(MAKE) -C base lib $(MAKE) -C prec lib $(MAKE) -C krylov lib $(MAKE) -C util lib $(MAKE) -C cbind lib + $(MAKE) -C ext lib based: $(MAKE) -C base objs @@ -32,6 +34,8 @@ utild: $(MAKE) -C util objs cbindd: $(MAKE) -C cbind objs +extd: + $(MAKE) -C ext objs install: all @@ -56,6 +60,7 @@ clean: $(MAKE) -C krylov clean $(MAKE) -C util clean $(MAKE) -C cbind clean + $(MAKE) -C ext clean check: all make check -C test/serial @@ -71,6 +76,7 @@ veryclean: cleanlib cd krylov && $(MAKE) veryclean cd util && $(MAKE) veryclean cd cbind && $(MAKE) veryclean + cd ext && $(MAKE) veryclean cd test/fileread && $(MAKE) clean cd test/pargen && $(MAKE) clean cd test/util && $(MAKE) clean diff --git a/ext/Makefile b/ext/Makefile new file mode 100755 index 00000000..36b82433 --- /dev/null +++ b/ext/Makefile @@ -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) + + + + diff --git a/ext/impl/Makefile b/ext/impl/Makefile new file mode 100755 index 00000000..57593a54 --- /dev/null +++ b/ext/impl/Makefile @@ -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) diff --git a/ext/impl/psb_c_cp_dia_from_coo.f90 b/ext/impl/psb_c_cp_dia_from_coo.f90 new file mode 100644 index 00000000..2d2b1caa --- /dev/null +++ b/ext/impl/psb_c_cp_dia_from_coo.f90 @@ -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 diff --git a/ext/impl/psb_c_cp_dia_to_coo.f90 b/ext/impl/psb_c_cp_dia_to_coo.f90 new file mode 100644 index 00000000..9975bec0 --- /dev/null +++ b/ext/impl/psb_c_cp_dia_to_coo.f90 @@ -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 diff --git a/ext/impl/psb_c_cp_ell_from_coo.f90 b/ext/impl/psb_c_cp_ell_from_coo.f90 new file mode 100644 index 00000000..28d7d242 --- /dev/null +++ b/ext/impl/psb_c_cp_ell_from_coo.f90 @@ -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 diff --git a/ext/impl/psb_c_cp_ell_from_fmt.f90 b/ext/impl/psb_c_cp_ell_from_fmt.f90 new file mode 100644 index 00000000..309063b9 --- /dev/null +++ b/ext/impl/psb_c_cp_ell_from_fmt.f90 @@ -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 diff --git a/ext/impl/psb_c_cp_ell_to_coo.f90 b/ext/impl/psb_c_cp_ell_to_coo.f90 new file mode 100644 index 00000000..ec6bcff5 --- /dev/null +++ b/ext/impl/psb_c_cp_ell_to_coo.f90 @@ -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 diff --git a/ext/impl/psb_c_cp_ell_to_fmt.f90 b/ext/impl/psb_c_cp_ell_to_fmt.f90 new file mode 100644 index 00000000..0c6a6903 --- /dev/null +++ b/ext/impl/psb_c_cp_ell_to_fmt.f90 @@ -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 diff --git a/ext/impl/psb_c_cp_hdia_from_coo.f90 b/ext/impl/psb_c_cp_hdia_from_coo.f90 new file mode 100644 index 00000000..a9e1ca21 --- /dev/null +++ b/ext/impl/psb_c_cp_hdia_from_coo.f90 @@ -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 diff --git a/ext/impl/psb_c_cp_hdia_to_coo.f90 b/ext/impl/psb_c_cp_hdia_to_coo.f90 new file mode 100644 index 00000000..32801653 --- /dev/null +++ b/ext/impl/psb_c_cp_hdia_to_coo.f90 @@ -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 diff --git a/ext/impl/psb_c_cp_hll_from_coo.f90 b/ext/impl/psb_c_cp_hll_from_coo.f90 new file mode 100644 index 00000000..506196c2 --- /dev/null +++ b/ext/impl/psb_c_cp_hll_from_coo.f90 @@ -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 diff --git a/ext/impl/psb_c_cp_hll_from_fmt.f90 b/ext/impl/psb_c_cp_hll_from_fmt.f90 new file mode 100644 index 00000000..0849561f --- /dev/null +++ b/ext/impl/psb_c_cp_hll_from_fmt.f90 @@ -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 diff --git a/ext/impl/psb_c_cp_hll_to_coo.f90 b/ext/impl/psb_c_cp_hll_to_coo.f90 new file mode 100644 index 00000000..0ff46352 --- /dev/null +++ b/ext/impl/psb_c_cp_hll_to_coo.f90 @@ -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 diff --git a/ext/impl/psb_c_cp_hll_to_fmt.f90 b/ext/impl/psb_c_cp_hll_to_fmt.f90 new file mode 100644 index 00000000..df8fa3b7 --- /dev/null +++ b/ext/impl/psb_c_cp_hll_to_fmt.f90 @@ -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 diff --git a/ext/impl/psb_c_dia_aclsum.f90 b/ext/impl/psb_c_dia_aclsum.f90 new file mode 100644 index 00000000..4bd8d440 --- /dev/null +++ b/ext/impl/psb_c_dia_aclsum.f90 @@ -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 diff --git a/ext/impl/psb_c_dia_allocate_mnnz.f90 b/ext/impl/psb_c_dia_allocate_mnnz.f90 new file mode 100644 index 00000000..37fb34e1 --- /dev/null +++ b/ext/impl/psb_c_dia_allocate_mnnz.f90 @@ -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 diff --git a/ext/impl/psb_c_dia_arwsum.f90 b/ext/impl/psb_c_dia_arwsum.f90 new file mode 100644 index 00000000..fe40deb8 --- /dev/null +++ b/ext/impl/psb_c_dia_arwsum.f90 @@ -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 diff --git a/ext/impl/psb_c_dia_colsum.f90 b/ext/impl/psb_c_dia_colsum.f90 new file mode 100644 index 00000000..ed43fa12 --- /dev/null +++ b/ext/impl/psb_c_dia_colsum.f90 @@ -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 diff --git a/ext/impl/psb_c_dia_csgetptn.f90 b/ext/impl/psb_c_dia_csgetptn.f90 new file mode 100644 index 00000000..ad479d35 --- /dev/null +++ b/ext/impl/psb_c_dia_csgetptn.f90 @@ -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 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 diff --git a/ext/impl/psb_c_dia_csgetrow.f90 b/ext/impl/psb_c_dia_csgetrow.f90 new file mode 100644 index 00000000..2989b20f --- /dev/null +++ b/ext/impl/psb_c_dia_csgetrow.f90 @@ -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 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 diff --git a/ext/impl/psb_c_dia_csmm.f90 b/ext/impl/psb_c_dia_csmm.f90 new file mode 100644 index 00000000..b65c4651 --- /dev/null +++ b/ext/impl/psb_c_dia_csmm.f90 @@ -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) 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 diff --git a/ext/impl/psb_c_dia_csmv.f90 b/ext/impl/psb_c_dia_csmv.f90 new file mode 100644 index 00000000..cf1ef677 --- /dev/null +++ b/ext/impl/psb_c_dia_csmv.f90 @@ -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) 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 diff --git a/ext/impl/psb_c_dia_get_diag.f90 b/ext/impl/psb_c_dia_get_diag.f90 new file mode 100644 index 00000000..d868b62d --- /dev/null +++ b/ext/impl/psb_c_dia_get_diag.f90 @@ -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 diff --git a/ext/impl/psb_c_dia_maxval.f90 b/ext/impl/psb_c_dia_maxval.f90 new file mode 100644 index 00000000..03a2be82 --- /dev/null +++ b/ext/impl/psb_c_dia_maxval.f90 @@ -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 diff --git a/ext/impl/psb_c_dia_mold.f90 b/ext/impl/psb_c_dia_mold.f90 new file mode 100644 index 00000000..1d694828 --- /dev/null +++ b/ext/impl/psb_c_dia_mold.f90 @@ -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 diff --git a/ext/impl/psb_c_dia_print.f90 b/ext/impl/psb_c_dia_print.f90 new file mode 100644 index 00000000..f3233366 --- /dev/null +++ b/ext/impl/psb_c_dia_print.f90 @@ -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 diff --git a/ext/impl/psb_c_dia_reallocate_nz.f90 b/ext/impl/psb_c_dia_reallocate_nz.f90 new file mode 100644 index 00000000..c46cd465 --- /dev/null +++ b/ext/impl/psb_c_dia_reallocate_nz.f90 @@ -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 diff --git a/ext/impl/psb_c_dia_reinit.f90 b/ext/impl/psb_c_dia_reinit.f90 new file mode 100644 index 00000000..04a345eb --- /dev/null +++ b/ext/impl/psb_c_dia_reinit.f90 @@ -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 diff --git a/ext/impl/psb_c_dia_rowsum.f90 b/ext/impl/psb_c_dia_rowsum.f90 new file mode 100644 index 00000000..1f36dab4 --- /dev/null +++ b/ext/impl/psb_c_dia_rowsum.f90 @@ -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 diff --git a/ext/impl/psb_c_dia_scal.f90 b/ext/impl/psb_c_dia_scal.f90 new file mode 100644 index 00000000..8f35b7c1 --- /dev/null +++ b/ext/impl/psb_c_dia_scal.f90 @@ -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 diff --git a/ext/impl/psb_c_dia_scals.f90 b/ext/impl/psb_c_dia_scals.f90 new file mode 100644 index 00000000..a9ca5db1 --- /dev/null +++ b/ext/impl/psb_c_dia_scals.f90 @@ -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 diff --git a/ext/impl/psb_c_dns_mat_impl.f90 b/ext/impl/psb_c_dns_mat_impl.f90 new file mode 100644 index 00000000..8e99af8b --- /dev/null +++ b/ext/impl/psb_c_dns_mat_impl.f90 @@ -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 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 + diff --git a/ext/impl/psb_c_ell_aclsum.f90 b/ext/impl/psb_c_ell_aclsum.f90 new file mode 100644 index 00000000..3d5a292a --- /dev/null +++ b/ext/impl/psb_c_ell_aclsum.f90 @@ -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 diff --git a/ext/impl/psb_c_ell_allocate_mnnz.f90 b/ext/impl/psb_c_ell_allocate_mnnz.f90 new file mode 100644 index 00000000..b137eb04 --- /dev/null +++ b/ext/impl/psb_c_ell_allocate_mnnz.f90 @@ -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 diff --git a/ext/impl/psb_c_ell_arwsum.f90 b/ext/impl/psb_c_ell_arwsum.f90 new file mode 100644 index 00000000..c047c742 --- /dev/null +++ b/ext/impl/psb_c_ell_arwsum.f90 @@ -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 diff --git a/ext/impl/psb_c_ell_colsum.f90 b/ext/impl/psb_c_ell_colsum.f90 new file mode 100644 index 00000000..6d06b589 --- /dev/null +++ b/ext/impl/psb_c_ell_colsum.f90 @@ -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 diff --git a/ext/impl/psb_c_ell_csgetblk.f90 b/ext/impl/psb_c_ell_csgetblk.f90 new file mode 100644 index 00000000..deb07c25 --- /dev/null +++ b/ext/impl/psb_c_ell_csgetblk.f90 @@ -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 diff --git a/ext/impl/psb_c_ell_csgetptn.f90 b/ext/impl/psb_c_ell_csgetptn.f90 new file mode 100644 index 00000000..821daa89 --- /dev/null +++ b/ext/impl/psb_c_ell_csgetptn.f90 @@ -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 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 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) 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) 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 diff --git a/ext/impl/psb_c_ell_csnmi.f90 b/ext/impl/psb_c_ell_csnmi.f90 new file mode 100644 index 00000000..6dc9cfa4 --- /dev/null +++ b/ext/impl/psb_c_ell_csnmi.f90 @@ -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 diff --git a/ext/impl/psb_c_ell_csput.f90 b/ext/impl/psb_c_ell_csput.f90 new file mode 100644 index 00000000..e0b0f47f --- /dev/null +++ b/ext/impl/psb_c_ell_csput.f90 @@ -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 diff --git a/ext/impl/psb_c_ell_cssm.f90 b/ext/impl/psb_c_ell_cssm.f90 new file mode 100644 index 00000000..26e76030 --- /dev/null +++ b/ext/impl/psb_c_ell_cssm.f90 @@ -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) 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) 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 diff --git a/ext/impl/psb_c_ell_maxval.f90 b/ext/impl/psb_c_ell_maxval.f90 new file mode 100644 index 00000000..4de58b11 --- /dev/null +++ b/ext/impl/psb_c_ell_maxval.f90 @@ -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 diff --git a/ext/impl/psb_c_ell_mold.f90 b/ext/impl/psb_c_ell_mold.f90 new file mode 100644 index 00000000..c7c5d621 --- /dev/null +++ b/ext/impl/psb_c_ell_mold.f90 @@ -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 diff --git a/ext/impl/psb_c_ell_print.f90 b/ext/impl/psb_c_ell_print.f90 new file mode 100644 index 00000000..1b8117a8 --- /dev/null +++ b/ext/impl/psb_c_ell_print.f90 @@ -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 diff --git a/ext/impl/psb_c_ell_reallocate_nz.f90 b/ext/impl/psb_c_ell_reallocate_nz.f90 new file mode 100644 index 00000000..b0d77568 --- /dev/null +++ b/ext/impl/psb_c_ell_reallocate_nz.f90 @@ -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 diff --git a/ext/impl/psb_c_ell_reinit.f90 b/ext/impl/psb_c_ell_reinit.f90 new file mode 100644 index 00000000..2b15dfea --- /dev/null +++ b/ext/impl/psb_c_ell_reinit.f90 @@ -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 diff --git a/ext/impl/psb_c_ell_rowsum.f90 b/ext/impl/psb_c_ell_rowsum.f90 new file mode 100644 index 00000000..5ae7d42c --- /dev/null +++ b/ext/impl/psb_c_ell_rowsum.f90 @@ -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 diff --git a/ext/impl/psb_c_ell_scal.f90 b/ext/impl/psb_c_ell_scal.f90 new file mode 100644 index 00000000..63150f32 --- /dev/null +++ b/ext/impl/psb_c_ell_scal.f90 @@ -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 diff --git a/ext/impl/psb_c_ell_scals.f90 b/ext/impl/psb_c_ell_scals.f90 new file mode 100644 index 00000000..3e4cd92a --- /dev/null +++ b/ext/impl/psb_c_ell_scals.f90 @@ -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 diff --git a/ext/impl/psb_c_ell_trim.f90 b/ext/impl/psb_c_ell_trim.f90 new file mode 100644 index 00000000..22aafefd --- /dev/null +++ b/ext/impl/psb_c_ell_trim.f90 @@ -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 diff --git a/ext/impl/psb_c_hdia_allocate_mnnz.f90 b/ext/impl/psb_c_hdia_allocate_mnnz.f90 new file mode 100644 index 00000000..17a49ffe --- /dev/null +++ b/ext/impl/psb_c_hdia_allocate_mnnz.f90 @@ -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 diff --git a/ext/impl/psb_c_hdia_csmv.f90 b/ext/impl/psb_c_hdia_csmv.f90 new file mode 100644 index 00000000..a04fde07 --- /dev/null +++ b/ext/impl/psb_c_hdia_csmv.f90 @@ -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)=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 diff --git a/ext/impl/psb_c_hdia_mold.f90 b/ext/impl/psb_c_hdia_mold.f90 new file mode 100644 index 00000000..d9f85ec9 --- /dev/null +++ b/ext/impl/psb_c_hdia_mold.f90 @@ -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 diff --git a/ext/impl/psb_c_hdia_print.f90 b/ext/impl/psb_c_hdia_print.f90 new file mode 100644 index 00000000..477a5433 --- /dev/null +++ b/ext/impl/psb_c_hdia_print.f90 @@ -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 diff --git a/ext/impl/psb_c_hll_aclsum.f90 b/ext/impl/psb_c_hll_aclsum.f90 new file mode 100644 index 00000000..f1bd8e89 --- /dev/null +++ b/ext/impl/psb_c_hll_aclsum.f90 @@ -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 diff --git a/ext/impl/psb_c_hll_allocate_mnnz.f90 b/ext/impl/psb_c_hll_allocate_mnnz.f90 new file mode 100644 index 00000000..97b996bd --- /dev/null +++ b/ext/impl/psb_c_hll_allocate_mnnz.f90 @@ -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 diff --git a/ext/impl/psb_c_hll_arwsum.f90 b/ext/impl/psb_c_hll_arwsum.f90 new file mode 100644 index 00000000..9c48e1c0 --- /dev/null +++ b/ext/impl/psb_c_hll_arwsum.f90 @@ -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 diff --git a/ext/impl/psb_c_hll_colsum.f90 b/ext/impl/psb_c_hll_colsum.f90 new file mode 100644 index 00000000..fbcb0934 --- /dev/null +++ b/ext/impl/psb_c_hll_colsum.f90 @@ -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 diff --git a/ext/impl/psb_c_hll_csgetblk.f90 b/ext/impl/psb_c_hll_csgetblk.f90 new file mode 100644 index 00000000..9bf0b869 --- /dev/null +++ b/ext/impl/psb_c_hll_csgetblk.f90 @@ -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 diff --git a/ext/impl/psb_c_hll_csgetptn.f90 b/ext/impl/psb_c_hll_csgetptn.f90 new file mode 100644 index 00000000..0f6481ed --- /dev/null +++ b/ext/impl/psb_c_hll_csgetptn.f90 @@ -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 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 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 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) 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 diff --git a/ext/impl/psb_c_hll_csnm1.f90 b/ext/impl/psb_c_hll_csnm1.f90 new file mode 100644 index 00000000..25daa75d --- /dev/null +++ b/ext/impl/psb_c_hll_csnm1.f90 @@ -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 diff --git a/ext/impl/psb_c_hll_csnmi.f90 b/ext/impl/psb_c_hll_csnmi.f90 new file mode 100644 index 00000000..c70be9ce --- /dev/null +++ b/ext/impl/psb_c_hll_csnmi.f90 @@ -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 diff --git a/ext/impl/psb_c_hll_csput.f90 b/ext/impl/psb_c_hll_csput.f90 new file mode 100644 index 00000000..e46ae30a --- /dev/null +++ b/ext/impl/psb_c_hll_csput.f90 @@ -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 diff --git a/ext/impl/psb_c_hll_cssm.f90 b/ext/impl/psb_c_hll_cssm.f90 new file mode 100644 index 00000000..90e3b978 --- /dev/null +++ b/ext/impl/psb_c_hll_cssm.f90 @@ -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 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) 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 diff --git a/ext/impl/psb_c_hll_maxval.f90 b/ext/impl/psb_c_hll_maxval.f90 new file mode 100644 index 00000000..ff82bb40 --- /dev/null +++ b/ext/impl/psb_c_hll_maxval.f90 @@ -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 diff --git a/ext/impl/psb_c_hll_mold.f90 b/ext/impl/psb_c_hll_mold.f90 new file mode 100644 index 00000000..4a6204b0 --- /dev/null +++ b/ext/impl/psb_c_hll_mold.f90 @@ -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 diff --git a/ext/impl/psb_c_hll_print.f90 b/ext/impl/psb_c_hll_print.f90 new file mode 100644 index 00000000..a5eec378 --- /dev/null +++ b/ext/impl/psb_c_hll_print.f90 @@ -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 diff --git a/ext/impl/psb_c_hll_reallocate_nz.f90 b/ext/impl/psb_c_hll_reallocate_nz.f90 new file mode 100644 index 00000000..44d9cfc9 --- /dev/null +++ b/ext/impl/psb_c_hll_reallocate_nz.f90 @@ -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 diff --git a/ext/impl/psb_c_hll_reinit.f90 b/ext/impl/psb_c_hll_reinit.f90 new file mode 100644 index 00000000..82d5cb16 --- /dev/null +++ b/ext/impl/psb_c_hll_reinit.f90 @@ -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 diff --git a/ext/impl/psb_c_hll_rowsum.f90 b/ext/impl/psb_c_hll_rowsum.f90 new file mode 100644 index 00000000..e6eea227 --- /dev/null +++ b/ext/impl/psb_c_hll_rowsum.f90 @@ -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 diff --git a/ext/impl/psb_c_hll_scal.f90 b/ext/impl/psb_c_hll_scal.f90 new file mode 100644 index 00000000..0fd59f15 --- /dev/null +++ b/ext/impl/psb_c_hll_scal.f90 @@ -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 diff --git a/ext/impl/psb_c_hll_scals.f90 b/ext/impl/psb_c_hll_scals.f90 new file mode 100644 index 00000000..13a03a22 --- /dev/null +++ b/ext/impl/psb_c_hll_scals.f90 @@ -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 diff --git a/ext/impl/psb_c_mv_dia_from_coo.f90 b/ext/impl/psb_c_mv_dia_from_coo.f90 new file mode 100644 index 00000000..99871348 --- /dev/null +++ b/ext/impl/psb_c_mv_dia_from_coo.f90 @@ -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 diff --git a/ext/impl/psb_c_mv_dia_to_coo.f90 b/ext/impl/psb_c_mv_dia_to_coo.f90 new file mode 100644 index 00000000..1382cec3 --- /dev/null +++ b/ext/impl/psb_c_mv_dia_to_coo.f90 @@ -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 diff --git a/ext/impl/psb_c_mv_ell_from_coo.f90 b/ext/impl/psb_c_mv_ell_from_coo.f90 new file mode 100644 index 00000000..64da3e8d --- /dev/null +++ b/ext/impl/psb_c_mv_ell_from_coo.f90 @@ -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 diff --git a/ext/impl/psb_c_mv_ell_from_fmt.f90 b/ext/impl/psb_c_mv_ell_from_fmt.f90 new file mode 100644 index 00000000..d0fa9bc4 --- /dev/null +++ b/ext/impl/psb_c_mv_ell_from_fmt.f90 @@ -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 diff --git a/ext/impl/psb_c_mv_ell_to_coo.f90 b/ext/impl/psb_c_mv_ell_to_coo.f90 new file mode 100644 index 00000000..a49e2e3c --- /dev/null +++ b/ext/impl/psb_c_mv_ell_to_coo.f90 @@ -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 diff --git a/ext/impl/psb_c_mv_ell_to_fmt.f90 b/ext/impl/psb_c_mv_ell_to_fmt.f90 new file mode 100644 index 00000000..3ea02d6b --- /dev/null +++ b/ext/impl/psb_c_mv_ell_to_fmt.f90 @@ -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 diff --git a/ext/impl/psb_c_mv_hdia_from_coo.f90 b/ext/impl/psb_c_mv_hdia_from_coo.f90 new file mode 100644 index 00000000..4247fdf8 --- /dev/null +++ b/ext/impl/psb_c_mv_hdia_from_coo.f90 @@ -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 diff --git a/ext/impl/psb_c_mv_hdia_to_coo.f90 b/ext/impl/psb_c_mv_hdia_to_coo.f90 new file mode 100644 index 00000000..3a91917a --- /dev/null +++ b/ext/impl/psb_c_mv_hdia_to_coo.f90 @@ -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 diff --git a/ext/impl/psb_c_mv_hll_from_coo.f90 b/ext/impl/psb_c_mv_hll_from_coo.f90 new file mode 100644 index 00000000..b78bdd80 --- /dev/null +++ b/ext/impl/psb_c_mv_hll_from_coo.f90 @@ -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 diff --git a/ext/impl/psb_c_mv_hll_from_fmt.f90 b/ext/impl/psb_c_mv_hll_from_fmt.f90 new file mode 100644 index 00000000..add90355 --- /dev/null +++ b/ext/impl/psb_c_mv_hll_from_fmt.f90 @@ -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 diff --git a/ext/impl/psb_c_mv_hll_to_coo.f90 b/ext/impl/psb_c_mv_hll_to_coo.f90 new file mode 100644 index 00000000..fbf5dfcd --- /dev/null +++ b/ext/impl/psb_c_mv_hll_to_coo.f90 @@ -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 diff --git a/ext/impl/psb_c_mv_hll_to_fmt.f90 b/ext/impl/psb_c_mv_hll_to_fmt.f90 new file mode 100644 index 00000000..37d77e85 --- /dev/null +++ b/ext/impl/psb_c_mv_hll_to_fmt.f90 @@ -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 diff --git a/ext/impl/psb_d_cp_dia_from_coo.f90 b/ext/impl/psb_d_cp_dia_from_coo.f90 new file mode 100644 index 00000000..b640565f --- /dev/null +++ b/ext/impl/psb_d_cp_dia_from_coo.f90 @@ -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 diff --git a/ext/impl/psb_d_cp_dia_to_coo.f90 b/ext/impl/psb_d_cp_dia_to_coo.f90 new file mode 100644 index 00000000..527c96d0 --- /dev/null +++ b/ext/impl/psb_d_cp_dia_to_coo.f90 @@ -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 diff --git a/ext/impl/psb_d_cp_ell_from_coo.f90 b/ext/impl/psb_d_cp_ell_from_coo.f90 new file mode 100644 index 00000000..cf23a0e0 --- /dev/null +++ b/ext/impl/psb_d_cp_ell_from_coo.f90 @@ -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 diff --git a/ext/impl/psb_d_cp_ell_from_fmt.f90 b/ext/impl/psb_d_cp_ell_from_fmt.f90 new file mode 100644 index 00000000..ce8a8d7e --- /dev/null +++ b/ext/impl/psb_d_cp_ell_from_fmt.f90 @@ -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 diff --git a/ext/impl/psb_d_cp_ell_to_coo.f90 b/ext/impl/psb_d_cp_ell_to_coo.f90 new file mode 100644 index 00000000..8e7ad735 --- /dev/null +++ b/ext/impl/psb_d_cp_ell_to_coo.f90 @@ -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_d_cp_ell_to_coo(a,b,info) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_cp_ell_to_coo + implicit none + + class(psb_d_ell_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, 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_d_base_sparse_mat = a%psb_d_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_d_cp_ell_to_coo diff --git a/ext/impl/psb_d_cp_ell_to_fmt.f90 b/ext/impl/psb_d_cp_ell_to_fmt.f90 new file mode 100644 index 00000000..fd05d0fd --- /dev/null +++ b/ext/impl/psb_d_cp_ell_to_fmt.f90 @@ -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_d_cp_ell_to_fmt(a,b,info) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_cp_ell_to_fmt + implicit none + + class(psb_d_ell_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout) :: 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_to_coo(b,info) + + type is (psb_d_ell_sparse_mat) + if (a%is_dev()) call a%sync() + + b%psb_d_base_sparse_mat = a%psb_d_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_d_cp_ell_to_fmt diff --git a/ext/impl/psb_d_cp_hdia_from_coo.f90 b/ext/impl/psb_d_cp_hdia_from_coo.f90 new file mode 100644 index 00000000..bbc34195 --- /dev/null +++ b/ext/impl/psb_d_cp_hdia_from_coo.f90 @@ -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_d_cp_hdia_from_coo(a,b,info) + + use psb_base_mod + use psb_d_hdia_mat_mod, psb_protect_name => psb_d_cp_hdia_from_coo + implicit none + + class(psb_d_hdia_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 + + 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_d_hdia_sparse_mat), intent(inout) :: a + class(psb_d_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_d_base_sparse_mat = tmp%psb_d_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_d_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_d_cp_hdia_from_coo diff --git a/ext/impl/psb_d_cp_hdia_to_coo.f90 b/ext/impl/psb_d_cp_hdia_to_coo.f90 new file mode 100644 index 00000000..bfa77b08 --- /dev/null +++ b/ext/impl/psb_d_cp_hdia_to_coo.f90 @@ -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_d_cp_hdia_to_coo(a,b,info) + + use psb_base_mod + use psb_d_hdia_mat_mod, psb_protect_name => psb_d_cp_hdia_to_coo + use psi_ext_util_mod + implicit none + + class(psb_d_hdia_sparse_mat), intent(in) :: a + class(psb_d_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_d_base_sparse_mat = a%psb_d_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_d_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_d_cp_hdia_to_coo diff --git a/ext/impl/psb_d_cp_hll_from_coo.f90 b/ext/impl/psb_d_cp_hll_from_coo.f90 new file mode 100644 index 00000000..03028d20 --- /dev/null +++ b/ext/impl/psb_d_cp_hll_from_coo.f90 @@ -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_d_cp_hll_from_coo(a,b,info) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_cp_hll_from_coo + implicit none + + class(psb_d_hll_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, 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_d_cp_hll_from_coo diff --git a/ext/impl/psb_d_cp_hll_from_fmt.f90 b/ext/impl/psb_d_cp_hll_from_fmt.f90 new file mode 100644 index 00000000..785b23ac --- /dev/null +++ b/ext/impl/psb_d_cp_hll_from_fmt.f90 @@ -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_hll_from_fmt(a,b,info) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_cp_hll_from_fmt + implicit none + + class(psb_d_hll_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) + class is (psb_d_coo_sparse_mat) + call a%cp_from_coo(b,info) + + class is (psb_d_hll_sparse_mat) + ! write(0,*) 'From type_hll' + 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%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_d_cp_hll_from_fmt diff --git a/ext/impl/psb_d_cp_hll_to_coo.f90 b/ext/impl/psb_d_cp_hll_to_coo.f90 new file mode 100644 index 00000000..b20144c5 --- /dev/null +++ b/ext/impl/psb_d_cp_hll_to_coo.f90 @@ -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_d_cp_hll_to_coo(a,b,info) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_cp_hll_to_coo + implicit none + + class(psb_d_hll_sparse_mat), intent(in) :: a + class(psb_d_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_d_base_sparse_mat = a%psb_d_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(*) + real(psb_dpk_) :: 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_d_cp_hll_to_coo diff --git a/ext/impl/psb_d_cp_hll_to_fmt.f90 b/ext/impl/psb_d_cp_hll_to_fmt.f90 new file mode 100644 index 00000000..6c60c5b5 --- /dev/null +++ b/ext/impl/psb_d_cp_hll_to_fmt.f90 @@ -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_d_cp_hll_to_fmt(a,b,info) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_cp_hll_to_fmt + implicit none + + class(psb_d_hll_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout) :: 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_to_coo(b,info) + + type is (psb_d_hll_sparse_mat) + if (a%is_dev()) call a%sync() + b%psb_d_base_sparse_mat = a%psb_d_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_d_cp_hll_to_fmt diff --git a/ext/impl/psb_d_dia_aclsum.f90 b/ext/impl/psb_d_dia_aclsum.f90 new file mode 100644 index 00000000..0f4df6ca --- /dev/null +++ b/ext/impl/psb_d_dia_aclsum.f90 @@ -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_d_dia_aclsum(d,a) + + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_dia_aclsum + implicit none + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), 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 = done + else + d = dzero + 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_d_dia_aclsum diff --git a/ext/impl/psb_d_dia_allocate_mnnz.f90 b/ext/impl/psb_d_dia_allocate_mnnz.f90 new file mode 100644 index 00000000..309b7d4a --- /dev/null +++ b/ext/impl/psb_d_dia_allocate_mnnz.f90 @@ -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_d_dia_allocate_mnnz(m,n,a,nz) + + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_dia_allocate_mnnz + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_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_d_dia_allocate_mnnz diff --git a/ext/impl/psb_d_dia_arwsum.f90 b/ext/impl/psb_d_dia_arwsum.f90 new file mode 100644 index 00000000..98eefc44 --- /dev/null +++ b/ext/impl/psb_d_dia_arwsum.f90 @@ -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_d_dia_arwsum(d,a) + + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_dia_arwsum + implicit none + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), 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 = done + else + d = dzero + 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_d_dia_arwsum diff --git a/ext/impl/psb_d_dia_colsum.f90 b/ext/impl/psb_d_dia_colsum.f90 new file mode 100644 index 00000000..6a6eb81c --- /dev/null +++ b/ext/impl/psb_d_dia_colsum.f90 @@ -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_d_dia_colsum(d,a) + + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_dia_colsum + implicit none + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), 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 = done + else + d = dzero + 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_d_dia_colsum diff --git a/ext/impl/psb_d_dia_csgetptn.f90 b/ext/impl/psb_d_dia_csgetptn.f90 new file mode 100644 index 00000000..ad0e040a --- /dev/null +++ b/ext/impl/psb_d_dia_csgetptn.f90 @@ -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_d_dia_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_dia_csgetptn + implicit none + + class(psb_d_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 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_d_dia_csgetptn diff --git a/ext/impl/psb_d_dia_csgetrow.f90 b/ext/impl/psb_d_dia_csgetrow.f90 new file mode 100644 index 00000000..7e05a26e --- /dev/null +++ b/ext/impl/psb_d_dia_csgetrow.f90 @@ -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_d_dia_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_dia_csgetrow + implicit none + + class(psb_d_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(:) + real(psb_dpk_), 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 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_d_dia_csgetrow diff --git a/ext/impl/psb_d_dia_csmm.f90 b/ext/impl/psb_d_dia_csmm.f90 new file mode 100644 index 00000000..81ad967d --- /dev/null +++ b/ext/impl/psb_d_dia_csmm.f90 @@ -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_d_dia_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_dia_csmm + implicit none + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), 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='d_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) 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_d_dia_csmm_inner + +end subroutine psb_d_dia_csmm diff --git a/ext/impl/psb_d_dia_csmv.f90 b/ext/impl/psb_d_dia_csmv.f90 new file mode 100644 index 00000000..166b4c58 --- /dev/null +++ b/ext/impl/psb_d_dia_csmv.f90 @@ -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_d_dia_csmv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_dia_csmv + implicit none + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), 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='d_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) 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_d_dia_csmv_inner + +end subroutine psb_d_dia_csmv diff --git a/ext/impl/psb_d_dia_get_diag.f90 b/ext/impl/psb_d_dia_get_diag.f90 new file mode 100644 index 00000000..bbcb4a12 --- /dev/null +++ b/ext/impl/psb_d_dia_get_diag.f90 @@ -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_d_dia_get_diag(a,d,info) + + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_dia_get_diag + implicit none + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), 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) = done + 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) = dzero + end do + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + +end subroutine psb_d_dia_get_diag diff --git a/ext/impl/psb_d_dia_maxval.f90 b/ext/impl/psb_d_dia_maxval.f90 new file mode 100644 index 00000000..f57be1ff --- /dev/null +++ b/ext/impl/psb_d_dia_maxval.f90 @@ -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_d_dia_maxval(a) result(res) + + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_dia_maxval + implicit none + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_) :: 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='d_maxval' + logical, parameter :: debug=.false. + + if (a%is_dev()) call a%sync() + if (a%is_unit()) then + res = done + else + res = dzero + end if + + res = max(res,maxval(abs(a%data))) + +end function psb_d_dia_maxval diff --git a/ext/impl/psb_d_dia_mold.f90 b/ext/impl/psb_d_dia_mold.f90 new file mode 100644 index 00000000..2b3cef81 --- /dev/null +++ b/ext/impl/psb_d_dia_mold.f90 @@ -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_d_dia_mold(a,b,info) + + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_dia_mold + implicit none + class(psb_d_dia_sparse_mat), intent(in) :: a + class(psb_d_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_d_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_d_dia_mold diff --git a/ext/impl/psb_d_dia_print.f90 b/ext/impl/psb_d_dia_print.f90 new file mode 100644 index 00000000..e32dc2ed --- /dev/null +++ b/ext/impl/psb_d_dia_print.f90 @@ -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_d_dia_print(iout,a,iv,head,ivr,ivc) + + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_dia_print + implicit none + + integer(psb_ipk_), intent(in) :: iout + class(psb_d_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='d_dia_print' + logical, parameter :: debug=.false. + + class(psb_d_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 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_d_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_d_dia_print diff --git a/ext/impl/psb_d_dia_reallocate_nz.f90 b/ext/impl/psb_d_dia_reallocate_nz.f90 new file mode 100644 index 00000000..83864dd8 --- /dev/null +++ b/ext/impl/psb_d_dia_reallocate_nz.f90 @@ -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_d_dia_reallocate_nz(nz,a) + + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_dia_reallocate_nz + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_d_dia_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm, ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='d_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_d_dia_reallocate_nz diff --git a/ext/impl/psb_d_dia_reinit.f90 b/ext/impl/psb_d_dia_reinit.f90 new file mode 100644 index 00000000..f1e91ade --- /dev/null +++ b/ext/impl/psb_d_dia_reinit.f90 @@ -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_d_dia_reinit(a,clear) + + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_dia_reinit + implicit none + + class(psb_d_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(:,:) = dzero + 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_d_dia_reinit diff --git a/ext/impl/psb_d_dia_rowsum.f90 b/ext/impl/psb_d_dia_rowsum.f90 new file mode 100644 index 00000000..7a5875ba --- /dev/null +++ b/ext/impl/psb_d_dia_rowsum.f90 @@ -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_d_dia_rowsum(d,a) + + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_dia_rowsum + implicit none + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), 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 = done + else + d = dzero + 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_d_dia_rowsum diff --git a/ext/impl/psb_d_dia_scal.f90 b/ext/impl/psb_d_dia_scal.f90 new file mode 100644 index 00000000..d87c0d25 --- /dev/null +++ b/ext/impl/psb_d_dia_scal.f90 @@ -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_d_dia_scal(d,a,info,side) + + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_dia_scal + implicit none + class(psb_d_dia_sparse_mat), intent(inout) :: a + real(psb_dpk_), 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_d_dia_scal diff --git a/ext/impl/psb_d_dia_scals.f90 b/ext/impl/psb_d_dia_scals.f90 new file mode 100644 index 00000000..a3958f57 --- /dev/null +++ b/ext/impl/psb_d_dia_scals.f90 @@ -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_d_dia_scals(d,a,info) + + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_dia_scals + implicit none + class(psb_d_dia_sparse_mat), intent(inout) :: a + real(psb_dpk_), 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_d_dia_scals diff --git a/ext/impl/psb_d_dns_mat_impl.f90 b/ext/impl/psb_d_dns_mat_impl.f90 new file mode 100644 index 00000000..edf5cde4 --- /dev/null +++ b/ext/impl/psb_d_dns_mat_impl.f90 @@ -0,0 +1,724 @@ + +!> Function csmv: +!! \memberof psb_d_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_d_dns_csmv(alpha,a,x,beta,y,info,trans) + use psb_base_mod + use psb_d_dns_mat_mod, psb_protect_name => psb_d_dns_csmv + implicit none + class(psb_d_dns_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), 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='d_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 dgemv(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_d_dns_csmv + + +!> Function csmm: +!! \memberof psb_d_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_d_dns_csmm(alpha,a,x,beta,y,info,trans) + use psb_base_mod + use psb_d_dns_mat_mod, psb_protect_name => psb_d_dns_csmm + implicit none + class(psb_d_dns_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), 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='d_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 dgemm(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_d_dns_csmm + + + +! +! +!> Function csnmi: +!! \memberof psb_d_dns_sparse_mat +!! \brief Operator infinity norm +!! CSNMI = MAXVAL(SUM(ABS(A(:,:)),dim=2)) +!! +! +function psb_d_dns_csnmi(a) result(res) + use psb_base_mod + use psb_d_dns_mat_mod, psb_protect_name => psb_d_dns_csnmi + implicit none + class(psb_d_dns_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + ! + integer(psb_ipk_) :: i + real(psb_dpk_) :: acc + + res = dzero + 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_d_dns_csnmi + + +! +!> Function get_diag: +!! \memberof psb_d_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_d_dns_get_diag(a,d,info) + use psb_base_mod + use psb_d_dns_mat_mod, psb_protect_name => psb_d_dns_get_diag + implicit none + class(psb_d_dns_sparse_mat), intent(in) :: a + real(psb_dpk_), 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) = dzero + end do + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + +end subroutine psb_d_dns_get_diag + + +! +! +!> Function reallocate_nz +!! \memberof psb_d_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_d_dns_reallocate_nz(nz,a) + use psb_base_mod + use psb_d_dns_mat_mod, psb_protect_name => psb_d_dns_reallocate_nz + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_d_dns_sparse_mat), intent(inout) :: a + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_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_d_dns_reallocate_nz + +! +!> Function mold: +!! \memberof psb_d_dns_sparse_mat +!! \brief Allocate a class(psb_d_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_d_dns_mold(a,b,info) + use psb_base_mod + use psb_d_dns_mat_mod, psb_protect_name => psb_d_dns_mold + implicit none + class(psb_d_dns_sparse_mat), intent(in) :: a + class(psb_d_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_d_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_d_dns_mold + +! +! +!> Function allocate_mnnz +!! \memberof psb_d_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_d_dns_allocate_mnnz(m,n,a,nz) + use psb_base_mod + use psb_d_dns_mat_mod, psb_protect_name => psb_d_dns_allocate_mnnz + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_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 = dzero + a%nnz = 0 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + +end subroutine psb_d_dns_allocate_mnnz + + +! +! +! +!> Function csgetrow: +!! \memberof psb_d_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_d_dns_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + use psb_base_mod + use psb_d_dns_mat_mod, psb_protect_name => psb_d_dns_csgetrow + implicit none + + class(psb_d_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(:) + real(psb_dpk_), 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 Function trim +!! \memberof psb_d_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_d_dns_trim(a) + use psb_base_mod + use psb_d_dns_mat_mod, psb_protect_name => psb_d_dns_trim + implicit none + class(psb_d_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_d_dns_trim + +! +!> Function cp_from_coo: +!! \memberof psb_d_dns_sparse_mat +!! \brief Copy and convert from psb_d_coo_sparse_mat +!! Invoked from the target object. +!! \param b The input variable +!! \param info return code +! + +subroutine psb_d_cp_dns_from_coo(a,b,info) + use psb_base_mod + use psb_d_dns_mat_mod, psb_protect_name => psb_d_cp_dns_from_coo + implicit none + + class(psb_d_dns_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + ! + type(psb_d_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_d_base_sparse_mat = tmp%psb_d_base_sparse_mat + + call psb_realloc(nr,nc,a%val,info) + if (info /= 0) goto 9999 + a%val = dzero + 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_d_base_sparse_mat = b%psb_d_base_sparse_mat + + call psb_realloc(nr,nc,a%val,info) + if (info /= 0) goto 9999 + a%val = dzero + 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_d_cp_dns_from_coo + + + +! +!> Function cp_to_coo: +!! \memberof psb_d_dns_sparse_mat +!! \brief Copy and convert to psb_d_coo_sparse_mat +!! Invoked from the source object. +!! \param b The output variable +!! \param info return code +! + +subroutine psb_d_cp_dns_to_coo(a,b,info) + use psb_base_mod + use psb_d_dns_mat_mod, psb_protect_name => psb_d_cp_dns_to_coo + implicit none + + class(psb_d_dns_sparse_mat), intent(in) :: a + class(psb_d_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_d_base_sparse_mat = a%psb_d_base_sparse_mat + + k = 0 + do i=1,a%get_nrows() + do j=1,a%get_ncols() + if (a%val(i,j) /= dzero) 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_d_cp_dns_to_coo + + + +! +!> Function mv_to_coo: +!! \memberof psb_d_dns_sparse_mat +!! \brief Convert to psb_d_coo_sparse_mat, freeing the source. +!! Invoked from the source object. +!! \param b The output variable +!! \param info return code +! +subroutine psb_d_mv_dns_to_coo(a,b,info) + use psb_base_mod + use psb_d_dns_mat_mod, psb_protect_name => psb_d_mv_dns_to_coo + implicit none + + class(psb_d_dns_sparse_mat), intent(inout) :: a + class(psb_d_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_d_mv_dns_to_coo + + +! +!> Function mv_from_coo: +!! \memberof psb_d_dns_sparse_mat +!! \brief Convert from psb_d_coo_sparse_mat, freeing the source. +!! Invoked from the target object. +!! \param b The input variable +!! \param info return code +! +! +subroutine psb_d_mv_dns_from_coo(a,b,info) + use psb_base_mod + use psb_d_dns_mat_mod, psb_protect_name => psb_d_mv_dns_from_coo + implicit none + + class(psb_d_dns_sparse_mat), intent(inout) :: a + class(psb_d_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_d_mv_dns_from_coo + diff --git a/ext/impl/psb_d_ell_aclsum.f90 b/ext/impl/psb_d_ell_aclsum.f90 new file mode 100644 index 00000000..e0bfc18d --- /dev/null +++ b/ext/impl/psb_d_ell_aclsum.f90 @@ -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_d_ell_aclsum(d,a) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_aclsum + implicit none + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), 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 = done + else + d = dzero + 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_d_ell_aclsum diff --git a/ext/impl/psb_d_ell_allocate_mnnz.f90 b/ext/impl/psb_d_ell_allocate_mnnz.f90 new file mode 100644 index 00000000..95e4558c --- /dev/null +++ b/ext/impl/psb_d_ell_allocate_mnnz.f90 @@ -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_d_ell_allocate_mnnz(m,n,a,nz) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_allocate_mnnz + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_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_d_ell_allocate_mnnz diff --git a/ext/impl/psb_d_ell_arwsum.f90 b/ext/impl/psb_d_ell_arwsum.f90 new file mode 100644 index 00000000..6bf3b888 --- /dev/null +++ b/ext/impl/psb_d_ell_arwsum.f90 @@ -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_d_ell_arwsum(d,a) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_arwsum + implicit none + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), 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) = done + else + d(i) = dzero + 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_d_ell_arwsum diff --git a/ext/impl/psb_d_ell_colsum.f90 b/ext/impl/psb_d_ell_colsum.f90 new file mode 100644 index 00000000..9eb30ca0 --- /dev/null +++ b/ext/impl/psb_d_ell_colsum.f90 @@ -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_d_ell_colsum(d,a) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_colsum + implicit none + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), 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 = done + else + d = dzero + 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_d_ell_colsum diff --git a/ext/impl/psb_d_ell_csgetblk.f90 b/ext/impl/psb_d_ell_csgetblk.f90 new file mode 100644 index 00000000..9725518f --- /dev/null +++ b/ext/impl/psb_d_ell_csgetblk.f90 @@ -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_d_ell_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_csgetblk + implicit none + + class(psb_d_ell_sparse_mat), intent(in) :: a + class(psb_d_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_d_ell_csgetblk diff --git a/ext/impl/psb_d_ell_csgetptn.f90 b/ext/impl/psb_d_ell_csgetptn.f90 new file mode 100644 index 00000000..a050fe54 --- /dev/null +++ b/ext/impl/psb_d_ell_csgetptn.f90 @@ -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_d_ell_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_csgetptn + implicit none + + class(psb_d_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 psb_d_ell_csgetrow + implicit none + + class(psb_d_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(:) + real(psb_dpk_), 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 psb_d_ell_csmm + implicit none + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), 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 + real(psb_dpk_), allocatable :: acc(:) + logical :: tra, ctra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_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) psb_d_ell_csmv + implicit none + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), 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 + real(psb_dpk_) :: 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) psb_d_ell_csnm1 + + implicit none + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info + real(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_ell_csnm1' + logical, parameter :: debug=.false. + + + if (a%is_dev()) call a%sync() + res = dzero + 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(:) = done + else + vt(:) = dzero + 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_d_ell_csnm1 diff --git a/ext/impl/psb_d_ell_csnmi.f90 b/ext/impl/psb_d_ell_csnmi.f90 new file mode 100644 index 00000000..b4e3d03e --- /dev/null +++ b/ext/impl/psb_d_ell_csnmi.f90 @@ -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_d_ell_csnmi(a) result(res) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_csnmi + implicit none + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer(psb_ipk_) :: i,j,k,m,n, nr, ir, jc, nc + real(psb_dpk_) :: acc + logical :: tra, is_unit + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_csnmi' + logical, parameter :: debug=.false. + + + if (a%is_dev()) call a%sync() + res = dzero + is_unit = a%is_unit() + do i = 1, a%get_nrows() + acc = sum(abs(a%val(i,:))) + if (is_unit) acc = acc + done + res = max(res,acc) + end do + +end function psb_d_ell_csnmi diff --git a/ext/impl/psb_d_ell_csput.f90 b/ext/impl/psb_d_ell_csput.f90 new file mode 100644 index 00000000..d38d9d51 --- /dev/null +++ b/ext/impl/psb_d_ell_csput.f90 @@ -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_d_ell_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_csput_a + implicit none + + class(psb_d_ell_sparse_mat), intent(inout) :: a + real(psb_dpk_), 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='d_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_d_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_d_ell_srch_upd(nz,ia,ja,val,a,& + & imin,imax,jmin,jmax,info) + + implicit none + + class(psb_d_ell_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax + integer(psb_ipk_), intent(in) :: ia(:),ja(:) + real(psb_dpk_), 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='d_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_d_ell_srch_upd +end subroutine psb_d_ell_csput_a diff --git a/ext/impl/psb_d_ell_cssm.f90 b/ext/impl/psb_d_ell_cssm.f90 new file mode 100644 index 00000000..3c8b5f21 --- /dev/null +++ b/ext/impl/psb_d_ell_cssm.f90 @@ -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_d_ell_cssm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_cssm + implicit none + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), 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 + real(psb_dpk_), allocatable :: tmp(:,:), acc(:) + logical :: tra, ctra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_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) psb_d_ell_cssv + implicit none + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), 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 + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: tmp(:) + logical :: tra, ctra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_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) psb_d_ell_get_diag + implicit none + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), 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) = done + 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) = dzero + end if + end do + end if + do i=mnm+1,size(d) + d(i) = dzero + end do + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + +end subroutine psb_d_ell_get_diag diff --git a/ext/impl/psb_d_ell_maxval.f90 b/ext/impl/psb_d_ell_maxval.f90 new file mode 100644 index 00000000..d0cb24d3 --- /dev/null +++ b/ext/impl/psb_d_ell_maxval.f90 @@ -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_d_ell_maxval(a) result(res) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_maxval + implicit none + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer(psb_ipk_) :: i,j,k,m,n, nr, ir, jc, nc + real(psb_dpk_) :: acc + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_csnmi' + logical, parameter :: debug=.false. + + if (a%is_dev()) call a%sync() + if (a%is_unit()) then + res = done + else + res = dzero + end if + + do i = 1, a%get_nrows() + acc = maxval(abs(a%val(i,:))) + res = max(res,acc) + end do + +end function psb_d_ell_maxval diff --git a/ext/impl/psb_d_ell_mold.f90 b/ext/impl/psb_d_ell_mold.f90 new file mode 100644 index 00000000..48814f3c --- /dev/null +++ b/ext/impl/psb_d_ell_mold.f90 @@ -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_d_ell_mold(a,b,info) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_mold + implicit none + class(psb_d_ell_sparse_mat), intent(in) :: a + class(psb_d_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_d_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_d_ell_mold diff --git a/ext/impl/psb_d_ell_print.f90 b/ext/impl/psb_d_ell_print.f90 new file mode 100644 index 00000000..cf539662 --- /dev/null +++ b/ext/impl/psb_d_ell_print.f90 @@ -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_d_ell_print(iout,a,iv,head,ivr,ivc) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_print + implicit none + + integer(psb_ipk_), intent(in) :: iout + class(psb_d_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='d_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 real 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_d_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_d_ell_print diff --git a/ext/impl/psb_d_ell_reallocate_nz.f90 b/ext/impl/psb_d_ell_reallocate_nz.f90 new file mode 100644 index 00000000..8f92ffad --- /dev/null +++ b/ext/impl/psb_d_ell_reallocate_nz.f90 @@ -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_d_ell_reallocate_nz(nz,a) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_reallocate_nz + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_d_ell_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm, ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='d_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_d_ell_reallocate_nz diff --git a/ext/impl/psb_d_ell_reinit.f90 b/ext/impl/psb_d_ell_reinit.f90 new file mode 100644 index 00000000..ab9a7ba2 --- /dev/null +++ b/ext/impl/psb_d_ell_reinit.f90 @@ -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_d_ell_reinit(a,clear) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_reinit + implicit none + + class(psb_d_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(:,:) = dzero + 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_d_ell_reinit diff --git a/ext/impl/psb_d_ell_rowsum.f90 b/ext/impl/psb_d_ell_rowsum.f90 new file mode 100644 index 00000000..782775d4 --- /dev/null +++ b/ext/impl/psb_d_ell_rowsum.f90 @@ -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_d_ell_rowsum(d,a) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_rowsum + implicit none + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), 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) = done + else + d(i) = dzero + 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_d_ell_rowsum diff --git a/ext/impl/psb_d_ell_scal.f90 b/ext/impl/psb_d_ell_scal.f90 new file mode 100644 index 00000000..15be8a66 --- /dev/null +++ b/ext/impl/psb_d_ell_scal.f90 @@ -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_d_ell_scal(d,a,info,side) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_scal + implicit none + class(psb_d_ell_sparse_mat), intent(inout) :: a + real(psb_dpk_), 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_d_ell_scal diff --git a/ext/impl/psb_d_ell_scals.f90 b/ext/impl/psb_d_ell_scals.f90 new file mode 100644 index 00000000..501f42b0 --- /dev/null +++ b/ext/impl/psb_d_ell_scals.f90 @@ -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_d_ell_scals(d,a,info) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_scals + implicit none + class(psb_d_ell_sparse_mat), intent(inout) :: a + real(psb_dpk_), 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_d_ell_scals diff --git a/ext/impl/psb_d_ell_trim.f90 b/ext/impl/psb_d_ell_trim.f90 new file mode 100644 index 00000000..8b1d52f7 --- /dev/null +++ b/ext/impl/psb_d_ell_trim.f90 @@ -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_d_ell_trim(a) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_ell_trim + implicit none + class(psb_d_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_d_ell_trim diff --git a/ext/impl/psb_d_hdia_allocate_mnnz.f90 b/ext/impl/psb_d_hdia_allocate_mnnz.f90 new file mode 100644 index 00000000..e5721754 --- /dev/null +++ b/ext/impl/psb_d_hdia_allocate_mnnz.f90 @@ -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_d_hdia_allocate_mnnz(m,n,a,nz) + + use psb_base_mod + use psb_d_hdia_mat_mod, psb_protect_name => psb_d_hdia_allocate_mnnz + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_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_d_hdia_allocate_mnnz diff --git a/ext/impl/psb_d_hdia_csmv.f90 b/ext/impl/psb_d_hdia_csmv.f90 new file mode 100644 index 00000000..82599342 --- /dev/null +++ b/ext/impl/psb_d_hdia_csmv.f90 @@ -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_d_hdia_csmv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod + use psb_d_hdia_mat_mod, psb_protect_name => psb_d_hdia_csmv + implicit none + class(psb_d_hdia_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), 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)=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_d_inner_dia_csmv + +end subroutine psb_d_hdia_csmv diff --git a/ext/impl/psb_d_hdia_mold.f90 b/ext/impl/psb_d_hdia_mold.f90 new file mode 100644 index 00000000..cebedd44 --- /dev/null +++ b/ext/impl/psb_d_hdia_mold.f90 @@ -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_d_hdia_mold(a,b,info) + + use psb_base_mod + use psb_d_hdia_mat_mod, psb_protect_name => psb_d_hdia_mold + implicit none + class(psb_d_hdia_sparse_mat), intent(in) :: a + class(psb_d_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_d_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_d_hdia_mold diff --git a/ext/impl/psb_d_hdia_print.f90 b/ext/impl/psb_d_hdia_print.f90 new file mode 100644 index 00000000..43753299 --- /dev/null +++ b/ext/impl/psb_d_hdia_print.f90 @@ -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_d_hdia_print(iout,a,iv,head,ivr,ivc) + + use psb_base_mod + use psb_d_hdia_mat_mod, psb_protect_name => psb_d_hdia_print + use psi_ext_util_mod + implicit none + + integer(psb_ipk_), intent(in) :: iout + class(psb_d_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_d_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(:) + real(psb_dpk_), allocatable :: val(:) + + + write(iout,'(a)') '%%MatrixMarket matrix coordinate real 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_d_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_d_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_d_hdia_print diff --git a/ext/impl/psb_d_hll_aclsum.f90 b/ext/impl/psb_d_hll_aclsum.f90 new file mode 100644 index 00000000..1f868edc --- /dev/null +++ b/ext/impl/psb_d_hll_aclsum.f90 @@ -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_d_hll_aclsum(d,a) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_aclsum + implicit none + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), 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 = done + else + d = dzero + 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 d_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 d_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(*) + real(psb_dpk_), intent(in) :: val(ldv,*) + real(psb_dpk_), intent(inout) :: d(*) + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i,j,k, m4, jc + real(psb_dpk_) :: 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 d_hll_aclsum + +end subroutine psb_d_hll_aclsum diff --git a/ext/impl/psb_d_hll_allocate_mnnz.f90 b/ext/impl/psb_d_hll_allocate_mnnz.f90 new file mode 100644 index 00000000..f58d0e4a --- /dev/null +++ b/ext/impl/psb_d_hll_allocate_mnnz.f90 @@ -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_d_hll_allocate_mnnz(m,n,a,nz) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_allocate_mnnz + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_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_d_hll_allocate_mnnz diff --git a/ext/impl/psb_d_hll_arwsum.f90 b/ext/impl/psb_d_hll_arwsum.f90 new file mode 100644 index 00000000..e5ae24fb --- /dev/null +++ b/ext/impl/psb_d_hll_arwsum.f90 @@ -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_d_hll_arwsum(d,a) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_arwsum + implicit none + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), 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 = done + else + d = dzero + 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 d_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 d_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(*) + real(psb_dpk_), intent(in) :: val(ldv,*) + real(psb_dpk_), intent(inout) :: d(*) + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i,j,k, m4, jc + real(psb_dpk_) :: 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 d_hll_arwsum + +end subroutine psb_d_hll_arwsum diff --git a/ext/impl/psb_d_hll_colsum.f90 b/ext/impl/psb_d_hll_colsum.f90 new file mode 100644 index 00000000..8c2020ec --- /dev/null +++ b/ext/impl/psb_d_hll_colsum.f90 @@ -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_d_hll_colsum(d,a) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_colsum + implicit none + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), 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 = done + else + d = dzero + 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 d_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 d_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(*) + real(psb_dpk_), intent(in) :: val(ldv,*) + real(psb_dpk_), intent(inout) :: d(*) + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i,j,k, m4, jc + real(psb_dpk_) :: 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 d_hll_colsum + +end subroutine psb_d_hll_colsum diff --git a/ext/impl/psb_d_hll_csgetblk.f90 b/ext/impl/psb_d_hll_csgetblk.f90 new file mode 100644 index 00000000..185baf29 --- /dev/null +++ b/ext/impl/psb_d_hll_csgetblk.f90 @@ -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_d_hll_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_csgetblk + implicit none + + class(psb_d_hll_sparse_mat), intent(in) :: a + class(psb_d_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_d_hll_csgetblk diff --git a/ext/impl/psb_d_hll_csgetptn.f90 b/ext/impl/psb_d_hll_csgetptn.f90 new file mode 100644 index 00000000..a7cdc148 --- /dev/null +++ b/ext/impl/psb_d_hll_csgetptn.f90 @@ -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_d_hll_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_csgetptn + implicit none + + class(psb_d_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 psb_d_hll_csgetrow + implicit none + + class(psb_d_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(:) + real(psb_dpk_), 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 psb_d_hll_csmm + implicit none + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), 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 + real(psb_dpk_), allocatable :: acc(:) + logical :: tra, ctra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_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 psb_d_hll_csmv + implicit none + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), 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='d_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) 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_d_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_d_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_d_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_d_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_d_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_d_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_d_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_d_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_d_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(*) + real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + real(psb_dpk_), 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 + real(psb_dpk_) :: acc(4), tmp + + info = psb_success_ + if (tra) then + + if (beta == done) 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 == done) 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 (.not.(tra.or.ctra)) then + + if (alpha == dzero) then + if (beta == dzero) then + do i=1,m + y(ir+i-1) = dzero + end do + else + do i=1,m + y(ir+i-1) = beta*y(ir+i-1) + end do + end if + + else + if (beta == dzero) then + do i=1,m + tmp = dzero + 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 = dzero + 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_d_hll_csmv_inner + + subroutine psb_d_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_dpk_, dzero, psb_success_ + implicit none + integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) + real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + real(psb_dpk_), 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 + real(psb_dpk_) :: acc(4), tmp(m) + + info = psb_success_ + + + tmp(:) = dzero + if (alpha /= dzero) 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 == dzero) 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_d_hll_csmv_notra_8 + + subroutine psb_d_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_dpk_, dzero, psb_success_ + implicit none + integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) + real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + real(psb_dpk_), 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 + real(psb_dpk_) :: acc(4), tmp(m) + + info = psb_success_ + + + tmp(:) = dzero + if (alpha /= dzero) 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 == dzero) 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_d_hll_csmv_notra_24 + + subroutine psb_d_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_dpk_, dzero, psb_success_ + implicit none + integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) + real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + real(psb_dpk_), 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 + real(psb_dpk_) :: acc(4), tmp(m) + + info = psb_success_ + + + tmp(:) = dzero + if (alpha /= dzero) 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 == dzero) 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_d_hll_csmv_notra_16 + + subroutine psb_d_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_dpk_, dzero, psb_success_ + implicit none + integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) + real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + real(psb_dpk_), 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 + real(psb_dpk_) :: acc(4), tmp(m) + + info = psb_success_ + + + tmp(:) = dzero + if (alpha /= dzero) 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 == dzero) 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_d_hll_csmv_notra_32 + + subroutine psb_d_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_dpk_, dzero, psb_success_ + implicit none + integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) + real(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + real(psb_dpk_), 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 + real(psb_dpk_) :: acc(4), tmp(m) + + info = psb_success_ + + + tmp(:) = dzero + if (alpha /= dzero) 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 == dzero) 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_d_hll_csmv_notra_4 + +end subroutine psb_d_hll_csmv diff --git a/ext/impl/psb_d_hll_csnm1.f90 b/ext/impl/psb_d_hll_csnm1.f90 new file mode 100644 index 00000000..4627a4d2 --- /dev/null +++ b/ext/impl/psb_d_hll_csnm1.f90 @@ -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_d_hll_csnm1(a) result(res) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_csnm1 + + implicit none + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info, hksz, mxrwl + real(psb_dpk_), allocatable :: vt(:) + logical :: is_unit + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_hll_csnm1' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + + res = dzero + 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 = done + else + vt = dzero + 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_d_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_d_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(*) + real(psb_dpk_), intent(in) :: val(ldv,*) + real(psb_dpk_), intent(inout) :: vt(*) + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i,j,k, m4, jc + real(psb_dpk_) :: 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_d_hll_csnm1_inner + +end function psb_d_hll_csnm1 diff --git a/ext/impl/psb_d_hll_csnmi.f90 b/ext/impl/psb_d_hll_csnmi.f90 new file mode 100644 index 00000000..2b758fa3 --- /dev/null +++ b/ext/impl/psb_d_hll_csnmi.f90 @@ -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_d_hll_csnmi(a) result(res) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_csnmi + implicit none + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_) :: 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='d_csnmi' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + info = 0 + res = dzero + 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_d_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_d_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(*) + real(psb_dpk_), intent(in) :: val(ldv,*) + real(psb_dpk_), intent(inout) :: res + logical :: is_unit + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i,j,k, m4, jc + real(psb_dpk_) :: tmp, acc + + info = psb_success_ + if (is_unit) then + tmp = done + else + tmp = dzero + 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_d_hll_csnmi_inner + +end function psb_d_hll_csnmi diff --git a/ext/impl/psb_d_hll_csput.f90 b/ext/impl/psb_d_hll_csput.f90 new file mode 100644 index 00000000..064e6c59 --- /dev/null +++ b/ext/impl/psb_d_hll_csput.f90 @@ -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_d_hll_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_csput_a + implicit none + + class(psb_d_hll_sparse_mat), intent(inout) :: a + real(psb_dpk_), 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='d_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_d_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_d_hll_srch_upd(nz,ia,ja,val,a,& + & imin,imax,jmin,jmax,info) + + implicit none + + class(psb_d_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax + integer(psb_ipk_), intent(in) :: ia(:),ja(:) + real(psb_dpk_), 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='d_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_d_hll_srch_upd + +end subroutine psb_d_hll_csput_a diff --git a/ext/impl/psb_d_hll_cssm.f90 b/ext/impl/psb_d_hll_cssm.f90 new file mode 100644 index 00000000..f4f6e349 --- /dev/null +++ b/ext/impl/psb_d_hll_cssm.f90 @@ -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_d_hll_cssm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_cssm + implicit none + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), 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 + real(psb_dpk_), allocatable :: tmp(:,:), acc(:) + logical :: tra, ctra + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_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 psb_d_hll_cssv + implicit none + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), 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 + real(psb_dpk_) :: acc + real(psb_dpk_), allocatable :: tmp(:) + logical :: tra, ctra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='d_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) psb_d_hll_get_diag + implicit none + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), 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) = done + 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_d_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) = dzero + end do + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + +contains + + subroutine psb_d_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(*) + real(psb_dpk_), intent(in) :: val(ldv,*) + real(psb_dpk_), 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) = dzero + end if + end do + + end subroutine psb_d_hll_get_diag_inner + +end subroutine psb_d_hll_get_diag diff --git a/ext/impl/psb_d_hll_maxval.f90 b/ext/impl/psb_d_hll_maxval.f90 new file mode 100644 index 00000000..8408cc96 --- /dev/null +++ b/ext/impl/psb_d_hll_maxval.f90 @@ -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_d_hll_maxval(a) result(res) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_maxval + implicit none + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + if (a%is_dev()) call a%sync() + res = maxval(abs(a%val(:))) + if (a%is_unit()) res = max(res,done) + +end function psb_d_hll_maxval diff --git a/ext/impl/psb_d_hll_mold.f90 b/ext/impl/psb_d_hll_mold.f90 new file mode 100644 index 00000000..e9d721f0 --- /dev/null +++ b/ext/impl/psb_d_hll_mold.f90 @@ -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_hll_mold(a,b,info) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_mold + implicit none + class(psb_d_hll_sparse_mat), intent(in) :: a + class(psb_d_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_d_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_d_hll_mold diff --git a/ext/impl/psb_d_hll_print.f90 b/ext/impl/psb_d_hll_print.f90 new file mode 100644 index 00000000..93c56d5c --- /dev/null +++ b/ext/impl/psb_d_hll_print.f90 @@ -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_d_hll_print(iout,a,iv,head,ivr,ivc) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_print + implicit none + + integer(psb_ipk_), intent(in) :: iout + class(psb_d_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='d_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_d_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_d_hll_print diff --git a/ext/impl/psb_d_hll_reallocate_nz.f90 b/ext/impl/psb_d_hll_reallocate_nz.f90 new file mode 100644 index 00000000..7abdd58f --- /dev/null +++ b/ext/impl/psb_d_hll_reallocate_nz.f90 @@ -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_d_hll_reallocate_nz(nz,a) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_reallocate_nz + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_d_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm,nz_ + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='d_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_d_hll_reallocate_nz diff --git a/ext/impl/psb_d_hll_reinit.f90 b/ext/impl/psb_d_hll_reinit.f90 new file mode 100644 index 00000000..6a0f34fa --- /dev/null +++ b/ext/impl/psb_d_hll_reinit.f90 @@ -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_d_hll_reinit(a,clear) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_reinit + implicit none + + class(psb_d_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(:) = dzero + 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_d_hll_reinit diff --git a/ext/impl/psb_d_hll_rowsum.f90 b/ext/impl/psb_d_hll_rowsum.f90 new file mode 100644 index 00000000..bfa2d2e1 --- /dev/null +++ b/ext/impl/psb_d_hll_rowsum.f90 @@ -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_d_hll_rowsum(d,a) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_rowsum + implicit none + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), 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 = done + else + d = dzero + 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 d_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 d_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(*) + real(psb_dpk_), intent(in) :: val(ldv,*) + real(psb_dpk_), intent(inout) :: d(*) + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i,j,k, m4, jc + real(psb_dpk_) :: 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 d_hll_rowsum + +end subroutine psb_d_hll_rowsum diff --git a/ext/impl/psb_d_hll_scal.f90 b/ext/impl/psb_d_hll_scal.f90 new file mode 100644 index 00000000..ed9dd9ce --- /dev/null +++ b/ext/impl/psb_d_hll_scal.f90 @@ -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_d_hll_scal(d,a,info,side) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_scal + implicit none + class(psb_d_hll_sparse_mat), intent(inout) :: a + real(psb_dpk_), 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_d_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_d_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(*) + real(psb_dpk_), intent(in) :: d(*) + real(psb_dpk_), 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_d_hll_scal_inner + + +end subroutine psb_d_hll_scal diff --git a/ext/impl/psb_d_hll_scals.f90 b/ext/impl/psb_d_hll_scals.f90 new file mode 100644 index 00000000..8e05cddd --- /dev/null +++ b/ext/impl/psb_d_hll_scals.f90 @@ -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_d_hll_scals(d,a,info) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_hll_scals + implicit none + class(psb_d_hll_sparse_mat), intent(inout) :: a + real(psb_dpk_), 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_d_hll_scals diff --git a/ext/impl/psb_d_mv_dia_from_coo.f90 b/ext/impl/psb_d_mv_dia_from_coo.f90 new file mode 100644 index 00000000..e38e975a --- /dev/null +++ b/ext/impl/psb_d_mv_dia_from_coo.f90 @@ -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_d_mv_dia_from_coo(a,b,info) + + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_mv_dia_from_coo + implicit none + + class(psb_d_dia_sparse_mat), intent(inout) :: a + class(psb_d_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_d_mv_dia_from_coo diff --git a/ext/impl/psb_d_mv_dia_to_coo.f90 b/ext/impl/psb_d_mv_dia_to_coo.f90 new file mode 100644 index 00000000..d8ac7a69 --- /dev/null +++ b/ext/impl/psb_d_mv_dia_to_coo.f90 @@ -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_d_mv_dia_to_coo(a,b,info) + + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psb_d_mv_dia_to_coo + implicit none + + class(psb_d_dia_sparse_mat), intent(inout) :: a + class(psb_d_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_d_mv_dia_to_coo diff --git a/ext/impl/psb_d_mv_ell_from_coo.f90 b/ext/impl/psb_d_mv_ell_from_coo.f90 new file mode 100644 index 00000000..8f98daab --- /dev/null +++ b/ext/impl/psb_d_mv_ell_from_coo.f90 @@ -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_d_mv_ell_from_coo(a,b,info) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_mv_ell_from_coo + implicit none + + class(psb_d_ell_sparse_mat), intent(inout) :: a + class(psb_d_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_d_mv_ell_from_coo diff --git a/ext/impl/psb_d_mv_ell_from_fmt.f90 b/ext/impl/psb_d_mv_ell_from_fmt.f90 new file mode 100644 index 00000000..6589fd0a --- /dev/null +++ b/ext/impl/psb_d_mv_ell_from_fmt.f90 @@ -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_d_mv_ell_from_fmt(a,b,info) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_mv_ell_from_fmt + implicit none + + class(psb_d_ell_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: 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%mv_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 + 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_d_mv_ell_from_fmt diff --git a/ext/impl/psb_d_mv_ell_to_coo.f90 b/ext/impl/psb_d_mv_ell_to_coo.f90 new file mode 100644 index 00000000..a1220a6e --- /dev/null +++ b/ext/impl/psb_d_mv_ell_to_coo.f90 @@ -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_d_mv_ell_to_coo(a,b,info) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_mv_ell_to_coo + implicit none + + class(psb_d_ell_sparse_mat), intent(inout) :: a + class(psb_d_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_d_base_sparse_mat = a%psb_d_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_d_mv_ell_to_coo diff --git a/ext/impl/psb_d_mv_ell_to_fmt.f90 b/ext/impl/psb_d_mv_ell_to_fmt.f90 new file mode 100644 index 00000000..a5975360 --- /dev/null +++ b/ext/impl/psb_d_mv_ell_to_fmt.f90 @@ -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_d_mv_ell_to_fmt(a,b,info) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psb_d_mv_ell_to_fmt + implicit none + + class(psb_d_ell_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: 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%mv_to_coo(b,info) + ! Need to fix trivial copies! + type is (psb_d_ell_sparse_mat) + if (a%is_dev()) call a%sync() + b%psb_d_base_sparse_mat = a%psb_d_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_d_mv_ell_to_fmt diff --git a/ext/impl/psb_d_mv_hdia_from_coo.f90 b/ext/impl/psb_d_mv_hdia_from_coo.f90 new file mode 100644 index 00000000..68caea34 --- /dev/null +++ b/ext/impl/psb_d_mv_hdia_from_coo.f90 @@ -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_d_mv_hdia_from_coo(a,b,info) + + use psb_base_mod + use psb_d_hdia_mat_mod, psb_protect_name => psb_d_mv_hdia_from_coo + implicit none + + class(psb_d_hdia_sparse_mat), intent(inout) :: a + class(psb_d_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_d_mv_hdia_from_coo diff --git a/ext/impl/psb_d_mv_hdia_to_coo.f90 b/ext/impl/psb_d_mv_hdia_to_coo.f90 new file mode 100644 index 00000000..595e20a2 --- /dev/null +++ b/ext/impl/psb_d_mv_hdia_to_coo.f90 @@ -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_d_mv_hdia_to_coo(a,b,info) + + use psb_base_mod + use psb_d_hdia_mat_mod, psb_protect_name => psb_d_mv_hdia_to_coo + implicit none + + class(psb_d_hdia_sparse_mat), intent(inout) :: a + class(psb_d_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_d_mv_hdia_to_coo diff --git a/ext/impl/psb_d_mv_hll_from_coo.f90 b/ext/impl/psb_d_mv_hll_from_coo.f90 new file mode 100644 index 00000000..78faed4b --- /dev/null +++ b/ext/impl/psb_d_mv_hll_from_coo.f90 @@ -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_d_mv_hll_from_coo(a,b,info) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_mv_hll_from_coo + implicit none + + class(psb_d_hll_sparse_mat), intent(inout) :: a + class(psb_d_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_d_mv_hll_from_coo diff --git a/ext/impl/psb_d_mv_hll_from_fmt.f90 b/ext/impl/psb_d_mv_hll_from_fmt.f90 new file mode 100644 index 00000000..76a2f2fb --- /dev/null +++ b/ext/impl/psb_d_mv_hll_from_fmt.f90 @@ -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_mv_hll_from_fmt(a,b,info) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_mv_hll_from_fmt + implicit none + + class(psb_d_hll_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: 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%mv_from_coo(b,info) + + type is (psb_d_hll_sparse_mat) + if (b%is_dev()) call b%sync() + a%psb_d_base_sparse_mat = b%psb_d_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_d_mv_hll_from_fmt diff --git a/ext/impl/psb_d_mv_hll_to_coo.f90 b/ext/impl/psb_d_mv_hll_to_coo.f90 new file mode 100644 index 00000000..fbc9111b --- /dev/null +++ b/ext/impl/psb_d_mv_hll_to_coo.f90 @@ -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_d_mv_hll_to_coo(a,b,info) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_mv_hll_to_coo + implicit none + + class(psb_d_hll_sparse_mat), intent(inout) :: a + class(psb_d_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_d_mv_hll_to_coo diff --git a/ext/impl/psb_d_mv_hll_to_fmt.f90 b/ext/impl/psb_d_mv_hll_to_fmt.f90 new file mode 100644 index 00000000..8022b2e5 --- /dev/null +++ b/ext/impl/psb_d_mv_hll_to_fmt.f90 @@ -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_d_mv_hll_to_fmt(a,b,info) + + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psb_d_mv_hll_to_fmt + implicit none + + class(psb_d_hll_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: 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%mv_to_coo(b,info) + ! Need to fix trivial copies! + type is (psb_d_hll_sparse_mat) + if (a%is_dev()) call a%sync() + b%psb_d_base_sparse_mat = a%psb_d_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_d_mv_hll_to_fmt diff --git a/ext/impl/psb_s_cp_dia_from_coo.f90 b/ext/impl/psb_s_cp_dia_from_coo.f90 new file mode 100644 index 00000000..6d9a0749 --- /dev/null +++ b/ext/impl/psb_s_cp_dia_from_coo.f90 @@ -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_s_cp_dia_from_coo(a,b,info) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_cp_dia_from_coo + implicit none + + class(psb_s_dia_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_s_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_s_cp_dia_from_coo diff --git a/ext/impl/psb_s_cp_dia_to_coo.f90 b/ext/impl/psb_s_cp_dia_to_coo.f90 new file mode 100644 index 00000000..c0cd5d32 --- /dev/null +++ b/ext/impl/psb_s_cp_dia_to_coo.f90 @@ -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_s_cp_dia_to_coo(a,b,info) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_cp_dia_to_coo + implicit none + + class(psb_s_dia_sparse_mat), intent(in) :: a + class(psb_s_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_s_base_sparse_mat = a%psb_s_base_sparse_mat + + call psi_s_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_s_cp_dia_to_coo diff --git a/ext/impl/psb_s_cp_ell_from_coo.f90 b/ext/impl/psb_s_cp_ell_from_coo.f90 new file mode 100644 index 00000000..f178a05c --- /dev/null +++ b/ext/impl/psb_s_cp_ell_from_coo.f90 @@ -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_s_cp_ell_from_coo(a,b,info) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_cp_ell_from_coo + use psi_ext_util_mod + implicit none + + class(psb_s_ell_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_s_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_s_convert_ell_from_coo(a,b,info) + else + call b%cp_to_coo(tmp,info) + if (info == psb_success_) call psi_s_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_s_cp_ell_from_coo diff --git a/ext/impl/psb_s_cp_ell_from_fmt.f90 b/ext/impl/psb_s_cp_ell_from_fmt.f90 new file mode 100644 index 00000000..bffe3d85 --- /dev/null +++ b/ext/impl/psb_s_cp_ell_from_fmt.f90 @@ -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_s_cp_ell_from_fmt(a,b,info) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_cp_ell_from_fmt + implicit none + + class(psb_s_ell_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_s_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type (b) + type is (psb_s_coo_sparse_mat) + call a%cp_from_coo(b,info) + + type is (psb_s_ell_sparse_mat) + if (b%is_dev()) call b%sync() + a%psb_s_base_sparse_mat = b%psb_s_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_s_cp_ell_from_fmt diff --git a/ext/impl/psb_s_cp_ell_to_coo.f90 b/ext/impl/psb_s_cp_ell_to_coo.f90 new file mode 100644 index 00000000..b8acddfc --- /dev/null +++ b/ext/impl/psb_s_cp_ell_to_coo.f90 @@ -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_s_cp_ell_to_coo(a,b,info) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_cp_ell_to_coo + implicit none + + class(psb_s_ell_sparse_mat), intent(in) :: a + class(psb_s_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_s_base_sparse_mat = a%psb_s_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_s_cp_ell_to_coo diff --git a/ext/impl/psb_s_cp_ell_to_fmt.f90 b/ext/impl/psb_s_cp_ell_to_fmt.f90 new file mode 100644 index 00000000..58fe3756 --- /dev/null +++ b/ext/impl/psb_s_cp_ell_to_fmt.f90 @@ -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_s_cp_ell_to_fmt(a,b,info) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_cp_ell_to_fmt + implicit none + + class(psb_s_ell_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_s_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type (b) + type is (psb_s_coo_sparse_mat) + call a%cp_to_coo(b,info) + + type is (psb_s_ell_sparse_mat) + if (a%is_dev()) call a%sync() + + b%psb_s_base_sparse_mat = a%psb_s_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_s_cp_ell_to_fmt diff --git a/ext/impl/psb_s_cp_hdia_from_coo.f90 b/ext/impl/psb_s_cp_hdia_from_coo.f90 new file mode 100644 index 00000000..b3d427d9 --- /dev/null +++ b/ext/impl/psb_s_cp_hdia_from_coo.f90 @@ -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_s_cp_hdia_from_coo(a,b,info) + + use psb_base_mod + use psb_s_hdia_mat_mod, psb_protect_name => psb_s_cp_hdia_from_coo + implicit none + + class(psb_s_hdia_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_s_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_s_hdia_sparse_mat), intent(inout) :: a + class(psb_s_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_s_base_sparse_mat = tmp%psb_s_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_s_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_s_cp_hdia_from_coo diff --git a/ext/impl/psb_s_cp_hdia_to_coo.f90 b/ext/impl/psb_s_cp_hdia_to_coo.f90 new file mode 100644 index 00000000..8e90e236 --- /dev/null +++ b/ext/impl/psb_s_cp_hdia_to_coo.f90 @@ -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_s_cp_hdia_to_coo(a,b,info) + + use psb_base_mod + use psb_s_hdia_mat_mod, psb_protect_name => psb_s_cp_hdia_to_coo + use psi_ext_util_mod + implicit none + + class(psb_s_hdia_sparse_mat), intent(in) :: a + class(psb_s_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_s_base_sparse_mat = a%psb_s_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_s_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_s_cp_hdia_to_coo diff --git a/ext/impl/psb_s_cp_hll_from_coo.f90 b/ext/impl/psb_s_cp_hll_from_coo.f90 new file mode 100644 index 00000000..9d75f994 --- /dev/null +++ b/ext/impl/psb_s_cp_hll_from_coo.f90 @@ -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_s_cp_hll_from_coo(a,b,info) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_cp_hll_from_coo + implicit none + + class(psb_s_hll_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_s_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_s_cp_hll_from_coo diff --git a/ext/impl/psb_s_cp_hll_from_fmt.f90 b/ext/impl/psb_s_cp_hll_from_fmt.f90 new file mode 100644 index 00000000..8f010902 --- /dev/null +++ b/ext/impl/psb_s_cp_hll_from_fmt.f90 @@ -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_s_cp_hll_from_fmt(a,b,info) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_cp_hll_from_fmt + implicit none + + class(psb_s_hll_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_s_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type (b) + class is (psb_s_coo_sparse_mat) + call a%cp_from_coo(b,info) + + class is (psb_s_hll_sparse_mat) + ! write(0,*) 'From type_hll' + if (b%is_dev()) call b%sync() + + a%psb_s_base_sparse_mat = b%psb_s_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_s_cp_hll_from_fmt diff --git a/ext/impl/psb_s_cp_hll_to_coo.f90 b/ext/impl/psb_s_cp_hll_to_coo.f90 new file mode 100644 index 00000000..74502ba2 --- /dev/null +++ b/ext/impl/psb_s_cp_hll_to_coo.f90 @@ -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_s_cp_hll_to_coo(a,b,info) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_cp_hll_to_coo + implicit none + + class(psb_s_hll_sparse_mat), intent(in) :: a + class(psb_s_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_s_base_sparse_mat = a%psb_s_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(*) + real(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_s_cp_hll_to_coo diff --git a/ext/impl/psb_s_cp_hll_to_fmt.f90 b/ext/impl/psb_s_cp_hll_to_fmt.f90 new file mode 100644 index 00000000..f7adaa54 --- /dev/null +++ b/ext/impl/psb_s_cp_hll_to_fmt.f90 @@ -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_s_cp_hll_to_fmt(a,b,info) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_cp_hll_to_fmt + implicit none + + class(psb_s_hll_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_s_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type (b) + type is (psb_s_coo_sparse_mat) + call a%cp_to_coo(b,info) + + type is (psb_s_hll_sparse_mat) + if (a%is_dev()) call a%sync() + b%psb_s_base_sparse_mat = a%psb_s_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_s_cp_hll_to_fmt diff --git a/ext/impl/psb_s_dia_aclsum.f90 b/ext/impl/psb_s_dia_aclsum.f90 new file mode 100644 index 00000000..718a2424 --- /dev/null +++ b/ext/impl/psb_s_dia_aclsum.f90 @@ -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_s_dia_aclsum(d,a) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_dia_aclsum + implicit none + class(psb_s_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_s_dia_aclsum diff --git a/ext/impl/psb_s_dia_allocate_mnnz.f90 b/ext/impl/psb_s_dia_allocate_mnnz.f90 new file mode 100644 index 00000000..df56c4a6 --- /dev/null +++ b/ext/impl/psb_s_dia_allocate_mnnz.f90 @@ -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_s_dia_allocate_mnnz(m,n,a,nz) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_dia_allocate_mnnz + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_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_s_dia_allocate_mnnz diff --git a/ext/impl/psb_s_dia_arwsum.f90 b/ext/impl/psb_s_dia_arwsum.f90 new file mode 100644 index 00000000..5a974bbf --- /dev/null +++ b/ext/impl/psb_s_dia_arwsum.f90 @@ -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_s_dia_arwsum(d,a) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_dia_arwsum + implicit none + class(psb_s_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_s_dia_arwsum diff --git a/ext/impl/psb_s_dia_colsum.f90 b/ext/impl/psb_s_dia_colsum.f90 new file mode 100644 index 00000000..e60eb88f --- /dev/null +++ b/ext/impl/psb_s_dia_colsum.f90 @@ -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_s_dia_colsum(d,a) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_dia_colsum + implicit none + class(psb_s_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='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 = 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) + a%data(i,j) + enddo + enddo + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + +end subroutine psb_s_dia_colsum diff --git a/ext/impl/psb_s_dia_csgetptn.f90 b/ext/impl/psb_s_dia_csgetptn.f90 new file mode 100644 index 00000000..f946eb73 --- /dev/null +++ b/ext/impl/psb_s_dia_csgetptn.f90 @@ -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_s_dia_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_dia_csgetptn + implicit none + + class(psb_s_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 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_s_dia_csgetptn diff --git a/ext/impl/psb_s_dia_csgetrow.f90 b/ext/impl/psb_s_dia_csgetrow.f90 new file mode 100644 index 00000000..b79e2470 --- /dev/null +++ b/ext/impl/psb_s_dia_csgetrow.f90 @@ -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_s_dia_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_dia_csgetrow + implicit none + + class(psb_s_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(:) + real(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 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_s_dia_csgetrow diff --git a/ext/impl/psb_s_dia_csmm.f90 b/ext/impl/psb_s_dia_csmm.f90 new file mode 100644 index 00000000..9f586dbb --- /dev/null +++ b/ext/impl/psb_s_dia_csmm.f90 @@ -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_s_dia_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_dia_csmm + implicit none + class(psb_s_dia_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(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='s_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) 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_s_dia_csmm_inner + +end subroutine psb_s_dia_csmm diff --git a/ext/impl/psb_s_dia_csmv.f90 b/ext/impl/psb_s_dia_csmv.f90 new file mode 100644 index 00000000..1a23932e --- /dev/null +++ b/ext/impl/psb_s_dia_csmv.f90 @@ -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_s_dia_csmv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_dia_csmv + implicit none + class(psb_s_dia_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(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='s_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) 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_s_dia_csmv_inner + +end subroutine psb_s_dia_csmv diff --git a/ext/impl/psb_s_dia_get_diag.f90 b/ext/impl/psb_s_dia_get_diag.f90 new file mode 100644 index 00000000..5909c72a --- /dev/null +++ b/ext/impl/psb_s_dia_get_diag.f90 @@ -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_s_dia_get_diag(a,d,info) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_dia_get_diag + implicit none + class(psb_s_dia_sparse_mat), intent(in) :: a + real(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) = sone + 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) = szero + end do + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + +end subroutine psb_s_dia_get_diag diff --git a/ext/impl/psb_s_dia_maxval.f90 b/ext/impl/psb_s_dia_maxval.f90 new file mode 100644 index 00000000..5f672644 --- /dev/null +++ b/ext/impl/psb_s_dia_maxval.f90 @@ -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_s_dia_maxval(a) result(res) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_dia_maxval + implicit none + class(psb_s_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='s_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_s_dia_maxval diff --git a/ext/impl/psb_s_dia_mold.f90 b/ext/impl/psb_s_dia_mold.f90 new file mode 100644 index 00000000..a65379a4 --- /dev/null +++ b/ext/impl/psb_s_dia_mold.f90 @@ -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_s_dia_mold(a,b,info) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_dia_mold + implicit none + class(psb_s_dia_sparse_mat), intent(in) :: a + class(psb_s_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_s_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_s_dia_mold diff --git a/ext/impl/psb_s_dia_print.f90 b/ext/impl/psb_s_dia_print.f90 new file mode 100644 index 00000000..a0de1ba8 --- /dev/null +++ b/ext/impl/psb_s_dia_print.f90 @@ -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_s_dia_print(iout,a,iv,head,ivr,ivc) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_dia_print + implicit none + + integer(psb_ipk_), intent(in) :: iout + class(psb_s_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='s_dia_print' + logical, parameter :: debug=.false. + + class(psb_s_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 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_s_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_s_dia_print diff --git a/ext/impl/psb_s_dia_reallocate_nz.f90 b/ext/impl/psb_s_dia_reallocate_nz.f90 new file mode 100644 index 00000000..d37d9e5f --- /dev/null +++ b/ext/impl/psb_s_dia_reallocate_nz.f90 @@ -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_s_dia_reallocate_nz(nz,a) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_dia_reallocate_nz + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_s_dia_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm, ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='s_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_s_dia_reallocate_nz diff --git a/ext/impl/psb_s_dia_reinit.f90 b/ext/impl/psb_s_dia_reinit.f90 new file mode 100644 index 00000000..dd109783 --- /dev/null +++ b/ext/impl/psb_s_dia_reinit.f90 @@ -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_s_dia_reinit(a,clear) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_dia_reinit + implicit none + + class(psb_s_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(:,:) = szero + 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_s_dia_reinit diff --git a/ext/impl/psb_s_dia_rowsum.f90 b/ext/impl/psb_s_dia_rowsum.f90 new file mode 100644 index 00000000..3f32a2b2 --- /dev/null +++ b/ext/impl/psb_s_dia_rowsum.f90 @@ -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_s_dia_rowsum(d,a) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_dia_rowsum + implicit none + class(psb_s_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='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_s_dia_rowsum diff --git a/ext/impl/psb_s_dia_scal.f90 b/ext/impl/psb_s_dia_scal.f90 new file mode 100644 index 00000000..7ccf881a --- /dev/null +++ b/ext/impl/psb_s_dia_scal.f90 @@ -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_s_dia_scal(d,a,info,side) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_dia_scal + implicit none + class(psb_s_dia_sparse_mat), intent(inout) :: a + real(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_s_dia_scal diff --git a/ext/impl/psb_s_dia_scals.f90 b/ext/impl/psb_s_dia_scals.f90 new file mode 100644 index 00000000..da1bc94e --- /dev/null +++ b/ext/impl/psb_s_dia_scals.f90 @@ -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_s_dia_scals(d,a,info) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_dia_scals + implicit none + class(psb_s_dia_sparse_mat), intent(inout) :: a + real(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_s_dia_scals diff --git a/ext/impl/psb_s_dns_mat_impl.f90 b/ext/impl/psb_s_dns_mat_impl.f90 new file mode 100644 index 00000000..f6f458c8 --- /dev/null +++ b/ext/impl/psb_s_dns_mat_impl.f90 @@ -0,0 +1,724 @@ + +!> Function csmv: +!! \memberof psb_s_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_s_dns_csmv(alpha,a,x,beta,y,info,trans) + use psb_base_mod + use psb_s_dns_mat_mod, psb_protect_name => psb_s_dns_csmv + implicit none + class(psb_s_dns_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(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='s_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 sgemv(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_s_dns_csmv + + +!> Function csmm: +!! \memberof psb_s_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_s_dns_csmm(alpha,a,x,beta,y,info,trans) + use psb_base_mod + use psb_s_dns_mat_mod, psb_protect_name => psb_s_dns_csmm + implicit none + class(psb_s_dns_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(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='s_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 sgemm(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_s_dns_csmm + + + +! +! +!> Function csnmi: +!! \memberof psb_s_dns_sparse_mat +!! \brief Operator infinity norm +!! CSNMI = MAXVAL(SUM(ABS(A(:,:)),dim=2)) +!! +! +function psb_s_dns_csnmi(a) result(res) + use psb_base_mod + use psb_s_dns_mat_mod, psb_protect_name => psb_s_dns_csnmi + implicit none + class(psb_s_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_s_dns_csnmi + + +! +!> Function get_diag: +!! \memberof psb_s_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_s_dns_get_diag(a,d,info) + use psb_base_mod + use psb_s_dns_mat_mod, psb_protect_name => psb_s_dns_get_diag + implicit none + class(psb_s_dns_sparse_mat), intent(in) :: a + real(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) = szero + end do + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + +end subroutine psb_s_dns_get_diag + + +! +! +!> Function reallocate_nz +!! \memberof psb_s_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_s_dns_reallocate_nz(nz,a) + use psb_base_mod + use psb_s_dns_mat_mod, psb_protect_name => psb_s_dns_reallocate_nz + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_s_dns_sparse_mat), intent(inout) :: a + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='s_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_s_dns_reallocate_nz + +! +!> Function mold: +!! \memberof psb_s_dns_sparse_mat +!! \brief Allocate a class(psb_s_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_s_dns_mold(a,b,info) + use psb_base_mod + use psb_s_dns_mat_mod, psb_protect_name => psb_s_dns_mold + implicit none + class(psb_s_dns_sparse_mat), intent(in) :: a + class(psb_s_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_s_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_s_dns_mold + +! +! +!> Function allocate_mnnz +!! \memberof psb_s_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_s_dns_allocate_mnnz(m,n,a,nz) + use psb_base_mod + use psb_s_dns_mat_mod, psb_protect_name => psb_s_dns_allocate_mnnz + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_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 = szero + a%nnz = 0 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + +end subroutine psb_s_dns_allocate_mnnz + + +! +! +! +!> Function csgetrow: +!! \memberof psb_s_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_s_dns_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + use psb_base_mod + use psb_s_dns_mat_mod, psb_protect_name => psb_s_dns_csgetrow + implicit none + + class(psb_s_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(:) + real(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 Function trim +!! \memberof psb_s_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_s_dns_trim(a) + use psb_base_mod + use psb_s_dns_mat_mod, psb_protect_name => psb_s_dns_trim + implicit none + class(psb_s_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_s_dns_trim + +! +!> Function cp_from_coo: +!! \memberof psb_s_dns_sparse_mat +!! \brief Copy and convert from psb_s_coo_sparse_mat +!! Invoked from the target object. +!! \param b The input variable +!! \param info return code +! + +subroutine psb_s_cp_dns_from_coo(a,b,info) + use psb_base_mod + use psb_s_dns_mat_mod, psb_protect_name => psb_s_cp_dns_from_coo + implicit none + + class(psb_s_dns_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + ! + type(psb_s_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_s_base_sparse_mat = tmp%psb_s_base_sparse_mat + + call psb_realloc(nr,nc,a%val,info) + if (info /= 0) goto 9999 + a%val = szero + 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_s_base_sparse_mat = b%psb_s_base_sparse_mat + + call psb_realloc(nr,nc,a%val,info) + if (info /= 0) goto 9999 + a%val = szero + 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_s_cp_dns_from_coo + + + +! +!> Function cp_to_coo: +!! \memberof psb_s_dns_sparse_mat +!! \brief Copy and convert to psb_s_coo_sparse_mat +!! Invoked from the source object. +!! \param b The output variable +!! \param info return code +! + +subroutine psb_s_cp_dns_to_coo(a,b,info) + use psb_base_mod + use psb_s_dns_mat_mod, psb_protect_name => psb_s_cp_dns_to_coo + implicit none + + class(psb_s_dns_sparse_mat), intent(in) :: a + class(psb_s_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_s_base_sparse_mat = a%psb_s_base_sparse_mat + + k = 0 + do i=1,a%get_nrows() + do j=1,a%get_ncols() + if (a%val(i,j) /= szero) 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_s_cp_dns_to_coo + + + +! +!> Function mv_to_coo: +!! \memberof psb_s_dns_sparse_mat +!! \brief Convert to psb_s_coo_sparse_mat, freeing the source. +!! Invoked from the source object. +!! \param b The output variable +!! \param info return code +! +subroutine psb_s_mv_dns_to_coo(a,b,info) + use psb_base_mod + use psb_s_dns_mat_mod, psb_protect_name => psb_s_mv_dns_to_coo + implicit none + + class(psb_s_dns_sparse_mat), intent(inout) :: a + class(psb_s_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_s_mv_dns_to_coo + + +! +!> Function mv_from_coo: +!! \memberof psb_s_dns_sparse_mat +!! \brief Convert from psb_s_coo_sparse_mat, freeing the source. +!! Invoked from the target object. +!! \param b The input variable +!! \param info return code +! +! +subroutine psb_s_mv_dns_from_coo(a,b,info) + use psb_base_mod + use psb_s_dns_mat_mod, psb_protect_name => psb_s_mv_dns_from_coo + implicit none + + class(psb_s_dns_sparse_mat), intent(inout) :: a + class(psb_s_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_s_mv_dns_from_coo + diff --git a/ext/impl/psb_s_ell_aclsum.f90 b/ext/impl/psb_s_ell_aclsum.f90 new file mode 100644 index 00000000..2eea0cc9 --- /dev/null +++ b/ext/impl/psb_s_ell_aclsum.f90 @@ -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_s_ell_aclsum(d,a) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_aclsum + implicit none + class(psb_s_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_s_ell_aclsum diff --git a/ext/impl/psb_s_ell_allocate_mnnz.f90 b/ext/impl/psb_s_ell_allocate_mnnz.f90 new file mode 100644 index 00000000..fd9f1b49 --- /dev/null +++ b/ext/impl/psb_s_ell_allocate_mnnz.f90 @@ -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_s_ell_allocate_mnnz(m,n,a,nz) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_allocate_mnnz + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_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_s_ell_allocate_mnnz diff --git a/ext/impl/psb_s_ell_arwsum.f90 b/ext/impl/psb_s_ell_arwsum.f90 new file mode 100644 index 00000000..a47f8721 --- /dev/null +++ b/ext/impl/psb_s_ell_arwsum.f90 @@ -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_s_ell_arwsum(d,a) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_arwsum + implicit none + class(psb_s_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_s_ell_arwsum diff --git a/ext/impl/psb_s_ell_colsum.f90 b/ext/impl/psb_s_ell_colsum.f90 new file mode 100644 index 00000000..0924d8a9 --- /dev/null +++ b/ext/impl/psb_s_ell_colsum.f90 @@ -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_s_ell_colsum(d,a) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_colsum + implicit none + class(psb_s_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='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 = 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) + (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_s_ell_colsum diff --git a/ext/impl/psb_s_ell_csgetblk.f90 b/ext/impl/psb_s_ell_csgetblk.f90 new file mode 100644 index 00000000..5468e93c --- /dev/null +++ b/ext/impl/psb_s_ell_csgetblk.f90 @@ -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_s_ell_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_csgetblk + implicit none + + class(psb_s_ell_sparse_mat), intent(in) :: a + class(psb_s_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_s_ell_csgetblk diff --git a/ext/impl/psb_s_ell_csgetptn.f90 b/ext/impl/psb_s_ell_csgetptn.f90 new file mode 100644 index 00000000..07463757 --- /dev/null +++ b/ext/impl/psb_s_ell_csgetptn.f90 @@ -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_s_ell_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_csgetptn + implicit none + + class(psb_s_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 psb_s_ell_csgetrow + implicit none + + class(psb_s_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(:) + real(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 psb_s_ell_csmm + implicit none + class(psb_s_ell_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(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 + real(psb_spk_), allocatable :: acc(:) + logical :: tra, ctra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_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) psb_s_ell_csmv + implicit none + class(psb_s_ell_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(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 + real(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) psb_s_ell_csnm1 + + implicit none + class(psb_s_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='s_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_s_ell_csnm1 diff --git a/ext/impl/psb_s_ell_csnmi.f90 b/ext/impl/psb_s_ell_csnmi.f90 new file mode 100644 index 00000000..1df9bafa --- /dev/null +++ b/ext/impl/psb_s_ell_csnmi.f90 @@ -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_s_ell_csnmi(a) result(res) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_csnmi + implicit none + class(psb_s_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='s_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_s_ell_csnmi diff --git a/ext/impl/psb_s_ell_csput.f90 b/ext/impl/psb_s_ell_csput.f90 new file mode 100644 index 00000000..c0d69067 --- /dev/null +++ b/ext/impl/psb_s_ell_csput.f90 @@ -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_s_ell_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_csput_a + implicit none + + class(psb_s_ell_sparse_mat), intent(inout) :: a + real(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='s_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_s_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_s_ell_srch_upd(nz,ia,ja,val,a,& + & imin,imax,jmin,jmax,info) + + implicit none + + class(psb_s_ell_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax + integer(psb_ipk_), intent(in) :: ia(:),ja(:) + real(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='s_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_s_ell_srch_upd +end subroutine psb_s_ell_csput_a diff --git a/ext/impl/psb_s_ell_cssm.f90 b/ext/impl/psb_s_ell_cssm.f90 new file mode 100644 index 00000000..ca50fa35 --- /dev/null +++ b/ext/impl/psb_s_ell_cssm.f90 @@ -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_s_ell_cssm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_cssm + implicit none + class(psb_s_ell_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(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 + real(psb_spk_), allocatable :: tmp(:,:), acc(:) + logical :: tra, ctra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_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) psb_s_ell_cssv + implicit none + class(psb_s_ell_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(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 + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: tmp(:) + logical :: tra, ctra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_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) psb_s_ell_get_diag + implicit none + class(psb_s_ell_sparse_mat), intent(in) :: a + real(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) = sone + 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) = szero + end if + end do + end if + do i=mnm+1,size(d) + d(i) = szero + end do + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + +end subroutine psb_s_ell_get_diag diff --git a/ext/impl/psb_s_ell_maxval.f90 b/ext/impl/psb_s_ell_maxval.f90 new file mode 100644 index 00000000..6e2635b8 --- /dev/null +++ b/ext/impl/psb_s_ell_maxval.f90 @@ -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_s_ell_maxval(a) result(res) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_maxval + implicit none + class(psb_s_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='s_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_s_ell_maxval diff --git a/ext/impl/psb_s_ell_mold.f90 b/ext/impl/psb_s_ell_mold.f90 new file mode 100644 index 00000000..4d137112 --- /dev/null +++ b/ext/impl/psb_s_ell_mold.f90 @@ -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_s_ell_mold(a,b,info) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_mold + implicit none + class(psb_s_ell_sparse_mat), intent(in) :: a + class(psb_s_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_s_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_s_ell_mold diff --git a/ext/impl/psb_s_ell_print.f90 b/ext/impl/psb_s_ell_print.f90 new file mode 100644 index 00000000..aec15a6d --- /dev/null +++ b/ext/impl/psb_s_ell_print.f90 @@ -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_s_ell_print(iout,a,iv,head,ivr,ivc) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_print + implicit none + + integer(psb_ipk_), intent(in) :: iout + class(psb_s_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='s_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 real 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_s_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_s_ell_print diff --git a/ext/impl/psb_s_ell_reallocate_nz.f90 b/ext/impl/psb_s_ell_reallocate_nz.f90 new file mode 100644 index 00000000..ff7dabda --- /dev/null +++ b/ext/impl/psb_s_ell_reallocate_nz.f90 @@ -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_s_ell_reallocate_nz(nz,a) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_reallocate_nz + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_s_ell_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm, ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='s_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_s_ell_reallocate_nz diff --git a/ext/impl/psb_s_ell_reinit.f90 b/ext/impl/psb_s_ell_reinit.f90 new file mode 100644 index 00000000..088e8398 --- /dev/null +++ b/ext/impl/psb_s_ell_reinit.f90 @@ -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_s_ell_reinit(a,clear) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_reinit + implicit none + + class(psb_s_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(:,:) = szero + 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_s_ell_reinit diff --git a/ext/impl/psb_s_ell_rowsum.f90 b/ext/impl/psb_s_ell_rowsum.f90 new file mode 100644 index 00000000..092329c9 --- /dev/null +++ b/ext/impl/psb_s_ell_rowsum.f90 @@ -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_s_ell_rowsum(d,a) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_rowsum + implicit none + class(psb_s_ell_sparse_mat), intent(in) :: a + real(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) = sone + else + d(i) = szero + 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_s_ell_rowsum diff --git a/ext/impl/psb_s_ell_scal.f90 b/ext/impl/psb_s_ell_scal.f90 new file mode 100644 index 00000000..7f39f63d --- /dev/null +++ b/ext/impl/psb_s_ell_scal.f90 @@ -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_s_ell_scal(d,a,info,side) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_scal + implicit none + class(psb_s_ell_sparse_mat), intent(inout) :: a + real(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_s_ell_scal diff --git a/ext/impl/psb_s_ell_scals.f90 b/ext/impl/psb_s_ell_scals.f90 new file mode 100644 index 00000000..4bc77626 --- /dev/null +++ b/ext/impl/psb_s_ell_scals.f90 @@ -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_s_ell_scals(d,a,info) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_scals + implicit none + class(psb_s_ell_sparse_mat), intent(inout) :: a + real(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_s_ell_scals diff --git a/ext/impl/psb_s_ell_trim.f90 b/ext/impl/psb_s_ell_trim.f90 new file mode 100644 index 00000000..758a8bb5 --- /dev/null +++ b/ext/impl/psb_s_ell_trim.f90 @@ -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_s_ell_trim(a) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_ell_trim + implicit none + class(psb_s_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_s_ell_trim diff --git a/ext/impl/psb_s_hdia_allocate_mnnz.f90 b/ext/impl/psb_s_hdia_allocate_mnnz.f90 new file mode 100644 index 00000000..2c4e16fc --- /dev/null +++ b/ext/impl/psb_s_hdia_allocate_mnnz.f90 @@ -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_s_hdia_allocate_mnnz(m,n,a,nz) + + use psb_base_mod + use psb_s_hdia_mat_mod, psb_protect_name => psb_s_hdia_allocate_mnnz + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_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_s_hdia_allocate_mnnz diff --git a/ext/impl/psb_s_hdia_csmv.f90 b/ext/impl/psb_s_hdia_csmv.f90 new file mode 100644 index 00000000..d945f964 --- /dev/null +++ b/ext/impl/psb_s_hdia_csmv.f90 @@ -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_s_hdia_csmv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod + use psb_s_hdia_mat_mod, psb_protect_name => psb_s_hdia_csmv + implicit none + class(psb_s_hdia_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(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)=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_s_inner_dia_csmv + +end subroutine psb_s_hdia_csmv diff --git a/ext/impl/psb_s_hdia_mold.f90 b/ext/impl/psb_s_hdia_mold.f90 new file mode 100644 index 00000000..a62630c0 --- /dev/null +++ b/ext/impl/psb_s_hdia_mold.f90 @@ -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_s_hdia_mold(a,b,info) + + use psb_base_mod + use psb_s_hdia_mat_mod, psb_protect_name => psb_s_hdia_mold + implicit none + class(psb_s_hdia_sparse_mat), intent(in) :: a + class(psb_s_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_s_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_s_hdia_mold diff --git a/ext/impl/psb_s_hdia_print.f90 b/ext/impl/psb_s_hdia_print.f90 new file mode 100644 index 00000000..f4b927bc --- /dev/null +++ b/ext/impl/psb_s_hdia_print.f90 @@ -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_s_hdia_print(iout,a,iv,head,ivr,ivc) + + use psb_base_mod + use psb_s_hdia_mat_mod, psb_protect_name => psb_s_hdia_print + use psi_ext_util_mod + implicit none + + integer(psb_ipk_), intent(in) :: iout + class(psb_s_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_s_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(:) + real(psb_spk_), allocatable :: val(:) + + + write(iout,'(a)') '%%MatrixMarket matrix coordinate real 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_s_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_s_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_s_hdia_print diff --git a/ext/impl/psb_s_hll_aclsum.f90 b/ext/impl/psb_s_hll_aclsum.f90 new file mode 100644 index 00000000..cf75dfb2 --- /dev/null +++ b/ext/impl/psb_s_hll_aclsum.f90 @@ -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_s_hll_aclsum(d,a) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_aclsum + implicit none + class(psb_s_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 s_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 s_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(*) + real(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 + real(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 s_hll_aclsum + +end subroutine psb_s_hll_aclsum diff --git a/ext/impl/psb_s_hll_allocate_mnnz.f90 b/ext/impl/psb_s_hll_allocate_mnnz.f90 new file mode 100644 index 00000000..549eccb4 --- /dev/null +++ b/ext/impl/psb_s_hll_allocate_mnnz.f90 @@ -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_s_hll_allocate_mnnz(m,n,a,nz) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_allocate_mnnz + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_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_s_hll_allocate_mnnz diff --git a/ext/impl/psb_s_hll_arwsum.f90 b/ext/impl/psb_s_hll_arwsum.f90 new file mode 100644 index 00000000..b93efb12 --- /dev/null +++ b/ext/impl/psb_s_hll_arwsum.f90 @@ -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_s_hll_arwsum(d,a) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_arwsum + implicit none + class(psb_s_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 s_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 s_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(*) + real(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 + real(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 s_hll_arwsum + +end subroutine psb_s_hll_arwsum diff --git a/ext/impl/psb_s_hll_colsum.f90 b/ext/impl/psb_s_hll_colsum.f90 new file mode 100644 index 00000000..02cceac2 --- /dev/null +++ b/ext/impl/psb_s_hll_colsum.f90 @@ -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_s_hll_colsum(d,a) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_colsum + implicit none + class(psb_s_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='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 = 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 s_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 s_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(*) + real(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 + real(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 s_hll_colsum + +end subroutine psb_s_hll_colsum diff --git a/ext/impl/psb_s_hll_csgetblk.f90 b/ext/impl/psb_s_hll_csgetblk.f90 new file mode 100644 index 00000000..c925e3a2 --- /dev/null +++ b/ext/impl/psb_s_hll_csgetblk.f90 @@ -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_s_hll_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_csgetblk + implicit none + + class(psb_s_hll_sparse_mat), intent(in) :: a + class(psb_s_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_s_hll_csgetblk diff --git a/ext/impl/psb_s_hll_csgetptn.f90 b/ext/impl/psb_s_hll_csgetptn.f90 new file mode 100644 index 00000000..ccb1b6a1 --- /dev/null +++ b/ext/impl/psb_s_hll_csgetptn.f90 @@ -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_s_hll_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_csgetptn + implicit none + + class(psb_s_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 psb_s_hll_csgetrow + implicit none + + class(psb_s_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(:) + real(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 psb_s_hll_csmm + implicit none + class(psb_s_hll_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(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 + real(psb_spk_), allocatable :: acc(:) + logical :: tra, ctra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_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 psb_s_hll_csmv + implicit none + class(psb_s_hll_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(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='s_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) 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_s_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_s_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_s_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_s_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_s_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_s_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_s_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_s_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_s_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(*) + real(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + real(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 + real(psb_spk_) :: acc(4), tmp + + info = psb_success_ + if (tra) then + + if (beta == sone) 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 == sone) 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 (.not.(tra.or.ctra)) then + + if (alpha == szero) then + if (beta == szero) then + do i=1,m + y(ir+i-1) = szero + end do + else + do i=1,m + y(ir+i-1) = beta*y(ir+i-1) + end do + end if + + else + if (beta == szero) then + do i=1,m + tmp = szero + 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 = szero + 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_s_hll_csmv_inner + + subroutine psb_s_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_, szero, psb_success_ + implicit none + integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) + real(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + real(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 + real(psb_spk_) :: acc(4), tmp(m) + + info = psb_success_ + + + tmp(:) = szero + if (alpha /= szero) 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 == szero) 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_s_hll_csmv_notra_8 + + subroutine psb_s_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_, szero, psb_success_ + implicit none + integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) + real(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + real(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 + real(psb_spk_) :: acc(4), tmp(m) + + info = psb_success_ + + + tmp(:) = szero + if (alpha /= szero) 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 == szero) 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_s_hll_csmv_notra_24 + + subroutine psb_s_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_, szero, psb_success_ + implicit none + integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) + real(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + real(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 + real(psb_spk_) :: acc(4), tmp(m) + + info = psb_success_ + + + tmp(:) = szero + if (alpha /= szero) 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 == szero) 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_s_hll_csmv_notra_16 + + subroutine psb_s_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_, szero, psb_success_ + implicit none + integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) + real(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + real(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 + real(psb_spk_) :: acc(4), tmp(m) + + info = psb_success_ + + + tmp(:) = szero + if (alpha /= szero) 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 == szero) 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_s_hll_csmv_notra_32 + + subroutine psb_s_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_, szero, psb_success_ + implicit none + integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) + real(psb_spk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + real(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 + real(psb_spk_) :: acc(4), tmp(m) + + info = psb_success_ + + + tmp(:) = szero + if (alpha /= szero) 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 == szero) 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_s_hll_csmv_notra_4 + +end subroutine psb_s_hll_csmv diff --git a/ext/impl/psb_s_hll_csnm1.f90 b/ext/impl/psb_s_hll_csnm1.f90 new file mode 100644 index 00000000..6e745081 --- /dev/null +++ b/ext/impl/psb_s_hll_csnm1.f90 @@ -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_s_hll_csnm1(a) result(res) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_csnm1 + + implicit none + class(psb_s_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='s_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_s_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_s_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(*) + real(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_s_hll_csnm1_inner + +end function psb_s_hll_csnm1 diff --git a/ext/impl/psb_s_hll_csnmi.f90 b/ext/impl/psb_s_hll_csnmi.f90 new file mode 100644 index 00000000..3be15f9b --- /dev/null +++ b/ext/impl/psb_s_hll_csnmi.f90 @@ -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_s_hll_csnmi(a) result(res) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_csnmi + implicit none + class(psb_s_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='s_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_s_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_s_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(*) + real(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_s_hll_csnmi_inner + +end function psb_s_hll_csnmi diff --git a/ext/impl/psb_s_hll_csput.f90 b/ext/impl/psb_s_hll_csput.f90 new file mode 100644 index 00000000..b12678d4 --- /dev/null +++ b/ext/impl/psb_s_hll_csput.f90 @@ -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_s_hll_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_csput_a + implicit none + + class(psb_s_hll_sparse_mat), intent(inout) :: a + real(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='s_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_s_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_s_hll_srch_upd(nz,ia,ja,val,a,& + & imin,imax,jmin,jmax,info) + + implicit none + + class(psb_s_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: nz, imin,imax,jmin,jmax + integer(psb_ipk_), intent(in) :: ia(:),ja(:) + real(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='s_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_s_hll_srch_upd + +end subroutine psb_s_hll_csput_a diff --git a/ext/impl/psb_s_hll_cssm.f90 b/ext/impl/psb_s_hll_cssm.f90 new file mode 100644 index 00000000..30c77c8f --- /dev/null +++ b/ext/impl/psb_s_hll_cssm.f90 @@ -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_s_hll_cssm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_cssm + implicit none + class(psb_s_hll_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(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 + real(psb_spk_), allocatable :: tmp(:,:), acc(:) + logical :: tra, ctra + integer(psb_ipk_) :: err_act + character(len=20) :: name='s_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 psb_s_hll_cssv + implicit none + class(psb_s_hll_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(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 + real(psb_spk_) :: acc + real(psb_spk_), allocatable :: tmp(:) + logical :: tra, ctra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='s_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) psb_s_hll_get_diag + implicit none + class(psb_s_hll_sparse_mat), intent(in) :: a + real(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) = sone + 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_s_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) = szero + end do + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + +contains + + subroutine psb_s_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(*) + real(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 + + info = psb_success_ + + do i=1,m + if (idiag(i) /= 0) then + d(i) = val(i,idiag(i)) + else + d(i) = szero + end if + end do + + end subroutine psb_s_hll_get_diag_inner + +end subroutine psb_s_hll_get_diag diff --git a/ext/impl/psb_s_hll_maxval.f90 b/ext/impl/psb_s_hll_maxval.f90 new file mode 100644 index 00000000..84625328 --- /dev/null +++ b/ext/impl/psb_s_hll_maxval.f90 @@ -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_s_hll_maxval(a) result(res) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_maxval + implicit none + class(psb_s_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_s_hll_maxval diff --git a/ext/impl/psb_s_hll_mold.f90 b/ext/impl/psb_s_hll_mold.f90 new file mode 100644 index 00000000..eb04ccd9 --- /dev/null +++ b/ext/impl/psb_s_hll_mold.f90 @@ -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_s_hll_mold(a,b,info) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_mold + implicit none + class(psb_s_hll_sparse_mat), intent(in) :: a + class(psb_s_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_s_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_s_hll_mold diff --git a/ext/impl/psb_s_hll_print.f90 b/ext/impl/psb_s_hll_print.f90 new file mode 100644 index 00000000..fb6bb38d --- /dev/null +++ b/ext/impl/psb_s_hll_print.f90 @@ -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_s_hll_print(iout,a,iv,head,ivr,ivc) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_print + implicit none + + integer(psb_ipk_), intent(in) :: iout + class(psb_s_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='s_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_s_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_s_hll_print diff --git a/ext/impl/psb_s_hll_reallocate_nz.f90 b/ext/impl/psb_s_hll_reallocate_nz.f90 new file mode 100644 index 00000000..f7a3076f --- /dev/null +++ b/ext/impl/psb_s_hll_reallocate_nz.f90 @@ -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_s_hll_reallocate_nz(nz,a) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_reallocate_nz + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_s_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm,nz_ + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='s_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_s_hll_reallocate_nz diff --git a/ext/impl/psb_s_hll_reinit.f90 b/ext/impl/psb_s_hll_reinit.f90 new file mode 100644 index 00000000..170abe08 --- /dev/null +++ b/ext/impl/psb_s_hll_reinit.f90 @@ -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_s_hll_reinit(a,clear) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_reinit + implicit none + + class(psb_s_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(:) = szero + 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_s_hll_reinit diff --git a/ext/impl/psb_s_hll_rowsum.f90 b/ext/impl/psb_s_hll_rowsum.f90 new file mode 100644 index 00000000..c7484698 --- /dev/null +++ b/ext/impl/psb_s_hll_rowsum.f90 @@ -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_s_hll_rowsum(d,a) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_rowsum + implicit none + class(psb_s_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='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 = 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 s_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 s_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(*) + real(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 + real(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 s_hll_rowsum + +end subroutine psb_s_hll_rowsum diff --git a/ext/impl/psb_s_hll_scal.f90 b/ext/impl/psb_s_hll_scal.f90 new file mode 100644 index 00000000..c8f3ddd5 --- /dev/null +++ b/ext/impl/psb_s_hll_scal.f90 @@ -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_s_hll_scal(d,a,info,side) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_scal + implicit none + class(psb_s_hll_sparse_mat), intent(inout) :: a + real(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_s_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_s_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(*) + real(psb_spk_), intent(in) :: d(*) + real(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_s_hll_scal_inner + + +end subroutine psb_s_hll_scal diff --git a/ext/impl/psb_s_hll_scals.f90 b/ext/impl/psb_s_hll_scals.f90 new file mode 100644 index 00000000..8f823a20 --- /dev/null +++ b/ext/impl/psb_s_hll_scals.f90 @@ -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_s_hll_scals(d,a,info) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_hll_scals + implicit none + class(psb_s_hll_sparse_mat), intent(inout) :: a + real(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_s_hll_scals diff --git a/ext/impl/psb_s_mv_dia_from_coo.f90 b/ext/impl/psb_s_mv_dia_from_coo.f90 new file mode 100644 index 00000000..d7dcfc1b --- /dev/null +++ b/ext/impl/psb_s_mv_dia_from_coo.f90 @@ -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_s_mv_dia_from_coo(a,b,info) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_mv_dia_from_coo + implicit none + + class(psb_s_dia_sparse_mat), intent(inout) :: a + class(psb_s_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_s_mv_dia_from_coo diff --git a/ext/impl/psb_s_mv_dia_to_coo.f90 b/ext/impl/psb_s_mv_dia_to_coo.f90 new file mode 100644 index 00000000..c0944b21 --- /dev/null +++ b/ext/impl/psb_s_mv_dia_to_coo.f90 @@ -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_s_mv_dia_to_coo(a,b,info) + + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psb_s_mv_dia_to_coo + implicit none + + class(psb_s_dia_sparse_mat), intent(inout) :: a + class(psb_s_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_s_mv_dia_to_coo diff --git a/ext/impl/psb_s_mv_ell_from_coo.f90 b/ext/impl/psb_s_mv_ell_from_coo.f90 new file mode 100644 index 00000000..90965e41 --- /dev/null +++ b/ext/impl/psb_s_mv_ell_from_coo.f90 @@ -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_s_mv_ell_from_coo(a,b,info) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_mv_ell_from_coo + implicit none + + class(psb_s_ell_sparse_mat), intent(inout) :: a + class(psb_s_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_s_mv_ell_from_coo diff --git a/ext/impl/psb_s_mv_ell_from_fmt.f90 b/ext/impl/psb_s_mv_ell_from_fmt.f90 new file mode 100644 index 00000000..03ebf8e4 --- /dev/null +++ b/ext/impl/psb_s_mv_ell_from_fmt.f90 @@ -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_s_mv_ell_from_fmt(a,b,info) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_mv_ell_from_fmt + implicit none + + class(psb_s_ell_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_s_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type (b) + type is (psb_s_coo_sparse_mat) + call a%mv_from_coo(b,info) + + type is (psb_s_ell_sparse_mat) + if (b%is_dev()) call b%sync() + a%psb_s_base_sparse_mat = b%psb_s_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_s_mv_ell_from_fmt diff --git a/ext/impl/psb_s_mv_ell_to_coo.f90 b/ext/impl/psb_s_mv_ell_to_coo.f90 new file mode 100644 index 00000000..151cbeff --- /dev/null +++ b/ext/impl/psb_s_mv_ell_to_coo.f90 @@ -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_s_mv_ell_to_coo(a,b,info) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_mv_ell_to_coo + implicit none + + class(psb_s_ell_sparse_mat), intent(inout) :: a + class(psb_s_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_s_base_sparse_mat = a%psb_s_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_s_mv_ell_to_coo diff --git a/ext/impl/psb_s_mv_ell_to_fmt.f90 b/ext/impl/psb_s_mv_ell_to_fmt.f90 new file mode 100644 index 00000000..66f33508 --- /dev/null +++ b/ext/impl/psb_s_mv_ell_to_fmt.f90 @@ -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_s_mv_ell_to_fmt(a,b,info) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psb_s_mv_ell_to_fmt + implicit none + + class(psb_s_ell_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_s_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type (b) + type is (psb_s_coo_sparse_mat) + call a%mv_to_coo(b,info) + ! Need to fix trivial copies! + type is (psb_s_ell_sparse_mat) + if (a%is_dev()) call a%sync() + b%psb_s_base_sparse_mat = a%psb_s_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_s_mv_ell_to_fmt diff --git a/ext/impl/psb_s_mv_hdia_from_coo.f90 b/ext/impl/psb_s_mv_hdia_from_coo.f90 new file mode 100644 index 00000000..88765079 --- /dev/null +++ b/ext/impl/psb_s_mv_hdia_from_coo.f90 @@ -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_s_mv_hdia_from_coo(a,b,info) + + use psb_base_mod + use psb_s_hdia_mat_mod, psb_protect_name => psb_s_mv_hdia_from_coo + implicit none + + class(psb_s_hdia_sparse_mat), intent(inout) :: a + class(psb_s_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_s_mv_hdia_from_coo diff --git a/ext/impl/psb_s_mv_hdia_to_coo.f90 b/ext/impl/psb_s_mv_hdia_to_coo.f90 new file mode 100644 index 00000000..56399b2a --- /dev/null +++ b/ext/impl/psb_s_mv_hdia_to_coo.f90 @@ -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_s_mv_hdia_to_coo(a,b,info) + + use psb_base_mod + use psb_s_hdia_mat_mod, psb_protect_name => psb_s_mv_hdia_to_coo + implicit none + + class(psb_s_hdia_sparse_mat), intent(inout) :: a + class(psb_s_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_s_mv_hdia_to_coo diff --git a/ext/impl/psb_s_mv_hll_from_coo.f90 b/ext/impl/psb_s_mv_hll_from_coo.f90 new file mode 100644 index 00000000..c8e46086 --- /dev/null +++ b/ext/impl/psb_s_mv_hll_from_coo.f90 @@ -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_s_mv_hll_from_coo(a,b,info) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_mv_hll_from_coo + implicit none + + class(psb_s_hll_sparse_mat), intent(inout) :: a + class(psb_s_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_s_mv_hll_from_coo diff --git a/ext/impl/psb_s_mv_hll_from_fmt.f90 b/ext/impl/psb_s_mv_hll_from_fmt.f90 new file mode 100644 index 00000000..19bda0a6 --- /dev/null +++ b/ext/impl/psb_s_mv_hll_from_fmt.f90 @@ -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_s_mv_hll_from_fmt(a,b,info) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_mv_hll_from_fmt + implicit none + + class(psb_s_hll_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_s_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type (b) + type is (psb_s_coo_sparse_mat) + call a%mv_from_coo(b,info) + + type is (psb_s_hll_sparse_mat) + if (b%is_dev()) call b%sync() + a%psb_s_base_sparse_mat = b%psb_s_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_s_mv_hll_from_fmt diff --git a/ext/impl/psb_s_mv_hll_to_coo.f90 b/ext/impl/psb_s_mv_hll_to_coo.f90 new file mode 100644 index 00000000..d36286a5 --- /dev/null +++ b/ext/impl/psb_s_mv_hll_to_coo.f90 @@ -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_s_mv_hll_to_coo(a,b,info) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_mv_hll_to_coo + implicit none + + class(psb_s_hll_sparse_mat), intent(inout) :: a + class(psb_s_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_s_mv_hll_to_coo diff --git a/ext/impl/psb_s_mv_hll_to_fmt.f90 b/ext/impl/psb_s_mv_hll_to_fmt.f90 new file mode 100644 index 00000000..17618f69 --- /dev/null +++ b/ext/impl/psb_s_mv_hll_to_fmt.f90 @@ -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_s_mv_hll_to_fmt(a,b,info) + + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psb_s_mv_hll_to_fmt + implicit none + + class(psb_s_hll_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_s_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type (b) + type is (psb_s_coo_sparse_mat) + call a%mv_to_coo(b,info) + ! Need to fix trivial copies! + type is (psb_s_hll_sparse_mat) + if (a%is_dev()) call a%sync() + b%psb_s_base_sparse_mat = a%psb_s_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_s_mv_hll_to_fmt diff --git a/ext/impl/psb_z_cp_dia_from_coo.f90 b/ext/impl/psb_z_cp_dia_from_coo.f90 new file mode 100644 index 00000000..e87bfb34 --- /dev/null +++ b/ext/impl/psb_z_cp_dia_from_coo.f90 @@ -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_z_cp_dia_from_coo(a,b,info) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_cp_dia_from_coo + implicit none + + class(psb_z_dia_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_z_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_z_cp_dia_from_coo diff --git a/ext/impl/psb_z_cp_dia_to_coo.f90 b/ext/impl/psb_z_cp_dia_to_coo.f90 new file mode 100644 index 00000000..26fac30b --- /dev/null +++ b/ext/impl/psb_z_cp_dia_to_coo.f90 @@ -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_z_cp_dia_to_coo(a,b,info) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_cp_dia_to_coo + implicit none + + class(psb_z_dia_sparse_mat), intent(in) :: a + class(psb_z_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_z_base_sparse_mat = a%psb_z_base_sparse_mat + + call psi_z_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_z_cp_dia_to_coo diff --git a/ext/impl/psb_z_cp_ell_from_coo.f90 b/ext/impl/psb_z_cp_ell_from_coo.f90 new file mode 100644 index 00000000..7559621d --- /dev/null +++ b/ext/impl/psb_z_cp_ell_from_coo.f90 @@ -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_z_cp_ell_from_coo(a,b,info) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_cp_ell_from_coo + use psi_ext_util_mod + implicit none + + class(psb_z_ell_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_z_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_z_convert_ell_from_coo(a,b,info) + else + call b%cp_to_coo(tmp,info) + if (info == psb_success_) call psi_z_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_z_cp_ell_from_coo diff --git a/ext/impl/psb_z_cp_ell_from_fmt.f90 b/ext/impl/psb_z_cp_ell_from_fmt.f90 new file mode 100644 index 00000000..6d63b64e --- /dev/null +++ b/ext/impl/psb_z_cp_ell_from_fmt.f90 @@ -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_z_cp_ell_from_fmt(a,b,info) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_cp_ell_from_fmt + implicit none + + class(psb_z_ell_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_z_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type (b) + type is (psb_z_coo_sparse_mat) + call a%cp_from_coo(b,info) + + type is (psb_z_ell_sparse_mat) + if (b%is_dev()) call b%sync() + a%psb_z_base_sparse_mat = b%psb_z_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_z_cp_ell_from_fmt diff --git a/ext/impl/psb_z_cp_ell_to_coo.f90 b/ext/impl/psb_z_cp_ell_to_coo.f90 new file mode 100644 index 00000000..38a1696b --- /dev/null +++ b/ext/impl/psb_z_cp_ell_to_coo.f90 @@ -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_z_cp_ell_to_coo(a,b,info) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_cp_ell_to_coo + implicit none + + class(psb_z_ell_sparse_mat), intent(in) :: a + class(psb_z_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_z_base_sparse_mat = a%psb_z_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_z_cp_ell_to_coo diff --git a/ext/impl/psb_z_cp_ell_to_fmt.f90 b/ext/impl/psb_z_cp_ell_to_fmt.f90 new file mode 100644 index 00000000..7fb64a90 --- /dev/null +++ b/ext/impl/psb_z_cp_ell_to_fmt.f90 @@ -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_z_cp_ell_to_fmt(a,b,info) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_cp_ell_to_fmt + implicit none + + class(psb_z_ell_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_z_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type (b) + type is (psb_z_coo_sparse_mat) + call a%cp_to_coo(b,info) + + type is (psb_z_ell_sparse_mat) + if (a%is_dev()) call a%sync() + + b%psb_z_base_sparse_mat = a%psb_z_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_z_cp_ell_to_fmt diff --git a/ext/impl/psb_z_cp_hdia_from_coo.f90 b/ext/impl/psb_z_cp_hdia_from_coo.f90 new file mode 100644 index 00000000..ed77914e --- /dev/null +++ b/ext/impl/psb_z_cp_hdia_from_coo.f90 @@ -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_z_cp_hdia_from_coo(a,b,info) + + use psb_base_mod + use psb_z_hdia_mat_mod, psb_protect_name => psb_z_cp_hdia_from_coo + implicit none + + class(psb_z_hdia_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_z_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_z_hdia_sparse_mat), intent(inout) :: a + class(psb_z_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_z_base_sparse_mat = tmp%psb_z_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_z_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_z_cp_hdia_from_coo diff --git a/ext/impl/psb_z_cp_hdia_to_coo.f90 b/ext/impl/psb_z_cp_hdia_to_coo.f90 new file mode 100644 index 00000000..c0544ff0 --- /dev/null +++ b/ext/impl/psb_z_cp_hdia_to_coo.f90 @@ -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_z_cp_hdia_to_coo(a,b,info) + + use psb_base_mod + use psb_z_hdia_mat_mod, psb_protect_name => psb_z_cp_hdia_to_coo + use psi_ext_util_mod + implicit none + + class(psb_z_hdia_sparse_mat), intent(in) :: a + class(psb_z_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_z_base_sparse_mat = a%psb_z_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_z_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_z_cp_hdia_to_coo diff --git a/ext/impl/psb_z_cp_hll_from_coo.f90 b/ext/impl/psb_z_cp_hll_from_coo.f90 new file mode 100644 index 00000000..15a8d1c2 --- /dev/null +++ b/ext/impl/psb_z_cp_hll_from_coo.f90 @@ -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_z_cp_hll_from_coo(a,b,info) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_cp_hll_from_coo + implicit none + + class(psb_z_hll_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_z_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_z_cp_hll_from_coo diff --git a/ext/impl/psb_z_cp_hll_from_fmt.f90 b/ext/impl/psb_z_cp_hll_from_fmt.f90 new file mode 100644 index 00000000..3bdb2271 --- /dev/null +++ b/ext/impl/psb_z_cp_hll_from_fmt.f90 @@ -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_z_cp_hll_from_fmt(a,b,info) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_cp_hll_from_fmt + implicit none + + class(psb_z_hll_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_z_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type (b) + class is (psb_z_coo_sparse_mat) + call a%cp_from_coo(b,info) + + class is (psb_z_hll_sparse_mat) + ! write(0,*) 'From type_hll' + if (b%is_dev()) call b%sync() + + a%psb_z_base_sparse_mat = b%psb_z_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_z_cp_hll_from_fmt diff --git a/ext/impl/psb_z_cp_hll_to_coo.f90 b/ext/impl/psb_z_cp_hll_to_coo.f90 new file mode 100644 index 00000000..409fe7b5 --- /dev/null +++ b/ext/impl/psb_z_cp_hll_to_coo.f90 @@ -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_z_cp_hll_to_coo(a,b,info) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_cp_hll_to_coo + implicit none + + class(psb_z_hll_sparse_mat), intent(in) :: a + class(psb_z_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_z_base_sparse_mat = a%psb_z_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_dpk_) :: 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_z_cp_hll_to_coo diff --git a/ext/impl/psb_z_cp_hll_to_fmt.f90 b/ext/impl/psb_z_cp_hll_to_fmt.f90 new file mode 100644 index 00000000..b0417c92 --- /dev/null +++ b/ext/impl/psb_z_cp_hll_to_fmt.f90 @@ -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_z_cp_hll_to_fmt(a,b,info) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_cp_hll_to_fmt + implicit none + + class(psb_z_hll_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_z_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type (b) + type is (psb_z_coo_sparse_mat) + call a%cp_to_coo(b,info) + + type is (psb_z_hll_sparse_mat) + if (a%is_dev()) call a%sync() + b%psb_z_base_sparse_mat = a%psb_z_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_z_cp_hll_to_fmt diff --git a/ext/impl/psb_z_dia_aclsum.f90 b/ext/impl/psb_z_dia_aclsum.f90 new file mode 100644 index 00000000..5aed7ff0 --- /dev/null +++ b/ext/impl/psb_z_dia_aclsum.f90 @@ -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_z_dia_aclsum(d,a) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_dia_aclsum + implicit none + class(psb_z_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), 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 = done + else + d = dzero + 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_z_dia_aclsum diff --git a/ext/impl/psb_z_dia_allocate_mnnz.f90 b/ext/impl/psb_z_dia_allocate_mnnz.f90 new file mode 100644 index 00000000..e9c614f6 --- /dev/null +++ b/ext/impl/psb_z_dia_allocate_mnnz.f90 @@ -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_z_dia_allocate_mnnz(m,n,a,nz) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_dia_allocate_mnnz + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_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_z_dia_allocate_mnnz diff --git a/ext/impl/psb_z_dia_arwsum.f90 b/ext/impl/psb_z_dia_arwsum.f90 new file mode 100644 index 00000000..42805349 --- /dev/null +++ b/ext/impl/psb_z_dia_arwsum.f90 @@ -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_z_dia_arwsum(d,a) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_dia_arwsum + implicit none + class(psb_z_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), 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 = done + else + d = dzero + 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_z_dia_arwsum diff --git a/ext/impl/psb_z_dia_colsum.f90 b/ext/impl/psb_z_dia_colsum.f90 new file mode 100644 index 00000000..69919736 --- /dev/null +++ b/ext/impl/psb_z_dia_colsum.f90 @@ -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_z_dia_colsum(d,a) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_dia_colsum + implicit none + class(psb_z_dia_sparse_mat), intent(in) :: a + complex(psb_dpk_), 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 = zone + else + d = zzero + 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_z_dia_colsum diff --git a/ext/impl/psb_z_dia_csgetptn.f90 b/ext/impl/psb_z_dia_csgetptn.f90 new file mode 100644 index 00000000..d63304f8 --- /dev/null +++ b/ext/impl/psb_z_dia_csgetptn.f90 @@ -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_z_dia_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_dia_csgetptn + implicit none + + class(psb_z_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 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_z_dia_csgetptn diff --git a/ext/impl/psb_z_dia_csgetrow.f90 b/ext/impl/psb_z_dia_csgetrow.f90 new file mode 100644 index 00000000..6571264e --- /dev/null +++ b/ext/impl/psb_z_dia_csgetrow.f90 @@ -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_z_dia_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_dia_csgetrow + implicit none + + class(psb_z_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_dpk_), 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 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_z_dia_csgetrow diff --git a/ext/impl/psb_z_dia_csmm.f90 b/ext/impl/psb_z_dia_csmm.f90 new file mode 100644 index 00000000..cbebd10e --- /dev/null +++ b/ext/impl/psb_z_dia_csmm.f90 @@ -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_z_dia_csmm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_dia_csmm + implicit none + class(psb_z_dia_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), 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='z_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) 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_z_dia_csmm_inner + +end subroutine psb_z_dia_csmm diff --git a/ext/impl/psb_z_dia_csmv.f90 b/ext/impl/psb_z_dia_csmv.f90 new file mode 100644 index 00000000..9d1f5a2a --- /dev/null +++ b/ext/impl/psb_z_dia_csmv.f90 @@ -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_z_dia_csmv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_dia_csmv + implicit none + class(psb_z_dia_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), 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='z_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) 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_z_dia_csmv_inner + +end subroutine psb_z_dia_csmv diff --git a/ext/impl/psb_z_dia_get_diag.f90 b/ext/impl/psb_z_dia_get_diag.f90 new file mode 100644 index 00000000..9b403923 --- /dev/null +++ b/ext/impl/psb_z_dia_get_diag.f90 @@ -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_z_dia_get_diag(a,d,info) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_dia_get_diag + implicit none + class(psb_z_dia_sparse_mat), intent(in) :: a + complex(psb_dpk_), 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) = zone + 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) = zzero + end do + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + +end subroutine psb_z_dia_get_diag diff --git a/ext/impl/psb_z_dia_maxval.f90 b/ext/impl/psb_z_dia_maxval.f90 new file mode 100644 index 00000000..d3518c17 --- /dev/null +++ b/ext/impl/psb_z_dia_maxval.f90 @@ -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_z_dia_maxval(a) result(res) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_dia_maxval + implicit none + class(psb_z_dia_sparse_mat), intent(in) :: a + real(psb_dpk_) :: 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='z_maxval' + logical, parameter :: debug=.false. + + if (a%is_dev()) call a%sync() + if (a%is_unit()) then + res = done + else + res = dzero + end if + + res = max(res,maxval(abs(a%data))) + +end function psb_z_dia_maxval diff --git a/ext/impl/psb_z_dia_mold.f90 b/ext/impl/psb_z_dia_mold.f90 new file mode 100644 index 00000000..421af284 --- /dev/null +++ b/ext/impl/psb_z_dia_mold.f90 @@ -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_z_dia_mold(a,b,info) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_dia_mold + implicit none + class(psb_z_dia_sparse_mat), intent(in) :: a + class(psb_z_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_z_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_z_dia_mold diff --git a/ext/impl/psb_z_dia_print.f90 b/ext/impl/psb_z_dia_print.f90 new file mode 100644 index 00000000..1f7853ef --- /dev/null +++ b/ext/impl/psb_z_dia_print.f90 @@ -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_z_dia_print(iout,a,iv,head,ivr,ivc) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_dia_print + implicit none + + integer(psb_ipk_), intent(in) :: iout + class(psb_z_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='z_dia_print' + logical, parameter :: debug=.false. + + class(psb_z_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_z_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_z_dia_print diff --git a/ext/impl/psb_z_dia_reallocate_nz.f90 b/ext/impl/psb_z_dia_reallocate_nz.f90 new file mode 100644 index 00000000..2d204a64 --- /dev/null +++ b/ext/impl/psb_z_dia_reallocate_nz.f90 @@ -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_z_dia_reallocate_nz(nz,a) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_dia_reallocate_nz + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_z_dia_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm, ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='z_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_z_dia_reallocate_nz diff --git a/ext/impl/psb_z_dia_reinit.f90 b/ext/impl/psb_z_dia_reinit.f90 new file mode 100644 index 00000000..0f58a9ed --- /dev/null +++ b/ext/impl/psb_z_dia_reinit.f90 @@ -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_z_dia_reinit(a,clear) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_dia_reinit + implicit none + + class(psb_z_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(:,:) = zzero + 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_z_dia_reinit diff --git a/ext/impl/psb_z_dia_rowsum.f90 b/ext/impl/psb_z_dia_rowsum.f90 new file mode 100644 index 00000000..6918ada1 --- /dev/null +++ b/ext/impl/psb_z_dia_rowsum.f90 @@ -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_z_dia_rowsum(d,a) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_dia_rowsum + implicit none + class(psb_z_dia_sparse_mat), intent(in) :: a + complex(psb_dpk_), 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 = done + else + d = dzero + 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_z_dia_rowsum diff --git a/ext/impl/psb_z_dia_scal.f90 b/ext/impl/psb_z_dia_scal.f90 new file mode 100644 index 00000000..65957e60 --- /dev/null +++ b/ext/impl/psb_z_dia_scal.f90 @@ -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_z_dia_scal(d,a,info,side) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_dia_scal + implicit none + class(psb_z_dia_sparse_mat), intent(inout) :: a + complex(psb_dpk_), 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_z_dia_scal diff --git a/ext/impl/psb_z_dia_scals.f90 b/ext/impl/psb_z_dia_scals.f90 new file mode 100644 index 00000000..895763d9 --- /dev/null +++ b/ext/impl/psb_z_dia_scals.f90 @@ -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_z_dia_scals(d,a,info) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_dia_scals + implicit none + class(psb_z_dia_sparse_mat), intent(inout) :: a + complex(psb_dpk_), 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_z_dia_scals diff --git a/ext/impl/psb_z_dns_mat_impl.f90 b/ext/impl/psb_z_dns_mat_impl.f90 new file mode 100644 index 00000000..b249a3f2 --- /dev/null +++ b/ext/impl/psb_z_dns_mat_impl.f90 @@ -0,0 +1,724 @@ + +!> Function csmv: +!! \memberof psb_z_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_z_dns_csmv(alpha,a,x,beta,y,info,trans) + use psb_base_mod + use psb_z_dns_mat_mod, psb_protect_name => psb_z_dns_csmv + implicit none + class(psb_z_dns_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), 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='z_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 zgemv(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_z_dns_csmv + + +!> Function csmm: +!! \memberof psb_z_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_z_dns_csmm(alpha,a,x,beta,y,info,trans) + use psb_base_mod + use psb_z_dns_mat_mod, psb_protect_name => psb_z_dns_csmm + implicit none + class(psb_z_dns_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), 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='z_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 zgemm(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_z_dns_csmm + + + +! +! +!> Function csnmi: +!! \memberof psb_z_dns_sparse_mat +!! \brief Operator infinity norm +!! CSNMI = MAXVAL(SUM(ABS(A(:,:)),dim=2)) +!! +! +function psb_z_dns_csnmi(a) result(res) + use psb_base_mod + use psb_z_dns_mat_mod, psb_protect_name => psb_z_dns_csnmi + implicit none + class(psb_z_dns_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + ! + integer(psb_ipk_) :: i + real(psb_dpk_) :: acc + + res = dzero + 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_z_dns_csnmi + + +! +!> Function get_diag: +!! \memberof psb_z_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_z_dns_get_diag(a,d,info) + use psb_base_mod + use psb_z_dns_mat_mod, psb_protect_name => psb_z_dns_get_diag + implicit none + class(psb_z_dns_sparse_mat), intent(in) :: a + complex(psb_dpk_), 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) = zzero + end do + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + +end subroutine psb_z_dns_get_diag + + +! +! +!> Function reallocate_nz +!! \memberof psb_z_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_z_dns_reallocate_nz(nz,a) + use psb_base_mod + use psb_z_dns_mat_mod, psb_protect_name => psb_z_dns_reallocate_nz + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_z_dns_sparse_mat), intent(inout) :: a + ! + integer(psb_ipk_) :: err_act + character(len=20) :: name='z_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_z_dns_reallocate_nz + +! +!> Function mold: +!! \memberof psb_z_dns_sparse_mat +!! \brief Allocate a class(psb_z_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_z_dns_mold(a,b,info) + use psb_base_mod + use psb_z_dns_mat_mod, psb_protect_name => psb_z_dns_mold + implicit none + class(psb_z_dns_sparse_mat), intent(in) :: a + class(psb_z_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_z_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_z_dns_mold + +! +! +!> Function allocate_mnnz +!! \memberof psb_z_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_z_dns_allocate_mnnz(m,n,a,nz) + use psb_base_mod + use psb_z_dns_mat_mod, psb_protect_name => psb_z_dns_allocate_mnnz + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_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 = zzero + a%nnz = 0 + end if + + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + +end subroutine psb_z_dns_allocate_mnnz + + +! +! +! +!> Function csgetrow: +!! \memberof psb_z_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_z_dns_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + use psb_base_mod + use psb_z_dns_mat_mod, psb_protect_name => psb_z_dns_csgetrow + implicit none + + class(psb_z_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_dpk_), 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 Function trim +!! \memberof psb_z_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_z_dns_trim(a) + use psb_base_mod + use psb_z_dns_mat_mod, psb_protect_name => psb_z_dns_trim + implicit none + class(psb_z_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_z_dns_trim + +! +!> Function cp_from_coo: +!! \memberof psb_z_dns_sparse_mat +!! \brief Copy and convert from psb_z_coo_sparse_mat +!! Invoked from the target object. +!! \param b The input variable +!! \param info return code +! + +subroutine psb_z_cp_dns_from_coo(a,b,info) + use psb_base_mod + use psb_z_dns_mat_mod, psb_protect_name => psb_z_cp_dns_from_coo + implicit none + + class(psb_z_dns_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + ! + type(psb_z_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_z_base_sparse_mat = tmp%psb_z_base_sparse_mat + + call psb_realloc(nr,nc,a%val,info) + if (info /= 0) goto 9999 + a%val = zzero + 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_z_base_sparse_mat = b%psb_z_base_sparse_mat + + call psb_realloc(nr,nc,a%val,info) + if (info /= 0) goto 9999 + a%val = zzero + 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_z_cp_dns_from_coo + + + +! +!> Function cp_to_coo: +!! \memberof psb_z_dns_sparse_mat +!! \brief Copy and convert to psb_z_coo_sparse_mat +!! Invoked from the source object. +!! \param b The output variable +!! \param info return code +! + +subroutine psb_z_cp_dns_to_coo(a,b,info) + use psb_base_mod + use psb_z_dns_mat_mod, psb_protect_name => psb_z_cp_dns_to_coo + implicit none + + class(psb_z_dns_sparse_mat), intent(in) :: a + class(psb_z_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_z_base_sparse_mat = a%psb_z_base_sparse_mat + + k = 0 + do i=1,a%get_nrows() + do j=1,a%get_ncols() + if (a%val(i,j) /= zzero) 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_z_cp_dns_to_coo + + + +! +!> Function mv_to_coo: +!! \memberof psb_z_dns_sparse_mat +!! \brief Convert to psb_z_coo_sparse_mat, freeing the source. +!! Invoked from the source object. +!! \param b The output variable +!! \param info return code +! +subroutine psb_z_mv_dns_to_coo(a,b,info) + use psb_base_mod + use psb_z_dns_mat_mod, psb_protect_name => psb_z_mv_dns_to_coo + implicit none + + class(psb_z_dns_sparse_mat), intent(inout) :: a + class(psb_z_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_z_mv_dns_to_coo + + +! +!> Function mv_from_coo: +!! \memberof psb_z_dns_sparse_mat +!! \brief Convert from psb_z_coo_sparse_mat, freeing the source. +!! Invoked from the target object. +!! \param b The input variable +!! \param info return code +! +! +subroutine psb_z_mv_dns_from_coo(a,b,info) + use psb_base_mod + use psb_z_dns_mat_mod, psb_protect_name => psb_z_mv_dns_from_coo + implicit none + + class(psb_z_dns_sparse_mat), intent(inout) :: a + class(psb_z_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_z_mv_dns_from_coo + diff --git a/ext/impl/psb_z_ell_aclsum.f90 b/ext/impl/psb_z_ell_aclsum.f90 new file mode 100644 index 00000000..b03121fd --- /dev/null +++ b/ext/impl/psb_z_ell_aclsum.f90 @@ -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_z_ell_aclsum(d,a) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_aclsum + implicit none + class(psb_z_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), 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 = done + else + d = dzero + 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_z_ell_aclsum diff --git a/ext/impl/psb_z_ell_allocate_mnnz.f90 b/ext/impl/psb_z_ell_allocate_mnnz.f90 new file mode 100644 index 00000000..f7f7f67e --- /dev/null +++ b/ext/impl/psb_z_ell_allocate_mnnz.f90 @@ -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_z_ell_allocate_mnnz(m,n,a,nz) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_allocate_mnnz + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_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_z_ell_allocate_mnnz diff --git a/ext/impl/psb_z_ell_arwsum.f90 b/ext/impl/psb_z_ell_arwsum.f90 new file mode 100644 index 00000000..9d4b4949 --- /dev/null +++ b/ext/impl/psb_z_ell_arwsum.f90 @@ -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_z_ell_arwsum(d,a) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_arwsum + implicit none + class(psb_z_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), 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) = done + else + d(i) = dzero + 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_z_ell_arwsum diff --git a/ext/impl/psb_z_ell_colsum.f90 b/ext/impl/psb_z_ell_colsum.f90 new file mode 100644 index 00000000..e9c2bc0b --- /dev/null +++ b/ext/impl/psb_z_ell_colsum.f90 @@ -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_z_ell_colsum(d,a) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_colsum + implicit none + class(psb_z_ell_sparse_mat), intent(in) :: a + complex(psb_dpk_), 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 = zone + else + d = zzero + 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_z_ell_colsum diff --git a/ext/impl/psb_z_ell_csgetblk.f90 b/ext/impl/psb_z_ell_csgetblk.f90 new file mode 100644 index 00000000..d2e56e1d --- /dev/null +++ b/ext/impl/psb_z_ell_csgetblk.f90 @@ -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_z_ell_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_csgetblk + implicit none + + class(psb_z_ell_sparse_mat), intent(in) :: a + class(psb_z_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_z_ell_csgetblk diff --git a/ext/impl/psb_z_ell_csgetptn.f90 b/ext/impl/psb_z_ell_csgetptn.f90 new file mode 100644 index 00000000..97ed7d90 --- /dev/null +++ b/ext/impl/psb_z_ell_csgetptn.f90 @@ -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_z_ell_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_csgetptn + implicit none + + class(psb_z_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 psb_z_ell_csgetrow + implicit none + + class(psb_z_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_dpk_), 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 psb_z_ell_csmm + implicit none + class(psb_z_ell_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), 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_dpk_), allocatable :: acc(:) + logical :: tra, ctra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_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) psb_z_ell_csmv + implicit none + class(psb_z_ell_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), 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_dpk_) :: 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) psb_z_ell_csnm1 + + implicit none + class(psb_z_ell_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info + real(psb_dpk_), allocatable :: vt(:) + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_ell_csnm1' + logical, parameter :: debug=.false. + + + if (a%is_dev()) call a%sync() + res = dzero + 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(:) = done + else + vt(:) = dzero + 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_z_ell_csnm1 diff --git a/ext/impl/psb_z_ell_csnmi.f90 b/ext/impl/psb_z_ell_csnmi.f90 new file mode 100644 index 00000000..ecbfb1e1 --- /dev/null +++ b/ext/impl/psb_z_ell_csnmi.f90 @@ -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_z_ell_csnmi(a) result(res) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_csnmi + implicit none + class(psb_z_ell_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer(psb_ipk_) :: i,j,k,m,n, nr, ir, jc, nc + real(psb_dpk_) :: acc + logical :: tra, is_unit + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_csnmi' + logical, parameter :: debug=.false. + + + if (a%is_dev()) call a%sync() + res = dzero + is_unit = a%is_unit() + do i = 1, a%get_nrows() + acc = sum(abs(a%val(i,:))) + if (is_unit) acc = acc + done + res = max(res,acc) + end do + +end function psb_z_ell_csnmi diff --git a/ext/impl/psb_z_ell_csput.f90 b/ext/impl/psb_z_ell_csput.f90 new file mode 100644 index 00000000..cf45070f --- /dev/null +++ b/ext/impl/psb_z_ell_csput.f90 @@ -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_z_ell_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_csput_a + implicit none + + class(psb_z_ell_sparse_mat), intent(inout) :: a + complex(psb_dpk_), 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='z_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_z_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_z_ell_srch_upd(nz,ia,ja,val,a,& + & imin,imax,jmin,jmax,info) + + implicit none + + class(psb_z_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_dpk_), 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='z_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_z_ell_srch_upd +end subroutine psb_z_ell_csput_a diff --git a/ext/impl/psb_z_ell_cssm.f90 b/ext/impl/psb_z_ell_cssm.f90 new file mode 100644 index 00000000..2e26c656 --- /dev/null +++ b/ext/impl/psb_z_ell_cssm.f90 @@ -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_z_ell_cssm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_cssm + implicit none + class(psb_z_ell_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), 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_dpk_), allocatable :: tmp(:,:), acc(:) + logical :: tra, ctra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_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) psb_z_ell_cssv + implicit none + class(psb_z_ell_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), 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_dpk_) :: acc + complex(psb_dpk_), allocatable :: tmp(:) + logical :: tra, ctra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_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) psb_z_ell_get_diag + implicit none + class(psb_z_ell_sparse_mat), intent(in) :: a + complex(psb_dpk_), 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) = zone + 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) = zzero + end if + end do + end if + do i=mnm+1,size(d) + d(i) = zzero + end do + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + +end subroutine psb_z_ell_get_diag diff --git a/ext/impl/psb_z_ell_maxval.f90 b/ext/impl/psb_z_ell_maxval.f90 new file mode 100644 index 00000000..9596f124 --- /dev/null +++ b/ext/impl/psb_z_ell_maxval.f90 @@ -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_z_ell_maxval(a) result(res) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_maxval + implicit none + class(psb_z_ell_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer(psb_ipk_) :: i,j,k,m,n, nr, ir, jc, nc + real(psb_dpk_) :: acc + logical :: tra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_csnmi' + logical, parameter :: debug=.false. + + if (a%is_dev()) call a%sync() + if (a%is_unit()) then + res = done + else + res = dzero + end if + + do i = 1, a%get_nrows() + acc = maxval(abs(a%val(i,:))) + res = max(res,acc) + end do + +end function psb_z_ell_maxval diff --git a/ext/impl/psb_z_ell_mold.f90 b/ext/impl/psb_z_ell_mold.f90 new file mode 100644 index 00000000..3e1db6cc --- /dev/null +++ b/ext/impl/psb_z_ell_mold.f90 @@ -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_z_ell_mold(a,b,info) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_mold + implicit none + class(psb_z_ell_sparse_mat), intent(in) :: a + class(psb_z_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_z_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_z_ell_mold diff --git a/ext/impl/psb_z_ell_print.f90 b/ext/impl/psb_z_ell_print.f90 new file mode 100644 index 00000000..502abb94 --- /dev/null +++ b/ext/impl/psb_z_ell_print.f90 @@ -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_z_ell_print(iout,a,iv,head,ivr,ivc) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_print + implicit none + + integer(psb_ipk_), intent(in) :: iout + class(psb_z_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='z_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_z_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_z_ell_print diff --git a/ext/impl/psb_z_ell_reallocate_nz.f90 b/ext/impl/psb_z_ell_reallocate_nz.f90 new file mode 100644 index 00000000..58237508 --- /dev/null +++ b/ext/impl/psb_z_ell_reallocate_nz.f90 @@ -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_z_ell_reallocate_nz(nz,a) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_reallocate_nz + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_z_ell_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm, ld + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='z_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_z_ell_reallocate_nz diff --git a/ext/impl/psb_z_ell_reinit.f90 b/ext/impl/psb_z_ell_reinit.f90 new file mode 100644 index 00000000..d73620d8 --- /dev/null +++ b/ext/impl/psb_z_ell_reinit.f90 @@ -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_z_ell_reinit(a,clear) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_reinit + implicit none + + class(psb_z_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(:,:) = zzero + 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_z_ell_reinit diff --git a/ext/impl/psb_z_ell_rowsum.f90 b/ext/impl/psb_z_ell_rowsum.f90 new file mode 100644 index 00000000..60eb70af --- /dev/null +++ b/ext/impl/psb_z_ell_rowsum.f90 @@ -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_z_ell_rowsum(d,a) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_rowsum + implicit none + class(psb_z_ell_sparse_mat), intent(in) :: a + complex(psb_dpk_), 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) = zone + else + d(i) = zzero + 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_z_ell_rowsum diff --git a/ext/impl/psb_z_ell_scal.f90 b/ext/impl/psb_z_ell_scal.f90 new file mode 100644 index 00000000..7f2f8944 --- /dev/null +++ b/ext/impl/psb_z_ell_scal.f90 @@ -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_z_ell_scal(d,a,info,side) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_scal + implicit none + class(psb_z_ell_sparse_mat), intent(inout) :: a + complex(psb_dpk_), 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_z_ell_scal diff --git a/ext/impl/psb_z_ell_scals.f90 b/ext/impl/psb_z_ell_scals.f90 new file mode 100644 index 00000000..4086d8cc --- /dev/null +++ b/ext/impl/psb_z_ell_scals.f90 @@ -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_z_ell_scals(d,a,info) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_scals + implicit none + class(psb_z_ell_sparse_mat), intent(inout) :: a + complex(psb_dpk_), 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_z_ell_scals diff --git a/ext/impl/psb_z_ell_trim.f90 b/ext/impl/psb_z_ell_trim.f90 new file mode 100644 index 00000000..7cc2ed65 --- /dev/null +++ b/ext/impl/psb_z_ell_trim.f90 @@ -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_z_ell_trim(a) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_ell_trim + implicit none + class(psb_z_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_z_ell_trim diff --git a/ext/impl/psb_z_hdia_allocate_mnnz.f90 b/ext/impl/psb_z_hdia_allocate_mnnz.f90 new file mode 100644 index 00000000..abed0c58 --- /dev/null +++ b/ext/impl/psb_z_hdia_allocate_mnnz.f90 @@ -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_z_hdia_allocate_mnnz(m,n,a,nz) + + use psb_base_mod + use psb_z_hdia_mat_mod, psb_protect_name => psb_z_hdia_allocate_mnnz + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_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_z_hdia_allocate_mnnz diff --git a/ext/impl/psb_z_hdia_csmv.f90 b/ext/impl/psb_z_hdia_csmv.f90 new file mode 100644 index 00000000..73d11da6 --- /dev/null +++ b/ext/impl/psb_z_hdia_csmv.f90 @@ -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_z_hdia_csmv(alpha,a,x,beta,y,info,trans) + + use psb_base_mod + use psb_z_hdia_mat_mod, psb_protect_name => psb_z_hdia_csmv + implicit none + class(psb_z_hdia_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), 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)=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_z_inner_dia_csmv + +end subroutine psb_z_hdia_csmv diff --git a/ext/impl/psb_z_hdia_mold.f90 b/ext/impl/psb_z_hdia_mold.f90 new file mode 100644 index 00000000..d91bdb35 --- /dev/null +++ b/ext/impl/psb_z_hdia_mold.f90 @@ -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_z_hdia_mold(a,b,info) + + use psb_base_mod + use psb_z_hdia_mat_mod, psb_protect_name => psb_z_hdia_mold + implicit none + class(psb_z_hdia_sparse_mat), intent(in) :: a + class(psb_z_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_z_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_z_hdia_mold diff --git a/ext/impl/psb_z_hdia_print.f90 b/ext/impl/psb_z_hdia_print.f90 new file mode 100644 index 00000000..46f7769d --- /dev/null +++ b/ext/impl/psb_z_hdia_print.f90 @@ -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_z_hdia_print(iout,a,iv,head,ivr,ivc) + + use psb_base_mod + use psb_z_hdia_mat_mod, psb_protect_name => psb_z_hdia_print + use psi_ext_util_mod + implicit none + + integer(psb_ipk_), intent(in) :: iout + class(psb_z_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_z_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_dpk_), 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_z_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_z_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_z_hdia_print diff --git a/ext/impl/psb_z_hll_aclsum.f90 b/ext/impl/psb_z_hll_aclsum.f90 new file mode 100644 index 00000000..e4add299 --- /dev/null +++ b/ext/impl/psb_z_hll_aclsum.f90 @@ -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_z_hll_aclsum(d,a) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_aclsum + implicit none + class(psb_z_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), 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 = done + else + d = dzero + 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 z_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 z_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_dpk_), intent(in) :: val(ldv,*) + real(psb_dpk_), intent(inout) :: d(*) + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i,j,k, m4, jc + complex(psb_dpk_) :: 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 z_hll_aclsum + +end subroutine psb_z_hll_aclsum diff --git a/ext/impl/psb_z_hll_allocate_mnnz.f90 b/ext/impl/psb_z_hll_allocate_mnnz.f90 new file mode 100644 index 00000000..6ba9d7f1 --- /dev/null +++ b/ext/impl/psb_z_hll_allocate_mnnz.f90 @@ -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_z_hll_allocate_mnnz(m,n,a,nz) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_allocate_mnnz + implicit none + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_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_z_hll_allocate_mnnz diff --git a/ext/impl/psb_z_hll_arwsum.f90 b/ext/impl/psb_z_hll_arwsum.f90 new file mode 100644 index 00000000..a6e020fd --- /dev/null +++ b/ext/impl/psb_z_hll_arwsum.f90 @@ -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_z_hll_arwsum(d,a) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_arwsum + implicit none + class(psb_z_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), 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 = done + else + d = dzero + 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 z_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 z_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_dpk_), intent(in) :: val(ldv,*) + real(psb_dpk_), intent(inout) :: d(*) + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i,j,k, m4, jc + complex(psb_dpk_) :: 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 z_hll_arwsum + +end subroutine psb_z_hll_arwsum diff --git a/ext/impl/psb_z_hll_colsum.f90 b/ext/impl/psb_z_hll_colsum.f90 new file mode 100644 index 00000000..196a694e --- /dev/null +++ b/ext/impl/psb_z_hll_colsum.f90 @@ -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_z_hll_colsum(d,a) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_colsum + implicit none + class(psb_z_hll_sparse_mat), intent(in) :: a + complex(psb_dpk_), 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 = zone + else + d = zzero + 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 z_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 z_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_dpk_), intent(in) :: val(ldv,*) + complex(psb_dpk_), intent(inout) :: d(*) + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i,j,k, m4, jc + complex(psb_dpk_) :: 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 z_hll_colsum + +end subroutine psb_z_hll_colsum diff --git a/ext/impl/psb_z_hll_csgetblk.f90 b/ext/impl/psb_z_hll_csgetblk.f90 new file mode 100644 index 00000000..0cdf1fef --- /dev/null +++ b/ext/impl/psb_z_hll_csgetblk.f90 @@ -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_z_hll_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_csgetblk + implicit none + + class(psb_z_hll_sparse_mat), intent(in) :: a + class(psb_z_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_z_hll_csgetblk diff --git a/ext/impl/psb_z_hll_csgetptn.f90 b/ext/impl/psb_z_hll_csgetptn.f90 new file mode 100644 index 00000000..9d4c6714 --- /dev/null +++ b/ext/impl/psb_z_hll_csgetptn.f90 @@ -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_z_hll_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_csgetptn + implicit none + + class(psb_z_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 psb_z_hll_csgetrow + implicit none + + class(psb_z_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_dpk_), 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 psb_z_hll_csmm + implicit none + class(psb_z_hll_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), 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_dpk_), allocatable :: acc(:) + logical :: tra, ctra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_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 psb_z_hll_csmv + implicit none + class(psb_z_hll_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), 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='z_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) 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_z_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_z_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_z_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_z_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_z_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_z_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_z_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_z_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_z_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_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + complex(psb_dpk_), 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_dpk_) :: acc(4), tmp + + info = psb_success_ + if (tra) then + + if (beta == zone) 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 == zone) 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 == zzero) then + if (beta == zzero) then + do i=1,m + y(ir+i-1) = zzero + end do + else + do i=1,m + y(ir+i-1) = beta*y(ir+i-1) + end do + end if + + else + if (beta == zzero) then + do i=1,m + tmp = zzero + 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 = zzero + 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_z_hll_csmv_inner + + subroutine psb_z_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_dpk_, zzero, psb_success_ + implicit none + integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) + complex(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + complex(psb_dpk_), 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_dpk_) :: acc(4), tmp(m) + + info = psb_success_ + + + tmp(:) = zzero + if (alpha /= zzero) 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 == zzero) 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_z_hll_csmv_notra_8 + + subroutine psb_z_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_dpk_, zzero, psb_success_ + implicit none + integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) + complex(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + complex(psb_dpk_), 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_dpk_) :: acc(4), tmp(m) + + info = psb_success_ + + + tmp(:) = zzero + if (alpha /= zzero) 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 == zzero) 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_z_hll_csmv_notra_24 + + subroutine psb_z_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_dpk_, zzero, psb_success_ + implicit none + integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) + complex(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + complex(psb_dpk_), 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_dpk_) :: acc(4), tmp(m) + + info = psb_success_ + + + tmp(:) = zzero + if (alpha /= zzero) 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 == zzero) 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_z_hll_csmv_notra_16 + + subroutine psb_z_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_dpk_, zzero, psb_success_ + implicit none + integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) + complex(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + complex(psb_dpk_), 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_dpk_) :: acc(4), tmp(m) + + info = psb_success_ + + + tmp(:) = zzero + if (alpha /= zzero) 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 == zzero) 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_z_hll_csmv_notra_32 + + subroutine psb_z_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_dpk_, zzero, psb_success_ + implicit none + integer(psb_ipk_), intent(in) :: ir,n,ldj,ldv,ja(ldj,*),irn(*) + complex(psb_dpk_), intent(in) :: alpha, beta, x(*),val(ldv,*) + complex(psb_dpk_), 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_dpk_) :: acc(4), tmp(m) + + info = psb_success_ + + + tmp(:) = zzero + if (alpha /= zzero) 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 == zzero) 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_z_hll_csmv_notra_4 + +end subroutine psb_z_hll_csmv diff --git a/ext/impl/psb_z_hll_csnm1.f90 b/ext/impl/psb_z_hll_csnm1.f90 new file mode 100644 index 00000000..eb5c5b6b --- /dev/null +++ b/ext/impl/psb_z_hll_csnm1.f90 @@ -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_z_hll_csnm1(a) result(res) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_csnm1 + + implicit none + class(psb_z_hll_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info, hksz, mxrwl + real(psb_dpk_), allocatable :: vt(:) + logical :: is_unit + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_hll_csnm1' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + info = psb_success_ + + + res = dzero + 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 = done + else + vt = dzero + 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_z_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_z_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_dpk_), intent(in) :: val(ldv,*) + real(psb_dpk_), intent(inout) :: vt(*) + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i,j,k, m4, jc + real(psb_dpk_) :: 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_z_hll_csnm1_inner + +end function psb_z_hll_csnm1 diff --git a/ext/impl/psb_z_hll_csnmi.f90 b/ext/impl/psb_z_hll_csnmi.f90 new file mode 100644 index 00000000..6243e5cf --- /dev/null +++ b/ext/impl/psb_z_hll_csnmi.f90 @@ -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_z_hll_csnmi(a) result(res) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_csnmi + implicit none + class(psb_z_hll_sparse_mat), intent(in) :: a + real(psb_dpk_) :: 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='z_csnmi' + logical, parameter :: debug=.false. + + call psb_erractionsave(err_act) + + info = 0 + res = dzero + 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_z_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_z_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_dpk_), intent(in) :: val(ldv,*) + real(psb_dpk_), intent(inout) :: res + logical :: is_unit + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i,j,k, m4, jc + real(psb_dpk_) :: tmp, acc + + info = psb_success_ + if (is_unit) then + tmp = done + else + tmp = dzero + 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_z_hll_csnmi_inner + +end function psb_z_hll_csnmi diff --git a/ext/impl/psb_z_hll_csput.f90 b/ext/impl/psb_z_hll_csput.f90 new file mode 100644 index 00000000..e47664c7 --- /dev/null +++ b/ext/impl/psb_z_hll_csput.f90 @@ -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_z_hll_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_csput_a + implicit none + + class(psb_z_hll_sparse_mat), intent(inout) :: a + complex(psb_dpk_), 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='z_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_z_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_z_hll_srch_upd(nz,ia,ja,val,a,& + & imin,imax,jmin,jmax,info) + + implicit none + + class(psb_z_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_dpk_), 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='z_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_z_hll_srch_upd + +end subroutine psb_z_hll_csput_a diff --git a/ext/impl/psb_z_hll_cssm.f90 b/ext/impl/psb_z_hll_cssm.f90 new file mode 100644 index 00000000..ba1aa150 --- /dev/null +++ b/ext/impl/psb_z_hll_cssm.f90 @@ -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_z_hll_cssm(alpha,a,x,beta,y,info,trans) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_cssm + implicit none + class(psb_z_hll_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), 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_dpk_), allocatable :: tmp(:,:), acc(:) + logical :: tra, ctra + integer(psb_ipk_) :: err_act + character(len=20) :: name='z_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 psb_z_hll_cssv + implicit none + class(psb_z_hll_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), 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_dpk_) :: acc + complex(psb_dpk_), allocatable :: tmp(:) + logical :: tra, ctra + Integer(Psb_ipk_) :: err_act + character(len=20) :: name='z_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) psb_z_hll_get_diag + implicit none + class(psb_z_hll_sparse_mat), intent(in) :: a + complex(psb_dpk_), 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) = zone + 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_z_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) = zzero + end do + call psb_erractionrestore(err_act) + return + +9999 call psb_error_handler(err_act) + return + +contains + + subroutine psb_z_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_dpk_), intent(in) :: val(ldv,*) + complex(psb_dpk_), 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) = zzero + end if + end do + + end subroutine psb_z_hll_get_diag_inner + +end subroutine psb_z_hll_get_diag diff --git a/ext/impl/psb_z_hll_maxval.f90 b/ext/impl/psb_z_hll_maxval.f90 new file mode 100644 index 00000000..22258c3a --- /dev/null +++ b/ext/impl/psb_z_hll_maxval.f90 @@ -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_z_hll_maxval(a) result(res) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_maxval + implicit none + class(psb_z_hll_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + + if (a%is_dev()) call a%sync() + res = maxval(abs(a%val(:))) + if (a%is_unit()) res = max(res,done) + +end function psb_z_hll_maxval diff --git a/ext/impl/psb_z_hll_mold.f90 b/ext/impl/psb_z_hll_mold.f90 new file mode 100644 index 00000000..e108e9ce --- /dev/null +++ b/ext/impl/psb_z_hll_mold.f90 @@ -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_z_hll_mold(a,b,info) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_mold + implicit none + class(psb_z_hll_sparse_mat), intent(in) :: a + class(psb_z_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_z_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_z_hll_mold diff --git a/ext/impl/psb_z_hll_print.f90 b/ext/impl/psb_z_hll_print.f90 new file mode 100644 index 00000000..43882264 --- /dev/null +++ b/ext/impl/psb_z_hll_print.f90 @@ -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_z_hll_print(iout,a,iv,head,ivr,ivc) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_print + implicit none + + integer(psb_ipk_), intent(in) :: iout + class(psb_z_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='z_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_z_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_z_hll_print diff --git a/ext/impl/psb_z_hll_reallocate_nz.f90 b/ext/impl/psb_z_hll_reallocate_nz.f90 new file mode 100644 index 00000000..23432f9f --- /dev/null +++ b/ext/impl/psb_z_hll_reallocate_nz.f90 @@ -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_z_hll_reallocate_nz(nz,a) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_reallocate_nz + implicit none + integer(psb_ipk_), intent(in) :: nz + class(psb_z_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: m, nzrm,nz_ + Integer(Psb_ipk_) :: err_act, info + character(len=20) :: name='z_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_z_hll_reallocate_nz diff --git a/ext/impl/psb_z_hll_reinit.f90 b/ext/impl/psb_z_hll_reinit.f90 new file mode 100644 index 00000000..b6851c61 --- /dev/null +++ b/ext/impl/psb_z_hll_reinit.f90 @@ -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_z_hll_reinit(a,clear) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_reinit + implicit none + + class(psb_z_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(:) = zzero + 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_z_hll_reinit diff --git a/ext/impl/psb_z_hll_rowsum.f90 b/ext/impl/psb_z_hll_rowsum.f90 new file mode 100644 index 00000000..027c5b22 --- /dev/null +++ b/ext/impl/psb_z_hll_rowsum.f90 @@ -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_z_hll_rowsum(d,a) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_rowsum + implicit none + class(psb_z_hll_sparse_mat), intent(in) :: a + complex(psb_dpk_), 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 = zone + else + d = zzero + 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 z_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 z_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_dpk_), intent(in) :: val(ldv,*) + complex(psb_dpk_), intent(inout) :: d(*) + integer(psb_ipk_), intent(out) :: info + + integer(psb_ipk_) :: i,j,k, m4, jc + complex(psb_dpk_) :: 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 z_hll_rowsum + +end subroutine psb_z_hll_rowsum diff --git a/ext/impl/psb_z_hll_scal.f90 b/ext/impl/psb_z_hll_scal.f90 new file mode 100644 index 00000000..a11d0da8 --- /dev/null +++ b/ext/impl/psb_z_hll_scal.f90 @@ -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_z_hll_scal(d,a,info,side) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_scal + implicit none + class(psb_z_hll_sparse_mat), intent(inout) :: a + complex(psb_dpk_), 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_z_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_z_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_dpk_), intent(in) :: d(*) + complex(psb_dpk_), 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_z_hll_scal_inner + + +end subroutine psb_z_hll_scal diff --git a/ext/impl/psb_z_hll_scals.f90 b/ext/impl/psb_z_hll_scals.f90 new file mode 100644 index 00000000..432f11e6 --- /dev/null +++ b/ext/impl/psb_z_hll_scals.f90 @@ -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_z_hll_scals(d,a,info) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_hll_scals + implicit none + class(psb_z_hll_sparse_mat), intent(inout) :: a + complex(psb_dpk_), 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_z_hll_scals diff --git a/ext/impl/psb_z_mv_dia_from_coo.f90 b/ext/impl/psb_z_mv_dia_from_coo.f90 new file mode 100644 index 00000000..29e27dfc --- /dev/null +++ b/ext/impl/psb_z_mv_dia_from_coo.f90 @@ -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_z_mv_dia_from_coo(a,b,info) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_mv_dia_from_coo + implicit none + + class(psb_z_dia_sparse_mat), intent(inout) :: a + class(psb_z_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_z_mv_dia_from_coo diff --git a/ext/impl/psb_z_mv_dia_to_coo.f90 b/ext/impl/psb_z_mv_dia_to_coo.f90 new file mode 100644 index 00000000..1679c9e0 --- /dev/null +++ b/ext/impl/psb_z_mv_dia_to_coo.f90 @@ -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_z_mv_dia_to_coo(a,b,info) + + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psb_z_mv_dia_to_coo + implicit none + + class(psb_z_dia_sparse_mat), intent(inout) :: a + class(psb_z_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_z_mv_dia_to_coo diff --git a/ext/impl/psb_z_mv_ell_from_coo.f90 b/ext/impl/psb_z_mv_ell_from_coo.f90 new file mode 100644 index 00000000..de39604e --- /dev/null +++ b/ext/impl/psb_z_mv_ell_from_coo.f90 @@ -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_z_mv_ell_from_coo(a,b,info) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_mv_ell_from_coo + implicit none + + class(psb_z_ell_sparse_mat), intent(inout) :: a + class(psb_z_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_z_mv_ell_from_coo diff --git a/ext/impl/psb_z_mv_ell_from_fmt.f90 b/ext/impl/psb_z_mv_ell_from_fmt.f90 new file mode 100644 index 00000000..a2c7c190 --- /dev/null +++ b/ext/impl/psb_z_mv_ell_from_fmt.f90 @@ -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_z_mv_ell_from_fmt(a,b,info) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_mv_ell_from_fmt + implicit none + + class(psb_z_ell_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_z_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type (b) + type is (psb_z_coo_sparse_mat) + call a%mv_from_coo(b,info) + + type is (psb_z_ell_sparse_mat) + if (b%is_dev()) call b%sync() + a%psb_z_base_sparse_mat = b%psb_z_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_z_mv_ell_from_fmt diff --git a/ext/impl/psb_z_mv_ell_to_coo.f90 b/ext/impl/psb_z_mv_ell_to_coo.f90 new file mode 100644 index 00000000..3f8afb0a --- /dev/null +++ b/ext/impl/psb_z_mv_ell_to_coo.f90 @@ -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_z_mv_ell_to_coo(a,b,info) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_mv_ell_to_coo + implicit none + + class(psb_z_ell_sparse_mat), intent(inout) :: a + class(psb_z_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_z_base_sparse_mat = a%psb_z_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_z_mv_ell_to_coo diff --git a/ext/impl/psb_z_mv_ell_to_fmt.f90 b/ext/impl/psb_z_mv_ell_to_fmt.f90 new file mode 100644 index 00000000..d34ae80e --- /dev/null +++ b/ext/impl/psb_z_mv_ell_to_fmt.f90 @@ -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_z_mv_ell_to_fmt(a,b,info) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psb_z_mv_ell_to_fmt + implicit none + + class(psb_z_ell_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_z_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type (b) + type is (psb_z_coo_sparse_mat) + call a%mv_to_coo(b,info) + ! Need to fix trivial copies! + type is (psb_z_ell_sparse_mat) + if (a%is_dev()) call a%sync() + b%psb_z_base_sparse_mat = a%psb_z_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_z_mv_ell_to_fmt diff --git a/ext/impl/psb_z_mv_hdia_from_coo.f90 b/ext/impl/psb_z_mv_hdia_from_coo.f90 new file mode 100644 index 00000000..b9593f34 --- /dev/null +++ b/ext/impl/psb_z_mv_hdia_from_coo.f90 @@ -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_z_mv_hdia_from_coo(a,b,info) + + use psb_base_mod + use psb_z_hdia_mat_mod, psb_protect_name => psb_z_mv_hdia_from_coo + implicit none + + class(psb_z_hdia_sparse_mat), intent(inout) :: a + class(psb_z_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_z_mv_hdia_from_coo diff --git a/ext/impl/psb_z_mv_hdia_to_coo.f90 b/ext/impl/psb_z_mv_hdia_to_coo.f90 new file mode 100644 index 00000000..f4c8df55 --- /dev/null +++ b/ext/impl/psb_z_mv_hdia_to_coo.f90 @@ -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_z_mv_hdia_to_coo(a,b,info) + + use psb_base_mod + use psb_z_hdia_mat_mod, psb_protect_name => psb_z_mv_hdia_to_coo + implicit none + + class(psb_z_hdia_sparse_mat), intent(inout) :: a + class(psb_z_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_z_mv_hdia_to_coo diff --git a/ext/impl/psb_z_mv_hll_from_coo.f90 b/ext/impl/psb_z_mv_hll_from_coo.f90 new file mode 100644 index 00000000..abe988b3 --- /dev/null +++ b/ext/impl/psb_z_mv_hll_from_coo.f90 @@ -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_z_mv_hll_from_coo(a,b,info) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_mv_hll_from_coo + implicit none + + class(psb_z_hll_sparse_mat), intent(inout) :: a + class(psb_z_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_z_mv_hll_from_coo diff --git a/ext/impl/psb_z_mv_hll_from_fmt.f90 b/ext/impl/psb_z_mv_hll_from_fmt.f90 new file mode 100644 index 00000000..81626aba --- /dev/null +++ b/ext/impl/psb_z_mv_hll_from_fmt.f90 @@ -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_z_mv_hll_from_fmt(a,b,info) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_mv_hll_from_fmt + implicit none + + class(psb_z_hll_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_z_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type (b) + type is (psb_z_coo_sparse_mat) + call a%mv_from_coo(b,info) + + type is (psb_z_hll_sparse_mat) + if (b%is_dev()) call b%sync() + a%psb_z_base_sparse_mat = b%psb_z_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_z_mv_hll_from_fmt diff --git a/ext/impl/psb_z_mv_hll_to_coo.f90 b/ext/impl/psb_z_mv_hll_to_coo.f90 new file mode 100644 index 00000000..af033004 --- /dev/null +++ b/ext/impl/psb_z_mv_hll_to_coo.f90 @@ -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_z_mv_hll_to_coo(a,b,info) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_mv_hll_to_coo + implicit none + + class(psb_z_hll_sparse_mat), intent(inout) :: a + class(psb_z_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_z_mv_hll_to_coo diff --git a/ext/impl/psb_z_mv_hll_to_fmt.f90 b/ext/impl/psb_z_mv_hll_to_fmt.f90 new file mode 100644 index 00000000..a2fd7027 --- /dev/null +++ b/ext/impl/psb_z_mv_hll_to_fmt.f90 @@ -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_z_mv_hll_to_fmt(a,b,info) + + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psb_z_mv_hll_to_fmt + implicit none + + class(psb_z_hll_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + + !locals + type(psb_z_coo_sparse_mat) :: tmp + + info = psb_success_ + + select type (b) + type is (psb_z_coo_sparse_mat) + call a%mv_to_coo(b,info) + ! Need to fix trivial copies! + type is (psb_z_hll_sparse_mat) + if (a%is_dev()) call a%sync() + b%psb_z_base_sparse_mat = a%psb_z_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_z_mv_hll_to_fmt diff --git a/ext/impl/psi_c_convert_dia_from_coo.f90 b/ext/impl/psi_c_convert_dia_from_coo.f90 new file mode 100644 index 00000000..29565748 --- /dev/null +++ b/ext/impl/psi_c_convert_dia_from_coo.f90 @@ -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. +! +subroutine psi_c_convert_dia_from_coo(a,tmp,info) + use psb_base_mod + use psb_c_dia_mat_mod, psb_protect_name => psi_c_convert_dia_from_coo + use psi_ext_util_mod + implicit none + class(psb_c_dia_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,nd + integer(psb_ipk_),allocatable :: d(:) + integer(psb_ipk_) :: k,i,j,nc,nr,nza,ir,ic + + info = psb_success_ + 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 + + ndiag = nr+nc-1 + allocate(d(ndiag),stat=info) + if (info /= 0) return + call psb_realloc(ndiag,a%offset,info) + if (info /= 0) return + + call psi_dia_offset_from_coo(nr,nc,nza,tmp%ia,tmp%ja, & + & nd,d,a%offset,info,initd=.true.,cleard=.false.) + + call psb_realloc(nd,a%offset,info) + if (info /= 0) return + call psb_realloc(nr,nd,a%data,info) + if (info /= 0) return + a%nzeros = nza + + call psi_xtr_dia_from_coo(nr,nc,nza,tmp%ia,tmp%ja,tmp%val,& + & d,nr,nd,a%data,info,initdata=.true.) + + deallocate(d,stat=info) + if (info /= 0) return + +end subroutine psi_c_convert_dia_from_coo diff --git a/ext/impl/psi_c_convert_ell_from_coo.f90 b/ext/impl/psi_c_convert_ell_from_coo.f90 new file mode 100644 index 00000000..b4e0c7e4 --- /dev/null +++ b/ext/impl/psi_c_convert_ell_from_coo.f90 @@ -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 psi_c_convert_ell_from_coo(a,tmp,info,hacksize) + + use psb_base_mod + use psb_c_ell_mat_mod, psb_protect_name => psi_c_convert_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) :: tmp + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: hacksize + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,k, idl,err_act, nc, nzm, & + & ir, ic, hsz_, ldv + + info = psb_success_ + + nr = tmp%get_nrows() + nc = tmp%get_ncols() + nza = tmp%get_nzeros() + + hsz_ = 1 + if (present(hacksize)) then + if (hacksize> 1) hsz_ = hacksize + end if + ! Make ldv a multiple of hacksize + ldv = ((nr+hsz_-1)/hsz_)*hsz_ + + ! If it is sorted then we can lessen memory impact + a%psb_c_base_sparse_mat = tmp%psb_c_base_sparse_mat + + ! First compute the number of nonzeros in each row. + call psb_realloc(nr,a%irn,info) + if (info /= psb_success_) return + a%irn = 0 + do i=1, nza + ir = tmp%ia(i) + a%irn(ir) = a%irn(ir) + 1 + end do + nzm = 0 + a%nzt = 0 + do i=1,nr + nzm = max(nzm,a%irn(i)) + a%nzt = a%nzt + a%irn(i) + end do + ! Allocate and extract. + call psb_realloc(nr,a%idiag,info) + if (info == psb_success_) call psb_realloc(ldv,nzm,a%ja,info) + if (info == psb_success_) call psb_realloc(ldv,nzm,a%val,info) + if (info /= psb_success_) return + + call psi_c_xtr_ell_from_coo(ione,nr,nzm,tmp%ia,tmp%ja,tmp%val,& + & a%ja,a%val,a%irn,a%idiag,ldv) + +end subroutine psi_c_convert_ell_from_coo + diff --git a/ext/impl/psi_c_convert_hll_from_coo.f90 b/ext/impl/psi_c_convert_hll_from_coo.f90 new file mode 100644 index 00000000..2ebb86a6 --- /dev/null +++ b/ext/impl/psi_c_convert_hll_from_coo.f90 @@ -0,0 +1,122 @@ +! 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 psi_c_convert_hll_from_coo(a,hksz,tmp,info) + use psb_base_mod + use psb_c_hll_mat_mod, psb_protect_name => psi_c_convert_hll_from_coo + use psi_ext_util_mod + implicit none + class(psb_c_hll_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(in) :: hksz + integer(psb_ipk_), intent(out) :: info + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, isz,irs + integer(psb_ipk_) :: nzm, ir, ic, k, hk, mxrwl, noffs, kc + + + if (.not.tmp%is_by_rows()) then + info = -98765 + return + end if + + + 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 + + ! First compute the number of nonzeros in each row. + call psb_realloc(nr,a%irn,info) + if (info /= 0) return + a%irn = 0 + do i=1, nza + a%irn(tmp%ia(i)) = a%irn(tmp%ia(i)) + 1 + end do + + a%nzt = nza + ! Second. Figure out the block offsets. + call a%set_hksz(hksz) + noffs = (nr+hksz-1)/hksz + call psb_realloc(noffs+1,a%hkoffs,info) + if (info /= 0) return + a%hkoffs(1) = 0 + j=1 + do i=1,nr,hksz + ir = min(hksz,nr-i+1) + mxrwl = a%irn(i) + do k=1,ir-1 + mxrwl = max(mxrwl,a%irn(i+k)) + end do + a%hkoffs(j+1) = a%hkoffs(j) + mxrwl*hksz + j = j + 1 + end do + + ! + ! At this point a%hkoffs(noffs+1) contains the allocation + ! size a%ja a%val. + ! + isz = a%hkoffs(noffs+1) + call psb_realloc(nr,a%idiag,info) + if (info == 0) call psb_realloc(isz,a%ja,info) + if (info == 0) call psb_realloc(isz,a%val,info) + if (info /= 0) return + ! Init last chunk of data + nzm = a%hkoffs(noffs+1)-a%hkoffs(noffs) + a%val(isz-(nzm-1):isz) = czero + a%ja(isz-(nzm-1):isz) = nr + ! + ! Now copy everything, noting the position of the diagonal. + ! + kc = 1 + k = 1 + 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)) + mxrwl = isz/hksz + nza = sum(a%irn(i:i+ir-1)) + call psi_c_xtr_ell_from_coo(i,ir,mxrwl,tmp%ia(kc:kc+nza-1),& + & tmp%ja(kc:kc+nza-1),tmp%val(kc:kc+nza-1),& + & a%ja(k:k+isz-1),a%val(k:k+isz-1),a%irn(i:i+ir-1),& + & a%idiag(i:i+ir-1),hksz) + k = k + isz + kc = kc + nza + + enddo + + ! Third copy the other stuff + if (info /= 0) return + call a%set_sorted(.true.) + +end subroutine psi_c_convert_hll_from_coo diff --git a/ext/impl/psi_c_xtr_coo_from_dia.f90 b/ext/impl/psi_c_xtr_coo_from_dia.f90 new file mode 100644 index 00000000..eab82a11 --- /dev/null +++ b/ext/impl/psi_c_xtr_coo_from_dia.f90 @@ -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 psi_c_xtr_coo_from_dia(nr,nc,ia,ja,val,nz,nrd,ncd,data,offsets,info,rdisp) + use psb_base_mod, only : psb_ipk_, psb_success_, psb_spk_, czero + + implicit none + + integer(psb_ipk_), intent(in) :: nr,nc, nrd,ncd, offsets(:) + integer(psb_ipk_), intent(inout) :: ia(:), ja(:),nz + complex(psb_spk_), intent(inout) :: val(:) + complex(psb_spk_), intent(in) :: data(nrd,ncd) + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: rdisp + + !locals + integer(psb_ipk_) :: rdisp_, nrcmdisp, rdisp1 + integer(psb_ipk_) :: i,j,ir1, ir2, ir, ic,k + logical, parameter :: debug=.false. + + info = psb_success_ + rdisp_ = 0 + if (present(rdisp)) rdisp_ = rdisp + + if (debug) write(0,*) 'Start xtr_coo_from_dia',nr,nc,nrd,ncd, rdisp_ + nrcmdisp = min(nr-rdisp_,nc-rdisp_) + rdisp1 = 1-rdisp_ + nz = 0 + 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 + if (debug) write(0,*) ' Loop J',j,ir1,ir2, offsets(j) + do i=ir1,ir2 + ir = i + rdisp_ + ic = i + rdisp_ + offsets(j) + if (debug) write(0,*) ' Loop I',i,ir,ic + nz = nz + 1 + ia(nz) = ir + ja(nz) = ic + val(nz) = data(i,j) + enddo + end do + +end subroutine psi_c_xtr_coo_from_dia + diff --git a/ext/impl/psi_c_xtr_dia_from_coo.f90 b/ext/impl/psi_c_xtr_dia_from_coo.f90 new file mode 100644 index 00000000..f72a03df --- /dev/null +++ b/ext/impl/psi_c_xtr_dia_from_coo.f90 @@ -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 psi_c_xtr_dia_from_coo(nr,nc,nz,ia,ja,val,d,nrd,ncd,data,info,& + & initdata, rdisp) + use psb_base_mod, only : psb_ipk_, psb_success_, psb_spk_, czero + + implicit none + integer(psb_ipk_), intent(in) :: nr, nc, nz, nrd,ncd,ia(:), ja(:), d(:) + complex(psb_spk_), intent(in) :: val(:) + complex(psb_spk_), intent(out) :: data(nrd,ncd) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: initdata + integer(psb_ipk_), intent(in), optional :: rdisp + + !locals + logical :: initdata_ + integer(psb_ipk_) :: rdisp_ + integer(psb_ipk_) :: i,ir,ic,k + logical, parameter :: debug=.false. + + info = psb_success_ + initdata_ = .true. + if (present(initdata)) initdata_ = initdata + rdisp_ = 0 + if (present(rdisp)) rdisp_ = rdisp + + if (debug) write(0,*) 'Start xtr_dia_from_coo',nr,nc,nz,nrd,ncd,initdata_, rdisp_ + + if (initdata_) data(1:nrd,1:ncd) = czero + + do i=1,nz + ir = ia(i) + k = ja(i) - ir + ic = d(nr+k) + if (debug) write(0,*) 'loop xtr_dia_from_coo :',ia(i),ja(i),k,ir-rdisp_,ic + data(ir-rdisp_,ic) = val(i) + enddo + + +end subroutine psi_c_xtr_dia_from_coo diff --git a/ext/impl/psi_c_xtr_ell_from_coo.f90 b/ext/impl/psi_c_xtr_ell_from_coo.f90 new file mode 100644 index 00000000..706e6c1f --- /dev/null +++ b/ext/impl/psi_c_xtr_ell_from_coo.f90 @@ -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 psi_c_xtr_ell_from_coo(i,nr,mxrwl,iac,jac,valc, & + & ja,val,irn,diag,ld) + use psb_base_mod, only : psb_ipk_, psb_success_, psb_spk_, czero + + implicit none + integer(psb_ipk_) :: i,nr,mxrwl,ld + integer(psb_ipk_) :: iac(*),jac(*),ja(ld,*),irn(*),diag(*) + complex(psb_spk_) :: valc(*), val(ld,*) + + integer(psb_ipk_) :: ii,jj,kk, kc,nc, ir, ic + kc = 1 + do ii = 1, nr + nc = irn(ii) + do jj=1,nc + !if (iac(kc) /= i+ii-1) write(0,*) 'Copy mismatch',iac(kc),i,ii,i+ii-1 + ir = iac(kc) + ic = jac(kc) + if (ir == ic) diag(ii) = jj + ja(ii,jj) = ic + val(ii,jj) = valc(kc) + kc = kc + 1 + end do + ! We are assuming that jac contains at least one valid entry + ! If the previous loop did not have any entries, pick one valid + ! value. + if (nc == 0) ic = jac(1) + do jj = nc+1,mxrwl + ja(ii,jj) = ic + val(ii,jj) = czero + end do + end do +end subroutine psi_c_xtr_ell_from_coo + diff --git a/ext/impl/psi_d_convert_dia_from_coo.f90 b/ext/impl/psi_d_convert_dia_from_coo.f90 new file mode 100644 index 00000000..5f821967 --- /dev/null +++ b/ext/impl/psi_d_convert_dia_from_coo.f90 @@ -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. +! +subroutine psi_d_convert_dia_from_coo(a,tmp,info) + use psb_base_mod + use psb_d_dia_mat_mod, psb_protect_name => psi_d_convert_dia_from_coo + use psi_ext_util_mod + implicit none + class(psb_d_dia_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(out) :: info + + !locals + integer(psb_ipk_) :: ndiag,nd + integer(psb_ipk_),allocatable :: d(:) + integer(psb_ipk_) :: k,i,j,nc,nr,nza,ir,ic + + info = psb_success_ + nr = tmp%get_nrows() + nc = tmp%get_ncols() + nza = tmp%get_nzeros() + ! If it is sorted then we can lessen memory impact + a%psb_d_base_sparse_mat = tmp%psb_d_base_sparse_mat + + ndiag = nr+nc-1 + allocate(d(ndiag),stat=info) + if (info /= 0) return + call psb_realloc(ndiag,a%offset,info) + if (info /= 0) return + + call psi_dia_offset_from_coo(nr,nc,nza,tmp%ia,tmp%ja, & + & nd,d,a%offset,info,initd=.true.,cleard=.false.) + + call psb_realloc(nd,a%offset,info) + if (info /= 0) return + call psb_realloc(nr,nd,a%data,info) + if (info /= 0) return + a%nzeros = nza + + call psi_xtr_dia_from_coo(nr,nc,nza,tmp%ia,tmp%ja,tmp%val,& + & d,nr,nd,a%data,info,initdata=.true.) + + deallocate(d,stat=info) + if (info /= 0) return + +end subroutine psi_d_convert_dia_from_coo diff --git a/ext/impl/psi_d_convert_ell_from_coo.f90 b/ext/impl/psi_d_convert_ell_from_coo.f90 new file mode 100644 index 00000000..51471c19 --- /dev/null +++ b/ext/impl/psi_d_convert_ell_from_coo.f90 @@ -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 psi_d_convert_ell_from_coo(a,tmp,info,hacksize) + + use psb_base_mod + use psb_d_ell_mat_mod, psb_protect_name => psi_d_convert_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) :: tmp + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: hacksize + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,k, idl,err_act, nc, nzm, & + & ir, ic, hsz_, ldv + + info = psb_success_ + + nr = tmp%get_nrows() + nc = tmp%get_ncols() + nza = tmp%get_nzeros() + + hsz_ = 1 + if (present(hacksize)) then + if (hacksize> 1) hsz_ = hacksize + end if + ! Make ldv a multiple of hacksize + ldv = ((nr+hsz_-1)/hsz_)*hsz_ + + ! If it is sorted then we can lessen memory impact + a%psb_d_base_sparse_mat = tmp%psb_d_base_sparse_mat + + ! First compute the number of nonzeros in each row. + call psb_realloc(nr,a%irn,info) + if (info /= psb_success_) return + a%irn = 0 + do i=1, nza + ir = tmp%ia(i) + a%irn(ir) = a%irn(ir) + 1 + end do + nzm = 0 + a%nzt = 0 + do i=1,nr + nzm = max(nzm,a%irn(i)) + a%nzt = a%nzt + a%irn(i) + end do + ! Allocate and extract. + call psb_realloc(nr,a%idiag,info) + if (info == psb_success_) call psb_realloc(ldv,nzm,a%ja,info) + if (info == psb_success_) call psb_realloc(ldv,nzm,a%val,info) + if (info /= psb_success_) return + + call psi_d_xtr_ell_from_coo(ione,nr,nzm,tmp%ia,tmp%ja,tmp%val,& + & a%ja,a%val,a%irn,a%idiag,ldv) + +end subroutine psi_d_convert_ell_from_coo + diff --git a/ext/impl/psi_d_convert_hll_from_coo.f90 b/ext/impl/psi_d_convert_hll_from_coo.f90 new file mode 100644 index 00000000..cb07e52c --- /dev/null +++ b/ext/impl/psi_d_convert_hll_from_coo.f90 @@ -0,0 +1,122 @@ +! 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 psi_d_convert_hll_from_coo(a,hksz,tmp,info) + use psb_base_mod + use psb_d_hll_mat_mod, psb_protect_name => psi_d_convert_hll_from_coo + use psi_ext_util_mod + implicit none + class(psb_d_hll_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(in) :: hksz + integer(psb_ipk_), intent(out) :: info + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, isz,irs + integer(psb_ipk_) :: nzm, ir, ic, k, hk, mxrwl, noffs, kc + + + if (.not.tmp%is_by_rows()) then + info = -98765 + return + end if + + + nr = tmp%get_nrows() + nc = tmp%get_ncols() + nza = tmp%get_nzeros() + ! If it is sorted then we can lessen memory impact + a%psb_d_base_sparse_mat = tmp%psb_d_base_sparse_mat + + ! First compute the number of nonzeros in each row. + call psb_realloc(nr,a%irn,info) + if (info /= 0) return + a%irn = 0 + do i=1, nza + a%irn(tmp%ia(i)) = a%irn(tmp%ia(i)) + 1 + end do + + a%nzt = nza + ! Second. Figure out the block offsets. + call a%set_hksz(hksz) + noffs = (nr+hksz-1)/hksz + call psb_realloc(noffs+1,a%hkoffs,info) + if (info /= 0) return + a%hkoffs(1) = 0 + j=1 + do i=1,nr,hksz + ir = min(hksz,nr-i+1) + mxrwl = a%irn(i) + do k=1,ir-1 + mxrwl = max(mxrwl,a%irn(i+k)) + end do + a%hkoffs(j+1) = a%hkoffs(j) + mxrwl*hksz + j = j + 1 + end do + + ! + ! At this point a%hkoffs(noffs+1) contains the allocation + ! size a%ja a%val. + ! + isz = a%hkoffs(noffs+1) + call psb_realloc(nr,a%idiag,info) + if (info == 0) call psb_realloc(isz,a%ja,info) + if (info == 0) call psb_realloc(isz,a%val,info) + if (info /= 0) return + ! Init last chunk of data + nzm = a%hkoffs(noffs+1)-a%hkoffs(noffs) + a%val(isz-(nzm-1):isz) = dzero + a%ja(isz-(nzm-1):isz) = nr + ! + ! Now copy everything, noting the position of the diagonal. + ! + kc = 1 + k = 1 + 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)) + mxrwl = isz/hksz + nza = sum(a%irn(i:i+ir-1)) + call psi_d_xtr_ell_from_coo(i,ir,mxrwl,tmp%ia(kc:kc+nza-1),& + & tmp%ja(kc:kc+nza-1),tmp%val(kc:kc+nza-1),& + & a%ja(k:k+isz-1),a%val(k:k+isz-1),a%irn(i:i+ir-1),& + & a%idiag(i:i+ir-1),hksz) + k = k + isz + kc = kc + nza + + enddo + + ! Third copy the other stuff + if (info /= 0) return + call a%set_sorted(.true.) + +end subroutine psi_d_convert_hll_from_coo diff --git a/ext/impl/psi_d_xtr_coo_from_dia.f90 b/ext/impl/psi_d_xtr_coo_from_dia.f90 new file mode 100644 index 00000000..5fc98b82 --- /dev/null +++ b/ext/impl/psi_d_xtr_coo_from_dia.f90 @@ -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 psi_d_xtr_coo_from_dia(nr,nc,ia,ja,val,nz,nrd,ncd,data,offsets,info,rdisp) + use psb_base_mod, only : psb_ipk_, psb_success_, psb_dpk_, dzero + + implicit none + + integer(psb_ipk_), intent(in) :: nr,nc, nrd,ncd, offsets(:) + integer(psb_ipk_), intent(inout) :: ia(:), ja(:),nz + real(psb_dpk_), intent(inout) :: val(:) + real(psb_dpk_), intent(in) :: data(nrd,ncd) + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: rdisp + + !locals + integer(psb_ipk_) :: rdisp_, nrcmdisp, rdisp1 + integer(psb_ipk_) :: i,j,ir1, ir2, ir, ic,k + logical, parameter :: debug=.false. + + info = psb_success_ + rdisp_ = 0 + if (present(rdisp)) rdisp_ = rdisp + + if (debug) write(0,*) 'Start xtr_coo_from_dia',nr,nc,nrd,ncd, rdisp_ + nrcmdisp = min(nr-rdisp_,nc-rdisp_) + rdisp1 = 1-rdisp_ + nz = 0 + 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 + if (debug) write(0,*) ' Loop J',j,ir1,ir2, offsets(j) + do i=ir1,ir2 + ir = i + rdisp_ + ic = i + rdisp_ + offsets(j) + if (debug) write(0,*) ' Loop I',i,ir,ic + nz = nz + 1 + ia(nz) = ir + ja(nz) = ic + val(nz) = data(i,j) + enddo + end do + +end subroutine psi_d_xtr_coo_from_dia + diff --git a/ext/impl/psi_d_xtr_dia_from_coo.f90 b/ext/impl/psi_d_xtr_dia_from_coo.f90 new file mode 100644 index 00000000..cd95b64e --- /dev/null +++ b/ext/impl/psi_d_xtr_dia_from_coo.f90 @@ -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 psi_d_xtr_dia_from_coo(nr,nc,nz,ia,ja,val,d,nrd,ncd,data,info,& + & initdata, rdisp) + use psb_base_mod, only : psb_ipk_, psb_success_, psb_dpk_, dzero + + implicit none + integer(psb_ipk_), intent(in) :: nr, nc, nz, nrd,ncd,ia(:), ja(:), d(:) + real(psb_dpk_), intent(in) :: val(:) + real(psb_dpk_), intent(out) :: data(nrd,ncd) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: initdata + integer(psb_ipk_), intent(in), optional :: rdisp + + !locals + logical :: initdata_ + integer(psb_ipk_) :: rdisp_ + integer(psb_ipk_) :: i,ir,ic,k + logical, parameter :: debug=.false. + + info = psb_success_ + initdata_ = .true. + if (present(initdata)) initdata_ = initdata + rdisp_ = 0 + if (present(rdisp)) rdisp_ = rdisp + + if (debug) write(0,*) 'Start xtr_dia_from_coo',nr,nc,nz,nrd,ncd,initdata_, rdisp_ + + if (initdata_) data(1:nrd,1:ncd) = dzero + + do i=1,nz + ir = ia(i) + k = ja(i) - ir + ic = d(nr+k) + if (debug) write(0,*) 'loop xtr_dia_from_coo :',ia(i),ja(i),k,ir-rdisp_,ic + data(ir-rdisp_,ic) = val(i) + enddo + + +end subroutine psi_d_xtr_dia_from_coo diff --git a/ext/impl/psi_d_xtr_ell_from_coo.f90 b/ext/impl/psi_d_xtr_ell_from_coo.f90 new file mode 100644 index 00000000..ec520797 --- /dev/null +++ b/ext/impl/psi_d_xtr_ell_from_coo.f90 @@ -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 psi_d_xtr_ell_from_coo(i,nr,mxrwl,iac,jac,valc, & + & ja,val,irn,diag,ld) + use psb_base_mod, only : psb_ipk_, psb_success_, psb_dpk_, dzero + + implicit none + integer(psb_ipk_) :: i,nr,mxrwl,ld + integer(psb_ipk_) :: iac(*),jac(*),ja(ld,*),irn(*),diag(*) + real(psb_dpk_) :: valc(*), val(ld,*) + + integer(psb_ipk_) :: ii,jj,kk, kc,nc, ir, ic + kc = 1 + do ii = 1, nr + nc = irn(ii) + do jj=1,nc + !if (iac(kc) /= i+ii-1) write(0,*) 'Copy mismatch',iac(kc),i,ii,i+ii-1 + ir = iac(kc) + ic = jac(kc) + if (ir == ic) diag(ii) = jj + ja(ii,jj) = ic + val(ii,jj) = valc(kc) + kc = kc + 1 + end do + ! We are assuming that jac contains at least one valid entry + ! If the previous loop did not have any entries, pick one valid + ! value. + if (nc == 0) ic = jac(1) + do jj = nc+1,mxrwl + ja(ii,jj) = ic + val(ii,jj) = dzero + end do + end do +end subroutine psi_d_xtr_ell_from_coo + diff --git a/ext/impl/psi_s_convert_dia_from_coo.f90 b/ext/impl/psi_s_convert_dia_from_coo.f90 new file mode 100644 index 00000000..d2f58778 --- /dev/null +++ b/ext/impl/psi_s_convert_dia_from_coo.f90 @@ -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. +! +subroutine psi_s_convert_dia_from_coo(a,tmp,info) + use psb_base_mod + use psb_s_dia_mat_mod, psb_protect_name => psi_s_convert_dia_from_coo + use psi_ext_util_mod + implicit none + class(psb_s_dia_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(out) :: info + + !locals + integer(psb_ipk_) :: ndiag,nd + integer(psb_ipk_),allocatable :: d(:) + integer(psb_ipk_) :: k,i,j,nc,nr,nza,ir,ic + + info = psb_success_ + nr = tmp%get_nrows() + nc = tmp%get_ncols() + nza = tmp%get_nzeros() + ! If it is sorted then we can lessen memory impact + a%psb_s_base_sparse_mat = tmp%psb_s_base_sparse_mat + + ndiag = nr+nc-1 + allocate(d(ndiag),stat=info) + if (info /= 0) return + call psb_realloc(ndiag,a%offset,info) + if (info /= 0) return + + call psi_dia_offset_from_coo(nr,nc,nza,tmp%ia,tmp%ja, & + & nd,d,a%offset,info,initd=.true.,cleard=.false.) + + call psb_realloc(nd,a%offset,info) + if (info /= 0) return + call psb_realloc(nr,nd,a%data,info) + if (info /= 0) return + a%nzeros = nza + + call psi_xtr_dia_from_coo(nr,nc,nza,tmp%ia,tmp%ja,tmp%val,& + & d,nr,nd,a%data,info,initdata=.true.) + + deallocate(d,stat=info) + if (info /= 0) return + +end subroutine psi_s_convert_dia_from_coo diff --git a/ext/impl/psi_s_convert_ell_from_coo.f90 b/ext/impl/psi_s_convert_ell_from_coo.f90 new file mode 100644 index 00000000..ecdd9b1e --- /dev/null +++ b/ext/impl/psi_s_convert_ell_from_coo.f90 @@ -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 psi_s_convert_ell_from_coo(a,tmp,info,hacksize) + + use psb_base_mod + use psb_s_ell_mat_mod, psb_protect_name => psi_s_convert_ell_from_coo + use psi_ext_util_mod + implicit none + + class(psb_s_ell_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: hacksize + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,k, idl,err_act, nc, nzm, & + & ir, ic, hsz_, ldv + + info = psb_success_ + + nr = tmp%get_nrows() + nc = tmp%get_ncols() + nza = tmp%get_nzeros() + + hsz_ = 1 + if (present(hacksize)) then + if (hacksize> 1) hsz_ = hacksize + end if + ! Make ldv a multiple of hacksize + ldv = ((nr+hsz_-1)/hsz_)*hsz_ + + ! If it is sorted then we can lessen memory impact + a%psb_s_base_sparse_mat = tmp%psb_s_base_sparse_mat + + ! First compute the number of nonzeros in each row. + call psb_realloc(nr,a%irn,info) + if (info /= psb_success_) return + a%irn = 0 + do i=1, nza + ir = tmp%ia(i) + a%irn(ir) = a%irn(ir) + 1 + end do + nzm = 0 + a%nzt = 0 + do i=1,nr + nzm = max(nzm,a%irn(i)) + a%nzt = a%nzt + a%irn(i) + end do + ! Allocate and extract. + call psb_realloc(nr,a%idiag,info) + if (info == psb_success_) call psb_realloc(ldv,nzm,a%ja,info) + if (info == psb_success_) call psb_realloc(ldv,nzm,a%val,info) + if (info /= psb_success_) return + + call psi_s_xtr_ell_from_coo(ione,nr,nzm,tmp%ia,tmp%ja,tmp%val,& + & a%ja,a%val,a%irn,a%idiag,ldv) + +end subroutine psi_s_convert_ell_from_coo + diff --git a/ext/impl/psi_s_convert_hll_from_coo.f90 b/ext/impl/psi_s_convert_hll_from_coo.f90 new file mode 100644 index 00000000..dcf6c4e2 --- /dev/null +++ b/ext/impl/psi_s_convert_hll_from_coo.f90 @@ -0,0 +1,122 @@ +! 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 psi_s_convert_hll_from_coo(a,hksz,tmp,info) + use psb_base_mod + use psb_s_hll_mat_mod, psb_protect_name => psi_s_convert_hll_from_coo + use psi_ext_util_mod + implicit none + class(psb_s_hll_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(in) :: hksz + integer(psb_ipk_), intent(out) :: info + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, isz,irs + integer(psb_ipk_) :: nzm, ir, ic, k, hk, mxrwl, noffs, kc + + + if (.not.tmp%is_by_rows()) then + info = -98765 + return + end if + + + nr = tmp%get_nrows() + nc = tmp%get_ncols() + nza = tmp%get_nzeros() + ! If it is sorted then we can lessen memory impact + a%psb_s_base_sparse_mat = tmp%psb_s_base_sparse_mat + + ! First compute the number of nonzeros in each row. + call psb_realloc(nr,a%irn,info) + if (info /= 0) return + a%irn = 0 + do i=1, nza + a%irn(tmp%ia(i)) = a%irn(tmp%ia(i)) + 1 + end do + + a%nzt = nza + ! Second. Figure out the block offsets. + call a%set_hksz(hksz) + noffs = (nr+hksz-1)/hksz + call psb_realloc(noffs+1,a%hkoffs,info) + if (info /= 0) return + a%hkoffs(1) = 0 + j=1 + do i=1,nr,hksz + ir = min(hksz,nr-i+1) + mxrwl = a%irn(i) + do k=1,ir-1 + mxrwl = max(mxrwl,a%irn(i+k)) + end do + a%hkoffs(j+1) = a%hkoffs(j) + mxrwl*hksz + j = j + 1 + end do + + ! + ! At this point a%hkoffs(noffs+1) contains the allocation + ! size a%ja a%val. + ! + isz = a%hkoffs(noffs+1) + call psb_realloc(nr,a%idiag,info) + if (info == 0) call psb_realloc(isz,a%ja,info) + if (info == 0) call psb_realloc(isz,a%val,info) + if (info /= 0) return + ! Init last chunk of data + nzm = a%hkoffs(noffs+1)-a%hkoffs(noffs) + a%val(isz-(nzm-1):isz) = szero + a%ja(isz-(nzm-1):isz) = nr + ! + ! Now copy everything, noting the position of the diagonal. + ! + kc = 1 + k = 1 + 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)) + mxrwl = isz/hksz + nza = sum(a%irn(i:i+ir-1)) + call psi_s_xtr_ell_from_coo(i,ir,mxrwl,tmp%ia(kc:kc+nza-1),& + & tmp%ja(kc:kc+nza-1),tmp%val(kc:kc+nza-1),& + & a%ja(k:k+isz-1),a%val(k:k+isz-1),a%irn(i:i+ir-1),& + & a%idiag(i:i+ir-1),hksz) + k = k + isz + kc = kc + nza + + enddo + + ! Third copy the other stuff + if (info /= 0) return + call a%set_sorted(.true.) + +end subroutine psi_s_convert_hll_from_coo diff --git a/ext/impl/psi_s_xtr_coo_from_dia.f90 b/ext/impl/psi_s_xtr_coo_from_dia.f90 new file mode 100644 index 00000000..3745365b --- /dev/null +++ b/ext/impl/psi_s_xtr_coo_from_dia.f90 @@ -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 psi_s_xtr_coo_from_dia(nr,nc,ia,ja,val,nz,nrd,ncd,data,offsets,info,rdisp) + use psb_base_mod, only : psb_ipk_, psb_success_, psb_spk_, szero + + implicit none + + integer(psb_ipk_), intent(in) :: nr,nc, nrd,ncd, offsets(:) + integer(psb_ipk_), intent(inout) :: ia(:), ja(:),nz + real(psb_spk_), intent(inout) :: val(:) + real(psb_spk_), intent(in) :: data(nrd,ncd) + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: rdisp + + !locals + integer(psb_ipk_) :: rdisp_, nrcmdisp, rdisp1 + integer(psb_ipk_) :: i,j,ir1, ir2, ir, ic,k + logical, parameter :: debug=.false. + + info = psb_success_ + rdisp_ = 0 + if (present(rdisp)) rdisp_ = rdisp + + if (debug) write(0,*) 'Start xtr_coo_from_dia',nr,nc,nrd,ncd, rdisp_ + nrcmdisp = min(nr-rdisp_,nc-rdisp_) + rdisp1 = 1-rdisp_ + nz = 0 + 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 + if (debug) write(0,*) ' Loop J',j,ir1,ir2, offsets(j) + do i=ir1,ir2 + ir = i + rdisp_ + ic = i + rdisp_ + offsets(j) + if (debug) write(0,*) ' Loop I',i,ir,ic + nz = nz + 1 + ia(nz) = ir + ja(nz) = ic + val(nz) = data(i,j) + enddo + end do + +end subroutine psi_s_xtr_coo_from_dia + diff --git a/ext/impl/psi_s_xtr_dia_from_coo.f90 b/ext/impl/psi_s_xtr_dia_from_coo.f90 new file mode 100644 index 00000000..a8ee7c4b --- /dev/null +++ b/ext/impl/psi_s_xtr_dia_from_coo.f90 @@ -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 psi_s_xtr_dia_from_coo(nr,nc,nz,ia,ja,val,d,nrd,ncd,data,info,& + & initdata, rdisp) + use psb_base_mod, only : psb_ipk_, psb_success_, psb_spk_, szero + + implicit none + integer(psb_ipk_), intent(in) :: nr, nc, nz, nrd,ncd,ia(:), ja(:), d(:) + real(psb_spk_), intent(in) :: val(:) + real(psb_spk_), intent(out) :: data(nrd,ncd) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: initdata + integer(psb_ipk_), intent(in), optional :: rdisp + + !locals + logical :: initdata_ + integer(psb_ipk_) :: rdisp_ + integer(psb_ipk_) :: i,ir,ic,k + logical, parameter :: debug=.false. + + info = psb_success_ + initdata_ = .true. + if (present(initdata)) initdata_ = initdata + rdisp_ = 0 + if (present(rdisp)) rdisp_ = rdisp + + if (debug) write(0,*) 'Start xtr_dia_from_coo',nr,nc,nz,nrd,ncd,initdata_, rdisp_ + + if (initdata_) data(1:nrd,1:ncd) = szero + + do i=1,nz + ir = ia(i) + k = ja(i) - ir + ic = d(nr+k) + if (debug) write(0,*) 'loop xtr_dia_from_coo :',ia(i),ja(i),k,ir-rdisp_,ic + data(ir-rdisp_,ic) = val(i) + enddo + + +end subroutine psi_s_xtr_dia_from_coo diff --git a/ext/impl/psi_s_xtr_ell_from_coo.f90 b/ext/impl/psi_s_xtr_ell_from_coo.f90 new file mode 100644 index 00000000..0bac2ec0 --- /dev/null +++ b/ext/impl/psi_s_xtr_ell_from_coo.f90 @@ -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 psi_s_xtr_ell_from_coo(i,nr,mxrwl,iac,jac,valc, & + & ja,val,irn,diag,ld) + use psb_base_mod, only : psb_ipk_, psb_success_, psb_spk_, szero + + implicit none + integer(psb_ipk_) :: i,nr,mxrwl,ld + integer(psb_ipk_) :: iac(*),jac(*),ja(ld,*),irn(*),diag(*) + real(psb_spk_) :: valc(*), val(ld,*) + + integer(psb_ipk_) :: ii,jj,kk, kc,nc, ir, ic + kc = 1 + do ii = 1, nr + nc = irn(ii) + do jj=1,nc + !if (iac(kc) /= i+ii-1) write(0,*) 'Copy mismatch',iac(kc),i,ii,i+ii-1 + ir = iac(kc) + ic = jac(kc) + if (ir == ic) diag(ii) = jj + ja(ii,jj) = ic + val(ii,jj) = valc(kc) + kc = kc + 1 + end do + ! We are assuming that jac contains at least one valid entry + ! If the previous loop did not have any entries, pick one valid + ! value. + if (nc == 0) ic = jac(1) + do jj = nc+1,mxrwl + ja(ii,jj) = ic + val(ii,jj) = szero + end do + end do +end subroutine psi_s_xtr_ell_from_coo + diff --git a/ext/impl/psi_z_convert_dia_from_coo.f90 b/ext/impl/psi_z_convert_dia_from_coo.f90 new file mode 100644 index 00000000..ddc9d2fd --- /dev/null +++ b/ext/impl/psi_z_convert_dia_from_coo.f90 @@ -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. +! +subroutine psi_z_convert_dia_from_coo(a,tmp,info) + use psb_base_mod + use psb_z_dia_mat_mod, psb_protect_name => psi_z_convert_dia_from_coo + use psi_ext_util_mod + implicit none + class(psb_z_dia_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(out) :: info + + !locals + integer(psb_ipk_) :: ndiag,nd + integer(psb_ipk_),allocatable :: d(:) + integer(psb_ipk_) :: k,i,j,nc,nr,nza,ir,ic + + info = psb_success_ + nr = tmp%get_nrows() + nc = tmp%get_ncols() + nza = tmp%get_nzeros() + ! If it is sorted then we can lessen memory impact + a%psb_z_base_sparse_mat = tmp%psb_z_base_sparse_mat + + ndiag = nr+nc-1 + allocate(d(ndiag),stat=info) + if (info /= 0) return + call psb_realloc(ndiag,a%offset,info) + if (info /= 0) return + + call psi_dia_offset_from_coo(nr,nc,nza,tmp%ia,tmp%ja, & + & nd,d,a%offset,info,initd=.true.,cleard=.false.) + + call psb_realloc(nd,a%offset,info) + if (info /= 0) return + call psb_realloc(nr,nd,a%data,info) + if (info /= 0) return + a%nzeros = nza + + call psi_xtr_dia_from_coo(nr,nc,nza,tmp%ia,tmp%ja,tmp%val,& + & d,nr,nd,a%data,info,initdata=.true.) + + deallocate(d,stat=info) + if (info /= 0) return + +end subroutine psi_z_convert_dia_from_coo diff --git a/ext/impl/psi_z_convert_ell_from_coo.f90 b/ext/impl/psi_z_convert_ell_from_coo.f90 new file mode 100644 index 00000000..3d37c11f --- /dev/null +++ b/ext/impl/psi_z_convert_ell_from_coo.f90 @@ -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 psi_z_convert_ell_from_coo(a,tmp,info,hacksize) + + use psb_base_mod + use psb_z_ell_mat_mod, psb_protect_name => psi_z_convert_ell_from_coo + use psi_ext_util_mod + implicit none + + class(psb_z_ell_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: hacksize + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,k, idl,err_act, nc, nzm, & + & ir, ic, hsz_, ldv + + info = psb_success_ + + nr = tmp%get_nrows() + nc = tmp%get_ncols() + nza = tmp%get_nzeros() + + hsz_ = 1 + if (present(hacksize)) then + if (hacksize> 1) hsz_ = hacksize + end if + ! Make ldv a multiple of hacksize + ldv = ((nr+hsz_-1)/hsz_)*hsz_ + + ! If it is sorted then we can lessen memory impact + a%psb_z_base_sparse_mat = tmp%psb_z_base_sparse_mat + + ! First compute the number of nonzeros in each row. + call psb_realloc(nr,a%irn,info) + if (info /= psb_success_) return + a%irn = 0 + do i=1, nza + ir = tmp%ia(i) + a%irn(ir) = a%irn(ir) + 1 + end do + nzm = 0 + a%nzt = 0 + do i=1,nr + nzm = max(nzm,a%irn(i)) + a%nzt = a%nzt + a%irn(i) + end do + ! Allocate and extract. + call psb_realloc(nr,a%idiag,info) + if (info == psb_success_) call psb_realloc(ldv,nzm,a%ja,info) + if (info == psb_success_) call psb_realloc(ldv,nzm,a%val,info) + if (info /= psb_success_) return + + call psi_z_xtr_ell_from_coo(ione,nr,nzm,tmp%ia,tmp%ja,tmp%val,& + & a%ja,a%val,a%irn,a%idiag,ldv) + +end subroutine psi_z_convert_ell_from_coo + diff --git a/ext/impl/psi_z_convert_hll_from_coo.f90 b/ext/impl/psi_z_convert_hll_from_coo.f90 new file mode 100644 index 00000000..bc9fdde1 --- /dev/null +++ b/ext/impl/psi_z_convert_hll_from_coo.f90 @@ -0,0 +1,122 @@ +! 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 psi_z_convert_hll_from_coo(a,hksz,tmp,info) + use psb_base_mod + use psb_z_hll_mat_mod, psb_protect_name => psi_z_convert_hll_from_coo + use psi_ext_util_mod + implicit none + class(psb_z_hll_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(in) :: hksz + integer(psb_ipk_), intent(out) :: info + + !locals + Integer(Psb_ipk_) :: nza, nr, i,j,irw, idl,err_act, nc, isz,irs + integer(psb_ipk_) :: nzm, ir, ic, k, hk, mxrwl, noffs, kc + + + if (.not.tmp%is_by_rows()) then + info = -98765 + return + end if + + + nr = tmp%get_nrows() + nc = tmp%get_ncols() + nza = tmp%get_nzeros() + ! If it is sorted then we can lessen memory impact + a%psb_z_base_sparse_mat = tmp%psb_z_base_sparse_mat + + ! First compute the number of nonzeros in each row. + call psb_realloc(nr,a%irn,info) + if (info /= 0) return + a%irn = 0 + do i=1, nza + a%irn(tmp%ia(i)) = a%irn(tmp%ia(i)) + 1 + end do + + a%nzt = nza + ! Second. Figure out the block offsets. + call a%set_hksz(hksz) + noffs = (nr+hksz-1)/hksz + call psb_realloc(noffs+1,a%hkoffs,info) + if (info /= 0) return + a%hkoffs(1) = 0 + j=1 + do i=1,nr,hksz + ir = min(hksz,nr-i+1) + mxrwl = a%irn(i) + do k=1,ir-1 + mxrwl = max(mxrwl,a%irn(i+k)) + end do + a%hkoffs(j+1) = a%hkoffs(j) + mxrwl*hksz + j = j + 1 + end do + + ! + ! At this point a%hkoffs(noffs+1) contains the allocation + ! size a%ja a%val. + ! + isz = a%hkoffs(noffs+1) + call psb_realloc(nr,a%idiag,info) + if (info == 0) call psb_realloc(isz,a%ja,info) + if (info == 0) call psb_realloc(isz,a%val,info) + if (info /= 0) return + ! Init last chunk of data + nzm = a%hkoffs(noffs+1)-a%hkoffs(noffs) + a%val(isz-(nzm-1):isz) = zzero + a%ja(isz-(nzm-1):isz) = nr + ! + ! Now copy everything, noting the position of the diagonal. + ! + kc = 1 + k = 1 + 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)) + mxrwl = isz/hksz + nza = sum(a%irn(i:i+ir-1)) + call psi_z_xtr_ell_from_coo(i,ir,mxrwl,tmp%ia(kc:kc+nza-1),& + & tmp%ja(kc:kc+nza-1),tmp%val(kc:kc+nza-1),& + & a%ja(k:k+isz-1),a%val(k:k+isz-1),a%irn(i:i+ir-1),& + & a%idiag(i:i+ir-1),hksz) + k = k + isz + kc = kc + nza + + enddo + + ! Third copy the other stuff + if (info /= 0) return + call a%set_sorted(.true.) + +end subroutine psi_z_convert_hll_from_coo diff --git a/ext/impl/psi_z_xtr_coo_from_dia.f90 b/ext/impl/psi_z_xtr_coo_from_dia.f90 new file mode 100644 index 00000000..70d0938f --- /dev/null +++ b/ext/impl/psi_z_xtr_coo_from_dia.f90 @@ -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 psi_z_xtr_coo_from_dia(nr,nc,ia,ja,val,nz,nrd,ncd,data,offsets,info,rdisp) + use psb_base_mod, only : psb_ipk_, psb_success_, psb_dpk_, zzero + + implicit none + + integer(psb_ipk_), intent(in) :: nr,nc, nrd,ncd, offsets(:) + integer(psb_ipk_), intent(inout) :: ia(:), ja(:),nz + complex(psb_dpk_), intent(inout) :: val(:) + complex(psb_dpk_), intent(in) :: data(nrd,ncd) + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: rdisp + + !locals + integer(psb_ipk_) :: rdisp_, nrcmdisp, rdisp1 + integer(psb_ipk_) :: i,j,ir1, ir2, ir, ic,k + logical, parameter :: debug=.false. + + info = psb_success_ + rdisp_ = 0 + if (present(rdisp)) rdisp_ = rdisp + + if (debug) write(0,*) 'Start xtr_coo_from_dia',nr,nc,nrd,ncd, rdisp_ + nrcmdisp = min(nr-rdisp_,nc-rdisp_) + rdisp1 = 1-rdisp_ + nz = 0 + 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 + if (debug) write(0,*) ' Loop J',j,ir1,ir2, offsets(j) + do i=ir1,ir2 + ir = i + rdisp_ + ic = i + rdisp_ + offsets(j) + if (debug) write(0,*) ' Loop I',i,ir,ic + nz = nz + 1 + ia(nz) = ir + ja(nz) = ic + val(nz) = data(i,j) + enddo + end do + +end subroutine psi_z_xtr_coo_from_dia + diff --git a/ext/impl/psi_z_xtr_dia_from_coo.f90 b/ext/impl/psi_z_xtr_dia_from_coo.f90 new file mode 100644 index 00000000..6b2542c6 --- /dev/null +++ b/ext/impl/psi_z_xtr_dia_from_coo.f90 @@ -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 psi_z_xtr_dia_from_coo(nr,nc,nz,ia,ja,val,d,nrd,ncd,data,info,& + & initdata, rdisp) + use psb_base_mod, only : psb_ipk_, psb_success_, psb_dpk_, zzero + + implicit none + integer(psb_ipk_), intent(in) :: nr, nc, nz, nrd,ncd,ia(:), ja(:), d(:) + complex(psb_dpk_), intent(in) :: val(:) + complex(psb_dpk_), intent(out) :: data(nrd,ncd) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: initdata + integer(psb_ipk_), intent(in), optional :: rdisp + + !locals + logical :: initdata_ + integer(psb_ipk_) :: rdisp_ + integer(psb_ipk_) :: i,ir,ic,k + logical, parameter :: debug=.false. + + info = psb_success_ + initdata_ = .true. + if (present(initdata)) initdata_ = initdata + rdisp_ = 0 + if (present(rdisp)) rdisp_ = rdisp + + if (debug) write(0,*) 'Start xtr_dia_from_coo',nr,nc,nz,nrd,ncd,initdata_, rdisp_ + + if (initdata_) data(1:nrd,1:ncd) = zzero + + do i=1,nz + ir = ia(i) + k = ja(i) - ir + ic = d(nr+k) + if (debug) write(0,*) 'loop xtr_dia_from_coo :',ia(i),ja(i),k,ir-rdisp_,ic + data(ir-rdisp_,ic) = val(i) + enddo + + +end subroutine psi_z_xtr_dia_from_coo diff --git a/ext/impl/psi_z_xtr_ell_from_coo.f90 b/ext/impl/psi_z_xtr_ell_from_coo.f90 new file mode 100644 index 00000000..7133f2ae --- /dev/null +++ b/ext/impl/psi_z_xtr_ell_from_coo.f90 @@ -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 psi_z_xtr_ell_from_coo(i,nr,mxrwl,iac,jac,valc, & + & ja,val,irn,diag,ld) + use psb_base_mod, only : psb_ipk_, psb_success_, psb_dpk_, zzero + + implicit none + integer(psb_ipk_) :: i,nr,mxrwl,ld + integer(psb_ipk_) :: iac(*),jac(*),ja(ld,*),irn(*),diag(*) + complex(psb_dpk_) :: valc(*), val(ld,*) + + integer(psb_ipk_) :: ii,jj,kk, kc,nc, ir, ic + kc = 1 + do ii = 1, nr + nc = irn(ii) + do jj=1,nc + !if (iac(kc) /= i+ii-1) write(0,*) 'Copy mismatch',iac(kc),i,ii,i+ii-1 + ir = iac(kc) + ic = jac(kc) + if (ir == ic) diag(ii) = jj + ja(ii,jj) = ic + val(ii,jj) = valc(kc) + kc = kc + 1 + end do + ! We are assuming that jac contains at least one valid entry + ! If the previous loop did not have any entries, pick one valid + ! value. + if (nc == 0) ic = jac(1) + do jj = nc+1,mxrwl + ja(ii,jj) = ic + val(ii,jj) = zzero + end do + end do +end subroutine psi_z_xtr_ell_from_coo + diff --git a/ext/psb_c_dia_mat_mod.f90 b/ext/psb_c_dia_mat_mod.f90 new file mode 100644 index 00000000..8311487b --- /dev/null +++ b/ext/psb_c_dia_mat_mod.f90 @@ -0,0 +1,513 @@ +! 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. +! + + +module psb_c_dia_mat_mod + + use psb_c_base_mat_mod + + type, extends(psb_c_base_sparse_mat) :: psb_c_dia_sparse_mat + ! + ! DIA format, extended. + ! + + integer(psb_ipk_), allocatable :: offset(:) + integer(psb_ipk_) :: nzeros + complex(psb_spk_), allocatable :: data(:,:) + + contains + ! procedure, pass(a) :: get_size => c_dia_get_size + procedure, pass(a) :: get_nzeros => c_dia_get_nzeros + procedure, nopass :: get_fmt => c_dia_get_fmt + procedure, pass(a) :: sizeof => c_dia_sizeof + procedure, pass(a) :: csmm => psb_c_dia_csmm + procedure, pass(a) :: csmv => psb_c_dia_csmv + ! procedure, pass(a) :: inner_cssm => psb_c_dia_cssm + ! procedure, pass(a) :: inner_cssv => psb_c_dia_cssv + procedure, pass(a) :: scals => psb_c_dia_scals + procedure, pass(a) :: scalv => psb_c_dia_scal + procedure, pass(a) :: maxval => psb_c_dia_maxval + procedure, pass(a) :: rowsum => psb_c_dia_rowsum + procedure, pass(a) :: arwsum => psb_c_dia_arwsum + procedure, pass(a) :: colsum => psb_c_dia_colsum + procedure, pass(a) :: aclsum => psb_c_dia_aclsum + procedure, pass(a) :: reallocate_nz => psb_c_dia_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_c_dia_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_c_cp_dia_to_coo + procedure, pass(a) :: cp_from_coo => psb_c_cp_dia_from_coo + ! procedure, pass(a) :: mv_to_coo => psb_c_mv_dia_to_coo + procedure, pass(a) :: mv_from_coo => psb_c_mv_dia_from_coo + ! procedure, pass(a) :: mv_to_fmt => psb_c_mv_dia_to_fmt + ! procedure, pass(a) :: mv_from_fmt => psb_c_mv_dia_from_fmt + ! procedure, pass(a) :: csput_a => psb_c_dia_csput_a + procedure, pass(a) :: get_diag => psb_c_dia_get_diag + procedure, pass(a) :: csgetptn => psb_c_dia_csgetptn + procedure, pass(a) :: csgetrow => psb_c_dia_csgetrow + ! procedure, pass(a) :: get_nz_row => c_dia_get_nz_row + procedure, pass(a) :: reinit => psb_c_dia_reinit + ! procedure, pass(a) :: trim => psb_c_dia_trim + procedure, pass(a) :: print => psb_c_dia_print + procedure, pass(a) :: free => c_dia_free + procedure, pass(a) :: mold => psb_c_dia_mold + + end type psb_c_dia_sparse_mat + + private :: c_dia_get_nzeros, c_dia_free, c_dia_get_fmt, & + & c_dia_sizeof !, c_dia_get_size, c_dia_get_nz_row + + interface + subroutine psb_c_dia_reallocate_nz(nz,a) + import :: psb_c_dia_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_c_dia_sparse_mat), intent(inout) :: a + end subroutine psb_c_dia_reallocate_nz + end interface + + interface + subroutine psb_c_dia_reinit(a,clear) + import :: psb_c_dia_sparse_mat + class(psb_c_dia_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + end subroutine psb_c_dia_reinit + end interface + + interface + subroutine psb_c_dia_trim(a) + import :: psb_c_dia_sparse_mat + class(psb_c_dia_sparse_mat), intent(inout) :: a + end subroutine psb_c_dia_trim + end interface + + interface + subroutine psb_c_dia_mold(a,b,info) + import :: psb_c_dia_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + 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 + end subroutine psb_c_dia_mold + end interface + + interface + subroutine psb_c_dia_allocate_mnnz(m,n,a,nz) + import :: psb_c_dia_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_c_dia_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_c_dia_allocate_mnnz + end interface + + interface + subroutine psb_c_dia_print(iout,a,iv,head,ivr,ivc) + import :: psb_c_dia_sparse_mat, psb_ipk_, psb_lpk_ + 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(:) + end subroutine psb_c_dia_print + end interface + + interface + subroutine psb_c_cp_dia_to_coo(a,b,info) + import :: psb_c_coo_sparse_mat, psb_c_dia_sparse_mat, psb_ipk_ + class(psb_c_dia_sparse_mat), intent(in) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_dia_to_coo + end interface + + interface + subroutine psb_c_cp_dia_from_coo(a,b,info) + import :: psb_c_dia_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_dia_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_dia_from_coo + end interface + + interface + subroutine psb_c_cp_dia_to_fmt(a,b,info) + import :: psb_c_dia_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_dia_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_dia_to_fmt + end interface + + interface + subroutine psb_c_cp_dia_from_fmt(a,b,info) + import :: psb_c_dia_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_dia_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_dia_from_fmt + end interface + + interface + subroutine psb_c_mv_dia_to_coo(a,b,info) + import :: psb_c_dia_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_dia_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_dia_to_coo + end interface + + interface + subroutine psb_c_mv_dia_from_coo(a,b,info) + import :: psb_c_dia_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_dia_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_dia_from_coo + end interface + + interface + subroutine psb_c_mv_dia_to_fmt(a,b,info) + import :: psb_c_dia_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_dia_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_dia_to_fmt + end interface + + interface + subroutine psb_c_mv_dia_from_fmt(a,b,info) + import :: psb_c_dia_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_dia_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_dia_from_fmt + end interface + + interface + subroutine psb_c_dia_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_c_dia_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_dia_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 + end subroutine psb_c_dia_csput_a + end interface + + interface + subroutine psb_c_dia_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + import :: psb_c_dia_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_dia_csgetptn + end interface + + interface + subroutine psb_c_dia_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_c_dia_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_dia_csgetrow + end interface + + interface + subroutine psb_c_dia_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + import :: psb_c_dia_sparse_mat, psb_spk_, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_dia_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 + end subroutine psb_c_dia_csgetblk + end interface + + interface + subroutine psb_c_dia_cssv(alpha,a,x,beta,y,info,trans) + import :: psb_c_dia_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_dia_cssv + subroutine psb_c_dia_cssm(alpha,a,x,beta,y,info,trans) + import :: psb_c_dia_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_dia_cssm + end interface + + interface + subroutine psb_c_dia_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_c_dia_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_dia_csmv + subroutine psb_c_dia_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_c_dia_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_dia_csmm + end interface + + + interface + function psb_c_dia_maxval(a) result(res) + import :: psb_c_dia_sparse_mat, psb_spk_ + class(psb_c_dia_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_dia_maxval + end interface + + interface + function psb_c_dia_csnmi(a) result(res) + import :: psb_c_dia_sparse_mat, psb_spk_ + class(psb_c_dia_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_dia_csnmi + end interface + + interface + function psb_c_dia_csnm1(a) result(res) + import :: psb_c_dia_sparse_mat, psb_spk_ + class(psb_c_dia_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_dia_csnm1 + end interface + + interface + subroutine psb_c_dia_rowsum(d,a) + import :: psb_c_dia_sparse_mat, psb_spk_ + class(psb_c_dia_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_dia_rowsum + end interface + + interface + subroutine psb_c_dia_arwsum(d,a) + import :: psb_c_dia_sparse_mat, psb_spk_ + class(psb_c_dia_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_dia_arwsum + end interface + + interface + subroutine psb_c_dia_colsum(d,a) + import :: psb_c_dia_sparse_mat, psb_spk_ + class(psb_c_dia_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_dia_colsum + end interface + + interface + subroutine psb_c_dia_aclsum(d,a) + import :: psb_c_dia_sparse_mat, psb_spk_ + class(psb_c_dia_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_dia_aclsum + end interface + + interface + subroutine psb_c_dia_get_diag(a,d,info) + import :: psb_c_dia_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_dia_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_dia_get_diag + end interface + + interface + subroutine psb_c_dia_scal(d,a,info,side) + import :: psb_c_dia_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_dia_scal + end interface + + interface + subroutine psb_c_dia_scals(d,a,info) + import :: psb_c_dia_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_dia_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_dia_scals + end interface + + interface psi_convert_dia_from_coo + subroutine psi_c_convert_dia_from_coo(a,tmp,info) + import :: psb_c_dia_sparse_mat, psb_ipk_, psb_c_coo_sparse_mat + implicit none + class(psb_c_dia_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(out) :: info + end subroutine psi_c_convert_dia_from_coo + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function c_dia_sizeof(a) result(res) + implicit none + class(psb_c_dia_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + if (a%is_dev()) call a%sync() + res = 8 + res = res + (2*psb_sizeof_sp) * size(a%data) + res = res + psb_sizeof_ip * size(a%offset) + + end function c_dia_sizeof + + function c_dia_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DIA' + end function c_dia_get_fmt + + function c_dia_get_nzeros(a) result(res) + implicit none + class(psb_c_dia_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nzeros + end function c_dia_get_nzeros + + ! function c_dia_get_size(a) result(res) + ! implicit none + ! class(psb_c_dia_sparse_mat), intent(in) :: a + ! integer(psb_ipk_) :: res + + ! res = -1 + + ! if (allocated(a%ja)) then + ! if (res >= 0) then + ! res = min(res,size(a%ja)) + ! else + ! res = size(a%ja) + ! end if + ! end if + ! if (allocated(a%val)) then + ! if (res >= 0) then + ! res = min(res,size(a%val)) + ! else + ! res = size(a%val) + ! end if + ! end if + + ! end function c_dia_get_size + + + ! function c_dia_get_nz_row(idx,a) result(res) + + ! implicit none + + ! class(psb_c_dia_sparse_mat), intent(in) :: a + ! integer(psb_ipk_), intent(in) :: idx + ! integer(psb_ipk_) :: res + + ! res = 0 + + ! if ((1<=idx).and.(idx<=a%get_nrows())) then + ! res = a%irn(idx) + ! end if + + ! end function c_dia_get_nz_row + + + + ! ! == =================================== + ! ! + ! ! + ! ! + ! ! Data management + ! ! + ! ! + ! ! + ! ! + ! ! + ! ! == =================================== + + subroutine c_dia_free(a) + implicit none + + class(psb_c_dia_sparse_mat), intent(inout) :: a + + if (allocated(a%data)) deallocate(a%data) + if (allocated(a%offset)) deallocate(a%offset) + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + + return + + end subroutine c_dia_free + + +end module psb_c_dia_mat_mod diff --git a/ext/psb_c_dns_mat_mod.f90 b/ext/psb_c_dns_mat_mod.f90 new file mode 100644 index 00000000..5e5a191d --- /dev/null +++ b/ext/psb_c_dns_mat_mod.f90 @@ -0,0 +1,467 @@ +! 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. +! +module psb_c_dns_mat_mod + + use psb_c_base_mat_mod + + type, extends(psb_c_base_sparse_mat) :: psb_c_dns_sparse_mat + ! + ! DNS format: a very simple dense matrix storage + ! psb_spk_ : kind for double precision reals + ! psb_ipk_: kind for normal integers. + ! psb_sizeof_dp: variable holding size in bytes of + ! a double + ! psb_sizeof_ip: size in bytes of an integer + ! + ! psb_realloc(n,v,info) Reallocate: does what it says + ! psb_realloc(m,n,a,info) on rank 1 and 2 arrays, may start + ! from unallocated + ! + ! + integer(psb_ipk_) :: nnz + complex(psb_spk_), allocatable :: val(:,:) + + contains + procedure, pass(a) :: get_size => c_dns_get_size + procedure, pass(a) :: get_nzeros => c_dns_get_nzeros + procedure, nopass :: get_fmt => c_dns_get_fmt + procedure, pass(a) :: sizeof => c_dns_sizeof + procedure, pass(a) :: csmv => psb_c_dns_csmv + procedure, pass(a) :: csmm => psb_c_dns_csmm + procedure, pass(a) :: csnmi => psb_c_dns_csnmi + procedure, pass(a) :: reallocate_nz => psb_c_dns_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_c_dns_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_c_cp_dns_to_coo + procedure, pass(a) :: cp_from_coo => psb_c_cp_dns_from_coo + procedure, pass(a) :: mv_to_coo => psb_c_mv_dns_to_coo + procedure, pass(a) :: mv_from_coo => psb_c_mv_dns_from_coo + procedure, pass(a) :: get_diag => psb_c_dns_get_diag + procedure, pass(a) :: csgetrow => psb_c_dns_csgetrow + procedure, pass(a) :: get_nz_row => c_dns_get_nz_row + procedure, pass(a) :: trim => psb_c_dns_trim + procedure, pass(a) :: free => c_dns_free + procedure, pass(a) :: mold => psb_c_dns_mold + + end type psb_c_dns_sparse_mat + + private :: c_dns_get_nzeros, c_dns_free, c_dns_get_fmt, & + & c_dns_get_size, c_dns_sizeof, c_dns_get_nz_row + + ! + ! + !> 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. + ! + interface + subroutine psb_c_dns_reallocate_nz(nz,a) + import :: psb_c_dns_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_c_dns_sparse_mat), intent(inout) :: a + end subroutine psb_c_dns_reallocate_nz + end interface + + !> 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. + ! + interface + subroutine psb_c_dns_trim(a) + import :: psb_c_dns_sparse_mat + class(psb_c_dns_sparse_mat), intent(inout) :: a + end subroutine psb_c_dns_trim + end interface + + ! + !> 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 + ! + interface + subroutine psb_c_dns_mold(a,b,info) + import :: psb_c_dns_sparse_mat, psb_c_base_sparse_mat, psb_epk_, psb_ipk_ + 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 + end subroutine psb_c_dns_mold + end interface + + ! + ! + !> 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 + ! + interface + subroutine psb_c_dns_allocate_mnnz(m,n,a,nz) + import :: psb_c_dns_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_c_dns_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_c_dns_allocate_mnnz + end interface + + ! + !> 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 + ! + interface + subroutine psb_c_cp_dns_to_coo(a,b,info) + import :: psb_c_coo_sparse_mat, psb_c_dns_sparse_mat, psb_ipk_ + class(psb_c_dns_sparse_mat), intent(in) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_dns_to_coo + end interface + + ! + !> 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 + ! + interface + subroutine psb_c_cp_dns_from_coo(a,b,info) + import :: psb_c_dns_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_dns_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_dns_from_coo + end interface + + ! + !> 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 + ! + interface + subroutine psb_c_mv_dns_to_coo(a,b,info) + import :: psb_c_dns_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_dns_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_dns_to_coo + end interface + + ! + !> 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 + ! + interface + subroutine psb_c_mv_dns_from_coo(a,b,info) + import :: psb_c_dns_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_dns_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_dns_from_coo + end interface + + ! + ! + !> 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 + !! + ! + interface + subroutine psb_c_dns_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_c_dns_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_dns_csgetrow + end interface + + + + !> 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) + !! + ! + interface + subroutine psb_c_dns_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_c_dns_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_dns_csmv + end interface + + !> 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) + !! + ! + interface + subroutine psb_c_dns_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_c_dns_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_dns_csmm + end interface + + ! + ! + !> Function csnmi: + !! \memberof psb_c_dns_sparse_mat + !! \brief Operator infinity norm + !! CSNMI = MAXVAL(SUM(ABS(A(:,:)),dim=2)) + !! + ! + interface + function psb_c_dns_csnmi(a) result(res) + import :: psb_c_dns_sparse_mat, psb_spk_ + class(psb_c_dns_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_dns_csnmi + end interface + + ! + !> 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. + ! + interface + subroutine psb_c_dns_get_diag(a,d,info) + import :: psb_c_dns_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_dns_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_dns_get_diag + end interface + + +contains + + ! + !> Function sizeof + !! \memberof psb_c_dns_sparse_mat + !! \brief Memory occupation in bytes + ! + function c_dns_sizeof(a) result(res) + implicit none + class(psb_c_dns_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + res = psb_sizeof_dp * size(a%val) + res = res + psb_sizeof_ip + + end function c_dns_sizeof + + ! + !> Function get_fmt + !! \memberof psb_c_dns_sparse_mat + !! \brief return a short descriptive name (e.g. COO CSR etc.) + ! + function c_dns_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DNS' + end function c_dns_get_fmt + + ! + !> Function get_nzeros + !! \memberof psb_c_dns_sparse_mat + !! \brief Current number of nonzero entries + ! + function c_dns_get_nzeros(a) result(res) + implicit none + class(psb_c_dns_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nnz + end function c_dns_get_nzeros + + ! + !> Function get_size + !! \memberof psb_c_dns_sparse_mat + !! \brief Maximum number of nonzeros the current structure can hold + ! this is fixed once you initialize the matrix, with dense storage + ! you can hold up to MxN entries + function c_dns_get_size(a) result(res) + implicit none + class(psb_c_dns_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + + res = size(a%val) + + end function c_dns_get_size + + + ! + !> Function get_nz_row. + !! \memberof psb_c_coo_sparse_mat + !! \brief How many nonzeros in a row? + !! + !! \param idx The row to search. + !! + ! + function c_dns_get_nz_row(idx,a) result(res) + + implicit none + + class(psb_c_dns_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: idx + integer(psb_ipk_) :: res + + res = 0 + + if ((1<=idx).and.(idx<=a%get_nrows())) then + res = count(a%val(idx,:) /= dzero) + end if + + end function c_dns_get_nz_row + + ! + !> Function free + !! \memberof psb_c_dns_sparse_mat + !! Name says all + + subroutine c_dns_free(a) + implicit none + + class(psb_c_dns_sparse_mat), intent(inout) :: a + + if (allocated(a%val)) deallocate(a%val) + a%nnz = 0 + + + ! + ! Mark the object as empty just in case + ! + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + + return + + end subroutine c_dns_free + + +end module psb_c_dns_mat_mod diff --git a/ext/psb_c_ell_mat_mod.f90 b/ext/psb_c_ell_mat_mod.f90 new file mode 100644 index 00000000..8eaf01ba --- /dev/null +++ b/ext/psb_c_ell_mat_mod.f90 @@ -0,0 +1,544 @@ +! 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. +! + + +module psb_c_ell_mat_mod + + use psb_c_base_mat_mod + + type, extends(psb_c_base_sparse_mat) :: psb_c_ell_sparse_mat + ! + ! ITPACK/ELL format, extended. + ! Based on M. Heroux "A proposal for a sparse BLAS toolkit". + ! IRN is our addition, should help in transferring to/from + ! other formats (should come in handy for GPUs). + ! Notes: + ! 1. JA holds the column indices, padded with the row index. + ! 2. VAL holds the coefficients, padded with zeros + ! 3. IDIAG hold the position of the diagonal element + ! or 0 if it is not there, but is only relevant for + ! triangular matrices. In particular, a unit triangular matrix + ! will have IDIAG==0. + ! 4. IRN holds the actual number of nonzeros stored in each row + ! 5. Within a row, the indices are sorted for use of SV. + ! + + integer(psb_ipk_) :: nzt + integer(psb_ipk_), allocatable :: irn(:), ja(:,:), idiag(:) + complex(psb_spk_), allocatable :: val(:,:) + + contains + procedure, pass(a) :: is_by_rows => c_ell_is_by_rows + procedure, pass(a) :: get_size => c_ell_get_size + procedure, pass(a) :: get_nzeros => c_ell_get_nzeros + procedure, nopass :: get_fmt => c_ell_get_fmt + procedure, pass(a) :: sizeof => c_ell_sizeof + procedure, pass(a) :: csmm => psb_c_ell_csmm + procedure, pass(a) :: csmv => psb_c_ell_csmv + procedure, pass(a) :: inner_cssm => psb_c_ell_cssm + procedure, pass(a) :: inner_cssv => psb_c_ell_cssv + procedure, pass(a) :: scals => psb_c_ell_scals + procedure, pass(a) :: scalv => psb_c_ell_scal + procedure, pass(a) :: maxval => psb_c_ell_maxval + procedure, pass(a) :: csnmi => psb_c_ell_csnmi + procedure, pass(a) :: csnm1 => psb_c_ell_csnm1 + procedure, pass(a) :: rowsum => psb_c_ell_rowsum + procedure, pass(a) :: arwsum => psb_c_ell_arwsum + procedure, pass(a) :: colsum => psb_c_ell_colsum + procedure, pass(a) :: aclsum => psb_c_ell_aclsum + procedure, pass(a) :: reallocate_nz => psb_c_ell_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_c_ell_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_c_cp_ell_to_coo + procedure, pass(a) :: cp_from_coo => psb_c_cp_ell_from_coo + procedure, pass(a) :: cp_to_fmt => psb_c_cp_ell_to_fmt + procedure, pass(a) :: cp_from_fmt => psb_c_cp_ell_from_fmt + procedure, pass(a) :: mv_to_coo => psb_c_mv_ell_to_coo + procedure, pass(a) :: mv_from_coo => psb_c_mv_ell_from_coo + procedure, pass(a) :: mv_to_fmt => psb_c_mv_ell_to_fmt + procedure, pass(a) :: mv_from_fmt => psb_c_mv_ell_from_fmt + procedure, pass(a) :: csput_a => psb_c_ell_csput_a + procedure, pass(a) :: get_diag => psb_c_ell_get_diag + procedure, pass(a) :: csgetptn => psb_c_ell_csgetptn + procedure, pass(a) :: csgetrow => psb_c_ell_csgetrow + procedure, pass(a) :: get_nz_row => c_ell_get_nz_row + procedure, pass(a) :: reinit => psb_c_ell_reinit + procedure, pass(a) :: trim => psb_c_ell_trim + procedure, pass(a) :: print => psb_c_ell_print + procedure, pass(a) :: free => c_ell_free + procedure, pass(a) :: mold => psb_c_ell_mold + + end type psb_c_ell_sparse_mat + + private :: c_ell_get_nzeros, c_ell_free, c_ell_get_fmt, & + & c_ell_get_size, c_ell_sizeof, c_ell_get_nz_row, & + & c_ell_is_by_rows + + interface + subroutine psb_c_ell_reallocate_nz(nz,a) + import :: psb_c_ell_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_c_ell_sparse_mat), intent(inout) :: a + end subroutine psb_c_ell_reallocate_nz + end interface + + interface + subroutine psb_c_ell_reinit(a,clear) + import :: psb_c_ell_sparse_mat + class(psb_c_ell_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + end subroutine psb_c_ell_reinit + end interface + + interface + subroutine psb_c_ell_trim(a) + import :: psb_c_ell_sparse_mat + class(psb_c_ell_sparse_mat), intent(inout) :: a + end subroutine psb_c_ell_trim + end interface + + interface + subroutine psb_c_ell_mold(a,b,info) + import :: psb_c_ell_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + 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 + end subroutine psb_c_ell_mold + end interface + + interface + subroutine psb_c_ell_allocate_mnnz(m,n,a,nz) + import :: psb_c_ell_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_c_ell_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_c_ell_allocate_mnnz + end interface + + interface + subroutine psb_c_ell_print(iout,a,iv,head,ivr,ivc) + import :: psb_c_ell_sparse_mat, psb_ipk_, psb_lpk_ + 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(:) + end subroutine psb_c_ell_print + end interface + + interface + subroutine psb_c_cp_ell_to_coo(a,b,info) + import :: psb_c_coo_sparse_mat, psb_c_ell_sparse_mat, psb_ipk_ + class(psb_c_ell_sparse_mat), intent(in) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_ell_to_coo + end interface + + interface + subroutine psb_c_cp_ell_from_coo(a,b,info) + import :: psb_c_ell_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_ell_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_ell_from_coo + end interface + + interface + subroutine psb_c_cp_ell_to_fmt(a,b,info) + import :: psb_c_ell_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_ell_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_ell_to_fmt + end interface + + interface + subroutine psb_c_cp_ell_from_fmt(a,b,info) + import :: psb_c_ell_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_ell_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_ell_from_fmt + end interface + + interface + subroutine psb_c_mv_ell_to_coo(a,b,info) + import :: psb_c_ell_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_ell_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_ell_to_coo + end interface + + interface + subroutine psb_c_mv_ell_from_coo(a,b,info) + import :: psb_c_ell_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_ell_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_ell_from_coo + end interface + + interface + subroutine psb_c_mv_ell_to_fmt(a,b,info) + import :: psb_c_ell_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_ell_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_ell_to_fmt + end interface + + interface + subroutine psb_c_mv_ell_from_fmt(a,b,info) + import :: psb_c_ell_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_ell_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_ell_from_fmt + end interface + + interface + subroutine psb_c_ell_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_c_ell_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_ell_csput_a + end interface + + interface + subroutine psb_c_ell_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + import :: psb_c_ell_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_ell_csgetptn + end interface + + interface + subroutine psb_c_ell_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_c_ell_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_ell_csgetrow + end interface + + interface + subroutine psb_c_ell_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + import :: psb_c_ell_sparse_mat, psb_spk_, psb_c_coo_sparse_mat, psb_ipk_ + 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 + end subroutine psb_c_ell_csgetblk + end interface + + interface + subroutine psb_c_ell_cssv(alpha,a,x,beta,y,info,trans) + import :: psb_c_ell_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_ell_cssv + subroutine psb_c_ell_cssm(alpha,a,x,beta,y,info,trans) + import :: psb_c_ell_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_ell_cssm + end interface + + interface + subroutine psb_c_ell_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_c_ell_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_ell_csmv + subroutine psb_c_ell_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_c_ell_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_ell_csmm + end interface + + + interface + function psb_c_ell_maxval(a) result(res) + import :: psb_c_ell_sparse_mat, psb_spk_ + class(psb_c_ell_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_ell_maxval + end interface + + interface + function psb_c_ell_csnmi(a) result(res) + import :: psb_c_ell_sparse_mat, psb_spk_ + class(psb_c_ell_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_ell_csnmi + end interface + + interface + function psb_c_ell_csnm1(a) result(res) + import :: psb_c_ell_sparse_mat, psb_spk_ + class(psb_c_ell_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_ell_csnm1 + end interface + + interface + subroutine psb_c_ell_rowsum(d,a) + import :: psb_c_ell_sparse_mat, psb_spk_ + class(psb_c_ell_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_ell_rowsum + end interface + + interface + subroutine psb_c_ell_arwsum(d,a) + import :: psb_c_ell_sparse_mat, psb_spk_ + class(psb_c_ell_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_ell_arwsum + end interface + + interface + subroutine psb_c_ell_colsum(d,a) + import :: psb_c_ell_sparse_mat, psb_spk_ + class(psb_c_ell_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_ell_colsum + end interface + + interface + subroutine psb_c_ell_aclsum(d,a) + import :: psb_c_ell_sparse_mat, psb_spk_ + class(psb_c_ell_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_ell_aclsum + end interface + + interface + subroutine psb_c_ell_get_diag(a,d,info) + import :: psb_c_ell_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_ell_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_ell_get_diag + end interface + + interface + subroutine psb_c_ell_scal(d,a,info,side) + import :: psb_c_ell_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_ell_scal + end interface + + interface + subroutine psb_c_ell_scals(d,a,info) + import :: psb_c_ell_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_ell_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_ell_scals + end interface + + interface + subroutine psi_c_convert_ell_from_coo(a,tmp,info,hacksize) + import :: psb_c_ell_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + implicit none + class(psb_c_ell_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: hacksize + end subroutine psi_c_convert_ell_from_coo + end interface + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function c_ell_is_by_rows(a) result(res) + implicit none + class(psb_c_ell_sparse_mat), intent(in) :: a + logical :: res + res = .true. + end function c_ell_is_by_rows + + function c_ell_sizeof(a) result(res) + implicit none + class(psb_c_ell_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + if (a%is_dev()) call a%sync() + res = 8 + res = res + (2*psb_sizeof_sp) * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%ja) + + end function c_ell_sizeof + + function c_ell_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'ELL' + end function c_ell_get_fmt + + function c_ell_get_nzeros(a) result(res) + implicit none + class(psb_c_ell_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nzt + end function c_ell_get_nzeros + + function c_ell_get_size(a) result(res) + implicit none + class(psb_c_ell_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + + res = -1 + if (a%is_dev()) call a%sync() + + if (allocated(a%ja)) then + if (res >= 0) then + res = min(res,size(a%ja)) + else + res = size(a%ja) + end if + end if + if (allocated(a%val)) then + if (res >= 0) then + res = min(res,size(a%val)) + else + res = size(a%val) + end if + end if + + end function c_ell_get_size + + + function c_ell_get_nz_row(idx,a) result(res) + + implicit none + + class(psb_c_ell_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: idx + integer(psb_ipk_) :: res + + res = 0 + if (a%is_dev()) call a%sync() + + if ((1<=idx).and.(idx<=a%get_nrows())) then + res = a%irn(idx) + end if + + end function c_ell_get_nz_row + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine c_ell_free(a) + implicit none + + class(psb_c_ell_sparse_mat), intent(inout) :: a + + if (allocated(a%idiag)) deallocate(a%idiag) + if (allocated(a%irn)) deallocate(a%irn) + if (allocated(a%ja)) deallocate(a%ja) + if (allocated(a%val)) deallocate(a%val) + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + + return + + end subroutine c_ell_free + + +end module psb_c_ell_mat_mod diff --git a/ext/psb_c_hdia_mat_mod.f90 b/ext/psb_c_hdia_mat_mod.f90 new file mode 100644 index 00000000..fbac05de --- /dev/null +++ b/ext/psb_c_hdia_mat_mod.f90 @@ -0,0 +1,534 @@ +! 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. +! + +module psb_c_hdia_mat_mod + + use psb_c_base_mat_mod + + + type, extends(psb_c_base_sparse_mat) :: psb_c_hdia_sparse_mat + ! + ! HDIA format + ! + integer(psb_ipk_), allocatable :: hackOffsets(:), diaOffsets(:) + complex(psb_spk_), allocatable :: val(:) + + + integer(psb_ipk_) :: nhacks, nzeros + integer(psb_ipk_) :: hacksize = 32 + integer(psb_epk_) :: dim=0 + + contains + ! procedure, pass(a) :: get_size => c_hdia_get_size + procedure, pass(a) :: get_nzeros => c_hdia_get_nzeros + procedure, pass(a) :: set_nzeros => c_hdia_set_nzeros + procedure, nopass :: get_fmt => c_hdia_get_fmt + procedure, pass(a) :: sizeof => c_hdia_sizeof + ! procedure, pass(a) :: csmm => psb_c_hdia_csmm + procedure, pass(a) :: csmv => psb_c_hdia_csmv + ! procedure, pass(a) :: inner_cssm => psb_c_hdia_cssm + ! procedure, pass(a) :: inner_cssv => psb_c_hdia_cssv + ! procedure, pass(a) :: scals => psb_c_hdia_scals + ! procedure, pass(a) :: scalv => psb_c_hdia_scal + ! procedure, pass(a) :: maxval => psb_c_hdia_maxval + ! procedure, pass(a) :: csnmi => psb_c_hdia_csnmi + ! procedure, pass(a) :: csnm1 => psb_c_hdia_csnm1 + ! procedure, pass(a) :: rowsum => psb_c_hdia_rowsum + ! procedure, pass(a) :: arwsum => psb_c_hdia_arwsum + ! procedure, pass(a) :: colsum => psb_c_hdia_colsum + ! procedure, pass(a) :: aclsum => psb_c_hdia_aclsum + ! procedure, pass(a) :: reallocate_nz => psb_c_hdia_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_c_hdia_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_c_cp_hdia_to_coo + procedure, pass(a) :: cp_from_coo => psb_c_cp_hdia_from_coo + ! procedure, pass(a) :: cp_to_fmt => psb_c_cp_hdia_to_fmt + ! procedure, pass(a) :: cp_from_fmt => psb_c_cp_hdia_from_fmt + procedure, pass(a) :: mv_to_coo => psb_c_mv_hdia_to_coo + procedure, pass(a) :: mv_from_coo => psb_c_mv_hdia_from_coo + ! procedure, pass(a) :: mv_to_fmt => psb_c_mv_hdia_to_fmt + ! procedure, pass(a) :: mv_from_fmt => psb_c_mv_hdia_from_fmt + ! procedure, pass(a) :: csput_a => psb_c_hdia_csput_a + ! procedure, pass(a) :: get_diag => psb_c_hdia_get_diag + ! procedure, pass(a) :: csgetptn => psb_c_hdia_csgetptn + ! procedure, pass(a) :: csgetrow => psb_c_hdia_csgetrow + ! procedure, pass(a) :: get_nz_row => c_hdia_get_nz_row + ! procedure, pass(a) :: reinit => psb_c_hdia_reinit + ! procedure, pass(a) :: trim => psb_c_hdia_trim + procedure, pass(a) :: print => psb_c_hdia_print + procedure, pass(a) :: free => c_hdia_free + procedure, pass(a) :: mold => psb_c_hdia_mold + + end type psb_c_hdia_sparse_mat + + private :: c_hdia_get_nzeros, c_hdia_set_nzeros, c_hdia_free, & + & c_hdia_get_fmt, c_hdia_sizeof +!!$ & +!!$ & c_hdia_get_nz_row c_hdia_get_size, + +!!$ interface +!!$ subroutine psb_c_hdia_reallocate_nz(nz,a) +!!$ import :: psb_c_hdia_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_c_hdia_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_c_hdia_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_hdia_reinit(a,clear) +!!$ import :: psb_c_hdia_sparse_mat +!!$ class(psb_c_hdia_sparse_mat), intent(inout) :: a +!!$ logical, intent(in), optional :: clear +!!$ end subroutine psb_c_hdia_reinit +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_hdia_trim(a) +!!$ import :: psb_c_hdia_sparse_mat +!!$ class(psb_c_hdia_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_c_hdia_trim +!!$ end interface + + interface + subroutine psb_c_hdia_mold(a,b,info) + import :: psb_c_hdia_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + 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 + end subroutine psb_c_hdia_mold + end interface + + interface + subroutine psb_c_hdia_allocate_mnnz(m,n,a,nz) + import :: psb_c_hdia_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_c_hdia_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_c_hdia_allocate_mnnz + end interface + + interface + subroutine psb_c_hdia_print(iout,a,iv,head,ivr,ivc) + import :: psb_c_hdia_sparse_mat, psb_ipk_, psb_lpk_ + 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(:) + end subroutine psb_c_hdia_print + end interface + + interface + subroutine psb_c_cp_hdia_to_coo(a,b,info) + import :: psb_c_coo_sparse_mat, psb_c_hdia_sparse_mat, psb_ipk_ + class(psb_c_hdia_sparse_mat), intent(in) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_hdia_to_coo + end interface + + interface + subroutine psb_c_cp_hdia_from_coo(a,b,info) + import :: psb_c_hdia_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_hdia_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_hdia_from_coo + end interface + +!!$ interface +!!$ subroutine psb_c_cp_hdia_to_fmt(a,b,info) +!!$ import :: psb_c_hdia_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ +!!$ class(psb_c_hdia_sparse_mat), intent(in) :: a +!!$ class(psb_c_base_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_c_cp_hdia_to_fmt +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_cp_hdia_from_fmt(a,b,info) +!!$ import :: psb_c_hdia_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ +!!$ class(psb_c_hdia_sparse_mat), intent(inout) :: a +!!$ class(psb_c_base_sparse_mat), intent(in) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_c_cp_hdia_from_fmt +!!$ end interface + + interface + subroutine psb_c_mv_hdia_to_coo(a,b,info) + import :: psb_c_hdia_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_hdia_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_hdia_to_coo + end interface + + interface + subroutine psb_c_mv_hdia_from_coo(a,b,info) + import :: psb_c_hdia_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_hdia_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_hdia_from_coo + end interface + +!!$ interface +!!$ subroutine psb_c_mv_hdia_to_fmt(a,b,info) +!!$ import :: psb_c_hdia_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ +!!$ class(psb_c_hdia_sparse_mat), intent(inout) :: a +!!$ class(psb_c_base_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_c_mv_hdia_to_fmt +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_mv_hdia_from_fmt(a,b,info) +!!$ import :: psb_c_hdia_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ +!!$ class(psb_c_hdia_sparse_mat), intent(inout) :: a +!!$ class(psb_c_base_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_c_mv_hdia_from_fmt +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_hdia_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) +!!$ import :: psb_c_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_c_hdia_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 +!!$ end subroutine psb_c_hdia_csput_a +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_hdia_csgetptn(imin,imax,a,nz,ia,ja,info,& +!!$ & jmin,jmax,iren,append,nzin,rscale,cscale) +!!$ import :: psb_c_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_c_hdia_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 +!!$ end subroutine psb_c_hdia_csgetptn +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_hdia_csgetrow(imin,imax,a,nz,ia,ja,val,info,& +!!$ & jmin,jmax,iren,append,nzin,rscale,cscale) +!!$ import :: psb_c_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_c_hdia_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 +!!$ end subroutine psb_c_hdia_csgetrow +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_hdia_csgetblk(imin,imax,a,b,info,& +!!$ & jmin,jmax,iren,append,rscale,cscale) +!!$ import :: psb_c_hdia_sparse_mat, psb_spk_, psb_c_coo_sparse_mat, psb_ipk_ +!!$ class(psb_c_hdia_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 +!!$ end subroutine psb_c_hdia_csgetblk +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_hdia_cssv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_c_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ 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 +!!$ end subroutine psb_c_hdia_cssv +!!$ subroutine psb_c_hdia_cssm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_c_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ 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 +!!$ end subroutine psb_c_hdia_cssm +!!$ end interface + + interface + subroutine psb_c_hdia_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_c_hdia_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_hdia_csmv +!!$ subroutine psb_c_hdia_csmm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_c_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ 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 +!!$ end subroutine psb_c_hdia_csmm + end interface + + +!!$ interface +!!$ function psb_c_hdia_maxval(a) result(res) +!!$ import :: psb_c_hdia_sparse_mat, psb_spk_ +!!$ class(psb_c_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_spk_) :: res +!!$ end function psb_c_hdia_maxval +!!$ end interface +!!$ +!!$ interface +!!$ function psb_c_hdia_csnmi(a) result(res) +!!$ import :: psb_c_hdia_sparse_mat, psb_spk_ +!!$ class(psb_c_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_spk_) :: res +!!$ end function psb_c_hdia_csnmi +!!$ end interface +!!$ +!!$ interface +!!$ function psb_c_hdia_csnm1(a) result(res) +!!$ import :: psb_c_hdia_sparse_mat, psb_spk_ +!!$ class(psb_c_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_spk_) :: res +!!$ end function psb_c_hdia_csnm1 +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_hdia_rowsum(d,a) +!!$ import :: psb_c_hdia_sparse_mat, psb_spk_ +!!$ class(psb_c_hdia_sparse_mat), intent(in) :: a +!!$ complex(psb_spk_), intent(out) :: d(:) +!!$ end subroutine psb_c_hdia_rowsum +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_hdia_arwsum(d,a) +!!$ import :: psb_c_hdia_sparse_mat, psb_spk_ +!!$ class(psb_c_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_spk_), intent(out) :: d(:) +!!$ end subroutine psb_c_hdia_arwsum +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_hdia_colsum(d,a) +!!$ import :: psb_c_hdia_sparse_mat, psb_spk_ +!!$ class(psb_c_hdia_sparse_mat), intent(in) :: a +!!$ complex(psb_spk_), intent(out) :: d(:) +!!$ end subroutine psb_c_hdia_colsum +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_hdia_aclsum(d,a) +!!$ import :: psb_c_hdia_sparse_mat, psb_spk_ +!!$ class(psb_c_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_spk_), intent(out) :: d(:) +!!$ end subroutine psb_c_hdia_aclsum +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_hdia_get_diag(a,d,info) +!!$ import :: psb_c_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_c_hdia_sparse_mat), intent(in) :: a +!!$ complex(psb_spk_), intent(out) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_c_hdia_get_diag +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_c_hdia_scal(d,a,info,side) +!!$ import :: psb_c_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_c_hdia_sparse_mat), intent(inout) :: a +!!$ complex(psb_spk_), intent(in) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, intent(in), optional :: side +!!$ end subroutine psb_c_hdia_scal +!!$ end interface + +!!$ interface +!!$ subroutine psb_c_hdia_scals(d,a,info) +!!$ import :: psb_c_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_c_hdia_sparse_mat), intent(inout) :: a +!!$ complex(psb_spk_), intent(in) :: d +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_c_hdia_scals +!!$ end interface +!!$ + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function c_hdia_sizeof(a) result(res) + use psb_realloc_mod, only : psb_size + implicit none + class(psb_c_hdia_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + integer(psb_ipk_) :: i + + if (a%is_dev()) call a%sync() + res = 0 + + res = res + psb_size(a%hackOffsets)*psb_sizeof_ip + res = res + psb_size(a%diaOffsets)*psb_sizeof_ip + res = res + psb_size(a%val) * (2*psb_sizeof_sp) + + end function c_hdia_sizeof + + function c_hdia_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HDIA' + end function c_hdia_get_fmt + + function c_hdia_get_nzeros(a) result(res) + implicit none + class(psb_c_hdia_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nzeros + end function c_hdia_get_nzeros + + subroutine c_hdia_set_nzeros(a,nz) + implicit none + class(psb_c_hdia_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: nz + a%nzeros = nz + end subroutine c_hdia_set_nzeros + + ! function c_hdia_get_size(a) result(res) + ! implicit none + ! class(psb_c_hdia_sparse_mat), intent(in) :: a + ! integer(psb_ipk_) :: res + + ! res = -1 + + ! if (allocated(a%ja)) then + ! if (res >= 0) then + ! res = min(res,size(a%ja)) + ! else + ! res = size(a%ja) + ! end if + ! end if + ! if (allocated(a%val)) then + ! if (res >= 0) then + ! res = min(res,size(a%val)) + ! else + ! res = size(a%val) + ! end if + ! end if + + ! end function c_hdia_get_size + + + ! function c_hdia_get_nz_row(idx,a) result(res) + + ! implicit none + + ! class(psb_c_hdia_sparse_mat), intent(in) :: a + ! integer(psb_ipk_), intent(in) :: idx + ! integer(psb_ipk_) :: res + + ! res = 0 + + ! if ((1<=idx).and.(idx<=a%get_nrows())) then + ! res = a%irn(idx) + ! end if + + ! end function c_hdia_get_nz_row + + + + ! ! == =================================== + ! ! + ! ! + ! ! + ! ! Data management + ! ! + ! ! + ! ! + ! ! + ! ! + ! ! == =================================== + + subroutine c_hdia_free(a) + implicit none + + class(psb_c_hdia_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: i, info + + + if (allocated(a%hackOffsets))& + & deallocate(a%hackOffsets,stat=info) + if (allocated(a%diaOffsets))& + & deallocate(a%diaOffsets,stat=info) + if (allocated(a%val))& + & deallocate(a%val,stat=info) + a%nhacks=0 + + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + + return + + end subroutine c_hdia_free + + +end module psb_c_hdia_mat_mod diff --git a/ext/psb_c_hll_mat_mod.f90 b/ext/psb_c_hll_mat_mod.f90 new file mode 100644 index 00000000..966b60f5 --- /dev/null +++ b/ext/psb_c_hll_mat_mod.f90 @@ -0,0 +1,564 @@ +! 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. +! + + +module psb_c_hll_mat_mod + + use psb_c_base_mat_mod + use psi_ext_util_mod + + type, extends(psb_c_base_sparse_mat) :: psb_c_hll_sparse_mat + ! + ! HLL format. (Hacked ELL) + ! A modification of ELL. + ! Basic idea: pack and pad data in blocks of HCK rows; + ! this reduces the impact of a lone, very long row. + ! Notes: + ! 1. JA holds the column indices, padded with the row index. + ! 2. VAL holds the coefficients, padded with zeros + ! 3. IDIAG hold the position of the diagonal element + ! or 0 if it is not there, but is only relevant for + ! triangular matrices. In particular, a unit triangular matrix + ! will have IDIAG==0. + ! 4. IRN holds the actual number of nonzeros stored in each row + ! 5. Within a row, the indices are sorted for use of SV. + ! 6. hksz: hack size (multiple of 32) + ! 7. hkoffs(:): offsets of the starts of hacks inside ja/val + ! + ! + ! + integer(psb_ipk_) :: hksz, nzt + integer(psb_ipk_), allocatable :: irn(:), ja(:), idiag(:), hkoffs(:) + complex(psb_spk_), allocatable :: val(:) + + contains + + procedure, pass(a) :: get_hksz => c_hll_get_hksz + procedure, pass(a) :: set_hksz => c_hll_set_hksz + procedure, pass(a) :: get_size => c_hll_get_size + procedure, pass(a) :: set_nzeros => c_hll_set_nzeros + procedure, pass(a) :: get_nzeros => c_hll_get_nzeros + procedure, nopass :: get_fmt => c_hll_get_fmt + procedure, pass(a) :: sizeof => c_hll_sizeof + procedure, pass(a) :: csmm => psb_c_hll_csmm + procedure, pass(a) :: csmv => psb_c_hll_csmv + procedure, pass(a) :: inner_cssm => psb_c_hll_cssm + procedure, pass(a) :: inner_cssv => psb_c_hll_cssv + procedure, pass(a) :: scals => psb_c_hll_scals + procedure, pass(a) :: scalv => psb_c_hll_scal + procedure, pass(a) :: maxval => psb_c_hll_maxval + procedure, pass(a) :: csnmi => psb_c_hll_csnmi + procedure, pass(a) :: csnm1 => psb_c_hll_csnm1 + procedure, pass(a) :: rowsum => psb_c_hll_rowsum + procedure, pass(a) :: arwsum => psb_c_hll_arwsum + procedure, pass(a) :: colsum => psb_c_hll_colsum + procedure, pass(a) :: aclsum => psb_c_hll_aclsum + procedure, pass(a) :: reallocate_nz => psb_c_hll_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_c_hll_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_c_cp_hll_to_coo + procedure, pass(a) :: cp_from_coo => psb_c_cp_hll_from_coo + procedure, pass(a) :: cp_to_fmt => psb_c_cp_hll_to_fmt + procedure, pass(a) :: cp_from_fmt => psb_c_cp_hll_from_fmt + procedure, pass(a) :: mv_to_coo => psb_c_mv_hll_to_coo + procedure, pass(a) :: mv_from_coo => psb_c_mv_hll_from_coo + procedure, pass(a) :: mv_to_fmt => psb_c_mv_hll_to_fmt + procedure, pass(a) :: mv_from_fmt => psb_c_mv_hll_from_fmt + procedure, pass(a) :: csput_a => psb_c_hll_csput_a + procedure, pass(a) :: get_diag => psb_c_hll_get_diag + procedure, pass(a) :: csgetptn => psb_c_hll_csgetptn + procedure, pass(a) :: csgetrow => psb_c_hll_csgetrow + procedure, pass(a) :: get_nz_row => c_hll_get_nz_row + procedure, pass(a) :: reinit => psb_c_hll_reinit + procedure, pass(a) :: print => psb_c_hll_print + procedure, pass(a) :: free => c_hll_free + procedure, pass(a) :: mold => psb_c_hll_mold + + end type psb_c_hll_sparse_mat + + private :: c_hll_get_nzeros, c_hll_free, c_hll_get_fmt, & + & c_hll_get_size, c_hll_sizeof, c_hll_get_nz_row, & + & c_hll_set_nzeros, c_hll_get_hksz, c_hll_set_hksz + + interface + subroutine psb_c_hll_reallocate_nz(nz,a) + import :: psb_c_hll_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_c_hll_sparse_mat), intent(inout) :: a + end subroutine psb_c_hll_reallocate_nz + end interface + + interface + subroutine psb_c_hll_reinit(a,clear) + import :: psb_c_hll_sparse_mat + class(psb_c_hll_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + end subroutine psb_c_hll_reinit + end interface + + interface + subroutine psb_c_hll_mold(a,b,info) + import :: psb_c_hll_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + 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 + end subroutine psb_c_hll_mold + end interface + + interface + subroutine psb_c_hll_allocate_mnnz(m,n,a,nz) + import :: psb_c_hll_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_c_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_c_hll_allocate_mnnz + end interface + + interface + subroutine psb_c_hll_print(iout,a,iv,head,ivr,ivc) + import :: psb_c_hll_sparse_mat, psb_ipk_, psb_lpk_ + 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(:) + end subroutine psb_c_hll_print + end interface + + interface + subroutine psb_c_cp_hll_to_coo(a,b,info) + import :: psb_c_coo_sparse_mat, psb_c_hll_sparse_mat, psb_ipk_ + class(psb_c_hll_sparse_mat), intent(in) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_hll_to_coo + end interface + + interface + subroutine psb_c_cp_hll_from_coo(a,b,info) + import :: psb_c_hll_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_hll_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_hll_from_coo + end interface + + interface + subroutine psb_c_cp_hll_to_fmt(a,b,info) + import :: psb_c_hll_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_hll_sparse_mat), intent(in) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_hll_to_fmt + end interface + + interface + subroutine psb_c_cp_hll_from_fmt(a,b,info) + import :: psb_c_hll_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_hll_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_cp_hll_from_fmt + end interface + + interface + subroutine psb_c_mv_hll_to_coo(a,b,info) + import :: psb_c_hll_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_hll_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_hll_to_coo + end interface + + interface + subroutine psb_c_mv_hll_from_coo(a,b,info) + import :: psb_c_hll_sparse_mat, psb_c_coo_sparse_mat, psb_ipk_ + class(psb_c_hll_sparse_mat), intent(inout) :: a + class(psb_c_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_hll_from_coo + end interface + + interface + subroutine psb_c_mv_hll_to_fmt(a,b,info) + import :: psb_c_hll_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_hll_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_hll_to_fmt + end interface + + interface + subroutine psb_c_mv_hll_from_fmt(a,b,info) + import :: psb_c_hll_sparse_mat, psb_c_base_sparse_mat, psb_ipk_ + class(psb_c_hll_sparse_mat), intent(inout) :: a + class(psb_c_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_mv_hll_from_fmt + end interface + + interface + subroutine psb_c_hll_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_c_hll_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_hll_csput_a + end interface + + interface + subroutine psb_c_hll_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + import :: psb_c_hll_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_hll_csgetptn + end interface + + interface + subroutine psb_c_hll_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_c_hll_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_hll_csgetrow + end interface + + interface + subroutine psb_c_hll_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + import :: psb_c_hll_sparse_mat, psb_spk_, psb_c_coo_sparse_mat, psb_ipk_ + 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 + end subroutine psb_c_hll_csgetblk + end interface + + interface + subroutine psb_c_hll_cssv(alpha,a,x,beta,y,info,trans) + import :: psb_c_hll_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_hll_cssv + subroutine psb_c_hll_cssm(alpha,a,x,beta,y,info,trans) + import :: psb_c_hll_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_hll_cssm + end interface + + interface + subroutine psb_c_hll_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_c_hll_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_hll_csmv + subroutine psb_c_hll_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_c_hll_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_hll_csmm + end interface + + + interface + function psb_c_hll_maxval(a) result(res) + import :: psb_c_hll_sparse_mat, psb_spk_ + class(psb_c_hll_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_hll_maxval + end interface + + interface + function psb_c_hll_csnmi(a) result(res) + import :: psb_c_hll_sparse_mat, psb_spk_ + class(psb_c_hll_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_hll_csnmi + end interface + + interface + function psb_c_hll_csnm1(a) result(res) + import :: psb_c_hll_sparse_mat, psb_spk_ + class(psb_c_hll_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_c_hll_csnm1 + end interface + + interface + subroutine psb_c_hll_rowsum(d,a) + import :: psb_c_hll_sparse_mat, psb_spk_ + class(psb_c_hll_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_hll_rowsum + end interface + + interface + subroutine psb_c_hll_arwsum(d,a) + import :: psb_c_hll_sparse_mat, psb_spk_ + class(psb_c_hll_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_hll_arwsum + end interface + + interface + subroutine psb_c_hll_colsum(d,a) + import :: psb_c_hll_sparse_mat, psb_spk_ + class(psb_c_hll_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_hll_colsum + end interface + + interface + subroutine psb_c_hll_aclsum(d,a) + import :: psb_c_hll_sparse_mat, psb_spk_ + class(psb_c_hll_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_c_hll_aclsum + end interface + + interface + subroutine psb_c_hll_get_diag(a,d,info) + import :: psb_c_hll_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_hll_sparse_mat), intent(in) :: a + complex(psb_spk_), intent(out) :: d(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_hll_get_diag + end interface + + interface + subroutine psb_c_hll_scal(d,a,info,side) + import :: psb_c_hll_sparse_mat, psb_spk_, psb_ipk_ + 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 + end subroutine psb_c_hll_scal + end interface + + interface + subroutine psb_c_hll_scals(d,a,info) + import :: psb_c_hll_sparse_mat, psb_spk_, psb_ipk_ + class(psb_c_hll_sparse_mat), intent(inout) :: a + complex(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_hll_scals + end interface + + interface psi_convert_hll_from_coo + subroutine psi_c_convert_hll_from_coo(a,hksz,tmp,info) + import :: psb_c_hll_sparse_mat, psb_ipk_, psb_c_coo_sparse_mat + implicit none + class(psb_c_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: hksz + class(psb_c_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(out) :: info + end subroutine psi_c_convert_hll_from_coo + end interface + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function c_hll_sizeof(a) result(res) + implicit none + class(psb_c_hll_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + if (a%is_dev()) call a%sync() + res = 8 + res = res + (2*psb_sizeof_sp) * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%ja) + res = res + psb_sizeof_ip * size(a%hkoffs) + + end function c_hll_sizeof + + function c_hll_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HLL' + end function c_hll_get_fmt + + subroutine c_hll_set_nzeros(a,n) + implicit none + class(psb_c_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: n + + a%nzt = n + end subroutine c_hll_set_nzeros + + function c_hll_get_nzeros(a) result(res) + implicit none + class(psb_c_hll_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nzt + end function c_hll_get_nzeros + + function c_hll_get_size(a) result(res) + implicit none + class(psb_c_hll_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + + if (a%is_dev()) call a%sync() + + res = -1 + + if (allocated(a%ja)) then + if (res >= 0) then + res = min(res,size(a%ja)) + else + res = size(a%ja) + end if + end if + if (allocated(a%val)) then + if (res >= 0) then + res = min(res,size(a%val)) + else + res = size(a%val) + end if + end if + + end function c_hll_get_size + + + + function c_hll_get_nz_row(idx,a) result(res) + + implicit none + + class(psb_c_hll_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: idx + integer(psb_ipk_) :: res + + res = 0 + + if ((1<=idx).and.(idx<=a%get_nrows())) then + res = a%irn(idx) + end if + + end function c_hll_get_nz_row + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine c_hll_free(a) + implicit none + + class(psb_c_hll_sparse_mat), intent(inout) :: a + + if (allocated(a%idiag)) deallocate(a%idiag) + if (allocated(a%irn)) deallocate(a%irn) + if (allocated(a%ja)) deallocate(a%ja) + if (allocated(a%val)) deallocate(a%val) + if (allocated(a%val)) deallocate(a%hkoffs) + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + call a%set_hksz(izero) + + return + + end subroutine c_hll_free + + subroutine c_hll_set_hksz(a,n) + implicit none + class(psb_c_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: n + + a%hksz = n + end subroutine c_hll_set_hksz + + function c_hll_get_hksz(a) result(res) + implicit none + class(psb_c_hll_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + + res = a%hksz + + end function c_hll_get_hksz + +end module psb_c_hll_mat_mod diff --git a/ext/psb_d_dia_mat_mod.f90 b/ext/psb_d_dia_mat_mod.f90 new file mode 100644 index 00000000..7df615ac --- /dev/null +++ b/ext/psb_d_dia_mat_mod.f90 @@ -0,0 +1,513 @@ +! 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. +! + + +module psb_d_dia_mat_mod + + use psb_d_base_mat_mod + + type, extends(psb_d_base_sparse_mat) :: psb_d_dia_sparse_mat + ! + ! DIA format, extended. + ! + + integer(psb_ipk_), allocatable :: offset(:) + integer(psb_ipk_) :: nzeros + real(psb_dpk_), allocatable :: data(:,:) + + contains + ! procedure, pass(a) :: get_size => d_dia_get_size + procedure, pass(a) :: get_nzeros => d_dia_get_nzeros + procedure, nopass :: get_fmt => d_dia_get_fmt + procedure, pass(a) :: sizeof => d_dia_sizeof + procedure, pass(a) :: csmm => psb_d_dia_csmm + procedure, pass(a) :: csmv => psb_d_dia_csmv + ! procedure, pass(a) :: inner_cssm => psb_d_dia_cssm + ! procedure, pass(a) :: inner_cssv => psb_d_dia_cssv + procedure, pass(a) :: scals => psb_d_dia_scals + procedure, pass(a) :: scalv => psb_d_dia_scal + procedure, pass(a) :: maxval => psb_d_dia_maxval + procedure, pass(a) :: rowsum => psb_d_dia_rowsum + procedure, pass(a) :: arwsum => psb_d_dia_arwsum + procedure, pass(a) :: colsum => psb_d_dia_colsum + procedure, pass(a) :: aclsum => psb_d_dia_aclsum + procedure, pass(a) :: reallocate_nz => psb_d_dia_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_d_dia_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_d_cp_dia_to_coo + procedure, pass(a) :: cp_from_coo => psb_d_cp_dia_from_coo + ! procedure, pass(a) :: mv_to_coo => psb_d_mv_dia_to_coo + procedure, pass(a) :: mv_from_coo => psb_d_mv_dia_from_coo + ! procedure, pass(a) :: mv_to_fmt => psb_d_mv_dia_to_fmt + ! procedure, pass(a) :: mv_from_fmt => psb_d_mv_dia_from_fmt + ! procedure, pass(a) :: csput_a => psb_d_dia_csput_a + procedure, pass(a) :: get_diag => psb_d_dia_get_diag + procedure, pass(a) :: csgetptn => psb_d_dia_csgetptn + procedure, pass(a) :: csgetrow => psb_d_dia_csgetrow + ! procedure, pass(a) :: get_nz_row => d_dia_get_nz_row + procedure, pass(a) :: reinit => psb_d_dia_reinit + ! procedure, pass(a) :: trim => psb_d_dia_trim + procedure, pass(a) :: print => psb_d_dia_print + procedure, pass(a) :: free => d_dia_free + procedure, pass(a) :: mold => psb_d_dia_mold + + end type psb_d_dia_sparse_mat + + private :: d_dia_get_nzeros, d_dia_free, d_dia_get_fmt, & + & d_dia_sizeof !, d_dia_get_size, d_dia_get_nz_row + + interface + subroutine psb_d_dia_reallocate_nz(nz,a) + import :: psb_d_dia_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_d_dia_sparse_mat), intent(inout) :: a + end subroutine psb_d_dia_reallocate_nz + end interface + + interface + subroutine psb_d_dia_reinit(a,clear) + import :: psb_d_dia_sparse_mat + class(psb_d_dia_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + end subroutine psb_d_dia_reinit + end interface + + interface + subroutine psb_d_dia_trim(a) + import :: psb_d_dia_sparse_mat + class(psb_d_dia_sparse_mat), intent(inout) :: a + end subroutine psb_d_dia_trim + end interface + + interface + subroutine psb_d_dia_mold(a,b,info) + import :: psb_d_dia_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_dia_mold + end interface + + interface + subroutine psb_d_dia_allocate_mnnz(m,n,a,nz) + import :: psb_d_dia_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_dia_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_d_dia_allocate_mnnz + end interface + + interface + subroutine psb_d_dia_print(iout,a,iv,head,ivr,ivc) + import :: psb_d_dia_sparse_mat, psb_ipk_, psb_lpk_ + integer(psb_ipk_), intent(in) :: iout + class(psb_d_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(:) + end subroutine psb_d_dia_print + end interface + + interface + subroutine psb_d_cp_dia_to_coo(a,b,info) + import :: psb_d_coo_sparse_mat, psb_d_dia_sparse_mat, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(in) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_dia_to_coo + end interface + + interface + subroutine psb_d_cp_dia_from_coo(a,b,info) + import :: psb_d_dia_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_dia_from_coo + end interface + + interface + subroutine psb_d_cp_dia_to_fmt(a,b,info) + import :: psb_d_dia_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_dia_to_fmt + end interface + + interface + subroutine psb_d_cp_dia_from_fmt(a,b,info) + import :: psb_d_dia_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_dia_from_fmt + end interface + + interface + subroutine psb_d_mv_dia_to_coo(a,b,info) + import :: psb_d_dia_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_dia_to_coo + end interface + + interface + subroutine psb_d_mv_dia_from_coo(a,b,info) + import :: psb_d_dia_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_dia_from_coo + end interface + + interface + subroutine psb_d_mv_dia_to_fmt(a,b,info) + import :: psb_d_dia_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_dia_to_fmt + end interface + + interface + subroutine psb_d_mv_dia_from_fmt(a,b,info) + import :: psb_d_dia_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_dia_from_fmt + end interface + + interface + subroutine psb_d_dia_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_d_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& + & imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_dia_csput_a + end interface + + interface + subroutine psb_d_dia_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + import :: psb_d_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_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 + end subroutine psb_d_dia_csgetptn + end interface + + interface + subroutine psb_d_dia_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_d_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_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(:) + real(psb_dpk_), 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 + end subroutine psb_d_dia_csgetrow + end interface + + interface + subroutine psb_d_dia_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + import :: psb_d_dia_sparse_mat, psb_dpk_, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(in) :: a + class(psb_d_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 + end subroutine psb_d_dia_csgetblk + end interface + + interface + subroutine psb_d_dia_cssv(alpha,a,x,beta,y,info,trans) + import :: psb_d_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_dia_cssv + subroutine psb_d_dia_cssm(alpha,a,x,beta,y,info,trans) + import :: psb_d_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_dia_cssm + end interface + + interface + subroutine psb_d_dia_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_d_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_dia_csmv + subroutine psb_d_dia_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_d_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_dia_csmm + end interface + + + interface + function psb_d_dia_maxval(a) result(res) + import :: psb_d_dia_sparse_mat, psb_dpk_ + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_d_dia_maxval + end interface + + interface + function psb_d_dia_csnmi(a) result(res) + import :: psb_d_dia_sparse_mat, psb_dpk_ + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_d_dia_csnmi + end interface + + interface + function psb_d_dia_csnm1(a) result(res) + import :: psb_d_dia_sparse_mat, psb_dpk_ + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_d_dia_csnm1 + end interface + + interface + subroutine psb_d_dia_rowsum(d,a) + import :: psb_d_dia_sparse_mat, psb_dpk_ + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_d_dia_rowsum + end interface + + interface + subroutine psb_d_dia_arwsum(d,a) + import :: psb_d_dia_sparse_mat, psb_dpk_ + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_d_dia_arwsum + end interface + + interface + subroutine psb_d_dia_colsum(d,a) + import :: psb_d_dia_sparse_mat, psb_dpk_ + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_d_dia_colsum + end interface + + interface + subroutine psb_d_dia_aclsum(d,a) + import :: psb_d_dia_sparse_mat, psb_dpk_ + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_d_dia_aclsum + end interface + + interface + subroutine psb_d_dia_get_diag(a,d,info) + import :: psb_d_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_dia_get_diag + end interface + + interface + subroutine psb_d_dia_scal(d,a,info,side) + import :: psb_d_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_d_dia_scal + end interface + + interface + subroutine psb_d_dia_scals(d,a,info) + import :: psb_d_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_dia_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_dia_scals + end interface + + interface psi_convert_dia_from_coo + subroutine psi_d_convert_dia_from_coo(a,tmp,info) + import :: psb_d_dia_sparse_mat, psb_ipk_, psb_d_coo_sparse_mat + implicit none + class(psb_d_dia_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(out) :: info + end subroutine psi_d_convert_dia_from_coo + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function d_dia_sizeof(a) result(res) + implicit none + class(psb_d_dia_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + if (a%is_dev()) call a%sync() + res = 8 + res = res + psb_sizeof_dp * size(a%data) + res = res + psb_sizeof_ip * size(a%offset) + + end function d_dia_sizeof + + function d_dia_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DIA' + end function d_dia_get_fmt + + function d_dia_get_nzeros(a) result(res) + implicit none + class(psb_d_dia_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nzeros + end function d_dia_get_nzeros + + ! function d_dia_get_size(a) result(res) + ! implicit none + ! class(psb_d_dia_sparse_mat), intent(in) :: a + ! integer(psb_ipk_) :: res + + ! res = -1 + + ! if (allocated(a%ja)) then + ! if (res >= 0) then + ! res = min(res,size(a%ja)) + ! else + ! res = size(a%ja) + ! end if + ! end if + ! if (allocated(a%val)) then + ! if (res >= 0) then + ! res = min(res,size(a%val)) + ! else + ! res = size(a%val) + ! end if + ! end if + + ! end function d_dia_get_size + + + ! function d_dia_get_nz_row(idx,a) result(res) + + ! implicit none + + ! class(psb_d_dia_sparse_mat), intent(in) :: a + ! integer(psb_ipk_), intent(in) :: idx + ! integer(psb_ipk_) :: res + + ! res = 0 + + ! if ((1<=idx).and.(idx<=a%get_nrows())) then + ! res = a%irn(idx) + ! end if + + ! end function d_dia_get_nz_row + + + + ! ! == =================================== + ! ! + ! ! + ! ! + ! ! Data management + ! ! + ! ! + ! ! + ! ! + ! ! + ! ! == =================================== + + subroutine d_dia_free(a) + implicit none + + class(psb_d_dia_sparse_mat), intent(inout) :: a + + if (allocated(a%data)) deallocate(a%data) + if (allocated(a%offset)) deallocate(a%offset) + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + + return + + end subroutine d_dia_free + + +end module psb_d_dia_mat_mod diff --git a/ext/psb_d_dns_mat_mod.f90 b/ext/psb_d_dns_mat_mod.f90 new file mode 100644 index 00000000..f8c977bc --- /dev/null +++ b/ext/psb_d_dns_mat_mod.f90 @@ -0,0 +1,467 @@ +! 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. +! +module psb_d_dns_mat_mod + + use psb_d_base_mat_mod + + type, extends(psb_d_base_sparse_mat) :: psb_d_dns_sparse_mat + ! + ! DNS format: a very simple dense matrix storage + ! psb_dpk_ : kind for double precision reals + ! psb_ipk_: kind for normal integers. + ! psb_sizeof_dp: variable holding size in bytes of + ! a double + ! psb_sizeof_ip: size in bytes of an integer + ! + ! psb_realloc(n,v,info) Reallocate: does what it says + ! psb_realloc(m,n,a,info) on rank 1 and 2 arrays, may start + ! from unallocated + ! + ! + integer(psb_ipk_) :: nnz + real(psb_dpk_), allocatable :: val(:,:) + + contains + procedure, pass(a) :: get_size => d_dns_get_size + procedure, pass(a) :: get_nzeros => d_dns_get_nzeros + procedure, nopass :: get_fmt => d_dns_get_fmt + procedure, pass(a) :: sizeof => d_dns_sizeof + procedure, pass(a) :: csmv => psb_d_dns_csmv + procedure, pass(a) :: csmm => psb_d_dns_csmm + procedure, pass(a) :: csnmi => psb_d_dns_csnmi + procedure, pass(a) :: reallocate_nz => psb_d_dns_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_d_dns_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_d_cp_dns_to_coo + procedure, pass(a) :: cp_from_coo => psb_d_cp_dns_from_coo + procedure, pass(a) :: mv_to_coo => psb_d_mv_dns_to_coo + procedure, pass(a) :: mv_from_coo => psb_d_mv_dns_from_coo + procedure, pass(a) :: get_diag => psb_d_dns_get_diag + procedure, pass(a) :: csgetrow => psb_d_dns_csgetrow + procedure, pass(a) :: get_nz_row => d_dns_get_nz_row + procedure, pass(a) :: trim => psb_d_dns_trim + procedure, pass(a) :: free => d_dns_free + procedure, pass(a) :: mold => psb_d_dns_mold + + end type psb_d_dns_sparse_mat + + private :: d_dns_get_nzeros, d_dns_free, d_dns_get_fmt, & + & d_dns_get_size, d_dns_sizeof, d_dns_get_nz_row + + ! + ! + !> Function reallocate_nz + !! \memberof psb_d_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. + ! + interface + subroutine psb_d_dns_reallocate_nz(nz,a) + import :: psb_d_dns_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_d_dns_sparse_mat), intent(inout) :: a + end subroutine psb_d_dns_reallocate_nz + end interface + + !> Function trim + !! \memberof psb_d_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. + ! + interface + subroutine psb_d_dns_trim(a) + import :: psb_d_dns_sparse_mat + class(psb_d_dns_sparse_mat), intent(inout) :: a + end subroutine psb_d_dns_trim + end interface + + ! + !> Function mold: + !! \memberof psb_d_dns_sparse_mat + !! \brief Allocate a class(psb_d_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 + ! + interface + subroutine psb_d_dns_mold(a,b,info) + import :: psb_d_dns_sparse_mat, psb_d_base_sparse_mat, psb_epk_, psb_ipk_ + class(psb_d_dns_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_dns_mold + end interface + + ! + ! + !> Function allocate_mnnz + !! \memberof psb_d_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 + ! + interface + subroutine psb_d_dns_allocate_mnnz(m,n,a,nz) + import :: psb_d_dns_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_dns_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_d_dns_allocate_mnnz + end interface + + ! + !> Function cp_to_coo: + !! \memberof psb_d_dns_sparse_mat + !! \brief Copy and convert to psb_d_coo_sparse_mat + !! Invoked from the source object. + !! \param b The output variable + !! \param info return code + ! + interface + subroutine psb_d_cp_dns_to_coo(a,b,info) + import :: psb_d_coo_sparse_mat, psb_d_dns_sparse_mat, psb_ipk_ + class(psb_d_dns_sparse_mat), intent(in) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_dns_to_coo + end interface + + ! + !> Function cp_from_coo: + !! \memberof psb_d_dns_sparse_mat + !! \brief Copy and convert from psb_d_coo_sparse_mat + !! Invoked from the target object. + !! \param b The input variable + !! \param info return code + ! + interface + subroutine psb_d_cp_dns_from_coo(a,b,info) + import :: psb_d_dns_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_dns_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_dns_from_coo + end interface + + ! + !> Function mv_to_coo: + !! \memberof psb_d_dns_sparse_mat + !! \brief Convert to psb_d_coo_sparse_mat, freeing the source. + !! Invoked from the source object. + !! \param b The output variable + !! \param info return code + ! + interface + subroutine psb_d_mv_dns_to_coo(a,b,info) + import :: psb_d_dns_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_dns_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_dns_to_coo + end interface + + ! + !> Function mv_from_coo: + !! \memberof psb_d_dns_sparse_mat + !! \brief Convert from psb_d_coo_sparse_mat, freeing the source. + !! Invoked from the target object. + !! \param b The input variable + !! \param info return code + ! + interface + subroutine psb_d_mv_dns_from_coo(a,b,info) + import :: psb_d_dns_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_dns_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_dns_from_coo + end interface + + ! + ! + !> Function csgetrow: + !! \memberof psb_d_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 + !! + ! + interface + subroutine psb_d_dns_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_d_dns_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_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(:) + real(psb_dpk_), 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 + end subroutine psb_d_dns_csgetrow + end interface + + + + !> Function csmv: + !! \memberof psb_d_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) + !! + ! + interface + subroutine psb_d_dns_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_d_dns_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_dns_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_dns_csmv + end interface + + !> Function csmm: + !! \memberof psb_d_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) + !! + ! + interface + subroutine psb_d_dns_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_d_dns_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_dns_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_dns_csmm + end interface + + ! + ! + !> Function csnmi: + !! \memberof psb_d_dns_sparse_mat + !! \brief Operator infinity norm + !! CSNMI = MAXVAL(SUM(ABS(A(:,:)),dim=2)) + !! + ! + interface + function psb_d_dns_csnmi(a) result(res) + import :: psb_d_dns_sparse_mat, psb_dpk_ + class(psb_d_dns_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_d_dns_csnmi + end interface + + ! + !> Function get_diag: + !! \memberof psb_d_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. + ! + interface + subroutine psb_d_dns_get_diag(a,d,info) + import :: psb_d_dns_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_dns_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_dns_get_diag + end interface + + +contains + + ! + !> Function sizeof + !! \memberof psb_d_dns_sparse_mat + !! \brief Memory occupation in bytes + ! + function d_dns_sizeof(a) result(res) + implicit none + class(psb_d_dns_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + res = psb_sizeof_dp * size(a%val) + res = res + psb_sizeof_ip + + end function d_dns_sizeof + + ! + !> Function get_fmt + !! \memberof psb_d_dns_sparse_mat + !! \brief return a short descriptive name (e.g. COO CSR etc.) + ! + function d_dns_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DNS' + end function d_dns_get_fmt + + ! + !> Function get_nzeros + !! \memberof psb_d_dns_sparse_mat + !! \brief Current number of nonzero entries + ! + function d_dns_get_nzeros(a) result(res) + implicit none + class(psb_d_dns_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nnz + end function d_dns_get_nzeros + + ! + !> Function get_size + !! \memberof psb_d_dns_sparse_mat + !! \brief Maximum number of nonzeros the current structure can hold + ! this is fixed once you initialize the matrix, with dense storage + ! you can hold up to MxN entries + function d_dns_get_size(a) result(res) + implicit none + class(psb_d_dns_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + + res = size(a%val) + + end function d_dns_get_size + + + ! + !> Function get_nz_row. + !! \memberof psb_d_coo_sparse_mat + !! \brief How many nonzeros in a row? + !! + !! \param idx The row to search. + !! + ! + function d_dns_get_nz_row(idx,a) result(res) + + implicit none + + class(psb_d_dns_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: idx + integer(psb_ipk_) :: res + + res = 0 + + if ((1<=idx).and.(idx<=a%get_nrows())) then + res = count(a%val(idx,:) /= dzero) + end if + + end function d_dns_get_nz_row + + ! + !> Function free + !! \memberof psb_d_dns_sparse_mat + !! Name says all + + subroutine d_dns_free(a) + implicit none + + class(psb_d_dns_sparse_mat), intent(inout) :: a + + if (allocated(a%val)) deallocate(a%val) + a%nnz = 0 + + + ! + ! Mark the object as empty just in case + ! + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + + return + + end subroutine d_dns_free + + +end module psb_d_dns_mat_mod diff --git a/ext/psb_d_ell_mat_mod.f90 b/ext/psb_d_ell_mat_mod.f90 new file mode 100644 index 00000000..3e34d63e --- /dev/null +++ b/ext/psb_d_ell_mat_mod.f90 @@ -0,0 +1,544 @@ +! 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. +! + + +module psb_d_ell_mat_mod + + use psb_d_base_mat_mod + + type, extends(psb_d_base_sparse_mat) :: psb_d_ell_sparse_mat + ! + ! ITPACK/ELL format, extended. + ! Based on M. Heroux "A proposal for a sparse BLAS toolkit". + ! IRN is our addition, should help in transferring to/from + ! other formats (should come in handy for GPUs). + ! Notes: + ! 1. JA holds the column indices, padded with the row index. + ! 2. VAL holds the coefficients, padded with zeros + ! 3. IDIAG hold the position of the diagonal element + ! or 0 if it is not there, but is only relevant for + ! triangular matrices. In particular, a unit triangular matrix + ! will have IDIAG==0. + ! 4. IRN holds the actual number of nonzeros stored in each row + ! 5. Within a row, the indices are sorted for use of SV. + ! + + integer(psb_ipk_) :: nzt + integer(psb_ipk_), allocatable :: irn(:), ja(:,:), idiag(:) + real(psb_dpk_), allocatable :: val(:,:) + + contains + procedure, pass(a) :: is_by_rows => d_ell_is_by_rows + procedure, pass(a) :: get_size => d_ell_get_size + procedure, pass(a) :: get_nzeros => d_ell_get_nzeros + procedure, nopass :: get_fmt => d_ell_get_fmt + procedure, pass(a) :: sizeof => d_ell_sizeof + procedure, pass(a) :: csmm => psb_d_ell_csmm + procedure, pass(a) :: csmv => psb_d_ell_csmv + procedure, pass(a) :: inner_cssm => psb_d_ell_cssm + procedure, pass(a) :: inner_cssv => psb_d_ell_cssv + procedure, pass(a) :: scals => psb_d_ell_scals + procedure, pass(a) :: scalv => psb_d_ell_scal + procedure, pass(a) :: maxval => psb_d_ell_maxval + procedure, pass(a) :: csnmi => psb_d_ell_csnmi + procedure, pass(a) :: csnm1 => psb_d_ell_csnm1 + procedure, pass(a) :: rowsum => psb_d_ell_rowsum + procedure, pass(a) :: arwsum => psb_d_ell_arwsum + procedure, pass(a) :: colsum => psb_d_ell_colsum + procedure, pass(a) :: aclsum => psb_d_ell_aclsum + procedure, pass(a) :: reallocate_nz => psb_d_ell_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_d_ell_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_d_cp_ell_to_coo + procedure, pass(a) :: cp_from_coo => psb_d_cp_ell_from_coo + procedure, pass(a) :: cp_to_fmt => psb_d_cp_ell_to_fmt + procedure, pass(a) :: cp_from_fmt => psb_d_cp_ell_from_fmt + procedure, pass(a) :: mv_to_coo => psb_d_mv_ell_to_coo + procedure, pass(a) :: mv_from_coo => psb_d_mv_ell_from_coo + procedure, pass(a) :: mv_to_fmt => psb_d_mv_ell_to_fmt + procedure, pass(a) :: mv_from_fmt => psb_d_mv_ell_from_fmt + procedure, pass(a) :: csput_a => psb_d_ell_csput_a + procedure, pass(a) :: get_diag => psb_d_ell_get_diag + procedure, pass(a) :: csgetptn => psb_d_ell_csgetptn + procedure, pass(a) :: csgetrow => psb_d_ell_csgetrow + procedure, pass(a) :: get_nz_row => d_ell_get_nz_row + procedure, pass(a) :: reinit => psb_d_ell_reinit + procedure, pass(a) :: trim => psb_d_ell_trim + procedure, pass(a) :: print => psb_d_ell_print + procedure, pass(a) :: free => d_ell_free + procedure, pass(a) :: mold => psb_d_ell_mold + + end type psb_d_ell_sparse_mat + + private :: d_ell_get_nzeros, d_ell_free, d_ell_get_fmt, & + & d_ell_get_size, d_ell_sizeof, d_ell_get_nz_row, & + & d_ell_is_by_rows + + interface + subroutine psb_d_ell_reallocate_nz(nz,a) + import :: psb_d_ell_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_d_ell_sparse_mat), intent(inout) :: a + end subroutine psb_d_ell_reallocate_nz + end interface + + interface + subroutine psb_d_ell_reinit(a,clear) + import :: psb_d_ell_sparse_mat + class(psb_d_ell_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + end subroutine psb_d_ell_reinit + end interface + + interface + subroutine psb_d_ell_trim(a) + import :: psb_d_ell_sparse_mat + class(psb_d_ell_sparse_mat), intent(inout) :: a + end subroutine psb_d_ell_trim + end interface + + interface + subroutine psb_d_ell_mold(a,b,info) + import :: psb_d_ell_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_ell_mold + end interface + + interface + subroutine psb_d_ell_allocate_mnnz(m,n,a,nz) + import :: psb_d_ell_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_ell_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_d_ell_allocate_mnnz + end interface + + interface + subroutine psb_d_ell_print(iout,a,iv,head,ivr,ivc) + import :: psb_d_ell_sparse_mat, psb_ipk_, psb_lpk_ + integer(psb_ipk_), intent(in) :: iout + class(psb_d_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(:) + end subroutine psb_d_ell_print + end interface + + interface + subroutine psb_d_cp_ell_to_coo(a,b,info) + import :: psb_d_coo_sparse_mat, psb_d_ell_sparse_mat, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(in) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_ell_to_coo + end interface + + interface + subroutine psb_d_cp_ell_from_coo(a,b,info) + import :: psb_d_ell_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_ell_from_coo + end interface + + interface + subroutine psb_d_cp_ell_to_fmt(a,b,info) + import :: psb_d_ell_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_ell_to_fmt + end interface + + interface + subroutine psb_d_cp_ell_from_fmt(a,b,info) + import :: psb_d_ell_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_ell_from_fmt + end interface + + interface + subroutine psb_d_mv_ell_to_coo(a,b,info) + import :: psb_d_ell_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_ell_to_coo + end interface + + interface + subroutine psb_d_mv_ell_from_coo(a,b,info) + import :: psb_d_ell_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_ell_from_coo + end interface + + interface + subroutine psb_d_mv_ell_to_fmt(a,b,info) + import :: psb_d_ell_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_ell_to_fmt + end interface + + interface + subroutine psb_d_mv_ell_from_fmt(a,b,info) + import :: psb_d_ell_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_ell_from_fmt + end interface + + interface + subroutine psb_d_ell_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_d_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& + & imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_ell_csput_a + end interface + + interface + subroutine psb_d_ell_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + import :: psb_d_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_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 + end subroutine psb_d_ell_csgetptn + end interface + + interface + subroutine psb_d_ell_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_d_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_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(:) + real(psb_dpk_), 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 + end subroutine psb_d_ell_csgetrow + end interface + + interface + subroutine psb_d_ell_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + import :: psb_d_ell_sparse_mat, psb_dpk_, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(in) :: a + class(psb_d_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 + end subroutine psb_d_ell_csgetblk + end interface + + interface + subroutine psb_d_ell_cssv(alpha,a,x,beta,y,info,trans) + import :: psb_d_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_ell_cssv + subroutine psb_d_ell_cssm(alpha,a,x,beta,y,info,trans) + import :: psb_d_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_ell_cssm + end interface + + interface + subroutine psb_d_ell_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_d_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_ell_csmv + subroutine psb_d_ell_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_d_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_ell_csmm + end interface + + + interface + function psb_d_ell_maxval(a) result(res) + import :: psb_d_ell_sparse_mat, psb_dpk_ + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_d_ell_maxval + end interface + + interface + function psb_d_ell_csnmi(a) result(res) + import :: psb_d_ell_sparse_mat, psb_dpk_ + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_d_ell_csnmi + end interface + + interface + function psb_d_ell_csnm1(a) result(res) + import :: psb_d_ell_sparse_mat, psb_dpk_ + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_d_ell_csnm1 + end interface + + interface + subroutine psb_d_ell_rowsum(d,a) + import :: psb_d_ell_sparse_mat, psb_dpk_ + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_d_ell_rowsum + end interface + + interface + subroutine psb_d_ell_arwsum(d,a) + import :: psb_d_ell_sparse_mat, psb_dpk_ + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_d_ell_arwsum + end interface + + interface + subroutine psb_d_ell_colsum(d,a) + import :: psb_d_ell_sparse_mat, psb_dpk_ + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_d_ell_colsum + end interface + + interface + subroutine psb_d_ell_aclsum(d,a) + import :: psb_d_ell_sparse_mat, psb_dpk_ + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_d_ell_aclsum + end interface + + interface + subroutine psb_d_ell_get_diag(a,d,info) + import :: psb_d_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_ell_get_diag + end interface + + interface + subroutine psb_d_ell_scal(d,a,info,side) + import :: psb_d_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_d_ell_scal + end interface + + interface + subroutine psb_d_ell_scals(d,a,info) + import :: psb_d_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_ell_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_ell_scals + end interface + + interface + subroutine psi_d_convert_ell_from_coo(a,tmp,info,hacksize) + import :: psb_d_ell_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + implicit none + class(psb_d_ell_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: hacksize + end subroutine psi_d_convert_ell_from_coo + end interface + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function d_ell_is_by_rows(a) result(res) + implicit none + class(psb_d_ell_sparse_mat), intent(in) :: a + logical :: res + res = .true. + end function d_ell_is_by_rows + + function d_ell_sizeof(a) result(res) + implicit none + class(psb_d_ell_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + if (a%is_dev()) call a%sync() + res = 8 + res = res + psb_sizeof_dp * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%ja) + + end function d_ell_sizeof + + function d_ell_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'ELL' + end function d_ell_get_fmt + + function d_ell_get_nzeros(a) result(res) + implicit none + class(psb_d_ell_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nzt + end function d_ell_get_nzeros + + function d_ell_get_size(a) result(res) + implicit none + class(psb_d_ell_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + + res = -1 + if (a%is_dev()) call a%sync() + + if (allocated(a%ja)) then + if (res >= 0) then + res = min(res,size(a%ja)) + else + res = size(a%ja) + end if + end if + if (allocated(a%val)) then + if (res >= 0) then + res = min(res,size(a%val)) + else + res = size(a%val) + end if + end if + + end function d_ell_get_size + + + function d_ell_get_nz_row(idx,a) result(res) + + implicit none + + class(psb_d_ell_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: idx + integer(psb_ipk_) :: res + + res = 0 + if (a%is_dev()) call a%sync() + + if ((1<=idx).and.(idx<=a%get_nrows())) then + res = a%irn(idx) + end if + + end function d_ell_get_nz_row + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine d_ell_free(a) + implicit none + + class(psb_d_ell_sparse_mat), intent(inout) :: a + + if (allocated(a%idiag)) deallocate(a%idiag) + if (allocated(a%irn)) deallocate(a%irn) + if (allocated(a%ja)) deallocate(a%ja) + if (allocated(a%val)) deallocate(a%val) + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + + return + + end subroutine d_ell_free + + +end module psb_d_ell_mat_mod diff --git a/ext/psb_d_hdia_mat_mod.f90 b/ext/psb_d_hdia_mat_mod.f90 new file mode 100644 index 00000000..25bc6898 --- /dev/null +++ b/ext/psb_d_hdia_mat_mod.f90 @@ -0,0 +1,534 @@ +! 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. +! + +module psb_d_hdia_mat_mod + + use psb_d_base_mat_mod + + + type, extends(psb_d_base_sparse_mat) :: psb_d_hdia_sparse_mat + ! + ! HDIA format + ! + integer(psb_ipk_), allocatable :: hackOffsets(:), diaOffsets(:) + real(psb_dpk_), allocatable :: val(:) + + + integer(psb_ipk_) :: nhacks, nzeros + integer(psb_ipk_) :: hacksize = 32 + integer(psb_epk_) :: dim=0 + + contains + ! procedure, pass(a) :: get_size => d_hdia_get_size + procedure, pass(a) :: get_nzeros => d_hdia_get_nzeros + procedure, pass(a) :: set_nzeros => d_hdia_set_nzeros + procedure, nopass :: get_fmt => d_hdia_get_fmt + procedure, pass(a) :: sizeof => d_hdia_sizeof + ! procedure, pass(a) :: csmm => psb_d_hdia_csmm + procedure, pass(a) :: csmv => psb_d_hdia_csmv + ! procedure, pass(a) :: inner_cssm => psb_d_hdia_cssm + ! procedure, pass(a) :: inner_cssv => psb_d_hdia_cssv + ! procedure, pass(a) :: scals => psb_d_hdia_scals + ! procedure, pass(a) :: scalv => psb_d_hdia_scal + ! procedure, pass(a) :: maxval => psb_d_hdia_maxval + ! procedure, pass(a) :: csnmi => psb_d_hdia_csnmi + ! procedure, pass(a) :: csnm1 => psb_d_hdia_csnm1 + ! procedure, pass(a) :: rowsum => psb_d_hdia_rowsum + ! procedure, pass(a) :: arwsum => psb_d_hdia_arwsum + ! procedure, pass(a) :: colsum => psb_d_hdia_colsum + ! procedure, pass(a) :: aclsum => psb_d_hdia_aclsum + ! procedure, pass(a) :: reallocate_nz => psb_d_hdia_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_d_hdia_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_d_cp_hdia_to_coo + procedure, pass(a) :: cp_from_coo => psb_d_cp_hdia_from_coo + ! procedure, pass(a) :: cp_to_fmt => psb_d_cp_hdia_to_fmt + ! procedure, pass(a) :: cp_from_fmt => psb_d_cp_hdia_from_fmt + procedure, pass(a) :: mv_to_coo => psb_d_mv_hdia_to_coo + procedure, pass(a) :: mv_from_coo => psb_d_mv_hdia_from_coo + ! procedure, pass(a) :: mv_to_fmt => psb_d_mv_hdia_to_fmt + ! procedure, pass(a) :: mv_from_fmt => psb_d_mv_hdia_from_fmt + ! procedure, pass(a) :: csput_a => psb_d_hdia_csput_a + ! procedure, pass(a) :: get_diag => psb_d_hdia_get_diag + ! procedure, pass(a) :: csgetptn => psb_d_hdia_csgetptn + ! procedure, pass(a) :: csgetrow => psb_d_hdia_csgetrow + ! procedure, pass(a) :: get_nz_row => d_hdia_get_nz_row + ! procedure, pass(a) :: reinit => psb_d_hdia_reinit + ! procedure, pass(a) :: trim => psb_d_hdia_trim + procedure, pass(a) :: print => psb_d_hdia_print + procedure, pass(a) :: free => d_hdia_free + procedure, pass(a) :: mold => psb_d_hdia_mold + + end type psb_d_hdia_sparse_mat + + private :: d_hdia_get_nzeros, d_hdia_set_nzeros, d_hdia_free, & + & d_hdia_get_fmt, d_hdia_sizeof +!!$ & +!!$ & d_hdia_get_nz_row d_hdia_get_size, + +!!$ interface +!!$ subroutine psb_d_hdia_reallocate_nz(nz,a) +!!$ import :: psb_d_hdia_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_d_hdia_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_d_hdia_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_hdia_reinit(a,clear) +!!$ import :: psb_d_hdia_sparse_mat +!!$ class(psb_d_hdia_sparse_mat), intent(inout) :: a +!!$ logical, intent(in), optional :: clear +!!$ end subroutine psb_d_hdia_reinit +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_hdia_trim(a) +!!$ import :: psb_d_hdia_sparse_mat +!!$ class(psb_d_hdia_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_d_hdia_trim +!!$ end interface + + interface + subroutine psb_d_hdia_mold(a,b,info) + import :: psb_d_hdia_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_hdia_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_hdia_mold + end interface + + interface + subroutine psb_d_hdia_allocate_mnnz(m,n,a,nz) + import :: psb_d_hdia_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_hdia_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_d_hdia_allocate_mnnz + end interface + + interface + subroutine psb_d_hdia_print(iout,a,iv,head,ivr,ivc) + import :: psb_d_hdia_sparse_mat, psb_ipk_, psb_lpk_ + integer(psb_ipk_), intent(in) :: iout + class(psb_d_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(:) + end subroutine psb_d_hdia_print + end interface + + interface + subroutine psb_d_cp_hdia_to_coo(a,b,info) + import :: psb_d_coo_sparse_mat, psb_d_hdia_sparse_mat, psb_ipk_ + class(psb_d_hdia_sparse_mat), intent(in) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_hdia_to_coo + end interface + + interface + subroutine psb_d_cp_hdia_from_coo(a,b,info) + import :: psb_d_hdia_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_hdia_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_hdia_from_coo + end interface + +!!$ interface +!!$ subroutine psb_d_cp_hdia_to_fmt(a,b,info) +!!$ import :: psb_d_hdia_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ +!!$ class(psb_d_hdia_sparse_mat), intent(in) :: a +!!$ class(psb_d_base_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_d_cp_hdia_to_fmt +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_cp_hdia_from_fmt(a,b,info) +!!$ import :: psb_d_hdia_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ +!!$ class(psb_d_hdia_sparse_mat), intent(inout) :: a +!!$ class(psb_d_base_sparse_mat), intent(in) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_d_cp_hdia_from_fmt +!!$ end interface + + interface + subroutine psb_d_mv_hdia_to_coo(a,b,info) + import :: psb_d_hdia_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_hdia_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_hdia_to_coo + end interface + + interface + subroutine psb_d_mv_hdia_from_coo(a,b,info) + import :: psb_d_hdia_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_hdia_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_hdia_from_coo + end interface + +!!$ interface +!!$ subroutine psb_d_mv_hdia_to_fmt(a,b,info) +!!$ import :: psb_d_hdia_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ +!!$ class(psb_d_hdia_sparse_mat), intent(inout) :: a +!!$ class(psb_d_base_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_d_mv_hdia_to_fmt +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_mv_hdia_from_fmt(a,b,info) +!!$ import :: psb_d_hdia_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ +!!$ class(psb_d_hdia_sparse_mat), intent(inout) :: a +!!$ class(psb_d_base_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_d_mv_hdia_from_fmt +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_hdia_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) +!!$ import :: psb_d_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_d_hdia_sparse_mat), intent(inout) :: a +!!$ real(psb_dpk_), intent(in) :: val(:) +!!$ integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& +!!$ & imin,imax,jmin,jmax +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_d_hdia_csput_a +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_hdia_csgetptn(imin,imax,a,nz,ia,ja,info,& +!!$ & jmin,jmax,iren,append,nzin,rscale,cscale) +!!$ import :: psb_d_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_d_hdia_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 +!!$ end subroutine psb_d_hdia_csgetptn +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_hdia_csgetrow(imin,imax,a,nz,ia,ja,val,info,& +!!$ & jmin,jmax,iren,append,nzin,rscale,cscale) +!!$ import :: psb_d_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_d_hdia_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(:) +!!$ real(psb_dpk_), 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 +!!$ end subroutine psb_d_hdia_csgetrow +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_hdia_csgetblk(imin,imax,a,b,info,& +!!$ & jmin,jmax,iren,append,rscale,cscale) +!!$ import :: psb_d_hdia_sparse_mat, psb_dpk_, psb_d_coo_sparse_mat, psb_ipk_ +!!$ class(psb_d_hdia_sparse_mat), intent(in) :: a +!!$ class(psb_d_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 +!!$ end subroutine psb_d_hdia_csgetblk +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_hdia_cssv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_d_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_d_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_), intent(in) :: alpha, beta, x(:) +!!$ real(psb_dpk_), intent(inout) :: y(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_d_hdia_cssv +!!$ subroutine psb_d_hdia_cssm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_d_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_d_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) +!!$ real(psb_dpk_), intent(inout) :: y(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_d_hdia_cssm +!!$ end interface + + interface + subroutine psb_d_hdia_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_d_hdia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hdia_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_hdia_csmv +!!$ subroutine psb_d_hdia_csmm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_d_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_d_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) +!!$ real(psb_dpk_), intent(inout) :: y(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_d_hdia_csmm + end interface + + +!!$ interface +!!$ function psb_d_hdia_maxval(a) result(res) +!!$ import :: psb_d_hdia_sparse_mat, psb_dpk_ +!!$ class(psb_d_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_) :: res +!!$ end function psb_d_hdia_maxval +!!$ end interface +!!$ +!!$ interface +!!$ function psb_d_hdia_csnmi(a) result(res) +!!$ import :: psb_d_hdia_sparse_mat, psb_dpk_ +!!$ class(psb_d_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_) :: res +!!$ end function psb_d_hdia_csnmi +!!$ end interface +!!$ +!!$ interface +!!$ function psb_d_hdia_csnm1(a) result(res) +!!$ import :: psb_d_hdia_sparse_mat, psb_dpk_ +!!$ class(psb_d_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_) :: res +!!$ end function psb_d_hdia_csnm1 +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_hdia_rowsum(d,a) +!!$ import :: psb_d_hdia_sparse_mat, psb_dpk_ +!!$ class(psb_d_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_), intent(out) :: d(:) +!!$ end subroutine psb_d_hdia_rowsum +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_hdia_arwsum(d,a) +!!$ import :: psb_d_hdia_sparse_mat, psb_dpk_ +!!$ class(psb_d_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_), intent(out) :: d(:) +!!$ end subroutine psb_d_hdia_arwsum +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_hdia_colsum(d,a) +!!$ import :: psb_d_hdia_sparse_mat, psb_dpk_ +!!$ class(psb_d_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_), intent(out) :: d(:) +!!$ end subroutine psb_d_hdia_colsum +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_hdia_aclsum(d,a) +!!$ import :: psb_d_hdia_sparse_mat, psb_dpk_ +!!$ class(psb_d_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_), intent(out) :: d(:) +!!$ end subroutine psb_d_hdia_aclsum +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_hdia_get_diag(a,d,info) +!!$ import :: psb_d_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_d_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_), intent(out) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_d_hdia_get_diag +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_d_hdia_scal(d,a,info,side) +!!$ import :: psb_d_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_d_hdia_sparse_mat), intent(inout) :: a +!!$ real(psb_dpk_), intent(in) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, intent(in), optional :: side +!!$ end subroutine psb_d_hdia_scal +!!$ end interface + +!!$ interface +!!$ subroutine psb_d_hdia_scals(d,a,info) +!!$ import :: psb_d_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_d_hdia_sparse_mat), intent(inout) :: a +!!$ real(psb_dpk_), intent(in) :: d +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_d_hdia_scals +!!$ end interface +!!$ + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function d_hdia_sizeof(a) result(res) + use psb_realloc_mod, only : psb_size + implicit none + class(psb_d_hdia_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + integer(psb_ipk_) :: i + + if (a%is_dev()) call a%sync() + res = 0 + + res = res + psb_size(a%hackOffsets)*psb_sizeof_ip + res = res + psb_size(a%diaOffsets)*psb_sizeof_ip + res = res + psb_size(a%val) * psb_sizeof_dp + + end function d_hdia_sizeof + + function d_hdia_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HDIA' + end function d_hdia_get_fmt + + function d_hdia_get_nzeros(a) result(res) + implicit none + class(psb_d_hdia_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nzeros + end function d_hdia_get_nzeros + + subroutine d_hdia_set_nzeros(a,nz) + implicit none + class(psb_d_hdia_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: nz + a%nzeros = nz + end subroutine d_hdia_set_nzeros + + ! function d_hdia_get_size(a) result(res) + ! implicit none + ! class(psb_d_hdia_sparse_mat), intent(in) :: a + ! integer(psb_ipk_) :: res + + ! res = -1 + + ! if (allocated(a%ja)) then + ! if (res >= 0) then + ! res = min(res,size(a%ja)) + ! else + ! res = size(a%ja) + ! end if + ! end if + ! if (allocated(a%val)) then + ! if (res >= 0) then + ! res = min(res,size(a%val)) + ! else + ! res = size(a%val) + ! end if + ! end if + + ! end function d_hdia_get_size + + + ! function d_hdia_get_nz_row(idx,a) result(res) + + ! implicit none + + ! class(psb_d_hdia_sparse_mat), intent(in) :: a + ! integer(psb_ipk_), intent(in) :: idx + ! integer(psb_ipk_) :: res + + ! res = 0 + + ! if ((1<=idx).and.(idx<=a%get_nrows())) then + ! res = a%irn(idx) + ! end if + + ! end function d_hdia_get_nz_row + + + + ! ! == =================================== + ! ! + ! ! + ! ! + ! ! Data management + ! ! + ! ! + ! ! + ! ! + ! ! + ! ! == =================================== + + subroutine d_hdia_free(a) + implicit none + + class(psb_d_hdia_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: i, info + + + if (allocated(a%hackOffsets))& + & deallocate(a%hackOffsets,stat=info) + if (allocated(a%diaOffsets))& + & deallocate(a%diaOffsets,stat=info) + if (allocated(a%val))& + & deallocate(a%val,stat=info) + a%nhacks=0 + + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + + return + + end subroutine d_hdia_free + + +end module psb_d_hdia_mat_mod diff --git a/ext/psb_d_hll_mat_mod.f90 b/ext/psb_d_hll_mat_mod.f90 new file mode 100644 index 00000000..acc3b312 --- /dev/null +++ b/ext/psb_d_hll_mat_mod.f90 @@ -0,0 +1,564 @@ +! 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. +! + + +module psb_d_hll_mat_mod + + use psb_d_base_mat_mod + use psi_ext_util_mod + + type, extends(psb_d_base_sparse_mat) :: psb_d_hll_sparse_mat + ! + ! HLL format. (Hacked ELL) + ! A modification of ELL. + ! Basic idea: pack and pad data in blocks of HCK rows; + ! this reduces the impact of a lone, very long row. + ! Notes: + ! 1. JA holds the column indices, padded with the row index. + ! 2. VAL holds the coefficients, padded with zeros + ! 3. IDIAG hold the position of the diagonal element + ! or 0 if it is not there, but is only relevant for + ! triangular matrices. In particular, a unit triangular matrix + ! will have IDIAG==0. + ! 4. IRN holds the actual number of nonzeros stored in each row + ! 5. Within a row, the indices are sorted for use of SV. + ! 6. hksz: hack size (multiple of 32) + ! 7. hkoffs(:): offsets of the starts of hacks inside ja/val + ! + ! + ! + integer(psb_ipk_) :: hksz, nzt + integer(psb_ipk_), allocatable :: irn(:), ja(:), idiag(:), hkoffs(:) + real(psb_dpk_), allocatable :: val(:) + + contains + + procedure, pass(a) :: get_hksz => d_hll_get_hksz + procedure, pass(a) :: set_hksz => d_hll_set_hksz + procedure, pass(a) :: get_size => d_hll_get_size + procedure, pass(a) :: set_nzeros => d_hll_set_nzeros + procedure, pass(a) :: get_nzeros => d_hll_get_nzeros + procedure, nopass :: get_fmt => d_hll_get_fmt + procedure, pass(a) :: sizeof => d_hll_sizeof + procedure, pass(a) :: csmm => psb_d_hll_csmm + procedure, pass(a) :: csmv => psb_d_hll_csmv + procedure, pass(a) :: inner_cssm => psb_d_hll_cssm + procedure, pass(a) :: inner_cssv => psb_d_hll_cssv + procedure, pass(a) :: scals => psb_d_hll_scals + procedure, pass(a) :: scalv => psb_d_hll_scal + procedure, pass(a) :: maxval => psb_d_hll_maxval + procedure, pass(a) :: csnmi => psb_d_hll_csnmi + procedure, pass(a) :: csnm1 => psb_d_hll_csnm1 + procedure, pass(a) :: rowsum => psb_d_hll_rowsum + procedure, pass(a) :: arwsum => psb_d_hll_arwsum + procedure, pass(a) :: colsum => psb_d_hll_colsum + procedure, pass(a) :: aclsum => psb_d_hll_aclsum + procedure, pass(a) :: reallocate_nz => psb_d_hll_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_d_hll_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_d_cp_hll_to_coo + procedure, pass(a) :: cp_from_coo => psb_d_cp_hll_from_coo + procedure, pass(a) :: cp_to_fmt => psb_d_cp_hll_to_fmt + procedure, pass(a) :: cp_from_fmt => psb_d_cp_hll_from_fmt + procedure, pass(a) :: mv_to_coo => psb_d_mv_hll_to_coo + procedure, pass(a) :: mv_from_coo => psb_d_mv_hll_from_coo + procedure, pass(a) :: mv_to_fmt => psb_d_mv_hll_to_fmt + procedure, pass(a) :: mv_from_fmt => psb_d_mv_hll_from_fmt + procedure, pass(a) :: csput_a => psb_d_hll_csput_a + procedure, pass(a) :: get_diag => psb_d_hll_get_diag + procedure, pass(a) :: csgetptn => psb_d_hll_csgetptn + procedure, pass(a) :: csgetrow => psb_d_hll_csgetrow + procedure, pass(a) :: get_nz_row => d_hll_get_nz_row + procedure, pass(a) :: reinit => psb_d_hll_reinit + procedure, pass(a) :: print => psb_d_hll_print + procedure, pass(a) :: free => d_hll_free + procedure, pass(a) :: mold => psb_d_hll_mold + + end type psb_d_hll_sparse_mat + + private :: d_hll_get_nzeros, d_hll_free, d_hll_get_fmt, & + & d_hll_get_size, d_hll_sizeof, d_hll_get_nz_row, & + & d_hll_set_nzeros, d_hll_get_hksz, d_hll_set_hksz + + interface + subroutine psb_d_hll_reallocate_nz(nz,a) + import :: psb_d_hll_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_d_hll_sparse_mat), intent(inout) :: a + end subroutine psb_d_hll_reallocate_nz + end interface + + interface + subroutine psb_d_hll_reinit(a,clear) + import :: psb_d_hll_sparse_mat + class(psb_d_hll_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + end subroutine psb_d_hll_reinit + end interface + + interface + subroutine psb_d_hll_mold(a,b,info) + import :: psb_d_hll_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_hll_mold + end interface + + interface + subroutine psb_d_hll_allocate_mnnz(m,n,a,nz) + import :: psb_d_hll_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_d_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_d_hll_allocate_mnnz + end interface + + interface + subroutine psb_d_hll_print(iout,a,iv,head,ivr,ivc) + import :: psb_d_hll_sparse_mat, psb_ipk_, psb_lpk_ + integer(psb_ipk_), intent(in) :: iout + class(psb_d_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(:) + end subroutine psb_d_hll_print + end interface + + interface + subroutine psb_d_cp_hll_to_coo(a,b,info) + import :: psb_d_coo_sparse_mat, psb_d_hll_sparse_mat, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(in) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_hll_to_coo + end interface + + interface + subroutine psb_d_cp_hll_from_coo(a,b,info) + import :: psb_d_hll_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_hll_from_coo + end interface + + interface + subroutine psb_d_cp_hll_to_fmt(a,b,info) + import :: psb_d_hll_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(in) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_hll_to_fmt + end interface + + interface + subroutine psb_d_cp_hll_from_fmt(a,b,info) + import :: psb_d_hll_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_cp_hll_from_fmt + end interface + + interface + subroutine psb_d_mv_hll_to_coo(a,b,info) + import :: psb_d_hll_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_hll_to_coo + end interface + + interface + subroutine psb_d_mv_hll_from_coo(a,b,info) + import :: psb_d_hll_sparse_mat, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(inout) :: a + class(psb_d_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_hll_from_coo + end interface + + interface + subroutine psb_d_mv_hll_to_fmt(a,b,info) + import :: psb_d_hll_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_hll_to_fmt + end interface + + interface + subroutine psb_d_mv_hll_from_fmt(a,b,info) + import :: psb_d_hll_sparse_mat, psb_d_base_sparse_mat, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(inout) :: a + class(psb_d_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_mv_hll_from_fmt + end interface + + interface + subroutine psb_d_hll_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_d_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& + & imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_hll_csput_a + end interface + + interface + subroutine psb_d_hll_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + import :: psb_d_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_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 + end subroutine psb_d_hll_csgetptn + end interface + + interface + subroutine psb_d_hll_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_d_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_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(:) + real(psb_dpk_), 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 + end subroutine psb_d_hll_csgetrow + end interface + + interface + subroutine psb_d_hll_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + import :: psb_d_hll_sparse_mat, psb_dpk_, psb_d_coo_sparse_mat, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(in) :: a + class(psb_d_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 + end subroutine psb_d_hll_csgetblk + end interface + + interface + subroutine psb_d_hll_cssv(alpha,a,x,beta,y,info,trans) + import :: psb_d_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_hll_cssv + subroutine psb_d_hll_cssm(alpha,a,x,beta,y,info,trans) + import :: psb_d_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_hll_cssm + end interface + + interface + subroutine psb_d_hll_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_d_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:) + real(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_hll_csmv + subroutine psb_d_hll_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_d_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + real(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_d_hll_csmm + end interface + + + interface + function psb_d_hll_maxval(a) result(res) + import :: psb_d_hll_sparse_mat, psb_dpk_ + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_d_hll_maxval + end interface + + interface + function psb_d_hll_csnmi(a) result(res) + import :: psb_d_hll_sparse_mat, psb_dpk_ + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_d_hll_csnmi + end interface + + interface + function psb_d_hll_csnm1(a) result(res) + import :: psb_d_hll_sparse_mat, psb_dpk_ + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_d_hll_csnm1 + end interface + + interface + subroutine psb_d_hll_rowsum(d,a) + import :: psb_d_hll_sparse_mat, psb_dpk_ + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_d_hll_rowsum + end interface + + interface + subroutine psb_d_hll_arwsum(d,a) + import :: psb_d_hll_sparse_mat, psb_dpk_ + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_d_hll_arwsum + end interface + + interface + subroutine psb_d_hll_colsum(d,a) + import :: psb_d_hll_sparse_mat, psb_dpk_ + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_d_hll_colsum + end interface + + interface + subroutine psb_d_hll_aclsum(d,a) + import :: psb_d_hll_sparse_mat, psb_dpk_ + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_d_hll_aclsum + end interface + + interface + subroutine psb_d_hll_get_diag(a,d,info) + import :: psb_d_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_hll_get_diag + end interface + + interface + subroutine psb_d_hll_scal(d,a,info,side) + import :: psb_d_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_d_hll_scal + end interface + + interface + subroutine psb_d_hll_scals(d,a,info) + import :: psb_d_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_d_hll_sparse_mat), intent(inout) :: a + real(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_hll_scals + end interface + + interface psi_convert_hll_from_coo + subroutine psi_d_convert_hll_from_coo(a,hksz,tmp,info) + import :: psb_d_hll_sparse_mat, psb_ipk_, psb_d_coo_sparse_mat + implicit none + class(psb_d_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: hksz + class(psb_d_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(out) :: info + end subroutine psi_d_convert_hll_from_coo + end interface + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function d_hll_sizeof(a) result(res) + implicit none + class(psb_d_hll_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + if (a%is_dev()) call a%sync() + res = 8 + res = res + psb_sizeof_dp * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%ja) + res = res + psb_sizeof_ip * size(a%hkoffs) + + end function d_hll_sizeof + + function d_hll_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HLL' + end function d_hll_get_fmt + + subroutine d_hll_set_nzeros(a,n) + implicit none + class(psb_d_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: n + + a%nzt = n + end subroutine d_hll_set_nzeros + + function d_hll_get_nzeros(a) result(res) + implicit none + class(psb_d_hll_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nzt + end function d_hll_get_nzeros + + function d_hll_get_size(a) result(res) + implicit none + class(psb_d_hll_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + + if (a%is_dev()) call a%sync() + + res = -1 + + if (allocated(a%ja)) then + if (res >= 0) then + res = min(res,size(a%ja)) + else + res = size(a%ja) + end if + end if + if (allocated(a%val)) then + if (res >= 0) then + res = min(res,size(a%val)) + else + res = size(a%val) + end if + end if + + end function d_hll_get_size + + + + function d_hll_get_nz_row(idx,a) result(res) + + implicit none + + class(psb_d_hll_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: idx + integer(psb_ipk_) :: res + + res = 0 + + if ((1<=idx).and.(idx<=a%get_nrows())) then + res = a%irn(idx) + end if + + end function d_hll_get_nz_row + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine d_hll_free(a) + implicit none + + class(psb_d_hll_sparse_mat), intent(inout) :: a + + if (allocated(a%idiag)) deallocate(a%idiag) + if (allocated(a%irn)) deallocate(a%irn) + if (allocated(a%ja)) deallocate(a%ja) + if (allocated(a%val)) deallocate(a%val) + if (allocated(a%val)) deallocate(a%hkoffs) + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + call a%set_hksz(izero) + + return + + end subroutine d_hll_free + + subroutine d_hll_set_hksz(a,n) + implicit none + class(psb_d_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: n + + a%hksz = n + end subroutine d_hll_set_hksz + + function d_hll_get_hksz(a) result(res) + implicit none + class(psb_d_hll_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + + res = a%hksz + + end function d_hll_get_hksz + +end module psb_d_hll_mat_mod diff --git a/ext/psb_ext_mod.F90 b/ext/psb_ext_mod.F90 new file mode 100644 index 00000000..b1dbdb59 --- /dev/null +++ b/ext/psb_ext_mod.F90 @@ -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. +! + + +module psb_ext_mod + use psb_const_mod + use psi_ext_util_mod + + use psb_s_dns_mat_mod + use psb_d_dns_mat_mod + use psb_c_dns_mat_mod + use psb_z_dns_mat_mod + + use psb_d_ell_mat_mod + use psb_s_ell_mat_mod + use psb_z_ell_mat_mod + use psb_c_ell_mat_mod + + use psb_s_hll_mat_mod + use psb_d_hll_mat_mod + use psb_c_hll_mat_mod + use psb_z_hll_mat_mod + + use psb_s_dia_mat_mod + use psb_d_dia_mat_mod + use psb_c_dia_mat_mod + use psb_z_dia_mat_mod + + use psb_s_hdia_mat_mod + use psb_d_hdia_mat_mod + use psb_c_hdia_mat_mod + use psb_z_hdia_mat_mod + +#ifdef HAVE_RSB + use psb_d_rsb_mat_mod +#endif +end module psb_ext_mod diff --git a/ext/psb_s_dia_mat_mod.f90 b/ext/psb_s_dia_mat_mod.f90 new file mode 100644 index 00000000..3a11d959 --- /dev/null +++ b/ext/psb_s_dia_mat_mod.f90 @@ -0,0 +1,513 @@ +! 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. +! + + +module psb_s_dia_mat_mod + + use psb_s_base_mat_mod + + type, extends(psb_s_base_sparse_mat) :: psb_s_dia_sparse_mat + ! + ! DIA format, extended. + ! + + integer(psb_ipk_), allocatable :: offset(:) + integer(psb_ipk_) :: nzeros + real(psb_spk_), allocatable :: data(:,:) + + contains + ! procedure, pass(a) :: get_size => s_dia_get_size + procedure, pass(a) :: get_nzeros => s_dia_get_nzeros + procedure, nopass :: get_fmt => s_dia_get_fmt + procedure, pass(a) :: sizeof => s_dia_sizeof + procedure, pass(a) :: csmm => psb_s_dia_csmm + procedure, pass(a) :: csmv => psb_s_dia_csmv + ! procedure, pass(a) :: inner_cssm => psb_s_dia_cssm + ! procedure, pass(a) :: inner_cssv => psb_s_dia_cssv + procedure, pass(a) :: scals => psb_s_dia_scals + procedure, pass(a) :: scalv => psb_s_dia_scal + procedure, pass(a) :: maxval => psb_s_dia_maxval + procedure, pass(a) :: rowsum => psb_s_dia_rowsum + procedure, pass(a) :: arwsum => psb_s_dia_arwsum + procedure, pass(a) :: colsum => psb_s_dia_colsum + procedure, pass(a) :: aclsum => psb_s_dia_aclsum + procedure, pass(a) :: reallocate_nz => psb_s_dia_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_s_dia_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_s_cp_dia_to_coo + procedure, pass(a) :: cp_from_coo => psb_s_cp_dia_from_coo + ! procedure, pass(a) :: mv_to_coo => psb_s_mv_dia_to_coo + procedure, pass(a) :: mv_from_coo => psb_s_mv_dia_from_coo + ! procedure, pass(a) :: mv_to_fmt => psb_s_mv_dia_to_fmt + ! procedure, pass(a) :: mv_from_fmt => psb_s_mv_dia_from_fmt + ! procedure, pass(a) :: csput_a => psb_s_dia_csput_a + procedure, pass(a) :: get_diag => psb_s_dia_get_diag + procedure, pass(a) :: csgetptn => psb_s_dia_csgetptn + procedure, pass(a) :: csgetrow => psb_s_dia_csgetrow + ! procedure, pass(a) :: get_nz_row => s_dia_get_nz_row + procedure, pass(a) :: reinit => psb_s_dia_reinit + ! procedure, pass(a) :: trim => psb_s_dia_trim + procedure, pass(a) :: print => psb_s_dia_print + procedure, pass(a) :: free => s_dia_free + procedure, pass(a) :: mold => psb_s_dia_mold + + end type psb_s_dia_sparse_mat + + private :: s_dia_get_nzeros, s_dia_free, s_dia_get_fmt, & + & s_dia_sizeof !, s_dia_get_size, s_dia_get_nz_row + + interface + subroutine psb_s_dia_reallocate_nz(nz,a) + import :: psb_s_dia_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_s_dia_sparse_mat), intent(inout) :: a + end subroutine psb_s_dia_reallocate_nz + end interface + + interface + subroutine psb_s_dia_reinit(a,clear) + import :: psb_s_dia_sparse_mat + class(psb_s_dia_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + end subroutine psb_s_dia_reinit + end interface + + interface + subroutine psb_s_dia_trim(a) + import :: psb_s_dia_sparse_mat + class(psb_s_dia_sparse_mat), intent(inout) :: a + end subroutine psb_s_dia_trim + end interface + + interface + subroutine psb_s_dia_mold(a,b,info) + import :: psb_s_dia_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_dia_mold + end interface + + interface + subroutine psb_s_dia_allocate_mnnz(m,n,a,nz) + import :: psb_s_dia_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_dia_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_s_dia_allocate_mnnz + end interface + + interface + subroutine psb_s_dia_print(iout,a,iv,head,ivr,ivc) + import :: psb_s_dia_sparse_mat, psb_ipk_, psb_lpk_ + integer(psb_ipk_), intent(in) :: iout + class(psb_s_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(:) + end subroutine psb_s_dia_print + end interface + + interface + subroutine psb_s_cp_dia_to_coo(a,b,info) + import :: psb_s_coo_sparse_mat, psb_s_dia_sparse_mat, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(in) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_dia_to_coo + end interface + + interface + subroutine psb_s_cp_dia_from_coo(a,b,info) + import :: psb_s_dia_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_dia_from_coo + end interface + + interface + subroutine psb_s_cp_dia_to_fmt(a,b,info) + import :: psb_s_dia_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_dia_to_fmt + end interface + + interface + subroutine psb_s_cp_dia_from_fmt(a,b,info) + import :: psb_s_dia_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_dia_from_fmt + end interface + + interface + subroutine psb_s_mv_dia_to_coo(a,b,info) + import :: psb_s_dia_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_dia_to_coo + end interface + + interface + subroutine psb_s_mv_dia_from_coo(a,b,info) + import :: psb_s_dia_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_dia_from_coo + end interface + + interface + subroutine psb_s_mv_dia_to_fmt(a,b,info) + import :: psb_s_dia_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_dia_to_fmt + end interface + + interface + subroutine psb_s_mv_dia_from_fmt(a,b,info) + import :: psb_s_dia_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_dia_from_fmt + end interface + + interface + subroutine psb_s_dia_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_s_dia_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& + & imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_dia_csput_a + end interface + + interface + subroutine psb_s_dia_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + import :: psb_s_dia_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_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 + end subroutine psb_s_dia_csgetptn + end interface + + interface + subroutine psb_s_dia_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_s_dia_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_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(:) + real(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 + end subroutine psb_s_dia_csgetrow + end interface + + interface + subroutine psb_s_dia_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + import :: psb_s_dia_sparse_mat, psb_spk_, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(in) :: a + class(psb_s_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 + end subroutine psb_s_dia_csgetblk + end interface + + interface + subroutine psb_s_dia_cssv(alpha,a,x,beta,y,info,trans) + import :: psb_s_dia_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_dia_cssv + subroutine psb_s_dia_cssm(alpha,a,x,beta,y,info,trans) + import :: psb_s_dia_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_dia_cssm + end interface + + interface + subroutine psb_s_dia_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_s_dia_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_dia_csmv + subroutine psb_s_dia_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_s_dia_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_dia_csmm + end interface + + + interface + function psb_s_dia_maxval(a) result(res) + import :: psb_s_dia_sparse_mat, psb_spk_ + class(psb_s_dia_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_dia_maxval + end interface + + interface + function psb_s_dia_csnmi(a) result(res) + import :: psb_s_dia_sparse_mat, psb_spk_ + class(psb_s_dia_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_dia_csnmi + end interface + + interface + function psb_s_dia_csnm1(a) result(res) + import :: psb_s_dia_sparse_mat, psb_spk_ + class(psb_s_dia_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_dia_csnm1 + end interface + + interface + subroutine psb_s_dia_rowsum(d,a) + import :: psb_s_dia_sparse_mat, psb_spk_ + class(psb_s_dia_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_dia_rowsum + end interface + + interface + subroutine psb_s_dia_arwsum(d,a) + import :: psb_s_dia_sparse_mat, psb_spk_ + class(psb_s_dia_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_dia_arwsum + end interface + + interface + subroutine psb_s_dia_colsum(d,a) + import :: psb_s_dia_sparse_mat, psb_spk_ + class(psb_s_dia_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_dia_colsum + end interface + + interface + subroutine psb_s_dia_aclsum(d,a) + import :: psb_s_dia_sparse_mat, psb_spk_ + class(psb_s_dia_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_dia_aclsum + end interface + + interface + subroutine psb_s_dia_get_diag(a,d,info) + import :: psb_s_dia_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_dia_get_diag + end interface + + interface + subroutine psb_s_dia_scal(d,a,info,side) + import :: psb_s_dia_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_s_dia_scal + end interface + + interface + subroutine psb_s_dia_scals(d,a,info) + import :: psb_s_dia_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_dia_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_dia_scals + end interface + + interface psi_convert_dia_from_coo + subroutine psi_s_convert_dia_from_coo(a,tmp,info) + import :: psb_s_dia_sparse_mat, psb_ipk_, psb_s_coo_sparse_mat + implicit none + class(psb_s_dia_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(out) :: info + end subroutine psi_s_convert_dia_from_coo + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function s_dia_sizeof(a) result(res) + implicit none + class(psb_s_dia_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + if (a%is_dev()) call a%sync() + res = 8 + res = res + psb_sizeof_sp * size(a%data) + res = res + psb_sizeof_ip * size(a%offset) + + end function s_dia_sizeof + + function s_dia_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DIA' + end function s_dia_get_fmt + + function s_dia_get_nzeros(a) result(res) + implicit none + class(psb_s_dia_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nzeros + end function s_dia_get_nzeros + + ! function s_dia_get_size(a) result(res) + ! implicit none + ! class(psb_s_dia_sparse_mat), intent(in) :: a + ! integer(psb_ipk_) :: res + + ! res = -1 + + ! if (allocated(a%ja)) then + ! if (res >= 0) then + ! res = min(res,size(a%ja)) + ! else + ! res = size(a%ja) + ! end if + ! end if + ! if (allocated(a%val)) then + ! if (res >= 0) then + ! res = min(res,size(a%val)) + ! else + ! res = size(a%val) + ! end if + ! end if + + ! end function s_dia_get_size + + + ! function s_dia_get_nz_row(idx,a) result(res) + + ! implicit none + + ! class(psb_s_dia_sparse_mat), intent(in) :: a + ! integer(psb_ipk_), intent(in) :: idx + ! integer(psb_ipk_) :: res + + ! res = 0 + + ! if ((1<=idx).and.(idx<=a%get_nrows())) then + ! res = a%irn(idx) + ! end if + + ! end function s_dia_get_nz_row + + + + ! ! == =================================== + ! ! + ! ! + ! ! + ! ! Data management + ! ! + ! ! + ! ! + ! ! + ! ! + ! ! == =================================== + + subroutine s_dia_free(a) + implicit none + + class(psb_s_dia_sparse_mat), intent(inout) :: a + + if (allocated(a%data)) deallocate(a%data) + if (allocated(a%offset)) deallocate(a%offset) + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + + return + + end subroutine s_dia_free + + +end module psb_s_dia_mat_mod diff --git a/ext/psb_s_dns_mat_mod.f90 b/ext/psb_s_dns_mat_mod.f90 new file mode 100644 index 00000000..e9ea5f26 --- /dev/null +++ b/ext/psb_s_dns_mat_mod.f90 @@ -0,0 +1,467 @@ +! 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. +! +module psb_s_dns_mat_mod + + use psb_s_base_mat_mod + + type, extends(psb_s_base_sparse_mat) :: psb_s_dns_sparse_mat + ! + ! DNS format: a very simple dense matrix storage + ! psb_spk_ : kind for double precision reals + ! psb_ipk_: kind for normal integers. + ! psb_sizeof_dp: variable holding size in bytes of + ! a double + ! psb_sizeof_ip: size in bytes of an integer + ! + ! psb_realloc(n,v,info) Reallocate: does what it says + ! psb_realloc(m,n,a,info) on rank 1 and 2 arrays, may start + ! from unallocated + ! + ! + integer(psb_ipk_) :: nnz + real(psb_spk_), allocatable :: val(:,:) + + contains + procedure, pass(a) :: get_size => s_dns_get_size + procedure, pass(a) :: get_nzeros => s_dns_get_nzeros + procedure, nopass :: get_fmt => s_dns_get_fmt + procedure, pass(a) :: sizeof => s_dns_sizeof + procedure, pass(a) :: csmv => psb_s_dns_csmv + procedure, pass(a) :: csmm => psb_s_dns_csmm + procedure, pass(a) :: csnmi => psb_s_dns_csnmi + procedure, pass(a) :: reallocate_nz => psb_s_dns_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_s_dns_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_s_cp_dns_to_coo + procedure, pass(a) :: cp_from_coo => psb_s_cp_dns_from_coo + procedure, pass(a) :: mv_to_coo => psb_s_mv_dns_to_coo + procedure, pass(a) :: mv_from_coo => psb_s_mv_dns_from_coo + procedure, pass(a) :: get_diag => psb_s_dns_get_diag + procedure, pass(a) :: csgetrow => psb_s_dns_csgetrow + procedure, pass(a) :: get_nz_row => s_dns_get_nz_row + procedure, pass(a) :: trim => psb_s_dns_trim + procedure, pass(a) :: free => s_dns_free + procedure, pass(a) :: mold => psb_s_dns_mold + + end type psb_s_dns_sparse_mat + + private :: s_dns_get_nzeros, s_dns_free, s_dns_get_fmt, & + & s_dns_get_size, s_dns_sizeof, s_dns_get_nz_row + + ! + ! + !> Function reallocate_nz + !! \memberof psb_s_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. + ! + interface + subroutine psb_s_dns_reallocate_nz(nz,a) + import :: psb_s_dns_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_s_dns_sparse_mat), intent(inout) :: a + end subroutine psb_s_dns_reallocate_nz + end interface + + !> Function trim + !! \memberof psb_s_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. + ! + interface + subroutine psb_s_dns_trim(a) + import :: psb_s_dns_sparse_mat + class(psb_s_dns_sparse_mat), intent(inout) :: a + end subroutine psb_s_dns_trim + end interface + + ! + !> Function mold: + !! \memberof psb_s_dns_sparse_mat + !! \brief Allocate a class(psb_s_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 + ! + interface + subroutine psb_s_dns_mold(a,b,info) + import :: psb_s_dns_sparse_mat, psb_s_base_sparse_mat, psb_epk_, psb_ipk_ + class(psb_s_dns_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_dns_mold + end interface + + ! + ! + !> Function allocate_mnnz + !! \memberof psb_s_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 + ! + interface + subroutine psb_s_dns_allocate_mnnz(m,n,a,nz) + import :: psb_s_dns_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_dns_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_s_dns_allocate_mnnz + end interface + + ! + !> Function cp_to_coo: + !! \memberof psb_s_dns_sparse_mat + !! \brief Copy and convert to psb_s_coo_sparse_mat + !! Invoked from the source object. + !! \param b The output variable + !! \param info return code + ! + interface + subroutine psb_s_cp_dns_to_coo(a,b,info) + import :: psb_s_coo_sparse_mat, psb_s_dns_sparse_mat, psb_ipk_ + class(psb_s_dns_sparse_mat), intent(in) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_dns_to_coo + end interface + + ! + !> Function cp_from_coo: + !! \memberof psb_s_dns_sparse_mat + !! \brief Copy and convert from psb_s_coo_sparse_mat + !! Invoked from the target object. + !! \param b The input variable + !! \param info return code + ! + interface + subroutine psb_s_cp_dns_from_coo(a,b,info) + import :: psb_s_dns_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_dns_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_dns_from_coo + end interface + + ! + !> Function mv_to_coo: + !! \memberof psb_s_dns_sparse_mat + !! \brief Convert to psb_s_coo_sparse_mat, freeing the source. + !! Invoked from the source object. + !! \param b The output variable + !! \param info return code + ! + interface + subroutine psb_s_mv_dns_to_coo(a,b,info) + import :: psb_s_dns_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_dns_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_dns_to_coo + end interface + + ! + !> Function mv_from_coo: + !! \memberof psb_s_dns_sparse_mat + !! \brief Convert from psb_s_coo_sparse_mat, freeing the source. + !! Invoked from the target object. + !! \param b The input variable + !! \param info return code + ! + interface + subroutine psb_s_mv_dns_from_coo(a,b,info) + import :: psb_s_dns_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_dns_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_dns_from_coo + end interface + + ! + ! + !> Function csgetrow: + !! \memberof psb_s_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 + !! + ! + interface + subroutine psb_s_dns_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_s_dns_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_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(:) + real(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 + end subroutine psb_s_dns_csgetrow + end interface + + + + !> Function csmv: + !! \memberof psb_s_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) + !! + ! + interface + subroutine psb_s_dns_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_s_dns_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_dns_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_dns_csmv + end interface + + !> Function csmm: + !! \memberof psb_s_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) + !! + ! + interface + subroutine psb_s_dns_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_s_dns_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_dns_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_dns_csmm + end interface + + ! + ! + !> Function csnmi: + !! \memberof psb_s_dns_sparse_mat + !! \brief Operator infinity norm + !! CSNMI = MAXVAL(SUM(ABS(A(:,:)),dim=2)) + !! + ! + interface + function psb_s_dns_csnmi(a) result(res) + import :: psb_s_dns_sparse_mat, psb_spk_ + class(psb_s_dns_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_dns_csnmi + end interface + + ! + !> Function get_diag: + !! \memberof psb_s_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. + ! + interface + subroutine psb_s_dns_get_diag(a,d,info) + import :: psb_s_dns_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_dns_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_dns_get_diag + end interface + + +contains + + ! + !> Function sizeof + !! \memberof psb_s_dns_sparse_mat + !! \brief Memory occupation in bytes + ! + function s_dns_sizeof(a) result(res) + implicit none + class(psb_s_dns_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + res = psb_sizeof_dp * size(a%val) + res = res + psb_sizeof_ip + + end function s_dns_sizeof + + ! + !> Function get_fmt + !! \memberof psb_s_dns_sparse_mat + !! \brief return a short descriptive name (e.g. COO CSR etc.) + ! + function s_dns_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DNS' + end function s_dns_get_fmt + + ! + !> Function get_nzeros + !! \memberof psb_s_dns_sparse_mat + !! \brief Current number of nonzero entries + ! + function s_dns_get_nzeros(a) result(res) + implicit none + class(psb_s_dns_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nnz + end function s_dns_get_nzeros + + ! + !> Function get_size + !! \memberof psb_s_dns_sparse_mat + !! \brief Maximum number of nonzeros the current structure can hold + ! this is fixed once you initialize the matrix, with dense storage + ! you can hold up to MxN entries + function s_dns_get_size(a) result(res) + implicit none + class(psb_s_dns_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + + res = size(a%val) + + end function s_dns_get_size + + + ! + !> Function get_nz_row. + !! \memberof psb_s_coo_sparse_mat + !! \brief How many nonzeros in a row? + !! + !! \param idx The row to search. + !! + ! + function s_dns_get_nz_row(idx,a) result(res) + + implicit none + + class(psb_s_dns_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: idx + integer(psb_ipk_) :: res + + res = 0 + + if ((1<=idx).and.(idx<=a%get_nrows())) then + res = count(a%val(idx,:) /= dzero) + end if + + end function s_dns_get_nz_row + + ! + !> Function free + !! \memberof psb_s_dns_sparse_mat + !! Name says all + + subroutine s_dns_free(a) + implicit none + + class(psb_s_dns_sparse_mat), intent(inout) :: a + + if (allocated(a%val)) deallocate(a%val) + a%nnz = 0 + + + ! + ! Mark the object as empty just in case + ! + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + + return + + end subroutine s_dns_free + + +end module psb_s_dns_mat_mod diff --git a/ext/psb_s_ell_mat_mod.f90 b/ext/psb_s_ell_mat_mod.f90 new file mode 100644 index 00000000..5f09913a --- /dev/null +++ b/ext/psb_s_ell_mat_mod.f90 @@ -0,0 +1,544 @@ +! 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. +! + + +module psb_s_ell_mat_mod + + use psb_s_base_mat_mod + + type, extends(psb_s_base_sparse_mat) :: psb_s_ell_sparse_mat + ! + ! ITPACK/ELL format, extended. + ! Based on M. Heroux "A proposal for a sparse BLAS toolkit". + ! IRN is our addition, should help in transferring to/from + ! other formats (should come in handy for GPUs). + ! Notes: + ! 1. JA holds the column indices, padded with the row index. + ! 2. VAL holds the coefficients, padded with zeros + ! 3. IDIAG hold the position of the diagonal element + ! or 0 if it is not there, but is only relevant for + ! triangular matrices. In particular, a unit triangular matrix + ! will have IDIAG==0. + ! 4. IRN holds the actual number of nonzeros stored in each row + ! 5. Within a row, the indices are sorted for use of SV. + ! + + integer(psb_ipk_) :: nzt + integer(psb_ipk_), allocatable :: irn(:), ja(:,:), idiag(:) + real(psb_spk_), allocatable :: val(:,:) + + contains + procedure, pass(a) :: is_by_rows => s_ell_is_by_rows + procedure, pass(a) :: get_size => s_ell_get_size + procedure, pass(a) :: get_nzeros => s_ell_get_nzeros + procedure, nopass :: get_fmt => s_ell_get_fmt + procedure, pass(a) :: sizeof => s_ell_sizeof + procedure, pass(a) :: csmm => psb_s_ell_csmm + procedure, pass(a) :: csmv => psb_s_ell_csmv + procedure, pass(a) :: inner_cssm => psb_s_ell_cssm + procedure, pass(a) :: inner_cssv => psb_s_ell_cssv + procedure, pass(a) :: scals => psb_s_ell_scals + procedure, pass(a) :: scalv => psb_s_ell_scal + procedure, pass(a) :: maxval => psb_s_ell_maxval + procedure, pass(a) :: csnmi => psb_s_ell_csnmi + procedure, pass(a) :: csnm1 => psb_s_ell_csnm1 + procedure, pass(a) :: rowsum => psb_s_ell_rowsum + procedure, pass(a) :: arwsum => psb_s_ell_arwsum + procedure, pass(a) :: colsum => psb_s_ell_colsum + procedure, pass(a) :: aclsum => psb_s_ell_aclsum + procedure, pass(a) :: reallocate_nz => psb_s_ell_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_s_ell_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_s_cp_ell_to_coo + procedure, pass(a) :: cp_from_coo => psb_s_cp_ell_from_coo + procedure, pass(a) :: cp_to_fmt => psb_s_cp_ell_to_fmt + procedure, pass(a) :: cp_from_fmt => psb_s_cp_ell_from_fmt + procedure, pass(a) :: mv_to_coo => psb_s_mv_ell_to_coo + procedure, pass(a) :: mv_from_coo => psb_s_mv_ell_from_coo + procedure, pass(a) :: mv_to_fmt => psb_s_mv_ell_to_fmt + procedure, pass(a) :: mv_from_fmt => psb_s_mv_ell_from_fmt + procedure, pass(a) :: csput_a => psb_s_ell_csput_a + procedure, pass(a) :: get_diag => psb_s_ell_get_diag + procedure, pass(a) :: csgetptn => psb_s_ell_csgetptn + procedure, pass(a) :: csgetrow => psb_s_ell_csgetrow + procedure, pass(a) :: get_nz_row => s_ell_get_nz_row + procedure, pass(a) :: reinit => psb_s_ell_reinit + procedure, pass(a) :: trim => psb_s_ell_trim + procedure, pass(a) :: print => psb_s_ell_print + procedure, pass(a) :: free => s_ell_free + procedure, pass(a) :: mold => psb_s_ell_mold + + end type psb_s_ell_sparse_mat + + private :: s_ell_get_nzeros, s_ell_free, s_ell_get_fmt, & + & s_ell_get_size, s_ell_sizeof, s_ell_get_nz_row, & + & s_ell_is_by_rows + + interface + subroutine psb_s_ell_reallocate_nz(nz,a) + import :: psb_s_ell_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_s_ell_sparse_mat), intent(inout) :: a + end subroutine psb_s_ell_reallocate_nz + end interface + + interface + subroutine psb_s_ell_reinit(a,clear) + import :: psb_s_ell_sparse_mat + class(psb_s_ell_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + end subroutine psb_s_ell_reinit + end interface + + interface + subroutine psb_s_ell_trim(a) + import :: psb_s_ell_sparse_mat + class(psb_s_ell_sparse_mat), intent(inout) :: a + end subroutine psb_s_ell_trim + end interface + + interface + subroutine psb_s_ell_mold(a,b,info) + import :: psb_s_ell_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_ell_mold + end interface + + interface + subroutine psb_s_ell_allocate_mnnz(m,n,a,nz) + import :: psb_s_ell_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_ell_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_s_ell_allocate_mnnz + end interface + + interface + subroutine psb_s_ell_print(iout,a,iv,head,ivr,ivc) + import :: psb_s_ell_sparse_mat, psb_ipk_, psb_lpk_ + integer(psb_ipk_), intent(in) :: iout + class(psb_s_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(:) + end subroutine psb_s_ell_print + end interface + + interface + subroutine psb_s_cp_ell_to_coo(a,b,info) + import :: psb_s_coo_sparse_mat, psb_s_ell_sparse_mat, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(in) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_ell_to_coo + end interface + + interface + subroutine psb_s_cp_ell_from_coo(a,b,info) + import :: psb_s_ell_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_ell_from_coo + end interface + + interface + subroutine psb_s_cp_ell_to_fmt(a,b,info) + import :: psb_s_ell_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_ell_to_fmt + end interface + + interface + subroutine psb_s_cp_ell_from_fmt(a,b,info) + import :: psb_s_ell_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_ell_from_fmt + end interface + + interface + subroutine psb_s_mv_ell_to_coo(a,b,info) + import :: psb_s_ell_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_ell_to_coo + end interface + + interface + subroutine psb_s_mv_ell_from_coo(a,b,info) + import :: psb_s_ell_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_ell_from_coo + end interface + + interface + subroutine psb_s_mv_ell_to_fmt(a,b,info) + import :: psb_s_ell_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_ell_to_fmt + end interface + + interface + subroutine psb_s_mv_ell_from_fmt(a,b,info) + import :: psb_s_ell_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_ell_from_fmt + end interface + + interface + subroutine psb_s_ell_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_s_ell_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& + & imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_ell_csput_a + end interface + + interface + subroutine psb_s_ell_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + import :: psb_s_ell_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_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 + end subroutine psb_s_ell_csgetptn + end interface + + interface + subroutine psb_s_ell_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_s_ell_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_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(:) + real(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 + end subroutine psb_s_ell_csgetrow + end interface + + interface + subroutine psb_s_ell_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + import :: psb_s_ell_sparse_mat, psb_spk_, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(in) :: a + class(psb_s_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 + end subroutine psb_s_ell_csgetblk + end interface + + interface + subroutine psb_s_ell_cssv(alpha,a,x,beta,y,info,trans) + import :: psb_s_ell_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_ell_cssv + subroutine psb_s_ell_cssm(alpha,a,x,beta,y,info,trans) + import :: psb_s_ell_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_ell_cssm + end interface + + interface + subroutine psb_s_ell_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_s_ell_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_ell_csmv + subroutine psb_s_ell_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_s_ell_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_ell_csmm + end interface + + + interface + function psb_s_ell_maxval(a) result(res) + import :: psb_s_ell_sparse_mat, psb_spk_ + class(psb_s_ell_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_ell_maxval + end interface + + interface + function psb_s_ell_csnmi(a) result(res) + import :: psb_s_ell_sparse_mat, psb_spk_ + class(psb_s_ell_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_ell_csnmi + end interface + + interface + function psb_s_ell_csnm1(a) result(res) + import :: psb_s_ell_sparse_mat, psb_spk_ + class(psb_s_ell_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_ell_csnm1 + end interface + + interface + subroutine psb_s_ell_rowsum(d,a) + import :: psb_s_ell_sparse_mat, psb_spk_ + class(psb_s_ell_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_ell_rowsum + end interface + + interface + subroutine psb_s_ell_arwsum(d,a) + import :: psb_s_ell_sparse_mat, psb_spk_ + class(psb_s_ell_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_ell_arwsum + end interface + + interface + subroutine psb_s_ell_colsum(d,a) + import :: psb_s_ell_sparse_mat, psb_spk_ + class(psb_s_ell_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_ell_colsum + end interface + + interface + subroutine psb_s_ell_aclsum(d,a) + import :: psb_s_ell_sparse_mat, psb_spk_ + class(psb_s_ell_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_ell_aclsum + end interface + + interface + subroutine psb_s_ell_get_diag(a,d,info) + import :: psb_s_ell_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_ell_get_diag + end interface + + interface + subroutine psb_s_ell_scal(d,a,info,side) + import :: psb_s_ell_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_s_ell_scal + end interface + + interface + subroutine psb_s_ell_scals(d,a,info) + import :: psb_s_ell_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_ell_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_ell_scals + end interface + + interface + subroutine psi_s_convert_ell_from_coo(a,tmp,info,hacksize) + import :: psb_s_ell_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + implicit none + class(psb_s_ell_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: hacksize + end subroutine psi_s_convert_ell_from_coo + end interface + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function s_ell_is_by_rows(a) result(res) + implicit none + class(psb_s_ell_sparse_mat), intent(in) :: a + logical :: res + res = .true. + end function s_ell_is_by_rows + + function s_ell_sizeof(a) result(res) + implicit none + class(psb_s_ell_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + if (a%is_dev()) call a%sync() + res = 8 + res = res + psb_sizeof_sp * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%ja) + + end function s_ell_sizeof + + function s_ell_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'ELL' + end function s_ell_get_fmt + + function s_ell_get_nzeros(a) result(res) + implicit none + class(psb_s_ell_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nzt + end function s_ell_get_nzeros + + function s_ell_get_size(a) result(res) + implicit none + class(psb_s_ell_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + + res = -1 + if (a%is_dev()) call a%sync() + + if (allocated(a%ja)) then + if (res >= 0) then + res = min(res,size(a%ja)) + else + res = size(a%ja) + end if + end if + if (allocated(a%val)) then + if (res >= 0) then + res = min(res,size(a%val)) + else + res = size(a%val) + end if + end if + + end function s_ell_get_size + + + function s_ell_get_nz_row(idx,a) result(res) + + implicit none + + class(psb_s_ell_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: idx + integer(psb_ipk_) :: res + + res = 0 + if (a%is_dev()) call a%sync() + + if ((1<=idx).and.(idx<=a%get_nrows())) then + res = a%irn(idx) + end if + + end function s_ell_get_nz_row + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine s_ell_free(a) + implicit none + + class(psb_s_ell_sparse_mat), intent(inout) :: a + + if (allocated(a%idiag)) deallocate(a%idiag) + if (allocated(a%irn)) deallocate(a%irn) + if (allocated(a%ja)) deallocate(a%ja) + if (allocated(a%val)) deallocate(a%val) + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + + return + + end subroutine s_ell_free + + +end module psb_s_ell_mat_mod diff --git a/ext/psb_s_hdia_mat_mod.f90 b/ext/psb_s_hdia_mat_mod.f90 new file mode 100644 index 00000000..b7b2b110 --- /dev/null +++ b/ext/psb_s_hdia_mat_mod.f90 @@ -0,0 +1,534 @@ +! 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. +! + +module psb_s_hdia_mat_mod + + use psb_s_base_mat_mod + + + type, extends(psb_s_base_sparse_mat) :: psb_s_hdia_sparse_mat + ! + ! HDIA format + ! + integer(psb_ipk_), allocatable :: hackOffsets(:), diaOffsets(:) + real(psb_spk_), allocatable :: val(:) + + + integer(psb_ipk_) :: nhacks, nzeros + integer(psb_ipk_) :: hacksize = 32 + integer(psb_epk_) :: dim=0 + + contains + ! procedure, pass(a) :: get_size => s_hdia_get_size + procedure, pass(a) :: get_nzeros => s_hdia_get_nzeros + procedure, pass(a) :: set_nzeros => s_hdia_set_nzeros + procedure, nopass :: get_fmt => s_hdia_get_fmt + procedure, pass(a) :: sizeof => s_hdia_sizeof + ! procedure, pass(a) :: csmm => psb_s_hdia_csmm + procedure, pass(a) :: csmv => psb_s_hdia_csmv + ! procedure, pass(a) :: inner_cssm => psb_s_hdia_cssm + ! procedure, pass(a) :: inner_cssv => psb_s_hdia_cssv + ! procedure, pass(a) :: scals => psb_s_hdia_scals + ! procedure, pass(a) :: scalv => psb_s_hdia_scal + ! procedure, pass(a) :: maxval => psb_s_hdia_maxval + ! procedure, pass(a) :: csnmi => psb_s_hdia_csnmi + ! procedure, pass(a) :: csnm1 => psb_s_hdia_csnm1 + ! procedure, pass(a) :: rowsum => psb_s_hdia_rowsum + ! procedure, pass(a) :: arwsum => psb_s_hdia_arwsum + ! procedure, pass(a) :: colsum => psb_s_hdia_colsum + ! procedure, pass(a) :: aclsum => psb_s_hdia_aclsum + ! procedure, pass(a) :: reallocate_nz => psb_s_hdia_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_s_hdia_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_s_cp_hdia_to_coo + procedure, pass(a) :: cp_from_coo => psb_s_cp_hdia_from_coo + ! procedure, pass(a) :: cp_to_fmt => psb_s_cp_hdia_to_fmt + ! procedure, pass(a) :: cp_from_fmt => psb_s_cp_hdia_from_fmt + procedure, pass(a) :: mv_to_coo => psb_s_mv_hdia_to_coo + procedure, pass(a) :: mv_from_coo => psb_s_mv_hdia_from_coo + ! procedure, pass(a) :: mv_to_fmt => psb_s_mv_hdia_to_fmt + ! procedure, pass(a) :: mv_from_fmt => psb_s_mv_hdia_from_fmt + ! procedure, pass(a) :: csput_a => psb_s_hdia_csput_a + ! procedure, pass(a) :: get_diag => psb_s_hdia_get_diag + ! procedure, pass(a) :: csgetptn => psb_s_hdia_csgetptn + ! procedure, pass(a) :: csgetrow => psb_s_hdia_csgetrow + ! procedure, pass(a) :: get_nz_row => s_hdia_get_nz_row + ! procedure, pass(a) :: reinit => psb_s_hdia_reinit + ! procedure, pass(a) :: trim => psb_s_hdia_trim + procedure, pass(a) :: print => psb_s_hdia_print + procedure, pass(a) :: free => s_hdia_free + procedure, pass(a) :: mold => psb_s_hdia_mold + + end type psb_s_hdia_sparse_mat + + private :: s_hdia_get_nzeros, s_hdia_set_nzeros, s_hdia_free, & + & s_hdia_get_fmt, s_hdia_sizeof +!!$ & +!!$ & s_hdia_get_nz_row s_hdia_get_size, + +!!$ interface +!!$ subroutine psb_s_hdia_reallocate_nz(nz,a) +!!$ import :: psb_s_hdia_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_s_hdia_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_s_hdia_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_hdia_reinit(a,clear) +!!$ import :: psb_s_hdia_sparse_mat +!!$ class(psb_s_hdia_sparse_mat), intent(inout) :: a +!!$ logical, intent(in), optional :: clear +!!$ end subroutine psb_s_hdia_reinit +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_hdia_trim(a) +!!$ import :: psb_s_hdia_sparse_mat +!!$ class(psb_s_hdia_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_s_hdia_trim +!!$ end interface + + interface + subroutine psb_s_hdia_mold(a,b,info) + import :: psb_s_hdia_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_hdia_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_hdia_mold + end interface + + interface + subroutine psb_s_hdia_allocate_mnnz(m,n,a,nz) + import :: psb_s_hdia_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_hdia_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_s_hdia_allocate_mnnz + end interface + + interface + subroutine psb_s_hdia_print(iout,a,iv,head,ivr,ivc) + import :: psb_s_hdia_sparse_mat, psb_ipk_, psb_lpk_ + integer(psb_ipk_), intent(in) :: iout + class(psb_s_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(:) + end subroutine psb_s_hdia_print + end interface + + interface + subroutine psb_s_cp_hdia_to_coo(a,b,info) + import :: psb_s_coo_sparse_mat, psb_s_hdia_sparse_mat, psb_ipk_ + class(psb_s_hdia_sparse_mat), intent(in) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_hdia_to_coo + end interface + + interface + subroutine psb_s_cp_hdia_from_coo(a,b,info) + import :: psb_s_hdia_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_hdia_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_hdia_from_coo + end interface + +!!$ interface +!!$ subroutine psb_s_cp_hdia_to_fmt(a,b,info) +!!$ import :: psb_s_hdia_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ +!!$ class(psb_s_hdia_sparse_mat), intent(in) :: a +!!$ class(psb_s_base_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_s_cp_hdia_to_fmt +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_cp_hdia_from_fmt(a,b,info) +!!$ import :: psb_s_hdia_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ +!!$ class(psb_s_hdia_sparse_mat), intent(inout) :: a +!!$ class(psb_s_base_sparse_mat), intent(in) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_s_cp_hdia_from_fmt +!!$ end interface + + interface + subroutine psb_s_mv_hdia_to_coo(a,b,info) + import :: psb_s_hdia_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_hdia_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_hdia_to_coo + end interface + + interface + subroutine psb_s_mv_hdia_from_coo(a,b,info) + import :: psb_s_hdia_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_hdia_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_hdia_from_coo + end interface + +!!$ interface +!!$ subroutine psb_s_mv_hdia_to_fmt(a,b,info) +!!$ import :: psb_s_hdia_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ +!!$ class(psb_s_hdia_sparse_mat), intent(inout) :: a +!!$ class(psb_s_base_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_s_mv_hdia_to_fmt +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_mv_hdia_from_fmt(a,b,info) +!!$ import :: psb_s_hdia_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ +!!$ class(psb_s_hdia_sparse_mat), intent(inout) :: a +!!$ class(psb_s_base_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_s_mv_hdia_from_fmt +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_hdia_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) +!!$ import :: psb_s_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_s_hdia_sparse_mat), intent(inout) :: a +!!$ real(psb_spk_), intent(in) :: val(:) +!!$ integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& +!!$ & imin,imax,jmin,jmax +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_s_hdia_csput_a +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_hdia_csgetptn(imin,imax,a,nz,ia,ja,info,& +!!$ & jmin,jmax,iren,append,nzin,rscale,cscale) +!!$ import :: psb_s_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_s_hdia_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 +!!$ end subroutine psb_s_hdia_csgetptn +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_hdia_csgetrow(imin,imax,a,nz,ia,ja,val,info,& +!!$ & jmin,jmax,iren,append,nzin,rscale,cscale) +!!$ import :: psb_s_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_s_hdia_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(:) +!!$ real(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 +!!$ end subroutine psb_s_hdia_csgetrow +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_hdia_csgetblk(imin,imax,a,b,info,& +!!$ & jmin,jmax,iren,append,rscale,cscale) +!!$ import :: psb_s_hdia_sparse_mat, psb_spk_, psb_s_coo_sparse_mat, psb_ipk_ +!!$ class(psb_s_hdia_sparse_mat), intent(in) :: a +!!$ class(psb_s_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 +!!$ end subroutine psb_s_hdia_csgetblk +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_hdia_cssv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_s_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_s_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_spk_), intent(in) :: alpha, beta, x(:) +!!$ real(psb_spk_), intent(inout) :: y(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_s_hdia_cssv +!!$ subroutine psb_s_hdia_cssm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_s_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_s_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_spk_), intent(in) :: alpha, beta, x(:,:) +!!$ real(psb_spk_), intent(inout) :: y(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_s_hdia_cssm +!!$ end interface + + interface + subroutine psb_s_hdia_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_s_hdia_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hdia_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_hdia_csmv +!!$ subroutine psb_s_hdia_csmm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_s_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_s_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_spk_), intent(in) :: alpha, beta, x(:,:) +!!$ real(psb_spk_), intent(inout) :: y(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_s_hdia_csmm + end interface + + +!!$ interface +!!$ function psb_s_hdia_maxval(a) result(res) +!!$ import :: psb_s_hdia_sparse_mat, psb_spk_ +!!$ class(psb_s_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_spk_) :: res +!!$ end function psb_s_hdia_maxval +!!$ end interface +!!$ +!!$ interface +!!$ function psb_s_hdia_csnmi(a) result(res) +!!$ import :: psb_s_hdia_sparse_mat, psb_spk_ +!!$ class(psb_s_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_spk_) :: res +!!$ end function psb_s_hdia_csnmi +!!$ end interface +!!$ +!!$ interface +!!$ function psb_s_hdia_csnm1(a) result(res) +!!$ import :: psb_s_hdia_sparse_mat, psb_spk_ +!!$ class(psb_s_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_spk_) :: res +!!$ end function psb_s_hdia_csnm1 +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_hdia_rowsum(d,a) +!!$ import :: psb_s_hdia_sparse_mat, psb_spk_ +!!$ class(psb_s_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_spk_), intent(out) :: d(:) +!!$ end subroutine psb_s_hdia_rowsum +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_hdia_arwsum(d,a) +!!$ import :: psb_s_hdia_sparse_mat, psb_spk_ +!!$ class(psb_s_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_spk_), intent(out) :: d(:) +!!$ end subroutine psb_s_hdia_arwsum +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_hdia_colsum(d,a) +!!$ import :: psb_s_hdia_sparse_mat, psb_spk_ +!!$ class(psb_s_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_spk_), intent(out) :: d(:) +!!$ end subroutine psb_s_hdia_colsum +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_hdia_aclsum(d,a) +!!$ import :: psb_s_hdia_sparse_mat, psb_spk_ +!!$ class(psb_s_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_spk_), intent(out) :: d(:) +!!$ end subroutine psb_s_hdia_aclsum +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_hdia_get_diag(a,d,info) +!!$ import :: psb_s_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_s_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_spk_), intent(out) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_s_hdia_get_diag +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_s_hdia_scal(d,a,info,side) +!!$ import :: psb_s_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_s_hdia_sparse_mat), intent(inout) :: a +!!$ real(psb_spk_), intent(in) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, intent(in), optional :: side +!!$ end subroutine psb_s_hdia_scal +!!$ end interface + +!!$ interface +!!$ subroutine psb_s_hdia_scals(d,a,info) +!!$ import :: psb_s_hdia_sparse_mat, psb_spk_, psb_ipk_ +!!$ class(psb_s_hdia_sparse_mat), intent(inout) :: a +!!$ real(psb_spk_), intent(in) :: d +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_s_hdia_scals +!!$ end interface +!!$ + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function s_hdia_sizeof(a) result(res) + use psb_realloc_mod, only : psb_size + implicit none + class(psb_s_hdia_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + integer(psb_ipk_) :: i + + if (a%is_dev()) call a%sync() + res = 0 + + res = res + psb_size(a%hackOffsets)*psb_sizeof_ip + res = res + psb_size(a%diaOffsets)*psb_sizeof_ip + res = res + psb_size(a%val) * psb_sizeof_sp + + end function s_hdia_sizeof + + function s_hdia_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HDIA' + end function s_hdia_get_fmt + + function s_hdia_get_nzeros(a) result(res) + implicit none + class(psb_s_hdia_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nzeros + end function s_hdia_get_nzeros + + subroutine s_hdia_set_nzeros(a,nz) + implicit none + class(psb_s_hdia_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: nz + a%nzeros = nz + end subroutine s_hdia_set_nzeros + + ! function s_hdia_get_size(a) result(res) + ! implicit none + ! class(psb_s_hdia_sparse_mat), intent(in) :: a + ! integer(psb_ipk_) :: res + + ! res = -1 + + ! if (allocated(a%ja)) then + ! if (res >= 0) then + ! res = min(res,size(a%ja)) + ! else + ! res = size(a%ja) + ! end if + ! end if + ! if (allocated(a%val)) then + ! if (res >= 0) then + ! res = min(res,size(a%val)) + ! else + ! res = size(a%val) + ! end if + ! end if + + ! end function s_hdia_get_size + + + ! function s_hdia_get_nz_row(idx,a) result(res) + + ! implicit none + + ! class(psb_s_hdia_sparse_mat), intent(in) :: a + ! integer(psb_ipk_), intent(in) :: idx + ! integer(psb_ipk_) :: res + + ! res = 0 + + ! if ((1<=idx).and.(idx<=a%get_nrows())) then + ! res = a%irn(idx) + ! end if + + ! end function s_hdia_get_nz_row + + + + ! ! == =================================== + ! ! + ! ! + ! ! + ! ! Data management + ! ! + ! ! + ! ! + ! ! + ! ! + ! ! == =================================== + + subroutine s_hdia_free(a) + implicit none + + class(psb_s_hdia_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: i, info + + + if (allocated(a%hackOffsets))& + & deallocate(a%hackOffsets,stat=info) + if (allocated(a%diaOffsets))& + & deallocate(a%diaOffsets,stat=info) + if (allocated(a%val))& + & deallocate(a%val,stat=info) + a%nhacks=0 + + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + + return + + end subroutine s_hdia_free + + +end module psb_s_hdia_mat_mod diff --git a/ext/psb_s_hll_mat_mod.f90 b/ext/psb_s_hll_mat_mod.f90 new file mode 100644 index 00000000..735091c8 --- /dev/null +++ b/ext/psb_s_hll_mat_mod.f90 @@ -0,0 +1,564 @@ +! 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. +! + + +module psb_s_hll_mat_mod + + use psb_s_base_mat_mod + use psi_ext_util_mod + + type, extends(psb_s_base_sparse_mat) :: psb_s_hll_sparse_mat + ! + ! HLL format. (Hacked ELL) + ! A modification of ELL. + ! Basic idea: pack and pad data in blocks of HCK rows; + ! this reduces the impact of a lone, very long row. + ! Notes: + ! 1. JA holds the column indices, padded with the row index. + ! 2. VAL holds the coefficients, padded with zeros + ! 3. IDIAG hold the position of the diagonal element + ! or 0 if it is not there, but is only relevant for + ! triangular matrices. In particular, a unit triangular matrix + ! will have IDIAG==0. + ! 4. IRN holds the actual number of nonzeros stored in each row + ! 5. Within a row, the indices are sorted for use of SV. + ! 6. hksz: hack size (multiple of 32) + ! 7. hkoffs(:): offsets of the starts of hacks inside ja/val + ! + ! + ! + integer(psb_ipk_) :: hksz, nzt + integer(psb_ipk_), allocatable :: irn(:), ja(:), idiag(:), hkoffs(:) + real(psb_spk_), allocatable :: val(:) + + contains + + procedure, pass(a) :: get_hksz => s_hll_get_hksz + procedure, pass(a) :: set_hksz => s_hll_set_hksz + procedure, pass(a) :: get_size => s_hll_get_size + procedure, pass(a) :: set_nzeros => s_hll_set_nzeros + procedure, pass(a) :: get_nzeros => s_hll_get_nzeros + procedure, nopass :: get_fmt => s_hll_get_fmt + procedure, pass(a) :: sizeof => s_hll_sizeof + procedure, pass(a) :: csmm => psb_s_hll_csmm + procedure, pass(a) :: csmv => psb_s_hll_csmv + procedure, pass(a) :: inner_cssm => psb_s_hll_cssm + procedure, pass(a) :: inner_cssv => psb_s_hll_cssv + procedure, pass(a) :: scals => psb_s_hll_scals + procedure, pass(a) :: scalv => psb_s_hll_scal + procedure, pass(a) :: maxval => psb_s_hll_maxval + procedure, pass(a) :: csnmi => psb_s_hll_csnmi + procedure, pass(a) :: csnm1 => psb_s_hll_csnm1 + procedure, pass(a) :: rowsum => psb_s_hll_rowsum + procedure, pass(a) :: arwsum => psb_s_hll_arwsum + procedure, pass(a) :: colsum => psb_s_hll_colsum + procedure, pass(a) :: aclsum => psb_s_hll_aclsum + procedure, pass(a) :: reallocate_nz => psb_s_hll_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_s_hll_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_s_cp_hll_to_coo + procedure, pass(a) :: cp_from_coo => psb_s_cp_hll_from_coo + procedure, pass(a) :: cp_to_fmt => psb_s_cp_hll_to_fmt + procedure, pass(a) :: cp_from_fmt => psb_s_cp_hll_from_fmt + procedure, pass(a) :: mv_to_coo => psb_s_mv_hll_to_coo + procedure, pass(a) :: mv_from_coo => psb_s_mv_hll_from_coo + procedure, pass(a) :: mv_to_fmt => psb_s_mv_hll_to_fmt + procedure, pass(a) :: mv_from_fmt => psb_s_mv_hll_from_fmt + procedure, pass(a) :: csput_a => psb_s_hll_csput_a + procedure, pass(a) :: get_diag => psb_s_hll_get_diag + procedure, pass(a) :: csgetptn => psb_s_hll_csgetptn + procedure, pass(a) :: csgetrow => psb_s_hll_csgetrow + procedure, pass(a) :: get_nz_row => s_hll_get_nz_row + procedure, pass(a) :: reinit => psb_s_hll_reinit + procedure, pass(a) :: print => psb_s_hll_print + procedure, pass(a) :: free => s_hll_free + procedure, pass(a) :: mold => psb_s_hll_mold + + end type psb_s_hll_sparse_mat + + private :: s_hll_get_nzeros, s_hll_free, s_hll_get_fmt, & + & s_hll_get_size, s_hll_sizeof, s_hll_get_nz_row, & + & s_hll_set_nzeros, s_hll_get_hksz, s_hll_set_hksz + + interface + subroutine psb_s_hll_reallocate_nz(nz,a) + import :: psb_s_hll_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_s_hll_sparse_mat), intent(inout) :: a + end subroutine psb_s_hll_reallocate_nz + end interface + + interface + subroutine psb_s_hll_reinit(a,clear) + import :: psb_s_hll_sparse_mat + class(psb_s_hll_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + end subroutine psb_s_hll_reinit + end interface + + interface + subroutine psb_s_hll_mold(a,b,info) + import :: psb_s_hll_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_hll_mold + end interface + + interface + subroutine psb_s_hll_allocate_mnnz(m,n,a,nz) + import :: psb_s_hll_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_s_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_s_hll_allocate_mnnz + end interface + + interface + subroutine psb_s_hll_print(iout,a,iv,head,ivr,ivc) + import :: psb_s_hll_sparse_mat, psb_ipk_, psb_lpk_ + integer(psb_ipk_), intent(in) :: iout + class(psb_s_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(:) + end subroutine psb_s_hll_print + end interface + + interface + subroutine psb_s_cp_hll_to_coo(a,b,info) + import :: psb_s_coo_sparse_mat, psb_s_hll_sparse_mat, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(in) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_hll_to_coo + end interface + + interface + subroutine psb_s_cp_hll_from_coo(a,b,info) + import :: psb_s_hll_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_hll_from_coo + end interface + + interface + subroutine psb_s_cp_hll_to_fmt(a,b,info) + import :: psb_s_hll_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(in) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_hll_to_fmt + end interface + + interface + subroutine psb_s_cp_hll_from_fmt(a,b,info) + import :: psb_s_hll_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_cp_hll_from_fmt + end interface + + interface + subroutine psb_s_mv_hll_to_coo(a,b,info) + import :: psb_s_hll_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_hll_to_coo + end interface + + interface + subroutine psb_s_mv_hll_from_coo(a,b,info) + import :: psb_s_hll_sparse_mat, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(inout) :: a + class(psb_s_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_hll_from_coo + end interface + + interface + subroutine psb_s_mv_hll_to_fmt(a,b,info) + import :: psb_s_hll_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_hll_to_fmt + end interface + + interface + subroutine psb_s_mv_hll_from_fmt(a,b,info) + import :: psb_s_hll_sparse_mat, psb_s_base_sparse_mat, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(inout) :: a + class(psb_s_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_mv_hll_from_fmt + end interface + + interface + subroutine psb_s_hll_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_s_hll_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& + & imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_hll_csput_a + end interface + + interface + subroutine psb_s_hll_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + import :: psb_s_hll_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_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 + end subroutine psb_s_hll_csgetptn + end interface + + interface + subroutine psb_s_hll_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_s_hll_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_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(:) + real(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 + end subroutine psb_s_hll_csgetrow + end interface + + interface + subroutine psb_s_hll_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + import :: psb_s_hll_sparse_mat, psb_spk_, psb_s_coo_sparse_mat, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(in) :: a + class(psb_s_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 + end subroutine psb_s_hll_csgetblk + end interface + + interface + subroutine psb_s_hll_cssv(alpha,a,x,beta,y,info,trans) + import :: psb_s_hll_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_hll_cssv + subroutine psb_s_hll_cssm(alpha,a,x,beta,y,info,trans) + import :: psb_s_hll_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_hll_cssm + end interface + + interface + subroutine psb_s_hll_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_s_hll_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:) + real(psb_spk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_hll_csmv + subroutine psb_s_hll_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_s_hll_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(in) :: a + real(psb_spk_), intent(in) :: alpha, beta, x(:,:) + real(psb_spk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_s_hll_csmm + end interface + + + interface + function psb_s_hll_maxval(a) result(res) + import :: psb_s_hll_sparse_mat, psb_spk_ + class(psb_s_hll_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_hll_maxval + end interface + + interface + function psb_s_hll_csnmi(a) result(res) + import :: psb_s_hll_sparse_mat, psb_spk_ + class(psb_s_hll_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_hll_csnmi + end interface + + interface + function psb_s_hll_csnm1(a) result(res) + import :: psb_s_hll_sparse_mat, psb_spk_ + class(psb_s_hll_sparse_mat), intent(in) :: a + real(psb_spk_) :: res + end function psb_s_hll_csnm1 + end interface + + interface + subroutine psb_s_hll_rowsum(d,a) + import :: psb_s_hll_sparse_mat, psb_spk_ + class(psb_s_hll_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_hll_rowsum + end interface + + interface + subroutine psb_s_hll_arwsum(d,a) + import :: psb_s_hll_sparse_mat, psb_spk_ + class(psb_s_hll_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_hll_arwsum + end interface + + interface + subroutine psb_s_hll_colsum(d,a) + import :: psb_s_hll_sparse_mat, psb_spk_ + class(psb_s_hll_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_hll_colsum + end interface + + interface + subroutine psb_s_hll_aclsum(d,a) + import :: psb_s_hll_sparse_mat, psb_spk_ + class(psb_s_hll_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + end subroutine psb_s_hll_aclsum + end interface + + interface + subroutine psb_s_hll_get_diag(a,d,info) + import :: psb_s_hll_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(in) :: a + real(psb_spk_), intent(out) :: d(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_hll_get_diag + end interface + + interface + subroutine psb_s_hll_scal(d,a,info,side) + import :: psb_s_hll_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_s_hll_scal + end interface + + interface + subroutine psb_s_hll_scals(d,a,info) + import :: psb_s_hll_sparse_mat, psb_spk_, psb_ipk_ + class(psb_s_hll_sparse_mat), intent(inout) :: a + real(psb_spk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_hll_scals + end interface + + interface psi_convert_hll_from_coo + subroutine psi_s_convert_hll_from_coo(a,hksz,tmp,info) + import :: psb_s_hll_sparse_mat, psb_ipk_, psb_s_coo_sparse_mat + implicit none + class(psb_s_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: hksz + class(psb_s_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(out) :: info + end subroutine psi_s_convert_hll_from_coo + end interface + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function s_hll_sizeof(a) result(res) + implicit none + class(psb_s_hll_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + if (a%is_dev()) call a%sync() + res = 8 + res = res + psb_sizeof_sp * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%ja) + res = res + psb_sizeof_ip * size(a%hkoffs) + + end function s_hll_sizeof + + function s_hll_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HLL' + end function s_hll_get_fmt + + subroutine s_hll_set_nzeros(a,n) + implicit none + class(psb_s_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: n + + a%nzt = n + end subroutine s_hll_set_nzeros + + function s_hll_get_nzeros(a) result(res) + implicit none + class(psb_s_hll_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nzt + end function s_hll_get_nzeros + + function s_hll_get_size(a) result(res) + implicit none + class(psb_s_hll_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + + if (a%is_dev()) call a%sync() + + res = -1 + + if (allocated(a%ja)) then + if (res >= 0) then + res = min(res,size(a%ja)) + else + res = size(a%ja) + end if + end if + if (allocated(a%val)) then + if (res >= 0) then + res = min(res,size(a%val)) + else + res = size(a%val) + end if + end if + + end function s_hll_get_size + + + + function s_hll_get_nz_row(idx,a) result(res) + + implicit none + + class(psb_s_hll_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: idx + integer(psb_ipk_) :: res + + res = 0 + + if ((1<=idx).and.(idx<=a%get_nrows())) then + res = a%irn(idx) + end if + + end function s_hll_get_nz_row + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine s_hll_free(a) + implicit none + + class(psb_s_hll_sparse_mat), intent(inout) :: a + + if (allocated(a%idiag)) deallocate(a%idiag) + if (allocated(a%irn)) deallocate(a%irn) + if (allocated(a%ja)) deallocate(a%ja) + if (allocated(a%val)) deallocate(a%val) + if (allocated(a%val)) deallocate(a%hkoffs) + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + call a%set_hksz(izero) + + return + + end subroutine s_hll_free + + subroutine s_hll_set_hksz(a,n) + implicit none + class(psb_s_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: n + + a%hksz = n + end subroutine s_hll_set_hksz + + function s_hll_get_hksz(a) result(res) + implicit none + class(psb_s_hll_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + + res = a%hksz + + end function s_hll_get_hksz + +end module psb_s_hll_mat_mod diff --git a/ext/psb_z_dia_mat_mod.f90 b/ext/psb_z_dia_mat_mod.f90 new file mode 100644 index 00000000..76d071af --- /dev/null +++ b/ext/psb_z_dia_mat_mod.f90 @@ -0,0 +1,513 @@ +! 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. +! + + +module psb_z_dia_mat_mod + + use psb_z_base_mat_mod + + type, extends(psb_z_base_sparse_mat) :: psb_z_dia_sparse_mat + ! + ! DIA format, extended. + ! + + integer(psb_ipk_), allocatable :: offset(:) + integer(psb_ipk_) :: nzeros + complex(psb_dpk_), allocatable :: data(:,:) + + contains + ! procedure, pass(a) :: get_size => z_dia_get_size + procedure, pass(a) :: get_nzeros => z_dia_get_nzeros + procedure, nopass :: get_fmt => z_dia_get_fmt + procedure, pass(a) :: sizeof => z_dia_sizeof + procedure, pass(a) :: csmm => psb_z_dia_csmm + procedure, pass(a) :: csmv => psb_z_dia_csmv + ! procedure, pass(a) :: inner_cssm => psb_z_dia_cssm + ! procedure, pass(a) :: inner_cssv => psb_z_dia_cssv + procedure, pass(a) :: scals => psb_z_dia_scals + procedure, pass(a) :: scalv => psb_z_dia_scal + procedure, pass(a) :: maxval => psb_z_dia_maxval + procedure, pass(a) :: rowsum => psb_z_dia_rowsum + procedure, pass(a) :: arwsum => psb_z_dia_arwsum + procedure, pass(a) :: colsum => psb_z_dia_colsum + procedure, pass(a) :: aclsum => psb_z_dia_aclsum + procedure, pass(a) :: reallocate_nz => psb_z_dia_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_z_dia_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_z_cp_dia_to_coo + procedure, pass(a) :: cp_from_coo => psb_z_cp_dia_from_coo + ! procedure, pass(a) :: mv_to_coo => psb_z_mv_dia_to_coo + procedure, pass(a) :: mv_from_coo => psb_z_mv_dia_from_coo + ! procedure, pass(a) :: mv_to_fmt => psb_z_mv_dia_to_fmt + ! procedure, pass(a) :: mv_from_fmt => psb_z_mv_dia_from_fmt + ! procedure, pass(a) :: csput_a => psb_z_dia_csput_a + procedure, pass(a) :: get_diag => psb_z_dia_get_diag + procedure, pass(a) :: csgetptn => psb_z_dia_csgetptn + procedure, pass(a) :: csgetrow => psb_z_dia_csgetrow + ! procedure, pass(a) :: get_nz_row => z_dia_get_nz_row + procedure, pass(a) :: reinit => psb_z_dia_reinit + ! procedure, pass(a) :: trim => psb_z_dia_trim + procedure, pass(a) :: print => psb_z_dia_print + procedure, pass(a) :: free => z_dia_free + procedure, pass(a) :: mold => psb_z_dia_mold + + end type psb_z_dia_sparse_mat + + private :: z_dia_get_nzeros, z_dia_free, z_dia_get_fmt, & + & z_dia_sizeof !, z_dia_get_size, z_dia_get_nz_row + + interface + subroutine psb_z_dia_reallocate_nz(nz,a) + import :: psb_z_dia_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_z_dia_sparse_mat), intent(inout) :: a + end subroutine psb_z_dia_reallocate_nz + end interface + + interface + subroutine psb_z_dia_reinit(a,clear) + import :: psb_z_dia_sparse_mat + class(psb_z_dia_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + end subroutine psb_z_dia_reinit + end interface + + interface + subroutine psb_z_dia_trim(a) + import :: psb_z_dia_sparse_mat + class(psb_z_dia_sparse_mat), intent(inout) :: a + end subroutine psb_z_dia_trim + end interface + + interface + subroutine psb_z_dia_mold(a,b,info) + import :: psb_z_dia_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_dia_mold + end interface + + interface + subroutine psb_z_dia_allocate_mnnz(m,n,a,nz) + import :: psb_z_dia_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_dia_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_z_dia_allocate_mnnz + end interface + + interface + subroutine psb_z_dia_print(iout,a,iv,head,ivr,ivc) + import :: psb_z_dia_sparse_mat, psb_ipk_, psb_lpk_ + integer(psb_ipk_), intent(in) :: iout + class(psb_z_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(:) + end subroutine psb_z_dia_print + end interface + + interface + subroutine psb_z_cp_dia_to_coo(a,b,info) + import :: psb_z_coo_sparse_mat, psb_z_dia_sparse_mat, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(in) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_dia_to_coo + end interface + + interface + subroutine psb_z_cp_dia_from_coo(a,b,info) + import :: psb_z_dia_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_dia_from_coo + end interface + + interface + subroutine psb_z_cp_dia_to_fmt(a,b,info) + import :: psb_z_dia_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_dia_to_fmt + end interface + + interface + subroutine psb_z_cp_dia_from_fmt(a,b,info) + import :: psb_z_dia_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_dia_from_fmt + end interface + + interface + subroutine psb_z_mv_dia_to_coo(a,b,info) + import :: psb_z_dia_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_dia_to_coo + end interface + + interface + subroutine psb_z_mv_dia_from_coo(a,b,info) + import :: psb_z_dia_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_dia_from_coo + end interface + + interface + subroutine psb_z_mv_dia_to_fmt(a,b,info) + import :: psb_z_dia_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_dia_to_fmt + end interface + + interface + subroutine psb_z_mv_dia_from_fmt(a,b,info) + import :: psb_z_dia_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_dia_from_fmt + end interface + + interface + subroutine psb_z_dia_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_z_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& + & imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_dia_csput_a + end interface + + interface + subroutine psb_z_dia_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + import :: psb_z_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_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 + end subroutine psb_z_dia_csgetptn + end interface + + interface + subroutine psb_z_dia_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_z_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_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_dpk_), 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 + end subroutine psb_z_dia_csgetrow + end interface + + interface + subroutine psb_z_dia_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + import :: psb_z_dia_sparse_mat, psb_dpk_, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(in) :: a + class(psb_z_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 + end subroutine psb_z_dia_csgetblk + end interface + + interface + subroutine psb_z_dia_cssv(alpha,a,x,beta,y,info,trans) + import :: psb_z_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_dia_cssv + subroutine psb_z_dia_cssm(alpha,a,x,beta,y,info,trans) + import :: psb_z_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_dia_cssm + end interface + + interface + subroutine psb_z_dia_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_z_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_dia_csmv + subroutine psb_z_dia_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_z_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_dia_csmm + end interface + + + interface + function psb_z_dia_maxval(a) result(res) + import :: psb_z_dia_sparse_mat, psb_dpk_ + class(psb_z_dia_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_dia_maxval + end interface + + interface + function psb_z_dia_csnmi(a) result(res) + import :: psb_z_dia_sparse_mat, psb_dpk_ + class(psb_z_dia_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_dia_csnmi + end interface + + interface + function psb_z_dia_csnm1(a) result(res) + import :: psb_z_dia_sparse_mat, psb_dpk_ + class(psb_z_dia_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_dia_csnm1 + end interface + + interface + subroutine psb_z_dia_rowsum(d,a) + import :: psb_z_dia_sparse_mat, psb_dpk_ + class(psb_z_dia_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_dia_rowsum + end interface + + interface + subroutine psb_z_dia_arwsum(d,a) + import :: psb_z_dia_sparse_mat, psb_dpk_ + class(psb_z_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_dia_arwsum + end interface + + interface + subroutine psb_z_dia_colsum(d,a) + import :: psb_z_dia_sparse_mat, psb_dpk_ + class(psb_z_dia_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_dia_colsum + end interface + + interface + subroutine psb_z_dia_aclsum(d,a) + import :: psb_z_dia_sparse_mat, psb_dpk_ + class(psb_z_dia_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_dia_aclsum + end interface + + interface + subroutine psb_z_dia_get_diag(a,d,info) + import :: psb_z_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_dia_get_diag + end interface + + interface + subroutine psb_z_dia_scal(d,a,info,side) + import :: psb_z_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_z_dia_scal + end interface + + interface + subroutine psb_z_dia_scals(d,a,info) + import :: psb_z_dia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_dia_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_dia_scals + end interface + + interface psi_convert_dia_from_coo + subroutine psi_z_convert_dia_from_coo(a,tmp,info) + import :: psb_z_dia_sparse_mat, psb_ipk_, psb_z_coo_sparse_mat + implicit none + class(psb_z_dia_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(out) :: info + end subroutine psi_z_convert_dia_from_coo + end interface + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function z_dia_sizeof(a) result(res) + implicit none + class(psb_z_dia_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + if (a%is_dev()) call a%sync() + res = 8 + res = res + (2*psb_sizeof_dp) * size(a%data) + res = res + psb_sizeof_ip * size(a%offset) + + end function z_dia_sizeof + + function z_dia_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DIA' + end function z_dia_get_fmt + + function z_dia_get_nzeros(a) result(res) + implicit none + class(psb_z_dia_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nzeros + end function z_dia_get_nzeros + + ! function z_dia_get_size(a) result(res) + ! implicit none + ! class(psb_z_dia_sparse_mat), intent(in) :: a + ! integer(psb_ipk_) :: res + + ! res = -1 + + ! if (allocated(a%ja)) then + ! if (res >= 0) then + ! res = min(res,size(a%ja)) + ! else + ! res = size(a%ja) + ! end if + ! end if + ! if (allocated(a%val)) then + ! if (res >= 0) then + ! res = min(res,size(a%val)) + ! else + ! res = size(a%val) + ! end if + ! end if + + ! end function z_dia_get_size + + + ! function z_dia_get_nz_row(idx,a) result(res) + + ! implicit none + + ! class(psb_z_dia_sparse_mat), intent(in) :: a + ! integer(psb_ipk_), intent(in) :: idx + ! integer(psb_ipk_) :: res + + ! res = 0 + + ! if ((1<=idx).and.(idx<=a%get_nrows())) then + ! res = a%irn(idx) + ! end if + + ! end function z_dia_get_nz_row + + + + ! ! == =================================== + ! ! + ! ! + ! ! + ! ! Data management + ! ! + ! ! + ! ! + ! ! + ! ! + ! ! == =================================== + + subroutine z_dia_free(a) + implicit none + + class(psb_z_dia_sparse_mat), intent(inout) :: a + + if (allocated(a%data)) deallocate(a%data) + if (allocated(a%offset)) deallocate(a%offset) + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + + return + + end subroutine z_dia_free + + +end module psb_z_dia_mat_mod diff --git a/ext/psb_z_dns_mat_mod.f90 b/ext/psb_z_dns_mat_mod.f90 new file mode 100644 index 00000000..6147057d --- /dev/null +++ b/ext/psb_z_dns_mat_mod.f90 @@ -0,0 +1,467 @@ +! 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. +! +module psb_z_dns_mat_mod + + use psb_z_base_mat_mod + + type, extends(psb_z_base_sparse_mat) :: psb_z_dns_sparse_mat + ! + ! DNS format: a very simple dense matrix storage + ! psb_dpk_ : kind for double precision reals + ! psb_ipk_: kind for normal integers. + ! psb_sizeof_dp: variable holding size in bytes of + ! a double + ! psb_sizeof_ip: size in bytes of an integer + ! + ! psb_realloc(n,v,info) Reallocate: does what it says + ! psb_realloc(m,n,a,info) on rank 1 and 2 arrays, may start + ! from unallocated + ! + ! + integer(psb_ipk_) :: nnz + complex(psb_dpk_), allocatable :: val(:,:) + + contains + procedure, pass(a) :: get_size => z_dns_get_size + procedure, pass(a) :: get_nzeros => z_dns_get_nzeros + procedure, nopass :: get_fmt => z_dns_get_fmt + procedure, pass(a) :: sizeof => z_dns_sizeof + procedure, pass(a) :: csmv => psb_z_dns_csmv + procedure, pass(a) :: csmm => psb_z_dns_csmm + procedure, pass(a) :: csnmi => psb_z_dns_csnmi + procedure, pass(a) :: reallocate_nz => psb_z_dns_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_z_dns_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_z_cp_dns_to_coo + procedure, pass(a) :: cp_from_coo => psb_z_cp_dns_from_coo + procedure, pass(a) :: mv_to_coo => psb_z_mv_dns_to_coo + procedure, pass(a) :: mv_from_coo => psb_z_mv_dns_from_coo + procedure, pass(a) :: get_diag => psb_z_dns_get_diag + procedure, pass(a) :: csgetrow => psb_z_dns_csgetrow + procedure, pass(a) :: get_nz_row => z_dns_get_nz_row + procedure, pass(a) :: trim => psb_z_dns_trim + procedure, pass(a) :: free => z_dns_free + procedure, pass(a) :: mold => psb_z_dns_mold + + end type psb_z_dns_sparse_mat + + private :: z_dns_get_nzeros, z_dns_free, z_dns_get_fmt, & + & z_dns_get_size, z_dns_sizeof, z_dns_get_nz_row + + ! + ! + !> Function reallocate_nz + !! \memberof psb_z_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. + ! + interface + subroutine psb_z_dns_reallocate_nz(nz,a) + import :: psb_z_dns_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_z_dns_sparse_mat), intent(inout) :: a + end subroutine psb_z_dns_reallocate_nz + end interface + + !> Function trim + !! \memberof psb_z_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. + ! + interface + subroutine psb_z_dns_trim(a) + import :: psb_z_dns_sparse_mat + class(psb_z_dns_sparse_mat), intent(inout) :: a + end subroutine psb_z_dns_trim + end interface + + ! + !> Function mold: + !! \memberof psb_z_dns_sparse_mat + !! \brief Allocate a class(psb_z_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 + ! + interface + subroutine psb_z_dns_mold(a,b,info) + import :: psb_z_dns_sparse_mat, psb_z_base_sparse_mat, psb_epk_, psb_ipk_ + class(psb_z_dns_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_dns_mold + end interface + + ! + ! + !> Function allocate_mnnz + !! \memberof psb_z_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 + ! + interface + subroutine psb_z_dns_allocate_mnnz(m,n,a,nz) + import :: psb_z_dns_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_dns_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_z_dns_allocate_mnnz + end interface + + ! + !> Function cp_to_coo: + !! \memberof psb_z_dns_sparse_mat + !! \brief Copy and convert to psb_z_coo_sparse_mat + !! Invoked from the source object. + !! \param b The output variable + !! \param info return code + ! + interface + subroutine psb_z_cp_dns_to_coo(a,b,info) + import :: psb_z_coo_sparse_mat, psb_z_dns_sparse_mat, psb_ipk_ + class(psb_z_dns_sparse_mat), intent(in) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_dns_to_coo + end interface + + ! + !> Function cp_from_coo: + !! \memberof psb_z_dns_sparse_mat + !! \brief Copy and convert from psb_z_coo_sparse_mat + !! Invoked from the target object. + !! \param b The input variable + !! \param info return code + ! + interface + subroutine psb_z_cp_dns_from_coo(a,b,info) + import :: psb_z_dns_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_dns_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_dns_from_coo + end interface + + ! + !> Function mv_to_coo: + !! \memberof psb_z_dns_sparse_mat + !! \brief Convert to psb_z_coo_sparse_mat, freeing the source. + !! Invoked from the source object. + !! \param b The output variable + !! \param info return code + ! + interface + subroutine psb_z_mv_dns_to_coo(a,b,info) + import :: psb_z_dns_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_dns_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_dns_to_coo + end interface + + ! + !> Function mv_from_coo: + !! \memberof psb_z_dns_sparse_mat + !! \brief Convert from psb_z_coo_sparse_mat, freeing the source. + !! Invoked from the target object. + !! \param b The input variable + !! \param info return code + ! + interface + subroutine psb_z_mv_dns_from_coo(a,b,info) + import :: psb_z_dns_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_dns_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_dns_from_coo + end interface + + ! + ! + !> Function csgetrow: + !! \memberof psb_z_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 + !! + ! + interface + subroutine psb_z_dns_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_z_dns_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_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_dpk_), 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 + end subroutine psb_z_dns_csgetrow + end interface + + + + !> Function csmv: + !! \memberof psb_z_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) + !! + ! + interface + subroutine psb_z_dns_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_z_dns_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_dns_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_dns_csmv + end interface + + !> Function csmm: + !! \memberof psb_z_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) + !! + ! + interface + subroutine psb_z_dns_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_z_dns_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_dns_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_dns_csmm + end interface + + ! + ! + !> Function csnmi: + !! \memberof psb_z_dns_sparse_mat + !! \brief Operator infinity norm + !! CSNMI = MAXVAL(SUM(ABS(A(:,:)),dim=2)) + !! + ! + interface + function psb_z_dns_csnmi(a) result(res) + import :: psb_z_dns_sparse_mat, psb_dpk_ + class(psb_z_dns_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_dns_csnmi + end interface + + ! + !> Function get_diag: + !! \memberof psb_z_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. + ! + interface + subroutine psb_z_dns_get_diag(a,d,info) + import :: psb_z_dns_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_dns_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_dns_get_diag + end interface + + +contains + + ! + !> Function sizeof + !! \memberof psb_z_dns_sparse_mat + !! \brief Memory occupation in bytes + ! + function z_dns_sizeof(a) result(res) + implicit none + class(psb_z_dns_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + + res = psb_sizeof_dp * size(a%val) + res = res + psb_sizeof_ip + + end function z_dns_sizeof + + ! + !> Function get_fmt + !! \memberof psb_z_dns_sparse_mat + !! \brief return a short descriptive name (e.g. COO CSR etc.) + ! + function z_dns_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'DNS' + end function z_dns_get_fmt + + ! + !> Function get_nzeros + !! \memberof psb_z_dns_sparse_mat + !! \brief Current number of nonzero entries + ! + function z_dns_get_nzeros(a) result(res) + implicit none + class(psb_z_dns_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nnz + end function z_dns_get_nzeros + + ! + !> Function get_size + !! \memberof psb_z_dns_sparse_mat + !! \brief Maximum number of nonzeros the current structure can hold + ! this is fixed once you initialize the matrix, with dense storage + ! you can hold up to MxN entries + function z_dns_get_size(a) result(res) + implicit none + class(psb_z_dns_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + + res = size(a%val) + + end function z_dns_get_size + + + ! + !> Function get_nz_row. + !! \memberof psb_z_coo_sparse_mat + !! \brief How many nonzeros in a row? + !! + !! \param idx The row to search. + !! + ! + function z_dns_get_nz_row(idx,a) result(res) + + implicit none + + class(psb_z_dns_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: idx + integer(psb_ipk_) :: res + + res = 0 + + if ((1<=idx).and.(idx<=a%get_nrows())) then + res = count(a%val(idx,:) /= dzero) + end if + + end function z_dns_get_nz_row + + ! + !> Function free + !! \memberof psb_z_dns_sparse_mat + !! Name says all + + subroutine z_dns_free(a) + implicit none + + class(psb_z_dns_sparse_mat), intent(inout) :: a + + if (allocated(a%val)) deallocate(a%val) + a%nnz = 0 + + + ! + ! Mark the object as empty just in case + ! + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + + return + + end subroutine z_dns_free + + +end module psb_z_dns_mat_mod diff --git a/ext/psb_z_ell_mat_mod.f90 b/ext/psb_z_ell_mat_mod.f90 new file mode 100644 index 00000000..52dc62b1 --- /dev/null +++ b/ext/psb_z_ell_mat_mod.f90 @@ -0,0 +1,544 @@ +! 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. +! + + +module psb_z_ell_mat_mod + + use psb_z_base_mat_mod + + type, extends(psb_z_base_sparse_mat) :: psb_z_ell_sparse_mat + ! + ! ITPACK/ELL format, extended. + ! Based on M. Heroux "A proposal for a sparse BLAS toolkit". + ! IRN is our addition, should help in transferring to/from + ! other formats (should come in handy for GPUs). + ! Notes: + ! 1. JA holds the column indices, padded with the row index. + ! 2. VAL holds the coefficients, padded with zeros + ! 3. IDIAG hold the position of the diagonal element + ! or 0 if it is not there, but is only relevant for + ! triangular matrices. In particular, a unit triangular matrix + ! will have IDIAG==0. + ! 4. IRN holds the actual number of nonzeros stored in each row + ! 5. Within a row, the indices are sorted for use of SV. + ! + + integer(psb_ipk_) :: nzt + integer(psb_ipk_), allocatable :: irn(:), ja(:,:), idiag(:) + complex(psb_dpk_), allocatable :: val(:,:) + + contains + procedure, pass(a) :: is_by_rows => z_ell_is_by_rows + procedure, pass(a) :: get_size => z_ell_get_size + procedure, pass(a) :: get_nzeros => z_ell_get_nzeros + procedure, nopass :: get_fmt => z_ell_get_fmt + procedure, pass(a) :: sizeof => z_ell_sizeof + procedure, pass(a) :: csmm => psb_z_ell_csmm + procedure, pass(a) :: csmv => psb_z_ell_csmv + procedure, pass(a) :: inner_cssm => psb_z_ell_cssm + procedure, pass(a) :: inner_cssv => psb_z_ell_cssv + procedure, pass(a) :: scals => psb_z_ell_scals + procedure, pass(a) :: scalv => psb_z_ell_scal + procedure, pass(a) :: maxval => psb_z_ell_maxval + procedure, pass(a) :: csnmi => psb_z_ell_csnmi + procedure, pass(a) :: csnm1 => psb_z_ell_csnm1 + procedure, pass(a) :: rowsum => psb_z_ell_rowsum + procedure, pass(a) :: arwsum => psb_z_ell_arwsum + procedure, pass(a) :: colsum => psb_z_ell_colsum + procedure, pass(a) :: aclsum => psb_z_ell_aclsum + procedure, pass(a) :: reallocate_nz => psb_z_ell_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_z_ell_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_z_cp_ell_to_coo + procedure, pass(a) :: cp_from_coo => psb_z_cp_ell_from_coo + procedure, pass(a) :: cp_to_fmt => psb_z_cp_ell_to_fmt + procedure, pass(a) :: cp_from_fmt => psb_z_cp_ell_from_fmt + procedure, pass(a) :: mv_to_coo => psb_z_mv_ell_to_coo + procedure, pass(a) :: mv_from_coo => psb_z_mv_ell_from_coo + procedure, pass(a) :: mv_to_fmt => psb_z_mv_ell_to_fmt + procedure, pass(a) :: mv_from_fmt => psb_z_mv_ell_from_fmt + procedure, pass(a) :: csput_a => psb_z_ell_csput_a + procedure, pass(a) :: get_diag => psb_z_ell_get_diag + procedure, pass(a) :: csgetptn => psb_z_ell_csgetptn + procedure, pass(a) :: csgetrow => psb_z_ell_csgetrow + procedure, pass(a) :: get_nz_row => z_ell_get_nz_row + procedure, pass(a) :: reinit => psb_z_ell_reinit + procedure, pass(a) :: trim => psb_z_ell_trim + procedure, pass(a) :: print => psb_z_ell_print + procedure, pass(a) :: free => z_ell_free + procedure, pass(a) :: mold => psb_z_ell_mold + + end type psb_z_ell_sparse_mat + + private :: z_ell_get_nzeros, z_ell_free, z_ell_get_fmt, & + & z_ell_get_size, z_ell_sizeof, z_ell_get_nz_row, & + & z_ell_is_by_rows + + interface + subroutine psb_z_ell_reallocate_nz(nz,a) + import :: psb_z_ell_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_z_ell_sparse_mat), intent(inout) :: a + end subroutine psb_z_ell_reallocate_nz + end interface + + interface + subroutine psb_z_ell_reinit(a,clear) + import :: psb_z_ell_sparse_mat + class(psb_z_ell_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + end subroutine psb_z_ell_reinit + end interface + + interface + subroutine psb_z_ell_trim(a) + import :: psb_z_ell_sparse_mat + class(psb_z_ell_sparse_mat), intent(inout) :: a + end subroutine psb_z_ell_trim + end interface + + interface + subroutine psb_z_ell_mold(a,b,info) + import :: psb_z_ell_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_ell_mold + end interface + + interface + subroutine psb_z_ell_allocate_mnnz(m,n,a,nz) + import :: psb_z_ell_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_ell_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_z_ell_allocate_mnnz + end interface + + interface + subroutine psb_z_ell_print(iout,a,iv,head,ivr,ivc) + import :: psb_z_ell_sparse_mat, psb_ipk_, psb_lpk_ + integer(psb_ipk_), intent(in) :: iout + class(psb_z_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(:) + end subroutine psb_z_ell_print + end interface + + interface + subroutine psb_z_cp_ell_to_coo(a,b,info) + import :: psb_z_coo_sparse_mat, psb_z_ell_sparse_mat, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(in) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_ell_to_coo + end interface + + interface + subroutine psb_z_cp_ell_from_coo(a,b,info) + import :: psb_z_ell_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_ell_from_coo + end interface + + interface + subroutine psb_z_cp_ell_to_fmt(a,b,info) + import :: psb_z_ell_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_ell_to_fmt + end interface + + interface + subroutine psb_z_cp_ell_from_fmt(a,b,info) + import :: psb_z_ell_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_ell_from_fmt + end interface + + interface + subroutine psb_z_mv_ell_to_coo(a,b,info) + import :: psb_z_ell_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_ell_to_coo + end interface + + interface + subroutine psb_z_mv_ell_from_coo(a,b,info) + import :: psb_z_ell_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_ell_from_coo + end interface + + interface + subroutine psb_z_mv_ell_to_fmt(a,b,info) + import :: psb_z_ell_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_ell_to_fmt + end interface + + interface + subroutine psb_z_mv_ell_from_fmt(a,b,info) + import :: psb_z_ell_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_ell_from_fmt + end interface + + interface + subroutine psb_z_ell_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_z_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& + & imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_ell_csput_a + end interface + + interface + subroutine psb_z_ell_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + import :: psb_z_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_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 + end subroutine psb_z_ell_csgetptn + end interface + + interface + subroutine psb_z_ell_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_z_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_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_dpk_), 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 + end subroutine psb_z_ell_csgetrow + end interface + + interface + subroutine psb_z_ell_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + import :: psb_z_ell_sparse_mat, psb_dpk_, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(in) :: a + class(psb_z_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 + end subroutine psb_z_ell_csgetblk + end interface + + interface + subroutine psb_z_ell_cssv(alpha,a,x,beta,y,info,trans) + import :: psb_z_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_ell_cssv + subroutine psb_z_ell_cssm(alpha,a,x,beta,y,info,trans) + import :: psb_z_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_ell_cssm + end interface + + interface + subroutine psb_z_ell_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_z_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_ell_csmv + subroutine psb_z_ell_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_z_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_ell_csmm + end interface + + + interface + function psb_z_ell_maxval(a) result(res) + import :: psb_z_ell_sparse_mat, psb_dpk_ + class(psb_z_ell_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_ell_maxval + end interface + + interface + function psb_z_ell_csnmi(a) result(res) + import :: psb_z_ell_sparse_mat, psb_dpk_ + class(psb_z_ell_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_ell_csnmi + end interface + + interface + function psb_z_ell_csnm1(a) result(res) + import :: psb_z_ell_sparse_mat, psb_dpk_ + class(psb_z_ell_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_ell_csnm1 + end interface + + interface + subroutine psb_z_ell_rowsum(d,a) + import :: psb_z_ell_sparse_mat, psb_dpk_ + class(psb_z_ell_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_ell_rowsum + end interface + + interface + subroutine psb_z_ell_arwsum(d,a) + import :: psb_z_ell_sparse_mat, psb_dpk_ + class(psb_z_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_ell_arwsum + end interface + + interface + subroutine psb_z_ell_colsum(d,a) + import :: psb_z_ell_sparse_mat, psb_dpk_ + class(psb_z_ell_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_ell_colsum + end interface + + interface + subroutine psb_z_ell_aclsum(d,a) + import :: psb_z_ell_sparse_mat, psb_dpk_ + class(psb_z_ell_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_ell_aclsum + end interface + + interface + subroutine psb_z_ell_get_diag(a,d,info) + import :: psb_z_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_ell_get_diag + end interface + + interface + subroutine psb_z_ell_scal(d,a,info,side) + import :: psb_z_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_z_ell_scal + end interface + + interface + subroutine psb_z_ell_scals(d,a,info) + import :: psb_z_ell_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_ell_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_ell_scals + end interface + + interface + subroutine psi_z_convert_ell_from_coo(a,tmp,info,hacksize) + import :: psb_z_ell_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + implicit none + class(psb_z_ell_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: hacksize + end subroutine psi_z_convert_ell_from_coo + end interface + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function z_ell_is_by_rows(a) result(res) + implicit none + class(psb_z_ell_sparse_mat), intent(in) :: a + logical :: res + res = .true. + end function z_ell_is_by_rows + + function z_ell_sizeof(a) result(res) + implicit none + class(psb_z_ell_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + if (a%is_dev()) call a%sync() + res = 8 + res = res + (2*psb_sizeof_dp) * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%ja) + + end function z_ell_sizeof + + function z_ell_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'ELL' + end function z_ell_get_fmt + + function z_ell_get_nzeros(a) result(res) + implicit none + class(psb_z_ell_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nzt + end function z_ell_get_nzeros + + function z_ell_get_size(a) result(res) + implicit none + class(psb_z_ell_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + + res = -1 + if (a%is_dev()) call a%sync() + + if (allocated(a%ja)) then + if (res >= 0) then + res = min(res,size(a%ja)) + else + res = size(a%ja) + end if + end if + if (allocated(a%val)) then + if (res >= 0) then + res = min(res,size(a%val)) + else + res = size(a%val) + end if + end if + + end function z_ell_get_size + + + function z_ell_get_nz_row(idx,a) result(res) + + implicit none + + class(psb_z_ell_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: idx + integer(psb_ipk_) :: res + + res = 0 + if (a%is_dev()) call a%sync() + + if ((1<=idx).and.(idx<=a%get_nrows())) then + res = a%irn(idx) + end if + + end function z_ell_get_nz_row + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine z_ell_free(a) + implicit none + + class(psb_z_ell_sparse_mat), intent(inout) :: a + + if (allocated(a%idiag)) deallocate(a%idiag) + if (allocated(a%irn)) deallocate(a%irn) + if (allocated(a%ja)) deallocate(a%ja) + if (allocated(a%val)) deallocate(a%val) + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + + return + + end subroutine z_ell_free + + +end module psb_z_ell_mat_mod diff --git a/ext/psb_z_hdia_mat_mod.f90 b/ext/psb_z_hdia_mat_mod.f90 new file mode 100644 index 00000000..e7c11321 --- /dev/null +++ b/ext/psb_z_hdia_mat_mod.f90 @@ -0,0 +1,534 @@ +! 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. +! + +module psb_z_hdia_mat_mod + + use psb_z_base_mat_mod + + + type, extends(psb_z_base_sparse_mat) :: psb_z_hdia_sparse_mat + ! + ! HDIA format + ! + integer(psb_ipk_), allocatable :: hackOffsets(:), diaOffsets(:) + complex(psb_dpk_), allocatable :: val(:) + + + integer(psb_ipk_) :: nhacks, nzeros + integer(psb_ipk_) :: hacksize = 32 + integer(psb_epk_) :: dim=0 + + contains + ! procedure, pass(a) :: get_size => z_hdia_get_size + procedure, pass(a) :: get_nzeros => z_hdia_get_nzeros + procedure, pass(a) :: set_nzeros => z_hdia_set_nzeros + procedure, nopass :: get_fmt => z_hdia_get_fmt + procedure, pass(a) :: sizeof => z_hdia_sizeof + ! procedure, pass(a) :: csmm => psb_z_hdia_csmm + procedure, pass(a) :: csmv => psb_z_hdia_csmv + ! procedure, pass(a) :: inner_cssm => psb_z_hdia_cssm + ! procedure, pass(a) :: inner_cssv => psb_z_hdia_cssv + ! procedure, pass(a) :: scals => psb_z_hdia_scals + ! procedure, pass(a) :: scalv => psb_z_hdia_scal + ! procedure, pass(a) :: maxval => psb_z_hdia_maxval + ! procedure, pass(a) :: csnmi => psb_z_hdia_csnmi + ! procedure, pass(a) :: csnm1 => psb_z_hdia_csnm1 + ! procedure, pass(a) :: rowsum => psb_z_hdia_rowsum + ! procedure, pass(a) :: arwsum => psb_z_hdia_arwsum + ! procedure, pass(a) :: colsum => psb_z_hdia_colsum + ! procedure, pass(a) :: aclsum => psb_z_hdia_aclsum + ! procedure, pass(a) :: reallocate_nz => psb_z_hdia_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_z_hdia_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_z_cp_hdia_to_coo + procedure, pass(a) :: cp_from_coo => psb_z_cp_hdia_from_coo + ! procedure, pass(a) :: cp_to_fmt => psb_z_cp_hdia_to_fmt + ! procedure, pass(a) :: cp_from_fmt => psb_z_cp_hdia_from_fmt + procedure, pass(a) :: mv_to_coo => psb_z_mv_hdia_to_coo + procedure, pass(a) :: mv_from_coo => psb_z_mv_hdia_from_coo + ! procedure, pass(a) :: mv_to_fmt => psb_z_mv_hdia_to_fmt + ! procedure, pass(a) :: mv_from_fmt => psb_z_mv_hdia_from_fmt + ! procedure, pass(a) :: csput_a => psb_z_hdia_csput_a + ! procedure, pass(a) :: get_diag => psb_z_hdia_get_diag + ! procedure, pass(a) :: csgetptn => psb_z_hdia_csgetptn + ! procedure, pass(a) :: csgetrow => psb_z_hdia_csgetrow + ! procedure, pass(a) :: get_nz_row => z_hdia_get_nz_row + ! procedure, pass(a) :: reinit => psb_z_hdia_reinit + ! procedure, pass(a) :: trim => psb_z_hdia_trim + procedure, pass(a) :: print => psb_z_hdia_print + procedure, pass(a) :: free => z_hdia_free + procedure, pass(a) :: mold => psb_z_hdia_mold + + end type psb_z_hdia_sparse_mat + + private :: z_hdia_get_nzeros, z_hdia_set_nzeros, z_hdia_free, & + & z_hdia_get_fmt, z_hdia_sizeof +!!$ & +!!$ & z_hdia_get_nz_row z_hdia_get_size, + +!!$ interface +!!$ subroutine psb_z_hdia_reallocate_nz(nz,a) +!!$ import :: psb_z_hdia_sparse_mat, psb_ipk_ +!!$ integer(psb_ipk_), intent(in) :: nz +!!$ class(psb_z_hdia_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_z_hdia_reallocate_nz +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_hdia_reinit(a,clear) +!!$ import :: psb_z_hdia_sparse_mat +!!$ class(psb_z_hdia_sparse_mat), intent(inout) :: a +!!$ logical, intent(in), optional :: clear +!!$ end subroutine psb_z_hdia_reinit +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_hdia_trim(a) +!!$ import :: psb_z_hdia_sparse_mat +!!$ class(psb_z_hdia_sparse_mat), intent(inout) :: a +!!$ end subroutine psb_z_hdia_trim +!!$ end interface + + interface + subroutine psb_z_hdia_mold(a,b,info) + import :: psb_z_hdia_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_hdia_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_hdia_mold + end interface + + interface + subroutine psb_z_hdia_allocate_mnnz(m,n,a,nz) + import :: psb_z_hdia_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_hdia_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_z_hdia_allocate_mnnz + end interface + + interface + subroutine psb_z_hdia_print(iout,a,iv,head,ivr,ivc) + import :: psb_z_hdia_sparse_mat, psb_ipk_, psb_lpk_ + integer(psb_ipk_), intent(in) :: iout + class(psb_z_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(:) + end subroutine psb_z_hdia_print + end interface + + interface + subroutine psb_z_cp_hdia_to_coo(a,b,info) + import :: psb_z_coo_sparse_mat, psb_z_hdia_sparse_mat, psb_ipk_ + class(psb_z_hdia_sparse_mat), intent(in) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_hdia_to_coo + end interface + + interface + subroutine psb_z_cp_hdia_from_coo(a,b,info) + import :: psb_z_hdia_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_hdia_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_hdia_from_coo + end interface + +!!$ interface +!!$ subroutine psb_z_cp_hdia_to_fmt(a,b,info) +!!$ import :: psb_z_hdia_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ +!!$ class(psb_z_hdia_sparse_mat), intent(in) :: a +!!$ class(psb_z_base_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_z_cp_hdia_to_fmt +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_cp_hdia_from_fmt(a,b,info) +!!$ import :: psb_z_hdia_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ +!!$ class(psb_z_hdia_sparse_mat), intent(inout) :: a +!!$ class(psb_z_base_sparse_mat), intent(in) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_z_cp_hdia_from_fmt +!!$ end interface + + interface + subroutine psb_z_mv_hdia_to_coo(a,b,info) + import :: psb_z_hdia_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_hdia_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_hdia_to_coo + end interface + + interface + subroutine psb_z_mv_hdia_from_coo(a,b,info) + import :: psb_z_hdia_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_hdia_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_hdia_from_coo + end interface + +!!$ interface +!!$ subroutine psb_z_mv_hdia_to_fmt(a,b,info) +!!$ import :: psb_z_hdia_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ +!!$ class(psb_z_hdia_sparse_mat), intent(inout) :: a +!!$ class(psb_z_base_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_z_mv_hdia_to_fmt +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_mv_hdia_from_fmt(a,b,info) +!!$ import :: psb_z_hdia_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ +!!$ class(psb_z_hdia_sparse_mat), intent(inout) :: a +!!$ class(psb_z_base_sparse_mat), intent(inout) :: b +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_z_mv_hdia_from_fmt +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_hdia_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) +!!$ import :: psb_z_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_z_hdia_sparse_mat), intent(inout) :: a +!!$ complex(psb_dpk_), intent(in) :: val(:) +!!$ integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& +!!$ & imin,imax,jmin,jmax +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_z_hdia_csput_a +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_hdia_csgetptn(imin,imax,a,nz,ia,ja,info,& +!!$ & jmin,jmax,iren,append,nzin,rscale,cscale) +!!$ import :: psb_z_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_z_hdia_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 +!!$ end subroutine psb_z_hdia_csgetptn +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_hdia_csgetrow(imin,imax,a,nz,ia,ja,val,info,& +!!$ & jmin,jmax,iren,append,nzin,rscale,cscale) +!!$ import :: psb_z_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_z_hdia_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_dpk_), 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 +!!$ end subroutine psb_z_hdia_csgetrow +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_hdia_csgetblk(imin,imax,a,b,info,& +!!$ & jmin,jmax,iren,append,rscale,cscale) +!!$ import :: psb_z_hdia_sparse_mat, psb_dpk_, psb_z_coo_sparse_mat, psb_ipk_ +!!$ class(psb_z_hdia_sparse_mat), intent(in) :: a +!!$ class(psb_z_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 +!!$ end subroutine psb_z_hdia_csgetblk +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_hdia_cssv(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_z_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_z_hdia_sparse_mat), intent(in) :: a +!!$ complex(psb_dpk_), intent(in) :: alpha, beta, x(:) +!!$ complex(psb_dpk_), intent(inout) :: y(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_z_hdia_cssv +!!$ subroutine psb_z_hdia_cssm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_z_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_z_hdia_sparse_mat), intent(in) :: a +!!$ complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) +!!$ complex(psb_dpk_), intent(inout) :: y(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_z_hdia_cssm +!!$ end interface + + interface + subroutine psb_z_hdia_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_z_hdia_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hdia_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_hdia_csmv +!!$ subroutine psb_z_hdia_csmm(alpha,a,x,beta,y,info,trans) +!!$ import :: psb_z_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_z_hdia_sparse_mat), intent(in) :: a +!!$ complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) +!!$ complex(psb_dpk_), intent(inout) :: y(:,:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, optional, intent(in) :: trans +!!$ end subroutine psb_z_hdia_csmm + end interface + + +!!$ interface +!!$ function psb_z_hdia_maxval(a) result(res) +!!$ import :: psb_z_hdia_sparse_mat, psb_dpk_ +!!$ class(psb_z_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_) :: res +!!$ end function psb_z_hdia_maxval +!!$ end interface +!!$ +!!$ interface +!!$ function psb_z_hdia_csnmi(a) result(res) +!!$ import :: psb_z_hdia_sparse_mat, psb_dpk_ +!!$ class(psb_z_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_) :: res +!!$ end function psb_z_hdia_csnmi +!!$ end interface +!!$ +!!$ interface +!!$ function psb_z_hdia_csnm1(a) result(res) +!!$ import :: psb_z_hdia_sparse_mat, psb_dpk_ +!!$ class(psb_z_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_) :: res +!!$ end function psb_z_hdia_csnm1 +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_hdia_rowsum(d,a) +!!$ import :: psb_z_hdia_sparse_mat, psb_dpk_ +!!$ class(psb_z_hdia_sparse_mat), intent(in) :: a +!!$ complex(psb_dpk_), intent(out) :: d(:) +!!$ end subroutine psb_z_hdia_rowsum +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_hdia_arwsum(d,a) +!!$ import :: psb_z_hdia_sparse_mat, psb_dpk_ +!!$ class(psb_z_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_), intent(out) :: d(:) +!!$ end subroutine psb_z_hdia_arwsum +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_hdia_colsum(d,a) +!!$ import :: psb_z_hdia_sparse_mat, psb_dpk_ +!!$ class(psb_z_hdia_sparse_mat), intent(in) :: a +!!$ complex(psb_dpk_), intent(out) :: d(:) +!!$ end subroutine psb_z_hdia_colsum +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_hdia_aclsum(d,a) +!!$ import :: psb_z_hdia_sparse_mat, psb_dpk_ +!!$ class(psb_z_hdia_sparse_mat), intent(in) :: a +!!$ real(psb_dpk_), intent(out) :: d(:) +!!$ end subroutine psb_z_hdia_aclsum +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_hdia_get_diag(a,d,info) +!!$ import :: psb_z_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_z_hdia_sparse_mat), intent(in) :: a +!!$ complex(psb_dpk_), intent(out) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_z_hdia_get_diag +!!$ end interface +!!$ +!!$ interface +!!$ subroutine psb_z_hdia_scal(d,a,info,side) +!!$ import :: psb_z_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_z_hdia_sparse_mat), intent(inout) :: a +!!$ complex(psb_dpk_), intent(in) :: d(:) +!!$ integer(psb_ipk_), intent(out) :: info +!!$ character, intent(in), optional :: side +!!$ end subroutine psb_z_hdia_scal +!!$ end interface + +!!$ interface +!!$ subroutine psb_z_hdia_scals(d,a,info) +!!$ import :: psb_z_hdia_sparse_mat, psb_dpk_, psb_ipk_ +!!$ class(psb_z_hdia_sparse_mat), intent(inout) :: a +!!$ complex(psb_dpk_), intent(in) :: d +!!$ integer(psb_ipk_), intent(out) :: info +!!$ end subroutine psb_z_hdia_scals +!!$ end interface +!!$ + + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function z_hdia_sizeof(a) result(res) + use psb_realloc_mod, only : psb_size + implicit none + class(psb_z_hdia_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + integer(psb_ipk_) :: i + + if (a%is_dev()) call a%sync() + res = 0 + + res = res + psb_size(a%hackOffsets)*psb_sizeof_ip + res = res + psb_size(a%diaOffsets)*psb_sizeof_ip + res = res + psb_size(a%val) * (2*psb_sizeof_dp) + + end function z_hdia_sizeof + + function z_hdia_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HDIA' + end function z_hdia_get_fmt + + function z_hdia_get_nzeros(a) result(res) + implicit none + class(psb_z_hdia_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nzeros + end function z_hdia_get_nzeros + + subroutine z_hdia_set_nzeros(a,nz) + implicit none + class(psb_z_hdia_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: nz + a%nzeros = nz + end subroutine z_hdia_set_nzeros + + ! function z_hdia_get_size(a) result(res) + ! implicit none + ! class(psb_z_hdia_sparse_mat), intent(in) :: a + ! integer(psb_ipk_) :: res + + ! res = -1 + + ! if (allocated(a%ja)) then + ! if (res >= 0) then + ! res = min(res,size(a%ja)) + ! else + ! res = size(a%ja) + ! end if + ! end if + ! if (allocated(a%val)) then + ! if (res >= 0) then + ! res = min(res,size(a%val)) + ! else + ! res = size(a%val) + ! end if + ! end if + + ! end function z_hdia_get_size + + + ! function z_hdia_get_nz_row(idx,a) result(res) + + ! implicit none + + ! class(psb_z_hdia_sparse_mat), intent(in) :: a + ! integer(psb_ipk_), intent(in) :: idx + ! integer(psb_ipk_) :: res + + ! res = 0 + + ! if ((1<=idx).and.(idx<=a%get_nrows())) then + ! res = a%irn(idx) + ! end if + + ! end function z_hdia_get_nz_row + + + + ! ! == =================================== + ! ! + ! ! + ! ! + ! ! Data management + ! ! + ! ! + ! ! + ! ! + ! ! + ! ! == =================================== + + subroutine z_hdia_free(a) + implicit none + + class(psb_z_hdia_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: i, info + + + if (allocated(a%hackOffsets))& + & deallocate(a%hackOffsets,stat=info) + if (allocated(a%diaOffsets))& + & deallocate(a%diaOffsets,stat=info) + if (allocated(a%val))& + & deallocate(a%val,stat=info) + a%nhacks=0 + + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + + return + + end subroutine z_hdia_free + + +end module psb_z_hdia_mat_mod diff --git a/ext/psb_z_hll_mat_mod.f90 b/ext/psb_z_hll_mat_mod.f90 new file mode 100644 index 00000000..98eb403f --- /dev/null +++ b/ext/psb_z_hll_mat_mod.f90 @@ -0,0 +1,564 @@ +! 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. +! + + +module psb_z_hll_mat_mod + + use psb_z_base_mat_mod + use psi_ext_util_mod + + type, extends(psb_z_base_sparse_mat) :: psb_z_hll_sparse_mat + ! + ! HLL format. (Hacked ELL) + ! A modification of ELL. + ! Basic idea: pack and pad data in blocks of HCK rows; + ! this reduces the impact of a lone, very long row. + ! Notes: + ! 1. JA holds the column indices, padded with the row index. + ! 2. VAL holds the coefficients, padded with zeros + ! 3. IDIAG hold the position of the diagonal element + ! or 0 if it is not there, but is only relevant for + ! triangular matrices. In particular, a unit triangular matrix + ! will have IDIAG==0. + ! 4. IRN holds the actual number of nonzeros stored in each row + ! 5. Within a row, the indices are sorted for use of SV. + ! 6. hksz: hack size (multiple of 32) + ! 7. hkoffs(:): offsets of the starts of hacks inside ja/val + ! + ! + ! + integer(psb_ipk_) :: hksz, nzt + integer(psb_ipk_), allocatable :: irn(:), ja(:), idiag(:), hkoffs(:) + complex(psb_dpk_), allocatable :: val(:) + + contains + + procedure, pass(a) :: get_hksz => z_hll_get_hksz + procedure, pass(a) :: set_hksz => z_hll_set_hksz + procedure, pass(a) :: get_size => z_hll_get_size + procedure, pass(a) :: set_nzeros => z_hll_set_nzeros + procedure, pass(a) :: get_nzeros => z_hll_get_nzeros + procedure, nopass :: get_fmt => z_hll_get_fmt + procedure, pass(a) :: sizeof => z_hll_sizeof + procedure, pass(a) :: csmm => psb_z_hll_csmm + procedure, pass(a) :: csmv => psb_z_hll_csmv + procedure, pass(a) :: inner_cssm => psb_z_hll_cssm + procedure, pass(a) :: inner_cssv => psb_z_hll_cssv + procedure, pass(a) :: scals => psb_z_hll_scals + procedure, pass(a) :: scalv => psb_z_hll_scal + procedure, pass(a) :: maxval => psb_z_hll_maxval + procedure, pass(a) :: csnmi => psb_z_hll_csnmi + procedure, pass(a) :: csnm1 => psb_z_hll_csnm1 + procedure, pass(a) :: rowsum => psb_z_hll_rowsum + procedure, pass(a) :: arwsum => psb_z_hll_arwsum + procedure, pass(a) :: colsum => psb_z_hll_colsum + procedure, pass(a) :: aclsum => psb_z_hll_aclsum + procedure, pass(a) :: reallocate_nz => psb_z_hll_reallocate_nz + procedure, pass(a) :: allocate_mnnz => psb_z_hll_allocate_mnnz + procedure, pass(a) :: cp_to_coo => psb_z_cp_hll_to_coo + procedure, pass(a) :: cp_from_coo => psb_z_cp_hll_from_coo + procedure, pass(a) :: cp_to_fmt => psb_z_cp_hll_to_fmt + procedure, pass(a) :: cp_from_fmt => psb_z_cp_hll_from_fmt + procedure, pass(a) :: mv_to_coo => psb_z_mv_hll_to_coo + procedure, pass(a) :: mv_from_coo => psb_z_mv_hll_from_coo + procedure, pass(a) :: mv_to_fmt => psb_z_mv_hll_to_fmt + procedure, pass(a) :: mv_from_fmt => psb_z_mv_hll_from_fmt + procedure, pass(a) :: csput_a => psb_z_hll_csput_a + procedure, pass(a) :: get_diag => psb_z_hll_get_diag + procedure, pass(a) :: csgetptn => psb_z_hll_csgetptn + procedure, pass(a) :: csgetrow => psb_z_hll_csgetrow + procedure, pass(a) :: get_nz_row => z_hll_get_nz_row + procedure, pass(a) :: reinit => psb_z_hll_reinit + procedure, pass(a) :: print => psb_z_hll_print + procedure, pass(a) :: free => z_hll_free + procedure, pass(a) :: mold => psb_z_hll_mold + + end type psb_z_hll_sparse_mat + + private :: z_hll_get_nzeros, z_hll_free, z_hll_get_fmt, & + & z_hll_get_size, z_hll_sizeof, z_hll_get_nz_row, & + & z_hll_set_nzeros, z_hll_get_hksz, z_hll_set_hksz + + interface + subroutine psb_z_hll_reallocate_nz(nz,a) + import :: psb_z_hll_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: nz + class(psb_z_hll_sparse_mat), intent(inout) :: a + end subroutine psb_z_hll_reallocate_nz + end interface + + interface + subroutine psb_z_hll_reinit(a,clear) + import :: psb_z_hll_sparse_mat + class(psb_z_hll_sparse_mat), intent(inout) :: a + logical, intent(in), optional :: clear + end subroutine psb_z_hll_reinit + end interface + + interface + subroutine psb_z_hll_mold(a,b,info) + import :: psb_z_hll_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout), allocatable :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_hll_mold + end interface + + interface + subroutine psb_z_hll_allocate_mnnz(m,n,a,nz) + import :: psb_z_hll_sparse_mat, psb_ipk_ + integer(psb_ipk_), intent(in) :: m,n + class(psb_z_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in), optional :: nz + end subroutine psb_z_hll_allocate_mnnz + end interface + + interface + subroutine psb_z_hll_print(iout,a,iv,head,ivr,ivc) + import :: psb_z_hll_sparse_mat, psb_ipk_, psb_lpk_ + integer(psb_ipk_), intent(in) :: iout + class(psb_z_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(:) + end subroutine psb_z_hll_print + end interface + + interface + subroutine psb_z_cp_hll_to_coo(a,b,info) + import :: psb_z_coo_sparse_mat, psb_z_hll_sparse_mat, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(in) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_hll_to_coo + end interface + + interface + subroutine psb_z_cp_hll_from_coo(a,b,info) + import :: psb_z_hll_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_hll_from_coo + end interface + + interface + subroutine psb_z_cp_hll_to_fmt(a,b,info) + import :: psb_z_hll_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(in) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_hll_to_fmt + end interface + + interface + subroutine psb_z_cp_hll_from_fmt(a,b,info) + import :: psb_z_hll_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(in) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_cp_hll_from_fmt + end interface + + interface + subroutine psb_z_mv_hll_to_coo(a,b,info) + import :: psb_z_hll_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_hll_to_coo + end interface + + interface + subroutine psb_z_mv_hll_from_coo(a,b,info) + import :: psb_z_hll_sparse_mat, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(inout) :: a + class(psb_z_coo_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_hll_from_coo + end interface + + interface + subroutine psb_z_mv_hll_to_fmt(a,b,info) + import :: psb_z_hll_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_hll_to_fmt + end interface + + interface + subroutine psb_z_mv_hll_from_fmt(a,b,info) + import :: psb_z_hll_sparse_mat, psb_z_base_sparse_mat, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(inout) :: a + class(psb_z_base_sparse_mat), intent(inout) :: b + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_mv_hll_from_fmt + end interface + + interface + subroutine psb_z_hll_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info) + import :: psb_z_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: val(:) + integer(psb_ipk_), intent(in) :: nz,ia(:), ja(:),& + & imin,imax,jmin,jmax + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_hll_csput_a + end interface + + interface + subroutine psb_z_hll_csgetptn(imin,imax,a,nz,ia,ja,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale) + import :: psb_z_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_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 + end subroutine psb_z_hll_csgetptn + end interface + + interface + subroutine psb_z_hll_csgetrow(imin,imax,a,nz,ia,ja,val,info,& + & jmin,jmax,iren,append,nzin,rscale,cscale,chksz) + import :: psb_z_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_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_dpk_), 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 + end subroutine psb_z_hll_csgetrow + end interface + + interface + subroutine psb_z_hll_csgetblk(imin,imax,a,b,info,& + & jmin,jmax,iren,append,rscale,cscale) + import :: psb_z_hll_sparse_mat, psb_dpk_, psb_z_coo_sparse_mat, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(in) :: a + class(psb_z_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 + end subroutine psb_z_hll_csgetblk + end interface + + interface + subroutine psb_z_hll_cssv(alpha,a,x,beta,y,info,trans) + import :: psb_z_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_hll_cssv + subroutine psb_z_hll_cssm(alpha,a,x,beta,y,info,trans) + import :: psb_z_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_hll_cssm + end interface + + interface + subroutine psb_z_hll_csmv(alpha,a,x,beta,y,info,trans) + import :: psb_z_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:) + complex(psb_dpk_), intent(inout) :: y(:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_hll_csmv + subroutine psb_z_hll_csmm(alpha,a,x,beta,y,info,trans) + import :: psb_z_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:) + complex(psb_dpk_), intent(inout) :: y(:,:) + integer(psb_ipk_), intent(out) :: info + character, optional, intent(in) :: trans + end subroutine psb_z_hll_csmm + end interface + + + interface + function psb_z_hll_maxval(a) result(res) + import :: psb_z_hll_sparse_mat, psb_dpk_ + class(psb_z_hll_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_hll_maxval + end interface + + interface + function psb_z_hll_csnmi(a) result(res) + import :: psb_z_hll_sparse_mat, psb_dpk_ + class(psb_z_hll_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_hll_csnmi + end interface + + interface + function psb_z_hll_csnm1(a) result(res) + import :: psb_z_hll_sparse_mat, psb_dpk_ + class(psb_z_hll_sparse_mat), intent(in) :: a + real(psb_dpk_) :: res + end function psb_z_hll_csnm1 + end interface + + interface + subroutine psb_z_hll_rowsum(d,a) + import :: psb_z_hll_sparse_mat, psb_dpk_ + class(psb_z_hll_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_hll_rowsum + end interface + + interface + subroutine psb_z_hll_arwsum(d,a) + import :: psb_z_hll_sparse_mat, psb_dpk_ + class(psb_z_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_hll_arwsum + end interface + + interface + subroutine psb_z_hll_colsum(d,a) + import :: psb_z_hll_sparse_mat, psb_dpk_ + class(psb_z_hll_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_hll_colsum + end interface + + interface + subroutine psb_z_hll_aclsum(d,a) + import :: psb_z_hll_sparse_mat, psb_dpk_ + class(psb_z_hll_sparse_mat), intent(in) :: a + real(psb_dpk_), intent(out) :: d(:) + end subroutine psb_z_hll_aclsum + end interface + + interface + subroutine psb_z_hll_get_diag(a,d,info) + import :: psb_z_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(in) :: a + complex(psb_dpk_), intent(out) :: d(:) + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_hll_get_diag + end interface + + interface + subroutine psb_z_hll_scal(d,a,info,side) + import :: psb_z_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d(:) + integer(psb_ipk_), intent(out) :: info + character, intent(in), optional :: side + end subroutine psb_z_hll_scal + end interface + + interface + subroutine psb_z_hll_scals(d,a,info) + import :: psb_z_hll_sparse_mat, psb_dpk_, psb_ipk_ + class(psb_z_hll_sparse_mat), intent(inout) :: a + complex(psb_dpk_), intent(in) :: d + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_hll_scals + end interface + + interface psi_convert_hll_from_coo + subroutine psi_z_convert_hll_from_coo(a,hksz,tmp,info) + import :: psb_z_hll_sparse_mat, psb_ipk_, psb_z_coo_sparse_mat + implicit none + class(psb_z_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: hksz + class(psb_z_coo_sparse_mat), intent(in) :: tmp + integer(psb_ipk_), intent(out) :: info + end subroutine psi_z_convert_hll_from_coo + end interface + +contains + + ! == =================================== + ! + ! + ! + ! Getters + ! + ! + ! + ! + ! + ! == =================================== + + + function z_hll_sizeof(a) result(res) + implicit none + class(psb_z_hll_sparse_mat), intent(in) :: a + integer(psb_epk_) :: res + if (a%is_dev()) call a%sync() + res = 8 + res = res + (2*psb_sizeof_dp) * size(a%val) + res = res + psb_sizeof_ip * size(a%irn) + res = res + psb_sizeof_ip * size(a%idiag) + res = res + psb_sizeof_ip * size(a%ja) + res = res + psb_sizeof_ip * size(a%hkoffs) + + end function z_hll_sizeof + + function z_hll_get_fmt() result(res) + implicit none + character(len=5) :: res + res = 'HLL' + end function z_hll_get_fmt + + subroutine z_hll_set_nzeros(a,n) + implicit none + class(psb_z_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: n + + a%nzt = n + end subroutine z_hll_set_nzeros + + function z_hll_get_nzeros(a) result(res) + implicit none + class(psb_z_hll_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + res = a%nzt + end function z_hll_get_nzeros + + function z_hll_get_size(a) result(res) + implicit none + class(psb_z_hll_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + + if (a%is_dev()) call a%sync() + + res = -1 + + if (allocated(a%ja)) then + if (res >= 0) then + res = min(res,size(a%ja)) + else + res = size(a%ja) + end if + end if + if (allocated(a%val)) then + if (res >= 0) then + res = min(res,size(a%val)) + else + res = size(a%val) + end if + end if + + end function z_hll_get_size + + + + function z_hll_get_nz_row(idx,a) result(res) + + implicit none + + class(psb_z_hll_sparse_mat), intent(in) :: a + integer(psb_ipk_), intent(in) :: idx + integer(psb_ipk_) :: res + + res = 0 + + if ((1<=idx).and.(idx<=a%get_nrows())) then + res = a%irn(idx) + end if + + end function z_hll_get_nz_row + + + + ! == =================================== + ! + ! + ! + ! Data management + ! + ! + ! + ! + ! + ! == =================================== + + subroutine z_hll_free(a) + implicit none + + class(psb_z_hll_sparse_mat), intent(inout) :: a + + if (allocated(a%idiag)) deallocate(a%idiag) + if (allocated(a%irn)) deallocate(a%irn) + if (allocated(a%ja)) deallocate(a%ja) + if (allocated(a%val)) deallocate(a%val) + if (allocated(a%val)) deallocate(a%hkoffs) + call a%set_null() + call a%set_nrows(izero) + call a%set_ncols(izero) + call a%set_hksz(izero) + + return + + end subroutine z_hll_free + + subroutine z_hll_set_hksz(a,n) + implicit none + class(psb_z_hll_sparse_mat), intent(inout) :: a + integer(psb_ipk_), intent(in) :: n + + a%hksz = n + end subroutine z_hll_set_hksz + + function z_hll_get_hksz(a) result(res) + implicit none + class(psb_z_hll_sparse_mat), intent(in) :: a + integer(psb_ipk_) :: res + + res = a%hksz + + end function z_hll_get_hksz + +end module psb_z_hll_mat_mod diff --git a/ext/psi_c_ext_util_mod.f90 b/ext/psi_c_ext_util_mod.f90 new file mode 100644 index 00000000..e58c0d93 --- /dev/null +++ b/ext/psi_c_ext_util_mod.f90 @@ -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. +! + + +module psi_c_ext_util_mod + + use psb_base_mod, only : psb_ipk_, psb_spk_ + + interface psi_xtr_dia_from_coo + subroutine psi_c_xtr_dia_from_coo(nr,nc,nz,ia,ja,val,d,nrd,ncd,data,info,& + & initdata,rdisp) + import :: psb_ipk_, psb_spk_ + implicit none + integer(psb_ipk_), intent(in) :: nr, nc, nz, nrd, ncd, ia(:), ja(:), d(:) + complex(psb_spk_), intent(in) :: val(:) + complex(psb_spk_), intent(out) :: data(nrd,ncd) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: initdata + integer(psb_ipk_), intent(in), optional :: rdisp + + end subroutine psi_c_xtr_dia_from_coo + end interface + + interface psi_xtr_ell_from_coo + subroutine psi_c_xtr_ell_from_coo(i,nr,mxrwl,iac,jac,& + & valc,ja,val,irn,diag,ld) + import :: psb_ipk_, psb_spk_ + implicit none + integer(psb_ipk_) :: i,nr,mxrwl,ld + integer(psb_ipk_) :: iac(*),jac(*),ja(ld,*),irn(*),diag(*) + complex(psb_spk_) :: valc(*), val(ld,*) + + end subroutine psi_c_xtr_ell_from_coo + end interface psi_xtr_ell_from_coo + + interface psi_xtr_coo_from_dia + subroutine psi_c_xtr_coo_from_dia(nr,nc,ia,ja,val,nz,nrd,ncd,data,offsets,& + & info,rdisp) + import :: psb_ipk_, psb_spk_ + + implicit none + + integer(psb_ipk_), intent(in) :: nr,nc, nrd,ncd, offsets(:) + integer(psb_ipk_), intent(inout) :: ia(:), ja(:), nz + complex(psb_spk_), intent(inout) :: val(:) + complex(psb_spk_), intent(in) :: data(nrd,ncd) + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: rdisp + end subroutine psi_c_xtr_coo_from_dia + end interface + +end module psi_c_ext_util_mod diff --git a/ext/psi_d_ext_util_mod.f90 b/ext/psi_d_ext_util_mod.f90 new file mode 100644 index 00000000..07de8ad1 --- /dev/null +++ b/ext/psi_d_ext_util_mod.f90 @@ -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. +! + + +module psi_d_ext_util_mod + + use psb_base_mod, only : psb_ipk_, psb_dpk_ + + interface psi_xtr_dia_from_coo + subroutine psi_d_xtr_dia_from_coo(nr,nc,nz,ia,ja,val,d,nrd,ncd,data,info,& + & initdata,rdisp) + import :: psb_ipk_, psb_dpk_ + implicit none + integer(psb_ipk_), intent(in) :: nr, nc, nz, nrd, ncd, ia(:), ja(:), d(:) + real(psb_dpk_), intent(in) :: val(:) + real(psb_dpk_), intent(out) :: data(nrd,ncd) + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: initdata + integer(psb_ipk_), intent(in), optional :: rdisp + + end subroutine psi_d_xtr_dia_from_coo + end interface + + interface psi_xtr_ell_from_coo + subroutine psi_d_xtr_ell_from_coo(i,nr,mxrwl,iac,jac,& + & valc,ja,val,irn,diag,ld) + import :: psb_ipk_, psb_dpk_ + implicit none + integer(psb_ipk_) :: i,nr,mxrwl,ld + integer(psb_ipk_) :: iac(*),jac(*),ja(ld,*),irn(*),diag(*) + real(psb_dpk_) :: valc(*), val(ld,*) + + end subroutine psi_d_xtr_ell_from_coo + end interface psi_xtr_ell_from_coo + + interface psi_xtr_coo_from_dia + subroutine psi_d_xtr_coo_from_dia(nr,nc,ia,ja,val,nz,nrd,ncd,data,offsets,& + & info,rdisp) + import :: psb_ipk_, psb_dpk_ + + implicit none + + integer(psb_ipk_), intent(in) :: nr,nc, nrd,ncd, offsets(:) + integer(psb_ipk_), intent(inout) :: ia(:), ja(:), nz + real(psb_dpk_), intent(inout) :: val(:) + real(psb_dpk_), intent(in) :: data(nrd,ncd) + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: rdisp + end subroutine psi_d_xtr_coo_from_dia + end interface + +end module psi_d_ext_util_mod diff --git a/ext/psi_ext_util_mod.f90 b/ext/psi_ext_util_mod.f90 new file mode 100644 index 00000000..afb2c749 --- /dev/null +++ b/ext/psi_ext_util_mod.f90 @@ -0,0 +1,41 @@ +! 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. +! + + +module psi_ext_util_mod + + use psi_i_ext_util_mod + use psi_s_ext_util_mod + use psi_c_ext_util_mod + use psi_d_ext_util_mod + use psi_z_ext_util_mod + +end module psi_ext_util_mod diff --git a/ext/psi_i_ext_util_mod.f90 b/ext/psi_i_ext_util_mod.f90 new file mode 100644 index 00000000..ac073f1d --- /dev/null +++ b/ext/psi_i_ext_util_mod.f90 @@ -0,0 +1,175 @@ +! 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. +! + + +module psi_i_ext_util_mod + + use psb_base_mod, only : psb_ipk_ + ! + ! Hack size for HLL format. + ! + integer(psb_ipk_), parameter :: psb_hksz_def_ = 32 + integer(psb_ipk_), private, save :: psb_hksz = psb_hksz_def_ + logical, private, save :: psb_hll_use_vector = .true. +contains + + function psi_get_hksz() result(res) + implicit none + integer(psb_ipk_) :: res + res = psb_hksz + end function psi_get_hksz + + subroutine psi_set_hksz(size) + implicit none + integer(psb_ipk_), intent(in) :: size + if (size > 0) psb_hksz = size + end subroutine psi_set_hksz + + subroutine psi_set_hll_vector(val) + implicit none + logical, optional :: val + if (present(val)) then + psb_hll_use_vector = val + else + psb_hll_use_vector = .true. + end if + + end subroutine psi_set_hll_vector + + function psi_get_hll_vector() result(res) + implicit none + logical :: res + + res = psb_hll_use_vector + end function psi_get_hll_vector + + + ! + ! Compute offsets and allocation for DIAgonal storage. + ! Input: + ! nr,nc,nz,ia,ja: the matrix pattern in COO + ! Note: This routine is designed to be called + ! with either a full matrix or an horizontal stripe, + ! with the COO entries sorted in row major order, hence + ! it will handle the conversion of a strip, so it can + ! be used by both DIA and HDIA. In both cases NR and NC + ! *MUST* be the *GLOBAL* number of rows/columns, not those + ! of the strips, i.e. it must be that all entris in IA <=NR + ! and JA <= NC. + ! Output: + ! nd: number of nonzero diagonals + ! d: d(k) contains the index inside offset of diagonal k, + ! which is, if A(I,J) /= 0 then K=NR+J-I, or (optionally) 0. + ! *MUST* be allocated on the *global* size NR+NC-1 + ! + ! offset: for each of the ND nonzero diagonals, its offset J-I + ! + ! Notes: D and OFFSET together represent the set of diagonals; + ! D can be used outside to quickly find which entry of OFFSET + ! a given a(i,j) corresponds to, without doing a search. + ! + ! 1. Optionally init D vector to zeros + ! 2. Walk through the NZ pairs (I,J): + ! a. if it is a new diagonal add to a heap; + ! b. increase its population count stored in D(J-I+NR) + ! c. Keep track of maximum population count. + ! 3. Go through the ND diagonals, getting them K out of the heap in order: + ! a. Set offset(i) to K-NR == J-I + ! b. Set D(K) = i or 0 (depending on cleard) + ! + ! Setting to 0 allows to reuse this function in a loop in a dry run + ! to estimate the allocation size for HDIA; without settng to 0 we + ! would need to zero the whole vector, resulting + ! in a quadratic overall cost. Outside this subroutine, it is possible + ! to zero selectively the entres in D by using the indices in OFFSET. + ! + ! + subroutine psi_dia_offset_from_coo(nr,nc,nz,ia,ja,nd,d,offset,info,& + & initd,cleard) + use psb_base_mod + + implicit none + + integer(psb_ipk_), intent(in) :: nr, nc, nz, ia(:), ja(:) + integer(psb_ipk_), intent(inout) :: d(:) + integer(psb_ipk_), intent(out) :: offset(:) + integer(psb_ipk_), intent(out) :: nd + integer(psb_ipk_), intent(out) :: info + logical, intent(in), optional :: initd,cleard + + type(psb_i_heap) :: heap + integer(psb_ipk_) :: k,i,j,ir,ic, ndiag, id + logical :: initd_, cleard_ + character(len=20) :: name + + info = psb_success_ + initd_ = .true. + if (present(initd)) initd_ = initd + cleard_ = .false. + if (present(cleard)) cleard_ = cleard + + if (initd_) d(:) = 0 + + ndiag = nr+nc-1 + if (size(d)