From 7a3e36db562d5888b04a032395030aafa8f78d6f Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 11 Jan 2007 16:33:50 +0000 Subject: [PATCH] First reorganization towards psblas-2.1/3.0 --- {src => base}/comm/Makefile | 0 {src => base}/comm/psb_dgather.f90 | 0 {src => base}/comm/psb_dhalo.f90 | 0 {src => base}/comm/psb_dovrl.f90 | 0 {src => base}/comm/psb_dscatter.f90 | 0 {src => base}/comm/psb_ihalo.f90 | 0 {src => base}/comm/psb_zgather.f90 | 0 {src => base}/comm/psb_zhalo.f90 | 0 {src => base}/comm/psb_zovrl.f90 | 0 {src => base}/comm/psb_zscatter.f90 | 0 {src => base}/internals/Makefile | 0 {src => base}/internals/avltree.c | 0 {src => base}/internals/avltree.h | 0 {src => base}/internals/psi_compute_size.f90 | 0 {src => base}/internals/psi_crea_bnd_elem.f90 | 0 {src => base}/internals/psi_crea_index.f90 | 0 {src => base}/internals/psi_crea_ovr_elem.f90 | 0 {src => base}/internals/psi_desc_index.f90 | 0 {src => base}/internals/psi_dl_check.f90 | 0 {src => base}/internals/psi_dswapdata.f90 | 0 {src => base}/internals/psi_dswaptran.f90 | 0 {src => base}/internals/psi_exist_ovr_elem.f | 0 {src => base}/internals/psi_extrct_dl.f | 0 {src => base}/internals/psi_fnd_owner.f90 | 0 {src => base}/internals/psi_gthsct.f90 | 0 {src => base}/internals/psi_idx_cnv.f90 | 0 {src => base}/internals/psi_idx_ins_cnv.f90 | 0 {src => base}/internals/psi_iswapdata.f90 | 0 {src => base}/internals/psi_iswaptran.f90 | 0 {src => base}/internals/psi_ldsc_pre_halo.f90 | 0 {src => base}/internals/psi_list_search.f | 0 {src => base}/internals/psi_sort_dl.f90 | 0 {src => base}/internals/psi_zswapdata.f90 | 0 {src => base}/internals/psi_zswaptran.f90 | 0 {src => base}/internals/srcht.c | 0 {src => base}/internals/srtlist.f | 0 {src => base}/modules/Makefile | 0 {src => base}/modules/blacs_env.F90 | 0 {src => base}/modules/error.f90 | 0 {src => base}/modules/parts.f90 | 0 {src => base}/modules/parts.fh | 0 {src => base}/modules/psb_all_mod.f90 | 0 {src => base}/modules/psb_check_mod.f90 | 0 {src => base}/modules/psb_comm_mod.f90 | 0 {src => base}/modules/psb_const_mod.f90 | 0 {src => base}/modules/psb_desc_type.f90 | 0 {src => base}/modules/psb_error_mod.f90 | 0 {src => base}/modules/psb_gps_mod.f90 | 0 {src => base}/modules/psb_methd_mod.f90 | 0 {src => base}/modules/psb_penv_mod.f90 | 0 {src => base}/modules/psb_prec_mod.f90 | 0 {src => base}/modules/psb_prec_type.f90 | 0 {src => base}/modules/psb_psblas_mod.f90 | 0 {src => base}/modules/psb_realloc_mod.F90 | 0 {src => base}/modules/psb_serial_mod.f90 | 0 {src => base}/modules/psb_sparse_mod.f90 | 0 {src => base}/modules/psb_spmat_type.f90 | 0 {src => base}/modules/psb_spsb_mod.f90 | 0 {src => base}/modules/psb_string_mod.f90 | 0 {src => base}/modules/psb_tools_mod.f90 | 0 {src => base}/modules/psi_mod.f90 | 0 {src => base}/psblas/Makefile | 0 {src => base}/psblas/pdtreecomb.f | 0 {src => base}/psblas/psb_damax.f90 | 0 {src => base}/psblas/psb_dasum.f90 | 0 {src => base}/psblas/psb_daxpby.f90 | 0 {src => base}/psblas/psb_ddot.f90 | 0 {src => base}/psblas/psb_dnrm2.f90 | 0 {src => base}/psblas/psb_dnrmi.f90 | 0 {src => base}/psblas/psb_dspmm.f90 | 0 {src => base}/psblas/psb_dspsm.f90 | 0 {src => base}/psblas/psb_zamax.f90 | 0 {src => base}/psblas/psb_zasum.f90 | 0 {src => base}/psblas/psb_zaxpby.f90 | 0 {src => base}/psblas/psb_zdot.f90 | 0 {src => base}/psblas/psb_znrm2.f90 | 0 {src => base}/psblas/psb_znrmi.f90 | 0 {src => base}/psblas/psb_zspmm.f90 | 0 {src => base}/psblas/psb_zspsm.f90 | 0 {src => base}/serial/Makefile | 0 {src => base}/serial/README.serial | 0 {src => base}/serial/aux/Makefile | 0 {src => base}/serial/aux/ibsrch.f | 0 {src => base}/serial/aux/imsr.f90 | 0 {src => base}/serial/aux/imsrx.f90 | 0 {src => base}/serial/aux/isaperm.f | 0 {src => base}/serial/aux/isr.f | 0 {src => base}/serial/aux/isrx.f | 0 {src => base}/serial/aux/issrch.f | 0 {src => base}/serial/aux/mrgsrt.f | 0 {src => base}/serial/coo/Makefile | 0 {src => base}/serial/coo/dcoomm.f | 0 {src => base}/serial/coo/dcoomv.f | 0 {src => base}/serial/coo/dcoonrmi.f | 0 {src => base}/serial/coo/dcooprt.f | 0 {src => base}/serial/coo/dcoorws.f | 0 {src => base}/serial/coo/dcoosm.f | 0 {src => base}/serial/coo/dcoosv.f | 0 {src => base}/serial/coo/zcoomm.f | 0 {src => base}/serial/coo/zcoomv.f | 0 {src => base}/serial/coo/zcoonrmi.f | 0 {src => base}/serial/coo/zcoorws.f | 0 {src => base}/serial/coo/zcoosm.f | 0 {src => base}/serial/coo/zcoosv.f | 0 {src => base}/serial/csr/Makefile | 0 {src => base}/serial/csr/dcrnrmi.f | 0 {src => base}/serial/csr/dcsrck.f | 0 {src => base}/serial/csr/dcsrmm.f | 0 {src => base}/serial/csr/dcsrmv.f | 0 {src => base}/serial/csr/dcsrmv2.f | 0 {src => base}/serial/csr/dcsrmv3.f | 0 {src => base}/serial/csr/dcsrmv4.f | 0 {src => base}/serial/csr/dcsrprt.f | 0 {src => base}/serial/csr/dcsrrws.f | 0 {src => base}/serial/csr/dcsrsm.f | 0 {src => base}/serial/csr/dcsrsv.f | 0 {src => base}/serial/csr/zcrnrmi.f | 0 {src => base}/serial/csr/zcsrck.f | 0 {src => base}/serial/csr/zcsrmm.f | 0 {src => base}/serial/csr/zcsrrws.f | 0 {src => base}/serial/csr/zcsrsm.f | 0 {src => base}/serial/csr/zsrmv.f | 0 {src => base}/serial/csr/zsrsv.f | 0 {src => base}/serial/dp/Makefile | 0 {src => base}/serial/dp/Max_nnzero.f | 0 {src => base}/serial/dp/check_dim.f | 0 {src => base}/serial/dp/dcoco.f | 0 {src => base}/serial/dp/dcocr.f | 0 {src => base}/serial/dp/dcrco.f | 0 {src => base}/serial/dp/dcrcr.f | 0 {src => base}/serial/dp/dcrjd.f | 0 {src => base}/serial/dp/dcsrp1.f | 0 {src => base}/serial/dp/dcsrrp.f | 0 {src => base}/serial/dp/dgblock.f | 0 {src => base}/serial/dp/dgind_tri.f | 0 {src => base}/serial/dp/dgindex.f | 0 {src => base}/serial/dp/djadrp.f | 0 {src => base}/serial/dp/djadrp1.f | 0 {src => base}/serial/dp/djdco.f | 0 {src => base}/serial/dp/djdcox.f | 0 {src => base}/serial/dp/dvtfg.f | 0 {src => base}/serial/dp/gen_block.f | 0 {src => base}/serial/dp/partition.f | 0 {src => base}/serial/dp/reordvn.f | 0 {src => base}/serial/dp/zcoco.f | 0 {src => base}/serial/dp/zcocr.f | 0 {src => base}/serial/dp/zcrco.f | 0 {src => base}/serial/dp/zcrcr.f | 0 {src => base}/serial/dp/zcrjd.f | 0 {src => base}/serial/dp/zgind_tri.f | 0 {src => base}/serial/dp/zgindex.f | 0 {src => base}/serial/f77/Makefile | 0 {src => base}/serial/f77/daxpby.f | 0 {src => base}/serial/f77/dcsmm.f | 0 {src => base}/serial/f77/dcsnmi.f | 0 {src => base}/serial/f77/dcsrp.f | 0 {src => base}/serial/f77/dcsrws.f | 0 {src => base}/serial/f77/dcssm.f | 0 {src => base}/serial/f77/dgelp.f | 0 {src => base}/serial/f77/dlpupd.f | 0 {src => base}/serial/f77/dswmm.f | 0 {src => base}/serial/f77/dswprt.f | 0 {src => base}/serial/f77/dswsm.f | 0 {src => base}/serial/f77/smmp.f | 0 {src => base}/serial/f77/zaxpby.f | 0 {src => base}/serial/f77/zcsmm.f | 0 {src => base}/serial/f77/zcsnmi.f | 0 {src => base}/serial/f77/zcsrws.f | 0 {src => base}/serial/f77/zcssm.f | 0 {src => base}/serial/f77/zgelp.f | 0 {src => base}/serial/f77/zlpupd.f | 0 {src => base}/serial/f77/zswmm.f | 0 {src => base}/serial/f77/zswsm.f | 0 {src => base}/serial/jad/Makefile | 0 {src => base}/serial/jad/djadmm.f | 0 {src => base}/serial/jad/djadmv.f | 0 {src => base}/serial/jad/djadmv2.f | 0 {src => base}/serial/jad/djadmv3.f | 0 {src => base}/serial/jad/djadmv4.f | 0 {src => base}/serial/jad/djadnr.f | 0 {src => base}/serial/jad/djadprt.f | 0 {src => base}/serial/jad/djadrws.f | 0 {src => base}/serial/jad/djadsm.f | 0 {src => base}/serial/jad/djadsv.f | 0 {src => base}/serial/jad/djdnrmi.f | 0 {src => base}/serial/jad/djdrws.f | 0 {src => base}/serial/lsame.f90 | 0 {src => base}/serial/psb_cest.f90 | 0 {src => base}/serial/psb_dcoins.f90 | 0 {src => base}/serial/psb_dcsdp.f90 | 0 {src => base}/serial/psb_dcsmm.f90 | 0 {src => base}/serial/psb_dcsmv.f90 | 0 {src => base}/serial/psb_dcsnmi.f90 | 0 {src => base}/serial/psb_dcsprt.f90 | 0 {src => base}/serial/psb_dcsrws.f90 | 0 {src => base}/serial/psb_dcssm.f90 | 0 {src => base}/serial/psb_dcssv.f90 | 0 {src => base}/serial/psb_dfixcoo.f90 | 0 {src => base}/serial/psb_dipcoo2csc.f90 | 0 {src => base}/serial/psb_dipcoo2csr.f90 | 0 {src => base}/serial/psb_dipcsr2coo.f90 | 0 {src => base}/serial/psb_dneigh.f90 | 0 {src => base}/serial/psb_dnumbmm.f90 | 0 {src => base}/serial/psb_drwextd.f90 | 0 {src => base}/serial/psb_dspgetrow.f90 | 0 {src => base}/serial/psb_dspgtblk.f90 | 0 {src => base}/serial/psb_dspgtdiag.f90 | 0 {src => base}/serial/psb_dspscal.f90 | 0 {src => base}/serial/psb_dsymbmm.f90 | 0 {src => base}/serial/psb_dtransp.f90 | 0 {src => base}/serial/psb_getifield.f90 | 0 {src => base}/serial/psb_setifield.f90 | 0 {src => base}/serial/psb_update_mod.f90 | 0 {src => base}/serial/psb_zcoins.f90 | 0 {src => base}/serial/psb_zcsdp.f90 | 0 {src => base}/serial/psb_zcsmm.f90 | 0 {src => base}/serial/psb_zcsmv.f90 | 0 {src => base}/serial/psb_zcsnmi.f90 | 0 {src => base}/serial/psb_zcsprt.f90 | 0 {src => base}/serial/psb_zcsrws.f90 | 0 {src => base}/serial/psb_zcssm.f90 | 0 {src => base}/serial/psb_zcssv.f90 | 0 {src => base}/serial/psb_zfixcoo.f90 | 0 {src => base}/serial/psb_zipcoo2csc.f90 | 0 {src => base}/serial/psb_zipcoo2csr.f90 | 0 {src => base}/serial/psb_zipcsr2coo.f90 | 0 {src => base}/serial/psb_zneigh.f90 | 0 {src => base}/serial/psb_znumbmm.f90 | 0 {src => base}/serial/psb_zrwextd.f90 | 0 {src => base}/serial/psb_zspgetrow.f90 | 0 {src => base}/serial/psb_zspgtblk.f90 | 0 {src => base}/serial/psb_zspgtdiag.f90 | 0 {src => base}/serial/psb_zspscal.f90 | 0 {src => base}/serial/psb_zsymbmm.f90 | 0 {src => base}/serial/psb_ztransc.f90 | 0 {src => base}/serial/psb_ztransp.f90 | 0 {src => base}/tools/Makefile | 0 {src => base}/tools/psb_cd_inloc.f90 | 0 {src => base}/tools/psb_cdall.f90 | 0 {src => base}/tools/psb_cdalv.f90 | 0 {src => base}/tools/psb_cdasb.f90 | 0 {src => base}/tools/psb_cdcpy.f90 | 0 {src => base}/tools/psb_cddec.f90 | 0 {src => base}/tools/psb_cdfree.f90 | 0 {src => base}/tools/psb_cdins.f90 | 0 {src => base}/tools/psb_cdprt.f90 | 0 {src => base}/tools/psb_cdren.f90 | 0 {src => base}/tools/psb_cdrep.f90 | 0 {src => base}/tools/psb_cdtransfer.f90 | 0 {src => base}/tools/psb_dallc.f90 | 0 {src => base}/tools/psb_dasb.f90 | 0 {src => base}/tools/psb_dcdovr.f90 | 0 {src => base}/tools/psb_dcsrp.f90 | 0 {src => base}/tools/psb_dfree.f90 | 0 {src => base}/tools/psb_dgelp.f90 | 0 {src => base}/tools/psb_dins.f90 | 0 {src => base}/tools/psb_dspalloc.f90 | 0 {src => base}/tools/psb_dspasb.f90 | 0 {src => base}/tools/psb_dspcnv.f90 | 0 {src => base}/tools/psb_dspfree.f90 | 0 {src => base}/tools/psb_dsphalo.f90 | 0 {src => base}/tools/psb_dspins.f90 | 0 {src => base}/tools/psb_dsprn.f90 | 0 {src => base}/tools/psb_get_overlap.f90 | 0 {src => base}/tools/psb_glob_to_loc.f90 | 0 {src => base}/tools/psb_ialloc.f90 | 0 {src => base}/tools/psb_iasb.f90 | 0 {src => base}/tools/psb_ifree.f90 | 0 {src => base}/tools/psb_iins.f90 | 0 {src => base}/tools/psb_loc_to_glob.f90 | 0 {src => base}/tools/psb_zallc.f90 | 0 {src => base}/tools/psb_zasb.f90 | 0 {src => base}/tools/psb_zcdovr.f90 | 0 {src => base}/tools/psb_zcsrp.f90 | 0 {src => base}/tools/psb_zfree.f90 | 0 {src => base}/tools/psb_zgelp.f90 | 0 {src => base}/tools/psb_zins.f90 | 0 {src => base}/tools/psb_zspalloc.f90 | 0 {src => base}/tools/psb_zspasb.f90 | 0 {src => base}/tools/psb_zspcnv.f90 | 0 {src => base}/tools/psb_zspfree.f90 | 0 {src => base}/tools/psb_zsphalo.f90 | 0 {src => base}/tools/psb_zspins.f90 | 0 {src => base}/tools/psb_zsprn.f90 | 0 baseprec/Makefile | 39 ++ baseprec/psb_dbaseprc_aply.f90 | 150 +++++ baseprec/psb_dbaseprc_bld.f90 | 205 +++++++ baseprec/psb_dbjac_aply.f90 | 211 +++++++ baseprec/psb_ddiagsc_bld.f90 | 163 ++++++ baseprec/psb_dilu_bld.f90 | 284 ++++++++++ baseprec/psb_dilu_fct.f90 | 469 ++++++++++++++++ baseprec/psb_dprc_aply.f90 | 223 ++++++++ baseprec/psb_dprecbld.f90 | 135 +++++ baseprec/psb_dprecfree.f90 | 69 +++ baseprec/psb_dprecset.f90 | 100 ++++ baseprec/psb_dsp_renum.f90 | 391 +++++++++++++ baseprec/psb_prec_mod.f90 | 163 ++++++ baseprec/psb_prec_type.f90 | 521 ++++++++++++++++++ baseprec/psb_zbaseprc_aply.f90 | 150 +++++ baseprec/psb_zbaseprc_bld.f90 | 204 +++++++ baseprec/psb_zbjac_aply.f90 | 211 +++++++ baseprec/psb_zdiagsc_bld.f90 | 158 ++++++ baseprec/psb_zilu_bld.f90 | 284 ++++++++++ baseprec/psb_zilu_fct.f90 | 465 ++++++++++++++++ baseprec/psb_zprc_aply.f90 | 223 ++++++++ baseprec/psb_zprecbld.f90 | 135 +++++ baseprec/psb_zprecfree.f90 | 69 +++ baseprec/psb_zprecset.f90 | 101 ++++ baseprec/psb_zsp_renum.f90 | 389 +++++++++++++ {src/methd => krylov}/Makefile | 0 {src/methd => krylov}/psb_dbicg.f90 | 0 {src/methd => krylov}/psb_dcg.f90 | 0 {src/methd => krylov}/psb_dcgs.f90 | 0 {src/methd => krylov}/psb_dcgstab.f90 | 0 {src/methd => krylov}/psb_dcgstabl.f90 | 0 {src/methd => krylov}/psb_dgmresr.f90 | 0 {src/methd => krylov}/psb_zcgs.f90 | 0 {src/methd => krylov}/psb_zcgstab.f90 | 0 {src/prec => mld2p4}/Makefile | 0 {src/prec => mld2p4}/psb_dasmatbld.f90 | 0 {src/prec => mld2p4}/psb_dbaseprc_aply.f90 | 0 {src/prec => mld2p4}/psb_dbaseprc_bld.f90 | 0 {src/prec => mld2p4}/psb_dbjac_aply.f90 | 0 {src/prec => mld2p4}/psb_dbldaggrmat.f90 | 0 {src/prec => mld2p4}/psb_ddiagsc_bld.f90 | 0 {src/prec => mld2p4}/psb_dgenaggrmap.f90 | 0 {src/prec => mld2p4}/psb_dilu_bld.f90 | 0 {src/prec => mld2p4}/psb_dilu_fct.f90 | 0 {src/prec => mld2p4}/psb_dmlprc_aply.f90 | 0 {src/prec => mld2p4}/psb_dmlprc_bld.f90 | 0 {src/prec => mld2p4}/psb_dprc_aply.f90 | 0 {src/prec => mld2p4}/psb_dprecbld.f90 | 0 {src/prec => mld2p4}/psb_dprecfree.f90 | 0 {src/prec => mld2p4}/psb_dprecset.f90 | 0 {src/prec => mld2p4}/psb_dslu_bld.f90 | 0 {src/prec => mld2p4}/psb_dsp_renum.f90 | 0 {src/prec => mld2p4}/psb_dumf_bld.f90 | 0 {src/prec => mld2p4}/psb_slu_impl.c | 0 {src/prec => mld2p4}/psb_umf_impl.c | 0 {src/prec => mld2p4}/psb_zasmatbld.f90 | 0 {src/prec => mld2p4}/psb_zbaseprc_aply.f90 | 0 {src/prec => mld2p4}/psb_zbaseprc_bld.f90 | 0 {src/prec => mld2p4}/psb_zbjac_aply.f90 | 0 {src/prec => mld2p4}/psb_zbldaggrmat.f90 | 0 {src/prec => mld2p4}/psb_zdiagsc_bld.f90 | 0 {src/prec => mld2p4}/psb_zgenaggrmap.f90 | 0 {src/prec => mld2p4}/psb_zilu_bld.f90 | 0 {src/prec => mld2p4}/psb_zilu_fct.f90 | 0 {src/prec => mld2p4}/psb_zmlprc_aply.f90 | 0 {src/prec => mld2p4}/psb_zmlprc_bld.f90 | 0 {src/prec => mld2p4}/psb_zprc_aply.f90 | 0 {src/prec => mld2p4}/psb_zprecbld.f90 | 0 {src/prec => mld2p4}/psb_zprecfree.f90 | 0 {src/prec => mld2p4}/psb_zprecset.f90 | 0 {src/prec => mld2p4}/psb_zslu_bld.f90 | 0 {src/prec => mld2p4}/psb_zslu_impl.c | 0 {src/prec => mld2p4}/psb_zsp_renum.f90 | 0 {src/prec => mld2p4}/psb_zumf_bld.f90 | 0 {src/prec => mld2p4}/psb_zumf_impl.c | 0 src/Makefile | 30 - 360 files changed, 5512 insertions(+), 30 deletions(-) rename {src => base}/comm/Makefile (100%) rename {src => base}/comm/psb_dgather.f90 (100%) rename {src => base}/comm/psb_dhalo.f90 (100%) rename {src => base}/comm/psb_dovrl.f90 (100%) rename {src => base}/comm/psb_dscatter.f90 (100%) rename {src => base}/comm/psb_ihalo.f90 (100%) rename {src => base}/comm/psb_zgather.f90 (100%) rename {src => base}/comm/psb_zhalo.f90 (100%) rename {src => base}/comm/psb_zovrl.f90 (100%) rename {src => base}/comm/psb_zscatter.f90 (100%) rename {src => base}/internals/Makefile (100%) rename {src => base}/internals/avltree.c (100%) rename {src => base}/internals/avltree.h (100%) rename {src => base}/internals/psi_compute_size.f90 (100%) rename {src => base}/internals/psi_crea_bnd_elem.f90 (100%) rename {src => base}/internals/psi_crea_index.f90 (100%) rename {src => base}/internals/psi_crea_ovr_elem.f90 (100%) rename {src => base}/internals/psi_desc_index.f90 (100%) rename {src => base}/internals/psi_dl_check.f90 (100%) rename {src => base}/internals/psi_dswapdata.f90 (100%) rename {src => base}/internals/psi_dswaptran.f90 (100%) rename {src => base}/internals/psi_exist_ovr_elem.f (100%) rename {src => base}/internals/psi_extrct_dl.f (100%) rename {src => base}/internals/psi_fnd_owner.f90 (100%) rename {src => base}/internals/psi_gthsct.f90 (100%) rename {src => base}/internals/psi_idx_cnv.f90 (100%) rename {src => base}/internals/psi_idx_ins_cnv.f90 (100%) rename {src => base}/internals/psi_iswapdata.f90 (100%) rename {src => base}/internals/psi_iswaptran.f90 (100%) rename {src => base}/internals/psi_ldsc_pre_halo.f90 (100%) rename {src => base}/internals/psi_list_search.f (100%) rename {src => base}/internals/psi_sort_dl.f90 (100%) rename {src => base}/internals/psi_zswapdata.f90 (100%) rename {src => base}/internals/psi_zswaptran.f90 (100%) rename {src => base}/internals/srcht.c (100%) rename {src => base}/internals/srtlist.f (100%) rename {src => base}/modules/Makefile (100%) rename {src => base}/modules/blacs_env.F90 (100%) rename {src => base}/modules/error.f90 (100%) rename {src => base}/modules/parts.f90 (100%) rename {src => base}/modules/parts.fh (100%) rename {src => base}/modules/psb_all_mod.f90 (100%) rename {src => base}/modules/psb_check_mod.f90 (100%) rename {src => base}/modules/psb_comm_mod.f90 (100%) rename {src => base}/modules/psb_const_mod.f90 (100%) rename {src => base}/modules/psb_desc_type.f90 (100%) rename {src => base}/modules/psb_error_mod.f90 (100%) rename {src => base}/modules/psb_gps_mod.f90 (100%) rename {src => base}/modules/psb_methd_mod.f90 (100%) rename {src => base}/modules/psb_penv_mod.f90 (100%) rename {src => base}/modules/psb_prec_mod.f90 (100%) rename {src => base}/modules/psb_prec_type.f90 (100%) rename {src => base}/modules/psb_psblas_mod.f90 (100%) rename {src => base}/modules/psb_realloc_mod.F90 (100%) rename {src => base}/modules/psb_serial_mod.f90 (100%) rename {src => base}/modules/psb_sparse_mod.f90 (100%) rename {src => base}/modules/psb_spmat_type.f90 (100%) rename {src => base}/modules/psb_spsb_mod.f90 (100%) rename {src => base}/modules/psb_string_mod.f90 (100%) rename {src => base}/modules/psb_tools_mod.f90 (100%) rename {src => base}/modules/psi_mod.f90 (100%) rename {src => base}/psblas/Makefile (100%) rename {src => base}/psblas/pdtreecomb.f (100%) rename {src => base}/psblas/psb_damax.f90 (100%) rename {src => base}/psblas/psb_dasum.f90 (100%) rename {src => base}/psblas/psb_daxpby.f90 (100%) rename {src => base}/psblas/psb_ddot.f90 (100%) rename {src => base}/psblas/psb_dnrm2.f90 (100%) rename {src => base}/psblas/psb_dnrmi.f90 (100%) rename {src => base}/psblas/psb_dspmm.f90 (100%) rename {src => base}/psblas/psb_dspsm.f90 (100%) rename {src => base}/psblas/psb_zamax.f90 (100%) rename {src => base}/psblas/psb_zasum.f90 (100%) rename {src => base}/psblas/psb_zaxpby.f90 (100%) rename {src => base}/psblas/psb_zdot.f90 (100%) rename {src => base}/psblas/psb_znrm2.f90 (100%) rename {src => base}/psblas/psb_znrmi.f90 (100%) rename {src => base}/psblas/psb_zspmm.f90 (100%) rename {src => base}/psblas/psb_zspsm.f90 (100%) rename {src => base}/serial/Makefile (100%) rename {src => base}/serial/README.serial (100%) rename {src => base}/serial/aux/Makefile (100%) rename {src => base}/serial/aux/ibsrch.f (100%) rename {src => base}/serial/aux/imsr.f90 (100%) rename {src => base}/serial/aux/imsrx.f90 (100%) rename {src => base}/serial/aux/isaperm.f (100%) rename {src => base}/serial/aux/isr.f (100%) rename {src => base}/serial/aux/isrx.f (100%) rename {src => base}/serial/aux/issrch.f (100%) rename {src => base}/serial/aux/mrgsrt.f (100%) rename {src => base}/serial/coo/Makefile (100%) rename {src => base}/serial/coo/dcoomm.f (100%) rename {src => base}/serial/coo/dcoomv.f (100%) rename {src => base}/serial/coo/dcoonrmi.f (100%) rename {src => base}/serial/coo/dcooprt.f (100%) rename {src => base}/serial/coo/dcoorws.f (100%) rename {src => base}/serial/coo/dcoosm.f (100%) rename {src => base}/serial/coo/dcoosv.f (100%) rename {src => base}/serial/coo/zcoomm.f (100%) rename {src => base}/serial/coo/zcoomv.f (100%) rename {src => base}/serial/coo/zcoonrmi.f (100%) rename {src => base}/serial/coo/zcoorws.f (100%) rename {src => base}/serial/coo/zcoosm.f (100%) rename {src => base}/serial/coo/zcoosv.f (100%) rename {src => base}/serial/csr/Makefile (100%) rename {src => base}/serial/csr/dcrnrmi.f (100%) rename {src => base}/serial/csr/dcsrck.f (100%) rename {src => base}/serial/csr/dcsrmm.f (100%) rename {src => base}/serial/csr/dcsrmv.f (100%) rename {src => base}/serial/csr/dcsrmv2.f (100%) rename {src => base}/serial/csr/dcsrmv3.f (100%) rename {src => base}/serial/csr/dcsrmv4.f (100%) rename {src => base}/serial/csr/dcsrprt.f (100%) rename {src => base}/serial/csr/dcsrrws.f (100%) rename {src => base}/serial/csr/dcsrsm.f (100%) rename {src => base}/serial/csr/dcsrsv.f (100%) rename {src => base}/serial/csr/zcrnrmi.f (100%) rename {src => base}/serial/csr/zcsrck.f (100%) rename {src => base}/serial/csr/zcsrmm.f (100%) rename {src => base}/serial/csr/zcsrrws.f (100%) rename {src => base}/serial/csr/zcsrsm.f (100%) rename {src => base}/serial/csr/zsrmv.f (100%) rename {src => base}/serial/csr/zsrsv.f (100%) rename {src => base}/serial/dp/Makefile (100%) rename {src => base}/serial/dp/Max_nnzero.f (100%) rename {src => base}/serial/dp/check_dim.f (100%) rename {src => base}/serial/dp/dcoco.f (100%) rename {src => base}/serial/dp/dcocr.f (100%) rename {src => base}/serial/dp/dcrco.f (100%) rename {src => base}/serial/dp/dcrcr.f (100%) rename {src => base}/serial/dp/dcrjd.f (100%) rename {src => base}/serial/dp/dcsrp1.f (100%) rename {src => base}/serial/dp/dcsrrp.f (100%) rename {src => base}/serial/dp/dgblock.f (100%) rename {src => base}/serial/dp/dgind_tri.f (100%) rename {src => base}/serial/dp/dgindex.f (100%) rename {src => base}/serial/dp/djadrp.f (100%) rename {src => base}/serial/dp/djadrp1.f (100%) rename {src => base}/serial/dp/djdco.f (100%) rename {src => base}/serial/dp/djdcox.f (100%) rename {src => base}/serial/dp/dvtfg.f (100%) rename {src => base}/serial/dp/gen_block.f (100%) rename {src => base}/serial/dp/partition.f (100%) rename {src => base}/serial/dp/reordvn.f (100%) rename {src => base}/serial/dp/zcoco.f (100%) rename {src => base}/serial/dp/zcocr.f (100%) rename {src => base}/serial/dp/zcrco.f (100%) rename {src => base}/serial/dp/zcrcr.f (100%) rename {src => base}/serial/dp/zcrjd.f (100%) rename {src => base}/serial/dp/zgind_tri.f (100%) rename {src => base}/serial/dp/zgindex.f (100%) rename {src => base}/serial/f77/Makefile (100%) rename {src => base}/serial/f77/daxpby.f (100%) rename {src => base}/serial/f77/dcsmm.f (100%) rename {src => base}/serial/f77/dcsnmi.f (100%) rename {src => base}/serial/f77/dcsrp.f (100%) rename {src => base}/serial/f77/dcsrws.f (100%) rename {src => base}/serial/f77/dcssm.f (100%) rename {src => base}/serial/f77/dgelp.f (100%) rename {src => base}/serial/f77/dlpupd.f (100%) rename {src => base}/serial/f77/dswmm.f (100%) rename {src => base}/serial/f77/dswprt.f (100%) rename {src => base}/serial/f77/dswsm.f (100%) rename {src => base}/serial/f77/smmp.f (100%) rename {src => base}/serial/f77/zaxpby.f (100%) rename {src => base}/serial/f77/zcsmm.f (100%) rename {src => base}/serial/f77/zcsnmi.f (100%) rename {src => base}/serial/f77/zcsrws.f (100%) rename {src => base}/serial/f77/zcssm.f (100%) rename {src => base}/serial/f77/zgelp.f (100%) rename {src => base}/serial/f77/zlpupd.f (100%) rename {src => base}/serial/f77/zswmm.f (100%) rename {src => base}/serial/f77/zswsm.f (100%) rename {src => base}/serial/jad/Makefile (100%) rename {src => base}/serial/jad/djadmm.f (100%) rename {src => base}/serial/jad/djadmv.f (100%) rename {src => base}/serial/jad/djadmv2.f (100%) rename {src => base}/serial/jad/djadmv3.f (100%) rename {src => base}/serial/jad/djadmv4.f (100%) rename {src => base}/serial/jad/djadnr.f (100%) rename {src => base}/serial/jad/djadprt.f (100%) rename {src => base}/serial/jad/djadrws.f (100%) rename {src => base}/serial/jad/djadsm.f (100%) rename {src => base}/serial/jad/djadsv.f (100%) rename {src => base}/serial/jad/djdnrmi.f (100%) rename {src => base}/serial/jad/djdrws.f (100%) rename {src => base}/serial/lsame.f90 (100%) rename {src => base}/serial/psb_cest.f90 (100%) rename {src => base}/serial/psb_dcoins.f90 (100%) rename {src => base}/serial/psb_dcsdp.f90 (100%) rename {src => base}/serial/psb_dcsmm.f90 (100%) rename {src => base}/serial/psb_dcsmv.f90 (100%) rename {src => base}/serial/psb_dcsnmi.f90 (100%) rename {src => base}/serial/psb_dcsprt.f90 (100%) rename {src => base}/serial/psb_dcsrws.f90 (100%) rename {src => base}/serial/psb_dcssm.f90 (100%) rename {src => base}/serial/psb_dcssv.f90 (100%) rename {src => base}/serial/psb_dfixcoo.f90 (100%) rename {src => base}/serial/psb_dipcoo2csc.f90 (100%) rename {src => base}/serial/psb_dipcoo2csr.f90 (100%) rename {src => base}/serial/psb_dipcsr2coo.f90 (100%) rename {src => base}/serial/psb_dneigh.f90 (100%) rename {src => base}/serial/psb_dnumbmm.f90 (100%) rename {src => base}/serial/psb_drwextd.f90 (100%) rename {src => base}/serial/psb_dspgetrow.f90 (100%) rename {src => base}/serial/psb_dspgtblk.f90 (100%) rename {src => base}/serial/psb_dspgtdiag.f90 (100%) rename {src => base}/serial/psb_dspscal.f90 (100%) rename {src => base}/serial/psb_dsymbmm.f90 (100%) rename {src => base}/serial/psb_dtransp.f90 (100%) rename {src => base}/serial/psb_getifield.f90 (100%) rename {src => base}/serial/psb_setifield.f90 (100%) rename {src => base}/serial/psb_update_mod.f90 (100%) rename {src => base}/serial/psb_zcoins.f90 (100%) rename {src => base}/serial/psb_zcsdp.f90 (100%) rename {src => base}/serial/psb_zcsmm.f90 (100%) rename {src => base}/serial/psb_zcsmv.f90 (100%) rename {src => base}/serial/psb_zcsnmi.f90 (100%) rename {src => base}/serial/psb_zcsprt.f90 (100%) rename {src => base}/serial/psb_zcsrws.f90 (100%) rename {src => base}/serial/psb_zcssm.f90 (100%) rename {src => base}/serial/psb_zcssv.f90 (100%) rename {src => base}/serial/psb_zfixcoo.f90 (100%) rename {src => base}/serial/psb_zipcoo2csc.f90 (100%) rename {src => base}/serial/psb_zipcoo2csr.f90 (100%) rename {src => base}/serial/psb_zipcsr2coo.f90 (100%) rename {src => base}/serial/psb_zneigh.f90 (100%) rename {src => base}/serial/psb_znumbmm.f90 (100%) rename {src => base}/serial/psb_zrwextd.f90 (100%) rename {src => base}/serial/psb_zspgetrow.f90 (100%) rename {src => base}/serial/psb_zspgtblk.f90 (100%) rename {src => base}/serial/psb_zspgtdiag.f90 (100%) rename {src => base}/serial/psb_zspscal.f90 (100%) rename {src => base}/serial/psb_zsymbmm.f90 (100%) rename {src => base}/serial/psb_ztransc.f90 (100%) rename {src => base}/serial/psb_ztransp.f90 (100%) rename {src => base}/tools/Makefile (100%) rename {src => base}/tools/psb_cd_inloc.f90 (100%) rename {src => base}/tools/psb_cdall.f90 (100%) rename {src => base}/tools/psb_cdalv.f90 (100%) rename {src => base}/tools/psb_cdasb.f90 (100%) rename {src => base}/tools/psb_cdcpy.f90 (100%) rename {src => base}/tools/psb_cddec.f90 (100%) rename {src => base}/tools/psb_cdfree.f90 (100%) rename {src => base}/tools/psb_cdins.f90 (100%) rename {src => base}/tools/psb_cdprt.f90 (100%) rename {src => base}/tools/psb_cdren.f90 (100%) rename {src => base}/tools/psb_cdrep.f90 (100%) rename {src => base}/tools/psb_cdtransfer.f90 (100%) rename {src => base}/tools/psb_dallc.f90 (100%) rename {src => base}/tools/psb_dasb.f90 (100%) rename {src => base}/tools/psb_dcdovr.f90 (100%) rename {src => base}/tools/psb_dcsrp.f90 (100%) rename {src => base}/tools/psb_dfree.f90 (100%) rename {src => base}/tools/psb_dgelp.f90 (100%) rename {src => base}/tools/psb_dins.f90 (100%) rename {src => base}/tools/psb_dspalloc.f90 (100%) rename {src => base}/tools/psb_dspasb.f90 (100%) rename {src => base}/tools/psb_dspcnv.f90 (100%) rename {src => base}/tools/psb_dspfree.f90 (100%) rename {src => base}/tools/psb_dsphalo.f90 (100%) rename {src => base}/tools/psb_dspins.f90 (100%) rename {src => base}/tools/psb_dsprn.f90 (100%) rename {src => base}/tools/psb_get_overlap.f90 (100%) rename {src => base}/tools/psb_glob_to_loc.f90 (100%) rename {src => base}/tools/psb_ialloc.f90 (100%) rename {src => base}/tools/psb_iasb.f90 (100%) rename {src => base}/tools/psb_ifree.f90 (100%) rename {src => base}/tools/psb_iins.f90 (100%) rename {src => base}/tools/psb_loc_to_glob.f90 (100%) rename {src => base}/tools/psb_zallc.f90 (100%) rename {src => base}/tools/psb_zasb.f90 (100%) rename {src => base}/tools/psb_zcdovr.f90 (100%) rename {src => base}/tools/psb_zcsrp.f90 (100%) rename {src => base}/tools/psb_zfree.f90 (100%) rename {src => base}/tools/psb_zgelp.f90 (100%) rename {src => base}/tools/psb_zins.f90 (100%) rename {src => base}/tools/psb_zspalloc.f90 (100%) rename {src => base}/tools/psb_zspasb.f90 (100%) rename {src => base}/tools/psb_zspcnv.f90 (100%) rename {src => base}/tools/psb_zspfree.f90 (100%) rename {src => base}/tools/psb_zsphalo.f90 (100%) rename {src => base}/tools/psb_zspins.f90 (100%) rename {src => base}/tools/psb_zsprn.f90 (100%) create mode 100644 baseprec/Makefile create mode 100644 baseprec/psb_dbaseprc_aply.f90 create mode 100644 baseprec/psb_dbaseprc_bld.f90 create mode 100644 baseprec/psb_dbjac_aply.f90 create mode 100644 baseprec/psb_ddiagsc_bld.f90 create mode 100644 baseprec/psb_dilu_bld.f90 create mode 100644 baseprec/psb_dilu_fct.f90 create mode 100644 baseprec/psb_dprc_aply.f90 create mode 100644 baseprec/psb_dprecbld.f90 create mode 100644 baseprec/psb_dprecfree.f90 create mode 100644 baseprec/psb_dprecset.f90 create mode 100644 baseprec/psb_dsp_renum.f90 create mode 100644 baseprec/psb_prec_mod.f90 create mode 100644 baseprec/psb_prec_type.f90 create mode 100644 baseprec/psb_zbaseprc_aply.f90 create mode 100644 baseprec/psb_zbaseprc_bld.f90 create mode 100644 baseprec/psb_zbjac_aply.f90 create mode 100644 baseprec/psb_zdiagsc_bld.f90 create mode 100644 baseprec/psb_zilu_bld.f90 create mode 100644 baseprec/psb_zilu_fct.f90 create mode 100644 baseprec/psb_zprc_aply.f90 create mode 100644 baseprec/psb_zprecbld.f90 create mode 100644 baseprec/psb_zprecfree.f90 create mode 100644 baseprec/psb_zprecset.f90 create mode 100644 baseprec/psb_zsp_renum.f90 rename {src/methd => krylov}/Makefile (100%) rename {src/methd => krylov}/psb_dbicg.f90 (100%) rename {src/methd => krylov}/psb_dcg.f90 (100%) rename {src/methd => krylov}/psb_dcgs.f90 (100%) rename {src/methd => krylov}/psb_dcgstab.f90 (100%) rename {src/methd => krylov}/psb_dcgstabl.f90 (100%) rename {src/methd => krylov}/psb_dgmresr.f90 (100%) rename {src/methd => krylov}/psb_zcgs.f90 (100%) rename {src/methd => krylov}/psb_zcgstab.f90 (100%) rename {src/prec => mld2p4}/Makefile (100%) rename {src/prec => mld2p4}/psb_dasmatbld.f90 (100%) rename {src/prec => mld2p4}/psb_dbaseprc_aply.f90 (100%) rename {src/prec => mld2p4}/psb_dbaseprc_bld.f90 (100%) rename {src/prec => mld2p4}/psb_dbjac_aply.f90 (100%) rename {src/prec => mld2p4}/psb_dbldaggrmat.f90 (100%) rename {src/prec => mld2p4}/psb_ddiagsc_bld.f90 (100%) rename {src/prec => mld2p4}/psb_dgenaggrmap.f90 (100%) rename {src/prec => mld2p4}/psb_dilu_bld.f90 (100%) rename {src/prec => mld2p4}/psb_dilu_fct.f90 (100%) rename {src/prec => mld2p4}/psb_dmlprc_aply.f90 (100%) rename {src/prec => mld2p4}/psb_dmlprc_bld.f90 (100%) rename {src/prec => mld2p4}/psb_dprc_aply.f90 (100%) rename {src/prec => mld2p4}/psb_dprecbld.f90 (100%) rename {src/prec => mld2p4}/psb_dprecfree.f90 (100%) rename {src/prec => mld2p4}/psb_dprecset.f90 (100%) rename {src/prec => mld2p4}/psb_dslu_bld.f90 (100%) rename {src/prec => mld2p4}/psb_dsp_renum.f90 (100%) rename {src/prec => mld2p4}/psb_dumf_bld.f90 (100%) rename {src/prec => mld2p4}/psb_slu_impl.c (100%) rename {src/prec => mld2p4}/psb_umf_impl.c (100%) rename {src/prec => mld2p4}/psb_zasmatbld.f90 (100%) rename {src/prec => mld2p4}/psb_zbaseprc_aply.f90 (100%) rename {src/prec => mld2p4}/psb_zbaseprc_bld.f90 (100%) rename {src/prec => mld2p4}/psb_zbjac_aply.f90 (100%) rename {src/prec => mld2p4}/psb_zbldaggrmat.f90 (100%) rename {src/prec => mld2p4}/psb_zdiagsc_bld.f90 (100%) rename {src/prec => mld2p4}/psb_zgenaggrmap.f90 (100%) rename {src/prec => mld2p4}/psb_zilu_bld.f90 (100%) rename {src/prec => mld2p4}/psb_zilu_fct.f90 (100%) rename {src/prec => mld2p4}/psb_zmlprc_aply.f90 (100%) rename {src/prec => mld2p4}/psb_zmlprc_bld.f90 (100%) rename {src/prec => mld2p4}/psb_zprc_aply.f90 (100%) rename {src/prec => mld2p4}/psb_zprecbld.f90 (100%) rename {src/prec => mld2p4}/psb_zprecfree.f90 (100%) rename {src/prec => mld2p4}/psb_zprecset.f90 (100%) rename {src/prec => mld2p4}/psb_zslu_bld.f90 (100%) rename {src/prec => mld2p4}/psb_zslu_impl.c (100%) rename {src/prec => mld2p4}/psb_zsp_renum.f90 (100%) rename {src/prec => mld2p4}/psb_zumf_bld.f90 (100%) rename {src/prec => mld2p4}/psb_zumf_impl.c (100%) delete mode 100644 src/Makefile diff --git a/src/comm/Makefile b/base/comm/Makefile similarity index 100% rename from src/comm/Makefile rename to base/comm/Makefile diff --git a/src/comm/psb_dgather.f90 b/base/comm/psb_dgather.f90 similarity index 100% rename from src/comm/psb_dgather.f90 rename to base/comm/psb_dgather.f90 diff --git a/src/comm/psb_dhalo.f90 b/base/comm/psb_dhalo.f90 similarity index 100% rename from src/comm/psb_dhalo.f90 rename to base/comm/psb_dhalo.f90 diff --git a/src/comm/psb_dovrl.f90 b/base/comm/psb_dovrl.f90 similarity index 100% rename from src/comm/psb_dovrl.f90 rename to base/comm/psb_dovrl.f90 diff --git a/src/comm/psb_dscatter.f90 b/base/comm/psb_dscatter.f90 similarity index 100% rename from src/comm/psb_dscatter.f90 rename to base/comm/psb_dscatter.f90 diff --git a/src/comm/psb_ihalo.f90 b/base/comm/psb_ihalo.f90 similarity index 100% rename from src/comm/psb_ihalo.f90 rename to base/comm/psb_ihalo.f90 diff --git a/src/comm/psb_zgather.f90 b/base/comm/psb_zgather.f90 similarity index 100% rename from src/comm/psb_zgather.f90 rename to base/comm/psb_zgather.f90 diff --git a/src/comm/psb_zhalo.f90 b/base/comm/psb_zhalo.f90 similarity index 100% rename from src/comm/psb_zhalo.f90 rename to base/comm/psb_zhalo.f90 diff --git a/src/comm/psb_zovrl.f90 b/base/comm/psb_zovrl.f90 similarity index 100% rename from src/comm/psb_zovrl.f90 rename to base/comm/psb_zovrl.f90 diff --git a/src/comm/psb_zscatter.f90 b/base/comm/psb_zscatter.f90 similarity index 100% rename from src/comm/psb_zscatter.f90 rename to base/comm/psb_zscatter.f90 diff --git a/src/internals/Makefile b/base/internals/Makefile similarity index 100% rename from src/internals/Makefile rename to base/internals/Makefile diff --git a/src/internals/avltree.c b/base/internals/avltree.c similarity index 100% rename from src/internals/avltree.c rename to base/internals/avltree.c diff --git a/src/internals/avltree.h b/base/internals/avltree.h similarity index 100% rename from src/internals/avltree.h rename to base/internals/avltree.h diff --git a/src/internals/psi_compute_size.f90 b/base/internals/psi_compute_size.f90 similarity index 100% rename from src/internals/psi_compute_size.f90 rename to base/internals/psi_compute_size.f90 diff --git a/src/internals/psi_crea_bnd_elem.f90 b/base/internals/psi_crea_bnd_elem.f90 similarity index 100% rename from src/internals/psi_crea_bnd_elem.f90 rename to base/internals/psi_crea_bnd_elem.f90 diff --git a/src/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 similarity index 100% rename from src/internals/psi_crea_index.f90 rename to base/internals/psi_crea_index.f90 diff --git a/src/internals/psi_crea_ovr_elem.f90 b/base/internals/psi_crea_ovr_elem.f90 similarity index 100% rename from src/internals/psi_crea_ovr_elem.f90 rename to base/internals/psi_crea_ovr_elem.f90 diff --git a/src/internals/psi_desc_index.f90 b/base/internals/psi_desc_index.f90 similarity index 100% rename from src/internals/psi_desc_index.f90 rename to base/internals/psi_desc_index.f90 diff --git a/src/internals/psi_dl_check.f90 b/base/internals/psi_dl_check.f90 similarity index 100% rename from src/internals/psi_dl_check.f90 rename to base/internals/psi_dl_check.f90 diff --git a/src/internals/psi_dswapdata.f90 b/base/internals/psi_dswapdata.f90 similarity index 100% rename from src/internals/psi_dswapdata.f90 rename to base/internals/psi_dswapdata.f90 diff --git a/src/internals/psi_dswaptran.f90 b/base/internals/psi_dswaptran.f90 similarity index 100% rename from src/internals/psi_dswaptran.f90 rename to base/internals/psi_dswaptran.f90 diff --git a/src/internals/psi_exist_ovr_elem.f b/base/internals/psi_exist_ovr_elem.f similarity index 100% rename from src/internals/psi_exist_ovr_elem.f rename to base/internals/psi_exist_ovr_elem.f diff --git a/src/internals/psi_extrct_dl.f b/base/internals/psi_extrct_dl.f similarity index 100% rename from src/internals/psi_extrct_dl.f rename to base/internals/psi_extrct_dl.f diff --git a/src/internals/psi_fnd_owner.f90 b/base/internals/psi_fnd_owner.f90 similarity index 100% rename from src/internals/psi_fnd_owner.f90 rename to base/internals/psi_fnd_owner.f90 diff --git a/src/internals/psi_gthsct.f90 b/base/internals/psi_gthsct.f90 similarity index 100% rename from src/internals/psi_gthsct.f90 rename to base/internals/psi_gthsct.f90 diff --git a/src/internals/psi_idx_cnv.f90 b/base/internals/psi_idx_cnv.f90 similarity index 100% rename from src/internals/psi_idx_cnv.f90 rename to base/internals/psi_idx_cnv.f90 diff --git a/src/internals/psi_idx_ins_cnv.f90 b/base/internals/psi_idx_ins_cnv.f90 similarity index 100% rename from src/internals/psi_idx_ins_cnv.f90 rename to base/internals/psi_idx_ins_cnv.f90 diff --git a/src/internals/psi_iswapdata.f90 b/base/internals/psi_iswapdata.f90 similarity index 100% rename from src/internals/psi_iswapdata.f90 rename to base/internals/psi_iswapdata.f90 diff --git a/src/internals/psi_iswaptran.f90 b/base/internals/psi_iswaptran.f90 similarity index 100% rename from src/internals/psi_iswaptran.f90 rename to base/internals/psi_iswaptran.f90 diff --git a/src/internals/psi_ldsc_pre_halo.f90 b/base/internals/psi_ldsc_pre_halo.f90 similarity index 100% rename from src/internals/psi_ldsc_pre_halo.f90 rename to base/internals/psi_ldsc_pre_halo.f90 diff --git a/src/internals/psi_list_search.f b/base/internals/psi_list_search.f similarity index 100% rename from src/internals/psi_list_search.f rename to base/internals/psi_list_search.f diff --git a/src/internals/psi_sort_dl.f90 b/base/internals/psi_sort_dl.f90 similarity index 100% rename from src/internals/psi_sort_dl.f90 rename to base/internals/psi_sort_dl.f90 diff --git a/src/internals/psi_zswapdata.f90 b/base/internals/psi_zswapdata.f90 similarity index 100% rename from src/internals/psi_zswapdata.f90 rename to base/internals/psi_zswapdata.f90 diff --git a/src/internals/psi_zswaptran.f90 b/base/internals/psi_zswaptran.f90 similarity index 100% rename from src/internals/psi_zswaptran.f90 rename to base/internals/psi_zswaptran.f90 diff --git a/src/internals/srcht.c b/base/internals/srcht.c similarity index 100% rename from src/internals/srcht.c rename to base/internals/srcht.c diff --git a/src/internals/srtlist.f b/base/internals/srtlist.f similarity index 100% rename from src/internals/srtlist.f rename to base/internals/srtlist.f diff --git a/src/modules/Makefile b/base/modules/Makefile similarity index 100% rename from src/modules/Makefile rename to base/modules/Makefile diff --git a/src/modules/blacs_env.F90 b/base/modules/blacs_env.F90 similarity index 100% rename from src/modules/blacs_env.F90 rename to base/modules/blacs_env.F90 diff --git a/src/modules/error.f90 b/base/modules/error.f90 similarity index 100% rename from src/modules/error.f90 rename to base/modules/error.f90 diff --git a/src/modules/parts.f90 b/base/modules/parts.f90 similarity index 100% rename from src/modules/parts.f90 rename to base/modules/parts.f90 diff --git a/src/modules/parts.fh b/base/modules/parts.fh similarity index 100% rename from src/modules/parts.fh rename to base/modules/parts.fh diff --git a/src/modules/psb_all_mod.f90 b/base/modules/psb_all_mod.f90 similarity index 100% rename from src/modules/psb_all_mod.f90 rename to base/modules/psb_all_mod.f90 diff --git a/src/modules/psb_check_mod.f90 b/base/modules/psb_check_mod.f90 similarity index 100% rename from src/modules/psb_check_mod.f90 rename to base/modules/psb_check_mod.f90 diff --git a/src/modules/psb_comm_mod.f90 b/base/modules/psb_comm_mod.f90 similarity index 100% rename from src/modules/psb_comm_mod.f90 rename to base/modules/psb_comm_mod.f90 diff --git a/src/modules/psb_const_mod.f90 b/base/modules/psb_const_mod.f90 similarity index 100% rename from src/modules/psb_const_mod.f90 rename to base/modules/psb_const_mod.f90 diff --git a/src/modules/psb_desc_type.f90 b/base/modules/psb_desc_type.f90 similarity index 100% rename from src/modules/psb_desc_type.f90 rename to base/modules/psb_desc_type.f90 diff --git a/src/modules/psb_error_mod.f90 b/base/modules/psb_error_mod.f90 similarity index 100% rename from src/modules/psb_error_mod.f90 rename to base/modules/psb_error_mod.f90 diff --git a/src/modules/psb_gps_mod.f90 b/base/modules/psb_gps_mod.f90 similarity index 100% rename from src/modules/psb_gps_mod.f90 rename to base/modules/psb_gps_mod.f90 diff --git a/src/modules/psb_methd_mod.f90 b/base/modules/psb_methd_mod.f90 similarity index 100% rename from src/modules/psb_methd_mod.f90 rename to base/modules/psb_methd_mod.f90 diff --git a/src/modules/psb_penv_mod.f90 b/base/modules/psb_penv_mod.f90 similarity index 100% rename from src/modules/psb_penv_mod.f90 rename to base/modules/psb_penv_mod.f90 diff --git a/src/modules/psb_prec_mod.f90 b/base/modules/psb_prec_mod.f90 similarity index 100% rename from src/modules/psb_prec_mod.f90 rename to base/modules/psb_prec_mod.f90 diff --git a/src/modules/psb_prec_type.f90 b/base/modules/psb_prec_type.f90 similarity index 100% rename from src/modules/psb_prec_type.f90 rename to base/modules/psb_prec_type.f90 diff --git a/src/modules/psb_psblas_mod.f90 b/base/modules/psb_psblas_mod.f90 similarity index 100% rename from src/modules/psb_psblas_mod.f90 rename to base/modules/psb_psblas_mod.f90 diff --git a/src/modules/psb_realloc_mod.F90 b/base/modules/psb_realloc_mod.F90 similarity index 100% rename from src/modules/psb_realloc_mod.F90 rename to base/modules/psb_realloc_mod.F90 diff --git a/src/modules/psb_serial_mod.f90 b/base/modules/psb_serial_mod.f90 similarity index 100% rename from src/modules/psb_serial_mod.f90 rename to base/modules/psb_serial_mod.f90 diff --git a/src/modules/psb_sparse_mod.f90 b/base/modules/psb_sparse_mod.f90 similarity index 100% rename from src/modules/psb_sparse_mod.f90 rename to base/modules/psb_sparse_mod.f90 diff --git a/src/modules/psb_spmat_type.f90 b/base/modules/psb_spmat_type.f90 similarity index 100% rename from src/modules/psb_spmat_type.f90 rename to base/modules/psb_spmat_type.f90 diff --git a/src/modules/psb_spsb_mod.f90 b/base/modules/psb_spsb_mod.f90 similarity index 100% rename from src/modules/psb_spsb_mod.f90 rename to base/modules/psb_spsb_mod.f90 diff --git a/src/modules/psb_string_mod.f90 b/base/modules/psb_string_mod.f90 similarity index 100% rename from src/modules/psb_string_mod.f90 rename to base/modules/psb_string_mod.f90 diff --git a/src/modules/psb_tools_mod.f90 b/base/modules/psb_tools_mod.f90 similarity index 100% rename from src/modules/psb_tools_mod.f90 rename to base/modules/psb_tools_mod.f90 diff --git a/src/modules/psi_mod.f90 b/base/modules/psi_mod.f90 similarity index 100% rename from src/modules/psi_mod.f90 rename to base/modules/psi_mod.f90 diff --git a/src/psblas/Makefile b/base/psblas/Makefile similarity index 100% rename from src/psblas/Makefile rename to base/psblas/Makefile diff --git a/src/psblas/pdtreecomb.f b/base/psblas/pdtreecomb.f similarity index 100% rename from src/psblas/pdtreecomb.f rename to base/psblas/pdtreecomb.f diff --git a/src/psblas/psb_damax.f90 b/base/psblas/psb_damax.f90 similarity index 100% rename from src/psblas/psb_damax.f90 rename to base/psblas/psb_damax.f90 diff --git a/src/psblas/psb_dasum.f90 b/base/psblas/psb_dasum.f90 similarity index 100% rename from src/psblas/psb_dasum.f90 rename to base/psblas/psb_dasum.f90 diff --git a/src/psblas/psb_daxpby.f90 b/base/psblas/psb_daxpby.f90 similarity index 100% rename from src/psblas/psb_daxpby.f90 rename to base/psblas/psb_daxpby.f90 diff --git a/src/psblas/psb_ddot.f90 b/base/psblas/psb_ddot.f90 similarity index 100% rename from src/psblas/psb_ddot.f90 rename to base/psblas/psb_ddot.f90 diff --git a/src/psblas/psb_dnrm2.f90 b/base/psblas/psb_dnrm2.f90 similarity index 100% rename from src/psblas/psb_dnrm2.f90 rename to base/psblas/psb_dnrm2.f90 diff --git a/src/psblas/psb_dnrmi.f90 b/base/psblas/psb_dnrmi.f90 similarity index 100% rename from src/psblas/psb_dnrmi.f90 rename to base/psblas/psb_dnrmi.f90 diff --git a/src/psblas/psb_dspmm.f90 b/base/psblas/psb_dspmm.f90 similarity index 100% rename from src/psblas/psb_dspmm.f90 rename to base/psblas/psb_dspmm.f90 diff --git a/src/psblas/psb_dspsm.f90 b/base/psblas/psb_dspsm.f90 similarity index 100% rename from src/psblas/psb_dspsm.f90 rename to base/psblas/psb_dspsm.f90 diff --git a/src/psblas/psb_zamax.f90 b/base/psblas/psb_zamax.f90 similarity index 100% rename from src/psblas/psb_zamax.f90 rename to base/psblas/psb_zamax.f90 diff --git a/src/psblas/psb_zasum.f90 b/base/psblas/psb_zasum.f90 similarity index 100% rename from src/psblas/psb_zasum.f90 rename to base/psblas/psb_zasum.f90 diff --git a/src/psblas/psb_zaxpby.f90 b/base/psblas/psb_zaxpby.f90 similarity index 100% rename from src/psblas/psb_zaxpby.f90 rename to base/psblas/psb_zaxpby.f90 diff --git a/src/psblas/psb_zdot.f90 b/base/psblas/psb_zdot.f90 similarity index 100% rename from src/psblas/psb_zdot.f90 rename to base/psblas/psb_zdot.f90 diff --git a/src/psblas/psb_znrm2.f90 b/base/psblas/psb_znrm2.f90 similarity index 100% rename from src/psblas/psb_znrm2.f90 rename to base/psblas/psb_znrm2.f90 diff --git a/src/psblas/psb_znrmi.f90 b/base/psblas/psb_znrmi.f90 similarity index 100% rename from src/psblas/psb_znrmi.f90 rename to base/psblas/psb_znrmi.f90 diff --git a/src/psblas/psb_zspmm.f90 b/base/psblas/psb_zspmm.f90 similarity index 100% rename from src/psblas/psb_zspmm.f90 rename to base/psblas/psb_zspmm.f90 diff --git a/src/psblas/psb_zspsm.f90 b/base/psblas/psb_zspsm.f90 similarity index 100% rename from src/psblas/psb_zspsm.f90 rename to base/psblas/psb_zspsm.f90 diff --git a/src/serial/Makefile b/base/serial/Makefile similarity index 100% rename from src/serial/Makefile rename to base/serial/Makefile diff --git a/src/serial/README.serial b/base/serial/README.serial similarity index 100% rename from src/serial/README.serial rename to base/serial/README.serial diff --git a/src/serial/aux/Makefile b/base/serial/aux/Makefile similarity index 100% rename from src/serial/aux/Makefile rename to base/serial/aux/Makefile diff --git a/src/serial/aux/ibsrch.f b/base/serial/aux/ibsrch.f similarity index 100% rename from src/serial/aux/ibsrch.f rename to base/serial/aux/ibsrch.f diff --git a/src/serial/aux/imsr.f90 b/base/serial/aux/imsr.f90 similarity index 100% rename from src/serial/aux/imsr.f90 rename to base/serial/aux/imsr.f90 diff --git a/src/serial/aux/imsrx.f90 b/base/serial/aux/imsrx.f90 similarity index 100% rename from src/serial/aux/imsrx.f90 rename to base/serial/aux/imsrx.f90 diff --git a/src/serial/aux/isaperm.f b/base/serial/aux/isaperm.f similarity index 100% rename from src/serial/aux/isaperm.f rename to base/serial/aux/isaperm.f diff --git a/src/serial/aux/isr.f b/base/serial/aux/isr.f similarity index 100% rename from src/serial/aux/isr.f rename to base/serial/aux/isr.f diff --git a/src/serial/aux/isrx.f b/base/serial/aux/isrx.f similarity index 100% rename from src/serial/aux/isrx.f rename to base/serial/aux/isrx.f diff --git a/src/serial/aux/issrch.f b/base/serial/aux/issrch.f similarity index 100% rename from src/serial/aux/issrch.f rename to base/serial/aux/issrch.f diff --git a/src/serial/aux/mrgsrt.f b/base/serial/aux/mrgsrt.f similarity index 100% rename from src/serial/aux/mrgsrt.f rename to base/serial/aux/mrgsrt.f diff --git a/src/serial/coo/Makefile b/base/serial/coo/Makefile similarity index 100% rename from src/serial/coo/Makefile rename to base/serial/coo/Makefile diff --git a/src/serial/coo/dcoomm.f b/base/serial/coo/dcoomm.f similarity index 100% rename from src/serial/coo/dcoomm.f rename to base/serial/coo/dcoomm.f diff --git a/src/serial/coo/dcoomv.f b/base/serial/coo/dcoomv.f similarity index 100% rename from src/serial/coo/dcoomv.f rename to base/serial/coo/dcoomv.f diff --git a/src/serial/coo/dcoonrmi.f b/base/serial/coo/dcoonrmi.f similarity index 100% rename from src/serial/coo/dcoonrmi.f rename to base/serial/coo/dcoonrmi.f diff --git a/src/serial/coo/dcooprt.f b/base/serial/coo/dcooprt.f similarity index 100% rename from src/serial/coo/dcooprt.f rename to base/serial/coo/dcooprt.f diff --git a/src/serial/coo/dcoorws.f b/base/serial/coo/dcoorws.f similarity index 100% rename from src/serial/coo/dcoorws.f rename to base/serial/coo/dcoorws.f diff --git a/src/serial/coo/dcoosm.f b/base/serial/coo/dcoosm.f similarity index 100% rename from src/serial/coo/dcoosm.f rename to base/serial/coo/dcoosm.f diff --git a/src/serial/coo/dcoosv.f b/base/serial/coo/dcoosv.f similarity index 100% rename from src/serial/coo/dcoosv.f rename to base/serial/coo/dcoosv.f diff --git a/src/serial/coo/zcoomm.f b/base/serial/coo/zcoomm.f similarity index 100% rename from src/serial/coo/zcoomm.f rename to base/serial/coo/zcoomm.f diff --git a/src/serial/coo/zcoomv.f b/base/serial/coo/zcoomv.f similarity index 100% rename from src/serial/coo/zcoomv.f rename to base/serial/coo/zcoomv.f diff --git a/src/serial/coo/zcoonrmi.f b/base/serial/coo/zcoonrmi.f similarity index 100% rename from src/serial/coo/zcoonrmi.f rename to base/serial/coo/zcoonrmi.f diff --git a/src/serial/coo/zcoorws.f b/base/serial/coo/zcoorws.f similarity index 100% rename from src/serial/coo/zcoorws.f rename to base/serial/coo/zcoorws.f diff --git a/src/serial/coo/zcoosm.f b/base/serial/coo/zcoosm.f similarity index 100% rename from src/serial/coo/zcoosm.f rename to base/serial/coo/zcoosm.f diff --git a/src/serial/coo/zcoosv.f b/base/serial/coo/zcoosv.f similarity index 100% rename from src/serial/coo/zcoosv.f rename to base/serial/coo/zcoosv.f diff --git a/src/serial/csr/Makefile b/base/serial/csr/Makefile similarity index 100% rename from src/serial/csr/Makefile rename to base/serial/csr/Makefile diff --git a/src/serial/csr/dcrnrmi.f b/base/serial/csr/dcrnrmi.f similarity index 100% rename from src/serial/csr/dcrnrmi.f rename to base/serial/csr/dcrnrmi.f diff --git a/src/serial/csr/dcsrck.f b/base/serial/csr/dcsrck.f similarity index 100% rename from src/serial/csr/dcsrck.f rename to base/serial/csr/dcsrck.f diff --git a/src/serial/csr/dcsrmm.f b/base/serial/csr/dcsrmm.f similarity index 100% rename from src/serial/csr/dcsrmm.f rename to base/serial/csr/dcsrmm.f diff --git a/src/serial/csr/dcsrmv.f b/base/serial/csr/dcsrmv.f similarity index 100% rename from src/serial/csr/dcsrmv.f rename to base/serial/csr/dcsrmv.f diff --git a/src/serial/csr/dcsrmv2.f b/base/serial/csr/dcsrmv2.f similarity index 100% rename from src/serial/csr/dcsrmv2.f rename to base/serial/csr/dcsrmv2.f diff --git a/src/serial/csr/dcsrmv3.f b/base/serial/csr/dcsrmv3.f similarity index 100% rename from src/serial/csr/dcsrmv3.f rename to base/serial/csr/dcsrmv3.f diff --git a/src/serial/csr/dcsrmv4.f b/base/serial/csr/dcsrmv4.f similarity index 100% rename from src/serial/csr/dcsrmv4.f rename to base/serial/csr/dcsrmv4.f diff --git a/src/serial/csr/dcsrprt.f b/base/serial/csr/dcsrprt.f similarity index 100% rename from src/serial/csr/dcsrprt.f rename to base/serial/csr/dcsrprt.f diff --git a/src/serial/csr/dcsrrws.f b/base/serial/csr/dcsrrws.f similarity index 100% rename from src/serial/csr/dcsrrws.f rename to base/serial/csr/dcsrrws.f diff --git a/src/serial/csr/dcsrsm.f b/base/serial/csr/dcsrsm.f similarity index 100% rename from src/serial/csr/dcsrsm.f rename to base/serial/csr/dcsrsm.f diff --git a/src/serial/csr/dcsrsv.f b/base/serial/csr/dcsrsv.f similarity index 100% rename from src/serial/csr/dcsrsv.f rename to base/serial/csr/dcsrsv.f diff --git a/src/serial/csr/zcrnrmi.f b/base/serial/csr/zcrnrmi.f similarity index 100% rename from src/serial/csr/zcrnrmi.f rename to base/serial/csr/zcrnrmi.f diff --git a/src/serial/csr/zcsrck.f b/base/serial/csr/zcsrck.f similarity index 100% rename from src/serial/csr/zcsrck.f rename to base/serial/csr/zcsrck.f diff --git a/src/serial/csr/zcsrmm.f b/base/serial/csr/zcsrmm.f similarity index 100% rename from src/serial/csr/zcsrmm.f rename to base/serial/csr/zcsrmm.f diff --git a/src/serial/csr/zcsrrws.f b/base/serial/csr/zcsrrws.f similarity index 100% rename from src/serial/csr/zcsrrws.f rename to base/serial/csr/zcsrrws.f diff --git a/src/serial/csr/zcsrsm.f b/base/serial/csr/zcsrsm.f similarity index 100% rename from src/serial/csr/zcsrsm.f rename to base/serial/csr/zcsrsm.f diff --git a/src/serial/csr/zsrmv.f b/base/serial/csr/zsrmv.f similarity index 100% rename from src/serial/csr/zsrmv.f rename to base/serial/csr/zsrmv.f diff --git a/src/serial/csr/zsrsv.f b/base/serial/csr/zsrsv.f similarity index 100% rename from src/serial/csr/zsrsv.f rename to base/serial/csr/zsrsv.f diff --git a/src/serial/dp/Makefile b/base/serial/dp/Makefile similarity index 100% rename from src/serial/dp/Makefile rename to base/serial/dp/Makefile diff --git a/src/serial/dp/Max_nnzero.f b/base/serial/dp/Max_nnzero.f similarity index 100% rename from src/serial/dp/Max_nnzero.f rename to base/serial/dp/Max_nnzero.f diff --git a/src/serial/dp/check_dim.f b/base/serial/dp/check_dim.f similarity index 100% rename from src/serial/dp/check_dim.f rename to base/serial/dp/check_dim.f diff --git a/src/serial/dp/dcoco.f b/base/serial/dp/dcoco.f similarity index 100% rename from src/serial/dp/dcoco.f rename to base/serial/dp/dcoco.f diff --git a/src/serial/dp/dcocr.f b/base/serial/dp/dcocr.f similarity index 100% rename from src/serial/dp/dcocr.f rename to base/serial/dp/dcocr.f diff --git a/src/serial/dp/dcrco.f b/base/serial/dp/dcrco.f similarity index 100% rename from src/serial/dp/dcrco.f rename to base/serial/dp/dcrco.f diff --git a/src/serial/dp/dcrcr.f b/base/serial/dp/dcrcr.f similarity index 100% rename from src/serial/dp/dcrcr.f rename to base/serial/dp/dcrcr.f diff --git a/src/serial/dp/dcrjd.f b/base/serial/dp/dcrjd.f similarity index 100% rename from src/serial/dp/dcrjd.f rename to base/serial/dp/dcrjd.f diff --git a/src/serial/dp/dcsrp1.f b/base/serial/dp/dcsrp1.f similarity index 100% rename from src/serial/dp/dcsrp1.f rename to base/serial/dp/dcsrp1.f diff --git a/src/serial/dp/dcsrrp.f b/base/serial/dp/dcsrrp.f similarity index 100% rename from src/serial/dp/dcsrrp.f rename to base/serial/dp/dcsrrp.f diff --git a/src/serial/dp/dgblock.f b/base/serial/dp/dgblock.f similarity index 100% rename from src/serial/dp/dgblock.f rename to base/serial/dp/dgblock.f diff --git a/src/serial/dp/dgind_tri.f b/base/serial/dp/dgind_tri.f similarity index 100% rename from src/serial/dp/dgind_tri.f rename to base/serial/dp/dgind_tri.f diff --git a/src/serial/dp/dgindex.f b/base/serial/dp/dgindex.f similarity index 100% rename from src/serial/dp/dgindex.f rename to base/serial/dp/dgindex.f diff --git a/src/serial/dp/djadrp.f b/base/serial/dp/djadrp.f similarity index 100% rename from src/serial/dp/djadrp.f rename to base/serial/dp/djadrp.f diff --git a/src/serial/dp/djadrp1.f b/base/serial/dp/djadrp1.f similarity index 100% rename from src/serial/dp/djadrp1.f rename to base/serial/dp/djadrp1.f diff --git a/src/serial/dp/djdco.f b/base/serial/dp/djdco.f similarity index 100% rename from src/serial/dp/djdco.f rename to base/serial/dp/djdco.f diff --git a/src/serial/dp/djdcox.f b/base/serial/dp/djdcox.f similarity index 100% rename from src/serial/dp/djdcox.f rename to base/serial/dp/djdcox.f diff --git a/src/serial/dp/dvtfg.f b/base/serial/dp/dvtfg.f similarity index 100% rename from src/serial/dp/dvtfg.f rename to base/serial/dp/dvtfg.f diff --git a/src/serial/dp/gen_block.f b/base/serial/dp/gen_block.f similarity index 100% rename from src/serial/dp/gen_block.f rename to base/serial/dp/gen_block.f diff --git a/src/serial/dp/partition.f b/base/serial/dp/partition.f similarity index 100% rename from src/serial/dp/partition.f rename to base/serial/dp/partition.f diff --git a/src/serial/dp/reordvn.f b/base/serial/dp/reordvn.f similarity index 100% rename from src/serial/dp/reordvn.f rename to base/serial/dp/reordvn.f diff --git a/src/serial/dp/zcoco.f b/base/serial/dp/zcoco.f similarity index 100% rename from src/serial/dp/zcoco.f rename to base/serial/dp/zcoco.f diff --git a/src/serial/dp/zcocr.f b/base/serial/dp/zcocr.f similarity index 100% rename from src/serial/dp/zcocr.f rename to base/serial/dp/zcocr.f diff --git a/src/serial/dp/zcrco.f b/base/serial/dp/zcrco.f similarity index 100% rename from src/serial/dp/zcrco.f rename to base/serial/dp/zcrco.f diff --git a/src/serial/dp/zcrcr.f b/base/serial/dp/zcrcr.f similarity index 100% rename from src/serial/dp/zcrcr.f rename to base/serial/dp/zcrcr.f diff --git a/src/serial/dp/zcrjd.f b/base/serial/dp/zcrjd.f similarity index 100% rename from src/serial/dp/zcrjd.f rename to base/serial/dp/zcrjd.f diff --git a/src/serial/dp/zgind_tri.f b/base/serial/dp/zgind_tri.f similarity index 100% rename from src/serial/dp/zgind_tri.f rename to base/serial/dp/zgind_tri.f diff --git a/src/serial/dp/zgindex.f b/base/serial/dp/zgindex.f similarity index 100% rename from src/serial/dp/zgindex.f rename to base/serial/dp/zgindex.f diff --git a/src/serial/f77/Makefile b/base/serial/f77/Makefile similarity index 100% rename from src/serial/f77/Makefile rename to base/serial/f77/Makefile diff --git a/src/serial/f77/daxpby.f b/base/serial/f77/daxpby.f similarity index 100% rename from src/serial/f77/daxpby.f rename to base/serial/f77/daxpby.f diff --git a/src/serial/f77/dcsmm.f b/base/serial/f77/dcsmm.f similarity index 100% rename from src/serial/f77/dcsmm.f rename to base/serial/f77/dcsmm.f diff --git a/src/serial/f77/dcsnmi.f b/base/serial/f77/dcsnmi.f similarity index 100% rename from src/serial/f77/dcsnmi.f rename to base/serial/f77/dcsnmi.f diff --git a/src/serial/f77/dcsrp.f b/base/serial/f77/dcsrp.f similarity index 100% rename from src/serial/f77/dcsrp.f rename to base/serial/f77/dcsrp.f diff --git a/src/serial/f77/dcsrws.f b/base/serial/f77/dcsrws.f similarity index 100% rename from src/serial/f77/dcsrws.f rename to base/serial/f77/dcsrws.f diff --git a/src/serial/f77/dcssm.f b/base/serial/f77/dcssm.f similarity index 100% rename from src/serial/f77/dcssm.f rename to base/serial/f77/dcssm.f diff --git a/src/serial/f77/dgelp.f b/base/serial/f77/dgelp.f similarity index 100% rename from src/serial/f77/dgelp.f rename to base/serial/f77/dgelp.f diff --git a/src/serial/f77/dlpupd.f b/base/serial/f77/dlpupd.f similarity index 100% rename from src/serial/f77/dlpupd.f rename to base/serial/f77/dlpupd.f diff --git a/src/serial/f77/dswmm.f b/base/serial/f77/dswmm.f similarity index 100% rename from src/serial/f77/dswmm.f rename to base/serial/f77/dswmm.f diff --git a/src/serial/f77/dswprt.f b/base/serial/f77/dswprt.f similarity index 100% rename from src/serial/f77/dswprt.f rename to base/serial/f77/dswprt.f diff --git a/src/serial/f77/dswsm.f b/base/serial/f77/dswsm.f similarity index 100% rename from src/serial/f77/dswsm.f rename to base/serial/f77/dswsm.f diff --git a/src/serial/f77/smmp.f b/base/serial/f77/smmp.f similarity index 100% rename from src/serial/f77/smmp.f rename to base/serial/f77/smmp.f diff --git a/src/serial/f77/zaxpby.f b/base/serial/f77/zaxpby.f similarity index 100% rename from src/serial/f77/zaxpby.f rename to base/serial/f77/zaxpby.f diff --git a/src/serial/f77/zcsmm.f b/base/serial/f77/zcsmm.f similarity index 100% rename from src/serial/f77/zcsmm.f rename to base/serial/f77/zcsmm.f diff --git a/src/serial/f77/zcsnmi.f b/base/serial/f77/zcsnmi.f similarity index 100% rename from src/serial/f77/zcsnmi.f rename to base/serial/f77/zcsnmi.f diff --git a/src/serial/f77/zcsrws.f b/base/serial/f77/zcsrws.f similarity index 100% rename from src/serial/f77/zcsrws.f rename to base/serial/f77/zcsrws.f diff --git a/src/serial/f77/zcssm.f b/base/serial/f77/zcssm.f similarity index 100% rename from src/serial/f77/zcssm.f rename to base/serial/f77/zcssm.f diff --git a/src/serial/f77/zgelp.f b/base/serial/f77/zgelp.f similarity index 100% rename from src/serial/f77/zgelp.f rename to base/serial/f77/zgelp.f diff --git a/src/serial/f77/zlpupd.f b/base/serial/f77/zlpupd.f similarity index 100% rename from src/serial/f77/zlpupd.f rename to base/serial/f77/zlpupd.f diff --git a/src/serial/f77/zswmm.f b/base/serial/f77/zswmm.f similarity index 100% rename from src/serial/f77/zswmm.f rename to base/serial/f77/zswmm.f diff --git a/src/serial/f77/zswsm.f b/base/serial/f77/zswsm.f similarity index 100% rename from src/serial/f77/zswsm.f rename to base/serial/f77/zswsm.f diff --git a/src/serial/jad/Makefile b/base/serial/jad/Makefile similarity index 100% rename from src/serial/jad/Makefile rename to base/serial/jad/Makefile diff --git a/src/serial/jad/djadmm.f b/base/serial/jad/djadmm.f similarity index 100% rename from src/serial/jad/djadmm.f rename to base/serial/jad/djadmm.f diff --git a/src/serial/jad/djadmv.f b/base/serial/jad/djadmv.f similarity index 100% rename from src/serial/jad/djadmv.f rename to base/serial/jad/djadmv.f diff --git a/src/serial/jad/djadmv2.f b/base/serial/jad/djadmv2.f similarity index 100% rename from src/serial/jad/djadmv2.f rename to base/serial/jad/djadmv2.f diff --git a/src/serial/jad/djadmv3.f b/base/serial/jad/djadmv3.f similarity index 100% rename from src/serial/jad/djadmv3.f rename to base/serial/jad/djadmv3.f diff --git a/src/serial/jad/djadmv4.f b/base/serial/jad/djadmv4.f similarity index 100% rename from src/serial/jad/djadmv4.f rename to base/serial/jad/djadmv4.f diff --git a/src/serial/jad/djadnr.f b/base/serial/jad/djadnr.f similarity index 100% rename from src/serial/jad/djadnr.f rename to base/serial/jad/djadnr.f diff --git a/src/serial/jad/djadprt.f b/base/serial/jad/djadprt.f similarity index 100% rename from src/serial/jad/djadprt.f rename to base/serial/jad/djadprt.f diff --git a/src/serial/jad/djadrws.f b/base/serial/jad/djadrws.f similarity index 100% rename from src/serial/jad/djadrws.f rename to base/serial/jad/djadrws.f diff --git a/src/serial/jad/djadsm.f b/base/serial/jad/djadsm.f similarity index 100% rename from src/serial/jad/djadsm.f rename to base/serial/jad/djadsm.f diff --git a/src/serial/jad/djadsv.f b/base/serial/jad/djadsv.f similarity index 100% rename from src/serial/jad/djadsv.f rename to base/serial/jad/djadsv.f diff --git a/src/serial/jad/djdnrmi.f b/base/serial/jad/djdnrmi.f similarity index 100% rename from src/serial/jad/djdnrmi.f rename to base/serial/jad/djdnrmi.f diff --git a/src/serial/jad/djdrws.f b/base/serial/jad/djdrws.f similarity index 100% rename from src/serial/jad/djdrws.f rename to base/serial/jad/djdrws.f diff --git a/src/serial/lsame.f90 b/base/serial/lsame.f90 similarity index 100% rename from src/serial/lsame.f90 rename to base/serial/lsame.f90 diff --git a/src/serial/psb_cest.f90 b/base/serial/psb_cest.f90 similarity index 100% rename from src/serial/psb_cest.f90 rename to base/serial/psb_cest.f90 diff --git a/src/serial/psb_dcoins.f90 b/base/serial/psb_dcoins.f90 similarity index 100% rename from src/serial/psb_dcoins.f90 rename to base/serial/psb_dcoins.f90 diff --git a/src/serial/psb_dcsdp.f90 b/base/serial/psb_dcsdp.f90 similarity index 100% rename from src/serial/psb_dcsdp.f90 rename to base/serial/psb_dcsdp.f90 diff --git a/src/serial/psb_dcsmm.f90 b/base/serial/psb_dcsmm.f90 similarity index 100% rename from src/serial/psb_dcsmm.f90 rename to base/serial/psb_dcsmm.f90 diff --git a/src/serial/psb_dcsmv.f90 b/base/serial/psb_dcsmv.f90 similarity index 100% rename from src/serial/psb_dcsmv.f90 rename to base/serial/psb_dcsmv.f90 diff --git a/src/serial/psb_dcsnmi.f90 b/base/serial/psb_dcsnmi.f90 similarity index 100% rename from src/serial/psb_dcsnmi.f90 rename to base/serial/psb_dcsnmi.f90 diff --git a/src/serial/psb_dcsprt.f90 b/base/serial/psb_dcsprt.f90 similarity index 100% rename from src/serial/psb_dcsprt.f90 rename to base/serial/psb_dcsprt.f90 diff --git a/src/serial/psb_dcsrws.f90 b/base/serial/psb_dcsrws.f90 similarity index 100% rename from src/serial/psb_dcsrws.f90 rename to base/serial/psb_dcsrws.f90 diff --git a/src/serial/psb_dcssm.f90 b/base/serial/psb_dcssm.f90 similarity index 100% rename from src/serial/psb_dcssm.f90 rename to base/serial/psb_dcssm.f90 diff --git a/src/serial/psb_dcssv.f90 b/base/serial/psb_dcssv.f90 similarity index 100% rename from src/serial/psb_dcssv.f90 rename to base/serial/psb_dcssv.f90 diff --git a/src/serial/psb_dfixcoo.f90 b/base/serial/psb_dfixcoo.f90 similarity index 100% rename from src/serial/psb_dfixcoo.f90 rename to base/serial/psb_dfixcoo.f90 diff --git a/src/serial/psb_dipcoo2csc.f90 b/base/serial/psb_dipcoo2csc.f90 similarity index 100% rename from src/serial/psb_dipcoo2csc.f90 rename to base/serial/psb_dipcoo2csc.f90 diff --git a/src/serial/psb_dipcoo2csr.f90 b/base/serial/psb_dipcoo2csr.f90 similarity index 100% rename from src/serial/psb_dipcoo2csr.f90 rename to base/serial/psb_dipcoo2csr.f90 diff --git a/src/serial/psb_dipcsr2coo.f90 b/base/serial/psb_dipcsr2coo.f90 similarity index 100% rename from src/serial/psb_dipcsr2coo.f90 rename to base/serial/psb_dipcsr2coo.f90 diff --git a/src/serial/psb_dneigh.f90 b/base/serial/psb_dneigh.f90 similarity index 100% rename from src/serial/psb_dneigh.f90 rename to base/serial/psb_dneigh.f90 diff --git a/src/serial/psb_dnumbmm.f90 b/base/serial/psb_dnumbmm.f90 similarity index 100% rename from src/serial/psb_dnumbmm.f90 rename to base/serial/psb_dnumbmm.f90 diff --git a/src/serial/psb_drwextd.f90 b/base/serial/psb_drwextd.f90 similarity index 100% rename from src/serial/psb_drwextd.f90 rename to base/serial/psb_drwextd.f90 diff --git a/src/serial/psb_dspgetrow.f90 b/base/serial/psb_dspgetrow.f90 similarity index 100% rename from src/serial/psb_dspgetrow.f90 rename to base/serial/psb_dspgetrow.f90 diff --git a/src/serial/psb_dspgtblk.f90 b/base/serial/psb_dspgtblk.f90 similarity index 100% rename from src/serial/psb_dspgtblk.f90 rename to base/serial/psb_dspgtblk.f90 diff --git a/src/serial/psb_dspgtdiag.f90 b/base/serial/psb_dspgtdiag.f90 similarity index 100% rename from src/serial/psb_dspgtdiag.f90 rename to base/serial/psb_dspgtdiag.f90 diff --git a/src/serial/psb_dspscal.f90 b/base/serial/psb_dspscal.f90 similarity index 100% rename from src/serial/psb_dspscal.f90 rename to base/serial/psb_dspscal.f90 diff --git a/src/serial/psb_dsymbmm.f90 b/base/serial/psb_dsymbmm.f90 similarity index 100% rename from src/serial/psb_dsymbmm.f90 rename to base/serial/psb_dsymbmm.f90 diff --git a/src/serial/psb_dtransp.f90 b/base/serial/psb_dtransp.f90 similarity index 100% rename from src/serial/psb_dtransp.f90 rename to base/serial/psb_dtransp.f90 diff --git a/src/serial/psb_getifield.f90 b/base/serial/psb_getifield.f90 similarity index 100% rename from src/serial/psb_getifield.f90 rename to base/serial/psb_getifield.f90 diff --git a/src/serial/psb_setifield.f90 b/base/serial/psb_setifield.f90 similarity index 100% rename from src/serial/psb_setifield.f90 rename to base/serial/psb_setifield.f90 diff --git a/src/serial/psb_update_mod.f90 b/base/serial/psb_update_mod.f90 similarity index 100% rename from src/serial/psb_update_mod.f90 rename to base/serial/psb_update_mod.f90 diff --git a/src/serial/psb_zcoins.f90 b/base/serial/psb_zcoins.f90 similarity index 100% rename from src/serial/psb_zcoins.f90 rename to base/serial/psb_zcoins.f90 diff --git a/src/serial/psb_zcsdp.f90 b/base/serial/psb_zcsdp.f90 similarity index 100% rename from src/serial/psb_zcsdp.f90 rename to base/serial/psb_zcsdp.f90 diff --git a/src/serial/psb_zcsmm.f90 b/base/serial/psb_zcsmm.f90 similarity index 100% rename from src/serial/psb_zcsmm.f90 rename to base/serial/psb_zcsmm.f90 diff --git a/src/serial/psb_zcsmv.f90 b/base/serial/psb_zcsmv.f90 similarity index 100% rename from src/serial/psb_zcsmv.f90 rename to base/serial/psb_zcsmv.f90 diff --git a/src/serial/psb_zcsnmi.f90 b/base/serial/psb_zcsnmi.f90 similarity index 100% rename from src/serial/psb_zcsnmi.f90 rename to base/serial/psb_zcsnmi.f90 diff --git a/src/serial/psb_zcsprt.f90 b/base/serial/psb_zcsprt.f90 similarity index 100% rename from src/serial/psb_zcsprt.f90 rename to base/serial/psb_zcsprt.f90 diff --git a/src/serial/psb_zcsrws.f90 b/base/serial/psb_zcsrws.f90 similarity index 100% rename from src/serial/psb_zcsrws.f90 rename to base/serial/psb_zcsrws.f90 diff --git a/src/serial/psb_zcssm.f90 b/base/serial/psb_zcssm.f90 similarity index 100% rename from src/serial/psb_zcssm.f90 rename to base/serial/psb_zcssm.f90 diff --git a/src/serial/psb_zcssv.f90 b/base/serial/psb_zcssv.f90 similarity index 100% rename from src/serial/psb_zcssv.f90 rename to base/serial/psb_zcssv.f90 diff --git a/src/serial/psb_zfixcoo.f90 b/base/serial/psb_zfixcoo.f90 similarity index 100% rename from src/serial/psb_zfixcoo.f90 rename to base/serial/psb_zfixcoo.f90 diff --git a/src/serial/psb_zipcoo2csc.f90 b/base/serial/psb_zipcoo2csc.f90 similarity index 100% rename from src/serial/psb_zipcoo2csc.f90 rename to base/serial/psb_zipcoo2csc.f90 diff --git a/src/serial/psb_zipcoo2csr.f90 b/base/serial/psb_zipcoo2csr.f90 similarity index 100% rename from src/serial/psb_zipcoo2csr.f90 rename to base/serial/psb_zipcoo2csr.f90 diff --git a/src/serial/psb_zipcsr2coo.f90 b/base/serial/psb_zipcsr2coo.f90 similarity index 100% rename from src/serial/psb_zipcsr2coo.f90 rename to base/serial/psb_zipcsr2coo.f90 diff --git a/src/serial/psb_zneigh.f90 b/base/serial/psb_zneigh.f90 similarity index 100% rename from src/serial/psb_zneigh.f90 rename to base/serial/psb_zneigh.f90 diff --git a/src/serial/psb_znumbmm.f90 b/base/serial/psb_znumbmm.f90 similarity index 100% rename from src/serial/psb_znumbmm.f90 rename to base/serial/psb_znumbmm.f90 diff --git a/src/serial/psb_zrwextd.f90 b/base/serial/psb_zrwextd.f90 similarity index 100% rename from src/serial/psb_zrwextd.f90 rename to base/serial/psb_zrwextd.f90 diff --git a/src/serial/psb_zspgetrow.f90 b/base/serial/psb_zspgetrow.f90 similarity index 100% rename from src/serial/psb_zspgetrow.f90 rename to base/serial/psb_zspgetrow.f90 diff --git a/src/serial/psb_zspgtblk.f90 b/base/serial/psb_zspgtblk.f90 similarity index 100% rename from src/serial/psb_zspgtblk.f90 rename to base/serial/psb_zspgtblk.f90 diff --git a/src/serial/psb_zspgtdiag.f90 b/base/serial/psb_zspgtdiag.f90 similarity index 100% rename from src/serial/psb_zspgtdiag.f90 rename to base/serial/psb_zspgtdiag.f90 diff --git a/src/serial/psb_zspscal.f90 b/base/serial/psb_zspscal.f90 similarity index 100% rename from src/serial/psb_zspscal.f90 rename to base/serial/psb_zspscal.f90 diff --git a/src/serial/psb_zsymbmm.f90 b/base/serial/psb_zsymbmm.f90 similarity index 100% rename from src/serial/psb_zsymbmm.f90 rename to base/serial/psb_zsymbmm.f90 diff --git a/src/serial/psb_ztransc.f90 b/base/serial/psb_ztransc.f90 similarity index 100% rename from src/serial/psb_ztransc.f90 rename to base/serial/psb_ztransc.f90 diff --git a/src/serial/psb_ztransp.f90 b/base/serial/psb_ztransp.f90 similarity index 100% rename from src/serial/psb_ztransp.f90 rename to base/serial/psb_ztransp.f90 diff --git a/src/tools/Makefile b/base/tools/Makefile similarity index 100% rename from src/tools/Makefile rename to base/tools/Makefile diff --git a/src/tools/psb_cd_inloc.f90 b/base/tools/psb_cd_inloc.f90 similarity index 100% rename from src/tools/psb_cd_inloc.f90 rename to base/tools/psb_cd_inloc.f90 diff --git a/src/tools/psb_cdall.f90 b/base/tools/psb_cdall.f90 similarity index 100% rename from src/tools/psb_cdall.f90 rename to base/tools/psb_cdall.f90 diff --git a/src/tools/psb_cdalv.f90 b/base/tools/psb_cdalv.f90 similarity index 100% rename from src/tools/psb_cdalv.f90 rename to base/tools/psb_cdalv.f90 diff --git a/src/tools/psb_cdasb.f90 b/base/tools/psb_cdasb.f90 similarity index 100% rename from src/tools/psb_cdasb.f90 rename to base/tools/psb_cdasb.f90 diff --git a/src/tools/psb_cdcpy.f90 b/base/tools/psb_cdcpy.f90 similarity index 100% rename from src/tools/psb_cdcpy.f90 rename to base/tools/psb_cdcpy.f90 diff --git a/src/tools/psb_cddec.f90 b/base/tools/psb_cddec.f90 similarity index 100% rename from src/tools/psb_cddec.f90 rename to base/tools/psb_cddec.f90 diff --git a/src/tools/psb_cdfree.f90 b/base/tools/psb_cdfree.f90 similarity index 100% rename from src/tools/psb_cdfree.f90 rename to base/tools/psb_cdfree.f90 diff --git a/src/tools/psb_cdins.f90 b/base/tools/psb_cdins.f90 similarity index 100% rename from src/tools/psb_cdins.f90 rename to base/tools/psb_cdins.f90 diff --git a/src/tools/psb_cdprt.f90 b/base/tools/psb_cdprt.f90 similarity index 100% rename from src/tools/psb_cdprt.f90 rename to base/tools/psb_cdprt.f90 diff --git a/src/tools/psb_cdren.f90 b/base/tools/psb_cdren.f90 similarity index 100% rename from src/tools/psb_cdren.f90 rename to base/tools/psb_cdren.f90 diff --git a/src/tools/psb_cdrep.f90 b/base/tools/psb_cdrep.f90 similarity index 100% rename from src/tools/psb_cdrep.f90 rename to base/tools/psb_cdrep.f90 diff --git a/src/tools/psb_cdtransfer.f90 b/base/tools/psb_cdtransfer.f90 similarity index 100% rename from src/tools/psb_cdtransfer.f90 rename to base/tools/psb_cdtransfer.f90 diff --git a/src/tools/psb_dallc.f90 b/base/tools/psb_dallc.f90 similarity index 100% rename from src/tools/psb_dallc.f90 rename to base/tools/psb_dallc.f90 diff --git a/src/tools/psb_dasb.f90 b/base/tools/psb_dasb.f90 similarity index 100% rename from src/tools/psb_dasb.f90 rename to base/tools/psb_dasb.f90 diff --git a/src/tools/psb_dcdovr.f90 b/base/tools/psb_dcdovr.f90 similarity index 100% rename from src/tools/psb_dcdovr.f90 rename to base/tools/psb_dcdovr.f90 diff --git a/src/tools/psb_dcsrp.f90 b/base/tools/psb_dcsrp.f90 similarity index 100% rename from src/tools/psb_dcsrp.f90 rename to base/tools/psb_dcsrp.f90 diff --git a/src/tools/psb_dfree.f90 b/base/tools/psb_dfree.f90 similarity index 100% rename from src/tools/psb_dfree.f90 rename to base/tools/psb_dfree.f90 diff --git a/src/tools/psb_dgelp.f90 b/base/tools/psb_dgelp.f90 similarity index 100% rename from src/tools/psb_dgelp.f90 rename to base/tools/psb_dgelp.f90 diff --git a/src/tools/psb_dins.f90 b/base/tools/psb_dins.f90 similarity index 100% rename from src/tools/psb_dins.f90 rename to base/tools/psb_dins.f90 diff --git a/src/tools/psb_dspalloc.f90 b/base/tools/psb_dspalloc.f90 similarity index 100% rename from src/tools/psb_dspalloc.f90 rename to base/tools/psb_dspalloc.f90 diff --git a/src/tools/psb_dspasb.f90 b/base/tools/psb_dspasb.f90 similarity index 100% rename from src/tools/psb_dspasb.f90 rename to base/tools/psb_dspasb.f90 diff --git a/src/tools/psb_dspcnv.f90 b/base/tools/psb_dspcnv.f90 similarity index 100% rename from src/tools/psb_dspcnv.f90 rename to base/tools/psb_dspcnv.f90 diff --git a/src/tools/psb_dspfree.f90 b/base/tools/psb_dspfree.f90 similarity index 100% rename from src/tools/psb_dspfree.f90 rename to base/tools/psb_dspfree.f90 diff --git a/src/tools/psb_dsphalo.f90 b/base/tools/psb_dsphalo.f90 similarity index 100% rename from src/tools/psb_dsphalo.f90 rename to base/tools/psb_dsphalo.f90 diff --git a/src/tools/psb_dspins.f90 b/base/tools/psb_dspins.f90 similarity index 100% rename from src/tools/psb_dspins.f90 rename to base/tools/psb_dspins.f90 diff --git a/src/tools/psb_dsprn.f90 b/base/tools/psb_dsprn.f90 similarity index 100% rename from src/tools/psb_dsprn.f90 rename to base/tools/psb_dsprn.f90 diff --git a/src/tools/psb_get_overlap.f90 b/base/tools/psb_get_overlap.f90 similarity index 100% rename from src/tools/psb_get_overlap.f90 rename to base/tools/psb_get_overlap.f90 diff --git a/src/tools/psb_glob_to_loc.f90 b/base/tools/psb_glob_to_loc.f90 similarity index 100% rename from src/tools/psb_glob_to_loc.f90 rename to base/tools/psb_glob_to_loc.f90 diff --git a/src/tools/psb_ialloc.f90 b/base/tools/psb_ialloc.f90 similarity index 100% rename from src/tools/psb_ialloc.f90 rename to base/tools/psb_ialloc.f90 diff --git a/src/tools/psb_iasb.f90 b/base/tools/psb_iasb.f90 similarity index 100% rename from src/tools/psb_iasb.f90 rename to base/tools/psb_iasb.f90 diff --git a/src/tools/psb_ifree.f90 b/base/tools/psb_ifree.f90 similarity index 100% rename from src/tools/psb_ifree.f90 rename to base/tools/psb_ifree.f90 diff --git a/src/tools/psb_iins.f90 b/base/tools/psb_iins.f90 similarity index 100% rename from src/tools/psb_iins.f90 rename to base/tools/psb_iins.f90 diff --git a/src/tools/psb_loc_to_glob.f90 b/base/tools/psb_loc_to_glob.f90 similarity index 100% rename from src/tools/psb_loc_to_glob.f90 rename to base/tools/psb_loc_to_glob.f90 diff --git a/src/tools/psb_zallc.f90 b/base/tools/psb_zallc.f90 similarity index 100% rename from src/tools/psb_zallc.f90 rename to base/tools/psb_zallc.f90 diff --git a/src/tools/psb_zasb.f90 b/base/tools/psb_zasb.f90 similarity index 100% rename from src/tools/psb_zasb.f90 rename to base/tools/psb_zasb.f90 diff --git a/src/tools/psb_zcdovr.f90 b/base/tools/psb_zcdovr.f90 similarity index 100% rename from src/tools/psb_zcdovr.f90 rename to base/tools/psb_zcdovr.f90 diff --git a/src/tools/psb_zcsrp.f90 b/base/tools/psb_zcsrp.f90 similarity index 100% rename from src/tools/psb_zcsrp.f90 rename to base/tools/psb_zcsrp.f90 diff --git a/src/tools/psb_zfree.f90 b/base/tools/psb_zfree.f90 similarity index 100% rename from src/tools/psb_zfree.f90 rename to base/tools/psb_zfree.f90 diff --git a/src/tools/psb_zgelp.f90 b/base/tools/psb_zgelp.f90 similarity index 100% rename from src/tools/psb_zgelp.f90 rename to base/tools/psb_zgelp.f90 diff --git a/src/tools/psb_zins.f90 b/base/tools/psb_zins.f90 similarity index 100% rename from src/tools/psb_zins.f90 rename to base/tools/psb_zins.f90 diff --git a/src/tools/psb_zspalloc.f90 b/base/tools/psb_zspalloc.f90 similarity index 100% rename from src/tools/psb_zspalloc.f90 rename to base/tools/psb_zspalloc.f90 diff --git a/src/tools/psb_zspasb.f90 b/base/tools/psb_zspasb.f90 similarity index 100% rename from src/tools/psb_zspasb.f90 rename to base/tools/psb_zspasb.f90 diff --git a/src/tools/psb_zspcnv.f90 b/base/tools/psb_zspcnv.f90 similarity index 100% rename from src/tools/psb_zspcnv.f90 rename to base/tools/psb_zspcnv.f90 diff --git a/src/tools/psb_zspfree.f90 b/base/tools/psb_zspfree.f90 similarity index 100% rename from src/tools/psb_zspfree.f90 rename to base/tools/psb_zspfree.f90 diff --git a/src/tools/psb_zsphalo.f90 b/base/tools/psb_zsphalo.f90 similarity index 100% rename from src/tools/psb_zsphalo.f90 rename to base/tools/psb_zsphalo.f90 diff --git a/src/tools/psb_zspins.f90 b/base/tools/psb_zspins.f90 similarity index 100% rename from src/tools/psb_zspins.f90 rename to base/tools/psb_zspins.f90 diff --git a/src/tools/psb_zsprn.f90 b/base/tools/psb_zsprn.f90 similarity index 100% rename from src/tools/psb_zsprn.f90 rename to base/tools/psb_zsprn.f90 diff --git a/baseprec/Makefile b/baseprec/Makefile new file mode 100644 index 00000000..61093e61 --- /dev/null +++ b/baseprec/Makefile @@ -0,0 +1,39 @@ +include ../Make.inc + +LIBDIR=../lib +HERE=. +MODOBJS= psb_prec_type.o psb_prec_mod.o +F90OBJS= psb_dilu_bld.o psb_dilu_fct.o\ + psb_dsp_renum.o\ + psb_dprecbld.o psb_dprecfree.o psb_dprecset.o \ + psb_dbaseprc_bld.o psb_ddiagsc_bld.o \ + psb_dprc_aply.o \ + psb_dbaseprc_aply.o psb_dbjac_aply.o\ + psb_zilu_bld.o psb_zilu_fct.o\ + psb_zsp_renum.o\ + psb_zprecbld.o psb_zprecfree.o psb_zprecset.o \ + psb_zbaseprc_bld.o psb_zdiagsc_bld.o \ + psb_zprc_aply.o psb_zbaseprc_aply.o psb_zbjac_aply.o + +LIBMOD=psb_prec_mod$(.mod) +LOCAL_MODS=$(MODOBJS:.o=$(.mod)) +LIBNAME=$(PRECLIBNAME) +COBJS= +INCDIRS=-I. -I$(LIBDIR) +OBJS=$(F90OBJS) $(COBJS) $(MPFOBJS) $(MODOBJS) + +lib: $(OBJS) + $(AR) $(HERE)/$(LIBNAME) $(OBJS) + $(RANLIB) $(HERE)/$(LIBNAME) + /bin/cp $(HERE)/$(LIBNAME) $(LIBDIR) + /bin/cp $(LIBMOD) $(LIBDIR) + +$(F90OBJS): $(MODOBJS) +psb_prec_mod.o: psb_prec_type.o + +veryclean: clean + /bin/rm -f $(LIBNAME) + +clean: + /bin/rm -f $(OBJS) $(LOCAL_MODS) + diff --git a/baseprec/psb_dbaseprc_aply.f90 b/baseprec/psb_dbaseprc_aply.f90 new file mode 100644 index 00000000..475dea0b --- /dev/null +++ b/baseprec/psb_dbaseprc_aply.f90 @@ -0,0 +1,150 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) + ! + ! Compute Y <- beta*Y + alpha*K^-1 X + ! where K is a a basic preconditioner stored in prec + ! + + use psb_base_mod + use psb_prec_type + implicit none + + type(psb_desc_type),intent(in) :: desc_data + type(psb_dbaseprc_type), intent(in) :: prec + real(kind(0.d0)),intent(inout) :: x(:), y(:) + real(kind(0.d0)),intent(in) :: alpha,beta + character(len=1) :: trans + real(kind(0.d0)),target :: work(:) + integer, intent(out) :: info + + ! Local variables + integer :: n_row,n_col, int_err(5) + real(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:) + character ::diagl, diagu + integer :: ictxt,np,me,i, isz, nrg, err_act + real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime + logical,parameter :: debug=.false., debugprt=.false. + external mpi_wtime + character(len=20) :: name, ch_err + + interface psb_bjac_aply + subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) + use psb_base_mod + use psb_prec_type + type(psb_desc_type), intent(in) :: desc_data + type(psb_dbaseprc_type), intent(in) :: prec + real(kind(0.d0)),intent(inout) :: x(:), y(:) + real(kind(0.d0)),intent(in) :: alpha,beta + character(len=1) :: trans + real(kind(0.d0)),target :: work(:) + integer, intent(out) :: info + end subroutine psb_dbjac_aply + end interface + + name='psb_baseprc_aply' + info = 0 + call psb_erractionsave(err_act) + + ictxt=desc_data%matrix_data(psb_ctxt_) + call psb_info(ictxt, me, np) + + diagl='U' + diagu='U' + + select case(trans) + case('N','n') + case('T','t','C','c') + case default + info=40 + int_err(1)=6 + ch_err(2:2)=trans + goto 9999 + end select + + select case(prec%iprcparm(p_type_)) + + case(noprec_) + + call psb_geaxpby(alpha,x,beta,y,desc_data,info) + + case(diagsc_) + + if (size(work) >= size(x)) then + ww => work + else + allocate(ww(size(x)),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + end if + + n_row=desc_data%matrix_data(psb_n_row_) + ww(1:n_row) = x(1:n_row)*prec%d(1:n_row) + call psb_geaxpby(alpha,ww,beta,y,desc_data,info) + + if (size(work) < size(x)) then + deallocate(ww,stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Deallocate') + goto 9999 + end if + end if + + case(bja_) + + call psb_bjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) + if(info.ne.0) then + info=4010 + ch_err='psb_bjac_aply' + goto 9999 + end if + + case default + write(0,*) 'Invalid PRE%PREC ',prec%iprcparm(p_type_),':',& + & min_prec_,noprec_,diagsc_,bja_ + end select + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_errpush(info,name,i_err=int_err,a_err=ch_err) + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +end subroutine psb_dbaseprc_aply + diff --git a/baseprec/psb_dbaseprc_bld.f90 b/baseprec/psb_dbaseprc_bld.f90 new file mode 100644 index 00000000..6bb162ca --- /dev/null +++ b/baseprec/psb_dbaseprc_bld.f90 @@ -0,0 +1,205 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd) + + use psb_base_mod + use psb_prec_type + Implicit None + + type(psb_dspmat_type), target :: a + type(psb_desc_type), intent(in), target :: desc_a + type(psb_dbaseprc_type),intent(inout) :: p + integer, intent(out) :: info + character, intent(in), optional :: upd + + interface psb_diagsc_bld + subroutine psb_ddiagsc_bld(a,desc_data,p,upd,info) + use psb_base_mod + use psb_prec_type + integer, intent(out) :: info + type(psb_dspmat_type), intent(in), target :: a + type(psb_desc_type),intent(in) :: desc_data + type(psb_dbaseprc_type), intent(inout) :: p + character, intent(in) :: upd + end subroutine psb_ddiagsc_bld + end interface + + interface psb_ilu_bld + subroutine psb_dilu_bld(a,desc_data,p,upd,info) + use psb_base_mod + use psb_prec_type + integer, intent(out) :: info + type(psb_dspmat_type), intent(in), target :: a + type(psb_desc_type),intent(in) :: desc_data + type(psb_dbaseprc_type), intent(inout) :: p + character, intent(in) :: upd + end subroutine psb_dilu_bld + end interface + + ! Local scalars + Integer :: err, nnzero, n_row, n_col,I,j,k,ictxt,& + & me,mycol,np,npcol,mglob,lw, mtype, nrg, nzg, err_act + real(kind(1.d0)) :: temp, real_err(5) + real(kind(1.d0)),pointer :: gd(:), work(:) + integer :: int_err(5) + character :: iupd + + logical, parameter :: debug=.false. + integer,parameter :: iroot=0,iout=60,ilout=40 + character(len=20) :: name, ch_err + + if(psb_get_errstatus().ne.0) return + info=0 + err=0 + call psb_erractionsave(err_act) + name = 'psb_baseprc_bld' + + if (debug) write(0,*) 'Entering baseprc_bld' + info = 0 + int_err(1) = 0 + ictxt = psb_cd_get_context(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) + + if (debug) write(0,*) 'Preconditioner Blacs_gridinfo' + call psb_info(ictxt, me, np) + + if (present(upd)) then + if (debug) write(0,*) 'UPD ', upd + if ((UPD.eq.'F').or.(UPD.eq.'T')) then + IUPD=UPD + else + IUPD='F' + endif + else + IUPD='F' + endif + + ! + ! Should add check to ensure all procs have the same... + ! + ! ALso should define symbolic names for the preconditioners. + ! + + call psb_check_def(p%iprcparm(p_type_),'base_prec',& + & diagsc_,is_legal_base_prec) + + call psb_nullify_desc(p%desc_data) + + select case(p%iprcparm(p_type_)) + case (noprec_) + ! Do nothing. + call psb_cdcpy(desc_a,p%desc_data,info) + if(info /= 0) then + info=4010 + ch_err='psb_cdcpy' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + case (diagsc_) + + call psb_diagsc_bld(a,desc_a,p,iupd,info) + if(debug) write(0,*)me,': out of psb_diagsc_bld' + if(info /= 0) then + info=4010 + ch_err='psb_diagsc_bld' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + case (bja_) + + call psb_check_def(p%iprcparm(iren_),'renumbering',& + & renum_none_,is_legal_renum) + call psb_check_def(p%iprcparm(f_type_),'fact',& + & f_ilu_n_,is_legal_ml_fact) + + if (debug) write(0,*)me, ': Calling PSB_ILU_BLD' + if (debug) call psb_barrier(ictxt) + call psb_cdcpy(desc_a,p%desc_data,info) + if(info /= 0) then + info=4010 + ch_err='psb_cdcpy' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + select case(p%iprcparm(f_type_)) + + case(f_ilu_n_,f_ilu_e_) + call psb_ilu_bld(a,desc_a,p,iupd,info) + if(debug) write(0,*)me,': out of psb_ilu_bld' + if (debug) call psb_barrier(ictxt) + if(info /= 0) then + info=4010 + ch_err='psb_ilu_bld' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + case(f_none_) + write(0,*) 'Fact=None in BASEPRC_BLD Bja/ASM??' + info=4010 + ch_err='Inconsistent prec f_none_' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + + case default + write(0,*) 'Unknown factor type in baseprc_bld bja/asm: ',& + &p%iprcparm(f_type_) + info=4010 + ch_err='Unknown f_type_' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end select + case default + info=4010 + ch_err='Unknown p_type_' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + + end select + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +end subroutine psb_dbaseprc_bld + diff --git a/baseprec/psb_dbjac_aply.f90 b/baseprec/psb_dbjac_aply.f90 new file mode 100644 index 00000000..67d74288 --- /dev/null +++ b/baseprec/psb_dbjac_aply.f90 @@ -0,0 +1,211 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) + ! + ! Compute Y <- beta*Y + alpha*K^-1 X + ! where K is a a Block Jacobi preconditioner stored in prec + ! Note that desc_data may or may not be the same as prec%desc_data, + ! but since both are INTENT(IN) this should be legal. + ! + + use psb_base_mod + use psb_prec_type + implicit none + + type(psb_desc_type), intent(in) :: desc_data + type(psb_dbaseprc_type), intent(in) :: prec + real(kind(0.d0)),intent(inout) :: x(:), y(:) + real(kind(0.d0)),intent(in) :: alpha,beta + character(len=1) :: trans + real(kind(0.d0)),target :: work(:) + integer, intent(out) :: info + + ! Local variables + integer :: n_row,n_col + real(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:),tb(:) + character ::diagl, diagu + integer :: ictxt,np,me,i, nrg, err_act, int_err(5) + real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime + logical,parameter :: debug=.false., debugprt=.false. + external mpi_wtime + character(len=20) :: name, ch_err + + name='psb_bjac_aply' + info = 0 + call psb_erractionsave(err_act) + + ictxt=psb_cd_get_context(desc_data) + call psb_info(ictxt, me, np) + + diagl='U' + diagu='U' + + select case(trans) + case('N','n') + case('T','t','C','c') + case default + call psb_errpush(40,name) + goto 9999 + end select + + + n_row=desc_data%matrix_data(psb_n_row_) + n_col=desc_data%matrix_data(psb_n_col_) + + if (n_col <= size(work)) then + ww => work(1:n_col) + if ((4*n_col+n_col) <= size(work)) then + aux => work(n_col+1:) + else + allocate(aux(4*n_col),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + endif + else + allocate(ww(n_col),aux(4*n_col),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + endif + + + if (prec%iprcparm(jac_sweeps_) == 1) then + + + select case(prec%iprcparm(f_type_)) + case(f_ilu_n_,f_ilu_e_) + + select case(trans) + case('N','n') + + call psb_spsm(done,prec%av(l_pr_),x,dzero,ww,desc_data,info,& + & trans='N',unit=diagl,choice=psb_none_,work=aux) + if(info /=0) goto 9999 + ww(1:n_row) = ww(1:n_row)*prec%d(1:n_row) + call psb_spsm(alpha,prec%av(u_pr_),ww,beta,y,desc_data,info,& + & trans='N',unit=diagu,choice=psb_none_, work=aux) + if(info /=0) goto 9999 + + case('T','t','C','c') + call psb_spsm(done,prec%av(u_pr_),x,dzero,ww,desc_data,info,& + & trans=trans,unit=diagu,choice=psb_none_, work=aux) + if(info /=0) goto 9999 + ww(1:n_row) = ww(1:n_row)*prec%d(1:n_row) + call psb_spsm(alpha,prec%av(l_pr_),ww,beta,y,desc_data,info,& + & trans=trans,unit=diagl,choice=psb_none_,work=aux) + if(info /=0) goto 9999 + + end select + + + case default + write(0,*) 'Unknown factorization type in bjac_aply',prec%iprcparm(f_type_) + end select + if (debugprt) write(0,*)' Y: ',y(:) + + else if (prec%iprcparm(jac_sweeps_) > 1) then + + ! Note: we have to add TRANS to this one !!!!!!!!! + + if (size(prec%av) < ap_nd_) then + info = 4011 + goto 9999 + endif + + allocate(tx(n_col),ty(n_col),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + tx = dzero + ty = dzero + select case(prec%iprcparm(f_type_)) + case(f_ilu_n_,f_ilu_e_) + do i=1, prec%iprcparm(jac_sweeps_) + ! X(k+1) = M^-1*(b-N*X(k)) + ty(1:n_row) = x(1:n_row) + call psb_spmm(-done,prec%av(ap_nd_),tx,done,ty,& + & prec%desc_data,info,work=aux) + if(info /=0) goto 9999 + call psb_spsm(done,prec%av(l_pr_),ty,dzero,ww,& + & prec%desc_data,info,& + & trans='N',unit='U',choice=psb_none_,work=aux) + if(info /=0) goto 9999 + ww(1:n_row) = ww(1:n_row)*prec%d(1:n_row) + call psb_spsm(done,prec%av(u_pr_),ww,dzero,tx,& + & prec%desc_data,info,& + & trans='N',unit='U',choice=psb_none_,work=aux) + if(info /=0) goto 9999 + end do + + end select + + call psb_geaxpby(alpha,tx,beta,y,desc_data,info) + + + deallocate(tx,ty) + + + else + + goto 9999 + + endif + + if (n_col <= size(work)) then + if ((4*n_col+n_col) <= size(work)) then + else + deallocate(aux) + endif + else + deallocate(ww,aux) + endif + + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_errpush(info,name,i_err=int_err,a_err=ch_err) + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +end subroutine psb_dbjac_aply + diff --git a/baseprec/psb_ddiagsc_bld.f90 b/baseprec/psb_ddiagsc_bld.f90 new file mode 100644 index 00000000..1029cdbe --- /dev/null +++ b/baseprec/psb_ddiagsc_bld.f90 @@ -0,0 +1,163 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_ddiagsc_bld(a,desc_a,p,upd,info) + + use psb_base_mod + use psb_prec_type + Implicit None + + type(psb_dspmat_type), target :: a + type(psb_desc_type), intent(in) :: desc_a + type(psb_dbaseprc_type),intent(inout) :: p + character, intent(in) :: upd + integer, intent(out) :: info + + + ! Local scalars + Integer :: err, n_row, n_col,I,j,k,ictxt,& + & me,np,mglob,lw, err_act + real(kind(1.d0)),allocatable :: gd(:), work(:) + integer :: int_err(5) + character :: iupd + + logical, parameter :: debug=.false. + integer,parameter :: iroot=0,iout=60,ilout=40 + character(len=20) :: name, ch_err + + if(psb_get_errstatus().ne.0) return + info=0 + err=0 + call psb_erractionsave(err_act) + name = 'psb_diagsc_bld' + + if (debug) write(0,*) 'Entering diagsc_bld' + info = 0 + int_err(1) = 0 + ictxt = psb_cd_get_context(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) + + if (debug) write(0,*) 'Preconditioner Blacs_gridinfo' + call psb_info(ictxt, me, np) + + if (debug) write(0,*) 'Precond: Diagonal scaling' + ! diagonal scaling + + call psb_realloc(n_col,p%d,info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='psb_realloc') + goto 9999 + end if + + call psb_csrws(p%d,a,info,trans='N') + if(info /= 0) then + info=4010 + ch_err='psb_csrws' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + call psb_cdcpy(desc_a,p%desc_Data,info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='psb_cdcpy') + goto 9999 + end if + + if (debug) write(ilout+me,*) 'VDIAG ',n_row + do i=1,n_row + if (p%d(i).eq.dzero) then + p%d(i) = done + else + p%d(i) = done/p%d(i) + endif + + if (debug) write(ilout+me,*) i,desc_a%loc_to_glob(i), p%d(i) + if (p%d(i).lt.0.d0) then + write(0,*) me,'Negative RWS? ',i,p%d(i) + endif + end do + if (a%pl(1) /= 0) then + allocate(work(n_row),stat=info) + if (info /= 0) then + info=4000 + call psb_errpush(info,name) + goto 9999 + end if + call psb_gelp('n',a%pl,p%d,desc_a,info) + if(info /= 0) then + info=4010 + ch_err='psb_dgelp' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + deallocate(work) + endif + + if (debug) then + allocate(gd(mglob),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + call psb_gather(gd, p%d, desc_a, info, iroot=iroot) + if(info /= 0) then + info=4010 + ch_err='psb_dgatherm' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (me.eq.iroot) then + write(iout+np,*) 'VDIAG CHECK ',mglob + do i=1,mglob + write(iout+np,*) i,gd(i) + enddo + endif + deallocate(gd) + endif + if (debug) write(*,*) 'Preconditioner DIAG computed OK' + + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +end subroutine psb_ddiagsc_bld + diff --git a/baseprec/psb_dilu_bld.f90 b/baseprec/psb_dilu_bld.f90 new file mode 100644 index 00000000..c17f4e51 --- /dev/null +++ b/baseprec/psb_dilu_bld.f90 @@ -0,0 +1,284 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_dilu_bld(a,desc_a,p,upd,info) + use psb_base_mod + use psb_prec_type + implicit none + ! + ! .. Scalar Arguments .. + integer, intent(out) :: info + ! .. array Arguments .. + type(psb_dspmat_type), intent(in), target :: a + type(psb_dbaseprc_type), intent(inout) :: p + type(psb_desc_type), intent(in) :: desc_a + character, intent(in) :: upd + + ! .. Local Scalars .. + integer :: i, j, jj, k, kk, m + integer :: int_err(5) + character :: trans, unitd + type(psb_dspmat_type) :: blck, atmp + real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,mpi_wtime, t7, t8 + external mpi_wtime + logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false. + integer nztota, nztotb, nztmp, nzl, nnr, ir, err_act,& + & n_row, nrow_a,n_col, nhalo, ind, iind, i1,i2,ia + integer :: ictxt,np,me + character(len=20) :: name, ch_err + + interface psb_ilu_fct + subroutine psb_dilu_fct(a,l,u,d,info,blck) + use psb_base_mod + integer, intent(out) :: info + type(psb_dspmat_type),intent(in) :: a + type(psb_dspmat_type),intent(inout) :: l,u + type(psb_dspmat_type),intent(in), optional, target :: blck + real(kind(1.d0)), intent(inout) :: d(:) + end subroutine psb_dilu_fct + end interface + + interface psb_sp_renum + subroutine psb_dsp_renum(a,desc_a,p,atmp,info) + use psb_base_mod + use psb_prec_type + implicit none + + ! .. array Arguments .. + type(psb_dspmat_type), intent(in) :: a + type(psb_dspmat_type), intent(inout) :: atmp + type(psb_dbaseprc_type), intent(inout) :: p + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psb_dsp_renum + end interface + + if(psb_get_errstatus().ne.0) return + info=0 + name='psb_ilu_bld' + call psb_erractionsave(err_act) + + ictxt=psb_cd_get_context(desc_a) + call psb_info(ictxt, me, np) + + m = a%m + if (m < 0) then + info = 10 + int_err(1) = 1 + int_err(2) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + trans = 'N' + unitd = 'U' + call psb_nullify_sp(atmp) + + if (allocated(p%av)) then + if (size(p%av) < bp_ilu_avsz) then + call psb_errpush(4010,name,a_err='Insufficient av size') + goto 9999 + endif + else + call psb_errpush(4010,name,a_err='AV not associated') + goto 9999 + endif +!!$ call psb_csprt(50+me,a,head='% (A)') + + nrow_a = psb_cd_get_local_rows(desc_a) + nztota = psb_sp_get_nnzeros(a) + if (debug) write(0,*)me,': out get_nnzeros',nztota + if (debug) call psb_barrier(ictxt) + + n_col = psb_cd_get_local_cols(desc_a) + nhalo = n_col-nrow_a + n_row = p%desc_data%matrix_data(psb_n_row_) + p%av(l_pr_)%m = n_row + p%av(l_pr_)%k = n_row + p%av(u_pr_)%m = n_row + p%av(u_pr_)%k = n_row + call psb_sp_all(n_row,n_row,p%av(l_pr_),nztota,info) + if (info == 0) call psb_sp_all(n_row,n_row,p%av(u_pr_),nztota,info) + if(info/=0) then + info=4010 + ch_err='psb_sp_all' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (allocated(p%d)) then + if (size(p%d) < n_row) then + deallocate(p%d) + endif + endif + if (.not.allocated(p%d)) then + allocate(p%d(n_row),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + endif + + if (p%iprcparm(iren_) > 0) then + + ! + ! Here we allocate a full copy to hold local A and received BLK + ! + + nztota = psb_sp_get_nnzeros(a) + call psb_sp_all(atmp,nztota,info) + if(info/=0) then + info=4011 + call psb_errpush(info,name) + goto 9999 + end if + + + ! write(0,*) 'ILU_BLD ',nztota,nztotb,a%m + + call psb_sp_renum(a,desc_a,p,atmp,info) + + if(info/=0) then + info=4010 + ch_err='psb_sp_renum' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + t3 = mpi_wtime() + if (debugprt) then + call psb_barrier(ictxt) + open(40+me) + call psb_csprt(40+me,atmp,head='% Local matrix') + close(40+me) + endif + if (debug) write(0,*) me,' Factoring rows ',& + &atmp%m,a%m,atmp%ia2(atmp%m+1)-1 + + ! + ! Ok, factor the matrix. + ! + t5 = mpi_wtime() + blck%m=0 + call psb_ilu_fct(atmp,p%av(l_pr_),p%av(u_pr_),p%d,info) + if(info/=0) then + info=4010 + ch_err='psb_ilu_fct' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + call psb_sp_free(atmp,info) + if(info/=0) then + info=4010 + ch_err='psb_sp_free' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + + else if (p%iprcparm(iren_) == 0) then + t3 = mpi_wtime() + ! This is where we have mo renumbering, thus no need + ! for ATMP + + if (debugprt) then + open(40+me) + call psb_barrier(ictxt) + call psb_csprt(40+me,a,iv=p%desc_data%loc_to_glob,& + & head='% Local matrix') + close(40+me) + endif + + t5= mpi_wtime() + if (debug) write(0,*) me,' Going for ilu_fct' + if (debug) call psb_barrier(ictxt) + call psb_ilu_fct(a,p%av(l_pr_),p%av(u_pr_),p%d,info) + if(info/=0) then + info=4010 + ch_err='psb_ilu_fct' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + if (debug) write(0,*) me,' Done dilu_fct' + endif + + + if (debugprt) then + ! + ! Print out the factors on file. + ! + open(80+me) + + call psb_csprt(80+me,p%av(l_pr_),head='% Local L factor') + write(80+me,*) '% Diagonal: ',p%av(l_pr_)%m + do i=1,p%av(l_pr_)%m + write(80+me,*) i,i,p%d(i) + enddo + call psb_csprt(80+me,p%av(u_pr_),head='% Local U factor') + + close(80+me) + endif + + + ! ierr = MPE_Log_event( ifcte, 0, "st SIMPLE" ) + t6 = mpi_wtime() + ! + ! write(0,'(i3,1x,a,3(1x,g18.9))') me,'renum/factor time',t3-t2,t6-t5 + ! if (me==0) write(0,'(a,3(1x,g18.9))') 'renum/factor time',t3-t2,t6-t5 + + if (psb_sp_getifld(psb_upd_,p%av(u_pr_),info) /= psb_upd_perm_) then + call psb_sp_trimsize(p%av(u_pr_),i1,i2,ia,info) + if (info == 0) call psb_sp_reall(p%av(u_pr_),i1,i2,ia,info) + endif + + if (psb_sp_getifld(psb_upd_,p%av(l_pr_),info) /= psb_upd_perm_) then + call psb_sp_trimsize(p%av(l_pr_),i1,i2,ia,info) + if (info == 0) call psb_sp_reall(p%av(l_pr_),i1,i2,ia,info) + endif + + + if (debug) write(0,*) me,'End of ilu_bld' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + + +end subroutine psb_dilu_bld + + diff --git a/baseprec/psb_dilu_fct.f90 b/baseprec/psb_dilu_fct.f90 new file mode 100644 index 00000000..e9eeb106 --- /dev/null +++ b/baseprec/psb_dilu_fct.f90 @@ -0,0 +1,469 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_dilu_fct(a,l,u,d,info,blck) + + ! + ! This routine copies and factors "on the fly" from A and BLCK + ! into L/D/U. + ! + ! + use psb_base_mod + implicit none + ! .. Scalar Arguments .. + integer, intent(out) :: info + ! .. Array Arguments .. + type(psb_dspmat_type),intent(in) :: a + type(psb_dspmat_type),intent(inout) :: l,u + type(psb_dspmat_type),intent(in), optional, target :: blck + real(kind(1.d0)), intent(inout) :: d(:) + ! .. Local Scalars .. + real(kind(1.d0)) :: dia, temp + integer :: i, j, jj, k, kk, l1, l2, ll, low1, low2,m,ma,err_act + + type(psb_dspmat_type), pointer :: blck_ + character(len=20) :: name, ch_err + logical, parameter :: debug=.false. + name='psb_dcsrlu' + info = 0 + call psb_erractionsave(err_act) + ! .. Executable Statements .. + ! + + if (present(blck)) then + blck_ => blck + else + allocate(blck_,stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + call psb_nullify_sp(blck_) ! Why do we need this? Who knows.... + call psb_sp_all(0,0,blck_,1,info) + if(info.ne.0) then + info=4010 + ch_err='psb_sp_all' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + blck_%m=0 + endif + +!!$ write(0,*) 'ilu_fct: ',size(l%ia2),size(u%ia2),a%m,blck_%m + call psb_dilu_fctint(m,a%m,a,blck_%m,blck_,& + & d,l%aspk,l%ia1,l%ia2,u%aspk,u%ia1,u%ia2,l1,l2,info) + if(info.ne.0) then + info=4010 + ch_err='psb_dilu_fctint' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + l%infoa(1) = l1 + l%fida = 'CSR' + l%descra = 'TLU' + u%infoa(1) = l2 + u%fida = 'CSR' + u%descra = 'TUU' + l%m = m + l%k = m + u%m = m + u%k = m + if (present(blck)) then + blck_ => null() + else + call psb_sp_free(blck_,info) + if(info.ne.0) then + info=4010 + ch_err='psb_sp_free' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + deallocate(blck_) + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +contains + subroutine psb_dilu_fctint(m,ma,a,mb,b,& + & d,laspk,lia1,lia2,uaspk,uia1,uia2,l1,l2,info) + implicit none + + type(psb_dspmat_type) :: a,b + integer :: m,ma,mb,l1,l2,info + integer, dimension(*) :: lia1,lia2,uia1,uia2 + real(kind(1.d0)), dimension(*) :: laspk,uaspk,d + + integer :: i,j,k,l,low1,low2,kk,jj,ll, irb, ktrw,err_act + real(kind(1.d0)) :: dia,temp + integer, parameter :: nrb=16 + logical,parameter :: debug=.false. + type(psb_dspmat_type) :: trw + integer :: int_err(5) + character(len=20) :: name, ch_err + + name='psb_dilu_fctint' + if(psb_get_errstatus().ne.0) return + info=0 + call psb_erractionsave(err_act) + call psb_nullify_sp(trw) + trw%m=0 + trw%k=0 + if(debug) write(0,*)'LUINT Allocating TRW' + call psb_sp_all(trw,1,info) + if(info.ne.0) then + info=4010 + ch_err='psb_sp_all' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + if(debug) write(0,*)'LUINT Done Allocating TRW' + lia2(1) = 1 + uia2(1) = 1 + l1=0 + l2=0 + m = ma+mb + if(debug) write(0,*)'In DCSRLU Begin cycle',m,ma,mb + + do i = 1, ma + if(debug) write(0,*)'LUINT: Loop index ',i,ma + d(i) = 0.d0 + + ! + ! Here we take a fast shortcut if possible, otherwise + ! use spgtblk, slower but able (in principle) to handle + ! anything. + ! + if (a%fida=='CSR') then + do j = a%ia2(i), a%ia2(i+1) - 1 + k = a%ia1(j) + ! write(0,*)'KKKKK',k + if ((k < i).and.(k >= 1)) then + l1 = l1 + 1 + laspk(l1) = a%aspk(j) + lia1(l1) = k + else if (k == i) then + d(i) = a%aspk(j) + else if ((k > i).and.(k <= m)) then + l2 = l2 + 1 + uaspk(l2) = a%aspk(j) + uia1(l2) = k + end if + enddo + + else + + if ((mod(i,nrb) == 1).or.(nrb==1)) then + irb = min(ma-i+1,nrb) + call psb_sp_getblk(i,a,trw,info,lrw=i+irb-1) + if(info.ne.0) then + info=4010 + ch_err='psb_sp_getblk' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ktrw=1 + end if + + do + if (ktrw > trw%infoa(psb_nnz_)) exit + if (trw%ia1(ktrw) > i) exit + k = trw%ia2(ktrw) + if ((k < i).and.(k >= 1)) then + l1 = l1 + 1 + laspk(l1) = trw%aspk(ktrw) + lia1(l1) = k + else if (k == i) then + d(i) = trw%aspk(ktrw) + else if ((k > i).and.(k <= m)) then + l2 = l2 + 1 + uaspk(l2) = trw%aspk(ktrw) + uia1(l2) = k + end if + ktrw = ktrw + 1 + enddo + + end if + +!!$ + + lia2(i+1) = l1 + 1 + uia2(i+1) = l2 + 1 + + dia = d(i) + do kk = lia2(i), lia2(i+1) - 1 + ! + ! compute element alo(i,k) of incomplete factorization + ! + temp = laspk(kk) + k = lia1(kk) + laspk(kk) = temp*d(k) + ! update the rest of row i using alo(i,k) + low1 = kk + 1 + low2 = uia2(i) + updateloop: do jj = uia2(k), uia2(k+1) - 1 + j = uia1(jj) + ! + if (j < i) then + ! search alo(i,*) for matching index J + do ll = low1, lia2(i+1) - 1 + l = lia1(ll) + if (l > j) then + low1 = ll + exit + else if (l == j) then + laspk(ll) = laspk(ll) - temp*uaspk(jj) + low1 = ll + 1 + cycle updateloop + end if + enddo + ! + else if (j == i) then + ! j=i update diagonal + ! write(0,*)'aggiorno dia',dia,'temp',temp,'jj',jj,'u%aspk',uaspk(jj) + dia = dia - temp*uaspk(jj) + ! write(0,*)'dia',dia,'temp',temp,'jj',jj,'aspk',uaspk(jj) + cycle updateloop + ! + else if (j > i) then + ! search aup(i,*) for matching index j + do ll = low2, uia2(i+1) - 1 + l = uia1(ll) + if (l > j) then + low2 = ll + exit + else if (l == j) then + uaspk(ll) = uaspk(ll) - temp*uaspk(jj) + low2 = ll + 1 + cycle updateloop + end if + enddo + end if + ! + ! for milu al=1.; for ilu al=0. + ! al = 1.d0 + ! dia = dia - al*temp*aup(jj) + enddo updateloop + enddo + ! + ! + ! Non singularity + ! + if (dabs(dia) < epstol) then + ! + ! Pivot too small: unstable factorization + ! + info = 2 + int_err(1) = i + write(ch_err,'(g20.10)') dia + call psb_errpush(info,name,i_err=int_err,a_err=ch_err) + goto 9999 + else + dia = 1.d0/dia + end if + d(i) = dia + ! write(6,*)'diag(',i,')=',d(i) + ! Scale row i of upper triangle + do kk = uia2(i), uia2(i+1) - 1 + uaspk(kk) = uaspk(kk)*dia + enddo + enddo + + do i = ma+1, m + d(i) = 0.d0 + + + if (b%fida=='CSR') then + + do j = b%ia2(i-ma), b%ia2(i-ma+1) - 1 + k = b%ia1(j) + ! if (me.eq.2) write(0,*)'ecco k=',k + if ((k < i).and.(k >= 1)) then + l1 = l1 + 1 + laspk(l1) = b%aspk(j) + lia1(l1) = k + ! if(me.eq.2) write(0,*)'scrivo l' + else if (k == i) then + d(i) = b%aspk(j) + else if ((k > i).and.(k <= m)) then + l2 = l2 + 1 + uaspk(l2) = b%aspk(j) + ! write(0,*)'KKKKK',k + uia1(l2) = k + end if + enddo + + else + + if ((mod((i-ma),nrb) == 1).or.(nrb==1)) then + irb = min(m-i+1,nrb) + call psb_sp_getblk(i-ma,b,trw,info,lrw=i-ma+irb-1) + if(info.ne.0) then + info=4010 + ch_err='psb_sp_getblk' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ktrw=1 + end if + + do + if (ktrw > trw%infoa(psb_nnz_)) exit + if (trw%ia1(ktrw) > i) exit + k = trw%ia2(ktrw) + ! write(0,*)'KKKKK',k + if ((k < i).and.(k >= 1)) then + l1 = l1 + 1 + laspk(l1) = trw%aspk(ktrw) + lia1(l1) = k + else if (k == i) then + d(i) = trw%aspk(ktrw) + else if ((k > i).and.(k <= m)) then + l2 = l2 + 1 + uaspk(l2) = trw%aspk(ktrw) + uia1(l2) = k + end if + ktrw = ktrw + 1 + enddo + + endif + + + lia2(i+1) = l1 + 1 + uia2(i+1) = l2 + 1 + + dia = d(i) + do kk = lia2(i), lia2(i+1) - 1 + ! + ! compute element alo(i,k) of incomplete factorization + ! + temp = laspk(kk) + k = lia1(kk) + laspk(kk) = temp*d(k) + ! update the rest of row i using alo(i,k) + low1 = kk + 1 + low2 = uia2(i) + updateloopb: do jj = uia2(k), uia2(k+1) - 1 + j = uia1(jj) + ! + if (j < i) then + ! search alo(i,*) for matching index J + do ll = low1, lia2(i+1) - 1 + l = lia1(ll) + if (l > j) then + low1 = ll + exit + else if (l == j) then + laspk(ll) = laspk(ll) - temp*uaspk(jj) + low1 = ll + 1 + cycle updateloopb + end if + enddo + ! + else if (j == i) then + ! j=i update diagonal + dia = dia - temp*uaspk(jj) + cycle updateloopb + ! + else if (j > i) then + ! search aup(i,*) for matching index j + do ll = low2, uia2(i+1) - 1 + l = uia1(ll) + if (l > j) then + low2 = ll + exit + else if (l == j) then + uaspk(ll) = uaspk(ll) - temp*uaspk(jj) + low2 = ll + 1 + cycle updateloopb + end if + enddo + end if + ! + ! for milu al=1.; for ilu al=0. + ! al = 1.d0 + ! dia = dia - al*temp*aup(jj) + enddo updateloopb + enddo + ! + ! + ! Non singularity + ! + if (dabs(dia) < epstol) then + ! + ! Pivot too small: unstable factorization + ! + int_err(1) = i + write(ch_err,'(g20.10)') dia + info = 2 + call psb_errpush(info,name,i_err=int_err,a_err=ch_err) + goto 9999 + else + dia = 1.d0/dia + end if + d(i) = dia + ! Scale row i of upper triangle + do kk = uia2(i), uia2(i+1) - 1 + uaspk(kk) = uaspk(kk)*dia + enddo + enddo + + call psb_sp_free(trw,info) + if(info.ne.0) then + info=4010 + ch_err='psb_sp_free' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + if(debug) write(0,*)'Leaving ilu_fct' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + end subroutine psb_dilu_fctint +end subroutine psb_dilu_fct diff --git a/baseprec/psb_dprc_aply.f90 b/baseprec/psb_dprc_aply.f90 new file mode 100644 index 00000000..cba287d3 --- /dev/null +++ b/baseprec/psb_dprc_aply.f90 @@ -0,0 +1,223 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work) + + use psb_base_mod + use psb_prec_type + implicit none + + type(psb_desc_type),intent(in) :: desc_data + type(psb_dprec_type), intent(in) :: prec + real(kind(0.d0)),intent(inout) :: x(:), y(:) + integer, intent(out) :: info + character(len=1), optional :: trans + real(kind(0.d0)), optional, target :: work(:) + + ! Local variables + character :: trans_ + real(kind(1.d0)), pointer :: work_(:) + integer :: ictxt,np,me,err_act + logical,parameter :: debug=.false., debugprt=.false. + external mpi_wtime + character(len=20) :: name + + interface psb_baseprc_aply + subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) + use psb_base_mod + use psb_prec_type + type(psb_desc_type),intent(in) :: desc_data + type(psb_dbaseprc_type), intent(in) :: prec + real(kind(0.d0)),intent(inout) :: x(:), y(:) + real(kind(0.d0)),intent(in) :: alpha,beta + character(len=1) :: trans + real(kind(0.d0)),target :: work(:) + integer, intent(out) :: info + end subroutine psb_dbaseprc_aply + end interface + + name='psb_prc_aply' + info = 0 + call psb_erractionsave(err_act) + + ictxt=desc_data%matrix_data(psb_ctxt_) + call psb_info(ictxt, me, np) + + if (present(trans)) then + trans_=trans + else + trans_='N' + end if + + if (present(work)) then + work_ => work + else + allocate(work_(4*desc_data%matrix_data(psb_n_col_)),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + end if + if (.not.(allocated(prec%baseprecv))) then + write(0,*) 'Inconsistent preconditioner: neither SMTH nor BASE?' + end if + + if (size(prec%baseprecv) == 1) then + call psb_baseprc_aply(done,prec%baseprecv(1),x,dzero,y,desc_data,trans_, work_,info) + else + write(0,*) 'Inconsistent preconditioner: size of baseprecv???' + endif + + if (present(work)) then + else + deallocate(work_) + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +end subroutine psb_dprc_aply + + +!!$ +!!$ +!!$ MD2P4 +!!$ Multilevel Domain Decomposition Parallel Preconditioner Package for PSBLAS +!!$ for +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ Daniela di Serafino Second University of Naples +!!$ Pasqua D'Ambra ICAR-CNR +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the MD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_dprc_aply1(prec,x,desc_data,info,trans) + + use psb_base_mod + use psb_prec_type + implicit none + + type(psb_desc_type),intent(in) :: desc_data + type(psb_dprec_type), intent(in) :: prec + real(kind(0.d0)),intent(inout) :: x(:) + integer, intent(out) :: info + character(len=1), optional :: trans + logical,parameter :: debug=.false., debugprt=.false. + + interface + subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work) + + use psb_base_mod + use psb_prec_type + implicit none + + type(psb_desc_type),intent(in) :: desc_data + type(psb_dprec_type), intent(in) :: prec + real(kind(0.d0)),intent(inout) :: x(:), y(:) + integer, intent(out) :: info + character(len=1), optional :: trans + real(kind(0.d0)), optional, target :: work(:) + end subroutine psb_dprc_aply + end interface + + ! Local variables + character :: trans_ + integer :: ictxt,np,me,i, err_act + real(kind(1.d0)), pointer :: WW(:), w1(:) + character(len=20) :: name + name='psb_dprec1' + info = 0 + call psb_erractionsave(err_act) + + + ictxt=desc_data%matrix_data(psb_ctxt_) + call psb_info(ictxt, me, np) + if (present(trans)) then + trans_=trans + else + trans_='N' + end if + + allocate(ww(size(x)),w1(size(x)),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + if (debug) write(0,*) 'Prc_aply1 Size(x) ',size(x), size(ww),size(w1) + call psb_dprc_aply(prec,x,ww,desc_data,info,trans_,work=w1) + if(info /=0) goto 9999 + x(:) = ww(:) + deallocate(ww,W1) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_errpush(info,name) + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return +end subroutine psb_dprc_aply1 diff --git a/baseprec/psb_dprecbld.f90 b/baseprec/psb_dprecbld.f90 new file mode 100644 index 00000000..ce65964e --- /dev/null +++ b/baseprec/psb_dprecbld.f90 @@ -0,0 +1,135 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_dprecbld(a,desc_a,p,info,upd) + + use psb_base_mod + use psb_prec_type + use psb_prec_mod, only : psb_baseprc_bld + Implicit None + + type(psb_dspmat_type), target :: a + type(psb_desc_type), intent(in), target :: desc_a + type(psb_dprec_type),intent(inout) :: p + integer, intent(out) :: info + character, intent(in), optional :: upd + + ! Local scalars + Integer :: err,i,j,k,ictxt, me,np,lw, err_act + integer :: int_err(5) + character :: iupd + + logical, parameter :: debug=.false. + integer,parameter :: iroot=0,iout=60,ilout=40 + character(len=20) :: name, ch_err + + if(psb_get_errstatus().ne.0) return + info=0 + err=0 + call psb_erractionsave(err_act) + name = 'psb_precbld' + + if (debug) write(0,*) 'Entering precbld',P%prec,desc_a%matrix_data(:) + info = 0 + int_err(1) = 0 + ictxt = psb_cd_get_context(desc_a) + + if (debug) write(0,*) 'Preconditioner psb_info' + call psb_info(ictxt, me, np) + + if (present(upd)) then + if (debug) write(0,*) 'UPD ', upd + if ((upd.eq.'F').or.(upd.eq.'T')) then + iupd=upd + else + iupd='F' + endif + else + iupd='F' + endif + + if (.not.allocated(p%baseprecv)) then + !! Error 1: should call precset + info=4010 + ch_err='unallocated bpv' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ! + ! Should add check to ensure all procs have the same... + ! + ! ALso should define symbolic names for the preconditioners. + ! + call init_baseprc_av(p%baseprecv(1),info) + if (info /= 0) then + info=4010 + ch_err='allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + endif + + call psb_baseprc_bld(a,desc_a,p%baseprecv(1),info,iupd) + if (info /= 0) then + info=4010 + ch_err='baseprc_bld' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + endif + + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +contains + + subroutine init_baseprc_av(p,info) + type(psb_dbaseprc_type), intent(inout) :: p + integer :: info + if (allocated(p%av)) then + ! Have not decided what to do yet + end if + allocate(p%av(max_avsz),stat=info) +!!$ if (info /= 0) return + do k=1,size(p%av) + call psb_nullify_sp(p%av(k)) + end do + + end subroutine init_baseprc_av + +end subroutine psb_dprecbld + diff --git a/baseprec/psb_dprecfree.f90 b/baseprec/psb_dprecfree.f90 new file mode 100644 index 00000000..33901dc8 --- /dev/null +++ b/baseprec/psb_dprecfree.f90 @@ -0,0 +1,69 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_dprecfree(p,info) + !...free sparse matrix structure... + use psb_base_mod + use psb_prec_type + implicit none + !....parameters... + + type(psb_dprec_type), intent(inout) :: p + integer, intent(out) :: info + + !...locals.... + integer :: ictxt,me,np,err_act,i + character(len=20) :: name + + if(psb_get_errstatus().ne.0) return + info=0 + name = 'psdprecfree' + call psb_erractionsave(err_act) + + me=-1 + + if (allocated(p%baseprecv)) then + do i=1,size(p%baseprecv) + call psb_base_precfree(p%baseprecv(i),info) + end do + deallocate(p%baseprecv) + end if + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +end subroutine psb_dprecfree diff --git a/baseprec/psb_dprecset.f90 b/baseprec/psb_dprecset.f90 new file mode 100644 index 00000000..493e381d --- /dev/null +++ b/baseprec/psb_dprecset.f90 @@ -0,0 +1,100 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_dprecset(p,ptype,info,iv,rs,rv,ilev,nlev) + + use psb_base_mod + use psb_prec_type + implicit none + type(psb_dprec_type), intent(inout) :: p + character(len=*), intent(in) :: ptype + integer, intent(out) :: info + integer, optional, intent(in) :: iv(:) + integer, optional, intent(in) :: nlev,ilev + real(kind(1.d0)), optional, intent(in) :: rs + real(kind(1.d0)), optional, intent(in) :: rv(:) + + character(len=len(ptype)) :: typeup + integer :: isz, err, nlev_, ilev_, i + + info = 0 + + ilev_ = 1 + nlev_ = 1 + + if (.not.allocated(p%baseprecv)) then + allocate(p%baseprecv(nlev_),stat=err) + else + nlev_ = size(p%baseprecv) + endif + + if ((ilev_<1).or.(ilev_ > nlev_)) then + write(0,*) 'PRECSET ERRROR: ilev out of bounds' + info = -1 + return + endif + + call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info) + if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) + if (info /= 0) return + p%baseprecv(ilev_)%iprcparm(:) = 0 + + select case(toupper(ptype(1:len_trim(ptype)))) + case ('NONE','NOPREC') + p%baseprecv(ilev_)%iprcparm(:) = 0 + p%baseprecv(ilev_)%iprcparm(p_type_) = noprec_ + p%baseprecv(ilev_)%iprcparm(f_type_) = f_none_ + p%baseprecv(ilev_)%iprcparm(iren_) = 0 + p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 + + case ('DIAG','DIAGSC') + p%baseprecv(ilev_)%iprcparm(:) = 0 + p%baseprecv(ilev_)%iprcparm(p_type_) = diagsc_ + p%baseprecv(ilev_)%iprcparm(f_type_) = f_none_ + p%baseprecv(ilev_)%iprcparm(iren_) = 0 + p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 + + case ('BJA','ILU') + p%baseprecv(ilev_)%iprcparm(:) = 0 + p%baseprecv(ilev_)%iprcparm(p_type_) = bja_ + p%baseprecv(ilev_)%iprcparm(f_type_) = f_ilu_n_ + p%baseprecv(ilev_)%iprcparm(iren_) = 0 + p%baseprecv(ilev_)%iprcparm(ilu_fill_in_) = 0 + p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 + + case default + write(0,*) 'Unknown preconditioner type request "',ptype,'"' + err = 2 + + end select + + info = err + +end subroutine psb_dprecset diff --git a/baseprec/psb_dsp_renum.f90 b/baseprec/psb_dsp_renum.f90 new file mode 100644 index 00000000..4404d21c --- /dev/null +++ b/baseprec/psb_dsp_renum.f90 @@ -0,0 +1,391 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_dsp_renum(a,desc_a,p,atmp,info) + use psb_base_mod + use psb_prec_type + implicit none + + ! .. array Arguments .. + type(psb_dspmat_type), intent(in) :: a + type(psb_dspmat_type), intent(inout) :: atmp + type(psb_dbaseprc_type), intent(inout) :: p + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + + character(len=20) :: name, ch_err + integer nztota, nztotb, nztmp, nzl, nnr, ir, mglob, mtype, n_row, & + & nrow_a,n_col, nhalo,lovr, ind, iind, pi,nr,ns,i,j,jj,k,kk + integer ::ictxt,np,me, err_act + integer, allocatable :: itmp(:), itmp2(:) + real(kind(1.d0)), allocatable :: rtmp(:) + real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,mpi_wtime, t7, t8 + external mpi_wtime + + if (psb_get_errstatus().ne.0) return + info=0 + name='apply_renum' + call psb_erractionsave(err_act) + + ictxt=psb_cd_get_context(desc_a) + + call psb_info(ictxt, me, np) + +!!!!!!!!!!!!!!!! CHANGE FOR NON-CSR A + ! + ! Renumbering type: + ! 1. Global column indices + ! (2. GPS band reduction disabled for the time being) + + if (p%iprcparm(iren_)==renum_glb_) then + atmp%m = a%m + atmp%k = a%k + atmp%fida='CSR' + atmp%descra = 'GUN' + + ! This is the renumbering coherent with global indices.. + mglob = psb_cd_get_global_rows(desc_a) + + ! + ! Remember: we have switched IA1=COLS and IA2=ROWS + ! Now identify the set of distinct local column indices + ! + + nnr = p%desc_data%matrix_data(psb_n_row_) + allocate(p%perm(nnr),p%invperm(nnr),itmp2(nnr),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + do k=1,nnr + itmp2(k) = p%desc_data%loc_to_glob(k) + enddo + ! + ! We want: NEW(I) = OLD(PERM(I)) + ! + call isrx(nnr,itmp2,p%perm) + + do k=1, nnr + p%invperm(p%perm(k)) = k + enddo + t3 = mpi_wtime() + + ! Build ATMP with new numbering. + nztmp=size(atmp%aspk) + allocate(itmp(max(8,atmp%m+2,nztmp+2)),rtmp(atmp%m),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + j = 1 + atmp%ia2(1) = 1 + do i=1, atmp%m + ir = p%perm(i) + + if (ir <= a%m ) then + + nzl = a%ia2(ir+1) - a%ia2(ir) + if (nzl > size(rtmp)) then + call psb_realloc(nzl,rtmp,info) + if(info/=0) then + info=4010 + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + endif + jj = a%ia2(ir) + k=0 + do kk=1, nzl + if (a%ia1(jj+kk-1)<=atmp%m) then + k = k + 1 + rtmp(k) = a%aspk(jj+kk-1) + atmp%ia1(j+k-1) = p%invperm(a%ia1(jj+kk-1)) + endif + enddo + call isrx(k,atmp%ia1(j:j+k-1),itmp2) + do kk=1,k + atmp%aspk(j+kk-1) = rtmp(itmp2(kk)) + enddo + + + else + write(0,*) 'Row index error 1 :',i,ir + endif + + j = j + k + atmp%ia2(i+1) = j + + enddo + + t4 = mpi_wtime() + + + deallocate(itmp,itmp2,rtmp) + + else if (p%iprcparm(iren_)==renum_gps_) then + + atmp%m = a%m + atmp%k = a%k + atmp%fida='CSR' + atmp%descra = 'GUN' + do i=1, a%m + atmp%ia2(i) = a%ia2(i) + do j= a%ia2(i), a%ia2(i+1)-1 + atmp%ia1(j) = a%ia1(j) + enddo + enddo + atmp%ia2(a%m+1) = a%ia2(a%m+1) + nztmp = atmp%ia2(atmp%m+1) - 1 + + + ! This is a renumbering with Gibbs-Poole-Stockmeyer + ! band reduction. Switched off for now. To be fixed, + ! gps_reduction should get p%perm. + + ! write(0,*) me,' Renumbering: realloc perms',atmp%m + call psb_realloc(atmp%m,p%perm,info) + if(info/=0) then + info=4010 + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + call psb_realloc(atmp%m,p%invperm,info) + if(info/=0) then + info=4010 + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + allocate(itmp(max(8,atmp%m+2,nztmp+2)),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + itmp(1:8) = 0 + ! write(0,*) me,' Renumbering: Calling Metis' + + ! write(0,*) size(p%av(u_pr_)%pl),size(p%av(l_pr_)%pr) + call gps_reduction(atmp%m,atmp%ia2,atmp%ia1,p%perm,p%invperm,info) + if(info/=0) then + info=4010 + ch_err='gps_reduction' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + ! write(0,*) me,' Renumbering: Done GPS' + ! call psb_barrier(ictxt) + do i=1, atmp%m + if (p%perm(i) /= i) then + write(0,*) me,' permutation is not identity ' + exit + endif + enddo + + + do k=1, nnr + p%invperm(p%perm(k)) = k + enddo + t3 = mpi_wtime() + + ! Build ATMP with new numbering. + + allocate(itmp2(max(8,atmp%m+2,nztmp+2)),rtmp(atmp%m),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + j = 1 + atmp%ia2(1) = 1 + do i=1, atmp%m + ir = p%perm(i) + + if (ir <= a%m ) then + + nzl = a%ia2(ir+1) - a%ia2(ir) + if (nzl > size(rtmp)) then + call psb_realloc(nzl,rtmp,info) + if(info/=0) then + info=4010 + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + endif + jj = a%ia2(ir) + k=0 + do kk=1, nzl + if (a%ia1(jj+kk-1)<=atmp%m) then + k = k + 1 + rtmp(k) = a%aspk(jj+kk-1) + atmp%ia1(j+k-1) = p%invperm(a%ia1(jj+kk-1)) + endif + enddo + call isrx(k,atmp%ia1(j:j+k-1),itmp2) + do kk=1,k + atmp%aspk(j+kk-1) = rtmp(itmp2(kk)) + enddo + + else + write(0,*) 'Row index error 1 :',i,ir + endif + + j = j + k + atmp%ia2(i+1) = j + + enddo + + t4 = mpi_wtime() + + + + deallocate(itmp,itmp2,rtmp) + + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +contains + + + subroutine gps_reduction(m,ia,ja,perm,iperm,info) + integer i,j,dgConn,Npnt,m + integer n,idpth,ideg,ibw2,ipf2 + integer,dimension(:) :: perm,iperm,ia,ja + integer, intent(out) :: info + + integer,dimension(:,:),allocatable::NDstk + integer,dimension(:),allocatable::iOld,renum,ndeg,lvl,lvls1,lvls2,ccstor + !--- Per la common area. + + character(len=20) :: name, ch_err + + if(psb_get_errstatus().ne.0) return + info=0 + name='gps_reduction' + call psb_erractionsave(err_act) + + + !--- Calcolo il massimo grado di connettivita'. + npnt = m + write(6,*) ' GPS su ',npnt + dgConn=0 + do i=1,m + dgconn = max(dgconn,(ia(i+1)-ia(i))) + enddo + !--- Il max valore di connettivita' e "dgConn" + + !--- Valori della common + n=Npnt !--- Numero di righe + iDeg=dgConn !--- Massima connettivita' + ! iDpth= !--- Numero di livelli non serve settarlo + + allocate(NDstk(Npnt,dgConn),stat=info) + if (info/=0) then + info=4000 + call psb_errpush(info,name) + goto 9999 + else + write(0,*) 'gps_reduction first alloc OK' + endif + allocate(iOld(Npnt),renum(Npnt+1),ndeg(Npnt),lvl(Npnt),lvls1(Npnt),& + &lvls2(Npnt),ccstor(Npnt),stat=info) + if (info/=0) then + info=4000 + call psb_errpush(info,name) + goto 9999 + else + write(0,*) 'gps_reduction 2nd alloc OK' + endif + + !--- Prepariamo il grafo della matrice + Ndstk(:,:)=0 + do i=1,Npnt + k=0 + do j = ia(i),ia(i+1) - 1 + if ((1<=ja(j)).and.( ja( j ) /= i ).and.(ja(j)<=npnt)) then + k = k+1 + Ndstk(i,k)=ja(j) + endif + enddo + ndeg(i)=k + enddo + + !--- Numerazione. + do i=1,Npnt + iOld(i)=i + enddo + write(0,*) 'gps_red : Preparation done' + !--- + !--- Chiamiamo funzione reduce. + call psb_gps_reduce(Ndstk,Npnt,iOld,renum,ndeg,lvl,lvls1, lvls2,ccstor,& + & ibw2,ipf2,n,idpth,ideg) + write(0,*) 'gps_red : Done reduce' + !--- Permutazione + perm(1:Npnt)=renum(1:Npnt) + !--- Inversa permutazione + do i=1,Npnt + iperm(perm(i))=i + enddo + !--- Puliamo tutto. + deallocate(NDstk,iOld,renum,ndeg,lvl,lvls1,lvls2,ccstor) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + + end subroutine gps_reduction + +end subroutine psb_dsp_renum diff --git a/baseprec/psb_prec_mod.f90 b/baseprec/psb_prec_mod.f90 new file mode 100644 index 00000000..9b419135 --- /dev/null +++ b/baseprec/psb_prec_mod.f90 @@ -0,0 +1,163 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (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_prec_mod + use psb_prec_type + + interface psb_precbld + subroutine psb_dprecbld(a,desc_a,prec,info,upd) + use psb_base_mod + use psb_prec_type + implicit none + type(psb_dspmat_type), intent(in), target :: a + type(psb_desc_type), intent(in), target :: desc_a + type(psb_dprec_type), intent(inout) :: prec + integer, intent(out) :: info + character, intent(in),optional :: upd + end subroutine psb_dprecbld + subroutine psb_zprecbld(a,desc_a,prec,info,upd) + use psb_base_mod + use psb_prec_type + implicit none + type(psb_zspmat_type), intent(in), target :: a + type(psb_desc_type), intent(in), target :: desc_a + type(psb_zprec_type), intent(inout) :: prec + integer, intent(out) :: info + character, intent(in),optional :: upd + end subroutine psb_zprecbld + end interface + + interface psb_precset + subroutine psb_dprecset(prec,ptype,info,iv,rs,rv,ilev,nlev) + use psb_base_mod + use psb_prec_type + implicit none + type(psb_dprec_type), intent(inout) :: prec + character(len=*), intent(in) :: ptype + integer, intent(out) :: info + integer, optional, intent(in) :: iv(:) + integer, optional, intent(in) :: nlev,ilev + real(kind(1.d0)), optional, intent(in) :: rs + real(kind(1.d0)), optional, intent(in) :: rv(:) + end subroutine psb_dprecset + subroutine psb_zprecset(prec,ptype,info,iv,rs,rv,ilev,nlev) + use psb_base_mod + use psb_prec_type + implicit none + type(psb_zprec_type), intent(inout) :: prec + character(len=*), intent(in) :: ptype + integer, intent(out) :: info + integer, optional, intent(in) :: iv(:) + real(kind(1.d0)), optional, intent(in) :: rs + real(kind(1.d0)), optional, intent(in) :: rv(:) + integer, optional, intent(in) :: nlev,ilev + end subroutine psb_zprecset + end interface + + + interface psb_precfree + subroutine psb_dprecfree(p,info) + use psb_base_mod + use psb_prec_type + type(psb_dprec_type), intent(inout) :: p + integer, intent(out) :: info + end subroutine psb_dprecfree + subroutine psb_zprecfree(p,info) + use psb_base_mod + use psb_prec_type + type(psb_zprec_type), intent(inout) :: p + integer, intent(out) :: info + end subroutine psb_zprecfree + end interface + + interface psb_prc_aply + subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans,work) + use psb_base_mod + use psb_prec_type + type(psb_desc_type),intent(in) :: desc_data + type(psb_dprec_type), intent(in) :: prec + real(kind(0.d0)),intent(inout) :: x(:), y(:) + integer, intent(out) :: info + character(len=1), optional :: trans + real(kind(0.d0)),intent(inout), optional, target :: work(:) + end subroutine psb_dprc_aply + subroutine psb_dprc_aply1(prec,x,desc_data,info,trans) + use psb_base_mod + use psb_prec_type + type(psb_desc_type),intent(in) :: desc_data + type(psb_dprec_type), intent(in) :: prec + real(kind(0.d0)),intent(inout) :: x(:) + integer, intent(out) :: info + character(len=1), optional :: trans + end subroutine psb_dprc_aply1 + subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans,work) + use psb_base_mod + use psb_prec_type + type(psb_desc_type),intent(in) :: desc_data + type(psb_zprec_type), intent(in) :: prec + complex(kind(0.d0)),intent(inout) :: x(:), y(:) + integer, intent(out) :: info + character(len=1), optional :: trans + complex(kind(0.d0)),intent(inout), optional, target :: work(:) + end subroutine psb_zprc_aply + subroutine psb_zprc_aply1(prec,x,desc_data,info,trans) + use psb_base_mod + use psb_prec_type + type(psb_desc_type),intent(in) :: desc_data + type(psb_zprec_type), intent(in) :: prec + complex(kind(0.d0)),intent(inout) :: x(:) + integer, intent(out) :: info + character(len=1), optional :: trans + end subroutine psb_zprc_aply1 + end interface + + interface psb_baseprc_bld + subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd) + use psb_base_mod + use psb_prec_type + type(psb_dspmat_type), target :: a + type(psb_desc_type), intent(in), target :: desc_a + type(psb_dbaseprc_type),intent(inout) :: p + integer, intent(out) :: info + character, intent(in), optional :: upd + end subroutine psb_dbaseprc_bld + subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd) + use psb_base_mod + use psb_prec_type + type(psb_zspmat_type), target :: a + type(psb_desc_type), intent(in), target :: desc_a + type(psb_zbaseprc_type),intent(inout) :: p + integer, intent(out) :: info + character, intent(in), optional :: upd + end subroutine psb_zbaseprc_bld + end interface + +end module psb_prec_mod diff --git a/baseprec/psb_prec_type.f90 b/baseprec/psb_prec_type.f90 new file mode 100644 index 00000000..620e454b --- /dev/null +++ b/baseprec/psb_prec_type.f90 @@ -0,0 +1,521 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (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 to define PREC_DATA, !! +!! structure for preconditioning. !! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +module psb_prec_type + + use psb_base_mod + + integer, parameter :: min_prec_=0, noprec_=0, diagsc_=1, bja_=2,& + & max_prec_=2 + + ! Entries in iprcparm: preconditioner type, factorization type, + ! prolongation type, restriction type, renumbering algorithm, + ! number of overlap layers, pointer to SuperLU factors, + ! levels of fill in for ILU(N), + integer, parameter :: p_type_=1, f_type_=2, iren_=5 + integer, parameter :: ilu_fill_in_=8, jac_sweeps_=9 + !Renumbering. SEE BELOW + integer, parameter :: renum_none_=0, renum_glb_=1, renum_gps_=2 + integer, parameter :: ifpsz=10 + ! Entries in dprcparm: ILU(E) epsilon, smoother omega + integer, parameter :: fact_eps_=1 + integer, parameter :: dfpsz=4 + ! Factorization types: none, ILU(N), ILU(E) + integer, parameter :: f_none_=0,f_ilu_n_=1,f_ilu_e_=2 + ! Fields for sparse matrices ensembles: + integer, parameter :: l_pr_=1, u_pr_=2, bp_ilu_avsz=2 + integer, parameter :: ap_nd_=3, ac_=4, sm_pr_t_=5, sm_pr_=6 + integer, parameter :: smth_avsz=6, max_avsz=smth_avsz + + + type psb_dbaseprc_type + + type(psb_dspmat_type), allocatable :: av(:) + real(kind(1.d0)), allocatable :: d(:) + type(psb_desc_type) :: desc_data + integer, allocatable :: iprcparm(:) + real(kind(1.d0)), allocatable :: dprcparm(:) + integer, allocatable :: perm(:), invperm(:) + + end type psb_dbaseprc_type + + + type psb_dprec_type + type(psb_dbaseprc_type), allocatable :: baseprecv(:) + ! contain type of preconditioning to be performed + integer :: prec, base_prec + end type psb_dprec_type + + type psb_zbaseprc_type + + type(psb_zspmat_type), allocatable :: av(:) + complex(kind(1.d0)), allocatable :: d(:) + type(psb_desc_type) :: desc_data + integer, allocatable :: iprcparm(:) + real(kind(1.d0)), allocatable :: dprcparm(:) + integer, allocatable :: perm(:), invperm(:) + + end type psb_zbaseprc_type + + type psb_zprec_type + type(psb_zbaseprc_type), allocatable :: baseprecv(:) + ! contain type of preconditioning to be performed + integer :: prec, base_prec + end type psb_zprec_type + + + character(len=15), parameter, private :: & + & fact_names(0:2)=(/'None ','ILU(n) ',& + & 'ILU(eps) '/) + + interface psb_base_precfree + module procedure psb_dbase_precfree, psb_zbase_precfree + end interface + + interface psb_nullify_baseprec + module procedure psb_nullify_dbaseprec, psb_nullify_zbaseprec + end interface + + interface psb_check_def + module procedure psb_icheck_def, psb_dcheck_def + end interface + + interface psb_prec_descr + module procedure psb_out_prec_descr, psb_file_prec_descr, & + & psb_zout_prec_descr, psb_zfile_prec_descr + end interface + + interface psb_prec_short_descr + module procedure psb_prec_short_descr, psb_zprec_short_descr + end interface + +contains + + subroutine psb_out_prec_descr(p) + type(psb_dprec_type), intent(in) :: p + call psb_file_prec_descr(6,p) + end subroutine psb_out_prec_descr + + subroutine psb_zout_prec_descr(p) + type(psb_zprec_type), intent(in) :: p + call psb_zfile_prec_descr(6,p) + end subroutine psb_zout_prec_descr + + subroutine psb_file_prec_descr(iout,p) + integer, intent(in) :: iout + type(psb_dprec_type), intent(in) :: p + integer :: ilev + + write(iout,*) 'Preconditioner description' + if (allocated(p%baseprecv)) then + if (size(p%baseprecv)>=1) then + write(iout,*) 'Base preconditioner' + select case(p%baseprecv(1)%iprcparm(p_type_)) + case(noprec_) + write(iout,*) 'No preconditioning' + case(diagsc_) + write(iout,*) 'Diagonal scaling' + case(bja_) + write(iout,*) 'Block Jacobi with: ',& + & fact_names(p%baseprecv(1)%iprcparm(f_type_)) + end select + end if + + else + write(iout,*) 'No Base preconditioner available, something is wrong!' + return + endif + + end subroutine psb_file_prec_descr + + function psb_prec_short_descr(p) + type(psb_dprec_type), intent(in) :: p + character(len=20) :: psb_prec_short_descr + psb_prec_short_descr = ' ' +!!$ write(iout,*) 'Preconditioner description' +!!$ if (associated(p%baseprecv)) then +!!$ if (size(p%baseprecv)>=1) then +!!$ write(iout,*) 'Base preconditioner' +!!$ select case(p%baseprecv(1)%iprcparm(p_type_)) +!!$ case(noprec_) +!!$ write(iout,*) 'No preconditioning' +!!$ case(diagsc_) +!!$ write(iout,*) 'Diagonal scaling' +!!$ case(bja_) +!!$ write(iout,*) 'Block Jacobi with: ',& +!!$ & fact_names(p%baseprecv(1)%iprcparm(f_type_)) +!!$ case(asm_,ras_,ash_,rash_) +!!$ write(iout,*) 'Additive Schwarz with: ',& +!!$ & fact_names(p%baseprecv(1)%iprcparm(f_type_)) +!!$ write(iout,*) 'Overlap:',& +!!$ & p%baseprecv(1)%iprcparm(n_ovr_) +!!$ write(iout,*) 'Restriction: ',& +!!$ & restrict_names(p%baseprecv(1)%iprcparm(restr_)) +!!$ write(iout,*) 'Prolongation: ',& +!!$ & prolong_names(p%baseprecv(1)%iprcparm(prol_)) +!!$ end select +!!$ end if +!!$ if (size(p%baseprecv)>=2) then +!!$ if (.not.associated(p%baseprecv(2)%iprcparm)) then +!!$ write(iout,*) 'Inconsistent MLPREC part!' +!!$ return +!!$ endif +!!$ write(iout,*) 'Multilevel: ',ml_names(p%baseprecv(2)%iprcparm(ml_type_)) +!!$ if (p%baseprecv(2)%iprcparm(ml_type_)>no_ml_) then +!!$ write(iout,*) 'Multilevel aggregation: ', & +!!$ & aggr_names(p%baseprecv(2)%iprcparm(aggr_alg_)) +!!$ write(iout,*) 'Smoother: ', & +!!$ & smooth_kinds(p%baseprecv(2)%iprcparm(smth_kind_)) +!!$ write(iout,*) 'Smoothing omega: ', p%baseprecv(2)%dprcparm(smooth_omega_) +!!$ write(iout,*) 'Smoothing position: ',& +!!$ & smooth_names(p%baseprecv(2)%iprcparm(smth_pos_)) +!!$ write(iout,*) 'Coarse matrix: ',& +!!$ & matrix_names(p%baseprecv(2)%iprcparm(coarse_mat_)) +!!$ write(iout,*) 'Factorization type: ',& +!!$ & fact_names(p%baseprecv(2)%iprcparm(f_type_)) +!!$ select case(p%baseprecv(2)%iprcparm(f_type_)) +!!$ case(f_ilu_n_) +!!$ write(iout,*) 'Fill level :',p%baseprecv(2)%iprcparm(ilu_fill_in_) +!!$ case(f_ilu_e_) +!!$ write(iout,*) 'Fill threshold :',p%baseprecv(2)%dprcparm(fact_eps_) +!!$ case(f_slu_,f_umf_) +!!$ case default +!!$ write(iout,*) 'Should never get here!' +!!$ end select +!!$ write(iout,*) 'Number of Jacobi sweeps: ', & +!!$ & (p%baseprecv(2)%iprcparm(jac_sweeps_)) +!!$ +!!$ end if +!!$ end if +!!$ +!!$ else +!!$ write(iout,*) 'No Base preconditioner available, something is wrong!' +!!$ return +!!$ endif + + end function psb_prec_short_descr + + + subroutine psb_zfile_prec_descr(iout,p) + integer, intent(in) :: iout + type(psb_zprec_type), intent(in) :: p + + write(iout,*) 'Preconditioner description' + if (allocated(p%baseprecv)) then + if (size(p%baseprecv)>=1) then + write(iout,*) 'Base preconditioner' + select case(p%baseprecv(1)%iprcparm(p_type_)) + case(noprec_) + write(iout,*) 'No preconditioning' + case(diagsc_) + write(iout,*) 'Diagonal scaling' + case(bja_) + write(iout,*) 'Block Jacobi with: ',& + & fact_names(p%baseprecv(1)%iprcparm(f_type_)) + end select + end if + else + write(iout,*) 'No Base preconditioner available, something is wrong!' + return + endif + + end subroutine psb_zfile_prec_descr + + function psb_zprec_short_descr(p) + type(psb_zprec_type), intent(in) :: p + character(len=20) :: psb_zprec_short_descr + psb_zprec_short_descr = ' ' +!!$ write(iout,*) 'Preconditioner description' +!!$ if (associated(p%baseprecv)) then +!!$ if (size(p%baseprecv)>=1) then +!!$ write(iout,*) 'Base preconditioner' +!!$ select case(p%baseprecv(1)%iprcparm(p_type_)) +!!$ case(noprec_) +!!$ write(iout,*) 'No preconditioning' +!!$ case(diagsc_) +!!$ write(iout,*) 'Diagonal scaling' +!!$ case(bja_) +!!$ write(iout,*) 'Block Jacobi with: ',& +!!$ & fact_names(p%baseprecv(1)%iprcparm(f_type_)) +!!$ case(asm_,ras_,ash_,rash_) +!!$ write(iout,*) 'Additive Schwarz with: ',& +!!$ & fact_names(p%baseprecv(1)%iprcparm(f_type_)) +!!$ write(iout,*) 'Overlap:',& +!!$ & p%baseprecv(1)%iprcparm(n_ovr_) +!!$ write(iout,*) 'Restriction: ',& +!!$ & restrict_names(p%baseprecv(1)%iprcparm(restr_)) +!!$ write(iout,*) 'Prolongation: ',& +!!$ & prolong_names(p%baseprecv(1)%iprcparm(prol_)) +!!$ end select +!!$ end if +!!$ if (size(p%baseprecv)>=2) then +!!$ if (.not.associated(p%baseprecv(2)%iprcparm)) then +!!$ write(iout,*) 'Inconsistent MLPREC part!' +!!$ return +!!$ endif +!!$ write(iout,*) 'Multilevel: ',ml_names(p%baseprecv(2)%iprcparm(ml_type_)) +!!$ if (p%baseprecv(2)%iprcparm(ml_type_)>no_ml_) then +!!$ write(iout,*) 'Multilevel aggregation: ', & +!!$ & aggr_names(p%baseprecv(2)%iprcparm(aggr_alg_)) +!!$ write(iout,*) 'Smoother: ', & +!!$ & smooth_kinds(p%baseprecv(2)%iprcparm(smth_kind_)) +!!$ write(iout,*) 'Smoothing omega: ', p%baseprecv(2)%dprcparm(smooth_omega_) +!!$ write(iout,*) 'Smoothing position: ',& +!!$ & smooth_names(p%baseprecv(2)%iprcparm(smth_pos_)) +!!$ write(iout,*) 'Coarse matrix: ',& +!!$ & matrix_names(p%baseprecv(2)%iprcparm(coarse_mat_)) +!!$ write(iout,*) 'Factorization type: ',& +!!$ & fact_names(p%baseprecv(2)%iprcparm(f_type_)) +!!$ select case(p%baseprecv(2)%iprcparm(f_type_)) +!!$ case(f_ilu_n_) +!!$ write(iout,*) 'Fill level :',p%baseprecv(2)%iprcparm(ilu_fill_in_) +!!$ case(f_ilu_e_) +!!$ write(iout,*) 'Fill threshold :',p%baseprecv(2)%dprcparm(fact_eps_) +!!$ case(f_slu_,f_umf_) +!!$ case default +!!$ write(iout,*) 'Should never get here!' +!!$ end select +!!$ write(iout,*) 'Number of Jacobi sweeps: ', & +!!$ & (p%baseprecv(2)%iprcparm(jac_sweeps_)) +!!$ +!!$ end if +!!$ end if +!!$ +!!$ else +!!$ write(iout,*) 'No Base preconditioner available, something is wrong!' +!!$ return +!!$ endif + + end function psb_zprec_short_descr + + + + + function is_legal_base_prec(ip) + integer, intent(in) :: ip + logical :: is_legal_base_prec + + is_legal_base_prec = ((ip>=noprec_).and.(ip<=bja_)) + return + end function is_legal_base_prec + function is_legal_renum(ip) + integer, intent(in) :: ip + logical :: is_legal_renum + ! For the time being we are disabling renumbering options. + is_legal_renum = (ip ==0) + return + end function is_legal_renum + function is_legal_jac_sweeps(ip) + integer, intent(in) :: ip + logical :: is_legal_jac_sweeps + is_legal_jac_sweeps = (ip >= 1) + return + end function is_legal_jac_sweeps + function is_legal_ml_fact(ip) + integer, intent(in) :: ip + logical :: is_legal_ml_fact + + is_legal_ml_fact = ((ip>=f_ilu_n_).and.(ip<=f_ilu_e_)) + return + end function is_legal_ml_fact + function is_legal_ml_eps(ip) + real(kind(1.d0)), intent(in) :: ip + logical :: is_legal_ml_eps + + is_legal_ml_eps = (ip>=0.0d0) + return + end function is_legal_ml_eps + + + subroutine psb_icheck_def(ip,name,id,is_legal) + integer, intent(inout) :: ip + integer, intent(in) :: id + character(len=*), intent(in) :: name + interface + function is_legal(i) + integer, intent(in) :: i + logical :: is_legal + end function is_legal + end interface + + if (.not.is_legal(ip)) then + write(0,*) 'Illegal value for ',name,' :',ip, '. defaulting to ',id + ip = id + end if + end subroutine psb_icheck_def + + subroutine psb_dcheck_def(ip,name,id,is_legal) + real(kind(1.d0)), intent(inout) :: ip + real(kind(1.d0)), intent(in) :: id + character(len=*), intent(in) :: name + interface + function is_legal(i) + real(kind(1.d0)), intent(in) :: i + logical :: is_legal + end function is_legal + end interface + + if (.not.is_legal(ip)) then + write(0,*) 'Illegal value for ',name,' :',ip, '. defaulting to ',id + ip = id + end if + end subroutine psb_dcheck_def + + subroutine psb_dbase_precfree(p,info) + type(psb_dbaseprc_type), intent(inout) :: p + integer, intent(out) :: info + integer :: i + + info = 0 + + ! Actually we migh just deallocate the top level array, except + ! for the inner UMFPACK or SLU stuff + + if (allocated(p%d)) then + deallocate(p%d,stat=info) + end if + + if (allocated(p%av)) then + do i=1,size(p%av) + call psb_sp_free(p%av(i),info) + if (info /= 0) then + ! Actually, we don't care here about this. + ! Just let it go. + ! return + end if + enddo + deallocate(p%av,stat=info) + end if + + if (allocated(p%desc_data%matrix_data)) & + & call psb_cdfree(p%desc_data,info) + + if (allocated(p%dprcparm)) then + deallocate(p%dprcparm,stat=info) + end if + + if (allocated(p%perm)) then + deallocate(p%perm,stat=info) + endif + + if (allocated(p%invperm)) then + deallocate(p%invperm,stat=info) + endif + + if (allocated(p%iprcparm)) then + deallocate(p%iprcparm,stat=info) + end if + call psb_nullify_baseprec(p) + end subroutine psb_dbase_precfree + + subroutine psb_nullify_dbaseprec(p) + type(psb_dbaseprc_type), intent(inout) :: p + +!!$ nullify(p%av,p%d,p%iprcparm,p%dprcparm,p%perm,p%invperm,p%mlia,& +!!$ & p%nlaggr,p%base_a,p%base_desc,p%dorig,p%desc_data, p%desc_ac) + + end subroutine psb_nullify_dbaseprec + + subroutine psb_zbase_precfree(p,info) + type(psb_zbaseprc_type), intent(inout) :: p + integer, intent(out) :: info + integer :: i + + info = 0 + + if (allocated(p%d)) then + deallocate(p%d,stat=info) + end if + + if (allocated(p%av)) then + do i=1,size(p%av) + call psb_sp_free(p%av(i),info) + if (info /= 0) then + ! Actually, we don't care here about this. + ! Just let it go. + ! return + end if + enddo + deallocate(p%av,stat=info) + + end if + if (allocated(p%desc_data%matrix_data)) & + & call psb_cdfree(p%desc_data,info) + + if (allocated(p%dprcparm)) then + deallocate(p%dprcparm,stat=info) + end if + + if (allocated(p%perm)) then + deallocate(p%perm,stat=info) + endif + + if (allocated(p%invperm)) then + deallocate(p%invperm,stat=info) + endif + + if (allocated(p%iprcparm)) then + deallocate(p%iprcparm,stat=info) + end if + call psb_nullify_baseprec(p) + end subroutine psb_zbase_precfree + + subroutine psb_nullify_zbaseprec(p) + type(psb_zbaseprc_type), intent(inout) :: p + + + + end subroutine psb_nullify_zbaseprec + + + function pr_to_str(iprec) + + integer, intent(in) :: iprec + character(len=10) :: pr_to_str + + select case(iprec) + case(noprec_) + pr_to_str='NOPREC' + case(diagsc_) + pr_to_str='DIAGSC' + case(bja_) + pr_to_str='BJA' + case default + pr_to_str='???' + end select + + end function pr_to_str + +end module psb_prec_type diff --git a/baseprec/psb_zbaseprc_aply.f90 b/baseprec/psb_zbaseprc_aply.f90 new file mode 100644 index 00000000..8c1196f2 --- /dev/null +++ b/baseprec/psb_zbaseprc_aply.f90 @@ -0,0 +1,150 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) + ! + ! Compute Y <- beta*Y + alpha*K^-1 X + ! where K is a a basic preconditioner stored in prec + ! + + use psb_base_mod + use psb_prec_type + implicit none + + type(psb_desc_type),intent(in) :: desc_data + type(psb_zbaseprc_type), intent(in) :: prec + complex(kind(0.d0)),intent(inout) :: x(:), y(:) + complex(kind(0.d0)),intent(in) :: alpha,beta + character(len=1) :: trans + complex(kind(0.d0)),target :: work(:) + integer, intent(out) :: info + + ! Local variables + integer :: n_row,n_col, int_err(5) + complex(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:) + character ::diagl, diagu + integer :: ictxt,np,me,i, isz, nrg, err_act + real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime + logical,parameter :: debug=.false., debugprt=.false. + external mpi_wtime + character(len=20) :: name, ch_err + + interface psb_bjac_aply + subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) + use psb_base_mod + use psb_prec_type + type(psb_desc_type), intent(in) :: desc_data + type(psb_zbaseprc_type), intent(in) :: prec + complex(kind(0.d0)),intent(inout) :: x(:), y(:) + complex(kind(0.d0)),intent(in) :: alpha,beta + character(len=1) :: trans + complex(kind(0.d0)),target :: work(:) + integer, intent(out) :: info + end subroutine psb_zbjac_aply + end interface + + name='psb_baseprc_aply' + info = 0 + call psb_erractionsave(err_act) + + ictxt=desc_data%matrix_data(psb_ctxt_) + call psb_info(ictxt, me, np) + + diagl='U' + diagu='U' + + select case(trans) + case('N','n') + case('T','t','C','c') + case default + info=40 + int_err(1)=6 + ch_err(2:2)=trans + goto 9999 + end select + + select case(prec%iprcparm(p_type_)) + + case(noprec_) + + call psb_geaxpby(alpha,x,beta,y,desc_data,info) + + case(diagsc_) + + if (size(work) >= size(x)) then + ww => work + else + allocate(ww(size(x)),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + end if + + n_row=desc_data%matrix_data(psb_n_row_) + ww(1:n_row) = x(1:n_row)*prec%d(1:n_row) + call psb_geaxpby(alpha,ww,beta,y,desc_data,info) + + if (size(work) < size(x)) then + deallocate(ww,stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Deallocate') + goto 9999 + end if + end if + + case(bja_) + + call psb_bjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) + if(info.ne.0) then + info=4010 + ch_err='psb_bjac_aply' + goto 9999 + end if + + case default + write(0,*) 'Invalid PRE%PREC ',prec%iprcparm(p_type_),':',& + & min_prec_,noprec_,diagsc_,bja_ + end select + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_errpush(info,name,i_err=int_err,a_err=ch_err) + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +end subroutine psb_zbaseprc_aply + diff --git a/baseprec/psb_zbaseprc_bld.f90 b/baseprec/psb_zbaseprc_bld.f90 new file mode 100644 index 00000000..13d74e24 --- /dev/null +++ b/baseprec/psb_zbaseprc_bld.f90 @@ -0,0 +1,204 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd) + + use psb_base_mod + use psb_prec_type + Implicit None + + type(psb_zspmat_type), target :: a + type(psb_desc_type), intent(in), target :: desc_a + type(psb_zbaseprc_type),intent(inout) :: p + integer, intent(out) :: info + character, intent(in), optional :: upd + + interface psb_diagsc_bld + subroutine psb_zdiagsc_bld(a,desc_data,p,upd,info) + use psb_base_mod + use psb_prec_type + integer, intent(out) :: info + type(psb_zspmat_type), intent(in), target :: a + type(psb_desc_type),intent(in) :: desc_data + type(psb_zbaseprc_type), intent(inout) :: p + character, intent(in) :: upd + end subroutine psb_zdiagsc_bld + end interface + + interface psb_ilu_bld + subroutine psb_zilu_bld(a,desc_data,p,upd,info) + use psb_base_mod + use psb_prec_type + integer, intent(out) :: info + type(psb_zspmat_type), intent(in), target :: a + type(psb_desc_type),intent(in) :: desc_data + type(psb_zbaseprc_type), intent(inout) :: p + character, intent(in) :: upd + end subroutine psb_zilu_bld + end interface + + ! Local scalars + Integer :: err, nnzero, n_row, n_col,I,j,k,ictxt,& + & me,mycol,np,npcol,mglob,lw, mtype, nrg, nzg, err_act + real(kind(1.d0)) :: temp, real_err(5) + real(kind(1.d0)),pointer :: gd(:), work(:) + integer :: int_err(5) + character :: iupd + + logical, parameter :: debug=.false. + integer,parameter :: iroot=0,iout=60,ilout=40 + character(len=20) :: name, ch_err + + if(psb_get_errstatus().ne.0) return + info=0 + err=0 + call psb_erractionsave(err_act) + name = 'psb_baseprc_bld' + + if (debug) write(0,*) 'Entering baseprc_bld' + info = 0 + int_err(1) = 0 + ictxt = psb_cd_get_context(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) + if (debug) write(0,*) 'Preconditioner Blacs_gridinfo' + call psb_info(ictxt, me, np) + + if (present(upd)) then + if (debug) write(0,*) 'UPD ', upd + if ((UPD.eq.'F').or.(UPD.eq.'T')) then + IUPD=UPD + else + IUPD='F' + endif + else + IUPD='F' + endif + + ! + ! Should add check to ensure all procs have the same... + ! + ! ALso should define symbolic names for the preconditioners. + ! + + call psb_check_def(p%iprcparm(p_type_),'base_prec',& + & diagsc_,is_legal_base_prec) + + call psb_nullify_desc(p%desc_data) + + select case(p%iprcparm(p_type_)) + case (noprec_) + ! Do nothing. + call psb_cdcpy(desc_a,p%desc_data,info) + if(info /= 0) then + info=4010 + ch_err='psb_cdcpy' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + case (diagsc_) + + call psb_diagsc_bld(a,desc_a,p,iupd,info) + if(debug) write(0,*)me,': out of psb_diagsc_bld' + if(info /= 0) then + info=4010 + ch_err='psb_diagsc_bld' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + case (bja_) + + call psb_check_def(p%iprcparm(iren_),'renumbering',& + & renum_none_,is_legal_renum) + call psb_check_def(p%iprcparm(f_type_),'fact',& + & f_ilu_n_,is_legal_ml_fact) + + if (debug) write(0,*)me, ': Calling PSB_ILU_BLD' + if (debug) call psb_barrier(ictxt) + call psb_cdcpy(desc_a,p%desc_data,info) + if(info /= 0) then + info=4010 + ch_err='psb_cdcpy' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + select case(p%iprcparm(f_type_)) + + case(f_ilu_n_,f_ilu_e_) + call psb_ilu_bld(a,desc_a,p,iupd,info) + if(debug) write(0,*)me,': out of psb_ilu_bld' + if (debug) call psb_barrier(ictxt) + if(info /= 0) then + info=4010 + ch_err='psb_ilu_bld' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + case(f_none_) + write(0,*) 'Fact=None in BASEPRC_BLD Bja/ASM??' + info=4010 + ch_err='Inconsistent prec f_none_' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + + case default + write(0,*) 'Unknown factor type in baseprc_bld bja/asm: ',& + &p%iprcparm(f_type_) + info=4010 + ch_err='Unknown f_type_' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end select + case default + info=4010 + ch_err='Unknown p_type_' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + + end select + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +end subroutine psb_zbaseprc_bld + diff --git a/baseprec/psb_zbjac_aply.f90 b/baseprec/psb_zbjac_aply.f90 new file mode 100644 index 00000000..54bbb083 --- /dev/null +++ b/baseprec/psb_zbjac_aply.f90 @@ -0,0 +1,211 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) + ! + ! Compute Y <- beta*Y + alpha*K^-1 X + ! where K is a a Block Jacobi preconditioner stored in prec + ! Note that desc_data may or may not be the same as prec%desc_data, + ! but since both are INTENT(IN) this should be legal. + ! + + use psb_base_mod + use psb_prec_type + implicit none + + type(psb_desc_type), intent(in) :: desc_data + type(psb_zbaseprc_type), intent(in) :: prec + complex(kind(0.d0)),intent(inout) :: x(:), y(:) + complex(kind(0.d0)),intent(in) :: alpha,beta + character(len=1) :: trans + complex(kind(0.d0)),target :: work(:) + integer, intent(out) :: info + + ! Local variables + integer :: n_row,n_col + complex(kind(1.d0)), pointer :: ww(:), aux(:), tx(:),ty(:),tb(:) + character ::diagl, diagu + integer :: ictxt,np,me,i, isz, nrg, err_act, int_err(5) + real(kind(1.d0)) :: t1, t2, t3, t4, t5, t6, t7, mpi_wtime + logical,parameter :: debug=.false., debugprt=.false. + external mpi_wtime + character(len=20) :: name, ch_err + + name='psb_bjac_aply' + info = 0 + call psb_erractionsave(err_act) + + ictxt=psb_cd_get_context(desc_data) + call psb_info(ictxt, me, np) + + diagl='U' + diagu='U' + + select case(trans) + case('N','n') + case('T','t','C','c') + case default + call psb_errpush(40,name) + goto 9999 + end select + + + n_row=desc_data%matrix_data(psb_n_row_) + n_col=desc_data%matrix_data(psb_n_col_) + + if (n_col <= size(work)) then + ww => work(1:n_col) + if ((4*n_col+n_col) <= size(work)) then + aux => work(n_col+1:) + else + allocate(aux(4*n_col),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + endif + else + allocate(ww(n_col),aux(4*n_col),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + endif + + + if (prec%iprcparm(jac_sweeps_) == 1) then + + + select case(prec%iprcparm(f_type_)) + case(f_ilu_n_,f_ilu_e_) + + select case(trans) + case('N','n') + + call psb_spsm(zone,prec%av(l_pr_),x,zzero,ww,desc_data,info,& + & trans='N',unit=diagl,choice=psb_none_,work=aux) + if(info /=0) goto 9999 + ww(1:n_row) = ww(1:n_row)*prec%d(1:n_row) + call psb_spsm(alpha,prec%av(u_pr_),ww,beta,y,desc_data,info,& + & trans='N',unit=diagu,choice=psb_none_, work=aux) + if(info /=0) goto 9999 + + case('T','t','C','c') + call psb_spsm(zone,prec%av(u_pr_),x,zzero,ww,desc_data,info,& + & trans=trans,unit=diagu,choice=psb_none_, work=aux) + if(info /=0) goto 9999 + ww(1:n_row) = ww(1:n_row)*prec%d(1:n_row) + call psb_spsm(alpha,prec%av(l_pr_),ww,beta,y,desc_data,info,& + & trans=trans,unit=diagl,choice=psb_none_,work=aux) + if(info /=0) goto 9999 + + end select + + + case default + write(0,*) 'Unknown factorization type in bjac_aply',prec%iprcparm(f_type_) + end select + if (debugprt) write(0,*)' Y: ',y(:) + + else if (prec%iprcparm(jac_sweeps_) > 1) then + + ! Note: we have to add TRANS to this one !!!!!!!!! + + if (size(prec%av) < ap_nd_) then + info = 4011 + goto 9999 + endif + + allocate(tx(n_col),ty(n_col),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + tx = zzero + ty = zzero + select case(prec%iprcparm(f_type_)) + case(f_ilu_n_,f_ilu_e_) + do i=1, prec%iprcparm(jac_sweeps_) + ! X(k+1) = M^-1*(b-N*X(k)) + ty(1:n_row) = x(1:n_row) + call psb_spmm(-zone,prec%av(ap_nd_),tx,zone,ty,& + & prec%desc_data,info,work=aux) + if(info /=0) goto 9999 + call psb_spsm(zone,prec%av(l_pr_),ty,zzero,ww,& + & prec%desc_data,info,& + & trans='N',unit='U',choice=psb_none_,work=aux) + if(info /=0) goto 9999 + ww(1:n_row) = ww(1:n_row)*prec%d(1:n_row) + call psb_spsm(zone,prec%av(u_pr_),ww,zzero,tx,& + & prec%desc_data,info,& + & trans='N',unit='U',choice=psb_none_,work=aux) + if(info /=0) goto 9999 + end do + + end select + + call psb_geaxpby(alpha,tx,beta,y,desc_data,info) + + + deallocate(tx,ty) + + + else + + goto 9999 + + endif + + if (n_col <= size(work)) then + if ((4*n_col+n_col) <= size(work)) then + else + deallocate(aux) + endif + else + deallocate(ww,aux) + endif + + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_errpush(info,name,i_err=int_err,a_err=ch_err) + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +end subroutine psb_zbjac_aply + diff --git a/baseprec/psb_zdiagsc_bld.f90 b/baseprec/psb_zdiagsc_bld.f90 new file mode 100644 index 00000000..66162ca9 --- /dev/null +++ b/baseprec/psb_zdiagsc_bld.f90 @@ -0,0 +1,158 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info) + + use psb_base_mod + use psb_prec_type + Implicit None + + type(psb_zspmat_type), target :: a + type(psb_desc_type), intent(in) :: desc_a + type(psb_zbaseprc_type),intent(inout) :: p + character, intent(in) :: upd + integer, intent(out) :: info + + + ! Local scalars + Integer :: err, n_row, n_col,I,j,k,ictxt,& + & me,np,mglob,lw, err_act + complex(kind(1.d0)),pointer :: gd(:), work(:) + integer :: int_err(5) + character :: iupd + + logical, parameter :: debug=.false. + integer,parameter :: iroot=0,iout=60,ilout=40 + character(len=20) :: name, ch_err + + if(psb_get_errstatus().ne.0) return + info=0 + err=0 + call psb_erractionsave(err_act) + name = 'psb_diagsc_bld' + + if (debug) write(0,*) 'Entering diagsc_bld' + info = 0 + int_err(1) = 0 + ictxt = psb_cd_get_context(desc_a) + n_row = psb_cd_get_local_rows(desc_a) + n_col = psb_cd_get_local_cols(desc_a) + mglob = psb_cd_get_global_rows(desc_a) + + if (debug) write(0,*) 'Preconditioner Blacs_gridinfo' + call psb_info(ictxt, me, np) + + if (debug) write(0,*) 'Precond: Diagonal scaling' + ! diagonal scaling + + call psb_realloc(n_col,p%d,info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='psb_realloc') + goto 9999 + end if + + call psb_csrws(p%d,a,info,trans='N') + if(info /= 0) then + info=4010 + ch_err='psb_csrws' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (debug) write(ilout+me,*) 'VDIAG ',n_row + do i=1,n_row + if (p%d(i) == zzero) then + p%d(i) = zone + else + p%d(i) = zone/p%d(i) + endif + + if (debug) write(ilout+me,*) i,desc_a%loc_to_glob(i), p%d(i) +!!$ if (p%d(i).lt.0.d0) then +!!$ write(0,*) me,'Negative RWS? ',i,p%d(i) +!!$ endif + end do + if (a%pl(1) /= 0) then + allocate(work(n_row),stat=info) + if (info /= 0) then + info=4000 + call psb_errpush(info,name) + goto 9999 + end if + call psb_gelp('n',a%pl,p%d,desc_a,info) + if(info /= 0) then + info=4010 + ch_err='psb_zgelp' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + deallocate(work) + endif + + if (debug) then + allocate(gd(mglob),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + call psb_gather(gd, p%d, desc_a, info, iroot=iroot) + if(info /= 0) then + info=4010 + ch_err='psb_zgatherm' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (me.eq.iroot) then + write(iout+np,*) 'VDIAG CHECK ',mglob + do i=1,mglob + write(iout+np,*) i,gd(i) + enddo + endif + deallocate(gd) + endif + if (debug) write(*,*) 'Preconditioner DIAG computed OK' + + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +end subroutine psb_zdiagsc_bld + diff --git a/baseprec/psb_zilu_bld.f90 b/baseprec/psb_zilu_bld.f90 new file mode 100644 index 00000000..a1f95a38 --- /dev/null +++ b/baseprec/psb_zilu_bld.f90 @@ -0,0 +1,284 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_zilu_bld(a,desc_a,p,upd,info) + use psb_base_mod + use psb_prec_type + implicit none + ! + ! .. Scalar Arguments .. + integer, intent(out) :: info + ! .. array Arguments .. + type(psb_zspmat_type), intent(in), target :: a + type(psb_zbaseprc_type), intent(inout) :: p + type(psb_desc_type), intent(in) :: desc_a + character, intent(in) :: upd + + ! .. Local Scalars .. + integer :: i, j, jj, k, kk, m + integer :: int_err(5) + character :: trans, unitd + type(psb_zspmat_type) :: blck, atmp + real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,mpi_wtime, t7, t8 + external mpi_wtime + logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false. + integer nztota, nztotb, nztmp, nzl, nnr, ir, err_act,& + & n_row, nrow_a,n_col, nhalo, ind, iind, i1,i2,ia + integer :: ictxt,np,me + character(len=20) :: name, ch_err + + interface psb_ilu_fct + subroutine psb_zilu_fct(a,l,u,d,info,blck) + use psb_base_mod + integer, intent(out) :: info + type(psb_zspmat_type),intent(in) :: a + type(psb_zspmat_type),intent(inout) :: l,u + type(psb_zspmat_type),intent(in), optional, target :: blck + complex(kind(1.d0)), intent(inout) :: d(:) + end subroutine psb_zilu_fct + end interface + + interface psb_sp_renum + subroutine psb_zsp_renum(a,desc_a,p,atmp,info) + use psb_base_mod + use psb_prec_type + implicit none + + ! .. array Arguments .. + type(psb_zspmat_type), intent(in) :: a + type(psb_zspmat_type), intent(inout) :: atmp + type(psb_zbaseprc_type), intent(inout) :: p + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + end subroutine psb_zsp_renum + end interface + + if(psb_get_errstatus().ne.0) return + info=0 + name='psb_ilu_bld' + call psb_erractionsave(err_act) + + ictxt=psb_cd_get_context(desc_a) + call psb_info(ictxt, me, np) + + m = a%m + if (m < 0) then + info = 10 + int_err(1) = 1 + int_err(2) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + trans = 'N' + unitd = 'U' + call psb_nullify_sp(atmp) + + if (allocated(p%av)) then + if (size(p%av) < bp_ilu_avsz) then + call psb_errpush(4010,name,a_err='Insufficient av size') + goto 9999 + endif + else + call psb_errpush(4010,name,a_err='AV not associated') + goto 9999 + endif +!!$ call psb_csprt(50+me,a,head='% (A)') + + nrow_a = psb_cd_get_local_rows(desc_a) + nztota = psb_sp_get_nnzeros(a) + if (debug) write(0,*)me,': out get_nnzeros',nztota + if (debug) call psb_barrier(ictxt) + + n_col = psb_cd_get_local_cols(desc_a) + nhalo = n_col-nrow_a + n_row = p%desc_data%matrix_data(psb_n_row_) + p%av(l_pr_)%m = n_row + p%av(l_pr_)%k = n_row + p%av(u_pr_)%m = n_row + p%av(u_pr_)%k = n_row + call psb_sp_all(n_row,n_row,p%av(l_pr_),nztota,info) + if (info == 0) call psb_sp_all(n_row,n_row,p%av(u_pr_),nztota,info) + if(info/=0) then + info=4010 + ch_err='psb_sp_all' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (allocated(p%d)) then + if (size(p%d) < n_row) then + deallocate(p%d) + endif + endif + if (.not.allocated(p%d)) then + allocate(p%d(n_row),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + endif + + if (p%iprcparm(iren_) > 0) then + + ! + ! Here we allocate a full copy to hold local A and received BLK + ! + + nztota = psb_sp_get_nnzeros(a) + call psb_sp_all(atmp,nztota,info) + if(info/=0) then + info=4011 + call psb_errpush(info,name) + goto 9999 + end if + + + ! write(0,*) 'ILU_BLD ',nztota,nztotb,a%m + + call psb_sp_renum(a,desc_a,p,atmp,info) + + if(info/=0) then + info=4010 + ch_err='psb_sp_renum' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + t3 = mpi_wtime() + if (debugprt) then + call psb_barrier(ictxt) + open(40+me) + call psb_csprt(40+me,atmp,head='% Local matrix') + close(40+me) + endif + if (debug) write(0,*) me,' Factoring rows ',& + &atmp%m,a%m,atmp%ia2(atmp%m+1)-1 + + ! + ! Ok, factor the matrix. + ! + t5 = mpi_wtime() + blck%m=0 + call psb_ilu_fct(atmp,p%av(l_pr_),p%av(u_pr_),p%d,info) + if(info/=0) then + info=4010 + ch_err='psb_ilu_fct' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + call psb_sp_free(atmp,info) + if(info/=0) then + info=4010 + ch_err='psb_sp_free' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + + else if (p%iprcparm(iren_) == 0) then + t3 = mpi_wtime() + ! This is where we have mo renumbering, thus no need + ! for ATMP + + if (debugprt) then + open(40+me) + call psb_barrier(ictxt) + call psb_csprt(40+me,a,iv=p%desc_data%loc_to_glob,& + & head='% Local matrix') + close(40+me) + endif + + t5= mpi_wtime() + if (debug) write(0,*) me,' Going for ilu_fct' + if (debug) call psb_barrier(ictxt) + call psb_ilu_fct(a,p%av(l_pr_),p%av(u_pr_),p%d,info) + if(info/=0) then + info=4010 + ch_err='psb_ilu_fct' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + if (debug) write(0,*) me,' Done dilu_fct' + endif + + + if (debugprt) then + ! + ! Print out the factors on file. + ! + open(80+me) + + call psb_csprt(80+me,p%av(l_pr_),head='% Local L factor') + write(80+me,*) '% Diagonal: ',p%av(l_pr_)%m + do i=1,p%av(l_pr_)%m + write(80+me,*) i,i,p%d(i) + enddo + call psb_csprt(80+me,p%av(u_pr_),head='% Local U factor') + + close(80+me) + endif + + + ! ierr = MPE_Log_event( ifcte, 0, "st SIMPLE" ) + t6 = mpi_wtime() + ! + ! write(0,'(i3,1x,a,3(1x,g18.9))') me,'renum/factor time',t3-t2,t6-t5 + ! if (me==0) write(0,'(a,3(1x,g18.9))') 'renum/factor time',t3-t2,t6-t5 + + if (psb_sp_getifld(psb_upd_,p%av(u_pr_),info) /= psb_upd_perm_) then + call psb_sp_trimsize(p%av(u_pr_),i1,i2,ia,info) + if (info == 0) call psb_sp_reall(p%av(u_pr_),i1,i2,ia,info) + endif + + if (psb_sp_getifld(psb_upd_,p%av(l_pr_),info) /= psb_upd_perm_) then + call psb_sp_trimsize(p%av(l_pr_),i1,i2,ia,info) + if (info == 0) call psb_sp_reall(p%av(l_pr_),i1,i2,ia,info) + endif + + + if (debug) write(0,*) me,'End of ilu_bld' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + + +end subroutine psb_zilu_bld + + diff --git a/baseprec/psb_zilu_fct.f90 b/baseprec/psb_zilu_fct.f90 new file mode 100644 index 00000000..df1773b9 --- /dev/null +++ b/baseprec/psb_zilu_fct.f90 @@ -0,0 +1,465 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_zilu_fct(a,l,u,d,info,blck) + + ! + ! This routine copies and factors "on the fly" from A and BLCK + ! into L/D/U. + ! + ! + use psb_base_mod + implicit none + ! .. Scalar Arguments .. + integer, intent(out) :: info + ! .. Array Arguments .. + type(psb_zspmat_type),intent(in) :: a + type(psb_zspmat_type),intent(inout) :: l,u + type(psb_zspmat_type),intent(in), optional, target :: blck + complex(kind(1.d0)), intent(inout) :: d(:) + ! .. Local Scalars .. + integer :: i, j, jj, k, kk, l1, l2, ll, low1, low2,m,ma,err_act + type(psb_zspmat_type), pointer :: blck_ + character(len=20) :: name, ch_err + name='psb_zcsrlu' + info = 0 + call psb_erractionsave(err_act) + ! .. Executable Statements .. + ! + + if (present(blck)) then + blck_ => blck + else + allocate(blck_,stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + call psb_nullify_sp(blck_) ! Why do we need this? Who knows.... + call psb_sp_all(0,0,blck_,1,info) + if(info.ne.0) then + info=4010 + ch_err='psb_sp_all' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + blck_%m=0 + endif + + call psb_zilu_fctint(m,a%m,a,blck_%m,blck_,& + & d,l%aspk,l%ia1,l%ia2,u%aspk,u%ia1,u%ia2,l1,l2,info) + if(info.ne.0) then + info=4010 + ch_err='psb_zilu_fctint' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + l%infoa(1) = l1 + l%fida = 'CSR' + l%descra = 'TLU' + u%infoa(1) = l2 + u%fida = 'CSR' + u%descra = 'TUU' + l%m = m + l%k = m + u%m = m + u%k = m + if (present(blck)) then + blck_ => null() + else + call psb_sp_free(blck_,info) + if(info.ne.0) then + info=4010 + ch_err='psb_sp_free' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + deallocate(blck_) + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +contains + subroutine psb_zilu_fctint(m,ma,a,mb,b,& + & d,laspk,lia1,lia2,uaspk,uia1,uia2,l1,l2,info) + implicit none + + type(psb_zspmat_type) :: a,b + integer :: m,ma,mb,l1,l2,info + integer, dimension(*) :: lia1,lia2,uia1,uia2 + complex(kind(1.d0)), dimension(*) :: laspk,uaspk,d + + integer :: i,j,k,l,low1,low2,kk,jj,ll, irb, ktrw,err_act + complex(kind(1.d0)) :: dia,temp + integer, parameter :: nrb=16 + logical,parameter :: debug=.false. + type(psb_zspmat_type) :: trw + integer :: int_err(5) + character(len=20) :: name, ch_err + + name='psb_zilu_fctint' + if(psb_get_errstatus().ne.0) return + info=0 + call psb_erractionsave(err_act) + call psb_nullify_sp(trw) + trw%m=0 + trw%k=0 + if(debug) write(0,*)'LUINT Allocating TRW' + call psb_sp_all(trw,1,info) + if(info.ne.0) then + info=4010 + ch_err='psb_sp_all' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + if(debug) write(0,*)'LUINT Done Allocating TRW' + lia2(1) = 1 + uia2(1) = 1 + l1=0 + l2=0 + m = ma+mb + if(debug) write(0,*)'In DCSRLU Begin cycle',m,ma,mb + + do i = 1, ma + if(debug) write(0,*)'LUINT: Loop index ',i,ma + d(i) = zzero + + ! + ! Here we take a fast shortcut if possible, otherwise + ! use spgtblk, slower but able (in principle) to handle + ! anything. + ! + if (a%fida=='CSR') then + do j = a%ia2(i), a%ia2(i+1) - 1 + k = a%ia1(j) + ! write(0,*)'KKKKK',k + if ((k < i).and.(k >= 1)) then + l1 = l1 + 1 + laspk(l1) = a%aspk(j) + lia1(l1) = k + else if (k == i) then + d(i) = a%aspk(j) + else if ((k > i).and.(k <= m)) then + l2 = l2 + 1 + uaspk(l2) = a%aspk(j) + uia1(l2) = k + end if + enddo + + else + + if ((mod(i,nrb) == 1).or.(nrb==1)) then + irb = min(ma-i+1,nrb) + call psb_sp_getblk(i,a,trw,info,lrw=i+irb-1) + if(info.ne.0) then + info=4010 + ch_err='psb_sp_getblk' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ktrw=1 + end if + + do + if (ktrw > trw%infoa(psb_nnz_)) exit + if (trw%ia1(ktrw) > i) exit + k = trw%ia2(ktrw) + if ((k < i).and.(k >= 1)) then + l1 = l1 + 1 + laspk(l1) = trw%aspk(ktrw) + lia1(l1) = k + else if (k == i) then + d(i) = trw%aspk(ktrw) + else if ((k > i).and.(k <= m)) then + l2 = l2 + 1 + uaspk(l2) = trw%aspk(ktrw) + uia1(l2) = k + end if + ktrw = ktrw + 1 + enddo + + end if + +!!$ + + lia2(i+1) = l1 + 1 + uia2(i+1) = l2 + 1 + + dia = d(i) + do kk = lia2(i), lia2(i+1) - 1 + ! + ! compute element alo(i,k) of incomplete factorization + ! + temp = laspk(kk) + k = lia1(kk) + laspk(kk) = temp*d(k) + ! update the rest of row i using alo(i,k) + low1 = kk + 1 + low2 = uia2(i) + updateloop: do jj = uia2(k), uia2(k+1) - 1 + j = uia1(jj) + ! + if (j < i) then + ! search alo(i,*) for matching index J + do ll = low1, lia2(i+1) - 1 + l = lia1(ll) + if (l > j) then + low1 = ll + exit + else if (l == j) then + laspk(ll) = laspk(ll) - temp*uaspk(jj) + low1 = ll + 1 + cycle updateloop + end if + enddo + ! + else if (j == i) then + ! j=i update diagonal + ! write(0,*)'aggiorno dia',dia,'temp',temp,'jj',jj,'u%aspk',uaspk(jj) + dia = dia - temp*uaspk(jj) + ! write(0,*)'dia',dia,'temp',temp,'jj',jj,'aspk',uaspk(jj) + cycle updateloop + ! + else if (j > i) then + ! search aup(i,*) for matching index j + do ll = low2, uia2(i+1) - 1 + l = uia1(ll) + if (l > j) then + low2 = ll + exit + else if (l == j) then + uaspk(ll) = uaspk(ll) - temp*uaspk(jj) + low2 = ll + 1 + cycle updateloop + end if + enddo + end if + ! + ! for milu al=1.; for ilu al=0. + ! al = 1.d0 + ! dia = dia - al*temp*aup(jj) + enddo updateloop + enddo + ! + ! + ! Non singularity + ! + if (abs(dia) < epstol) then + ! + ! Pivot too small: unstable factorization + ! + info = 2 + int_err(1) = i + write(ch_err,'(g20.10)') abs(dia) + call psb_errpush(info,name,i_err=int_err,a_err=ch_err) + goto 9999 + else + dia = zone/dia + end if + d(i) = dia + ! write(6,*)'diag(',i,')=',d(i) + ! Scale row i of upper triangle + do kk = uia2(i), uia2(i+1) - 1 + uaspk(kk) = uaspk(kk)*dia + enddo + enddo + + do i = ma+1, m + d(i) = zzero + + + if (b%fida=='CSR') then + + do j = b%ia2(i-ma), b%ia2(i-ma+1) - 1 + k = b%ia1(j) + ! if (me.eq.2) write(0,*)'ecco k=',k + if ((k < i).and.(k >= 1)) then + l1 = l1 + 1 + laspk(l1) = b%aspk(j) + lia1(l1) = k + ! if(me.eq.2) write(0,*)'scrivo l' + else if (k == i) then + d(i) = b%aspk(j) + else if ((k > i).and.(k <= m)) then + l2 = l2 + 1 + uaspk(l2) = b%aspk(j) + ! write(0,*)'KKKKK',k + uia1(l2) = k + end if + enddo + + else + + if ((mod((i-ma),nrb) == 1).or.(nrb==1)) then + irb = min(m-i+1,nrb) + call psb_sp_getblk(i-ma,b,trw,info,lrw=i-ma+irb-1) + if(info.ne.0) then + info=4010 + ch_err='psb_sp_getblk' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ktrw=1 + end if + + do + if (ktrw > trw%infoa(psb_nnz_)) exit + if (trw%ia1(ktrw) > i) exit + k = trw%ia2(ktrw) + ! write(0,*)'KKKKK',k + if ((k < i).and.(k >= 1)) then + l1 = l1 + 1 + laspk(l1) = trw%aspk(ktrw) + lia1(l1) = k + else if (k == i) then + d(i) = trw%aspk(ktrw) + else if ((k > i).and.(k <= m)) then + l2 = l2 + 1 + uaspk(l2) = trw%aspk(ktrw) + uia1(l2) = k + end if + ktrw = ktrw + 1 + enddo + + endif + + + lia2(i+1) = l1 + 1 + uia2(i+1) = l2 + 1 + + dia = d(i) + do kk = lia2(i), lia2(i+1) - 1 + ! + ! compute element alo(i,k) of incomplete factorization + ! + temp = laspk(kk) + k = lia1(kk) + laspk(kk) = temp*d(k) + ! update the rest of row i using alo(i,k) + low1 = kk + 1 + low2 = uia2(i) + updateloopb: do jj = uia2(k), uia2(k+1) - 1 + j = uia1(jj) + ! + if (j < i) then + ! search alo(i,*) for matching index J + do ll = low1, lia2(i+1) - 1 + l = lia1(ll) + if (l > j) then + low1 = ll + exit + else if (l == j) then + laspk(ll) = laspk(ll) - temp*uaspk(jj) + low1 = ll + 1 + cycle updateloopb + end if + enddo + ! + else if (j == i) then + ! j=i update diagonal + dia = dia - temp*uaspk(jj) + cycle updateloopb + ! + else if (j > i) then + ! search aup(i,*) for matching index j + do ll = low2, uia2(i+1) - 1 + l = uia1(ll) + if (l > j) then + low2 = ll + exit + else if (l == j) then + uaspk(ll) = uaspk(ll) - temp*uaspk(jj) + low2 = ll + 1 + cycle updateloopb + end if + enddo + end if + ! + ! for milu al=1.; for ilu al=0. + ! al = 1.d0 + ! dia = dia - al*temp*aup(jj) + enddo updateloopb + enddo + ! + ! + ! Non singularity + ! + if (abs(dia) < epstol) then + ! + ! Pivot too small: unstable factorization + ! + int_err(1) = i + write(ch_err,'(g20.10)') abs(dia) + info = 2 + call psb_errpush(info,name,i_err=int_err,a_err=ch_err) + goto 9999 + else + dia = zone/dia + end if + d(i) = dia + ! Scale row i of upper triangle + do kk = uia2(i), uia2(i+1) - 1 + uaspk(kk) = uaspk(kk)*dia + enddo + enddo + + call psb_sp_free(trw,info) + if(info.ne.0) then + info=4010 + ch_err='psb_sp_free' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + if(debug) write(0,*)'Leaving ilu_fct' + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + end subroutine psb_zilu_fctint +end subroutine psb_zilu_fct diff --git a/baseprec/psb_zprc_aply.f90 b/baseprec/psb_zprc_aply.f90 new file mode 100644 index 00000000..1b75b10c --- /dev/null +++ b/baseprec/psb_zprc_aply.f90 @@ -0,0 +1,223 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work) + + use psb_base_mod + use psb_prec_type + implicit none + + type(psb_desc_type),intent(in) :: desc_data + type(psb_zprec_type), intent(in) :: prec + complex(kind(0.d0)),intent(inout) :: x(:), y(:) + integer, intent(out) :: info + character(len=1), optional :: trans + complex(kind(0.d0)), optional, target :: work(:) + + ! Local variables + character :: trans_ + complex(kind(1.d0)), pointer :: work_(:) + integer :: ictxt,np,me,err_act + logical,parameter :: debug=.false., debugprt=.false. + external mpi_wtime + character(len=20) :: name + + interface psb_baseprc_aply + subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) + use psb_base_mod + use psb_prec_type + type(psb_desc_type),intent(in) :: desc_data + type(psb_zbaseprc_type), intent(in) :: prec + complex(kind(0.d0)),intent(inout) :: x(:), y(:) + complex(kind(0.d0)),intent(in) :: alpha,beta + character(len=1) :: trans + complex(kind(0.d0)),target :: work(:) + integer, intent(out) :: info + end subroutine psb_zbaseprc_aply + end interface + + name='psb_prc_aply' + info = 0 + call psb_erractionsave(err_act) + + ictxt=desc_data%matrix_data(psb_ctxt_) + call psb_info(ictxt, me, np) + + if (present(trans)) then + trans_=trans + else + trans_='N' + end if + + if (present(work)) then + work_ => work + else + allocate(work_(4*desc_data%matrix_data(psb_n_col_)),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + end if + if (.not.(allocated(prec%baseprecv))) then + write(0,*) 'Inconsistent preconditioner: neither SMTH nor BASE?' + end if + + if (size(prec%baseprecv) == 1) then + call psb_baseprc_aply(zone,prec%baseprecv(1),x,zzero,y,desc_data,trans_, work_,info) + else + write(0,*) 'Inconsistent preconditioner: size of baseprecv???' + endif + + if (present(work)) then + else + deallocate(work_) + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +end subroutine psb_zprc_aply + + +!!$ +!!$ +!!$ MD2P4 +!!$ Multilevel Domain Decomposition Parallel Preconditioner Package for PSBLAS +!!$ for +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ Daniela di Serafino Second University of Naples +!!$ Pasqua D'Ambra ICAR-CNR +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the MD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_zprc_aply1(prec,x,desc_data,info,trans) + + use psb_base_mod + use psb_prec_type + implicit none + + type(psb_desc_type),intent(in) :: desc_data + type(psb_zprec_type), intent(in) :: prec + complex(kind(0.d0)),intent(inout) :: x(:) + integer, intent(out) :: info + character(len=1), optional :: trans + logical,parameter :: debug=.false., debugprt=.false. + + interface + subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work) + + use psb_base_mod + use psb_prec_type + implicit none + + type(psb_desc_type),intent(in) :: desc_data + type(psb_zprec_type), intent(in) :: prec + complex(kind(0.d0)),intent(inout) :: x(:), y(:) + integer, intent(out) :: info + character(len=1), optional :: trans + complex(kind(0.d0)), optional, target :: work(:) + end subroutine psb_zprc_aply + end interface + + ! Local variables + character :: trans_ + integer :: ictxt,np,me,i, isz, err_act, int_err(5) + complex(kind(1.d0)), pointer :: WW(:), w1(:) + character(len=20) :: name, ch_err + name='psb_zprec1' + info = 0 + call psb_erractionsave(err_act) + + + ictxt=desc_data%matrix_data(psb_ctxt_) + call psb_info(ictxt, me, np) + if (present(trans)) then + trans_=trans + else + trans_='N' + end if + + allocate(ww(size(x)),w1(size(x)),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + if (debug) write(0,*) 'Prc_aply1 Size(x) ',size(x), size(ww),size(w1) + call psb_zprc_aply(prec,x,ww,desc_data,info,trans_,work=w1) + if(info /=0) goto 9999 + x(:) = ww(:) + deallocate(ww,W1) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_errpush(info,name) + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return +end subroutine psb_zprc_aply1 diff --git a/baseprec/psb_zprecbld.f90 b/baseprec/psb_zprecbld.f90 new file mode 100644 index 00000000..995b3730 --- /dev/null +++ b/baseprec/psb_zprecbld.f90 @@ -0,0 +1,135 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_zprecbld(a,desc_a,p,info,upd) + + use psb_base_mod + use psb_prec_type + use psb_prec_mod, only : psb_baseprc_bld + Implicit None + + type(psb_zspmat_type), target :: a + type(psb_desc_type), intent(in), target :: desc_a + type(psb_zprec_type),intent(inout) :: p + integer, intent(out) :: info + character, intent(in), optional :: upd + + + ! Local scalars + Integer :: err,i,j,k,ictxt, me,np,lw, err_act + integer :: int_err(5) + character :: iupd + + logical, parameter :: debug=.false. + integer,parameter :: iroot=0,iout=60,ilout=40 + character(len=20) :: name, ch_err + + if(psb_get_errstatus().ne.0) return + info=0 + err=0 + call psb_erractionsave(err_act) + name = 'psb_precbld' + + if (debug) write(0,*) 'Entering precbld',P%prec,desc_a%matrix_data(:) + info = 0 + int_err(1) = 0 + ictxt = psb_cd_get_context(desc_a) + + if (debug) write(0,*) 'Preconditioner psb_info' + call psb_info(ictxt, me, np) + + if (present(upd)) then + if (debug) write(0,*) 'UPD ', upd + if ((upd.eq.'F').or.(upd.eq.'T')) then + iupd=upd + else + iupd='F' + endif + else + iupd='F' + endif + + if (.not.allocated(p%baseprecv)) then + !! Error 1: should call precset + info=4010 + ch_err='unallocated bpv' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + ! + ! Should add check to ensure all procs have the same... + ! + ! ALso should define symbolic names for the preconditioners. + ! + call init_baseprc_av(p%baseprecv(1),info) + if (info /= 0) then + info=4010 + ch_err='allocate' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + endif + + call psb_baseprc_bld(a,desc_a,p%baseprecv(1),info,iupd) + if (info /= 0) then + info=4010 + ch_err='baseprc_bld' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + endif + + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +contains + + subroutine init_baseprc_av(p,info) + type(psb_zbaseprc_type), intent(inout) :: p + integer :: info + if (allocated(p%av)) then + ! Have not decided what to do yet + end if + allocate(p%av(max_avsz),stat=info) +!!$ if (info /= 0) return + do k=1,size(p%av) + call psb_nullify_sp(p%av(k)) + end do + end subroutine init_baseprc_av + +end subroutine psb_zprecbld + diff --git a/baseprec/psb_zprecfree.f90 b/baseprec/psb_zprecfree.f90 new file mode 100644 index 00000000..bcf61c95 --- /dev/null +++ b/baseprec/psb_zprecfree.f90 @@ -0,0 +1,69 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_zprecfree(p,info) + !...free sparse matrix structure... + use psb_base_mod + use psb_prec_type + implicit none + !....parameters... + + type(psb_zprec_type), intent(inout) :: p + integer, intent(out) :: info + + !...locals.... + integer :: ictxt,me, np,err_act,i + character(len=20) :: name + + if(psb_get_errstatus().ne.0) return + info=0 + name = 'pszprecfree' + call psb_erractionsave(err_act) + + me=-1 + + if (allocated(p%baseprecv)) then + do i=1,size(p%baseprecv) + call psb_base_precfree(p%baseprecv(i),info) + end do + deallocate(p%baseprecv) + end if + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +end subroutine psb_zprecfree diff --git a/baseprec/psb_zprecset.f90 b/baseprec/psb_zprecset.f90 new file mode 100644 index 00000000..24616557 --- /dev/null +++ b/baseprec/psb_zprecset.f90 @@ -0,0 +1,101 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_zprecset(p,ptype,info,iv,rs,rv,ilev,nlev) + + use psb_base_mod + use psb_prec_type + implicit none + + type(psb_zprec_type), intent(inout) :: p + character(len=*), intent(in) :: ptype + integer, intent(out) :: info + integer, optional, intent(in) :: iv(:) + integer, optional, intent(in) :: nlev,ilev + real(kind(1.d0)), optional, intent(in) :: rs + real(kind(1.d0)), optional, intent(in) :: rv(:) + + character(len=len(ptype)) :: typeup + integer :: isz, err, nlev_, ilev_, i + + info = 0 + + ilev_ = 1 + nlev_ = 1 + + if (.not.allocated(p%baseprecv)) then + allocate(p%baseprecv(nlev_),stat=err) + else + nlev_ = size(p%baseprecv) + endif + + if ((ilev_<1).or.(ilev_ > nlev_)) then + write(0,*) 'PRECSET ERRROR: ilev out of bounds' + info = -1 + return + endif + + call psb_realloc(ifpsz,p%baseprecv(ilev_)%iprcparm,info) + if (info == 0) call psb_realloc(dfpsz,p%baseprecv(ilev_)%dprcparm,info) + if (info /= 0) return + p%baseprecv(ilev_)%iprcparm(:) = 0 + + select case(toupper(ptype(1:len_trim(ptype)))) + case ('NONE','NOPREC') + p%baseprecv(ilev_)%iprcparm(:) = 0 + p%baseprecv(ilev_)%iprcparm(p_type_) = noprec_ + p%baseprecv(ilev_)%iprcparm(f_type_) = f_none_ + p%baseprecv(ilev_)%iprcparm(iren_) = 0 + p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 + + case ('DIAG','DIAGSC') + p%baseprecv(ilev_)%iprcparm(:) = 0 + p%baseprecv(ilev_)%iprcparm(p_type_) = diagsc_ + p%baseprecv(ilev_)%iprcparm(f_type_) = f_none_ + p%baseprecv(ilev_)%iprcparm(iren_) = 0 + p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 + + case ('BJA','ILU') + p%baseprecv(ilev_)%iprcparm(:) = 0 + p%baseprecv(ilev_)%iprcparm(p_type_) = bja_ + p%baseprecv(ilev_)%iprcparm(f_type_) = f_ilu_n_ + p%baseprecv(ilev_)%iprcparm(iren_) = 0 + p%baseprecv(ilev_)%iprcparm(ilu_fill_in_) = 0 + p%baseprecv(ilev_)%iprcparm(jac_sweeps_) = 1 + + case default + write(0,*) 'Unknown preconditioner type request "',ptype,'"' + err = 2 + + end select + + info = err + +end subroutine psb_zprecset diff --git a/baseprec/psb_zsp_renum.f90 b/baseprec/psb_zsp_renum.f90 new file mode 100644 index 00000000..f2f32b11 --- /dev/null +++ b/baseprec/psb_zsp_renum.f90 @@ -0,0 +1,389 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_zsp_renum(a,desc_a,p,atmp,info) + use psb_base_mod + use psb_prec_type + implicit none + + ! .. array Arguments .. + type(psb_zspmat_type), intent(in) :: a + type(psb_zspmat_type), intent(inout) :: atmp + type(psb_zbaseprc_type), intent(inout) :: p + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info + + + character(len=20) :: name, ch_err + integer nztota, nztotb, nztmp, nzl, nnr, ir, mglob, mtype, n_row, & + & nrow_a,n_col, nhalo,lovr, ind, iind, pi,nr,ns,i,j,jj,k,kk + integer ::ictxt,np,me, err_act + integer, allocatable :: itmp(:), itmp2(:) + complex(kind(1.d0)), allocatable :: ztmp(:) + real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6,mpi_wtime, t7, t8 + external mpi_wtime + + if (psb_get_errstatus().ne.0) return + info=0 + name='apply_renum' + call psb_erractionsave(err_act) + + ictxt=psb_cd_get_context(desc_a) + call psb_info(ictxt, me, np) + +!!!!!!!!!!!!!!!! CHANGE FOR NON-CSR A + ! + ! Renumbering type: + ! 1. Global column indices + ! (2. GPS band reduction disabled for the time being) + + if (p%iprcparm(iren_)==renum_glb_) then + atmp%m = a%m + atmp%k = a%k + atmp%fida='CSR' + atmp%descra = 'GUN' + + ! This is the renumbering coherent with global indices.. + mglob = psb_cd_get_global_rows(desc_a) + ! + ! Remember: we have switched IA1=COLS and IA2=ROWS + ! Now identify the set of distinct local column indices + ! + + nnr = p%desc_data%matrix_data(psb_n_row_) + allocate(p%perm(nnr),p%invperm(nnr),itmp2(nnr),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + do k=1,nnr + itmp2(k) = p%desc_data%loc_to_glob(k) + enddo + ! + ! We want: NEW(I) = OLD(PERM(I)) + ! + call isrx(nnr,itmp2,p%perm) + + do k=1, nnr + p%invperm(p%perm(k)) = k + enddo + t3 = mpi_wtime() + + ! Build ATMP with new numbering. + nztmp=size(atmp%aspk) + allocate(itmp(max(8,atmp%m+2,nztmp+2)),ztmp(atmp%m),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + j = 1 + atmp%ia2(1) = 1 + do i=1, atmp%m + ir = p%perm(i) + + if (ir <= a%m ) then + + nzl = a%ia2(ir+1) - a%ia2(ir) + if (nzl > size(ztmp)) then + call psb_realloc(nzl,ztmp,info) + if(info/=0) then + info=4010 + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + endif + jj = a%ia2(ir) + k=0 + do kk=1, nzl + if (a%ia1(jj+kk-1)<=atmp%m) then + k = k + 1 + ztmp(k) = a%aspk(jj+kk-1) + atmp%ia1(j+k-1) = p%invperm(a%ia1(jj+kk-1)) + endif + enddo + call isrx(k,atmp%ia1(j:j+k-1),itmp2) + do kk=1,k + atmp%aspk(j+kk-1) = ztmp(itmp2(kk)) + enddo + + else + write(0,*) 'Row index error 1 :',i,ir + endif + + j = j + k + atmp%ia2(i+1) = j + + enddo + + t4 = mpi_wtime() + + + deallocate(itmp,itmp2,ztmp) + + else if (p%iprcparm(iren_)==renum_gps_) then + + atmp%m = a%m + atmp%k = a%k + atmp%fida='CSR' + atmp%descra = 'GUN' + do i=1, a%m + atmp%ia2(i) = a%ia2(i) + do j= a%ia2(i), a%ia2(i+1)-1 + atmp%ia1(j) = a%ia1(j) + enddo + enddo + atmp%ia2(a%m+1) = a%ia2(a%m+1) + nztmp = atmp%ia2(atmp%m+1) - 1 + + + ! This is a renumbering with Gibbs-Poole-Stockmeyer + ! band reduction. Switched off for now. To be fixed, + ! gps_reduction should get p%perm. + + ! write(0,*) me,' Renumbering: realloc perms',atmp%m + call psb_realloc(atmp%m,p%perm,info) + if(info/=0) then + info=4010 + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + call psb_realloc(atmp%m,p%invperm,info) + if(info/=0) then + info=4010 + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + allocate(itmp(max(8,atmp%m+2,nztmp+2)),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + itmp(1:8) = 0 + ! write(0,*) me,' Renumbering: Calling Metis' + + ! write(0,*) size(p%av(u_pr_)%pl),size(p%av(l_pr_)%pr) + call gps_reduction(atmp%m,atmp%ia2,atmp%ia1,p%perm,p%invperm,info) + if(info/=0) then + info=4010 + ch_err='gps_reduction' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + ! write(0,*) me,' Renumbering: Done GPS' + ! call psb_barrier(ictxt) + do i=1, atmp%m + if (p%perm(i) /= i) then + write(0,*) me,' permutation is not identity ' + exit + endif + enddo + + + + do k=1, nnr + p%invperm(p%perm(k)) = k + enddo + t3 = mpi_wtime() + + ! Build ATMP with new numbering. + + allocate(itmp2(max(8,atmp%m+2,nztmp+2)),ztmp(atmp%m),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + j = 1 + atmp%ia2(1) = 1 + do i=1, atmp%m + ir = p%perm(i) + + if (ir <= a%m ) then + + nzl = a%ia2(ir+1) - a%ia2(ir) + if (nzl > size(ztmp)) then + call psb_realloc(nzl,ztmp,info) + if(info/=0) then + info=4010 + ch_err='psb_realloc' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + endif + jj = a%ia2(ir) + k=0 + do kk=1, nzl + if (a%ia1(jj+kk-1)<=atmp%m) then + k = k + 1 + ztmp(k) = a%aspk(jj+kk-1) + atmp%ia1(j+k-1) = p%invperm(a%ia1(jj+kk-1)) + endif + enddo + call isrx(k,atmp%ia1(j:j+k-1),itmp2) + do kk=1,k + atmp%aspk(j+kk-1) = ztmp(itmp2(kk)) + enddo + + else + write(0,*) 'Row index error 1 :',i,ir + endif + + j = j + k + atmp%ia2(i+1) = j + + enddo + + t4 = mpi_wtime() + + + + deallocate(itmp,itmp2,ztmp) + + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +contains + + + subroutine gps_reduction(m,ia,ja,perm,iperm,info) + integer i,j,dgConn,Npnt,m + integer n,idpth,ideg,ibw2,ipf2 + integer,dimension(:) :: perm,iperm,ia,ja + integer, intent(out) :: info + + integer,dimension(:,:),allocatable::NDstk + integer,dimension(:),allocatable::iOld,renum,ndeg,lvl,lvls1,lvls2,ccstor + !--- Per la common area. + + character(len=20) :: name, ch_err + + if(psb_get_errstatus().ne.0) return + info=0 + name='gps_reduction' + call psb_erractionsave(err_act) + + + !--- Calcolo il massimo grado di connettivita'. + npnt = m + write(6,*) ' GPS su ',npnt + dgConn=0 + do i=1,m + dgconn = max(dgconn,(ia(i+1)-ia(i))) + enddo + !--- Il max valore di connettivita' e "dgConn" + + !--- Valori della common + n=Npnt !--- Numero di righe + iDeg=dgConn !--- Massima connettivita' + ! iDpth= !--- Numero di livelli non serve settarlo + + allocate(NDstk(Npnt,dgConn),stat=info) + if (info/=0) then + info=4000 + call psb_errpush(info,name) + goto 9999 + else + write(0,*) 'gps_reduction first alloc OK' + endif + allocate(iOld(Npnt),renum(Npnt+1),ndeg(Npnt),lvl(Npnt),lvls1(Npnt),& + &lvls2(Npnt),ccstor(Npnt),stat=info) + if (info/=0) then + info=4000 + call psb_errpush(info,name) + goto 9999 + else + write(0,*) 'gps_reduction 2nd alloc OK' + endif + + !--- Prepariamo il grafo della matrice + Ndstk(:,:)=0 + do i=1,Npnt + k=0 + do j = ia(i),ia(i+1) - 1 + if ((1<=ja(j)).and.( ja( j ) /= i ).and.(ja(j)<=npnt)) then + k = k+1 + Ndstk(i,k)=ja(j) + endif + enddo + ndeg(i)=k + enddo + + !--- Numerazione. + do i=1,Npnt + iOld(i)=i + enddo + write(0,*) 'gps_red : Preparation done' + !--- + !--- Chiamiamo funzione reduce. + call psb_gps_reduce(Ndstk,Npnt,iOld,renum,ndeg,lvl,lvls1, lvls2,ccstor,& + & ibw2,ipf2,n,idpth,ideg) + write(0,*) 'gps_red : Done reduce' + !--- Permutazione + perm(1:Npnt)=renum(1:Npnt) + !--- Inversa permutazione + do i=1,Npnt + iperm(perm(i))=i + enddo + !--- Puliamo tutto. + deallocate(NDstk,iOld,renum,ndeg,lvl,lvls1,lvls2,ccstor) + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + + end subroutine gps_reduction + +end subroutine psb_zsp_renum diff --git a/src/methd/Makefile b/krylov/Makefile similarity index 100% rename from src/methd/Makefile rename to krylov/Makefile diff --git a/src/methd/psb_dbicg.f90 b/krylov/psb_dbicg.f90 similarity index 100% rename from src/methd/psb_dbicg.f90 rename to krylov/psb_dbicg.f90 diff --git a/src/methd/psb_dcg.f90 b/krylov/psb_dcg.f90 similarity index 100% rename from src/methd/psb_dcg.f90 rename to krylov/psb_dcg.f90 diff --git a/src/methd/psb_dcgs.f90 b/krylov/psb_dcgs.f90 similarity index 100% rename from src/methd/psb_dcgs.f90 rename to krylov/psb_dcgs.f90 diff --git a/src/methd/psb_dcgstab.f90 b/krylov/psb_dcgstab.f90 similarity index 100% rename from src/methd/psb_dcgstab.f90 rename to krylov/psb_dcgstab.f90 diff --git a/src/methd/psb_dcgstabl.f90 b/krylov/psb_dcgstabl.f90 similarity index 100% rename from src/methd/psb_dcgstabl.f90 rename to krylov/psb_dcgstabl.f90 diff --git a/src/methd/psb_dgmresr.f90 b/krylov/psb_dgmresr.f90 similarity index 100% rename from src/methd/psb_dgmresr.f90 rename to krylov/psb_dgmresr.f90 diff --git a/src/methd/psb_zcgs.f90 b/krylov/psb_zcgs.f90 similarity index 100% rename from src/methd/psb_zcgs.f90 rename to krylov/psb_zcgs.f90 diff --git a/src/methd/psb_zcgstab.f90 b/krylov/psb_zcgstab.f90 similarity index 100% rename from src/methd/psb_zcgstab.f90 rename to krylov/psb_zcgstab.f90 diff --git a/src/prec/Makefile b/mld2p4/Makefile similarity index 100% rename from src/prec/Makefile rename to mld2p4/Makefile diff --git a/src/prec/psb_dasmatbld.f90 b/mld2p4/psb_dasmatbld.f90 similarity index 100% rename from src/prec/psb_dasmatbld.f90 rename to mld2p4/psb_dasmatbld.f90 diff --git a/src/prec/psb_dbaseprc_aply.f90 b/mld2p4/psb_dbaseprc_aply.f90 similarity index 100% rename from src/prec/psb_dbaseprc_aply.f90 rename to mld2p4/psb_dbaseprc_aply.f90 diff --git a/src/prec/psb_dbaseprc_bld.f90 b/mld2p4/psb_dbaseprc_bld.f90 similarity index 100% rename from src/prec/psb_dbaseprc_bld.f90 rename to mld2p4/psb_dbaseprc_bld.f90 diff --git a/src/prec/psb_dbjac_aply.f90 b/mld2p4/psb_dbjac_aply.f90 similarity index 100% rename from src/prec/psb_dbjac_aply.f90 rename to mld2p4/psb_dbjac_aply.f90 diff --git a/src/prec/psb_dbldaggrmat.f90 b/mld2p4/psb_dbldaggrmat.f90 similarity index 100% rename from src/prec/psb_dbldaggrmat.f90 rename to mld2p4/psb_dbldaggrmat.f90 diff --git a/src/prec/psb_ddiagsc_bld.f90 b/mld2p4/psb_ddiagsc_bld.f90 similarity index 100% rename from src/prec/psb_ddiagsc_bld.f90 rename to mld2p4/psb_ddiagsc_bld.f90 diff --git a/src/prec/psb_dgenaggrmap.f90 b/mld2p4/psb_dgenaggrmap.f90 similarity index 100% rename from src/prec/psb_dgenaggrmap.f90 rename to mld2p4/psb_dgenaggrmap.f90 diff --git a/src/prec/psb_dilu_bld.f90 b/mld2p4/psb_dilu_bld.f90 similarity index 100% rename from src/prec/psb_dilu_bld.f90 rename to mld2p4/psb_dilu_bld.f90 diff --git a/src/prec/psb_dilu_fct.f90 b/mld2p4/psb_dilu_fct.f90 similarity index 100% rename from src/prec/psb_dilu_fct.f90 rename to mld2p4/psb_dilu_fct.f90 diff --git a/src/prec/psb_dmlprc_aply.f90 b/mld2p4/psb_dmlprc_aply.f90 similarity index 100% rename from src/prec/psb_dmlprc_aply.f90 rename to mld2p4/psb_dmlprc_aply.f90 diff --git a/src/prec/psb_dmlprc_bld.f90 b/mld2p4/psb_dmlprc_bld.f90 similarity index 100% rename from src/prec/psb_dmlprc_bld.f90 rename to mld2p4/psb_dmlprc_bld.f90 diff --git a/src/prec/psb_dprc_aply.f90 b/mld2p4/psb_dprc_aply.f90 similarity index 100% rename from src/prec/psb_dprc_aply.f90 rename to mld2p4/psb_dprc_aply.f90 diff --git a/src/prec/psb_dprecbld.f90 b/mld2p4/psb_dprecbld.f90 similarity index 100% rename from src/prec/psb_dprecbld.f90 rename to mld2p4/psb_dprecbld.f90 diff --git a/src/prec/psb_dprecfree.f90 b/mld2p4/psb_dprecfree.f90 similarity index 100% rename from src/prec/psb_dprecfree.f90 rename to mld2p4/psb_dprecfree.f90 diff --git a/src/prec/psb_dprecset.f90 b/mld2p4/psb_dprecset.f90 similarity index 100% rename from src/prec/psb_dprecset.f90 rename to mld2p4/psb_dprecset.f90 diff --git a/src/prec/psb_dslu_bld.f90 b/mld2p4/psb_dslu_bld.f90 similarity index 100% rename from src/prec/psb_dslu_bld.f90 rename to mld2p4/psb_dslu_bld.f90 diff --git a/src/prec/psb_dsp_renum.f90 b/mld2p4/psb_dsp_renum.f90 similarity index 100% rename from src/prec/psb_dsp_renum.f90 rename to mld2p4/psb_dsp_renum.f90 diff --git a/src/prec/psb_dumf_bld.f90 b/mld2p4/psb_dumf_bld.f90 similarity index 100% rename from src/prec/psb_dumf_bld.f90 rename to mld2p4/psb_dumf_bld.f90 diff --git a/src/prec/psb_slu_impl.c b/mld2p4/psb_slu_impl.c similarity index 100% rename from src/prec/psb_slu_impl.c rename to mld2p4/psb_slu_impl.c diff --git a/src/prec/psb_umf_impl.c b/mld2p4/psb_umf_impl.c similarity index 100% rename from src/prec/psb_umf_impl.c rename to mld2p4/psb_umf_impl.c diff --git a/src/prec/psb_zasmatbld.f90 b/mld2p4/psb_zasmatbld.f90 similarity index 100% rename from src/prec/psb_zasmatbld.f90 rename to mld2p4/psb_zasmatbld.f90 diff --git a/src/prec/psb_zbaseprc_aply.f90 b/mld2p4/psb_zbaseprc_aply.f90 similarity index 100% rename from src/prec/psb_zbaseprc_aply.f90 rename to mld2p4/psb_zbaseprc_aply.f90 diff --git a/src/prec/psb_zbaseprc_bld.f90 b/mld2p4/psb_zbaseprc_bld.f90 similarity index 100% rename from src/prec/psb_zbaseprc_bld.f90 rename to mld2p4/psb_zbaseprc_bld.f90 diff --git a/src/prec/psb_zbjac_aply.f90 b/mld2p4/psb_zbjac_aply.f90 similarity index 100% rename from src/prec/psb_zbjac_aply.f90 rename to mld2p4/psb_zbjac_aply.f90 diff --git a/src/prec/psb_zbldaggrmat.f90 b/mld2p4/psb_zbldaggrmat.f90 similarity index 100% rename from src/prec/psb_zbldaggrmat.f90 rename to mld2p4/psb_zbldaggrmat.f90 diff --git a/src/prec/psb_zdiagsc_bld.f90 b/mld2p4/psb_zdiagsc_bld.f90 similarity index 100% rename from src/prec/psb_zdiagsc_bld.f90 rename to mld2p4/psb_zdiagsc_bld.f90 diff --git a/src/prec/psb_zgenaggrmap.f90 b/mld2p4/psb_zgenaggrmap.f90 similarity index 100% rename from src/prec/psb_zgenaggrmap.f90 rename to mld2p4/psb_zgenaggrmap.f90 diff --git a/src/prec/psb_zilu_bld.f90 b/mld2p4/psb_zilu_bld.f90 similarity index 100% rename from src/prec/psb_zilu_bld.f90 rename to mld2p4/psb_zilu_bld.f90 diff --git a/src/prec/psb_zilu_fct.f90 b/mld2p4/psb_zilu_fct.f90 similarity index 100% rename from src/prec/psb_zilu_fct.f90 rename to mld2p4/psb_zilu_fct.f90 diff --git a/src/prec/psb_zmlprc_aply.f90 b/mld2p4/psb_zmlprc_aply.f90 similarity index 100% rename from src/prec/psb_zmlprc_aply.f90 rename to mld2p4/psb_zmlprc_aply.f90 diff --git a/src/prec/psb_zmlprc_bld.f90 b/mld2p4/psb_zmlprc_bld.f90 similarity index 100% rename from src/prec/psb_zmlprc_bld.f90 rename to mld2p4/psb_zmlprc_bld.f90 diff --git a/src/prec/psb_zprc_aply.f90 b/mld2p4/psb_zprc_aply.f90 similarity index 100% rename from src/prec/psb_zprc_aply.f90 rename to mld2p4/psb_zprc_aply.f90 diff --git a/src/prec/psb_zprecbld.f90 b/mld2p4/psb_zprecbld.f90 similarity index 100% rename from src/prec/psb_zprecbld.f90 rename to mld2p4/psb_zprecbld.f90 diff --git a/src/prec/psb_zprecfree.f90 b/mld2p4/psb_zprecfree.f90 similarity index 100% rename from src/prec/psb_zprecfree.f90 rename to mld2p4/psb_zprecfree.f90 diff --git a/src/prec/psb_zprecset.f90 b/mld2p4/psb_zprecset.f90 similarity index 100% rename from src/prec/psb_zprecset.f90 rename to mld2p4/psb_zprecset.f90 diff --git a/src/prec/psb_zslu_bld.f90 b/mld2p4/psb_zslu_bld.f90 similarity index 100% rename from src/prec/psb_zslu_bld.f90 rename to mld2p4/psb_zslu_bld.f90 diff --git a/src/prec/psb_zslu_impl.c b/mld2p4/psb_zslu_impl.c similarity index 100% rename from src/prec/psb_zslu_impl.c rename to mld2p4/psb_zslu_impl.c diff --git a/src/prec/psb_zsp_renum.f90 b/mld2p4/psb_zsp_renum.f90 similarity index 100% rename from src/prec/psb_zsp_renum.f90 rename to mld2p4/psb_zsp_renum.f90 diff --git a/src/prec/psb_zumf_bld.f90 b/mld2p4/psb_zumf_bld.f90 similarity index 100% rename from src/prec/psb_zumf_bld.f90 rename to mld2p4/psb_zumf_bld.f90 diff --git a/src/prec/psb_zumf_impl.c b/mld2p4/psb_zumf_impl.c similarity index 100% rename from src/prec/psb_zumf_impl.c rename to mld2p4/psb_zumf_impl.c diff --git a/src/Makefile b/src/Makefile deleted file mode 100644 index 7934c375..00000000 --- a/src/Makefile +++ /dev/null @@ -1,30 +0,0 @@ -include ../Make.inc - -lib: - (cd modules; make lib) - (cd comm; make lib) - (cd internals; make lib) - (cd tools; make lib) - (cd serial; make lib) - (cd psblas; make lib) - (cd prec; make lib) - (cd methd; make lib) -clean: - (cd modules; make clean) - (cd comm; make clean) - (cd internals; make clean) - (cd tools; make clean) - (cd serial; make clean) - (cd psblas; make clean) - (cd prec; make clean) - (cd methd; make clean) - -veryclean: - (cd modules; make veryclean) - (cd comm; make veryclean) - (cd internals; make veryclean) - (cd tools; make veryclean) - (cd serial; make veryclean) - (cd psblas; make veryclean) - (cd prec; make veryclean) - (cd methd; make veryclean)