From 1e9181292400dbb443857d8b73288dfee97b03ee Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 25 Sep 2009 17:03:30 +0000 Subject: [PATCH] psblas3: base/Makefile base/modules/Makefile base/modules/psb_base_mod.f90 base/modules/psb_linmap_mod.f90 base/modules/psb_linmap_type_mod.f90 base/modules/psb_mat_mod.f03 base/modules/psb_psblas_mod.f90 base/modules/psb_serial_mod.f90 base/modules/psb_tools_mod.f90 base/psblas/psb_cnrmi.f90 base/psblas/psb_cspmm.f90 base/psblas/psb_cspsm.f90 base/psblas/psb_dnrmi.f90 base/psblas/psb_dspsm.f90 base/psblas/psb_snrmi.f90 base/psblas/psb_sspmm.f90 base/psblas/psb_sspsm.f90 base/psblas/psb_znrmi.f90 base/psblas/psb_zspmm.f90 base/psblas/psb_zspsm.f90 base/serial/Makefile base/serial/dp/Makefile base/serial/dp/gen_block.f base/serial/dp/partition.f base/serial/dp/scrjd.f base/serial/f77/Makefile base/serial/psb_cest.f90 base/tools/psb_ccdbldext.F90 base/tools/psb_cins.f90 base/tools/psb_cspalloc.f90 base/tools/psb_cspasb.f90 base/tools/psb_cspfree.f90 base/tools/psb_csphalo.F90 base/tools/psb_cspins.f90 base/tools/psb_csprn.f90 base/tools/psb_dcdbldext.F90 base/tools/psb_dins.f90 base/tools/psb_dspalloc.f90 base/tools/psb_dspasb.f90 base/tools/psb_dspfree.f90 base/tools/psb_dsphalo.F90 base/tools/psb_dspins.f90 base/tools/psb_dsprn.f90 base/tools/psb_iins.f90 base/tools/psb_linmap.f90 base/tools/psb_scdbldext.F90 base/tools/psb_sins.f90 base/tools/psb_sspalloc.f90 base/tools/psb_sspasb.f90 base/tools/psb_sspfree.f90 base/tools/psb_ssphalo.F90 base/tools/psb_sspins.f90 base/tools/psb_ssprn.f90 base/tools/psb_zcdbldext.F90 base/tools/psb_zins.f90 base/tools/psb_zspalloc.f90 base/tools/psb_zspasb.f90 base/tools/psb_zspfree.f90 base/tools/psb_zsphalo.F90 base/tools/psb_zspins.f90 base/tools/psb_zsprn.f90 krylov/psb_cbicg.f90 krylov/psb_ccg.f90 krylov/psb_ccgs.f90 krylov/psb_ccgstab.f90 krylov/psb_ccgstabl.f90 krylov/psb_crgmres.f90 krylov/psb_dbicg.f90 krylov/psb_dcg.F90 krylov/psb_dcgs.f90 krylov/psb_dcgstab.F90 krylov/psb_dcgstabl.f90 krylov/psb_drgmres.f90 krylov/psb_krylov_mod.f90 krylov/psb_sbicg.f90 krylov/psb_scg.F90 krylov/psb_scgs.f90 krylov/psb_scgstab.F90 krylov/psb_scgstabl.f90 krylov/psb_srgmres.f90 krylov/psb_zbicg.f90 krylov/psb_zcg.F90 krylov/psb_zcgs.f90 krylov/psb_zcgstab.f90 krylov/psb_zcgstabl.f90 krylov/psb_zrgmres.f90 prec/psb_cbjac_aply.f90 prec/psb_cbjac_bld.f90 prec/psb_cdiagsc_bld.f90 prec/psb_cilu_fct.f90 prec/psb_cprecbld.f90 prec/psb_prec_mod.f90 prec/psb_prec_type.f90 prec/psb_zbjac_aply.f90 prec/psb_zbjac_bld.f90 prec/psb_zdiagsc_bld.f90 prec/psb_zilu_fct.f90 prec/psb_zprecbld.f90 test/fileread/cf_sample.f90 test/fileread/zf_sample.f90 test/util/zhb2mm.f90 test/util/zmm2hb.f90 util/psb_hbio_mod.f90 util/psb_mat_dist_mod.f90 util/psb_metispart_mod.F90 util/psb_mmio_mod.f90 complex version. Now the basic test appear to work. Next: move to MLD --- base/Makefile | 4 +- base/modules/Makefile | 10 +- base/modules/psb_base_mod.f90 | 2 +- base/modules/psb_linmap_mod.f90 | 18 +- base/modules/psb_linmap_type_mod.f90 | 9 +- base/modules/psb_mat_mod.f03 | 2 +- base/modules/psb_psblas_mod.f90 | 46 +- base/modules/psb_serial_mod.f90 | 978 +-------------------------- base/modules/psb_tools_mod.f90 | 238 +++++-- base/psblas/psb_cnrmi.f90 | 8 +- base/psblas/psb_cspmm.f90 | 23 +- base/psblas/psb_cspsm.f90 | 50 +- base/psblas/psb_dnrmi.f90 | 2 +- base/psblas/psb_dspsm.f90 | 2 +- base/psblas/psb_snrmi.f90 | 3 +- base/psblas/psb_sspmm.f90 | 1 - base/psblas/psb_sspsm.f90 | 2 +- base/psblas/psb_znrmi.f90 | 9 +- base/psblas/psb_zspmm.f90 | 26 +- base/psblas/psb_zspsm.f90 | 48 +- base/serial/Makefile | 35 +- base/serial/dp/Makefile | 14 +- base/serial/dp/gen_block.f | 2 +- base/serial/dp/partition.f | 2 +- base/serial/dp/scrjd.f | 2 +- base/serial/f77/Makefile | 12 +- base/serial/psb_cest.f90 | 2 +- base/tools/psb_ccdbldext.F90 | 66 +- base/tools/psb_cins.f90 | 2 - base/tools/psb_cspalloc.f90 | 7 +- base/tools/psb_cspasb.f90 | 28 +- base/tools/psb_cspfree.f90 | 14 +- base/tools/psb_csphalo.F90 | 90 ++- base/tools/psb_cspins.f90 | 33 +- base/tools/psb_csprn.f90 | 12 +- base/tools/psb_dcdbldext.F90 | 3 +- base/tools/psb_dins.f90 | 2 - base/tools/psb_dspalloc.f90 | 4 +- base/tools/psb_dspasb.f90 | 4 +- base/tools/psb_dspfree.f90 | 4 +- base/tools/psb_dsphalo.F90 | 3 +- base/tools/psb_dspins.f90 | 6 +- base/tools/psb_dsprn.f90 | 4 +- base/tools/psb_iins.f90 | 2 - base/tools/psb_linmap.f90 | 12 +- base/tools/psb_scdbldext.F90 | 1 - base/tools/psb_sins.f90 | 2 - base/tools/psb_sspalloc.f90 | 4 +- base/tools/psb_sspasb.f90 | 4 +- base/tools/psb_sspfree.f90 | 2 +- base/tools/psb_ssphalo.F90 | 3 +- base/tools/psb_sspins.f90 | 6 +- base/tools/psb_ssprn.f90 | 4 +- base/tools/psb_zcdbldext.F90 | 70 +- base/tools/psb_zins.f90 | 2 - base/tools/psb_zspalloc.f90 | 7 +- base/tools/psb_zspasb.f90 | 29 +- base/tools/psb_zspfree.f90 | 14 +- base/tools/psb_zsphalo.F90 | 90 ++- base/tools/psb_zspins.f90 | 31 +- base/tools/psb_zsprn.f90 | 12 +- krylov/psb_cbicg.f90 | 8 +- krylov/psb_ccg.f90 | 8 +- krylov/psb_ccgs.f90 | 8 +- krylov/psb_ccgstab.f90 | 8 +- krylov/psb_ccgstabl.f90 | 8 +- krylov/psb_crgmres.f90 | 8 +- krylov/psb_dbicg.f90 | 6 +- krylov/psb_dcg.F90 | 6 +- krylov/psb_dcgs.f90 | 6 +- krylov/psb_dcgstab.F90 | 6 +- krylov/psb_dcgstabl.f90 | 6 +- krylov/psb_drgmres.f90 | 6 +- krylov/psb_krylov_mod.f90 | 124 ++-- krylov/psb_sbicg.f90 | 4 +- krylov/psb_scg.F90 | 4 +- krylov/psb_scgs.f90 | 4 +- krylov/psb_scgstab.F90 | 4 +- krylov/psb_scgstabl.f90 | 4 +- krylov/psb_srgmres.f90 | 4 +- krylov/psb_zbicg.f90 | 8 +- krylov/psb_zcg.F90 | 8 +- krylov/psb_zcgs.f90 | 8 +- krylov/psb_zcgstab.f90 | 8 +- krylov/psb_zcgstabl.f90 | 8 +- krylov/psb_zrgmres.f90 | 8 +- prec/psb_cbjac_aply.f90 | 12 +- prec/psb_cbjac_bld.f90 | 52 +- prec/psb_cdiagsc_bld.f90 | 17 +- prec/psb_cilu_fct.f90 | 244 +++---- prec/psb_cprecbld.f90 | 2 +- prec/psb_prec_mod.f90 | 66 +- prec/psb_prec_type.f90 | 29 +- prec/psb_zbjac_aply.f90 | 12 +- prec/psb_zbjac_bld.f90 | 52 +- prec/psb_zdiagsc_bld.f90 | 17 +- prec/psb_zilu_fct.f90 | 234 +++---- prec/psb_zprecbld.f90 | 2 +- test/fileread/cf_sample.f90 | 7 +- test/fileread/zf_sample.f90 | 9 +- test/util/zhb2mm.f90 | 2 +- test/util/zmm2hb.f90 | 2 +- util/psb_hbio_mod.f90 | 281 +++++--- util/psb_mat_dist_mod.f90 | 55 +- util/psb_metispart_mod.F90 | 36 +- util/psb_mmio_mod.f90 | 172 ++--- 106 files changed, 1347 insertions(+), 2363 deletions(-) diff --git a/base/Makefile b/base/Makefile index a0a9a0de..9e2c44ee 100644 --- a/base/Makefile +++ b/base/Makefile @@ -7,11 +7,10 @@ LIBMOD=psb_base_mod$(.mod) lib: (cd modules; make lib LIBNAME=$(BASELIBNAME) F90=$(MPF90) F90COPT="$(F90COPT) $(MPI_OPT)") (cd serial; make lib LIBNAME=$(BASELIBNAME)) -# (cd newserial; make lib LIBNAME=$(BASELIBNAME) ) (cd comm; make lib LIBNAME=$(BASELIBNAME)) (cd internals; make lib LIBNAME=$(BASELIBNAME)) - (cd tools; make lib LIBNAME=$(BASELIBNAME)) (cd psblas; make lib LIBNAME=$(BASELIBNAME)) + (cd tools; make lib LIBNAME=$(BASELIBNAME)) /bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR) /bin/cp -p $(LIBMOD) *$(.mod) $(LIBDIR) @@ -22,7 +21,6 @@ clean: (cd tools; make clean) (cd serial; make clean) (cd psblas; make clean) -# (cd newserial; make clean) veryclean: clean /bin/rm -f $(HERE)/$(LIBNAME) $(LIBMOD) *$(.mod) diff --git a/base/modules/Makefile b/base/modules/Makefile index 97910be0..9bc82c91 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -1,7 +1,7 @@ include ../../Make.inc BASIC_MODS= psb_const_mod.o psb_error_mod.o psb_realloc_mod.o -UTIL_MODS = psb_string_mod.o psb_spmat_type.o \ +UTIL_MODS = psb_string_mod.o \ psb_desc_type.o psb_sort_mod.o psb_penv_mod.o \ psb_serial_mod.o psb_tools_mod.o psb_blacs_mod.o \ psb_linmap_type_mod.o psb_comm_mod.o psb_psblas_mod.o \ @@ -52,12 +52,12 @@ psi_serial_mod.o: psb_const_mod.o psb_realloc_mod.o psi_mod.o: psb_penv_mod.o psb_error_mod.o psb_desc_type.o psb_const_mod.o psi_serial_mod.o psb_serial_mod.o psb_desc_type.o: psb_const_mod.o psb_error_mod.o psb_penv_mod.o psb_realloc_mod.o psb_hash_mod.o psb_linmap_mod.o: psb_linmap_type_mod.o psb_mat_mod.o -psb_linmap_type_mod.o: psb_desc_type.o psb_spmat_type.o psb_error_mod.o psb_serial_mod.o psb_comm_mod.o psb_mat_mod.o +psb_linmap_type_mod.o: psb_desc_type.o psb_error_mod.o psb_serial_mod.o psb_comm_mod.o psb_mat_mod.o psb_check_mod.o: psb_desc_type.o -psb_serial_mod.o: psb_spmat_type.o psb_string_mod.o psb_sort_mod.o psi_serial_mod.o +psb_serial_mod.o: psb_mat_mod.o psb_string_mod.o psb_sort_mod.o psi_serial_mod.o psb_sort_mod.o: psb_error_mod.o psb_realloc_mod.o psb_const_mod.o -psb_tools_mod.o: psb_spmat_type.o psb_desc_type.o psi_mod.o psb_gps_mod.o psb_linmap_mod.o psb_mat_mod.o -psb_psblas_mod.o: psb_mat_mod.o psb_spmat_type.o psb_desc_type.o +psb_tools_mod.o: psb_desc_type.o psi_mod.o psb_gps_mod.o psb_linmap_mod.o psb_mat_mod.o +psb_psblas_mod.o: psb_mat_mod.o psb_desc_type.o psb_gps_mod.o: psb_realloc_mod.o psb_hash_mod.o: psb_const_mod.o psb_realloc_mod.o diff --git a/base/modules/psb_base_mod.f90 b/base/modules/psb_base_mod.f90 index 03faccc5..ff753ba1 100644 --- a/base/modules/psb_base_mod.f90 +++ b/base/modules/psb_base_mod.f90 @@ -36,10 +36,10 @@ module psb_base_mod use psb_check_mod use psb_descriptor_type use psb_linmap_mod + use psb_mat_mod use psb_serial_mod use psb_comm_mod use psb_psblas_mod use psb_gps_mod use psb_tools_mod - use psb_mat_mod end module psb_base_mod diff --git a/base/modules/psb_linmap_mod.f90 b/base/modules/psb_linmap_mod.f90 index f2b4c54b..a4d5a4cc 100644 --- a/base/modules/psb_linmap_mod.f90 +++ b/base/modules/psb_linmap_mod.f90 @@ -37,7 +37,7 @@ ! module psb_linmap_mod - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_, psb_sizeof + use psb_const_mod use psb_descriptor_type use psb_linmap_type_mod @@ -183,7 +183,7 @@ module psb_linmap_mod implicit none type(psb_clinmap_type) :: psb_c_linmap type(psb_desc_type), target :: desc_X, desc_Y - type(psb_cspmat_type), intent(in) :: map_X2Y, map_Y2X + type(psb_c_sparse_mat), intent(in) :: map_X2Y, map_Y2X integer, intent(in) :: map_kind integer, intent(in), optional :: iaggr(:), naggr(:) end function psb_c_linmap @@ -192,7 +192,7 @@ module psb_linmap_mod implicit none type(psb_zlinmap_type) :: psb_z_linmap type(psb_desc_type), target :: desc_X, desc_Y - type(psb_zspmat_type), intent(in) :: map_X2Y, map_Y2X + type(psb_z_sparse_mat), intent(in) :: map_X2Y, map_Y2X integer, intent(in) :: map_kind integer, intent(in), optional :: iaggr(:), naggr(:) end function psb_z_linmap @@ -491,6 +491,7 @@ contains end function psb_dlinmap_sizeof function psb_clinmap_sizeof(map) result(val) + use psb_mat_mod implicit none type(psb_clinmap_type), intent(in) :: map integer(psb_long_int_k_) :: val @@ -510,6 +511,7 @@ contains end function psb_clinmap_sizeof function psb_zlinmap_sizeof(map) result(val) + use psb_mat_mod implicit none type(psb_zlinmap_type), intent(in) :: map integer(psb_long_int_k_) :: val @@ -556,7 +558,7 @@ contains implicit none type(psb_clinmap_type), intent(out) :: out_map type(psb_desc_type), target :: desc_X, desc_Y - type(psb_cspmat_type), intent(in) :: map_X2Y, map_Y2X + type(psb_c_sparse_mat), intent(in) :: map_X2Y, map_Y2X integer, intent(in) :: map_kind integer, intent(in), optional :: iaggr(:), naggr(:) out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) @@ -567,7 +569,7 @@ contains implicit none type(psb_zlinmap_type), intent(out) :: out_map type(psb_desc_type), target :: desc_X, desc_Y - type(psb_zspmat_type), intent(in) :: map_X2Y, map_Y2X + type(psb_z_sparse_mat), intent(in) :: map_X2Y, map_Y2X integer, intent(in) :: map_kind integer, intent(in), optional :: iaggr(:), naggr(:) out_map = psb_linmap(map_kind,desc_X,desc_Y,map_X2Y,map_Y2X,iaggr,naggr) @@ -619,7 +621,8 @@ contains end subroutine psb_dlinmap_transfer subroutine psb_clinmap_transfer(mapin,mapout,info) - use psb_spmat_type + use psb_realloc_mod + use psb_mat_mod use psb_descriptor_type implicit none type(psb_clinmap_type) :: mapin,mapout @@ -640,7 +643,8 @@ contains end subroutine psb_clinmap_transfer subroutine psb_zlinmap_transfer(mapin,mapout,info) - use psb_spmat_type + use psb_realloc_mod + use psb_mat_mod use psb_descriptor_type implicit none type(psb_zlinmap_type) :: mapin,mapout diff --git a/base/modules/psb_linmap_type_mod.f90 b/base/modules/psb_linmap_type_mod.f90 index d0f35f97..8643f8d3 100644 --- a/base/modules/psb_linmap_type_mod.f90 +++ b/base/modules/psb_linmap_type_mod.f90 @@ -36,9 +36,8 @@ ! to different spaces. ! module psb_linmap_type_mod - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_, psb_sizeof - - use psb_mat_mod, only: psb_d_sparse_mat, psb_s_sparse_mat + use psb_const_mod + use psb_mat_mod, only: psb_d_sparse_mat, psb_s_sparse_mat, psb_z_sparse_mat, psb_c_sparse_mat use psb_descriptor_type, only: psb_desc_type @@ -72,14 +71,14 @@ module psb_linmap_type_mod integer, allocatable :: itd_data(:), iaggr(:), naggr(:) type(psb_desc_type), pointer :: p_desc_X=>null(), p_desc_Y=>null() type(psb_desc_type) :: desc_X, desc_Y - type(psb_cspmat_type) :: map_X2Y, map_Y2X + type(psb_c_sparse_mat) :: map_X2Y, map_Y2X end type psb_clinmap_type type psb_zlinmap_type integer, allocatable :: itd_data(:), iaggr(:), naggr(:) type(psb_desc_type), pointer :: p_desc_X=>null(), p_desc_Y=>null() type(psb_desc_type) :: desc_X, desc_Y - type(psb_zspmat_type) :: map_X2Y, map_Y2X + type(psb_z_sparse_mat) :: map_X2Y, map_Y2X end type psb_zlinmap_type end module psb_linmap_type_mod diff --git a/base/modules/psb_mat_mod.f03 b/base/modules/psb_mat_mod.f03 index 756cee10..70c2e1aa 100644 --- a/base/modules/psb_mat_mod.f03 +++ b/base/modules/psb_mat_mod.f03 @@ -1,4 +1,4 @@ -module psb_mat_mod +module psb_mat_mod use psb_s_mat_mod use psb_d_mat_mod use psb_c_mat_mod diff --git a/base/modules/psb_psblas_mod.f90 b/base/modules/psb_psblas_mod.f90 index c19643ae..22ea11d3 100644 --- a/base/modules/psb_psblas_mod.f90 +++ b/base/modules/psb_psblas_mod.f90 @@ -599,16 +599,18 @@ module psb_psblas_mod function psb_cnrmi(a, desc_a,info) use psb_serial_mod use psb_descriptor_type + use psb_mat_mod real(psb_spk_) :: psb_cnrmi - type(psb_cspmat_type), intent (in) :: a + type(psb_c_sparse_mat), intent (in) :: a type(psb_desc_type), intent (in) :: desc_a integer, intent(out) :: info end function psb_cnrmi function psb_znrmi(a, desc_a,info) use psb_serial_mod use psb_descriptor_type + use psb_mat_mod real(psb_dpk_) :: psb_znrmi - type(psb_zspmat_type), intent (in) :: a + type(psb_z_sparse_mat), intent (in) :: a type(psb_desc_type), intent (in) :: desc_a integer, intent(out) :: info end function psb_znrmi @@ -681,7 +683,8 @@ module psb_psblas_mod &trans, k, jx, jy,work,doswap) use psb_serial_mod use psb_descriptor_type - type(psb_cspmat_type), intent(in) :: a + use psb_mat_mod + type(psb_c_sparse_mat), intent(in) :: a complex(psb_spk_), intent(inout) :: x(:,:) complex(psb_spk_), intent(inout) :: y(:,:) complex(psb_spk_), intent(in) :: alpha, beta @@ -696,7 +699,8 @@ module psb_psblas_mod & desc_a, info, trans, work,doswap) use psb_serial_mod use psb_descriptor_type - type(psb_cspmat_type), intent(in) :: a + use psb_mat_mod + type(psb_c_sparse_mat), intent(in) :: a complex(psb_spk_), intent(inout) :: x(:) complex(psb_spk_), intent(inout) :: y(:) complex(psb_spk_), intent(in) :: alpha, beta @@ -710,7 +714,8 @@ module psb_psblas_mod &trans, k, jx, jy,work,doswap) use psb_serial_mod use psb_descriptor_type - type(psb_zspmat_type), intent(in) :: a + use psb_mat_mod + type(psb_z_sparse_mat), intent(in) :: a complex(psb_dpk_), intent(inout) :: x(:,:) complex(psb_dpk_), intent(inout) :: y(:,:) complex(psb_dpk_), intent(in) :: alpha, beta @@ -725,7 +730,8 @@ module psb_psblas_mod & desc_a, info, trans, work,doswap) use psb_serial_mod use psb_descriptor_type - type(psb_zspmat_type), intent(in) :: a + use psb_mat_mod + type(psb_z_sparse_mat), intent(in) :: a complex(psb_dpk_), intent(inout) :: x(:) complex(psb_dpk_), intent(inout) :: y(:) complex(psb_dpk_), intent(in) :: alpha, beta @@ -805,63 +811,67 @@ module psb_psblas_mod integer, intent(out) :: info end subroutine psb_dspsv subroutine psb_cspsm(alpha, t, x, beta, y,& - & desc_a, info, trans, unit, choice,& + & desc_a, info, trans, side, choice,& & diag, n, jx, jy, work) use psb_serial_mod use psb_descriptor_type - type(psb_cspmat_type), intent(in) :: t + use psb_mat_mod + type(psb_c_sparse_mat), intent(in) :: t complex(psb_spk_), intent(in) :: x(:,:) complex(psb_spk_), intent(inout) :: y(:,:) complex(psb_spk_), intent(in) :: alpha, beta type(psb_desc_type), intent(in) :: desc_a - character, optional, intent(in) :: trans, unit + character, optional, intent(in) :: trans, side integer, optional, intent(in) :: n, jx, jy integer, optional, intent(in) :: choice complex(psb_spk_), optional, intent(in),target :: work(:), diag(:) integer, intent(out) :: info end subroutine psb_cspsm subroutine psb_cspsv(alpha, t, x, beta, y,& - & desc_a, info, trans, unit, choice,& + & desc_a, info, trans, side, choice,& & diag, work) use psb_serial_mod use psb_descriptor_type - type(psb_cspmat_type), intent(in) :: t + use psb_mat_mod + type(psb_c_sparse_mat), intent(in) :: t complex(psb_spk_), intent(in) :: x(:) complex(psb_spk_), intent(inout) :: y(:) complex(psb_spk_), intent(in) :: alpha, beta type(psb_desc_type), intent(in) :: desc_a - character, optional, intent(in) :: trans, unit + character, optional, intent(in) :: trans, side integer, optional, intent(in) :: choice complex(psb_spk_), optional, intent(in),target :: work(:), diag(:) integer, intent(out) :: info end subroutine psb_cspsv subroutine psb_zspsm(alpha, t, x, beta, y,& - & desc_a, info, trans, unit, choice,& + & desc_a, info, trans, side, choice,& & diag, n, jx, jy, work) use psb_serial_mod use psb_descriptor_type - type(psb_zspmat_type), intent(in) :: t + use psb_mat_mod + type(psb_z_sparse_mat), intent(in) :: t complex(psb_dpk_), intent(in) :: x(:,:) complex(psb_dpk_), intent(inout) :: y(:,:) complex(psb_dpk_), intent(in) :: alpha, beta type(psb_desc_type), intent(in) :: desc_a - character, optional, intent(in) :: trans, unit + character, optional, intent(in) :: trans, side integer, optional, intent(in) :: n, jx, jy integer, optional, intent(in) :: choice complex(psb_dpk_), optional, intent(in),target :: work(:), diag(:) integer, intent(out) :: info end subroutine psb_zspsm subroutine psb_zspsv(alpha, t, x, beta, y,& - & desc_a, info, trans, unit, choice,& + & desc_a, info, trans, side, choice,& & diag, work) use psb_serial_mod use psb_descriptor_type - type(psb_zspmat_type), intent(in) :: t + use psb_mat_mod + type(psb_z_sparse_mat), intent(in) :: t complex(psb_dpk_), intent(in) :: x(:) complex(psb_dpk_), intent(inout) :: y(:) complex(psb_dpk_), intent(in) :: alpha, beta type(psb_desc_type), intent(in) :: desc_a - character, optional, intent(in) :: trans, unit + character, optional, intent(in) :: trans, side integer, optional, intent(in) :: choice complex(psb_dpk_), optional, intent(in),target :: work(:), diag(:) integer, intent(out) :: info diff --git a/base/modules/psb_serial_mod.f90 b/base/modules/psb_serial_mod.f90 index 88bfb9a6..fef55e9e 100644 --- a/base/modules/psb_serial_mod.f90 +++ b/base/modules/psb_serial_mod.f90 @@ -31,7 +31,8 @@ !!$ module psb_serial_mod use psb_const_mod - use psb_spmat_type + use psb_error_mod + use psb_realloc_mod use psb_string_mod use psb_sort_mod @@ -39,979 +40,6 @@ module psb_serial_mod & psb_gth => psi_gth,& & psb_sct => psi_sct - interface psb_csrws -!!$ subroutine psb_dcsrws(rw,a,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type) :: a -!!$ real(psb_dpk_), allocatable :: rw(:) -!!$ integer :: info -!!$ character, optional :: trans -!!$ end subroutine psb_dcsrws - subroutine psb_zcsrws(rw,a,info,trans) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type) :: a - complex(psb_dpk_), allocatable :: rw(:) - integer :: info - character, optional :: trans - end subroutine psb_zcsrws - end interface - -!!$ interface psb_cssm -!!$ subroutine psb_scssm(alpha,t,b,beta,c,info,trans,unitd,d) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type) :: t -!!$ real(psb_spk_) :: alpha, beta, b(:,:), c(:,:) -!!$ integer :: info -!!$ character, optional :: trans, unitd -!!$ real(psb_spk_), optional, target :: d(:) -!!$ end subroutine psb_scssm -!!$ subroutine psb_scssv(alpha,t,b,beta,c,info,trans,unitd,d) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type) :: t -!!$ real(psb_spk_) :: alpha, beta, b(:), c(:) -!!$ integer :: info -!!$ character, optional :: trans, unitd -!!$ real(psb_spk_), optional, target :: d(:) -!!$ end subroutine psb_scssv -!!$ subroutine psb_dcssm(alpha,t,b,beta,c,info,trans,unitd,d) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type) :: t -!!$ real(psb_dpk_) :: alpha, beta, b(:,:), c(:,:) -!!$ integer :: info -!!$ character, optional :: trans, unitd -!!$ real(psb_dpk_), optional, target :: d(:) -!!$ end subroutine psb_dcssm -!!$ subroutine psb_dcssv(alpha,t,b,beta,c,info,trans,unitd,d) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type) :: t -!!$ real(psb_dpk_) :: alpha, beta, b(:), c(:) -!!$ integer :: info -!!$ character, optional :: trans, unitd -!!$ real(psb_dpk_), optional, target :: d(:) -!!$ end subroutine psb_dcssv -!!$ subroutine psb_ccssm(alpha,t,b,beta,c,info,trans,unitd,d) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_cspmat_type) :: t -!!$ complex(psb_spk_) :: alpha, beta, b(:,:), c(:,:) -!!$ integer :: info -!!$ character, optional :: trans, unitd -!!$ complex(psb_spk_), optional, target :: d(:) -!!$ end subroutine psb_ccssm -!!$ subroutine psb_ccssv(alpha,t,b,beta,c,info,trans,unitd,d) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_cspmat_type) :: t -!!$ complex(psb_spk_) :: alpha, beta, b(:), c(:) -!!$ integer :: info -!!$ character, optional :: trans, unitd -!!$ complex(psb_spk_), optional, target :: d(:) -!!$ end subroutine psb_ccssv -!!$ subroutine psb_zcssm(alpha,t,b,beta,c,info,trans,unitd,d) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_zspmat_type) :: t -!!$ complex(psb_dpk_) :: alpha, beta, b(:,:), c(:,:) -!!$ integer :: info -!!$ character, optional :: trans, unitd -!!$ complex(psb_dpk_), optional, target :: d(:) -!!$ end subroutine psb_zcssm -!!$ subroutine psb_zcssv(alpha,t,b,beta,c,info,trans,unitd,d) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_zspmat_type) :: t -!!$ complex(psb_dpk_) :: alpha, beta, b(:), c(:) -!!$ integer :: info -!!$ character, optional :: trans, unitd -!!$ complex(psb_dpk_), optional, target :: d(:) -!!$ end subroutine psb_zcssv -!!$ end interface - -!!$ interface psb_csmm -!!$ module procedure psb_scsmm, psb_scsmv, psb_dcsmm, psb_dcsmv,& -!!$ & psb_ccsmm, psb_ccsmv, psb_zcsmm, psb_zcsmv -!!$ subroutine psb_scsmv(alpha,a,b,beta,c,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type) :: a -!!$ real(psb_spk_) :: alpha, beta, b(:), c(:) -!!$ integer :: info -!!$ character, optional :: trans -!!$ end subroutine psb_scsmv -!!$ subroutine psb_scsmm(alpha,a,b,beta,c,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type) :: a -!!$ real(psb_spk_) :: alpha, beta, b(:,:), c(:,:) -!!$ integer :: info -!!$ character, optional :: trans -!!$ end subroutine psb_scsmm -!!$ subroutine psb_dcsmv(alpha,a,b,beta,c,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type) :: a -!!$ real(psb_dpk_) :: alpha, beta, b(:), c(:) -!!$ integer :: info -!!$ character, optional :: trans -!!$ end subroutine psb_dcsmv -!!$ subroutine psb_dcsmm(alpha,a,b,beta,c,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type) :: a -!!$ real(psb_dpk_) :: alpha, beta, b(:,:), c(:,:) -!!$ integer :: info -!!$ character, optional :: trans -!!$ end subroutine psb_dcsmm -!!$ subroutine psb_ccsmv(alpha,a,b,beta,c,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_cspmat_type) :: a -!!$ complex(psb_spk_) :: alpha, beta, b(:), c(:) -!!$ integer :: info -!!$ character, optional :: trans -!!$ end subroutine psb_ccsmv -!!$ subroutine psb_ccsmm(alpha,a,b,beta,c,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_cspmat_type) :: a -!!$ complex(psb_spk_) :: alpha, beta, b(:,:), c(:,:) -!!$ integer :: info -!!$ character, optional :: trans -!!$ end subroutine psb_ccsmm -!!$ subroutine psb_zcsmv(alpha,a,b,beta,c,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_zspmat_type) :: a -!!$ complex(psb_dpk_) :: alpha, beta, b(:), c(:) -!!$ integer :: info -!!$ character, optional :: trans -!!$ end subroutine psb_zcsmv -!!$ subroutine psb_zcsmm(alpha,a,b,beta,c,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_zspmat_type) :: a -!!$ complex(psb_dpk_) :: alpha, beta, b(:,:), c(:,:) -!!$ integer :: info -!!$ character, optional :: trans -!!$ end subroutine psb_zcsmm -!!$ end interface - - interface psb_cest - subroutine psb_cest(afmt, m,n,nnz, lia1, lia2, lar, iup, info) - integer, intent(in) :: m,n,nnz,iup - integer, intent(out) :: lia1, lia2, lar, info - character(len=*), intent(inout) :: afmt - end subroutine psb_cest - end interface - - interface psb_spcnv -!!$ subroutine psb_sspcnv2(ain, a, info, afmt, upd, dupl) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type), intent (in) :: ain -!!$ type(psb_sspmat_type), intent (out) :: a -!!$ integer, intent(out) :: info -!!$ integer,optional, intent(in) :: dupl, upd -!!$ character(len=*), optional, intent(in) :: afmt -!!$ end subroutine psb_sspcnv2 -!!$ subroutine psb_sspcnv1(a, info, afmt, upd, dupl) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type), intent (inout) :: a -!!$ integer, intent(out) :: info -!!$ integer,optional, intent(in) :: dupl, upd -!!$ character(len=*), optional, intent(in) :: afmt -!!$ end subroutine psb_sspcnv1 -!!$ subroutine psb_dspcnv2(ain, a, info, afmt, upd, dupl) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent (in) :: ain -!!$ type(psb_dspmat_type), intent (out) :: a -!!$ integer, intent(out) :: info -!!$ integer,optional, intent(in) :: dupl, upd -!!$ character(len=*), optional, intent(in) :: afmt -!!$ end subroutine psb_dspcnv2 -!!$ subroutine psb_dspcnv1(a, info, afmt, upd, dupl) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent (inout) :: a -!!$ integer, intent(out) :: info -!!$ integer,optional, intent(in) :: dupl, upd -!!$ character(len=*), optional, intent(in) :: afmt -!!$ end subroutine psb_dspcnv1 - subroutine psb_cspcnv2(ain, a, info, afmt, upd, dupl) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_cspmat_type), intent (in) :: ain - type(psb_cspmat_type), intent (out) :: a - integer, intent(out) :: info - integer,optional, intent(in) :: dupl, upd - character(len=*), optional, intent(in) :: afmt - end subroutine psb_cspcnv2 - subroutine psb_cspcnv1(a, info, afmt, upd, dupl) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_cspmat_type), intent (inout) :: a - integer, intent(out) :: info - integer,optional, intent(in) :: dupl, upd - character(len=*), optional, intent(in) :: afmt - end subroutine psb_cspcnv1 - subroutine psb_zspcnv2(ain, a, info, afmt, upd, dupl) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent (in) :: ain - type(psb_zspmat_type), intent (out) :: a - integer, intent(out) :: info - integer,optional, intent(in) :: dupl, upd - character(len=*), optional, intent(in) :: afmt - end subroutine psb_zspcnv2 - subroutine psb_zspcnv1(a, info, afmt, upd, dupl) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent (inout) :: a - integer, intent(out) :: info - integer,optional, intent(in) :: dupl, upd - character(len=*), optional, intent(in) :: afmt - end subroutine psb_zspcnv1 - end interface - - - - interface psb_fixcoo -!!$ subroutine psb_sfixcoo(a,info,idir) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type), intent(inout) :: a -!!$ integer, intent(out) :: info -!!$ integer, intent(in), optional :: idir -!!$ end subroutine psb_sfixcoo -!!$ subroutine psb_dfixcoo(a,info,idir) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent(inout) :: a -!!$ integer, intent(out) :: info -!!$ integer, intent(in), optional :: idir -!!$ end subroutine psb_dfixcoo - subroutine psb_cfixcoo(a,info,idir) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_cspmat_type), intent(inout) :: a - integer, intent(out) :: info - integer, intent(in), optional :: idir - end subroutine psb_cfixcoo - subroutine psb_zfixcoo(a,info,idir) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent(inout) :: a - integer, intent(out) :: info - integer, intent(in), optional :: idir - end subroutine psb_zfixcoo - end interface - - interface psb_ipcoo2csr -!!$ subroutine psb_sipcoo2csr(a,info,rwshr) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type), intent(inout) :: a -!!$ integer, intent(out) :: info -!!$ logical, optional :: rwshr -!!$ end subroutine psb_sipcoo2csr -!!$ subroutine psb_dipcoo2csr(a,info,rwshr) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent(inout) :: a -!!$ integer, intent(out) :: info -!!$ logical, optional :: rwshr -!!$ end subroutine psb_dipcoo2csr - subroutine psb_cipcoo2csr(a,info,rwshr) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_cspmat_type), intent(inout) :: a - integer, intent(out) :: info - logical, optional :: rwshr - end subroutine psb_cipcoo2csr - subroutine psb_zipcoo2csr(a,info,rwshr) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent(inout) :: a - integer, intent(out) :: info - logical, optional :: rwshr - end subroutine psb_zipcoo2csr - end interface - - interface psb_ipcoo2csc -!!$ subroutine psb_sipcoo2csc(a,info,clshr) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type), intent(inout) :: a -!!$ integer, intent(out) :: info -!!$ logical, optional :: clshr -!!$ end subroutine psb_sipcoo2csc -!!$ subroutine psb_dipcoo2csc(a,info,clshr) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent(inout) :: a -!!$ integer, intent(out) :: info -!!$ logical, optional :: clshr -!!$ end subroutine psb_dipcoo2csc - subroutine psb_cipcoo2csc(a,info,clshr) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_cspmat_type), intent(inout) :: a - integer, intent(out) :: info - logical, optional :: clshr - end subroutine psb_cipcoo2csc - subroutine psb_zipcoo2csc(a,info,clshr) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent(inout) :: a - integer, intent(out) :: info - logical, optional :: clshr - end subroutine psb_zipcoo2csc - end interface - - interface psb_ipcsr2coo -!!$ subroutine psb_sipcsr2coo(a,info) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type), intent(inout) :: a -!!$ integer, intent(out) :: info -!!$ end subroutine psb_sipcsr2coo -!!$ subroutine psb_dipcsr2coo(a,info) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent(inout) :: a -!!$ integer, intent(out) :: info -!!$ end subroutine psb_dipcsr2coo - subroutine psb_cipcsr2coo(a,info) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_cspmat_type), intent(inout) :: a - integer, intent(out) :: info - end subroutine psb_cipcsr2coo - subroutine psb_zipcsr2coo(a,info) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent(inout) :: a - integer, intent(out) :: info - end subroutine psb_zipcsr2coo - end interface - - interface psb_csprt -!!$ subroutine psb_scsprt(iout,a,iv,irs,ics,head,ivr,ivc) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ integer, intent(in) :: iout -!!$ type(psb_sspmat_type), intent(in) :: a -!!$ integer, intent(in), optional :: iv(:) -!!$ integer, intent(in), optional :: irs,ics -!!$ character(len=*), optional :: head -!!$ integer, intent(in), optional :: ivr(:),ivc(:) -!!$ end subroutine psb_scsprt -!!$ subroutine psb_dcsprt(iout,a,iv,irs,ics,head,ivr,ivc) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ integer, intent(in) :: iout -!!$ type(psb_dspmat_type), intent(in) :: a -!!$ integer, intent(in), optional :: iv(:) -!!$ integer, intent(in), optional :: irs,ics -!!$ character(len=*), optional :: head -!!$ integer, intent(in), optional :: ivr(:),ivc(:) -!!$ end subroutine psb_dcsprt - subroutine psb_ccsprt(iout,a,iv,irs,ics,head,ivr,ivc) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - integer, intent(in) :: iout - type(psb_cspmat_type), intent(in) :: a - integer, intent(in), optional :: iv(:) - integer, intent(in), optional :: irs,ics - character(len=*), optional :: head - integer, intent(in), optional :: ivr(:),ivc(:) - end subroutine psb_ccsprt - subroutine psb_zcsprt(iout,a,iv,irs,ics,head,ivr,ivc) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - integer, intent(in) :: iout - type(psb_zspmat_type), intent(in) :: a - integer, intent(in), optional :: iv(:) - integer, intent(in), optional :: irs,ics - character(len=*), optional :: head - integer, intent(in), optional :: ivr(:),ivc(:) - end subroutine psb_zcsprt - end interface - - interface psb_neigh -!!$ subroutine psb_sneigh(a,idx,neigh,n,info,lev) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type), intent(in) :: a -!!$ integer, intent(in) :: idx -!!$ integer, intent(out) :: n -!!$ integer, allocatable :: neigh(:) -!!$ integer, intent(out) :: info -!!$ integer, optional, intent(in) :: lev -!!$ end subroutine psb_sneigh -!!$ subroutine psb_dneigh(a,idx,neigh,n,info,lev) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent(in) :: a -!!$ integer, intent(in) :: idx -!!$ integer, intent(out) :: n -!!$ integer, allocatable :: neigh(:) -!!$ integer, intent(out) :: info -!!$ integer, optional, intent(in) :: lev -!!$ end subroutine psb_dneigh - subroutine psb_cneigh(a,idx,neigh,n,info,lev) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_cspmat_type), intent(in) :: a - integer, intent(in) :: idx - integer, intent(out) :: n - integer, allocatable :: neigh(:) - integer, intent(out) :: info - integer, optional, intent(in) :: lev - end subroutine psb_cneigh - subroutine psb_zneigh(a,idx,neigh,n,info,lev) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent(in) :: a - integer, intent(in) :: idx - integer, intent(out) :: n - integer, allocatable :: neigh(:) - integer, intent(out) :: info - integer, optional, intent(in) :: lev - end subroutine psb_zneigh - end interface - - interface psb_coins -!!$ subroutine psb_scoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ integer, intent(in) :: nz, imin,imax,jmin,jmax -!!$ integer, intent(in) :: ia(:),ja(:) -!!$ real(psb_spk_), intent(in) :: val(:) -!!$ type(psb_sspmat_type), intent(inout) :: a -!!$ integer, intent(out) :: info -!!$ integer, intent(in), optional :: gtl(:) -!!$ logical, optional, intent(in) :: rebuild -!!$ end subroutine psb_scoins -!!$ subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ integer, intent(in) :: nz, imin,imax,jmin,jmax -!!$ integer, intent(in) :: ia(:),ja(:) -!!$ real(psb_dpk_), intent(in) :: val(:) -!!$ type(psb_dspmat_type), intent(inout) :: a -!!$ integer, intent(out) :: info -!!$ integer, intent(in), optional :: gtl(:) -!!$ logical, optional, intent(in) :: rebuild -!!$ end subroutine psb_dcoins - subroutine psb_ccoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - integer, intent(in) :: nz, imin,imax,jmin,jmax - integer, intent(in) :: ia(:),ja(:) - complex(psb_spk_), intent(in) :: val(:) - type(psb_cspmat_type), intent(inout) :: a - integer, intent(out) :: info - integer, intent(in), optional :: gtl(:) - logical, optional, intent(in) :: rebuild - end subroutine psb_ccoins - subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - integer, intent(in) :: nz, imin,imax,jmin,jmax - integer, intent(in) :: ia(:),ja(:) - complex(psb_dpk_), intent(in) :: val(:) - type(psb_zspmat_type), intent(inout) :: a - integer, intent(out) :: info - integer, intent(in), optional :: gtl(:) - logical, optional, intent(in) :: rebuild - end subroutine psb_zcoins - end interface - - - interface psb_symbmm -!!$ subroutine psb_ssymbmm(a,b,c,info) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type) :: a,b,c -!!$ integer :: info -!!$ end subroutine psb_ssymbmm -!!$ subroutine psb_dsymbmm(a,b,c,info) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type) :: a,b,c -!!$ integer :: info -!!$ end subroutine psb_dsymbmm - subroutine psb_csymbmm(a,b,c,info) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_cspmat_type) :: a,b,c - integer :: info - end subroutine psb_csymbmm - subroutine psb_zsymbmm(a,b,c,info) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type) :: a,b,c - integer :: info - end subroutine psb_zsymbmm - end interface - - interface psb_numbmm -!!$ subroutine psb_snumbmm(a,b,c) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type) :: a,b,c -!!$ end subroutine psb_snumbmm -!!$ subroutine psb_dnumbmm(a,b,c) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type) :: a,b,c -!!$ end subroutine psb_dnumbmm - subroutine psb_cnumbmm(a,b,c) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_cspmat_type) :: a,b,c - end subroutine psb_cnumbmm - subroutine psb_znumbmm(a,b,c) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type) :: a,b,c - end subroutine psb_znumbmm - end interface - - interface psb_transp -!!$ subroutine psb_stransp(a,b,c,fmt) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type), intent(in) :: a -!!$ type(psb_sspmat_type), intent(out) :: b -!!$ integer, optional :: c -!!$ character(len=*), optional :: fmt -!!$ end subroutine psb_stransp -!!$ subroutine psb_dtransp(a,b,c,fmt) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent(in) :: a -!!$ type(psb_dspmat_type), intent(out) :: b -!!$ integer, optional :: c -!!$ character(len=*), optional :: fmt -!!$ end subroutine psb_dtransp - subroutine psb_ctransp(a,b,c,fmt) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_cspmat_type), intent(in) :: a - type(psb_cspmat_type), intent(out) :: b - integer, optional :: c - character(len=*), optional :: fmt - end subroutine psb_ctransp - subroutine psb_ztransp(a,b,c,fmt) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent(in) :: a - type(psb_zspmat_type), intent(out) :: b - integer, optional :: c - character(len=*), optional :: fmt - end subroutine psb_ztransp -!!$ subroutine psb_stransp1(a,c,fmt) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type), intent(inout) :: a -!!$ integer, optional :: c -!!$ character(len=*), optional :: fmt -!!$ end subroutine psb_stransp1 -!!$ subroutine psb_dtransp1(a,c,fmt) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent(inout) :: a -!!$ integer, optional :: c -!!$ character(len=*), optional :: fmt -!!$ end subroutine psb_dtransp1 - subroutine psb_ctransp1(a,c,fmt) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_cspmat_type), intent(inout) :: a - integer, optional :: c - character(len=*), optional :: fmt - end subroutine psb_ctransp1 - subroutine psb_ztransp1(a,c,fmt) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent(inout) :: a - integer, optional :: c - character(len=*), optional :: fmt - end subroutine psb_ztransp1 - end interface - - interface psb_transc - subroutine psb_ctransc(a,b,c,fmt) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_cspmat_type), intent(in) :: a - type(psb_cspmat_type), intent(out) :: b - integer, optional :: c - character(len=*), optional :: fmt - end subroutine psb_ctransc - subroutine psb_ztransc(a,b,c,fmt) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent(in) :: a - type(psb_zspmat_type), intent(out) :: b - integer, optional :: c - character(len=*), optional :: fmt - end subroutine psb_ztransc - end interface - - interface psb_rwextd -!!$ subroutine psb_srwextd(nr,a,info,b,rowscale) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ integer, intent(in) :: nr -!!$ type(psb_sspmat_type), intent(inout) :: a -!!$ integer, intent(out) :: info -!!$ type(psb_sspmat_type), intent(in), optional :: b -!!$ logical, intent(in), optional :: rowscale -!!$ end subroutine psb_srwextd -!!$ subroutine psb_drwextd(nr,a,info,b,rowscale) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ integer, intent(in) :: nr -!!$ type(psb_dspmat_type), intent(inout) :: a -!!$ integer, intent(out) :: info -!!$ type(psb_dspmat_type), intent(in), optional :: b -!!$ logical, intent(in), optional :: rowscale -!!$ end subroutine psb_drwextd - subroutine psb_crwextd(nr,a,info,b,rowscale) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - integer, intent(in) :: nr - type(psb_cspmat_type), intent(inout) :: a - integer, intent(out) :: info - type(psb_cspmat_type), intent(in), optional :: b - logical, intent(in), optional :: rowscale - end subroutine psb_crwextd - subroutine psb_zrwextd(nr,a,info,b,rowscale) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - integer, intent(in) :: nr - type(psb_zspmat_type), intent(inout) :: a - integer, intent(out) :: info - type(psb_zspmat_type), intent(in), optional :: b - logical, intent(in), optional :: rowscale - end subroutine psb_zrwextd - end interface - - interface psb_csnmi -!!$ function psb_scsnmi(a,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type), intent(in) :: a -!!$ integer, intent(out) :: info -!!$ character, optional :: trans -!!$ real(psb_spk_) :: psb_scsnmi -!!$ end function psb_scsnmi -!!$ function psb_dcsnmi(a,info,trans) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent(in) :: a -!!$ integer, intent(out) :: info -!!$ character, optional :: trans -!!$ real(psb_dpk_) :: psb_dcsnmi -!!$ end function psb_dcsnmi - function psb_ccsnmi(a,info,trans) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_cspmat_type), intent(in) :: a - integer, intent(out) :: info - character, optional :: trans - real(psb_spk_) :: psb_ccsnmi - end function psb_ccsnmi - function psb_zcsnmi(a,info,trans) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent(in) :: a - integer, intent(out) :: info - character, optional :: trans - real(psb_dpk_) :: psb_zcsnmi - end function psb_zcsnmi - end interface - - interface psb_sp_clip -!!$ subroutine psb_sspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ implicit none -!!$ type(psb_sspmat_type), intent(in) :: a -!!$ type(psb_sspmat_type), intent(out) :: b -!!$ integer, intent(out) :: info -!!$ integer, intent(in), optional :: imin,imax,jmin,jmax -!!$ logical, intent(in), optional :: rscale,cscale -!!$ end subroutine psb_sspclip -!!$ subroutine psb_dspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ implicit none -!!$ type(psb_dspmat_type), intent(in) :: a -!!$ type(psb_dspmat_type), intent(out) :: b -!!$ integer, intent(out) :: info -!!$ integer, intent(in), optional :: imin,imax,jmin,jmax -!!$ logical, intent(in), optional :: rscale,cscale -!!$ end subroutine psb_dspclip - subroutine psb_cspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - implicit none - type(psb_cspmat_type), intent(in) :: a - type(psb_cspmat_type), intent(out) :: b - integer, intent(out) :: info - integer, intent(in), optional :: imin,imax,jmin,jmax - logical, intent(in), optional :: rscale,cscale - end subroutine psb_cspclip - subroutine psb_zspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - implicit none - type(psb_zspmat_type), intent(in) :: a - type(psb_zspmat_type), intent(out) :: b - integer, intent(out) :: info - integer, intent(in), optional :: imin,imax,jmin,jmax - logical, intent(in), optional :: rscale,cscale - end subroutine psb_zspclip - end interface - - interface psb_sp_getdiag -!!$ subroutine psb_sspgtdiag(a,d,info) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type), intent(in) :: a -!!$ real(psb_spk_), intent(inout) :: d(:) -!!$ integer, intent(out) :: info -!!$ end subroutine psb_sspgtdiag -!!$ subroutine psb_dspgtdiag(a,d,info) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent(in) :: a -!!$ real(psb_dpk_), intent(inout) :: d(:) -!!$ integer, intent(out) :: info -!!$ end subroutine psb_dspgtdiag - subroutine psb_cspgtdiag(a,d,info) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_cspmat_type), intent(in) :: a - complex(psb_spk_), intent(inout) :: d(:) - integer, intent(out) :: info - end subroutine psb_cspgtdiag - subroutine psb_zspgtdiag(a,d,info) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent(in) :: a - complex(psb_dpk_), intent(inout) :: d(:) - integer, intent(out) :: info - end subroutine psb_zspgtdiag - end interface - - interface psb_sp_scal -!!$ subroutine psb_sspscals(a,d,info) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type), intent(inout) :: a -!!$ real(psb_spk_), intent(in) :: d -!!$ integer, intent(out) :: info -!!$ end subroutine psb_sspscals -!!$ subroutine psb_sspscal(a,d,info) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type), intent(inout) :: a -!!$ real(psb_spk_), intent(in) :: d(:) -!!$ integer, intent(out) :: info -!!$ end subroutine psb_sspscal -!!$ subroutine psb_dspscals(a,d,info) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent(inout) :: a -!!$ real(psb_dpk_), intent(in) :: d -!!$ integer, intent(out) :: info -!!$ end subroutine psb_dspscals -!!$ subroutine psb_dspscal(a,d,info) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent(inout) :: a -!!$ real(psb_dpk_), intent(in) :: d(:) -!!$ integer, intent(out) :: info -!!$ end subroutine psb_dspscal - subroutine psb_cspscals(a,d,info) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_cspmat_type), intent(inout) :: a - complex(psb_spk_), intent(in) :: d - integer, intent(out) :: info - end subroutine psb_cspscals - subroutine psb_cspscal(a,d,info) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_cspmat_type), intent(inout) :: a - complex(psb_spk_), intent(in) :: d(:) - integer, intent(out) :: info - end subroutine psb_cspscal - subroutine psb_zspscals(a,d,info) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent(inout) :: a - complex(psb_dpk_), intent(in) :: d - integer, intent(out) :: info - end subroutine psb_zspscals - subroutine psb_zspscal(a,d,info) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent(inout) :: a - complex(psb_dpk_), intent(in) :: d(:) - integer, intent(out) :: info - end subroutine psb_zspscal - end interface - - - interface psb_sp_setbld -!!$ subroutine psb_dspsetbld1(a,info) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent(inout) :: a -!!$ integer, intent(out) :: info -!!$ end subroutine psb_dspsetbld1 -!!$ subroutine psb_dspsetbld2(a,b,info) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent(in) :: a -!!$ type(psb_dspmat_type), intent(out) :: b -!!$ integer, intent(out) :: info -!!$ end subroutine psb_dspsetbld2 - subroutine psb_zspsetbld1(a,info) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent(inout) :: a - integer, intent(out) :: info - end subroutine psb_zspsetbld1 - subroutine psb_zspsetbld2(a,b,info) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent(in) :: a - type(psb_zspmat_type), intent(out) :: b - integer, intent(out) :: info - end subroutine psb_zspsetbld2 - end interface - - interface psb_sp_shift -!!$ subroutine psb_dspshift(alpha,a,beta,b,info) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent(in) :: a -!!$ type(psb_dspmat_type), intent(out) :: b -!!$ real(psb_dpk_), intent(in) :: alpha, beta -!!$ integer, intent(out) :: info -!!$ end subroutine psb_dspshift - subroutine psb_zspshift(alpha,a,beta,b,info) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent(in) :: a - type(psb_zspmat_type), intent(out) :: b - complex(psb_dpk_), intent(in) :: alpha, beta - integer, intent(out) :: info - end subroutine psb_zspshift - end interface - - interface psb_sp_getblk -!!$ subroutine psb_sspgtblk(irw,a,b,info,append,iren,lrw,srt) -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_sspmat_type), intent(in) :: a -!!$ integer, intent(in) :: irw -!!$ type(psb_sspmat_type), intent(inout) :: b -!!$ integer, intent(out) :: info -!!$ logical, intent(in), optional :: append -!!$ integer, intent(in), target, optional :: iren(:) -!!$ integer, intent(in), optional :: lrw -!!$ logical, intent(in), optional :: srt -!!$ end subroutine psb_sspgtblk -!!$ subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw,srt) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent(in) :: a -!!$ integer, intent(in) :: irw -!!$ type(psb_dspmat_type), intent(inout) :: b -!!$ integer, intent(out) :: info -!!$ logical, intent(in), optional :: append -!!$ integer, intent(in), target, optional :: iren(:) -!!$ integer, intent(in), optional :: lrw -!!$ logical, intent(in), optional :: srt -!!$ end subroutine psb_dspgtblk - subroutine psb_cspgtblk(irw,a,b,info,append,iren,lrw,srt) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_cspmat_type), intent(in) :: a - integer, intent(in) :: irw - type(psb_cspmat_type), intent(inout) :: b - integer, intent(out) :: info - logical, intent(in), optional :: append - integer, intent(in), target, optional :: iren(:) - integer, intent(in), optional :: lrw - logical, intent(in), optional :: srt - end subroutine psb_cspgtblk - subroutine psb_zspgtblk(irw,a,b,info,append,iren,lrw,srt) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent(in) :: a - integer, intent(in) :: irw - type(psb_zspmat_type), intent(inout) :: b - integer, intent(out) :: info - logical, intent(in), optional :: append - integer, intent(in), target, optional :: iren(:) - integer, intent(in), optional :: lrw - logical, intent(in), optional :: srt - end subroutine psb_zspgtblk - end interface - - interface psb_sp_getrow -!!$ subroutine psb_sspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin) -!!$ ! Output is always in COO format -!!$ use psb_spmat_type, only : psb_sspmat_type, & -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ implicit none -!!$ -!!$ type(psb_sspmat_type), intent(in) :: a -!!$ integer, intent(in) :: irw -!!$ integer, intent(out) :: nz -!!$ integer, allocatable, intent(inout) :: ia(:), ja(:) -!!$ real(psb_spk_), allocatable, intent(inout) :: val(:) -!!$ integer,intent(out) :: info -!!$ logical, intent(in), optional :: append -!!$ integer, intent(in), optional :: iren(:) -!!$ integer, intent(in), optional :: lrw, nzin -!!$ end subroutine psb_sspgetrow -!!$ subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin) -!!$ ! Output is always in COO format -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ implicit none -!!$ -!!$ type(psb_dspmat_type), intent(in) :: a -!!$ integer, intent(in) :: irw -!!$ integer, intent(out) :: nz -!!$ integer, allocatable, intent(inout) :: ia(:), ja(:) -!!$ real(psb_dpk_), allocatable, intent(inout) :: val(:) -!!$ integer,intent(out) :: info -!!$ logical, intent(in), optional :: append -!!$ integer, intent(in), optional :: iren(:) -!!$ integer, intent(in), optional :: lrw, nzin -!!$ end subroutine psb_dspgetrow - subroutine psb_cspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin) - ! Output is always in COO format - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - implicit none - - type(psb_cspmat_type), intent(in) :: a - integer, intent(in) :: irw - integer, intent(out) :: nz - integer, allocatable, intent(inout) :: ia(:), ja(:) - complex(psb_spk_), allocatable, intent(inout) :: val(:) - integer,intent(out) :: info - logical, intent(in), optional :: append - integer, intent(in), optional :: iren(:) - integer, intent(in), optional :: lrw, nzin - end subroutine psb_cspgetrow - subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw,append,nzin) - ! Output is always in COO format - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - implicit none - - type(psb_zspmat_type), intent(in) :: a - integer, intent(in) :: irw - integer, intent(out) :: nz - integer, allocatable, intent(inout) :: ia(:), ja(:) - complex(psb_dpk_), allocatable, intent(inout) :: val(:) - integer,intent(out) :: info - logical, intent(in), optional :: append - integer, intent(in), optional :: iren(:) - integer, intent(in), optional :: lrw, nzin - end subroutine psb_zspgetrow - end interface - - - - interface psb_csrp -!!$ subroutine psb_dcsrp(trans,iperm,a, info) -!!$ use psb_spmat_type, only : psb_sspmat_type, psb_dspmat_type,& -!!$ & psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ -!!$ type(psb_dspmat_type), intent(inout) :: a -!!$ integer, intent(inout) :: iperm(:), info -!!$ character, intent(in) :: trans -!!$ end subroutine psb_dcsrp - subroutine psb_zcsrp(trans,iperm,a, info) - use psb_spmat_type, only : psb_cspmat_type, psb_zspmat_type, psb_spk_, psb_dpk_ - type(psb_zspmat_type), intent(inout) :: a - integer, intent(inout) :: iperm(:), info - character, intent(in) :: trans - end subroutine psb_zcsrp - end interface - + use psb_mat_mod end module psb_serial_mod diff --git a/base/modules/psb_tools_mod.f90 b/base/modules/psb_tools_mod.f90 index 1a349591..3b681e50 100644 --- a/base/modules/psb_tools_mod.f90 +++ b/base/modules/psb_tools_mod.f90 @@ -31,7 +31,7 @@ !!$ Module psb_tools_mod use psb_const_mod - use psb_spmat_type + interface psb_cd_set_bld subroutine psb_cd_set_bld(desc,info) @@ -243,9 +243,9 @@ Module psb_tools_mod Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rowscale,colscale,outfmt,data) use psb_descriptor_type - use psb_spmat_type - Type(psb_cspmat_type),Intent(in) :: a - Type(psb_cspmat_type),Intent(inout) :: blk + use psb_mat_mod + Type(psb_c_sparse_mat),Intent(in) :: a + Type(psb_c_sparse_mat),Intent(inout) :: blk Type(psb_desc_type),Intent(in) :: desc_a integer, intent(out) :: info logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale @@ -255,9 +255,9 @@ Module psb_tools_mod Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rowscale,colscale,outfmt,data) use psb_descriptor_type - use psb_spmat_type - Type(psb_zspmat_type),Intent(in) :: a - Type(psb_zspmat_type),Intent(inout) :: blk + use psb_mat_mod + Type(psb_z_sparse_mat),Intent(in) :: a + Type(psb_z_sparse_mat),Intent(inout) :: blk Type(psb_desc_type),Intent(in) :: desc_a integer, intent(out) :: info logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale @@ -497,9 +497,9 @@ Module psb_tools_mod end Subroutine psb_dcdbldext Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info,extype) use psb_descriptor_type - Use psb_spmat_type + use psb_mat_mod integer, intent(in) :: novr - Type(psb_cspmat_type), Intent(in) :: a + Type(psb_c_sparse_mat), Intent(in) :: a Type(psb_desc_type), Intent(in), target :: desc_a Type(psb_desc_type), Intent(out) :: desc_ov integer, intent(out) :: info @@ -507,9 +507,9 @@ Module psb_tools_mod end Subroutine psb_ccdbldext Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info,extype) use psb_descriptor_type - Use psb_spmat_type + Use psb_mat_mod integer, intent(in) :: novr - Type(psb_zspmat_type), Intent(in) :: a + Type(psb_z_sparse_mat), Intent(in) :: a Type(psb_desc_type), Intent(in), target :: desc_a Type(psb_desc_type), Intent(out) :: desc_ov integer, intent(out) :: info @@ -548,7 +548,6 @@ Module psb_tools_mod end subroutine psb_sspalloc subroutine psb_dspalloc(a, desc_a, info, nnz) use psb_descriptor_type - use psb_spmat_type use psb_mat_mod type(psb_desc_type), intent(inout) :: desc_a type(psb_d_sparse_mat), intent(out) :: a @@ -557,17 +556,17 @@ Module psb_tools_mod end subroutine psb_dspalloc subroutine psb_cspalloc(a, desc_a, info, nnz) use psb_descriptor_type - use psb_spmat_type + use psb_mat_mod type(psb_desc_type), intent(inout) :: desc_a - type(psb_cspmat_type), intent(out) :: a + type(psb_c_sparse_mat), intent(out) :: a integer, intent(out) :: info integer, optional, intent(in) :: nnz end subroutine psb_cspalloc subroutine psb_zspalloc(a, desc_a, info, nnz) use psb_descriptor_type - use psb_spmat_type + use psb_mat_mod type(psb_desc_type), intent(inout) :: desc_a - type(psb_zspmat_type), intent(out) :: a + type(psb_z_sparse_mat), intent(out) :: a integer, intent(out) :: info integer, optional, intent(in) :: nnz end subroutine psb_zspalloc @@ -586,7 +585,6 @@ Module psb_tools_mod end subroutine psb_sspasb subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl,mold) use psb_descriptor_type - use psb_spmat_type use psb_mat_mod type(psb_d_sparse_mat), intent (inout) :: a type(psb_desc_type), intent(in) :: desc_a @@ -597,8 +595,8 @@ Module psb_tools_mod end subroutine psb_dspasb subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl) use psb_descriptor_type - use psb_spmat_type - type(psb_cspmat_type), intent (inout) :: a + use psb_mat_mod + type(psb_c_sparse_mat), intent (inout) :: a type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info integer,optional, intent(in) :: dupl, upd @@ -606,8 +604,8 @@ Module psb_tools_mod end subroutine psb_cspasb subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl) use psb_descriptor_type - use psb_spmat_type - type(psb_zspmat_type), intent (inout) :: a + use psb_mat_mod + type(psb_z_sparse_mat), intent (inout) :: a type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info integer,optional, intent(in) :: dupl, upd @@ -629,7 +627,6 @@ Module psb_tools_mod end subroutine psb_sspfree subroutine psb_dspfree(a, desc_a,info) use psb_descriptor_type - use psb_spmat_type use psb_mat_mod type(psb_desc_type), intent(in) :: desc_a type(psb_d_sparse_mat), intent(inout) :: a @@ -637,16 +634,16 @@ Module psb_tools_mod end subroutine psb_dspfree subroutine psb_cspfree(a, desc_a,info) use psb_descriptor_type - use psb_spmat_type + use psb_mat_mod type(psb_desc_type), intent(in) :: desc_a - type(psb_cspmat_type), intent(inout) ::a + type(psb_c_sparse_mat), intent(inout) ::a integer, intent(out) :: info end subroutine psb_cspfree subroutine psb_zspfree(a, desc_a,info) use psb_descriptor_type - use psb_spmat_type + use psb_mat_mod type(psb_desc_type), intent(in) :: desc_a - type(psb_zspmat_type), intent(inout) ::a + type(psb_z_sparse_mat), intent(inout) ::a integer, intent(out) :: info end subroutine psb_zspfree end interface @@ -675,7 +672,6 @@ Module psb_tools_mod end subroutine psb_sspins_2desc subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) use psb_descriptor_type - use psb_spmat_type use psb_mat_mod type(psb_desc_type), intent(inout) :: desc_a type(psb_d_sparse_mat), intent(inout) :: a @@ -696,9 +692,9 @@ Module psb_tools_mod end subroutine psb_dspins_2desc subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild) use psb_descriptor_type - use psb_spmat_type + use psb_mat_mod type(psb_desc_type), intent(inout) :: desc_a - type(psb_cspmat_type), intent(inout) :: a + type(psb_c_sparse_mat), intent(inout) :: a integer, intent(in) :: nz,ia(:),ja(:) complex(psb_spk_), intent(in) :: val(:) integer, intent(out) :: info @@ -706,19 +702,19 @@ Module psb_tools_mod end subroutine psb_cspins subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) use psb_descriptor_type - use psb_spmat_type + use psb_mat_mod type(psb_desc_type), intent(in) :: desc_ar type(psb_desc_type), intent(inout) :: desc_ac - type(psb_cspmat_type), intent(inout) :: a + type(psb_c_sparse_mat), intent(inout) :: a integer, intent(in) :: nz,ia(:),ja(:) complex(psb_spk_), intent(in) :: val(:) integer, intent(out) :: info end subroutine psb_cspins_2desc subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) use psb_descriptor_type - use psb_spmat_type + use psb_mat_mod type(psb_desc_type), intent(inout) :: desc_a - type(psb_zspmat_type), intent(inout) :: a + type(psb_z_sparse_mat), intent(inout) :: a integer, intent(in) :: nz,ia(:),ja(:) complex(psb_dpk_), intent(in) :: val(:) integer, intent(out) :: info @@ -726,10 +722,10 @@ Module psb_tools_mod end subroutine psb_zspins subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) use psb_descriptor_type - use psb_spmat_type + use psb_mat_mod type(psb_desc_type), intent(in) :: desc_ar type(psb_desc_type), intent(inout) :: desc_ac - type(psb_zspmat_type), intent(inout) :: a + type(psb_z_sparse_mat), intent(inout) :: a integer, intent(in) :: nz,ia(:),ja(:) complex(psb_dpk_), intent(in) :: val(:) integer, intent(out) :: info @@ -756,17 +752,17 @@ Module psb_tools_mod end subroutine psb_dsprn subroutine psb_csprn(a, desc_a,info,clear) use psb_descriptor_type - use psb_spmat_type + use psb_mat_mod type(psb_desc_type), intent(in) :: desc_a - type(psb_cspmat_type), intent(inout) :: a + type(psb_c_sparse_mat), intent(inout) :: a integer, intent(out) :: info logical, intent(in), optional :: clear end subroutine psb_csprn subroutine psb_zsprn(a, desc_a,info,clear) use psb_descriptor_type - use psb_spmat_type + use psb_mat_mod type(psb_desc_type), intent(in) :: desc_a - type(psb_zspmat_type), intent(inout) :: a + type(psb_z_sparse_mat), intent(inout) :: a integer, intent(out) :: info logical, intent(in), optional :: clear end subroutine psb_zsprn @@ -875,15 +871,15 @@ Module psb_tools_mod interface psb_linmap_init - module procedure psb_dlinmap_init, psb_zlinmap_init + module procedure psb_slinmap_init, psb_clinmap_init, psb_dlinmap_init, psb_zlinmap_init end interface interface psb_linmap_ins - module procedure psb_dlinmap_ins, psb_zlinmap_ins + module procedure psb_slinmap_ins, psb_clinmap_ins, psb_dlinmap_ins, psb_zlinmap_ins end interface interface psb_linmap_asb - module procedure psb_dlinmap_asb, psb_zlinmap_asb + module procedure psb_slinmap_asb, psb_clinmap_asb, psb_dlinmap_asb, psb_zlinmap_asb end interface interface psb_is_owned @@ -1158,6 +1154,73 @@ contains end subroutine psb_cdasb + subroutine psb_slinmap_init(a_map,cd_xt,descin,descout) + use psb_descriptor_type + use psb_serial_mod + use psb_penv_mod + use psb_error_mod + use psb_mat_mod + implicit none + type(psb_s_sparse_mat), intent(out) :: a_map + type(psb_desc_type), intent(out) :: cd_xt + type(psb_desc_type), intent(in) :: descin, descout + + integer :: nrow_in, nrow_out, ncol_in, info, ictxt + + ictxt = psb_cd_get_context(descin) + call psb_cdcpy(descin,cd_xt,info) + if (info ==0) call psb_cd_reinit(cd_xt,info) + if (info /= 0) then + write(0,*) 'Error on reinitialising the extension map' + call psb_error(ictxt) + call psb_abort(ictxt) + stop + end if + + nrow_in = psb_cd_get_local_rows(cd_xt) + ncol_in = psb_cd_get_local_cols(cd_xt) + nrow_out = psb_cd_get_local_rows(descout) + + call a_map%csall(nrow_out,ncol_in,info) + + end subroutine psb_slinmap_init + + subroutine psb_slinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout) + use psb_mat_mod + use psb_descriptor_type + implicit none + integer, intent(in) :: nz + integer, intent(in) :: ir(:),ic(:) + real(psb_spk_), intent(in) :: val(:) + type(psb_s_sparse_mat), intent(inout) :: a_map + type(psb_desc_type), intent(inout) :: cd_xt + type(psb_desc_type), intent(in) :: descin, descout + integer :: info + call psb_spins(nz,ir,ic,val,a_map,descout,cd_xt,info) + + end subroutine psb_slinmap_ins + + subroutine psb_slinmap_asb(a_map,cd_xt,descin,descout,afmt) + use psb_mat_mod + use psb_descriptor_type + use psb_serial_mod + implicit none + type(psb_s_sparse_mat), intent(inout) :: a_map + type(psb_desc_type), intent(inout) :: cd_xt + type(psb_desc_type), intent(in) :: descin, descout + character(len=*), optional, intent(in) :: afmt + + + integer :: nrow_in, nrow_out, ncol_in, info, ictxt + + ictxt = psb_cd_get_context(descin) + + call psb_cdasb(cd_xt,info) + call a_map%set_ncols(psb_cd_get_local_cols(cd_xt)) + call a_map%cscnv(info,type=afmt) + + end subroutine psb_slinmap_asb + subroutine psb_dlinmap_init(a_map,cd_xt,descin,descout) use psb_descriptor_type use psb_serial_mod @@ -1195,7 +1258,7 @@ contains implicit none integer, intent(in) :: nz integer, intent(in) :: ir(:),ic(:) - real(kind(1.d0)), intent(in) :: val(:) + real(psb_dpk_), intent(in) :: val(:) type(psb_d_sparse_mat), intent(inout) :: a_map type(psb_desc_type), intent(inout) :: cd_xt type(psb_desc_type), intent(in) :: descin, descout @@ -1225,14 +1288,83 @@ contains end subroutine psb_dlinmap_asb + subroutine psb_clinmap_init(a_map,cd_xt,descin,descout) + use psb_mat_mod + use psb_descriptor_type + use psb_serial_mod + use psb_penv_mod + use psb_error_mod + implicit none + type(psb_c_sparse_mat), intent(out) :: a_map + type(psb_desc_type), intent(out) :: cd_xt + type(psb_desc_type), intent(in) :: descin, descout + + integer :: nrow_in, nrow_out, ncol_in, info, ictxt + + ictxt = psb_cd_get_context(descin) + + call psb_cdcpy(descin,cd_xt,info) + if (info ==0) call psb_cd_reinit(cd_xt,info) + if (info /= 0) then + write(0,*) 'Error on reinitialising the extension map' + call psb_error(ictxt) + call psb_abort(ictxt) + stop + end if + + nrow_in = psb_cd_get_local_rows(cd_xt) + ncol_in = psb_cd_get_local_cols(cd_xt) + nrow_out = psb_cd_get_local_rows(descout) + + call a_map%csall(nrow_out,ncol_in,info) + + end subroutine psb_clinmap_init + + subroutine psb_clinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout) + use psb_mat_mod + use psb_descriptor_type + implicit none + integer, intent(in) :: nz + integer, intent(in) :: ir(:),ic(:) + complex(psb_spk_), intent(in) :: val(:) + type(psb_c_sparse_mat), intent(inout) :: a_map + type(psb_desc_type), intent(inout) :: cd_xt + type(psb_desc_type), intent(in) :: descin, descout + integer :: info + + call psb_spins(nz,ir,ic,val,a_map,descout,cd_xt,info) + + end subroutine psb_clinmap_ins + + subroutine psb_clinmap_asb(a_map,cd_xt,descin,descout,afmt) + use psb_mat_mod + use psb_descriptor_type + use psb_serial_mod + implicit none + type(psb_c_sparse_mat), intent(inout) :: a_map + type(psb_desc_type), intent(inout) :: cd_xt + type(psb_desc_type), intent(in) :: descin, descout + character(len=*), optional, intent(in) :: afmt + + integer :: nrow_in, nrow_out, ncol_in, info, ictxt + + ictxt = psb_cd_get_context(descin) + + call psb_cdasb(cd_xt,info) + call a_map%set_ncols(psb_cd_get_local_cols(cd_xt)) + call a_map%cscnv(info,type=afmt) + + end subroutine psb_clinmap_asb + + subroutine psb_zlinmap_init(a_map,cd_xt,descin,descout) - use psb_spmat_type + use psb_mat_mod use psb_descriptor_type use psb_serial_mod use psb_penv_mod use psb_error_mod implicit none - type(psb_zspmat_type), intent(out) :: a_map + type(psb_z_sparse_mat), intent(out) :: a_map type(psb_desc_type), intent(out) :: cd_xt type(psb_desc_type), intent(in) :: descin, descout @@ -1253,18 +1385,18 @@ contains ncol_in = psb_cd_get_local_cols(cd_xt) nrow_out = psb_cd_get_local_rows(descout) - call psb_sp_all(nrow_out,ncol_in,a_map,info) + call a_map%csall(nrow_out,ncol_in,info) end subroutine psb_zlinmap_init subroutine psb_zlinmap_ins(nz,ir,ic,val,a_map,cd_xt,descin,descout) - use psb_spmat_type + use psb_mat_mod use psb_descriptor_type implicit none integer, intent(in) :: nz integer, intent(in) :: ir(:),ic(:) - complex(kind(1.d0)), intent(in) :: val(:) - type(psb_zspmat_type), intent(inout) :: a_map + complex(psb_dpk_), intent(in) :: val(:) + type(psb_z_sparse_mat), intent(inout) :: a_map type(psb_desc_type), intent(inout) :: cd_xt type(psb_desc_type), intent(in) :: descin, descout integer :: info @@ -1274,11 +1406,11 @@ contains end subroutine psb_zlinmap_ins subroutine psb_zlinmap_asb(a_map,cd_xt,descin,descout,afmt) - use psb_spmat_type + use psb_mat_mod use psb_descriptor_type use psb_serial_mod implicit none - type(psb_zspmat_type), intent(inout) :: a_map + type(psb_z_sparse_mat), intent(inout) :: a_map type(psb_desc_type), intent(inout) :: cd_xt type(psb_desc_type), intent(in) :: descin, descout character(len=*), optional, intent(in) :: afmt @@ -1288,8 +1420,8 @@ contains ictxt = psb_cd_get_context(descin) call psb_cdasb(cd_xt,info) - a_map%k = psb_cd_get_local_cols(cd_xt) - call psb_spcnv(a_map,info,afmt=afmt) + call a_map%set_ncols(psb_cd_get_local_cols(cd_xt)) + call a_map%cscnv(info,type=afmt) end subroutine psb_zlinmap_asb diff --git a/base/psblas/psb_cnrmi.f90 b/base/psblas/psb_cnrmi.f90 index 12b20a24..cec675de 100644 --- a/base/psblas/psb_cnrmi.f90 +++ b/base/psblas/psb_cnrmi.f90 @@ -47,9 +47,10 @@ function psb_cnrmi(a,desc_a,info) use psb_check_mod use psb_error_mod use psb_penv_mod + use psb_mat_mod implicit none - type(psb_cspmat_type), intent(in) :: a + type(psb_c_sparse_mat), intent(in) :: a integer, intent(out) :: info type(psb_desc_type), intent(in) :: desc_a real(psb_spk_) :: psb_cnrmi @@ -94,8 +95,7 @@ function psb_cnrmi(a,desc_a,info) end if if ((m /= 0).and.(n /= 0)) then - nrmi = psb_csnmi(a,info) - + nrmi = psb_csnmi(a) if(info /= 0) then info=4010 ch_err='psb_csnmi' @@ -103,7 +103,7 @@ function psb_cnrmi(a,desc_a,info) goto 9999 end if else - nrmi = 0.d0 + nrmi = 0.0 end if ! compute global max diff --git a/base/psblas/psb_cspmm.f90 b/base/psblas/psb_cspmm.f90 index d61f8553..647cf45f 100644 --- a/base/psblas/psb_cspmm.f90 +++ b/base/psblas/psb_cspmm.f90 @@ -65,7 +65,6 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,& & trans, k, jx, jy, work, doswap) - use psb_spmat_type use psb_serial_mod use psb_descriptor_type use psb_comm_mod @@ -74,12 +73,13 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,& use psb_error_mod use psb_string_mod use psb_penv_mod + use psb_mat_mod implicit none complex(psb_spk_), intent(in) :: alpha, beta complex(psb_spk_), intent(inout), target :: x(:,:) complex(psb_spk_), intent(inout), target :: y(:,:) - type(psb_cspmat_type), intent(in) :: a + type(psb_c_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info complex(psb_spk_), optional, target :: work(:) @@ -250,7 +250,7 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,& if(info /= 0) exit blk ! local Matrix-vector product - call a%csmm(alpha,x(:,jjx+i-1:jjx+i-1+ib-1),& + call psb_csmm(alpha,a,x(:,jjx+i-1:jjx+i-1+ib-1),& & beta,y(:,jjy+i-1:jjy+i-1+ib-1),info,trans=trans_) if(info /= 0) exit blk @@ -265,9 +265,8 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,& if (doswap_)& & call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& & ib1,czero,x(:,1:ik),desc_a,iwork,info) - if (info == 0) call a%csmm(alpha,x(:,1:ik),beta,y(:,1:ik),info) + if (info == 0) call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info) end if - if(info /= 0) then info = 4011 call psb_errpush(info,name) @@ -313,7 +312,7 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,& if (info == 0) call psi_ovrl_upd(x,desc_a,psb_avg_,info) y(nrow+1:ncol,1:ik) = czero - if (info == 0) call a%csmm(alpha,x(:,1:ik),beta,y(:,1:ik),info,trans=trans_) + if (info == 0) call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info,trans=trans_) if (debug_level >= psb_debug_comp_) & & write(debug_unit,*) me,' ',trim(name),' csmm ', info if (info /= 0) then @@ -413,7 +412,7 @@ end subroutine psb_cspmm ! ! Arguments: ! alpha - complex The scalar alpha. -! a - type(psb_cspmat_type). The sparse matrix containing A. +! a - type(psb_c_sparse_mat). The sparse matrix containing A. ! x(:) - complex The input vector containing the entries of ( X ). ! beta - complex The scalar beta. ! y(:) - complex The input vector containing the entries of ( Y ). @@ -426,8 +425,6 @@ end subroutine psb_cspmm subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,& & trans, work, doswap) - use psb_spmat_type - use psb_serial_mod use psb_descriptor_type use psb_comm_mod use psb_const_mod @@ -436,12 +433,13 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,& use psb_error_mod use psb_string_mod use psb_penv_mod + use psb_mat_mod implicit none complex(psb_spk_), intent(in) :: alpha, beta complex(psb_spk_), intent(inout), target :: x(:) complex(psb_spk_), intent(inout), target :: y(:) - type(psb_cspmat_type), intent(in) :: a + type(psb_c_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info complex(psb_spk_), optional, target :: work(:) @@ -582,8 +580,7 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,& & czero,x,desc_a,iwork,info,data=psb_comm_halo_) end if - ! local Matrix-vector product - call a%csmm(alpha,x(iix:lldx),beta,y(iiy:lldy),info) + call psb_csmm(alpha,a,x,beta,y,info) if(info /= 0) then info = 4011 @@ -632,7 +629,7 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,& yp(nrow+1:ncol) = czero ! local Matrix-vector product - if (info == 0) call a%csmm(alpha,x,beta,yp,info,trans=trans_) + if (info == 0) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_) if (debug_level >= psb_debug_comp_) & & write(debug_unit,*) me,' ',trim(name),' csmm ', info diff --git a/base/psblas/psb_cspsm.f90 b/base/psblas/psb_cspsm.f90 index 6a0f2ab9..56d6dab2 100644 --- a/base/psblas/psb_cspsm.f90 +++ b/base/psblas/psb_cspsm.f90 @@ -57,14 +57,14 @@ ! ! Arguments: ! alpha - complex. The scalar alpha. -! a - type(psb_cspmat_type). The sparse matrix containing A. +! a - type(psb_c_sparse_mat). The sparse matrix containing A. ! x(:,:) - complex The input vector containing the entries of ( X ). ! beta - complex The scalar beta. ! y(:,:) - complex The input vector containing the entries of ( Y ). ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Return code ! trans - character(optional). Whether A or A'. If not present 'N' is assumed. -! unitd - character(optional). Specify some type of operation with +! side - character(optional). Specify some type of operation with ! the diagonal matrix D. ! choice - integer(optional). The kind of update to perform on overlap elements. ! d(:) - complex, optional Matrix for diagonal scaling. @@ -74,10 +74,8 @@ ! work(:) - complex, optional Working area. ! subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,& - & trans, unitd, choice, diag, k, jx, jy, work) + & trans, side, choice, diag, k, jx, jy, work) - use psb_spmat_type - use psb_serial_mod use psb_descriptor_type use psb_comm_mod use psi_mod @@ -85,17 +83,18 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,& use psb_error_mod use psb_string_mod use psb_penv_mod + use psb_mat_mod implicit none complex(psb_spk_), intent(in) :: alpha, beta complex(psb_spk_), intent(in), target :: x(:,:) complex(psb_spk_), intent(inout), target :: y(:,:) - type (psb_cspmat_type), intent(in) :: a + type (psb_c_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info complex(psb_spk_), intent(in), optional, target :: diag(:) complex(psb_spk_), optional, target :: work(:) - character, intent(in), optional :: trans, unitd + character, intent(in), optional :: trans, side integer, intent(in), optional :: choice integer, intent(in), optional :: k, jx, jy @@ -105,7 +104,7 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,& & ix, iy, ik, ijx, ijy, i, lld,& & m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm - character :: lunitd + character :: lside integer, parameter :: nb=4 complex(psb_spk_),pointer :: iwork(:), xp(:,:), yp(:,:), id(:) character :: itrans @@ -157,10 +156,10 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,& choice_ = psb_avg_ endif - if (present(unitd)) then - lunitd = psb_toupper(unitd) + if (present(side)) then + lside = psb_toupper(side) else - lunitd = 'U' + lside = 'U' endif if (present(trans)) then @@ -191,8 +190,6 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,& ! check for presence/size of a work area iwork => null() liwork= 2*ncol - if (a%pr(1) /= 0) llwork = liwork + m * ik - if (a%pl(1) /= 0) llwork = llwork + m * ik if (present(work)) then if (size(work) >= liwork) then aliw =.false. @@ -258,11 +255,11 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,& ! Perform local triangular system solve xp => x(iix:lldx,jjx:jjx+ik-1) yp => y(iiy:lldy,jjy:jjy+ik-1) - call a%cssm(alpha,xp,beta,yp,info,unitd=lunitd,d=id,trans=itrans) + call psb_cssm(alpha,a,xp,beta,yp,info,side=side,d=diag,trans=trans) if(info /= 0) then info = 4010 - ch_err='zcssm' + ch_err='cssm' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -349,23 +346,21 @@ end subroutine psb_cspsm ! ! Arguments: ! alpha - complex. The scalar alpha. -! a - type(psb_cspmat_type). The sparse matrix containing A. +! a - type(psb_c_sparse_mat). The sparse matrix containing A. ! x(:) - complex The input vector containing the entries of ( X ). ! beta - complex The scalar beta. ! y(:) - complex The input vector containing the entries of ( Y ). ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Return code ! trans - character(optional). Whether A or A'. If not present 'N' is assumed. -! unitd - character(optional). Specify some type of operation with +! side - character(optional). Specify some type of operation with ! the diagonal matrix D. ! choice - integer(optional). The kind of update to perform on overlap elements. ! d(:) - complex, optional Matrix for diagonal scaling. ! work(:) - complex, optional Working area. ! subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,& - & trans, unitd, choice, diag, work) - use psb_spmat_type - use psb_serial_mod + & trans, side, choice, diag, work) use psb_descriptor_type use psb_comm_mod use psi_mod @@ -373,17 +368,18 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,& use psb_error_mod use psb_string_mod use psb_penv_mod + use psb_mat_mod implicit none complex(psb_spk_), intent(in) :: alpha, beta complex(psb_spk_), intent(in), target :: x(:) complex(psb_spk_), intent(inout), target :: y(:) - type(psb_cspmat_type), intent(in) :: a + type(psb_c_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info complex(psb_spk_), intent(in), optional, target :: diag(:) complex(psb_spk_), optional, target :: work(:) - character, intent(in), optional :: trans, unitd + character, intent(in), optional :: trans, side integer, intent(in), optional :: choice ! locals @@ -392,7 +388,7 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,& & ix, iy, ik, jx, jy, i, lld,& & m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm - character :: lunitd + character :: lside integer, parameter :: nb=4 complex(psb_spk_),pointer :: iwork(:), xp(:), yp(:), id(:) character :: itrans @@ -428,10 +424,10 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,& choice_ = psb_avg_ endif - if (present(unitd)) then - lunitd = psb_toupper(unitd) + if (present(side)) then + lside = psb_toupper(side) else - lunitd = 'U' + lside = 'U' endif if (present(trans)) then @@ -528,7 +524,7 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,& ! Perform local triangular system solve xp => x(iix:lldx) yp => y(iiy:lldy) - call a%cssm(alpha,xp,beta,yp,info,unitd=lunitd,d=id,trans=itrans) + call psb_cssm(alpha,a,xp,beta,yp,info,side=side,d=diag,trans=trans) if(info /= 0) then info = 4010 diff --git a/base/psblas/psb_dnrmi.f90 b/base/psblas/psb_dnrmi.f90 index 79c903ba..4e51e139 100644 --- a/base/psblas/psb_dnrmi.f90 +++ b/base/psblas/psb_dnrmi.f90 @@ -43,6 +43,7 @@ ! function psb_dnrmi(a,desc_a,info) use psb_descriptor_type + use psb_serial_mod use psb_check_mod use psb_error_mod use psb_penv_mod @@ -101,7 +102,6 @@ function psb_dnrmi(a,desc_a,info) call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - else nrmi = 0.d0 end if diff --git a/base/psblas/psb_dspsm.f90 b/base/psblas/psb_dspsm.f90 index ec63633c..b6d9cf38 100644 --- a/base/psblas/psb_dspsm.f90 +++ b/base/psblas/psb_dspsm.f90 @@ -260,7 +260,7 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,& if(info /= 0) then info = 4010 - ch_err='dcssm' + ch_err='cssm' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if diff --git a/base/psblas/psb_snrmi.f90 b/base/psblas/psb_snrmi.f90 index 1a725b99..83ffb218 100644 --- a/base/psblas/psb_snrmi.f90 +++ b/base/psblas/psb_snrmi.f90 @@ -43,6 +43,7 @@ ! function psb_snrmi(a,desc_a,info) use psb_descriptor_type + use psb_serial_mod use psb_check_mod use psb_error_mod use psb_penv_mod @@ -103,7 +104,7 @@ function psb_snrmi(a,desc_a,info) end if else - nrmi = 0.d0 + nrmi = 0.0 end if ! compute global max call psb_amx(ictxt, nrmi) diff --git a/base/psblas/psb_sspmm.f90 b/base/psblas/psb_sspmm.f90 index fad70505..1c6a6937 100644 --- a/base/psblas/psb_sspmm.f90 +++ b/base/psblas/psb_sspmm.f90 @@ -65,7 +65,6 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,& & trans, k, jx, jy, work, doswap) - use psb_spmat_type use psb_serial_mod use psb_descriptor_type use psb_comm_mod diff --git a/base/psblas/psb_sspsm.f90 b/base/psblas/psb_sspsm.f90 index 22b03d11..fb967644 100644 --- a/base/psblas/psb_sspsm.f90 +++ b/base/psblas/psb_sspsm.f90 @@ -260,7 +260,7 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,& if(info /= 0) then info = 4010 - ch_err='dcssm' + ch_err='cssm' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if diff --git a/base/psblas/psb_znrmi.f90 b/base/psblas/psb_znrmi.f90 index d275addb..7851420a 100644 --- a/base/psblas/psb_znrmi.f90 +++ b/base/psblas/psb_znrmi.f90 @@ -37,7 +37,7 @@ ! normi := max(abs(sum(A(i,j)))) ! ! Arguments: -! a - type(psb_dspmat_type). The sparse matrix containing A. +! a - type(psb_d_sparse_mat). The sparse matrix containing A. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Return code ! @@ -47,9 +47,10 @@ function psb_znrmi(a,desc_a,info) use psb_check_mod use psb_error_mod use psb_penv_mod + use psb_mat_mod implicit none - type(psb_zspmat_type), intent(in) :: a + type(psb_z_sparse_mat), intent(in) :: a integer, intent(out) :: info type(psb_desc_type), intent(in) :: desc_a real(psb_dpk_) :: psb_znrmi @@ -94,8 +95,7 @@ function psb_znrmi(a,desc_a,info) end if if ((m /= 0).and.(n /= 0)) then - nrmi = psb_csnmi(a,info) - + nrmi = psb_csnmi(a) if(info /= 0) then info=4010 ch_err='psb_csnmi' @@ -105,7 +105,6 @@ function psb_znrmi(a,desc_a,info) else nrmi = 0.d0 end if - ! compute global max call psb_amx(ictxt, nrmi) diff --git a/base/psblas/psb_zspmm.f90 b/base/psblas/psb_zspmm.f90 index 1e44dc89..efc70a16 100644 --- a/base/psblas/psb_zspmm.f90 +++ b/base/psblas/psb_zspmm.f90 @@ -49,7 +49,7 @@ ! ! Arguments: ! alpha - complex The scalar alpha. -! a - type(psb_zspmat_type). The sparse matrix containing A. +! a - type(psb_z_sparse_mat). The sparse matrix containing A. ! x(:,:) - complex The input vector containing the entries of ( X ). ! beta - complex The scalar beta. ! y(:,:) - complex The input vector containing the entries of ( Y ). @@ -65,8 +65,6 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& & trans, k, jx, jy, work, doswap) - use psb_spmat_type - use psb_serial_mod use psb_descriptor_type use psb_comm_mod use psi_mod @@ -74,12 +72,13 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& use psb_error_mod use psb_string_mod use psb_penv_mod + use psb_mat_mod implicit none complex(psb_dpk_), intent(in) :: alpha, beta complex(psb_dpk_), intent(inout), target :: x(:,:) complex(psb_dpk_), intent(inout), target :: y(:,:) - type(psb_zspmat_type), intent(in) :: a + type(psb_z_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info complex(psb_dpk_), optional, target :: work(:) @@ -250,7 +249,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& if(info /= 0) exit blk ! local Matrix-vector product - call a%csmm(alpha,x(:,jjx+i-1:jjx+i-1+ib-1),& + call psb_csmm(alpha,a,x(:,jjx+i-1:jjx+i-1+ib-1),& & beta,y(:,jjy+i-1:jjy+i-1+ib-1),info,trans=trans_) if(info /= 0) exit blk @@ -265,9 +264,8 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& if (doswap_)& & call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),& & ib1,zzero,x(:,1:ik),desc_a,iwork,info) - if (info == 0) call a%csmm(alpha,x(:,1:ik),beta,y(:,1:ik),info) + if (info == 0) call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info) end if - if(info /= 0) then info = 4011 call psb_errpush(info,name) @@ -313,7 +311,7 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,& if (info == 0) call psi_ovrl_upd(x,desc_a,psb_avg_,info) y(nrow+1:ncol,1:ik) = zzero - if (info == 0) call a%csmm(alpha,x(:,1:ik),beta,y(:,1:ik),info,trans=trans_) + if (info == 0) call psb_csmm(alpha,a,x(:,1:ik),beta,y(:,1:ik),info,trans=trans_) if (debug_level >= psb_debug_comp_) & & write(debug_unit,*) me,' ',trim(name),' csmm ', info if (info /= 0) then @@ -413,7 +411,7 @@ end subroutine psb_zspmm ! ! Arguments: ! alpha - complex The scalar alpha. -! a - type(psb_zspmat_type). The sparse matrix containing A. +! a - type(psb_z_sparse_mat). The sparse matrix containing A. ! x(:) - complex The input vector containing the entries of ( X ). ! beta - complex The scalar beta. ! y(:) - complex The input vector containing the entries of ( Y ). @@ -426,8 +424,6 @@ end subroutine psb_zspmm subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& & trans, work, doswap) - use psb_spmat_type - use psb_serial_mod use psb_descriptor_type use psb_comm_mod use psb_const_mod @@ -436,12 +432,13 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& use psb_error_mod use psb_string_mod use psb_penv_mod + use psb_mat_mod implicit none complex(psb_dpk_), intent(in) :: alpha, beta complex(psb_dpk_), intent(inout), target :: x(:) complex(psb_dpk_), intent(inout), target :: y(:) - type(psb_zspmat_type), intent(in) :: a + type(psb_z_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info complex(psb_dpk_), optional, target :: work(:) @@ -582,8 +579,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& & zzero,x,desc_a,iwork,info,data=psb_comm_halo_) end if - ! local Matrix-vector product - call a%csmm(alpha,x(iix:lldx),beta,y(iiy:lldy),info) + call psb_csmm(alpha,a,x,beta,y,info) if(info /= 0) then info = 4011 @@ -632,7 +628,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,& yp(nrow+1:ncol) = zzero ! local Matrix-vector product - if (info == 0) call a%csmm(alpha,x,beta,yp,info,trans=trans_) + if (info == 0) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_) if (debug_level >= psb_debug_comp_) & & write(debug_unit,*) me,' ',trim(name),' csmm ', info diff --git a/base/psblas/psb_zspsm.f90 b/base/psblas/psb_zspsm.f90 index f2d80c62..bd19d51e 100644 --- a/base/psblas/psb_zspsm.f90 +++ b/base/psblas/psb_zspsm.f90 @@ -57,7 +57,7 @@ ! ! Arguments: ! alpha - complex. The scalar alpha. -! a - type(psb_zspmat_type). The sparse matrix containing A. +! a - type(psb_z_sparse_mat). The sparse matrix containing A. ! x(:,:) - complex The input vector containing the entries of ( X ). ! beta - complex The scalar beta. ! y(:,:) - complex The input vector containing the entries of ( Y ). @@ -74,10 +74,8 @@ ! work(:) - complex, optional Working area. ! subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,& - & trans, unitd, choice, diag, k, jx, jy, work) + & trans, side, choice, diag, k, jx, jy, work) - use psb_spmat_type - use psb_serial_mod use psb_descriptor_type use psb_comm_mod use psi_mod @@ -85,17 +83,18 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,& use psb_error_mod use psb_string_mod use psb_penv_mod + use psb_mat_mod implicit none complex(psb_dpk_), intent(in) :: alpha, beta complex(psb_dpk_), intent(in), target :: x(:,:) complex(psb_dpk_), intent(inout), target :: y(:,:) - type (psb_zspmat_type), intent(in) :: a + type (psb_z_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info complex(psb_dpk_), intent(in), optional, target :: diag(:) complex(psb_dpk_), optional, target :: work(:) - character, intent(in), optional :: trans, unitd + character, intent(in), optional :: trans, side integer, intent(in), optional :: choice integer, intent(in), optional :: k, jx, jy @@ -105,7 +104,7 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,& & ix, iy, ik, ijx, ijy, i, lld,& & m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm - character :: lunitd + character :: lside integer, parameter :: nb=4 complex(psb_dpk_),pointer :: iwork(:), xp(:,:), yp(:,:), id(:) character :: itrans @@ -157,10 +156,10 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,& choice_ = psb_avg_ endif - if (present(unitd)) then - lunitd = psb_toupper(unitd) + if (present(side)) then + lside = psb_toupper(side) else - lunitd = 'U' + lside = 'U' endif if (present(trans)) then @@ -191,8 +190,6 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,& ! check for presence/size of a work area iwork => null() liwork= 2*ncol - if (a%pr(1) /= 0) llwork = liwork + m * ik - if (a%pl(1) /= 0) llwork = llwork + m * ik if (present(work)) then if (size(work) >= liwork) then aliw =.false. @@ -258,11 +255,11 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,& ! Perform local triangular system solve xp => x(iix:lldx,jjx:jjx+ik-1) yp => y(iiy:lldy,jjy:jjy+ik-1) - call a%cssm(alpha,xp,beta,yp,info,unitd=lunitd,d=id,trans=itrans) + call psb_cssm(alpha,a,xp,beta,yp,info,side=side,d=diag,trans=trans) if(info /= 0) then info = 4010 - ch_err='zcssm' + ch_err='cssm' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -349,23 +346,21 @@ end subroutine psb_zspsm ! ! Arguments: ! alpha - complex. The scalar alpha. -! a - type(psb_zspmat_type). The sparse matrix containing A. +! a - type(psb_z_sparse_mat). The sparse matrix containing A. ! x(:) - complex The input vector containing the entries of ( X ). ! beta - complex The scalar beta. ! y(:) - complex The input vector containing the entries of ( Y ). ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Return code ! trans - character(optional). Whether A or A'. If not present 'N' is assumed. -! unitd - character(optional). Specify some type of operation with +! side - character(optional). Specify some type of operation with ! the diagonal matrix D. ! choice - integer(optional). The kind of update to perform on overlap elements. ! d(:) - complex, optional Matrix for diagonal scaling. ! work(:) - complex, optional Working area. ! subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,& - & trans, unitd, choice, diag, work) - use psb_spmat_type - use psb_serial_mod + & trans, side, choice, diag, work) use psb_descriptor_type use psb_comm_mod use psi_mod @@ -373,17 +368,18 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,& use psb_error_mod use psb_string_mod use psb_penv_mod + use psb_mat_mod implicit none complex(psb_dpk_), intent(in) :: alpha, beta complex(psb_dpk_), intent(in), target :: x(:) complex(psb_dpk_), intent(inout), target :: y(:) - type(psb_zspmat_type), intent(in) :: a + type(psb_z_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info complex(psb_dpk_), intent(in), optional, target :: diag(:) complex(psb_dpk_), optional, target :: work(:) - character, intent(in), optional :: trans, unitd + character, intent(in), optional :: trans, side integer, intent(in), optional :: choice ! locals @@ -392,7 +388,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,& & ix, iy, ik, jx, jy, i, lld,& & m, nrow, ncol, liwork, llwork, iiy, jjy, idx, ndm - character :: lunitd + character :: lside integer, parameter :: nb=4 complex(psb_dpk_),pointer :: iwork(:), xp(:), yp(:), id(:) character :: itrans @@ -428,10 +424,10 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,& choice_ = psb_avg_ endif - if (present(unitd)) then - lunitd = psb_toupper(unitd) + if (present(side)) then + lside = psb_toupper(side) else - lunitd = 'U' + lside = 'U' endif if (present(trans)) then @@ -528,7 +524,7 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,& ! Perform local triangular system solve xp => x(iix:lldx) yp => y(iiy:lldy) - call a%cssm(alpha,xp,beta,yp,info,unitd=lunitd,d=id,trans=itrans) + call psb_cssm(alpha,a,xp,beta,yp,info,side=side,d=diag,trans=trans) if(info /= 0) then info = 4010 diff --git a/base/serial/Makefile b/base/serial/Makefile index 2392ff3e..cbe5f71a 100644 --- a/base/serial/Makefile +++ b/base/serial/Makefile @@ -1,22 +1,22 @@ include ../../Make.inc -FOBJS = psb_cest.o \ - psb_regen_mod.o psb_lsame.o psb_zspgetrow.o\ - psb_zcsmm.o psb_zcsmv.o psb_zspgtdiag.o psb_zspgtblk.o\ - psb_zcsnmi.o psb_zcsrws.o psb_zcssm.o psb_zcssv.o psb_zspcnv.o\ - psb_zfixcoo.o psb_zipcoo2csr.o psb_zipcsr2coo.o psb_zipcoo2csc.o \ - psb_zcoins.o psb_zcsprt.o psb_zneigh.o psb_ztransp.o psb_ztransc.o\ - psb_zrwextd.o psb_zsymbmm.o psb_znumbmm.o psb_zspscal.o psb_zspclip.o\ - psb_getifield.o psb_setifield.o psb_update_mod.o psb_getrow_mod.o\ - psb_zgelp.o\ - psb_zspshift.o psb_zspsetbld.o\ - psb_ccsprt.o psb_cspcnv.o psb_ccoins.o psb_ccsnmi.o\ - psb_cfixcoo.o psb_cipcsr2coo.o psb_cipcoo2csr.o psb_cipcoo2csc.o \ - psb_cgelp.o psb_cspgtdiag.o psb_cspgtblk.o psb_cspgetrow.o\ - psb_ccssm.o psb_ccssv.o psb_ccsmm.o psb_ccsmv.o psb_ctransp.o psb_ctransc.o\ - psb_cspclip.o psb_crwextd.o psb_cspscal.o\ - psb_cnumbmm.o psb_csymbmm.o psb_cneigh.o +FOBJS = psb_lsame.o +# psb_regen_mod.o psb_lsame.o psb_zspgetrow.o\ +# psb_zcsmm.o psb_zcsmv.o psb_zspgtdiag.o psb_zspgtblk.o\ +# psb_zcsnmi.o psb_zcsrws.o psb_zcssm.o psb_zcssv.o psb_zspcnv.o\ +# psb_zfixcoo.o psb_zipcoo2csr.o psb_zipcsr2coo.o psb_zipcoo2csc.o \ +# psb_zcoins.o psb_zcsprt.o psb_zneigh.o psb_ztransp.o psb_ztransc.o\ +# psb_zrwextd.o psb_zsymbmm.o psb_znumbmm.o psb_zspscal.o psb_zspclip.o\ +# psb_getifield.o psb_setifield.o psb_update_mod.o psb_getrow_mod.o\ +# psb_zgelp.o\ +# psb_zspshift.o psb_zspsetbld.o\ +# psb_ccsprt.o psb_cspcnv.o psb_ccoins.o psb_ccsnmi.o\ +# psb_cfixcoo.o psb_cipcsr2coo.o psb_cipcoo2csr.o psb_cipcoo2csc.o \ +# psb_cgelp.o psb_cspgtdiag.o psb_cspgtblk.o psb_cspgetrow.o\ +# psb_ccssm.o psb_ccssv.o psb_ccsmm.o psb_ccsmv.o psb_ctransp.o psb_ctransc.o\ +# psb_cspclip.o psb_crwextd.o psb_cspscal.o\ +# psb_cnumbmm.o psb_csymbmm.o psb_cneigh.o #FOBJS = psb_cest.o psb_dcoins.o psb_dcsmm.o psb_dcsmv.o \ # psb_dcsnmi.o psb_dcsprt.o psb_dcsrws.o psb_dcssm.o psb_dcssv.o \ # psb_dfixcoo.o psb_dipcoo2csr.o psb_dipcsr2coo.o psb_dneigh.o \ @@ -49,10 +49,11 @@ LIBDIR=.. MODDIR=../modules FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG)$(MODDIR) $(FMFLAG). -lib: auxd cood csrd jadd f77d f03d dpd lib1 +lib: auxd f77d f03d dpd lib1 $(AR) $(LIBDIR)/$(LIBNAME) $(FOBJS) $(RANLIB) $(LIBDIR)/$(LIBNAME) +#cood csrd jadd lib1: $(FOBJS) diff --git a/base/serial/dp/Makefile b/base/serial/dp/Makefile index ef7b559b..7b1ed7ca 100644 --- a/base/serial/dp/Makefile +++ b/base/serial/dp/Makefile @@ -3,14 +3,16 @@ include ../../../Make.inc # The object files # -XOBJS = scrjd.o ccrjd.o zcrjd.o +XOBJS = +#scrjd.o ccrjd.o zcrjd.o FOBJS = partition.o dgblock.o dvtfg.o \ check_dim.o \ Max_nnzero.o \ - gen_block.o\ - ccoco.o ccocr.o ccrco.o ccrcr.o cgindex.o cgind_tri.o\ - zcoco.o zcocr.o zcrco.o zcrcr.o zgindex.o zgind_tri.o\ - $(XOBJS) + gen_block.o + #\ +# ccoco.o ccocr.o ccrco.o ccrcr.o cgindex.o cgind_tri.o\ +# zcoco.o zcocr.o zcrco.o zcrcr.o zgindex.o zgind_tri.o\ +# $(XOBJS) #dcoco.o dcocr.o dcrco.o djdcox.o djdco.o dgind_tri.o \ #dcrcr.o @@ -41,7 +43,7 @@ LIBFILE=$(LIBDIR)/$(LIBNAME) # -lib: xobjs $(FOBJS) +lib: $(FOBJS) $(AR) $(LIBDIR)/$(LIBNAME) $(OBJS) $(RANLIB) $(LIBDIR)/$(LIBNAME) diff --git a/base/serial/dp/gen_block.f b/base/serial/dp/gen_block.f index b2a37b72..84186df7 100644 --- a/base/serial/dp/gen_block.f +++ b/base/serial/dp/gen_block.f @@ -31,7 +31,7 @@ C C SUBROUTINE GEN_BLOCK(M,NG,IA,AUX) use psb_const_mod - use psb_spmat_type + use psb_serial_mod IMPLICIT NONE INTEGER M, NG diff --git a/base/serial/dp/partition.f b/base/serial/dp/partition.f index 5c05ccc2..98be555e 100644 --- a/base/serial/dp/partition.f +++ b/base/serial/dp/partition.f @@ -31,7 +31,7 @@ C C SUBROUTINE PARTITION(M, WORK, IA, N_BLOCK) use psb_const_mod - use psb_spmat_type + use psb_serial_mod IMPLICIT NONE diff --git a/base/serial/dp/scrjd.f b/base/serial/dp/scrjd.f index 9827d203..e39d66cc 100644 --- a/base/serial/dp/scrjd.f +++ b/base/serial/dp/scrjd.f @@ -61,7 +61,7 @@ C ARN,IAN1 C IAN2,INFON, IP1, IP2 C use psb_const_mod - use psb_spmat_type + use psb_serial_mod use psb_string_mod IMPLICIT NONE diff --git a/base/serial/f77/Makefile b/base/serial/f77/Makefile index 6fb46219..cc3c4bad 100644 --- a/base/serial/f77/Makefile +++ b/base/serial/f77/Makefile @@ -4,11 +4,13 @@ include ../../../Make.inc # The object files # FOBJS = daxpby.o saxpby.o \ - sgelp.o\ - caxpby.o clpupd.o ccsmm.o cswmm.o ccsnmi.o ccsrws.o\ - cswsm.o ccssm.o cgelp.o\ - zcsnmi.o zaxpby.o zcsmm.o zcssm.o zswmm.o zswsm.o\ - zcsrws.o zgelp.o zlpupd.o + caxpby.o zaxpby.o + + +# clpupd.o ccsmm.o cswmm.o ccsnmi.o ccsrws.o\ +# cswsm.o ccssm.o cgelp.o\ +# zcsnmi.o zcsmm.o zcssm.o zswmm.o zswsm.o\ +# zcsrws.o zgelp.o zlpupd.o #dcsmm.o dcsnmi.o dcsrp.o dcssm.o \ # dgelp.o dlpupd.o dswmm.o \ diff --git a/base/serial/psb_cest.f90 b/base/serial/psb_cest.f90 index f17e1e4f..b76fbf20 100644 --- a/base/serial/psb_cest.f90 +++ b/base/serial/psb_cest.f90 @@ -34,7 +34,7 @@ subroutine psb_cest(afmt,m,n,nnz, lia1, lia2, lar, iup,info) use psb_error_mod use psb_const_mod use psb_string_mod - use psb_spmat_type + use psb_serial_mod implicit none diff --git a/base/tools/psb_ccdbldext.F90 b/base/tools/psb_ccdbldext.F90 index 51653b26..7155952e 100644 --- a/base/tools/psb_ccdbldext.F90 +++ b/base/tools/psb_ccdbldext.F90 @@ -37,7 +37,7 @@ ! specified on input. ! ! Arguments: -! a - type(psb_cspmat_type). The input sparse matrix. +! a - type(psb_c_sparse_mat). The input sparse matrix. ! desc_a - type(psb_desc_type). The input communication descriptor. ! novr - integer. The number of overlap levels. ! desc_ov - type(psb_desc_type). The auxiliary output communication @@ -78,7 +78,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) ! .. Array Arguments .. integer, intent(in) :: novr - Type(psb_cspmat_type), Intent(in) :: a + Type(psb_c_sparse_mat), Intent(in) :: a Type(psb_desc_type), Intent(in), target :: desc_a Type(psb_desc_type), Intent(out) :: desc_ov integer, intent(out) :: info @@ -86,7 +86,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) ! .. Local Scalars .. - Integer :: i, j, np, me,m,nnzero,& + Integer :: i, j, np, me,m,& & ictxt, lovr, lworks,lworkr, n_row,n_col, int_err(5),& & index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo Integer :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,& @@ -95,7 +95,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ integer :: icomm, err_act - type(psb_cspmat_type) :: blk + integer, allocatable :: irow(:), icol(:) Integer, allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) Integer,allocatable :: halo(:),works(:),workr(:),t_halo_in(:),& & t_halo_out(:),temp(:),maskr(:) @@ -123,7 +123,6 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) extype_ = psb_ovt_xhal_ endif m = psb_cd_get_local_rows(desc_a) - nnzero = Size(a%aspk) n_row = psb_cd_get_local_rows(desc_a) n_col = psb_cd_get_local_cols(desc_a) nhalo = n_col-m @@ -170,7 +169,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) ! LOVR= (NNZ/NROW)*N_HALO*NOVR This assumes that the local average ! nonzeros per row is the same as the global. ! - nztot = psb_sp_get_nnzeros(a) + nztot = a%get_nzeros() if (nztot>0) then lovr = ((nztot+m-1)/m)*nhalo*novr lworks = ((nztot+m-1)/m)*nhalo @@ -211,16 +210,6 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) goto 9999 end if - call psb_sp_all(blk,max(lworks,lworkr),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 - - blk%fida='COO' - Allocate(orig_ovr(l_tmp_ovr_idx),tmp_ovr_idx(l_tmp_ovr_idx),& & tmp_halo(l_tmp_halo), halo(size(desc_a%halo_index)),stat=info) if (info /= 0) then @@ -415,35 +404,20 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) ! Prepare to exchange the halo rows with the other proc. ! If (i_ovr <= (novr)) Then - n_elem = psb_sp_get_nnz_row(idx,a) - call psb_ensure_size((idxs+tot_elem+n_elem),works,info) + call a%csget(idx,idx,n_elem,irow,icol,info) if (info /= 0) then info=4010 - call psb_errpush(info,name,a_err='psb_ensure_size') + call psb_errpush(info,name,a_err='csget') goto 9999 end if - - If((n_elem) > size(blk%ia2)) Then - isz = max((3*size(blk%ia2))/2,(n_elem)) - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,'Realloc blk',isz - call psb_sp_reall(blk,isz,info) - if (info /= 0) then - info=4010 - ch_err='psb_sp_reall' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - End If - - call psb_sp_getblk(idx,a,blk,info) + + call psb_ensure_size((idxs+tot_elem+n_elem),works,info) if (info /= 0) then info=4010 - ch_err='psb_sp_getblk' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psb_ensure_size') goto 9999 end if - call psb_map_l2g(blk%ia2(1:n_elem),& + call psb_map_l2g(icol(1:n_elem),& & works(idxs+tot_elem+1:idxs+tot_elem+n_elem),& & desc_ov%idxmap,info) tot_elem=tot_elem+n_elem @@ -735,15 +709,21 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) end if call psb_icdasb(desc_ov,info,ext_hv=.true.) - - call psb_cd_set_ovl_asb(desc_ov,info) - - if (info == 0) call psb_sp_free(blk,info) if (info /= 0) then - ch_err='sp_free' - call psb_errpush(4013,name,a_err=ch_err,i_err=(/info,0,0,0,0/)) + call psb_errpush(4010,name,a_err='icdasdb') goto 9999 end if + + call psb_cd_set_ovl_asb(desc_ov,info) + + if (info == 0) then + if (allocated(irow)) deallocate(irow,stat=info) + if ((info ==0).and.allocated(icol)) deallocate(icol,stat=info) + if (info /= 0) then + call psb_errpush(4013,name,a_err='deallocate',i_err=(/info,0,0,0,0/)) + goto 9999 + end if + end if if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': end' diff --git a/base/tools/psb_cins.f90 b/base/tools/psb_cins.f90 index 8f2447cd..26b139dd 100644 --- a/base/tools/psb_cins.f90 +++ b/base/tools/psb_cins.f90 @@ -48,7 +48,6 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl) !....insert dense submatrix to dense matrix ..... use psb_descriptor_type - use psb_spmat_type use psb_const_mod use psb_error_mod use psb_penv_mod @@ -234,7 +233,6 @@ end subroutine psb_cinsvi subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl) !....insert dense submatrix to dense matrix ..... use psb_descriptor_type - use psb_spmat_type use psb_const_mod use psb_error_mod use psb_penv_mod diff --git a/base/tools/psb_cspalloc.f90 b/base/tools/psb_cspalloc.f90 index c829a7f1..f4860ba1 100644 --- a/base/tools/psb_cspalloc.f90 +++ b/base/tools/psb_cspalloc.f90 @@ -35,7 +35,7 @@ ! Allocate sparse matrix structure for psblas routines. ! ! Arguments: -! a - type(psb_cspmat_type). The sparse matrix to be allocated. +! a - type(psb_c_sparse_mat). The sparse matrix to be allocated. ! desc_a - type(psb_desc_type). The communication descriptor to be updated. ! info - integer. Return code. ! nnz - integer(optional). The number of nonzeroes in the matrix. @@ -44,7 +44,6 @@ subroutine psb_cspalloc(a, desc_a, info, nnz) use psb_descriptor_type - use psb_spmat_type use psb_serial_mod use psb_const_mod use psb_error_mod @@ -53,7 +52,7 @@ subroutine psb_cspalloc(a, desc_a, info, nnz) !....parameters... type(psb_desc_type), intent(inout) :: desc_a - type(psb_cspmat_type), intent(out) :: a + type(psb_c_sparse_mat), intent(out) :: a integer, intent(out) :: info integer, optional, intent(in) :: nnz @@ -108,7 +107,7 @@ subroutine psb_cspalloc(a, desc_a, info, nnz) & write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1 !....allocate aspk, ia1, ia2..... - call psb_sp_all(loc_row,loc_col,a,length_ia1,info) + call a%csall(loc_row,loc_col,info,nz=length_ia1) if(info /= 0) then info=4010 ch_err='sp_all' diff --git a/base/tools/psb_cspasb.f90 b/base/tools/psb_cspasb.f90 index e22e53b2..a65b7f95 100644 --- a/base/tools/psb_cspasb.f90 +++ b/base/tools/psb_cspasb.f90 @@ -35,7 +35,7 @@ ! Assemble sparse matrix ! ! Arguments: -! a - type(psb_cspmat_type). The sparse matrix to be assembled +! a - type(psb_c_sparse_mat). The sparse matrix to be assembled ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. return code. ! afmt - character(optional) The desired output storage format. @@ -48,10 +48,9 @@ ! psb_dupl_err_ raise an error. ! ! -subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl) +subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl,mold) use psb_descriptor_type - use psb_spmat_type use psb_serial_mod use psb_const_mod use psi_mod @@ -62,11 +61,12 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl) !...Parameters.... - type(psb_cspmat_type), intent (inout) :: a + type(psb_c_sparse_mat), intent (inout) :: a type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info integer,optional, intent(in) :: dupl, upd character(len=*), optional, intent(in) :: afmt + class(psb_c_base_sparse_mat), intent(in), optional :: mold !....Locals.... integer :: int_err(5) integer :: np,me,n_col, err_act @@ -107,23 +107,27 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl) !check on errors encountered in psdspins - spstate = a%infoa(psb_state_) - if (spstate == psb_spmat_bld_) then + + if (a%is_bld()) then ! ! First case: we come from a fresh build. ! n_row = psb_cd_get_local_rows(desc_a) n_col = psb_cd_get_local_cols(desc_a) - a%m = n_row - a%k = n_col + call a%set_nrows(n_row) + call a%set_ncols(n_col) end if - call psb_spcnv(a,info,afmt=afmt,upd=upd,dupl=dupl) + call a%cscnv(info,type=afmt,dupl=dupl, mold=mold) - IF (debug_level >= psb_debug_ext_)& - & write(debug_unit, *) me,' ',trim(name),': From SPCNV',& - & info,' ',A%FIDA + + IF (debug_level >= psb_debug_ext_) then + ch_err=a%get_fmt() + write(debug_unit, *) me,' ',trim(name),': From SPCNV',& + & info,' ',ch_err + end IF + if (info /= psb_no_err_) then info=4010 ch_err='psb_spcnv' diff --git a/base/tools/psb_cspfree.f90 b/base/tools/psb_cspfree.f90 index 1214046f..3cce11b7 100644 --- a/base/tools/psb_cspfree.f90 +++ b/base/tools/psb_cspfree.f90 @@ -35,14 +35,13 @@ ! Frees a sparse matrix structure. ! ! Arguments: -! a - type(psb_cspmat_type). The sparse matrix to be freed. +! a - type(psb_c_sparse_mat). The sparse matrix to be freed. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. return code. ! subroutine psb_cspfree(a, desc_a,info) !...free sparse matrix structure... use psb_descriptor_type - use psb_spmat_type use psb_serial_mod use psb_const_mod use psb_error_mod @@ -50,7 +49,7 @@ subroutine psb_cspfree(a, desc_a,info) !....parameters... type(psb_desc_type), intent(in) :: desc_a - type(psb_cspmat_type), intent(inout) :: a + type(psb_c_sparse_mat), intent(inout) :: a integer, intent(out) :: info !...locals.... integer :: ictxt, err_act @@ -70,14 +69,7 @@ subroutine psb_cspfree(a, desc_a,info) end if !...deallocate a.... - call psb_sp_free(a,info) - - - if(info /= 0) then - info=2045 - call psb_errpush(info,name) - goto 9999 - end if + call a%free() call psb_erractionrestore(err_act) return diff --git a/base/tools/psb_csphalo.F90 b/base/tools/psb_csphalo.F90 index 884cc964..4e74d695 100644 --- a/base/tools/psb_csphalo.F90 +++ b/base/tools/psb_csphalo.F90 @@ -38,9 +38,9 @@ ! ! ! Arguments: -! a - type(psb_cspmat_type) The local part of input matrix A +! a - type(psb_c_sparse_mat) The local part of input matrix A ! desc_a - type(psb_desc_type). The communication descriptor. -! blck - type(psb_cspmat_type) The local part of output matrix BLCK +! blck - type(psb_c_sparse_mat) The local part of output matrix BLCK ! info - integer. Return code ! rowcnv - logical Should row/col indices be converted ! colcnv - logical to/from global numbering when sent/received? @@ -73,8 +73,8 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& include 'mpif.h' #endif - Type(psb_cspmat_type),Intent(in) :: a - Type(psb_cspmat_type),Intent(inout) :: blk + Type(psb_c_sparse_mat),Intent(in) :: a + Type(psb_c_sparse_mat),Intent(inout) :: blk Type(psb_desc_type),Intent(in), target :: desc_a integer, intent(out) :: info logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale @@ -89,8 +89,9 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& Integer, allocatable :: sdid(:,:), brvindx(:),rvid(:,:), & & rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:) complex(psb_spk_), allocatable :: valsnd(:) - integer, pointer :: idxv(:) - logical :: rowcnv_,colcnv_,rowscale_,colscale_ + type(psb_c_coo_sparse_mat), allocatable :: acoo + integer, pointer :: idxv(:) + logical :: rowcnv_,colcnv_,rowscale_,colscale_ character(len=5) :: outfmt_ integer :: debug_level, debug_unit character(len=20) :: name, ch_err @@ -143,7 +144,7 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& Call psb_info(ictxt, me, np) Allocate(sdid(np,3),rvid(np,3),brvindx(np+1),& - & rvsz(np),sdsz(np),bsdindx(np+1),stat=info) + & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) if (info /= 0) then info=4000 @@ -180,8 +181,7 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& idx = 0 idxs = 0 idxr = 0 - blk%k = a%k - blk%m = 0 + call acoo%allocate(0,a%get_ncols(),info) ! For all rows in the halo descriptor, extract and send/receive. Do proc=idxv(counter) @@ -192,13 +192,11 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& tot_elem = 0 Do j=0,n_el_send-1 idx = idxv(counter+psb_elem_send_+j) - n_elem = psb_sp_get_nnz_row(idx,a) + n_elem = a%get_nz_row(idx) tot_elem = tot_elem+n_elem Enddo sdsz(proc+1) = tot_elem - - blk%m = blk%m + n_el_recv - + call acoo%set_nrows(acoo%get_nrows() + n_el_recv) counter = counter+n_el_send+3 Enddo @@ -228,9 +226,9 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& Enddo iszr=sum(rvsz) - call psb_sp_all(blk,max(iszr,1),info) + call acoo%reallocate(max(iszr,1)) if (debug_level >= psb_debug_outer_)& - & write(debug_unit,*) me,' ',trim(name),': Sizes:',size(blk%ia1),size(blk%ia2),& + & write(debug_unit,*) me,' ',trim(name),': Sizes:',acoo%get_size(),& & ' Send:',sdsz(:),' Receive:',rvsz(:) if (info /= 0) then info=4010 @@ -259,9 +257,8 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& Do j=0,n_el_send-1 idx = idxv(counter+psb_elem_send_+j) - n_elem = psb_sp_get_nnz_row(idx,a) - - call psb_sp_getrow(idx,a,ngtz,iasnd,jasnd,valsnd,info,& + n_elem = a%get_nz_row(idx) + call a%csget(idx,idx,ngtz,iasnd,jasnd,valsnd,info,& & append=.true.,nzin=tot_elem) if (info /= 0) then info=4010 @@ -271,9 +268,7 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& end if tot_elem=tot_elem+n_elem Enddo - ipx = ipx + 1 - counter = counter+n_el_send+3 Enddo nz = tot_elem @@ -289,11 +284,11 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_complex,& - & blk%aspk,rvsz,brvindx,mpi_complex,icomm,info) + & acoo%val,rvsz,brvindx,mpi_complex,icomm,info) call mpi_alltoallv(iasnd,sdsz,bsdindx,mpi_integer,& - & blk%ia1,rvsz,brvindx,mpi_integer,icomm,info) + & acoo%ia,rvsz,brvindx,mpi_integer,icomm,info) call mpi_alltoallv(jasnd,sdsz,bsdindx,mpi_integer,& - & blk%ia2,rvsz,brvindx,mpi_integer,icomm,info) + & acoo%ja,rvsz,brvindx,mpi_integer,icomm,info) if (info /= 0) then info=4010 ch_err='mpi_alltoallv' @@ -304,8 +299,8 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& ! ! Convert into local numbering ! - if (rowcnv_) call psb_glob_to_loc(blk%ia1(1:iszr),desc_a,info,iact='I') - if (colcnv_) call psb_glob_to_loc(blk%ia2(1:iszr),desc_a,info,iact='I') + if (rowcnv_) call psb_glob_to_loc(acoo%ia(1:iszr),desc_a,info,iact='I') + if (colcnv_) call psb_glob_to_loc(acoo%ja(1:iszr),desc_a,info,iact='I') if (info /= 0) then info=4010 @@ -315,21 +310,21 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& end if l1 = 0 - blk%m=0 + call acoo%set_nrows(0) ! irmin = huge(irmin) icmin = huge(icmin) irmax = 0 icmax = 0 Do i=1,iszr - r=(blk%ia1(i)) - k=(blk%ia2(i)) + r=(acoo%ia(i)) + k=(acoo%ja(i)) ! Just in case some of the conversions were out-of-range If ((r>0).and.(k>0)) Then l1=l1+1 - blk%aspk(l1) = blk%aspk(i) - blk%ia1(l1) = r - blk%ia2(l1) = k + acoo%val(l1) = acoo%val(i) + acoo%ia(l1) = r + acoo%ja(l1) = k irmin = min(irmin,r) irmax = max(irmax,r) icmin = min(icmin,k) @@ -337,37 +332,28 @@ Subroutine psb_csphalo(a,desc_a,blk,info,rowcnv,colcnv,& End If Enddo if (rowscale_) then - blk%m = max(irmax-irmin+1,0) - blk%ia1(1:l1) = blk%ia1(1:l1) - irmin + 1 - else - blk%m = irmax + call acoo%set_nrows(max(irmax-irmin+1,0)) + acoo%ia(1:l1) = acoo%ia(1:l1) - irmin + 1 + else + call acoo%set_nrows(irmax) end if if (colscale_) then - blk%k = max(icmax-icmin+1,0) - blk%ia2(1:l1) = blk%ia2(1:l1) - icmin + 1 + call acoo%set_ncols(max(icmax-icmin+1,0)) + acoo%ja(1:l1) = acoo%ja(1:l1) - icmin + 1 else - blk%k = icmax + call acoo%set_ncols(icmax) end if + call acoo%set_nzeros(l1) - blk%fida = 'COO' - blk%infoa(psb_nnz_) = l1 - call psb_ensure_size(1,blk%pl,info) - if (info == 0) call psb_ensure_size(1,blk%pr,info) - if (info /= 0) then - info=4010 - ch_err='psb_ensure_size' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - blk%pl = 0 - blk%pr = 0 if (debug_level >= psb_debug_outer_)& & write(debug_unit,*) me,' ',trim(name),& - & ': End data exchange',counter,l1,blk%m + & ': End data exchange',counter,l1 + + call move_alloc(acoo,blk%a) ! Do we expect any duplicates to appear???? - call psb_spcnv(blk,info,afmt=outfmt_,dupl=psb_dupl_add_) + call blk%cscnv(info,type=outfmt_,dupl=psb_dupl_add_) if (info /= 0) then info=4010 ch_err='psb_spcnv' diff --git a/base/tools/psb_cspins.f90 b/base/tools/psb_cspins.f90 index b5a6c54c..6cc60b03 100644 --- a/base/tools/psb_cspins.f90 +++ b/base/tools/psb_cspins.f90 @@ -42,7 +42,7 @@ ! ia(:) - integer The row indices of the coefficients. ! ja(:) - integer The column indices of the coefficients. ! val(:) - complex The values of the coefficients to be inserted. -! a - type(psb_dspmat_type). The sparse destination matrix. +! a - type(psb_d_sparse_mat). The sparse destination matrix. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Error code ! rebuild - logical Allows to reopen a matrix under @@ -52,7 +52,6 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild) use psb_tools_mod, psb_protect_name => psb_cspins use psb_descriptor_type - use psb_spmat_type use psb_serial_mod use psb_const_mod use psb_error_mod @@ -61,20 +60,19 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild) !....parameters... type(psb_desc_type), intent(inout) :: desc_a - type(psb_cspmat_type), intent(inout) :: a + type(psb_c_sparse_mat), intent(inout) :: a integer, intent(in) :: nz,ia(:),ja(:) complex(psb_spk_), intent(in) :: val(:) integer, intent(out) :: info logical, intent(in), optional :: rebuild !locals..... - integer :: nrow, err_act,mglob,ncol, spstate + integer :: nrow, err_act, ncol, spstate integer :: ictxt,np,me logical, parameter :: debug=.false. integer, parameter :: relocsz=200 logical :: rebuild_ integer, allocatable :: ila(:),jla(:) - character(len=20) :: name, ch_err info = 0 @@ -83,7 +81,6 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild) ictxt = psb_cd_get_context(desc_a) - mglob = psb_cd_get_global_rows(desc_a) call psb_info(ictxt, me, np) @@ -122,7 +119,6 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild) rebuild_ = .false. endif - spstate = a%infoa(psb_state_) if (psb_is_bld_desc(desc_a)) then if (psb_is_large_desc(desc_a)) then @@ -141,8 +137,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild) nrow = psb_cd_get_local_rows(desc_a) ncol = psb_cd_get_local_cols(desc_a) - if (spstate == psb_spmat_bld_) then - call psb_coins(nz,ila,jla,val,a,1,nrow,1,ncol,info) + if (a%is_bld()) then + call a%csput(nz,ila,jla,val,1,nrow,1,ncol,info) if (info /= 0) then info=4010 ch_err='psb_coins' @@ -166,8 +162,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild) nrow = psb_cd_get_local_rows(desc_a) ncol = psb_cd_get_local_cols(desc_a) - if (spstate == psb_spmat_bld_) then - call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,info,gtl=desc_a%idxmap%glob_to_loc) + if (a%is_bld()) then + call a%csput(nz,ia,ja,val,1,nrow,1,ncol,info,gtl=desc_a%idxmap%glob_to_loc) if (info /= 0) then info=4010 ch_err='psb_coins' @@ -181,7 +177,7 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild) end if end if - + else if (psb_is_asb_desc(desc_a)) then if (psb_is_large_desc(desc_a)) then @@ -200,8 +196,7 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild) nrow = psb_cd_get_local_rows(desc_a) ncol = psb_cd_get_local_cols(desc_a) - call psb_coins(nz,ila,jla,val,a,1,nrow,1,ncol,& - & info,rebuild=rebuild_) + call a%csput(nz,ila,jla,val,1,nrow,1,ncol,info) if (info /= 0) then info=4010 ch_err='psb_coins' @@ -212,8 +207,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild) else nrow = psb_cd_get_local_rows(desc_a) ncol = psb_cd_get_local_cols(desc_a) - call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,& - & info,gtl=desc_a%idxmap%glob_to_loc,rebuild=rebuild_) + call a%csput(nz,ia,ja,val,1,nrow,1,ncol,& + & info,gtl=desc_a%idxmap%glob_to_loc) if (info /= 0) then info=4010 ch_err='psb_coins' @@ -244,7 +239,6 @@ end subroutine psb_cspins subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) use psb_tools_mod, psb_protect_name => psb_cspins_2desc use psb_descriptor_type - use psb_spmat_type use psb_serial_mod use psb_const_mod use psb_error_mod @@ -254,7 +248,7 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) !....parameters... type(psb_desc_type), intent(in) :: desc_ar type(psb_desc_type), intent(inout) :: desc_ac - type(psb_cspmat_type), intent(inout) :: a + type(psb_c_sparse_mat), intent(inout) :: a integer, intent(in) :: nz,ia(:),ja(:) complex(psb_spk_), intent(in) :: val(:) integer, intent(out) :: info @@ -310,7 +304,6 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) end if if (nz==0) return - spstate = a%infoa(psb_state_) if (psb_is_bld_desc(desc_ac)) then allocate(ila(nz),jla(nz),stat=info) @@ -334,7 +327,7 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) nrow = psb_cd_get_local_rows(desc_ar) ncol = psb_cd_get_local_cols(desc_ac) - call psb_coins(nz,ila,jla,val,a,1,nrow,1,ncol,info) + call a%csput(nz,ila,jla,val,1,nrow,1,ncol,info) if (info /= 0) then info=4010 ch_err='psb_coins' diff --git a/base/tools/psb_csprn.f90 b/base/tools/psb_csprn.f90 index b671dba1..88af99ba 100644 --- a/base/tools/psb_csprn.f90 +++ b/base/tools/psb_csprn.f90 @@ -36,7 +36,7 @@ ! is in the update state. ! ! Arguments: -! a - type(psb_cspmat_type). The sparse matrix to be reinitiated. +! a - type(psb_c_sparse_mat). The sparse matrix to be reinitiated. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Return code. ! clear - logical, optional Whether the coefficients should be zeroed @@ -45,7 +45,6 @@ Subroutine psb_csprn(a, desc_a,info,clear) use psb_descriptor_type - use psb_spmat_type use psb_serial_mod use psb_const_mod use psb_error_mod @@ -54,7 +53,7 @@ Subroutine psb_csprn(a, desc_a,info,clear) !....Parameters... Type(psb_desc_type), intent(in) :: desc_a - Type(psb_cspmat_type), intent(inout) :: a + Type(psb_c_sparse_mat), intent(inout) :: a integer, intent(out) :: info logical, intent(in), optional :: clear @@ -87,13 +86,8 @@ Subroutine psb_csprn(a, desc_a,info,clear) call psb_errpush(info,name) goto 9999 endif - if (present(clear)) then - clear_ = clear - else - clear_ = .true. - end if - call psb_sp_reinit(a,info,clear=clear_) + call a%reinit(clear=clear) if (info /= 0) goto 9999 if (debug_level >= psb_debug_outer_) & diff --git a/base/tools/psb_dcdbldext.F90 b/base/tools/psb_dcdbldext.F90 index fbab49a2..ae3088ed 100644 --- a/base/tools/psb_dcdbldext.F90 +++ b/base/tools/psb_dcdbldext.F90 @@ -37,7 +37,7 @@ ! specified on input. ! ! Arguments: -! a - type(psb_dspmat_type). The input sparse matrix. +! a - type(psb_d_sparse_mat). The input sparse matrix. ! desc_a - type(psb_desc_type). The input communication descriptor. ! novr - integer. The number of overlap levels. ! desc_ov - type(psb_desc_type). The auxiliary output communication @@ -67,7 +67,6 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) use psb_error_mod use psb_penv_mod use psb_realloc_mod - use psb_mat_mod use psi_mod #ifdef MPI_MOD use mpi diff --git a/base/tools/psb_dins.f90 b/base/tools/psb_dins.f90 index 73c01bfe..2c0dc868 100644 --- a/base/tools/psb_dins.f90 +++ b/base/tools/psb_dins.f90 @@ -49,7 +49,6 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl) !....insert dense submatrix to dense matrix ..... use psb_const_mod use psb_descriptor_type - use psb_spmat_type use psb_error_mod use psb_penv_mod use psi_mod @@ -234,7 +233,6 @@ end subroutine psb_dinsvi subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl) !....insert dense submatrix to dense matrix ..... use psb_descriptor_type - use psb_spmat_type use psb_const_mod use psb_error_mod use psb_penv_mod diff --git a/base/tools/psb_dspalloc.f90 b/base/tools/psb_dspalloc.f90 index 260f38da..67d6698c 100644 --- a/base/tools/psb_dspalloc.f90 +++ b/base/tools/psb_dspalloc.f90 @@ -35,7 +35,7 @@ ! Allocate sparse matrix structure for psblas routines. ! ! Arguments: -! a - type(psb_dspmat_type). The sparse matrix to be allocated. +! a - type(psb_d_sparse_mat). The sparse matrix to be allocated. ! desc_a - type(psb_desc_type). The communication descriptor to be updated. ! info - integer. Return code. ! nnz - integer(optional). The number of nonzeroes in the matrix. @@ -44,10 +44,10 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) use psb_descriptor_type + use psb_serial_mod use psb_const_mod use psb_error_mod use psb_penv_mod - use psb_mat_mod implicit none !....parameters... diff --git a/base/tools/psb_dspasb.f90 b/base/tools/psb_dspasb.f90 index 5e3eb815..7f20a1d0 100644 --- a/base/tools/psb_dspasb.f90 +++ b/base/tools/psb_dspasb.f90 @@ -35,7 +35,7 @@ ! Assemble sparse matrix ! ! Arguments: -! a - type(psb_dspmat_type). The sparse matrix to be allocated. +! a - type(psb_d_sparse_mat). The sparse matrix to be allocated. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. return code. ! afmt - character(optional) The desired output storage format. @@ -50,12 +50,12 @@ ! subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold) use psb_descriptor_type + use psb_serial_mod use psb_const_mod use psi_mod use psb_error_mod use psb_string_mod use psb_penv_mod - use psb_mat_mod implicit none diff --git a/base/tools/psb_dspfree.f90 b/base/tools/psb_dspfree.f90 index 6693745f..174d3358 100644 --- a/base/tools/psb_dspfree.f90 +++ b/base/tools/psb_dspfree.f90 @@ -35,16 +35,16 @@ ! Frees a sparse matrix structure. ! ! Arguments: -! a - type(psb_dspmat_type). The sparse matrix to be freed. +! a - type(psb_d_sparse_mat). The sparse matrix to be freed. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. return code. ! subroutine psb_dspfree(a, desc_a,info) !...free sparse matrix structure... use psb_descriptor_type + use psb_serial_mod use psb_const_mod use psb_error_mod - use psb_mat_mod implicit none !....parameters... diff --git a/base/tools/psb_dsphalo.F90 b/base/tools/psb_dsphalo.F90 index 62282f9d..eb8630a9 100644 --- a/base/tools/psb_dsphalo.F90 +++ b/base/tools/psb_dsphalo.F90 @@ -60,8 +60,7 @@ Subroutine psb_dsphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rowscale,colscale,outfmt,data) use psb_const_mod - use psb_string_mod - use psb_mat_mod + use psb_serial_mod use psb_descriptor_type use psb_realloc_mod use psb_tools_mod, psb_protect_name => psb_dsphalo diff --git a/base/tools/psb_dspins.f90 b/base/tools/psb_dspins.f90 index 5496f780..72b1b9a1 100644 --- a/base/tools/psb_dspins.f90 +++ b/base/tools/psb_dspins.f90 @@ -42,7 +42,7 @@ ! ia(:) - integer The row indices of the coefficients. ! ja(:) - integer The column indices of the coefficients. ! val(:) - real The values of the coefficients to be inserted. -! a - type(psb_dspmat_type). The sparse destination matrix. +! a - type(psb_d_sparse_mat). The sparse destination matrix. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Error code ! rebuild - logical Allows to reopen a matrix under @@ -52,10 +52,10 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) use psb_tools_mod, psb_protect_name => psb_dspins use psb_descriptor_type + use psb_serial_mod use psb_const_mod use psb_error_mod use psb_penv_mod - use psb_mat_mod implicit none !....parameters... @@ -239,10 +239,10 @@ end subroutine psb_dspins subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) use psb_tools_mod, psb_protect_name => psb_dspins_2desc use psb_descriptor_type + use psb_serial_mod use psb_const_mod use psb_error_mod use psb_penv_mod - use psb_mat_mod implicit none !....parameters... diff --git a/base/tools/psb_dsprn.f90 b/base/tools/psb_dsprn.f90 index 817bea6c..817faeee 100644 --- a/base/tools/psb_dsprn.f90 +++ b/base/tools/psb_dsprn.f90 @@ -36,7 +36,7 @@ ! is in the update state. ! ! Arguments: -! a - type(psb_dspmat_type). The sparse matrix to be reinitiated. +! a - type(psb_d_sparse_mat). The sparse matrix to be reinitiated. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Return code. ! clear - logical, optional Whether the coefficients should be zeroed @@ -44,7 +44,6 @@ Subroutine psb_dsprn(a, desc_a,info,clear) use psb_descriptor_type - use psb_mat_mod use psb_serial_mod use psb_const_mod use psb_error_mod @@ -57,7 +56,6 @@ Subroutine psb_dsprn(a, desc_a,info,clear) integer, intent(out) :: info logical, intent(in), optional :: clear - !locals Integer :: ictxt,np,me,err,err_act integer :: debug_level, debug_unit diff --git a/base/tools/psb_iins.f90 b/base/tools/psb_iins.f90 index c05d70ac..bef75f81 100644 --- a/base/tools/psb_iins.f90 +++ b/base/tools/psb_iins.f90 @@ -48,7 +48,6 @@ subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl) !....insert dense submatrix to dense matrix ..... use psb_descriptor_type - use psb_spmat_type use psb_const_mod use psb_error_mod use psb_penv_mod @@ -233,7 +232,6 @@ end subroutine psb_iinsvi subroutine psb_iinsi(m, irw, val, x, desc_a, info, dupl) !....insert dense submatrix to dense matrix ..... use psb_descriptor_type - use psb_spmat_type use psb_const_mod use psb_error_mod use psb_penv_mod diff --git a/base/tools/psb_linmap.f90 b/base/tools/psb_linmap.f90 index e0089859..37b46682 100644 --- a/base/tools/psb_linmap.f90 +++ b/base/tools/psb_linmap.f90 @@ -37,7 +37,7 @@ function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res implicit none type(psb_clinmap_type) :: this type(psb_desc_type), target :: desc_X, desc_Y - type(psb_cspmat_type), intent(in) :: map_X2Y, map_Y2X + type(psb_c_sparse_mat), intent(in) :: map_X2Y, map_Y2X integer, intent(in) :: map_kind integer, intent(in), optional :: iaggr(:), naggr(:) ! @@ -93,8 +93,8 @@ function psb_c_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res info = 1 end select - if (info == 0) call psb_sp_clone(map_X2Y,this%map_X2Y,info) - if (info == 0) call psb_sp_clone(map_Y2X,this%map_Y2X,info) + if (info == 0) call psb_clone(map_X2Y,this%map_X2Y,info) + if (info == 0) call psb_clone(map_Y2X,this%map_Y2X,info) if (info == 0) call psb_realloc(psb_itd_data_size_,this%itd_data,info) if (info == 0) then call psb_set_map_kind(map_kind, this) @@ -274,7 +274,7 @@ function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res implicit none type(psb_zlinmap_type) :: this type(psb_desc_type), target :: desc_X, desc_Y - type(psb_zspmat_type), intent(in) :: map_X2Y, map_Y2X + type(psb_z_sparse_mat), intent(in) :: map_X2Y, map_Y2X integer, intent(in) :: map_kind integer, intent(in), optional :: iaggr(:), naggr(:) ! @@ -331,8 +331,8 @@ function psb_z_linmap(map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr) res info = 1 end select - if (info == 0) call psb_sp_clone(map_X2Y,this%map_X2Y,info) - if (info == 0) call psb_sp_clone(map_Y2X,this%map_Y2X,info) + if (info == 0) call psb_clone(map_X2Y,this%map_X2Y,info) + if (info == 0) call psb_clone(map_Y2X,this%map_Y2X,info) if (info == 0) call psb_realloc(psb_itd_data_size_,this%itd_data,info) if (info == 0) then call psb_set_map_kind(map_kind, this) diff --git a/base/tools/psb_scdbldext.F90 b/base/tools/psb_scdbldext.F90 index 2075d154..5e4bb685 100644 --- a/base/tools/psb_scdbldext.F90 +++ b/base/tools/psb_scdbldext.F90 @@ -67,7 +67,6 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) use psb_error_mod use psb_penv_mod use psb_realloc_mod - use psb_mat_mod use psi_mod #ifdef MPI_MOD use mpi diff --git a/base/tools/psb_sins.f90 b/base/tools/psb_sins.f90 index 5b7c354a..6d368094 100644 --- a/base/tools/psb_sins.f90 +++ b/base/tools/psb_sins.f90 @@ -49,7 +49,6 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl) !....insert dense submatrix to dense matrix ..... use psb_const_mod use psb_descriptor_type - use psb_spmat_type use psb_error_mod use psb_penv_mod use psi_mod @@ -234,7 +233,6 @@ end subroutine psb_sinsvi subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl) !....insert dense submatrix to dense matrix ..... use psb_descriptor_type - use psb_spmat_type use psb_const_mod use psb_error_mod use psb_penv_mod diff --git a/base/tools/psb_sspalloc.f90 b/base/tools/psb_sspalloc.f90 index e21dc1da..b15833c6 100644 --- a/base/tools/psb_sspalloc.f90 +++ b/base/tools/psb_sspalloc.f90 @@ -35,7 +35,7 @@ ! Allocate sparse matrix structure for psblas routines. ! ! Arguments: -! a - type(psb_sspmat_type). The sparse matrix to be allocated. +! a - type(psb_s_sparse_mat). The sparse matrix to be allocated. ! desc_a - type(psb_desc_type). The communication descriptor to be updated. ! info - integer. Return code. ! nnz - integer(optional). The number of nonzeroes in the matrix. @@ -44,10 +44,10 @@ subroutine psb_sspalloc(a, desc_a, info, nnz) use psb_descriptor_type + use psb_serial_mod use psb_const_mod use psb_error_mod use psb_penv_mod - use psb_mat_mod implicit none !....parameters... diff --git a/base/tools/psb_sspasb.f90 b/base/tools/psb_sspasb.f90 index 04ca8c00..e7939629 100644 --- a/base/tools/psb_sspasb.f90 +++ b/base/tools/psb_sspasb.f90 @@ -35,7 +35,7 @@ ! Assemble sparse matrix ! ! Arguments: -! a - type(psb_sspmat_type). The sparse matrix to be allocated. +! a - type(psb_s_sparse_mat). The sparse matrix to be allocated. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. return code. ! afmt - character(optional) The desired output storage format. @@ -50,12 +50,12 @@ ! subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold) use psb_descriptor_type + use psb_serial_mod use psb_const_mod use psi_mod use psb_error_mod use psb_string_mod use psb_penv_mod - use psb_mat_mod implicit none diff --git a/base/tools/psb_sspfree.f90 b/base/tools/psb_sspfree.f90 index 0b2512b4..9fc8066e 100644 --- a/base/tools/psb_sspfree.f90 +++ b/base/tools/psb_sspfree.f90 @@ -42,9 +42,9 @@ subroutine psb_sspfree(a, desc_a,info) !...free sparse matrix structure... use psb_descriptor_type + use psb_serial_mod use psb_const_mod use psb_error_mod - use psb_mat_mod implicit none !....parameters... diff --git a/base/tools/psb_ssphalo.F90 b/base/tools/psb_ssphalo.F90 index aaf3a189..ed2fddaf 100644 --- a/base/tools/psb_ssphalo.F90 +++ b/base/tools/psb_ssphalo.F90 @@ -60,8 +60,7 @@ Subroutine psb_ssphalo(a,desc_a,blk,info,rowcnv,colcnv,& & rowscale,colscale,outfmt,data) use psb_const_mod - use psb_string_mod - use psb_mat_mod + use psb_serial_mod use psb_descriptor_type use psb_realloc_mod use psb_tools_mod, psb_protect_name => psb_ssphalo diff --git a/base/tools/psb_sspins.f90 b/base/tools/psb_sspins.f90 index 0041b89b..f5f73694 100644 --- a/base/tools/psb_sspins.f90 +++ b/base/tools/psb_sspins.f90 @@ -42,7 +42,7 @@ ! ia(:) - integer The row indices of the coefficients. ! ja(:) - integer The column indices of the coefficients. ! val(:) - real The values of the coefficients to be inserted. -! a - type(psb_sspmat_type). The sparse destination matrix. +! a - type(psb_s_sparse_mat). The sparse destination matrix. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Error code ! rebuild - logical Allows to reopen a matrix under @@ -52,10 +52,10 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild) use psb_tools_mod, psb_protect_name => psb_sspins use psb_descriptor_type + use psb_serial_mod use psb_const_mod use psb_error_mod use psb_penv_mod - use psb_mat_mod implicit none !....parameters... @@ -239,10 +239,10 @@ end subroutine psb_sspins subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) use psb_tools_mod, psb_protect_name => psb_sspins_2desc use psb_descriptor_type + use psb_serial_mod use psb_const_mod use psb_error_mod use psb_penv_mod - use psb_mat_mod implicit none !....parameters... diff --git a/base/tools/psb_ssprn.f90 b/base/tools/psb_ssprn.f90 index cfffae94..dcc9ef0e 100644 --- a/base/tools/psb_ssprn.f90 +++ b/base/tools/psb_ssprn.f90 @@ -36,7 +36,7 @@ ! is in the update state. ! ! Arguments: -! a - type(psb_sspmat_type). The sparse matrix to be reinitiated. +! a - type(psb_s_sparse_mat). The sparse matrix to be reinitiated. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Return code. ! clear - logical, optional Whether the coefficients should be zeroed @@ -44,7 +44,6 @@ Subroutine psb_ssprn(a, desc_a,info,clear) use psb_descriptor_type - use psb_mat_mod use psb_serial_mod use psb_const_mod use psb_error_mod @@ -57,7 +56,6 @@ Subroutine psb_ssprn(a, desc_a,info,clear) integer, intent(out) :: info logical, intent(in), optional :: clear - !locals Integer :: ictxt,np,me,err,err_act integer :: debug_level, debug_unit diff --git a/base/tools/psb_zcdbldext.F90 b/base/tools/psb_zcdbldext.F90 index fb1f3a6c..76fe588d 100644 --- a/base/tools/psb_zcdbldext.F90 +++ b/base/tools/psb_zcdbldext.F90 @@ -37,7 +37,7 @@ ! specified on input. ! ! Arguments: -! a - type(psb_zspmat_type). The input sparse matrix. +! a - type(psb_z_sparse_mat). The input sparse matrix. ! desc_a - type(psb_desc_type). The input communication descriptor. ! novr - integer. The number of overlap levels. ! desc_ov - type(psb_desc_type). The auxiliary output communication @@ -78,23 +78,23 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) ! .. Array Arguments .. integer, intent(in) :: novr - Type(psb_zspmat_type), Intent(in) :: a + Type(psb_z_sparse_mat), Intent(in) :: a Type(psb_desc_type), Intent(in), target :: desc_a Type(psb_desc_type), Intent(out) :: desc_ov integer, intent(out) :: info integer, intent(in),optional :: extype ! .. Local Scalars .. - Integer :: i, j, np, me,m,nnzero,& + Integer :: i, j, np, me,m,& & ictxt, lovr, lworks,lworkr, n_row,n_col, int_err(5),& & index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo Integer :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,& & n_elem_send,tot_recv,tot_elem,cntov_o,& & counter_t,n_elem,i_ovr,jj,proc_id,isz, & & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ - integer icomm, err_act + integer :: icomm, err_act - type(psb_zspmat_type) :: blk + integer, allocatable :: irow(:), icol(:) Integer, allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) Integer,allocatable :: halo(:),works(:),workr(:),t_halo_in(:),& & t_halo_out(:),temp(:),maskr(:) @@ -122,7 +122,6 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) extype_ = psb_ovt_xhal_ endif m = psb_cd_get_local_rows(desc_a) - nnzero = Size(a%aspk) n_row = psb_cd_get_local_rows(desc_a) n_col = psb_cd_get_local_cols(desc_a) nhalo = n_col-m @@ -169,7 +168,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) ! LOVR= (NNZ/NROW)*N_HALO*NOVR This assumes that the local average ! nonzeros per row is the same as the global. ! - nztot = psb_sp_get_nnzeros(a) + nztot = a%get_nzeros() if (nztot>0) then lovr = ((nztot+m-1)/m)*nhalo*novr lworks = ((nztot+m-1)/m)*nhalo @@ -210,16 +209,6 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) goto 9999 end if - call psb_sp_all(blk,max(lworks,lworkr),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 - - blk%fida='COO' - Allocate(orig_ovr(l_tmp_ovr_idx),tmp_ovr_idx(l_tmp_ovr_idx),& & tmp_halo(l_tmp_halo), halo(size(desc_a%halo_index)),stat=info) if (info /= 0) then @@ -340,7 +329,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) ! add recv elements in halo_index into ovrlap_index ! Do j=0,n_elem_recv-1 - If ((counter+psb_elem_recv_+j)>Size(halo)) then + If((counter+psb_elem_recv_+j)>Size(halo)) then info=-2 call psb_errpush(info,name) goto 9999 @@ -414,35 +403,20 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) ! Prepare to exchange the halo rows with the other proc. ! If (i_ovr <= (novr)) Then - n_elem = psb_sp_get_nnz_row(idx,a) - call psb_ensure_size((idxs+tot_elem+n_elem),works,info) + call a%csget(idx,idx,n_elem,irow,icol,info) if (info /= 0) then info=4010 - call psb_errpush(info,name,a_err='psb_ensure_size') + call psb_errpush(info,name,a_err='csget') goto 9999 end if - - If((n_elem) > size(blk%ia2)) Then - isz = max((3*size(blk%ia2))/2,(n_elem)) - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,'Realloc blk',isz - call psb_sp_reall(blk,isz,info) - if (info /= 0) then - info=4010 - ch_err='psb_sp_reall' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - End If - - call psb_sp_getblk(idx,a,blk,info) + + call psb_ensure_size((idxs+tot_elem+n_elem),works,info) if (info /= 0) then info=4010 - ch_err='psb_sp_getblk' - call psb_errpush(info,name,a_err=ch_err) + call psb_errpush(info,name,a_err='psb_ensure_size') goto 9999 end if - call psb_map_l2g(blk%ia2(1:n_elem),& + call psb_map_l2g(icol(1:n_elem),& & works(idxs+tot_elem+1:idxs+tot_elem+n_elem),& & desc_ov%idxmap,info) tot_elem=tot_elem+n_elem @@ -734,15 +708,21 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) end if call psb_icdasb(desc_ov,info,ext_hv=.true.) - - call psb_cd_set_ovl_asb(desc_ov,info) - - if (info == 0) call psb_sp_free(blk,info) if (info /= 0) then - ch_err='sp_free' - call psb_errpush(4013,name,a_err=ch_err,i_err=(/info,0,0,0,0/)) + call psb_errpush(4010,name,a_err='icdasdb') goto 9999 end if + + call psb_cd_set_ovl_asb(desc_ov,info) + + if (info == 0) then + if (allocated(irow)) deallocate(irow,stat=info) + if ((info ==0).and.allocated(icol)) deallocate(icol,stat=info) + if (info /= 0) then + call psb_errpush(4013,name,a_err='deallocate',i_err=(/info,0,0,0,0/)) + goto 9999 + end if + end if if (debug_level >= psb_debug_outer_) & & write(debug_unit,*) me,' ',trim(name),': end' diff --git a/base/tools/psb_zins.f90 b/base/tools/psb_zins.f90 index 55d49714..2de07bcb 100644 --- a/base/tools/psb_zins.f90 +++ b/base/tools/psb_zins.f90 @@ -48,7 +48,6 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl) !....insert dense submatrix to dense matrix ..... use psb_descriptor_type - use psb_spmat_type use psb_const_mod use psb_error_mod use psb_penv_mod @@ -234,7 +233,6 @@ end subroutine psb_zinsvi subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl) !....insert dense submatrix to dense matrix ..... use psb_descriptor_type - use psb_spmat_type use psb_const_mod use psb_error_mod use psb_penv_mod diff --git a/base/tools/psb_zspalloc.f90 b/base/tools/psb_zspalloc.f90 index 38478f8a..dac44d85 100644 --- a/base/tools/psb_zspalloc.f90 +++ b/base/tools/psb_zspalloc.f90 @@ -35,7 +35,7 @@ ! Allocate sparse matrix structure for psblas routines. ! ! Arguments: -! a - type(psb_zspmat_type). The sparse matrix to be allocated. +! a - type(psb_z_sparse_mat). The sparse matrix to be allocated. ! desc_a - type(psb_desc_type). The communication descriptor to be updated. ! info - integer. Return code. ! nnz - integer(optional). The number of nonzeroes in the matrix. @@ -44,7 +44,6 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) use psb_descriptor_type - use psb_spmat_type use psb_serial_mod use psb_const_mod use psb_error_mod @@ -53,7 +52,7 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) !....parameters... type(psb_desc_type), intent(inout) :: desc_a - type(psb_zspmat_type), intent(out) :: a + type(psb_z_sparse_mat), intent(out) :: a integer, intent(out) :: info integer, optional, intent(in) :: nnz @@ -108,7 +107,7 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) & write(debug_unit,*) me,' ',trim(name),':allocating size:',length_ia1 !....allocate aspk, ia1, ia2..... - call psb_sp_all(loc_row,loc_col,a,length_ia1,info) + call a%csall(loc_row,loc_col,info,nz=length_ia1) if(info /= 0) then info=4010 ch_err='sp_all' diff --git a/base/tools/psb_zspasb.f90 b/base/tools/psb_zspasb.f90 index a66ba3ae..98dd84f2 100644 --- a/base/tools/psb_zspasb.f90 +++ b/base/tools/psb_zspasb.f90 @@ -35,7 +35,7 @@ ! Assemble sparse matrix ! ! Arguments: -! a - type(psb_zspmat_type). The sparse matrix to be assembled +! a - type(psb_z_sparse_mat). The sparse matrix to be assembled ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. return code. ! afmt - character(optional) The desired output storage format. @@ -48,10 +48,8 @@ ! psb_dupl_err_ raise an error. ! ! -subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl) - +subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold) use psb_descriptor_type - use psb_spmat_type use psb_serial_mod use psb_const_mod use psi_mod @@ -62,11 +60,12 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl) !...Parameters.... - type(psb_zspmat_type), intent (inout) :: a + type(psb_z_sparse_mat), intent (inout) :: a type(psb_desc_type), intent(in) :: desc_a integer, intent(out) :: info integer,optional, intent(in) :: dupl, upd character(len=*), optional, intent(in) :: afmt + class(psb_z_base_sparse_mat), intent(in), optional :: mold !....Locals.... integer :: int_err(5) integer :: np,me,n_col, err_act @@ -107,23 +106,27 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl) !check on errors encountered in psdspins - spstate = a%infoa(psb_state_) - if (spstate == psb_spmat_bld_) then + + if (a%is_bld()) then ! ! First case: we come from a fresh build. ! n_row = psb_cd_get_local_rows(desc_a) n_col = psb_cd_get_local_cols(desc_a) - a%m = n_row - a%k = n_col + call a%set_nrows(n_row) + call a%set_ncols(n_col) end if - call psb_spcnv(a,info,afmt=afmt,upd=upd,dupl=dupl) + call a%cscnv(info,type=afmt,dupl=dupl, mold=mold) - IF (debug_level >= psb_debug_ext_)& - & write(debug_unit, *) me,' ',trim(name),': From SPCNV',& - & info,' ',A%FIDA + + IF (debug_level >= psb_debug_ext_) then + ch_err=a%get_fmt() + write(debug_unit, *) me,' ',trim(name),': From SPCNV',& + & info,' ',ch_err + end IF + if (info /= psb_no_err_) then info=4010 ch_err='psb_spcnv' diff --git a/base/tools/psb_zspfree.f90 b/base/tools/psb_zspfree.f90 index 0bd7df48..8dd7a880 100644 --- a/base/tools/psb_zspfree.f90 +++ b/base/tools/psb_zspfree.f90 @@ -35,14 +35,13 @@ ! Frees a sparse matrix structure. ! ! Arguments: -! a - type(psb_zspmat_type). The sparse matrix to be freed. +! a - type(psb_z_sparse_mat). The sparse matrix to be freed. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. return code. ! subroutine psb_zspfree(a, desc_a,info) !...free sparse matrix structure... use psb_descriptor_type - use psb_spmat_type use psb_serial_mod use psb_const_mod use psb_error_mod @@ -50,7 +49,7 @@ subroutine psb_zspfree(a, desc_a,info) !....parameters... type(psb_desc_type), intent(in) :: desc_a - type(psb_zspmat_type), intent(inout) :: a + type(psb_z_sparse_mat), intent(inout) :: a integer, intent(out) :: info !...locals.... integer :: ictxt, err_act @@ -70,14 +69,7 @@ subroutine psb_zspfree(a, desc_a,info) end if !...deallocate a.... - call psb_sp_free(a,info) - - - if(info /= 0) then - info=2045 - call psb_errpush(info,name) - goto 9999 - end if + call a%free() call psb_erractionrestore(err_act) return diff --git a/base/tools/psb_zsphalo.F90 b/base/tools/psb_zsphalo.F90 index 58d67acf..cf778c74 100644 --- a/base/tools/psb_zsphalo.F90 +++ b/base/tools/psb_zsphalo.F90 @@ -38,9 +38,9 @@ ! ! ! Arguments: -! a - type(psb_zspmat_type) The local part of input matrix A +! a - type(psb_z_sparse_mat) The local part of input matrix A ! desc_a - type(psb_desc_type). The communication descriptor. -! blck - type(psb_zspmat_type) The local part of output matrix BLCK +! blck - type(psb_z_sparse_mat) The local part of output matrix BLCK ! info - integer. Return code ! rowcnv - logical Should row/col indices be converted ! colcnv - logical to/from global numbering when sent/received? @@ -73,8 +73,8 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& include 'mpif.h' #endif - Type(psb_zspmat_type),Intent(in) :: a - Type(psb_zspmat_type),Intent(inout) :: blk + Type(psb_z_sparse_mat),Intent(in) :: a + Type(psb_z_sparse_mat),Intent(inout) :: blk Type(psb_desc_type),Intent(in), target :: desc_a integer, intent(out) :: info logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale @@ -89,8 +89,9 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& Integer, allocatable :: sdid(:,:), brvindx(:),rvid(:,:), & & rvsz(:), bsdindx(:),sdsz(:), iasnd(:), jasnd(:) complex(psb_dpk_), allocatable :: valsnd(:) - integer, pointer :: idxv(:) - logical :: rowcnv_,colcnv_,rowscale_,colscale_ + type(psb_z_coo_sparse_mat), allocatable :: acoo + integer, pointer :: idxv(:) + logical :: rowcnv_,colcnv_,rowscale_,colscale_ character(len=5) :: outfmt_ integer :: debug_level, debug_unit character(len=20) :: name, ch_err @@ -143,7 +144,7 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& Call psb_info(ictxt, me, np) Allocate(sdid(np,3),rvid(np,3),brvindx(np+1),& - & rvsz(np),sdsz(np),bsdindx(np+1),stat=info) + & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) if (info /= 0) then info=4000 @@ -180,8 +181,7 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& idx = 0 idxs = 0 idxr = 0 - blk%k = a%k - blk%m = 0 + call acoo%allocate(0,a%get_ncols(),info) ! For all rows in the halo descriptor, extract and send/receive. Do proc=idxv(counter) @@ -192,13 +192,11 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& tot_elem = 0 Do j=0,n_el_send-1 idx = idxv(counter+psb_elem_send_+j) - n_elem = psb_sp_get_nnz_row(idx,a) + n_elem = a%get_nz_row(idx) tot_elem = tot_elem+n_elem Enddo sdsz(proc+1) = tot_elem - - blk%m = blk%m + n_el_recv - + call acoo%set_nrows(acoo%get_nrows() + n_el_recv) counter = counter+n_el_send+3 Enddo @@ -228,9 +226,9 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& Enddo iszr=sum(rvsz) - call psb_sp_all(blk,max(iszr,1),info) + call acoo%reallocate(max(iszr,1)) if (debug_level >= psb_debug_outer_)& - & write(debug_unit,*) me,' ',trim(name),': Sizes:',size(blk%ia1),size(blk%ia2),& + & write(debug_unit,*) me,' ',trim(name),': Sizes:',acoo%get_size(),& & ' Send:',sdsz(:),' Receive:',rvsz(:) if (info /= 0) then info=4010 @@ -259,9 +257,8 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& Do j=0,n_el_send-1 idx = idxv(counter+psb_elem_send_+j) - n_elem = psb_sp_get_nnz_row(idx,a) - - call psb_sp_getrow(idx,a,ngtz,iasnd,jasnd,valsnd,info,& + n_elem = a%get_nz_row(idx) + call a%csget(idx,idx,ngtz,iasnd,jasnd,valsnd,info,& & append=.true.,nzin=tot_elem) if (info /= 0) then info=4010 @@ -271,9 +268,7 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& end if tot_elem=tot_elem+n_elem Enddo - ipx = ipx + 1 - counter = counter+n_el_send+3 Enddo nz = tot_elem @@ -289,11 +284,11 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& call mpi_alltoallv(valsnd,sdsz,bsdindx,mpi_double_complex,& - & blk%aspk,rvsz,brvindx,mpi_double_complex,icomm,info) + & acoo%val,rvsz,brvindx,mpi_double_complex,icomm,info) call mpi_alltoallv(iasnd,sdsz,bsdindx,mpi_integer,& - & blk%ia1,rvsz,brvindx,mpi_integer,icomm,info) + & acoo%ia,rvsz,brvindx,mpi_integer,icomm,info) call mpi_alltoallv(jasnd,sdsz,bsdindx,mpi_integer,& - & blk%ia2,rvsz,brvindx,mpi_integer,icomm,info) + & acoo%ja,rvsz,brvindx,mpi_integer,icomm,info) if (info /= 0) then info=4010 ch_err='mpi_alltoallv' @@ -304,8 +299,8 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& ! ! Convert into local numbering ! - if (rowcnv_) call psb_glob_to_loc(blk%ia1(1:iszr),desc_a,info,iact='I') - if (colcnv_) call psb_glob_to_loc(blk%ia2(1:iszr),desc_a,info,iact='I') + if (rowcnv_) call psb_glob_to_loc(acoo%ia(1:iszr),desc_a,info,iact='I') + if (colcnv_) call psb_glob_to_loc(acoo%ja(1:iszr),desc_a,info,iact='I') if (info /= 0) then info=4010 @@ -315,21 +310,21 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& end if l1 = 0 - blk%m=0 + call acoo%set_nrows(0) ! irmin = huge(irmin) icmin = huge(icmin) irmax = 0 icmax = 0 Do i=1,iszr - r=(blk%ia1(i)) - k=(blk%ia2(i)) + r=(acoo%ia(i)) + k=(acoo%ja(i)) ! Just in case some of the conversions were out-of-range If ((r>0).and.(k>0)) Then l1=l1+1 - blk%aspk(l1) = blk%aspk(i) - blk%ia1(l1) = r - blk%ia2(l1) = k + acoo%val(l1) = acoo%val(i) + acoo%ia(l1) = r + acoo%ja(l1) = k irmin = min(irmin,r) irmax = max(irmax,r) icmin = min(icmin,k) @@ -337,37 +332,28 @@ Subroutine psb_zsphalo(a,desc_a,blk,info,rowcnv,colcnv,& End If Enddo if (rowscale_) then - blk%m = max(irmax-irmin+1,0) - blk%ia1(1:l1) = blk%ia1(1:l1) - irmin + 1 - else - blk%m = irmax + call acoo%set_nrows(max(irmax-irmin+1,0)) + acoo%ia(1:l1) = acoo%ia(1:l1) - irmin + 1 + else + call acoo%set_nrows(irmax) end if if (colscale_) then - blk%k = max(icmax-icmin+1,0) - blk%ia2(1:l1) = blk%ia2(1:l1) - icmin + 1 + call acoo%set_ncols(max(icmax-icmin+1,0)) + acoo%ja(1:l1) = acoo%ja(1:l1) - icmin + 1 else - blk%k = icmax + call acoo%set_ncols(icmax) end if + call acoo%set_nzeros(l1) - blk%fida = 'COO' - blk%infoa(psb_nnz_) = l1 - call psb_ensure_size(1,blk%pl,info) - if (info == 0) call psb_ensure_size(1,blk%pr,info) - if (info /= 0) then - info=4010 - ch_err='psb_ensure_size' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - blk%pl = 0 - blk%pr = 0 if (debug_level >= psb_debug_outer_)& & write(debug_unit,*) me,' ',trim(name),& - & ': End data exchange',counter,l1,blk%m + & ': End data exchange',counter,l1 + + call move_alloc(acoo,blk%a) ! Do we expect any duplicates to appear???? - call psb_spcnv(blk,info,afmt=outfmt_,dupl=psb_dupl_add_) + call blk%cscnv(info,type=outfmt_,dupl=psb_dupl_add_) if (info /= 0) then info=4010 ch_err='psb_spcnv' diff --git a/base/tools/psb_zspins.f90 b/base/tools/psb_zspins.f90 index 00994cf7..202280a5 100644 --- a/base/tools/psb_zspins.f90 +++ b/base/tools/psb_zspins.f90 @@ -42,7 +42,7 @@ ! ia(:) - integer The row indices of the coefficients. ! ja(:) - integer The column indices of the coefficients. ! val(:) - complex The values of the coefficients to be inserted. -! a - type(psb_dspmat_type). The sparse destination matrix. +! a - type(psb_d_sparse_mat). The sparse destination matrix. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Error code ! rebuild - logical Allows to reopen a matrix under @@ -52,7 +52,6 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) use psb_tools_mod, psb_protect_name => psb_zspins use psb_descriptor_type - use psb_spmat_type use psb_serial_mod use psb_const_mod use psb_error_mod @@ -61,20 +60,19 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) !....parameters... type(psb_desc_type), intent(inout) :: desc_a - type(psb_zspmat_type), intent(inout) :: a + type(psb_z_sparse_mat), intent(inout) :: a integer, intent(in) :: nz,ia(:),ja(:) complex(psb_dpk_), intent(in) :: val(:) integer, intent(out) :: info logical, intent(in), optional :: rebuild !locals..... - integer :: nrow, err_act,mglob,ncol, spstate + integer :: nrow, err_act, ncol, spstate integer :: ictxt,np,me logical, parameter :: debug=.false. integer, parameter :: relocsz=200 logical :: rebuild_ integer, allocatable :: ila(:),jla(:) - character(len=20) :: name, ch_err info = 0 @@ -83,7 +81,6 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) ictxt = psb_cd_get_context(desc_a) - mglob = psb_cd_get_global_rows(desc_a) call psb_info(ictxt, me, np) @@ -122,7 +119,6 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) rebuild_ = .false. endif - spstate = a%infoa(psb_state_) if (psb_is_bld_desc(desc_a)) then if (psb_is_large_desc(desc_a)) then @@ -141,8 +137,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) nrow = psb_cd_get_local_rows(desc_a) ncol = psb_cd_get_local_cols(desc_a) - if (spstate == psb_spmat_bld_) then - call psb_coins(nz,ila,jla,val,a,1,nrow,1,ncol,info) + if (a%is_bld()) then + call a%csput(nz,ila,jla,val,1,nrow,1,ncol,info) if (info /= 0) then info=4010 ch_err='psb_coins' @@ -166,8 +162,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) nrow = psb_cd_get_local_rows(desc_a) ncol = psb_cd_get_local_cols(desc_a) - if (spstate == psb_spmat_bld_) then - call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,info,gtl=desc_a%idxmap%glob_to_loc) + if (a%is_bld()) then + call a%csput(nz,ia,ja,val,1,nrow,1,ncol,info,gtl=desc_a%idxmap%glob_to_loc) if (info /= 0) then info=4010 ch_err='psb_coins' @@ -200,8 +196,7 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) nrow = psb_cd_get_local_rows(desc_a) ncol = psb_cd_get_local_cols(desc_a) - call psb_coins(nz,ila,jla,val,a,1,nrow,1,ncol,& - & info,rebuild=rebuild_) + call a%csput(nz,ila,jla,val,1,nrow,1,ncol,info) if (info /= 0) then info=4010 ch_err='psb_coins' @@ -212,8 +207,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) else nrow = psb_cd_get_local_rows(desc_a) ncol = psb_cd_get_local_cols(desc_a) - call psb_coins(nz,ia,ja,val,a,1,nrow,1,ncol,& - & info,gtl=desc_a%idxmap%glob_to_loc,rebuild=rebuild_) + call a%csput(nz,ia,ja,val,1,nrow,1,ncol,& + & info,gtl=desc_a%idxmap%glob_to_loc) if (info /= 0) then info=4010 ch_err='psb_coins' @@ -244,7 +239,6 @@ end subroutine psb_zspins subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) use psb_tools_mod, psb_protect_name => psb_zspins_2desc use psb_descriptor_type - use psb_spmat_type use psb_serial_mod use psb_const_mod use psb_error_mod @@ -254,7 +248,7 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) !....parameters... type(psb_desc_type), intent(in) :: desc_ar type(psb_desc_type), intent(inout) :: desc_ac - type(psb_zspmat_type), intent(inout) :: a + type(psb_z_sparse_mat), intent(inout) :: a integer, intent(in) :: nz,ia(:),ja(:) complex(psb_dpk_), intent(in) :: val(:) integer, intent(out) :: info @@ -310,7 +304,6 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) end if if (nz==0) return - spstate = a%infoa(psb_state_) if (psb_is_bld_desc(desc_ac)) then allocate(ila(nz),jla(nz),stat=info) @@ -334,7 +327,7 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) nrow = psb_cd_get_local_rows(desc_ar) ncol = psb_cd_get_local_cols(desc_ac) - call psb_coins(nz,ila,jla,val,a,1,nrow,1,ncol,info) + call a%csput(nz,ila,jla,val,1,nrow,1,ncol,info) if (info /= 0) then info=4010 ch_err='psb_coins' diff --git a/base/tools/psb_zsprn.f90 b/base/tools/psb_zsprn.f90 index b987f795..71be7e25 100644 --- a/base/tools/psb_zsprn.f90 +++ b/base/tools/psb_zsprn.f90 @@ -36,7 +36,7 @@ ! is in the update state. ! ! Arguments: -! a - type(psb_zspmat_type). The sparse matrix to be reinitiated. +! a - type(psb_z_sparse_mat). The sparse matrix to be reinitiated. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. Return code. ! clear - logical, optional Whether the coefficients should be zeroed @@ -45,7 +45,6 @@ Subroutine psb_zsprn(a, desc_a,info,clear) use psb_descriptor_type - use psb_spmat_type use psb_serial_mod use psb_const_mod use psb_error_mod @@ -54,7 +53,7 @@ Subroutine psb_zsprn(a, desc_a,info,clear) !....Parameters... Type(psb_desc_type), intent(in) :: desc_a - Type(psb_zspmat_type), intent(inout) :: a + Type(psb_z_sparse_mat), intent(inout) :: a integer, intent(out) :: info logical, intent(in), optional :: clear @@ -87,13 +86,8 @@ Subroutine psb_zsprn(a, desc_a,info,clear) call psb_errpush(info,name) goto 9999 endif - if (present(clear)) then - clear_ = clear - else - clear_ = .true. - end if - call psb_sp_reinit(a,info,clear=clear_) + call a%reinit(clear=clear) if (info /= 0) goto 9999 if (debug_level >= psb_debug_outer_) & diff --git a/krylov/psb_cbicg.f90 b/krylov/psb_cbicg.f90 index d7feb76d..ef8c2a73 100644 --- a/krylov/psb_cbicg.f90 +++ b/krylov/psb_cbicg.f90 @@ -62,8 +62,8 @@ ! ! Arguments: ! -! a - type(psb_cspmat_type) Input: sparse matrix containing A. -! prec - type(psb_cprec_type) Input: preconditioner +! a - type(psb_c_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_cprec_type) Input: preconditioner ! b(:) - complex Input: vector containing the ! right hand side B ! x(:) - complex Input/Output: vector containing the @@ -100,8 +100,8 @@ subroutine psb_cbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) implicit none !!$ parameters - type(psb_cspmat_type), intent(in) :: a - type(psb_cprec_type), intent(in) :: prec + type(psb_c_sparse_mat), intent(in) :: a + class(psb_cprec_type), intent(in) :: prec type(psb_desc_type), intent(in) :: desc_a complex(psb_spk_), intent(in) :: b(:) complex(psb_spk_), intent(inout) :: x(:) diff --git a/krylov/psb_ccg.f90 b/krylov/psb_ccg.f90 index a9a35098..25476b97 100644 --- a/krylov/psb_ccg.f90 +++ b/krylov/psb_ccg.f90 @@ -63,8 +63,8 @@ ! ! Arguments: ! -! a - type(psb_cspmat_type) Input: sparse matrix containing A. -! prec - type(psb_cprec_type) Input: preconditioner +! a - type(psb_c_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_cprec_type) Input: preconditioner ! b(:) - complex Input: vector containing the ! right hand side B ! x(:) - complex Input/Output: vector containing the @@ -102,8 +102,8 @@ subroutine psb_ccg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) implicit none !!$ Parameters - Type(psb_cspmat_type), Intent(in) :: a - Type(psb_cprec_type), Intent(in) :: prec + Type(psb_c_sparse_mat), Intent(in) :: a + class(psb_cprec_type), Intent(in) :: prec Type(psb_desc_type), Intent(in) :: desc_a complex(psb_spk_), Intent(in) :: b(:) complex(psb_spk_), Intent(inout) :: x(:) diff --git a/krylov/psb_ccgs.f90 b/krylov/psb_ccgs.f90 index 07f96c59..287faefd 100644 --- a/krylov/psb_ccgs.f90 +++ b/krylov/psb_ccgs.f90 @@ -61,8 +61,8 @@ ! ! Arguments: ! -! a - type(psb_cspmat_type) Input: sparse matrix containing A. -! prec - type(psb_cprec_type) Input: preconditioner +! a - type(psb_c_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_cprec_type) Input: preconditioner ! b - complex,dimension(:) Input: vector containing the ! right hand side B ! x - complex,dimension(:) Input/Output: vector containing the @@ -99,9 +99,9 @@ Subroutine psb_ccgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) implicit none !!$ parameters - Type(psb_cspmat_type), Intent(in) :: a + Type(psb_c_sparse_mat), Intent(in) :: a Type(psb_desc_type), Intent(in) :: desc_a - Type(psb_cprec_type), Intent(in) :: prec + class(psb_cprec_type), Intent(in) :: prec Complex(psb_spk_), Intent(in) :: b(:) Complex(psb_spk_), Intent(inout) :: x(:) Real(psb_spk_), Intent(in) :: eps diff --git a/krylov/psb_ccgstab.f90 b/krylov/psb_ccgstab.f90 index f6b02a21..ddd6a1b2 100644 --- a/krylov/psb_ccgstab.f90 +++ b/krylov/psb_ccgstab.f90 @@ -62,8 +62,8 @@ ! ! Arguments: ! -! a - type(psb_cspmat_type) Input: sparse matrix containing A. -! prec - type(psb_cprec_type) Input: preconditioner +! a - type(psb_c_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_cprec_type) Input: preconditioner ! b - complex,dimension(:) Input: vector containing the ! right hand side B ! x - complex,dimension(:) Input/Output: vector containing the @@ -99,8 +99,8 @@ subroutine psb_ccgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) use psb_krylov_mod, psb_protect_name => psb_ccgstab Implicit None !!$ parameters - Type(psb_cspmat_type), Intent(in) :: a - Type(psb_cprec_type), Intent(in) :: prec + Type(psb_c_sparse_mat), Intent(in) :: a + class(psb_cprec_type), Intent(in) :: prec Type(psb_desc_type), Intent(in) :: desc_a Complex(psb_spk_), Intent(in) :: b(:) Complex(psb_spk_), Intent(inout) :: x(:) diff --git a/krylov/psb_ccgstabl.f90 b/krylov/psb_ccgstabl.f90 index de225ab3..0effc94e 100644 --- a/krylov/psb_ccgstabl.f90 +++ b/krylov/psb_ccgstabl.f90 @@ -69,8 +69,8 @@ ! ! Arguments: ! -! a - type(psb_cspmat_type) Input: sparse matrix containing A. -! prec - type(psb_cprec_type) Input: preconditioner +! a - type(psb_c_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_cprec_type) Input: preconditioner ! b(:) - complex Input: vector containing the ! right hand side B ! x(:) - complex Input/Output: vector containing the @@ -110,8 +110,8 @@ Subroutine psb_ccgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is implicit none !!$ parameters - Type(psb_cspmat_type), Intent(in) :: a - Type(psb_cprec_type), Intent(in) :: prec + Type(psb_c_sparse_mat), Intent(in) :: a + class(psb_cprec_type), Intent(in) :: prec Type(psb_desc_type), Intent(in) :: desc_a complex(psb_spk_), Intent(in) :: b(:) complex(psb_spk_), Intent(inout) :: x(:) diff --git a/krylov/psb_crgmres.f90 b/krylov/psb_crgmres.f90 index 18bb817a..a310e88b 100644 --- a/krylov/psb_crgmres.f90 +++ b/krylov/psb_crgmres.f90 @@ -73,8 +73,8 @@ ! ! Arguments: ! -! a - type(psb_cspmat_type) Input: sparse matrix containing A. -! prec - type(psb_cprec_type) Input: preconditioner +! a - type(psb_c_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_cprec_type) Input: preconditioner ! b - complex,dimension(:) Input: vector containing the ! right hand side B ! x - complex,dimension(:) Input/Output: vector containing the @@ -112,8 +112,8 @@ Subroutine psb_crgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist implicit none !!$ Parameters - Type(psb_cspmat_type), Intent(in) :: a - Type(psb_cprec_type), Intent(in) :: prec + Type(psb_c_sparse_mat), Intent(in) :: a + class(psb_cprec_type), Intent(in) :: prec Type(psb_desc_type), Intent(in) :: desc_a complex(psb_spk_), Intent(in) :: b(:) complex(psb_spk_), Intent(inout) :: x(:) diff --git a/krylov/psb_dbicg.f90 b/krylov/psb_dbicg.f90 index b3bde503..00c4953f 100644 --- a/krylov/psb_dbicg.f90 +++ b/krylov/psb_dbicg.f90 @@ -62,8 +62,8 @@ ! ! Arguments: ! -! a - type(psb_dspmat_type) Input: sparse matrix containing A. -! prec - type(psb_dprec_type) Input: preconditioner +! a - type(psb_d_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_dprec_type) Input: preconditioner ! b - real,dimension(:) Input: vector containing the ! right hand side B ! x - real,dimension(:) Input/Output: vector containing the @@ -101,7 +101,7 @@ subroutine psb_dbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) implicit none type(psb_d_sparse_mat), intent(in) :: a - type(psb_dprec_type), intent(in) :: prec + class(psb_dprec_type), intent(in) :: prec type(psb_desc_type), intent(in) :: desc_a real(psb_dpk_), intent(in) :: b(:) real(psb_dpk_), intent(inout) :: x(:) diff --git a/krylov/psb_dcg.F90 b/krylov/psb_dcg.F90 index 4caee811..2b82bbc2 100644 --- a/krylov/psb_dcg.F90 +++ b/krylov/psb_dcg.F90 @@ -63,8 +63,8 @@ ! ! Arguments: ! -! a - type(psb_dspmat_type) Input: sparse matrix containing A. -! prec - type(psb_dprec_type) Input: preconditioner +! a - type(psb_d_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_dprec_type) Input: preconditioner ! b - real,dimension(:) Input: vector containing the ! right hand side B ! x - real,dimension(:) Input/Output: vector containing the @@ -104,7 +104,7 @@ subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop,cond) - Type(psb_dprec_type), Intent(in) :: prec + class(psb_dprec_type), Intent(in) :: prec Type(psb_desc_type), Intent(in) :: desc_a Real(psb_dpk_), Intent(in) :: b(:) Real(psb_dpk_), Intent(inout) :: x(:) diff --git a/krylov/psb_dcgs.f90 b/krylov/psb_dcgs.f90 index 831ed963..ef517e1d 100644 --- a/krylov/psb_dcgs.f90 +++ b/krylov/psb_dcgs.f90 @@ -62,8 +62,8 @@ ! ! Arguments: ! -! a - type(psb_dspmat_type) Input: sparse matrix containing A. -! prec - type(psb_dprec_type) Input: preconditioner +! a - type(psb_d_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_dprec_type) Input: preconditioner ! b - real,dimension(:) Input: vector containing the ! right hand side B ! x - real,dimension(:) Input/Output: vector containing the @@ -103,7 +103,7 @@ Subroutine psb_dcgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) Type(psb_desc_type), Intent(in) :: desc_a - Type(psb_dprec_type), Intent(in) :: prec + class(psb_dprec_type), Intent(in) :: prec Real(psb_dpk_), Intent(in) :: b(:) Real(psb_dpk_), Intent(inout) :: x(:) Real(psb_dpk_), Intent(in) :: eps diff --git a/krylov/psb_dcgstab.F90 b/krylov/psb_dcgstab.F90 index b211e513..b44dbcc0 100644 --- a/krylov/psb_dcgstab.F90 +++ b/krylov/psb_dcgstab.F90 @@ -62,8 +62,8 @@ ! ! Arguments: ! -! a - type(psb_dspmat_type) Input: sparse matrix containing A. -! prec - type(psb_dprec_type) Input: preconditioner +! a - type(psb_d_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_dprec_type) Input: preconditioner ! b - real,dimension(:) Input: vector containing the ! right hand side B ! x - real,dimension(:) Input/Output: vector containing the @@ -102,7 +102,7 @@ Subroutine psb_dcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) type(psb_d_sparse_mat), intent(in) :: a - Type(psb_dprec_type), Intent(in) :: prec + class(psb_dprec_type), Intent(in) :: prec Type(psb_desc_type), Intent(in) :: desc_a Real(psb_dpk_), Intent(in) :: b(:) Real(psb_dpk_), Intent(inout) :: x(:) diff --git a/krylov/psb_dcgstabl.f90 b/krylov/psb_dcgstabl.f90 index f15aacf2..15e38493 100644 --- a/krylov/psb_dcgstabl.f90 +++ b/krylov/psb_dcgstabl.f90 @@ -69,8 +69,8 @@ ! ! Arguments: ! -! a - type(psb_dspmat_type) Input: sparse matrix containing A. -! prec - type(psb_dprec_type) Input: preconditioner +! a - type(psb_d_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_dprec_type) Input: preconditioner ! b - real,dimension(:) Input: vector containing the ! right hand side B ! x - real,dimension(:) Input/Output: vector containing the @@ -111,7 +111,7 @@ Subroutine psb_dcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is type(psb_d_sparse_mat), intent(in) :: a - Type(psb_dprec_type), Intent(in) :: prec + class(psb_dprec_type), Intent(in) :: prec Type(psb_desc_type), Intent(in) :: desc_a Real(psb_dpk_), Intent(in) :: b(:) Real(psb_dpk_), Intent(inout) :: x(:) diff --git a/krylov/psb_drgmres.f90 b/krylov/psb_drgmres.f90 index 5edcdbad..a758dbcd 100644 --- a/krylov/psb_drgmres.f90 +++ b/krylov/psb_drgmres.f90 @@ -73,8 +73,8 @@ ! ! Arguments: ! -! a - type(psb_dspmat_type) Input: sparse matrix containing A. -! prec - type(psb_dprec_type) Input: preconditioner +! a - type(psb_d_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_dprec_type) Input: preconditioner ! b - real,dimension(:) Input: vector containing the ! right hand side B ! x - real,dimension(:) Input/Output: vector containing the @@ -114,7 +114,7 @@ subroutine psb_drgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist type(psb_d_sparse_mat), intent(in) :: a - Type(psb_dprec_type), Intent(in) :: prec + class(psb_dprec_type), Intent(in) :: prec Type(psb_desc_type), Intent(in) :: desc_a Real(psb_dpk_), Intent(in) :: b(:) Real(psb_dpk_), Intent(inout) :: x(:) diff --git a/krylov/psb_krylov_mod.f90 b/krylov/psb_krylov_mod.f90 index 3fafa26c..aba05547 100644 --- a/krylov/psb_krylov_mod.f90 +++ b/krylov/psb_krylov_mod.f90 @@ -52,7 +52,7 @@ Module psb_krylov_mod real(psb_spk_), intent(in) :: b(:) real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(in) :: eps - type(psb_sprec_type), intent(in) :: prec + class(psb_sprec_type), intent(in) :: prec integer, intent(out) :: info integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(out) :: iter @@ -67,7 +67,7 @@ Module psb_krylov_mod real(psb_dpk_), intent(in) :: b(:) real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(in) :: eps - type(psb_dprec_type), intent(in) :: prec + class(psb_dprec_type), intent(in) :: prec integer, intent(out) :: info integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(out) :: iter @@ -75,14 +75,14 @@ Module psb_krylov_mod end subroutine psb_dcg subroutine psb_ccg(a,prec,b,x,eps,& & desc_a,info,itmax,iter,err,itrace,istop) - use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_ + use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_ use psb_prec_mod, only : psb_cprec_type - type(psb_cspmat_type), intent(in) :: a + type(psb_c_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a complex(psb_spk_), intent(in) :: b(:) complex(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(in) :: eps - type(psb_cprec_type), intent(in) :: prec + class(psb_cprec_type), intent(in) :: prec integer, intent(out) :: info integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(out) :: iter @@ -90,14 +90,14 @@ Module psb_krylov_mod end subroutine psb_ccg subroutine psb_zcg(a,prec,b,x,eps,& & desc_a,info,itmax,iter,err,itrace,istop) - use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_ use psb_prec_mod, only : psb_zprec_type - type(psb_zspmat_type), intent(in) :: a + type(psb_z_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a complex(psb_dpk_), intent(in) :: b(:) complex(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(in) :: eps - type(psb_zprec_type), intent(in) :: prec + class(psb_zprec_type), intent(in) :: prec integer, intent(out) :: info integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(out) :: iter @@ -115,7 +115,7 @@ Module psb_krylov_mod real(psb_spk_), intent(in) :: b(:) real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(in) :: eps - type(psb_sprec_type), intent(in) :: prec + class(psb_sprec_type), intent(in) :: prec integer, intent(out) :: info integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(out) :: iter @@ -130,7 +130,7 @@ Module psb_krylov_mod real(psb_dpk_), intent(in) :: b(:) real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(in) :: eps - type(psb_dprec_type), intent(in) :: prec + class(psb_dprec_type), intent(in) :: prec integer, intent(out) :: info integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(out) :: iter @@ -138,14 +138,14 @@ Module psb_krylov_mod end subroutine psb_dbicg subroutine psb_cbicg(a,prec,b,x,eps,& & desc_a,info,itmax,iter,err,itrace,istop) - use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_ + use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_ use psb_prec_mod, only : psb_cprec_type - type(psb_cspmat_type), intent(in) :: a + type(psb_c_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a complex(psb_spk_), intent(in) :: b(:) complex(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(in) :: eps - type(psb_cprec_type), intent(in) :: prec + class(psb_cprec_type), intent(in) :: prec integer, intent(out) :: info integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(out) :: iter @@ -153,14 +153,14 @@ Module psb_krylov_mod end subroutine psb_cbicg subroutine psb_zbicg(a,prec,b,x,eps,& & desc_a,info,itmax,iter,err,itrace,istop) - use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_ use psb_prec_mod, only : psb_zprec_type - type(psb_zspmat_type), intent(in) :: a + type(psb_z_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a complex(psb_dpk_), intent(in) :: b(:) complex(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(in) :: eps - type(psb_zprec_type), intent(in) :: prec + class(psb_zprec_type), intent(in) :: prec integer, intent(out) :: info integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(out) :: iter @@ -178,7 +178,7 @@ Module psb_krylov_mod real(psb_spk_), intent(in) :: b(:) real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(in) :: eps - type(psb_sprec_type), intent(in) :: prec + class(psb_sprec_type), intent(in) :: prec integer, intent(out) :: info integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(out) :: iter @@ -193,7 +193,7 @@ Module psb_krylov_mod real(psb_dpk_), intent(in) :: b(:) real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(in) :: eps - type(psb_dprec_type), intent(in) :: prec + class(psb_dprec_type), intent(in) :: prec integer, intent(out) :: info integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(out) :: iter @@ -201,14 +201,14 @@ Module psb_krylov_mod end subroutine psb_dcgstab subroutine psb_ccgstab(a,prec,b,x,eps,& & desc_a,info,itmax,iter,err,itrace,istop) - use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_ + use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_ use psb_prec_mod, only : psb_cprec_type - type(psb_cspmat_type), intent(in) :: a + type(psb_c_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a complex(psb_spk_), intent(in) :: b(:) complex(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(in) :: eps - type(psb_cprec_type), intent(in) :: prec + class(psb_cprec_type), intent(in) :: prec integer, intent(out) :: info integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(out) :: iter @@ -216,14 +216,14 @@ Module psb_krylov_mod end subroutine psb_ccgstab subroutine psb_zcgstab(a,prec,b,x,eps,& & desc_a,info,itmax,iter,err,itrace,istop) - use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_ use psb_prec_mod, only : psb_zprec_type - type(psb_zspmat_type), intent(in) :: a + type(psb_z_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a complex(psb_dpk_), intent(in) :: b(:) complex(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(in) :: eps - type(psb_zprec_type), intent(in) :: prec + class(psb_zprec_type), intent(in) :: prec integer, intent(out) :: info integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(out) :: iter @@ -238,7 +238,7 @@ Module psb_krylov_mod use psb_prec_mod, only : psb_sprec_type Type(psb_s_sparse_mat), Intent(in) :: a Type(psb_desc_type), Intent(in) :: desc_a - type(psb_sprec_type), intent(in) :: prec + class(psb_sprec_type), intent(in) :: prec Real(psb_spk_), Intent(in) :: b(:) Real(psb_spk_), Intent(inout) :: x(:) Real(psb_spk_), Intent(in) :: eps @@ -253,7 +253,7 @@ Module psb_krylov_mod use psb_prec_mod, only : psb_dprec_type type(psb_d_sparse_mat), intent(in) :: a Type(psb_desc_type), Intent(in) :: desc_a - type(psb_dprec_type), intent(in) :: prec + class(psb_dprec_type), intent(in) :: prec Real(psb_dpk_), Intent(in) :: b(:) Real(psb_dpk_), Intent(inout) :: x(:) Real(psb_dpk_), Intent(in) :: eps @@ -264,11 +264,11 @@ Module psb_krylov_mod end subroutine psb_dcgstabl Subroutine psb_ccgstabl(a,prec,b,x,eps,desc_a,info,& &itmax,iter,err,itrace,irst,istop) - use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_ + use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_ use psb_prec_mod, only : psb_cprec_type - Type(psb_cspmat_type), Intent(in) :: a + Type(psb_c_sparse_mat), Intent(in) :: a Type(psb_desc_type), Intent(in) :: desc_a - type(psb_cprec_type), intent(in) :: prec + class(psb_cprec_type), intent(in) :: prec complex(psb_spk_), Intent(in) :: b(:) complex(psb_spk_), Intent(inout) :: x(:) Real(psb_spk_), Intent(in) :: eps @@ -279,11 +279,11 @@ Module psb_krylov_mod end subroutine psb_ccgstabl Subroutine psb_zcgstabl(a,prec,b,x,eps,desc_a,info,& &itmax,iter,err,itrace,irst,istop) - use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_ use psb_prec_mod, only : psb_zprec_type - Type(psb_zspmat_type), Intent(in) :: a + Type(psb_z_sparse_mat), Intent(in) :: a Type(psb_desc_type), Intent(in) :: desc_a - type(psb_zprec_type), intent(in) :: prec + class(psb_zprec_type), intent(in) :: prec complex(psb_dpk_), Intent(in) :: b(:) complex(psb_dpk_), Intent(inout) :: x(:) Real(psb_dpk_), Intent(in) :: eps @@ -301,7 +301,7 @@ Module psb_krylov_mod use psb_prec_mod, only : psb_sprec_type Type(psb_s_sparse_mat), Intent(in) :: a Type(psb_desc_type), Intent(in) :: desc_a - type(psb_sprec_type), intent(in) :: prec + class(psb_sprec_type), intent(in) :: prec Real(psb_spk_), Intent(in) :: b(:) Real(psb_spk_), Intent(inout) :: x(:) Real(psb_spk_), Intent(in) :: eps @@ -316,7 +316,7 @@ Module psb_krylov_mod use psb_prec_mod, only : psb_dprec_type type(psb_d_sparse_mat), intent(in) :: a Type(psb_desc_type), Intent(in) :: desc_a - type(psb_dprec_type), intent(in) :: prec + class(psb_dprec_type), intent(in) :: prec Real(psb_dpk_), Intent(in) :: b(:) Real(psb_dpk_), Intent(inout) :: x(:) Real(psb_dpk_), Intent(in) :: eps @@ -327,11 +327,11 @@ Module psb_krylov_mod end subroutine psb_drgmres Subroutine psb_crgmres(a,prec,b,x,eps,desc_a,info,& &itmax,iter,err,itrace,irst,istop) - use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_ + use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_ use psb_prec_mod, only : psb_cprec_type - Type(psb_cspmat_type), Intent(in) :: a + Type(psb_c_sparse_mat), Intent(in) :: a Type(psb_desc_type), Intent(in) :: desc_a - type(psb_cprec_type), intent(in) :: prec + class(psb_cprec_type), intent(in) :: prec complex(psb_spk_), Intent(in) :: b(:) complex(psb_spk_), Intent(inout) :: x(:) Real(psb_spk_), Intent(in) :: eps @@ -342,11 +342,11 @@ Module psb_krylov_mod end subroutine psb_crgmres Subroutine psb_zrgmres(a,prec,b,x,eps,desc_a,info,& &itmax,iter,err,itrace,irst,istop) - use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_ use psb_prec_mod, only : psb_zprec_type - Type(psb_zspmat_type), Intent(in) :: a + Type(psb_z_sparse_mat), Intent(in) :: a Type(psb_desc_type), Intent(in) :: desc_a - type(psb_zprec_type), intent(in) :: prec + class(psb_zprec_type), intent(in) :: prec complex(psb_dpk_), Intent(in) :: b(:) complex(psb_dpk_), Intent(inout) :: x(:) Real(psb_dpk_), Intent(in) :: eps @@ -364,7 +364,7 @@ Module psb_krylov_mod use psb_prec_mod, only : psb_sprec_type type(psb_s_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(psb_sprec_type), intent(in) :: prec + class(psb_sprec_type), intent(in) :: prec real(psb_spk_), intent(in) :: b(:) real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(in) :: eps @@ -379,7 +379,7 @@ Module psb_krylov_mod use psb_prec_mod, only : psb_dprec_type type(psb_d_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - type(psb_dprec_type), intent(in) :: prec + class(psb_dprec_type), intent(in) :: prec real(psb_dpk_), intent(in) :: b(:) real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(in) :: eps @@ -390,14 +390,14 @@ Module psb_krylov_mod end subroutine psb_dcgs subroutine psb_ccgs(a,prec,b,x,eps,& & desc_a,info,itmax,iter,err,itrace,istop) - use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_ + use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_ use psb_prec_mod, only : psb_cprec_type - type(psb_cspmat_type), intent(in) :: a + type(psb_c_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a complex(psb_spk_), intent(in) :: b(:) complex(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(in) :: eps - type(psb_cprec_type), intent(in) :: prec + class(psb_cprec_type), intent(in) :: prec integer, intent(out) :: info integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(out) :: iter @@ -405,14 +405,14 @@ Module psb_krylov_mod end subroutine psb_ccgs subroutine psb_zcgs(a,prec,b,x,eps,& & desc_a,info,itmax,iter,err,itrace,istop) - use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_ use psb_prec_mod, only : psb_zprec_type - type(psb_zspmat_type), intent(in) :: a + type(psb_z_sparse_mat), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a complex(psb_dpk_), intent(in) :: b(:) complex(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(in) :: eps - type(psb_zprec_type), intent(in) :: prec + class(psb_zprec_type), intent(in) :: prec integer, intent(out) :: info integer, optional, intent(in) :: itmax, itrace,istop integer, optional, intent(out) :: iter @@ -463,7 +463,7 @@ contains ! RGMRES ! ! a - type(psb_s_sparse_mat) Input: sparse matrix containing A. - ! prec - type(psb_sprec_type) Input: preconditioner + ! prec - class(psb_sprec_type) Input: preconditioner ! b - real,dimension(:) Input: vector containing the ! right hand side B ! x - real,dimension(:) Input/Output: vector containing the @@ -500,7 +500,7 @@ contains character(len=*) :: method Type(psb_s_sparse_mat), Intent(in) :: a Type(psb_desc_type), Intent(in) :: desc_a - type(psb_sprec_type), intent(in) :: prec + class(psb_sprec_type), intent(in) :: prec Real(psb_spk_), Intent(in) :: b(:) Real(psb_spk_), Intent(inout) :: x(:) Real(psb_spk_), Intent(in) :: eps @@ -580,7 +580,7 @@ contains ! RGMRES ! ! a - type(psb_d_sparse_mat) Input: sparse matrix containing A. - ! prec - type(psb_dprec_type) Input: preconditioner + ! prec - class(psb_dprec_type) Input: preconditioner ! b - real,dimension(:) Input: vector containing the ! right hand side B ! x - real,dimension(:) Input/Output: vector containing the @@ -618,7 +618,7 @@ contains character(len=*) :: method Type(psb_desc_type), Intent(in) :: desc_a - type(psb_dprec_type), intent(in) :: prec + class(psb_dprec_type), intent(in) :: prec Real(psb_dpk_), Intent(in) :: b(:) Real(psb_dpk_), Intent(inout) :: x(:) Real(psb_dpk_), Intent(in) :: eps @@ -698,8 +698,8 @@ contains ! BICGSTABL ! RGMRES ! - ! a - type(psb_cspmat_type) Input: sparse matrix containing A. - ! prec - type(psb_cprec_type) Input: preconditioner + ! a - type(psb_c_sparse_mat) Input: sparse matrix containing A. + ! prec - class(psb_cprec_type) Input: preconditioner ! b - complex,dimension(:) Input: vector containing the ! right hand side B ! x - complex,dimension(:) Input/Output: vector containing the @@ -732,9 +732,9 @@ contains use psb_base_mod use psb_prec_mod,only : psb_sprec_type, psb_dprec_type, psb_cprec_type, psb_zprec_type character(len=*) :: method - Type(psb_cspmat_type), Intent(in) :: a + Type(psb_c_sparse_mat), Intent(in) :: a Type(psb_desc_type), Intent(in) :: desc_a - type(psb_cprec_type), intent(in) :: prec + class(psb_cprec_type), intent(in) :: prec complex(psb_spk_), Intent(in) :: b(:) complex(psb_spk_), Intent(inout) :: x(:) Real(psb_spk_), Intent(in) :: eps @@ -814,8 +814,8 @@ contains ! BICGSTABL ! RGMRES ! - ! a - type(psb_zspmat_type) Input: sparse matrix containing A. - ! prec - type(psb_zprec_type) Input: preconditioner + ! a - type(psb_z_sparse_mat) Input: sparse matrix containing A. + ! prec - class(psb_zprec_type) Input: preconditioner ! b - complex,dimension(:) Input: vector containing the ! right hand side B ! x - complex,dimension(:) Input/Output: vector containing the @@ -848,9 +848,9 @@ contains use psb_base_mod use psb_prec_mod,only : psb_sprec_type, psb_dprec_type, psb_cprec_type, psb_zprec_type character(len=*) :: method - Type(psb_zspmat_type), Intent(in) :: a + Type(psb_z_sparse_mat), Intent(in) :: a Type(psb_desc_type), Intent(in) :: desc_a - type(psb_zprec_type), intent(in) :: prec + class(psb_zprec_type), intent(in) :: prec complex(psb_dpk_), Intent(in) :: b(:) complex(psb_dpk_), Intent(inout) :: x(:) Real(psb_dpk_), Intent(in) :: eps @@ -1130,7 +1130,7 @@ contains implicit none character(len=*), intent(in) :: methdname integer, intent(in) :: stopc, trace, itmax - type(psb_cspmat_type), intent(in) :: a + type(psb_c_sparse_mat), intent(in) :: a complex(psb_spk_), intent(in) :: b(:) real(psb_spk_), intent(in) :: eps type(psb_desc_type), intent(in) :: desc_a @@ -1198,7 +1198,7 @@ contains implicit none character(len=*), intent(in) :: methdname integer, intent(in) :: stopc, trace, itmax - type(psb_zspmat_type), intent(in) :: a + type(psb_z_sparse_mat), intent(in) :: a complex(psb_dpk_), intent(in) :: b(:) real(psb_dpk_), intent(in) :: eps type(psb_desc_type), intent(in) :: desc_a diff --git a/krylov/psb_sbicg.f90 b/krylov/psb_sbicg.f90 index caa378d9..b822fdbd 100644 --- a/krylov/psb_sbicg.f90 +++ b/krylov/psb_sbicg.f90 @@ -63,7 +63,7 @@ ! Arguments: ! ! a - type(psb_s_sparse_mat) Input: sparse matrix containing A. -! prec - type(psb_sprec_type) Input: preconditioner +! prec - class(psb_sprec_type) Input: preconditioner ! b - real,dimension(:) Input: vector containing the ! right hand side B ! x - real,dimension(:) Input/Output: vector containing the @@ -102,7 +102,7 @@ subroutine psb_sbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) !!$ parameters type(psb_s_sparse_mat), intent(in) :: a - type(psb_sprec_type), intent(in) :: prec + class(psb_sprec_type), intent(in) :: prec type(psb_desc_type), intent(in) :: desc_a real(psb_spk_), intent(in) :: b(:) real(psb_spk_), intent(inout) :: x(:) diff --git a/krylov/psb_scg.F90 b/krylov/psb_scg.F90 index 8047d64c..aa866f53 100644 --- a/krylov/psb_scg.F90 +++ b/krylov/psb_scg.F90 @@ -64,7 +64,7 @@ ! Arguments: ! ! a - type(psb_s_sparse_mat) Input: sparse matrix containing A. -! prec - type(psb_sprec_type) Input: preconditioner +! prec - class(psb_sprec_type) Input: preconditioner ! b - real,dimension(:) Input: vector containing the ! right hand side B ! x - real,dimension(:) Input/Output: vector containing the @@ -103,7 +103,7 @@ subroutine psb_scg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop,cond) !!$ Parameters Type(psb_s_sparse_mat), Intent(in) :: a - Type(psb_sprec_type), Intent(in) :: prec + class(psb_sprec_type), Intent(in) :: prec Type(psb_desc_type), Intent(in) :: desc_a Real(psb_spk_), Intent(in) :: b(:) Real(psb_spk_), Intent(inout) :: x(:) diff --git a/krylov/psb_scgs.f90 b/krylov/psb_scgs.f90 index 212cc9d8..e5374b9a 100644 --- a/krylov/psb_scgs.f90 +++ b/krylov/psb_scgs.f90 @@ -63,7 +63,7 @@ ! Arguments: ! ! a - type(psb_s_sparse_mat) Input: sparse matrix containing A. -! prec - type(psb_sprec_type) Input: preconditioner +! prec - class(psb_sprec_type) Input: preconditioner ! b - real,dimension(:) Input: vector containing the ! right hand side B ! x - real,dimension(:) Input/Output: vector containing the @@ -103,7 +103,7 @@ Subroutine psb_scgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) !!$ parameters Type(psb_s_sparse_mat), Intent(in) :: a Type(psb_desc_type), Intent(in) :: desc_a - Type(psb_sprec_type), Intent(in) :: prec + class(psb_sprec_type), Intent(in) :: prec Real(psb_spk_), Intent(in) :: b(:) Real(psb_spk_), Intent(inout) :: x(:) Real(psb_spk_), Intent(in) :: eps diff --git a/krylov/psb_scgstab.F90 b/krylov/psb_scgstab.F90 index a395128b..2a85eda9 100644 --- a/krylov/psb_scgstab.F90 +++ b/krylov/psb_scgstab.F90 @@ -63,7 +63,7 @@ ! Arguments: ! ! a - type(psb_s_sparse_mat) Input: sparse matrix containing A. -! prec - type(psb_sprec_type) Input: preconditioner +! prec - class(psb_sprec_type) Input: preconditioner ! b - real,dimension(:) Input: vector containing the ! right hand side B ! x - real,dimension(:) Input/Output: vector containing the @@ -101,7 +101,7 @@ Subroutine psb_scgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) Implicit None !!$ parameters Type(psb_s_sparse_mat), Intent(in) :: a - Type(psb_sprec_type), Intent(in) :: prec + class(psb_sprec_type), Intent(in) :: prec Type(psb_desc_type), Intent(in) :: desc_a Real(psb_spk_), Intent(in) :: b(:) Real(psb_spk_), Intent(inout) :: x(:) diff --git a/krylov/psb_scgstabl.f90 b/krylov/psb_scgstabl.f90 index dc1a3c8b..fb20b9b0 100644 --- a/krylov/psb_scgstabl.f90 +++ b/krylov/psb_scgstabl.f90 @@ -70,7 +70,7 @@ ! Arguments: ! ! a - type(psb_s_sparse_mat) Input: sparse matrix containing A. -! prec - type(psb_sprec_type) Input: preconditioner +! prec - class(psb_sprec_type) Input: preconditioner ! b - real,dimension(:) Input: vector containing the ! right hand side B ! x - real,dimension(:) Input/Output: vector containing the @@ -111,7 +111,7 @@ Subroutine psb_scgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is !!$ parameters Type(psb_s_sparse_mat), Intent(in) :: a - Type(psb_sprec_type), Intent(in) :: prec + class(psb_sprec_type), Intent(in) :: prec Type(psb_desc_type), Intent(in) :: desc_a Real(psb_spk_), Intent(in) :: b(:) Real(psb_spk_), Intent(inout) :: x(:) diff --git a/krylov/psb_srgmres.f90 b/krylov/psb_srgmres.f90 index 20fd7d4a..8a678693 100644 --- a/krylov/psb_srgmres.f90 +++ b/krylov/psb_srgmres.f90 @@ -74,7 +74,7 @@ ! Arguments: ! ! a - type(psb_s_sparse_mat) Input: sparse matrix containing A. -! prec - type(psb_sprec_type) Input: preconditioner +! prec - class(psb_sprec_type) Input: preconditioner ! b - real,dimension(:) Input: vector containing the ! right hand side B ! x - real,dimension(:) Input/Output: vector containing the @@ -114,7 +114,7 @@ subroutine psb_srgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist !!$ Parameters Type(psb_s_sparse_mat), Intent(in) :: a - Type(psb_sprec_type), Intent(in) :: prec + class(psb_sprec_type), Intent(in) :: prec Type(psb_desc_type), Intent(in) :: desc_a Real(psb_spk_), Intent(in) :: b(:) Real(psb_spk_), Intent(inout) :: x(:) diff --git a/krylov/psb_zbicg.f90 b/krylov/psb_zbicg.f90 index eed7147a..4c100613 100644 --- a/krylov/psb_zbicg.f90 +++ b/krylov/psb_zbicg.f90 @@ -62,8 +62,8 @@ ! ! Arguments: ! -! a - type(psb_zspmat_type) Input: sparse matrix containing A. -! prec - type(psb_zprec_type) Input: preconditioner +! a - type(psb_z_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_zprec_type) Input: preconditioner ! b(:) - complex Input: vector containing the ! right hand side B ! x(:) - complex Input/Output: vector containing the @@ -100,8 +100,8 @@ subroutine psb_zbicg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) implicit none !!$ parameters - type(psb_zspmat_type), intent(in) :: a - type(psb_zprec_type), intent(in) :: prec + type(psb_z_sparse_mat), intent(in) :: a + class(psb_zprec_type), intent(in) :: prec type(psb_desc_type), intent(in) :: desc_a complex(psb_dpk_), intent(in) :: b(:) complex(psb_dpk_), intent(inout) :: x(:) diff --git a/krylov/psb_zcg.F90 b/krylov/psb_zcg.F90 index 5d85c057..6c160bc5 100644 --- a/krylov/psb_zcg.F90 +++ b/krylov/psb_zcg.F90 @@ -63,8 +63,8 @@ ! ! Arguments: ! -! a - type(psb_zspmat_type) Input: sparse matrix containing A. -! prec - type(psb_zprec_type) Input: preconditioner +! a - type(psb_z_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_zprec_type) Input: preconditioner ! b(:) - complex Input: vector containing the ! right hand side B ! x(:) - complex Input/Output: vector containing the @@ -102,8 +102,8 @@ subroutine psb_zcg(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) implicit none !!$ Parameters - Type(psb_zspmat_type), Intent(in) :: a - Type(psb_zprec_type), Intent(in) :: prec + Type(psb_z_sparse_mat), Intent(in) :: a + class(psb_zprec_type), Intent(in) :: prec Type(psb_desc_type), Intent(in) :: desc_a complex(psb_dpk_), Intent(in) :: b(:) complex(psb_dpk_), Intent(inout) :: x(:) diff --git a/krylov/psb_zcgs.f90 b/krylov/psb_zcgs.f90 index 34f6c199..9861c4d1 100644 --- a/krylov/psb_zcgs.f90 +++ b/krylov/psb_zcgs.f90 @@ -61,8 +61,8 @@ ! ! Arguments: ! -! a - type(psb_zspmat_type) Input: sparse matrix containing A. -! prec - type(psb_zprec_type) Input: preconditioner +! a - type(psb_z_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_zprec_type) Input: preconditioner ! b - complex,dimension(:) Input: vector containing the ! right hand side B ! x - complex,dimension(:) Input/Output: vector containing the @@ -99,9 +99,9 @@ Subroutine psb_zcgs(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) implicit none !!$ parameters - Type(psb_zspmat_type), Intent(in) :: a + Type(psb_z_sparse_mat), Intent(in) :: a Type(psb_desc_type), Intent(in) :: desc_a - Type(psb_zprec_type), Intent(in) :: prec + class(psb_zprec_type), Intent(in) :: prec Complex(psb_dpk_), Intent(in) :: b(:) Complex(psb_dpk_), Intent(inout) :: x(:) Real(psb_dpk_), Intent(in) :: eps diff --git a/krylov/psb_zcgstab.f90 b/krylov/psb_zcgstab.f90 index de00c0c1..fdbe59da 100644 --- a/krylov/psb_zcgstab.f90 +++ b/krylov/psb_zcgstab.f90 @@ -62,8 +62,8 @@ ! ! Arguments: ! -! a - type(psb_zspmat_type) Input: sparse matrix containing A. -! prec - type(psb_zprec_type) Input: preconditioner +! a - type(psb_z_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_zprec_type) Input: preconditioner ! b - complex,dimension(:) Input: vector containing the ! right hand side B ! x - complex,dimension(:) Input/Output: vector containing the @@ -99,8 +99,8 @@ subroutine psb_zcgstab(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,istop) use psb_krylov_mod, psb_protect_name => psb_zcgstab Implicit None !!$ parameters - Type(psb_zspmat_type), Intent(in) :: a - Type(psb_zprec_type), Intent(in) :: prec + Type(psb_z_sparse_mat), Intent(in) :: a + class(psb_zprec_type), Intent(in) :: prec Type(psb_desc_type), Intent(in) :: desc_a Complex(psb_dpk_), Intent(in) :: b(:) Complex(psb_dpk_), Intent(inout) :: x(:) diff --git a/krylov/psb_zcgstabl.f90 b/krylov/psb_zcgstabl.f90 index 3d8c14be..ace87e92 100644 --- a/krylov/psb_zcgstabl.f90 +++ b/krylov/psb_zcgstabl.f90 @@ -69,8 +69,8 @@ ! ! Arguments: ! -! a - type(psb_zspmat_type) Input: sparse matrix containing A. -! prec - type(psb_zprec_type) Input: preconditioner +! a - type(psb_z_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_zprec_type) Input: preconditioner ! b(:) - complex Input: vector containing the ! right hand side B ! x(:) - complex Input/Output: vector containing the @@ -110,8 +110,8 @@ Subroutine psb_zcgstabl(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,is implicit none !!$ parameters - Type(psb_zspmat_type), Intent(in) :: a - Type(psb_zprec_type), Intent(in) :: prec + Type(psb_z_sparse_mat), Intent(in) :: a + class(psb_zprec_type), Intent(in) :: prec Type(psb_desc_type), Intent(in) :: desc_a complex(psb_dpk_), Intent(in) :: b(:) complex(psb_dpk_), Intent(inout) :: x(:) diff --git a/krylov/psb_zrgmres.f90 b/krylov/psb_zrgmres.f90 index c970d269..b42d11d8 100644 --- a/krylov/psb_zrgmres.f90 +++ b/krylov/psb_zrgmres.f90 @@ -73,8 +73,8 @@ ! ! Arguments: ! -! a - type(psb_zspmat_type) Input: sparse matrix containing A. -! prec - type(psb_zprec_type) Input: preconditioner +! a - type(psb_z_sparse_mat) Input: sparse matrix containing A. +! prec - class(psb_zprec_type) Input: preconditioner ! b - complex,dimension(:) Input: vector containing the ! right hand side B ! x - complex,dimension(:) Input/Output: vector containing the @@ -112,8 +112,8 @@ Subroutine psb_zrgmres(a,prec,b,x,eps,desc_a,info,itmax,iter,err,itrace,irst,ist implicit none !!$ Parameters - Type(psb_zspmat_type), Intent(in) :: a - Type(psb_zprec_type), Intent(in) :: prec + Type(psb_z_sparse_mat), Intent(in) :: a + class(psb_zprec_type), Intent(in) :: prec Type(psb_desc_type), Intent(in) :: desc_a complex(psb_dpk_), Intent(in) :: b(:) complex(psb_dpk_), Intent(inout) :: x(:) diff --git a/prec/psb_cbjac_aply.f90 b/prec/psb_cbjac_aply.f90 index 5e1ab23d..eab9710a 100644 --- a/prec/psb_cbjac_aply.f90 +++ b/prec/psb_cbjac_aply.f90 @@ -108,26 +108,26 @@ subroutine psb_cbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) case('N') call psb_spsm(cone,prec%av(psb_l_pr_),x,czero,ww,desc_data,info,& - & trans=trans_,unit='L',diag=prec%d,choice=psb_none_,work=aux) + & trans=trans_,side='L',diag=prec%d,choice=psb_none_,work=aux) if(info /=0) goto 9999 call psb_spsm(alpha,prec%av(psb_u_pr_),ww,beta,y,desc_data,info,& - & trans=trans_,unit='U',choice=psb_none_, work=aux) + & trans=trans_,side='U',choice=psb_none_, work=aux) if(info /=0) goto 9999 case('T') call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,ww,desc_data,info,& - & trans=trans_,unit='L',diag=prec%d,choice=psb_none_, work=aux) + & trans=trans_,side='L',diag=prec%d,choice=psb_none_, work=aux) if(info /=0) goto 9999 call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,desc_data,info,& - & trans=trans_,unit='U',choice=psb_none_,work=aux) + & trans=trans_,side='U',choice=psb_none_,work=aux) if(info /=0) goto 9999 case('C') call psb_spsm(cone,prec%av(psb_u_pr_),x,czero,ww,desc_data,info,& - & trans=trans_,unit='L',diag=conjg(prec%d),choice=psb_none_, work=aux) + & trans=trans_,side='L',diag=conjg(prec%d),choice=psb_none_, work=aux) if(info /=0) goto 9999 call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,desc_data,info,& - & trans=trans_,unit='U',choice=psb_none_,work=aux) + & trans=trans_,side='U',choice=psb_none_,work=aux) if(info /=0) goto 9999 end select diff --git a/prec/psb_cbjac_bld.f90 b/prec/psb_cbjac_bld.f90 index 148a53c9..dae56048 100644 --- a/prec/psb_cbjac_bld.f90 +++ b/prec/psb_cbjac_bld.f90 @@ -37,7 +37,7 @@ subroutine psb_cbjac_bld(a,desc_a,p,upd,info) ! .. Scalar Arguments .. integer, intent(out) :: info ! .. array Arguments .. - type(psb_cspmat_type), intent(in), target :: a + type(psb_c_sparse_mat), intent(in), target :: a type(psb_cprec_type), intent(inout) :: p type(psb_desc_type), intent(in) :: desc_a character, intent(in) :: upd @@ -46,7 +46,7 @@ subroutine psb_cbjac_bld(a,desc_a,p,upd,info) integer :: i, m integer :: int_err(5) character :: trans, unitd - type(psb_cspmat_type) :: atmp + type(psb_c_csr_sparse_mat), allocatable :: lf, uf real(psb_dpk_) :: t1,t2,t3,t4,t5,t6, t7, t8 integer nztota, err_act, n_row, nrow_a,n_col, nhalo integer :: ictxt,np,me @@ -61,7 +61,7 @@ subroutine psb_cbjac_bld(a,desc_a,p,upd,info) ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) - m = a%m + m = a%get_nrows() if (m < 0) then info = 10 int_err(1) = 1 @@ -71,7 +71,6 @@ subroutine psb_cbjac_bld(a,desc_a,p,upd,info) endif trans = 'N' unitd = 'U' - call psb_nullify_sp(atmp) call psb_cdcpy(desc_a,p%desc_data,info) if(info /= 0) then @@ -89,12 +88,7 @@ subroutine psb_cbjac_bld(a,desc_a,p,upd,info) if (allocated(p%av)) then if (size(p%av) < psb_bp_ilu_avsz) 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 + call p%av(i)%free() enddo deallocate(p%av,stat=info) endif @@ -108,17 +102,16 @@ subroutine psb_cbjac_bld(a,desc_a,p,upd,info) endif nrow_a = psb_cd_get_local_rows(desc_a) - nztota = psb_sp_get_nnzeros(a) + nztota = a%get_nzeros() 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(psb_l_pr_)%m = n_row - p%av(psb_l_pr_)%k = n_row - p%av(psb_u_pr_)%m = n_row - p%av(psb_u_pr_)%k = n_row - call psb_sp_all(n_row,n_row,p%av(psb_l_pr_),nztota,info) - if (info == 0) call psb_sp_all(n_row,n_row,p%av(psb_u_pr_),nztota,info) + + allocate(lf,uf,stat=info) + if (info == 0) call lf%allocate(n_row,n_row,nztota) + if (info == 0) call uf%allocate(n_row,n_row,nztota) + if(info/=0) then info=4010 ch_err='psb_sp_all' @@ -140,26 +133,23 @@ subroutine psb_cbjac_bld(a,desc_a,p,upd,info) endif t3 = psb_wtime() - ! This is where we have mo renumbering, thus no need - ! for ATMP - - call psb_ilu_fct(a,p%av(psb_l_pr_),p%av(psb_u_pr_),p%d,info) - if(info/=0) then + ! This is where we have no renumbering, thus no need + call psb_ilu_fct(a,lf,uf,p%d,info) + + if(info==0) then + call p%av(psb_l_pr_)%mv_from(lf) + call p%av(psb_u_pr_)%mv_from(uf) + call p%av(psb_l_pr_)%set_asb() + call p%av(psb_u_pr_)%set_asb() + call p%av(psb_l_pr_)%trim() + call p%av(psb_u_pr_)%trim() + else info=4010 ch_err='psb_ilu_fct' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - if (psb_sp_getifld(psb_upd_,p%av(psb_u_pr_),info) /= psb_upd_perm_) then - call psb_sp_trim(p%av(psb_u_pr_),info) - endif - - if (psb_sp_getifld(psb_upd_,p%av(psb_l_pr_),info) /= psb_upd_perm_) then - call psb_sp_trim(p%av(psb_l_pr_),info) - endif - - case(psb_f_none_) info=4010 ch_err='Inconsistent prec psb_f_none_' diff --git a/prec/psb_cdiagsc_bld.f90 b/prec/psb_cdiagsc_bld.f90 index a25f0129..33ad2e7c 100644 --- a/prec/psb_cdiagsc_bld.f90 +++ b/prec/psb_cdiagsc_bld.f90 @@ -35,7 +35,7 @@ subroutine psb_cdiagsc_bld(a,desc_a,p,upd,info) use psb_prec_mod, psb_protect_name => psb_cdiagsc_bld Implicit None - type(psb_cspmat_type), intent(in), target :: a + type(psb_c_sparse_mat), intent(in), target :: a type(psb_desc_type), intent(in) :: desc_a type(psb_cprec_type),intent(inout) :: p character, intent(in) :: upd @@ -76,7 +76,7 @@ subroutine psb_cdiagsc_bld(a,desc_a,p,upd,info) ! ! Retrieve the diagonal entries of the matrix A ! - call psb_sp_getdiag(a,p%d,info) + call a%get_diag(p%d,info) if(info /= 0) then info=4010 ch_err='psb_sp_getdiag' @@ -105,19 +105,6 @@ subroutine psb_cdiagsc_bld(a,desc_a,p,upd,info) endif end do - if (a%pl(1) /= 0) then - ! - ! Apply the same row permutation as in the sparse matrix A - ! - call psb_gelp('n',a%pl,p%d,info) - if(info /= 0) then - info=4010 - ch_err='psb_gelp' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - endif - call psb_erractionrestore(err_act) return diff --git a/prec/psb_cilu_fct.f90 b/prec/psb_cilu_fct.f90 index 3b0def18..04f36b56 100644 --- a/prec/psb_cilu_fct.f90 +++ b/prec/psb_cilu_fct.f90 @@ -41,15 +41,15 @@ subroutine psb_cilu_fct(a,l,u,d,info,blck) ! .. Scalar Arguments .. integer, intent(out) :: info ! .. Array Arguments .. - type(psb_cspmat_type),intent(in) :: a - type(psb_cspmat_type),intent(inout) :: l,u - type(psb_cspmat_type),intent(in), optional, target :: blck + type(psb_c_sparse_mat),intent(in) :: a + type(psb_c_csr_sparse_mat),intent(inout) :: l,u + type(psb_c_sparse_mat),intent(in), optional, target :: blck complex(psb_spk_), intent(inout) :: d(:) ! .. Local Scalars .. integer :: l1, l2,m,err_act - type(psb_cspmat_type), pointer :: blck_ + type(psb_c_sparse_mat), pointer :: blck_ character(len=20) :: name, ch_err - name='psb_ccsrlu' + name='psb_ilu_fct' info = 0 call psb_erractionsave(err_act) ! .. Executable Statements .. @@ -64,41 +64,34 @@ subroutine psb_cilu_fct(a,l,u,d,info,blck) 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 /= 0) then - info=4010 - ch_err='psb_sp_all' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if + call blck_%csall(0,0,info,1) - blck_%m=0 endif - call psb_cilu_fctint(m,a%m,a,blck_%m,blck_,& - & d,l%aspk,l%ia1,l%ia2,u%aspk,u%ia1,u%ia2,l1,l2,info) + call psb_cilu_fctint(m,a%get_nrows(),a,blck_%get_nrows(),blck_,& + & d,l%val,l%ja,l%irp,u%val,u%ja,u%irp,l1,l2,info) if(info /= 0) then info=4010 ch_err='psb_cilu_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 + + call l%set_triangle() + call l%set_lower() + call l%set_unit() + call u%set_triangle() + call u%set_upper() + call u%set_unit() + call l%set_nrows(m) + call l%set_ncols(m) + call u%set_nrows(m) + call u%set_ncols(m) + if (present(blck)) then blck_ => null() else - call psb_sp_free(blck_,info) + call blck_%free() if(info /= 0) then info=4010 ch_err='psb_sp_free' @@ -124,15 +117,15 @@ contains & d,laspk,lia1,lia2,uaspk,uia1,uia2,l1,l2,info) implicit none - type(psb_cspmat_type) :: a,b + type(psb_c_sparse_mat) :: a,b integer :: m,ma,mb,l1,l2,info integer, dimension(:) :: lia1,lia2,uia1,uia2 complex(psb_spk_), dimension(:) :: laspk,uaspk,d - integer :: i,j,k,l,low1,low2,kk,jj,ll, irb, ktrw,err_act + integer :: i,j,k,l,low1,low2,kk,jj,ll, irb, ktrw,err_act, nz complex(psb_spk_) :: dia,temp - integer, parameter :: nrb=16 - type(psb_cspmat_type) :: trw + integer, parameter :: nrb=60 + type(psb_c_coo_sparse_mat) :: trw integer :: int_err(5) character(len=20) :: name, ch_err @@ -140,11 +133,7 @@ contains if(psb_get_errstatus() /= 0) return info=0 call psb_erractionsave(err_act) - call psb_nullify_sp(trw) - trw%m=0 - trw%k=0 - - call psb_sp_all(trw,1,info) + call trw%allocate(0,0,info) if(info /= 0) then info=4010 ch_err='psb_sp_all' @@ -159,64 +148,40 @@ contains m = ma+mb do i = 1, ma - d(i) = zzero + d(i) = czero ! - ! 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 /= 0) then - info=4010 - ch_err='psb_sp_getblk' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - ktrw=1 + if ((mod(i,nrb) == 1).or.(nrb==1)) then + irb = min(ma-i+1,nrb) + call a%a%csget(i,i+irb-1,trw,info) + if(info /= 0) then + info=4010 + ch_err='a%csget' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 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 - + nz = trw%get_nzeros() + ktrw=1 end if - + + do + if (ktrw > nz ) exit + if (trw%ia(ktrw) > i) exit + k = trw%ja(ktrw) + if ((k < i).and.(k >= 1)) then + l1 = l1 + 1 + laspk(l1) = trw%val(ktrw) + lia1(l1) = k + else if (k == i) then + d(i) = trw%val(ktrw) + else if ((k > i).and.(k <= m)) then + l2 = l2 + 1 + uaspk(l2) = trw%val(ktrw) + uia1(l2) = k + end if + ktrw = ktrw + 1 + enddo !!$ lia2(i+1) = l1 + 1 @@ -291,7 +256,7 @@ contains call psb_errpush(info,name,i_err=int_err,a_err=ch_err) goto 9999 else - dia = zone/dia + dia = cone/dia end if d(i) = dia ! write(6,*)'diag(',i,')=',d(i) @@ -302,63 +267,38 @@ contains 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 == 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 == 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 /= 0) then - info=4010 - ch_err='psb_sp_getblk' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - ktrw=1 + d(i) = czero + + if ((mod(i,nrb) == 1).or.(nrb==1)) then + irb = min(ma-i+1,nrb) + call b%a%csget(i-ma,i-ma+irb-1,trw,info) + nz = trw%get_nzeros() + if(info /= 0) then + info=4010 + ch_err='a%csget' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 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 + ktrw=1 + end if + + do + if (ktrw > nz ) exit + if (trw%ia(ktrw) > i) exit + k = trw%ja(ktrw) + if ((k < i).and.(k >= 1)) then + l1 = l1 + 1 + laspk(l1) = trw%val(ktrw) + lia1(l1) = k + else if (k == i) then + d(i) = trw%val(ktrw) + else if ((k > i).and.(k <= m)) then + l2 = l2 + 1 + uaspk(l2) = trw%val(ktrw) + uia1(l2) = k + end if + ktrw = ktrw + 1 + enddo lia2(i+1) = l1 + 1 @@ -431,7 +371,7 @@ contains call psb_errpush(info,name,i_err=int_err,a_err=ch_err) goto 9999 else - dia = zone/dia + dia = cone/dia end if d(i) = dia ! Scale row i of upper triangle @@ -440,13 +380,7 @@ contains enddo enddo - call psb_sp_free(trw,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 + call trw%free() call psb_erractionrestore(err_act) return diff --git a/prec/psb_cprecbld.f90 b/prec/psb_cprecbld.f90 index 905ec62b..ebd3a9ef 100644 --- a/prec/psb_cprecbld.f90 +++ b/prec/psb_cprecbld.f90 @@ -35,7 +35,7 @@ subroutine psb_cprecbld(a,desc_a,p,info,upd) use psb_prec_mod, psb_protect_name => psb_cprecbld Implicit None - type(psb_cspmat_type), intent(in), target :: a + type(psb_c_sparse_mat), intent(in), target :: a type(psb_desc_type), intent(in), target :: desc_a type(psb_cprec_type),intent(inout) :: p integer, intent(out) :: info diff --git a/prec/psb_prec_mod.f90 b/prec/psb_prec_mod.f90 index ad0f1daf..601c61d5 100644 --- a/prec/psb_prec_mod.f90 +++ b/prec/psb_prec_mod.f90 @@ -55,20 +55,20 @@ module psb_prec_mod character, intent(in),optional :: upd end subroutine psb_dprecbld subroutine psb_cprecbld(a,desc_a,prec,info,upd) - use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_ + use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_ use psb_prec_type, only : psb_cprec_type implicit none - type(psb_cspmat_type), intent(in), target :: a + type(psb_c_sparse_mat), intent(in), target :: a type(psb_desc_type), intent(in), target :: desc_a type(psb_cprec_type), intent(inout) :: prec integer, intent(out) :: info character, intent(in),optional :: upd end subroutine psb_cprecbld subroutine psb_zprecbld(a,desc_a,prec,info,upd) - use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_ use psb_prec_type, only : psb_zprec_type implicit none - type(psb_zspmat_type), intent(in), target :: a + type(psb_z_sparse_mat), intent(in), target :: a type(psb_desc_type), intent(in), target :: desc_a type(psb_zprec_type), intent(inout) :: prec integer, intent(out) :: info @@ -147,7 +147,7 @@ module psb_prec_mod integer, intent(out) :: info end subroutine psb_dprecsetd subroutine psb_cprecseti(prec,what,val,info) - use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_ + use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_ use psb_prec_type, only : psb_cprec_type implicit none type(psb_cprec_type), intent(inout) :: prec @@ -155,7 +155,7 @@ module psb_prec_mod integer, intent(out) :: info end subroutine psb_cprecseti subroutine psb_cprecsets(prec,what,val,info) - use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_ + use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_ use psb_prec_type, only : psb_cprec_type implicit none type(psb_cprec_type), intent(inout) :: prec @@ -164,7 +164,7 @@ module psb_prec_mod integer, intent(out) :: info end subroutine psb_cprecsets subroutine psb_zprecseti(prec,what,val,info) - use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_ use psb_prec_type, only : psb_zprec_type implicit none type(psb_zprec_type), intent(inout) :: prec @@ -172,7 +172,7 @@ module psb_prec_mod integer, intent(out) :: info end subroutine psb_zprecseti subroutine psb_zprecsetd(prec,what,val,info) - use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_ use psb_prec_type, only : psb_zprec_type implicit none type(psb_zprec_type), intent(inout) :: prec @@ -225,7 +225,7 @@ module psb_prec_mod character(len=1), optional :: trans end subroutine psb_dprc_aply1 subroutine psb_cprc_aply(prec,x,y,desc_data,info,trans,work) - use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_ + use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_ use psb_prec_type, only : psb_cprec_type type(psb_desc_type),intent(in) :: desc_data type(psb_cprec_type), intent(in) :: prec @@ -236,7 +236,7 @@ module psb_prec_mod complex(psb_spk_),intent(inout), optional, target :: work(:) end subroutine psb_cprc_aply subroutine psb_cprc_aply1(prec,x,desc_data,info,trans) - use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_ + use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_ use psb_prec_type, only : psb_cprec_type type(psb_desc_type),intent(in) :: desc_data type(psb_cprec_type), intent(in) :: prec @@ -245,7 +245,7 @@ module psb_prec_mod character(len=1), optional :: trans end subroutine psb_cprc_aply1 subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans,work) - use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_ use psb_prec_type, only : psb_zprec_type type(psb_desc_type),intent(in) :: desc_data type(psb_zprec_type), intent(in) :: prec @@ -256,7 +256,7 @@ module psb_prec_mod complex(psb_dpk_),intent(inout), optional, target :: work(:) end subroutine psb_zprc_aply subroutine psb_zprc_aply1(prec,x,desc_data,info,trans) - use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_ use psb_prec_type, only : psb_zprec_type type(psb_desc_type),intent(in) :: desc_data type(psb_zprec_type), intent(in) :: prec @@ -293,7 +293,7 @@ module psb_prec_mod integer, intent(out) :: info end subroutine psb_dbjac_aply subroutine psb_cbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) - use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_ + use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_ use psb_prec_type, only : psb_cprec_type type(psb_desc_type), intent(in) :: desc_data type(psb_cprec_type), intent(in) :: prec @@ -305,7 +305,7 @@ module psb_prec_mod integer, intent(out) :: info end subroutine psb_cbjac_aply subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) - use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_ use psb_prec_type, only : psb_zprec_type type(psb_desc_type), intent(in) :: desc_data type(psb_zprec_type), intent(in) :: prec @@ -338,19 +338,21 @@ module psb_prec_mod real(psb_dpk_), intent(inout) :: d(:) end subroutine psb_dilu_fct subroutine psb_cilu_fct(a,l,u,d,info,blck) - use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_ + use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, & + & psb_c_csr_sparse_mat, psb_spk_ integer, intent(out) :: info - type(psb_cspmat_type),intent(in) :: a - type(psb_cspmat_type),intent(inout) :: l,u - type(psb_cspmat_type),intent(in), optional, target :: blck + type(psb_c_sparse_mat),intent(in) :: a + type(psb_c_csr_sparse_mat),intent(inout) :: l,u + type(psb_c_sparse_mat),intent(in), optional, target :: blck complex(psb_spk_), intent(inout) :: d(:) end subroutine psb_cilu_fct subroutine psb_zilu_fct(a,l,u,d,info,blck) - use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, & + & psb_z_csr_sparse_mat, psb_dpk_ 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 + type(psb_z_sparse_mat),intent(in) :: a + type(psb_z_csr_sparse_mat),intent(inout) :: l,u + type(psb_z_sparse_mat),intent(in), optional, target :: blck complex(psb_dpk_), intent(inout) :: d(:) end subroutine psb_zilu_fct end interface @@ -375,19 +377,19 @@ module psb_prec_mod character, intent(in) :: upd end subroutine psb_dbjac_bld subroutine psb_cbjac_bld(a,desc_a,p,upd,info) - use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_ + use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_ use psb_prec_type, only : psb_cprec_type integer, intent(out) :: info - type(psb_cspmat_type), intent(in), target :: a + type(psb_c_sparse_mat), intent(in), target :: a type(psb_cprec_type), intent(inout) :: p type(psb_desc_type), intent(in) :: desc_a character, intent(in) :: upd end subroutine psb_cbjac_bld subroutine psb_zbjac_bld(a,desc_a,p,upd,info) - use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_ use psb_prec_type, only : psb_zprec_type integer, intent(out) :: info - type(psb_zspmat_type), intent(in), target :: a + type(psb_z_sparse_mat), intent(in), target :: a type(psb_zprec_type), intent(inout) :: p type(psb_desc_type), intent(in) :: desc_a character, intent(in) :: upd @@ -415,19 +417,19 @@ module psb_prec_mod character, intent(in) :: upd end subroutine psb_ddiagsc_bld subroutine psb_cdiagsc_bld(a,desc_a,p,upd,info) - use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_ + use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_ use psb_prec_type, only : psb_cprec_type integer, intent(out) :: info - type(psb_cspmat_type), intent(in), target :: a + type(psb_c_sparse_mat), intent(in), target :: a type(psb_cprec_type), intent(inout) :: p type(psb_desc_type), intent(in) :: desc_a character, intent(in) :: upd end subroutine psb_cdiagsc_bld subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info) - use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_ use psb_prec_type, only : psb_zprec_type integer, intent(out) :: info - type(psb_zspmat_type), intent(in), target :: a + type(psb_z_sparse_mat), intent(in), target :: a type(psb_zprec_type), intent(inout) :: p type(psb_desc_type), intent(in) :: desc_a character, intent(in) :: upd @@ -460,7 +462,7 @@ module psb_prec_mod integer, intent(out) :: info end subroutine psb_dgprec_aply subroutine psb_cgprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) - use psb_base_mod, only : psb_desc_type, psb_cspmat_type, psb_spk_ + use psb_base_mod, only : psb_desc_type, psb_c_sparse_mat, psb_spk_ use psb_prec_type, only : psb_cprec_type type(psb_desc_type),intent(in) :: desc_data type(psb_cprec_type), intent(in) :: prec @@ -472,7 +474,7 @@ module psb_prec_mod integer, intent(out) :: info end subroutine psb_cgprec_aply subroutine psb_zgprec_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) - use psb_base_mod, only : psb_desc_type, psb_zspmat_type, psb_dpk_ + use psb_base_mod, only : psb_desc_type, psb_z_sparse_mat, psb_dpk_ use psb_prec_type, only : psb_zprec_type type(psb_desc_type),intent(in) :: desc_data type(psb_zprec_type), intent(in) :: prec diff --git a/prec/psb_prec_type.f90 b/prec/psb_prec_type.f90 index c89bec2e..660fa5b0 100644 --- a/prec/psb_prec_type.f90 +++ b/prec/psb_prec_type.f90 @@ -37,11 +37,10 @@ module psb_prec_type ! Reduces size of .mod file. - use psb_base_mod, only : psb_cspmat_type,& - & psb_zspmat_type, psb_dpk_, psb_spk_, psb_long_int_k_,& - & psb_desc_type, psb_sizeof, psb_sp_free, psb_cdfree,& - & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus - use psb_mat_mod, only : psb_s_sparse_mat, psb_d_sparse_mat + use psb_base_mod, only : psb_dpk_, psb_spk_, psb_long_int_k_,& + & psb_desc_type, psb_sizeof, psb_free, psb_cdfree,& + & psb_erractionsave, psb_erractionrestore, psb_error, psb_get_errstatus,& + & psb_s_sparse_mat, psb_d_sparse_mat, psb_c_sparse_mat, psb_z_sparse_mat integer, parameter :: psb_min_prec_=0, psb_noprec_=0, psb_diag_=1, & & psb_bjac_=2, psb_max_prec_=2 @@ -86,7 +85,7 @@ module psb_prec_type end type psb_dprec_type type psb_cprec_type - type(psb_cspmat_type), allocatable :: av(:) + type(psb_c_sparse_mat), allocatable :: av(:) complex(psb_spk_), allocatable :: d(:) type(psb_desc_type) :: desc_data integer, allocatable :: iprcparm(:) @@ -97,7 +96,7 @@ module psb_prec_type type psb_zprec_type - type(psb_zspmat_type), allocatable :: av(:) + type(psb_z_sparse_mat), allocatable :: av(:) complex(psb_dpk_), allocatable :: d(:) type(psb_desc_type) :: desc_data integer, allocatable :: iprcparm(:) @@ -460,12 +459,7 @@ contains 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 + call p%av(i)%free() enddo deallocate(p%av,stat=info) @@ -523,12 +517,7 @@ contains 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 + call p%av(i)%free() enddo deallocate(p%av,stat=info) @@ -591,7 +580,6 @@ contains function psb_dprec_sizeof(prec) result(val) - use psb_mat_mod type(psb_dprec_type), intent(in) :: prec integer(psb_long_int_k_) :: val integer :: i @@ -611,7 +599,6 @@ contains end function psb_dprec_sizeof function psb_sprec_sizeof(prec) result(val) - use psb_mat_mod type(psb_sprec_type), intent(in) :: prec integer(psb_long_int_k_) :: val integer :: i diff --git a/prec/psb_zbjac_aply.f90 b/prec/psb_zbjac_aply.f90 index 6ebbe6d7..74f8e8c0 100644 --- a/prec/psb_zbjac_aply.f90 +++ b/prec/psb_zbjac_aply.f90 @@ -108,26 +108,26 @@ subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info) case('N') call psb_spsm(zone,prec%av(psb_l_pr_),x,zzero,ww,desc_data,info,& - & trans=trans_,unit='L',diag=prec%d,choice=psb_none_,work=aux) + & trans=trans_,side='L',diag=prec%d,choice=psb_none_,work=aux) if(info /=0) goto 9999 call psb_spsm(alpha,prec%av(psb_u_pr_),ww,beta,y,desc_data,info,& - & trans=trans_,unit='U',choice=psb_none_, work=aux) + & trans=trans_,side='U',choice=psb_none_, work=aux) if(info /=0) goto 9999 case('T') call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,ww,desc_data,info,& - & trans=trans_,unit='L',diag=prec%d,choice=psb_none_, work=aux) + & trans=trans_,side='L',diag=prec%d,choice=psb_none_, work=aux) if(info /=0) goto 9999 call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,desc_data,info,& - & trans=trans_,unit='U',choice=psb_none_,work=aux) + & trans=trans_,side='U',choice=psb_none_,work=aux) if(info /=0) goto 9999 case('C') call psb_spsm(zone,prec%av(psb_u_pr_),x,zzero,ww,desc_data,info,& - & trans=trans_,unit='L',diag=conjg(prec%d),choice=psb_none_, work=aux) + & trans=trans_,side='L',diag=conjg(prec%d),choice=psb_none_, work=aux) if(info /=0) goto 9999 call psb_spsm(alpha,prec%av(psb_l_pr_),ww,beta,y,desc_data,info,& - & trans=trans_,unit='U',choice=psb_none_,work=aux) + & trans=trans_,side='U',choice=psb_none_,work=aux) if(info /=0) goto 9999 end select diff --git a/prec/psb_zbjac_bld.f90 b/prec/psb_zbjac_bld.f90 index d714d70a..933c90f3 100644 --- a/prec/psb_zbjac_bld.f90 +++ b/prec/psb_zbjac_bld.f90 @@ -37,7 +37,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info) ! .. Scalar Arguments .. integer, intent(out) :: info ! .. array Arguments .. - type(psb_zspmat_type), intent(in), target :: a + type(psb_z_sparse_mat), intent(in), target :: a type(psb_zprec_type), intent(inout) :: p type(psb_desc_type), intent(in) :: desc_a character, intent(in) :: upd @@ -46,7 +46,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info) integer :: i, m integer :: int_err(5) character :: trans, unitd - type(psb_zspmat_type) :: atmp + type(psb_z_csr_sparse_mat), allocatable :: lf, uf real(psb_dpk_) :: t1,t2,t3,t4,t5,t6, t7, t8 integer nztota, err_act, n_row, nrow_a,n_col, nhalo integer :: ictxt,np,me @@ -61,7 +61,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info) ictxt=psb_cd_get_context(desc_a) call psb_info(ictxt, me, np) - m = a%m + m = a%get_nrows() if (m < 0) then info = 10 int_err(1) = 1 @@ -71,7 +71,6 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info) endif trans = 'N' unitd = 'U' - call psb_nullify_sp(atmp) call psb_cdcpy(desc_a,p%desc_data,info) if(info /= 0) then @@ -89,12 +88,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info) if (allocated(p%av)) then if (size(p%av) < psb_bp_ilu_avsz) 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 + call p%av(i)%free() enddo deallocate(p%av,stat=info) endif @@ -108,17 +102,16 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info) endif nrow_a = psb_cd_get_local_rows(desc_a) - nztota = psb_sp_get_nnzeros(a) + nztota = a%get_nzeros() 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(psb_l_pr_)%m = n_row - p%av(psb_l_pr_)%k = n_row - p%av(psb_u_pr_)%m = n_row - p%av(psb_u_pr_)%k = n_row - call psb_sp_all(n_row,n_row,p%av(psb_l_pr_),nztota,info) - if (info == 0) call psb_sp_all(n_row,n_row,p%av(psb_u_pr_),nztota,info) + + allocate(lf,uf,stat=info) + if (info == 0) call lf%allocate(n_row,n_row,nztota) + if (info == 0) call uf%allocate(n_row,n_row,nztota) + if(info/=0) then info=4010 ch_err='psb_sp_all' @@ -140,26 +133,23 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info) endif t3 = psb_wtime() - ! This is where we have mo renumbering, thus no need - ! for ATMP - - call psb_ilu_fct(a,p%av(psb_l_pr_),p%av(psb_u_pr_),p%d,info) - if(info/=0) then + ! This is where we have no renumbering, thus no need + call psb_ilu_fct(a,lf,uf,p%d,info) + + if(info==0) then + call p%av(psb_l_pr_)%mv_from(lf) + call p%av(psb_u_pr_)%mv_from(uf) + call p%av(psb_l_pr_)%set_asb() + call p%av(psb_u_pr_)%set_asb() + call p%av(psb_l_pr_)%trim() + call p%av(psb_u_pr_)%trim() + else info=4010 ch_err='psb_ilu_fct' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - if (psb_sp_getifld(psb_upd_,p%av(psb_u_pr_),info) /= psb_upd_perm_) then - call psb_sp_trim(p%av(psb_u_pr_),info) - endif - - if (psb_sp_getifld(psb_upd_,p%av(psb_l_pr_),info) /= psb_upd_perm_) then - call psb_sp_trim(p%av(psb_l_pr_),info) - endif - - case(psb_f_none_) info=4010 ch_err='Inconsistent prec psb_f_none_' diff --git a/prec/psb_zdiagsc_bld.f90 b/prec/psb_zdiagsc_bld.f90 index 6be38d78..745845d4 100644 --- a/prec/psb_zdiagsc_bld.f90 +++ b/prec/psb_zdiagsc_bld.f90 @@ -35,7 +35,7 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info) use psb_prec_mod, psb_protect_name => psb_zdiagsc_bld Implicit None - type(psb_zspmat_type), intent(in), target :: a + type(psb_z_sparse_mat), intent(in), target :: a type(psb_desc_type), intent(in) :: desc_a type(psb_zprec_type),intent(inout) :: p character, intent(in) :: upd @@ -76,7 +76,7 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info) ! ! Retrieve the diagonal entries of the matrix A ! - call psb_sp_getdiag(a,p%d,info) + call a%get_diag(p%d,info) if(info /= 0) then info=4010 ch_err='psb_sp_getdiag' @@ -105,19 +105,6 @@ subroutine psb_zdiagsc_bld(a,desc_a,p,upd,info) endif end do - if (a%pl(1) /= 0) then - ! - ! Apply the same row permutation as in the sparse matrix A - ! - call psb_gelp('n',a%pl,p%d,info) - if(info /= 0) then - info=4010 - ch_err='psb_zgelp' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - endif - call psb_erractionrestore(err_act) return diff --git a/prec/psb_zilu_fct.f90 b/prec/psb_zilu_fct.f90 index 90e15b5d..95503d40 100644 --- a/prec/psb_zilu_fct.f90 +++ b/prec/psb_zilu_fct.f90 @@ -41,15 +41,15 @@ subroutine psb_zilu_fct(a,l,u,d,info,blck) ! .. 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 + type(psb_z_sparse_mat),intent(in) :: a + type(psb_z_csr_sparse_mat),intent(inout) :: l,u + type(psb_z_sparse_mat),intent(in), optional, target :: blck complex(psb_dpk_), intent(inout) :: d(:) ! .. Local Scalars .. integer :: l1, l2,m,err_act - type(psb_zspmat_type), pointer :: blck_ + type(psb_z_sparse_mat), pointer :: blck_ character(len=20) :: name, ch_err - name='psb_zcsrlu' + name='psb_ilu_fct' info = 0 call psb_erractionsave(err_act) ! .. Executable Statements .. @@ -64,41 +64,34 @@ subroutine psb_zilu_fct(a,l,u,d,info,blck) 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 /= 0) then - info=4010 - ch_err='psb_sp_all' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if + call blck_%csall(0,0,info,1) - 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) + call psb_zilu_fctint(m,a%get_nrows(),a,blck_%get_nrows(),blck_,& + & d,l%val,l%ja,l%irp,u%val,u%ja,u%irp,l1,l2,info) if(info /= 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 + + call l%set_triangle() + call l%set_lower() + call l%set_unit() + call u%set_triangle() + call u%set_upper() + call u%set_unit() + call l%set_nrows(m) + call l%set_ncols(m) + call u%set_nrows(m) + call u%set_ncols(m) + if (present(blck)) then blck_ => null() else - call psb_sp_free(blck_,info) + call blck_%free() if(info /= 0) then info=4010 ch_err='psb_sp_free' @@ -124,15 +117,15 @@ contains & d,laspk,lia1,lia2,uaspk,uia1,uia2,l1,l2,info) implicit none - type(psb_zspmat_type) :: a,b + type(psb_z_sparse_mat) :: a,b integer :: m,ma,mb,l1,l2,info integer, dimension(:) :: lia1,lia2,uia1,uia2 complex(psb_dpk_), dimension(:) :: laspk,uaspk,d - integer :: i,j,k,l,low1,low2,kk,jj,ll, irb, ktrw,err_act + integer :: i,j,k,l,low1,low2,kk,jj,ll, irb, ktrw,err_act, nz complex(psb_dpk_) :: dia,temp - integer, parameter :: nrb=16 - type(psb_zspmat_type) :: trw + integer, parameter :: nrb=60 + type(psb_z_coo_sparse_mat) :: trw integer :: int_err(5) character(len=20) :: name, ch_err @@ -140,11 +133,7 @@ contains if(psb_get_errstatus() /= 0) return info=0 call psb_erractionsave(err_act) - call psb_nullify_sp(trw) - trw%m=0 - trw%k=0 - - call psb_sp_all(trw,1,info) + call trw%allocate(0,0,info) if(info /= 0) then info=4010 ch_err='psb_sp_all' @@ -162,61 +151,37 @@ contains 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 /= 0) then - info=4010 - ch_err='psb_sp_getblk' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - ktrw=1 + if ((mod(i,nrb) == 1).or.(nrb==1)) then + irb = min(ma-i+1,nrb) + call a%a%csget(i,i+irb-1,trw,info) + if(info /= 0) then + info=4010 + ch_err='a%csget' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 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 - + nz = trw%get_nzeros() + ktrw=1 end if - + + do + if (ktrw > nz ) exit + if (trw%ia(ktrw) > i) exit + k = trw%ja(ktrw) + if ((k < i).and.(k >= 1)) then + l1 = l1 + 1 + laspk(l1) = trw%val(ktrw) + lia1(l1) = k + else if (k == i) then + d(i) = trw%val(ktrw) + else if ((k > i).and.(k <= m)) then + l2 = l2 + 1 + uaspk(l2) = trw%val(ktrw) + uia1(l2) = k + end if + ktrw = ktrw + 1 + enddo !!$ lia2(i+1) = l1 + 1 @@ -304,61 +269,36 @@ contains 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 == 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 == 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 /= 0) then - info=4010 - ch_err='psb_sp_getblk' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - ktrw=1 + if ((mod(i,nrb) == 1).or.(nrb==1)) then + irb = min(ma-i+1,nrb) + call b%a%csget(i-ma,i-ma+irb-1,trw,info) + nz = trw%get_nzeros() + if(info /= 0) then + info=4010 + ch_err='a%csget' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 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 + ktrw=1 + end if + + do + if (ktrw > nz ) exit + if (trw%ia(ktrw) > i) exit + k = trw%ja(ktrw) + if ((k < i).and.(k >= 1)) then + l1 = l1 + 1 + laspk(l1) = trw%val(ktrw) + lia1(l1) = k + else if (k == i) then + d(i) = trw%val(ktrw) + else if ((k > i).and.(k <= m)) then + l2 = l2 + 1 + uaspk(l2) = trw%val(ktrw) + uia1(l2) = k + end if + ktrw = ktrw + 1 + enddo lia2(i+1) = l1 + 1 @@ -440,13 +380,7 @@ contains enddo enddo - call psb_sp_free(trw,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 + call trw%free() call psb_erractionrestore(err_act) return diff --git a/prec/psb_zprecbld.f90 b/prec/psb_zprecbld.f90 index 8dfac0c7..890117c3 100644 --- a/prec/psb_zprecbld.f90 +++ b/prec/psb_zprecbld.f90 @@ -35,7 +35,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd) use psb_prec_mod, psb_protect_name => psb_zprecbld Implicit None - type(psb_zspmat_type), intent(in), target :: a + type(psb_z_sparse_mat), intent(in), target :: a type(psb_desc_type), intent(in), target :: desc_a type(psb_zprec_type),intent(inout) :: p integer, intent(out) :: info diff --git a/test/fileread/cf_sample.f90 b/test/fileread/cf_sample.f90 index f9ae83c2..a9f26390 100644 --- a/test/fileread/cf_sample.f90 +++ b/test/fileread/cf_sample.f90 @@ -41,7 +41,7 @@ program cf_sample character(len=40) :: kmethd, ptype, mtrx_file, rhs_file ! sparse matrices - type(psb_cspmat_type) :: a, aux_a + type(psb_c_sparse_mat) :: a, aux_a ! preconditioner data type(psb_cprec_type) :: prec @@ -129,7 +129,7 @@ program cf_sample call psb_abort(ictxt) end if - m_problem = aux_a%m + m_problem = aux_a%get_nrows() call psb_bcast(ictxt,m_problem) ! At this point aux_b may still be unallocated @@ -179,7 +179,8 @@ program cf_sample write(*,'("Partition type: graph")') write(*,'(" ")') ! write(0,'("Build type: graph")') - call build_mtpart(aux_a%m,aux_a%fida,aux_a%ia1,aux_a%ia2,np) + call build_mtpart(aux_a,np) + endif call psb_barrier(ictxt) call distr_mtpart(psb_root_,ictxt) diff --git a/test/fileread/zf_sample.f90 b/test/fileread/zf_sample.f90 index 13522aba..f957aa2c 100644 --- a/test/fileread/zf_sample.f90 +++ b/test/fileread/zf_sample.f90 @@ -41,7 +41,7 @@ program zf_sample character(len=40) :: kmethd, ptype, mtrx_file, rhs_file ! sparse matrices - type(psb_zspmat_type) :: a, aux_a + type(psb_z_sparse_mat) :: a, aux_a ! preconditioner data type(psb_zprec_type) :: prec @@ -129,7 +129,7 @@ program zf_sample call psb_abort(ictxt) end if - m_problem = aux_a%m + m_problem = aux_a%get_nrows() call psb_bcast(ictxt,m_problem) ! At this point aux_b may still be unallocated @@ -179,7 +179,8 @@ program zf_sample write(*,'("Partition type: graph")') write(*,'(" ")') ! write(0,'("Build type: graph")') - call build_mtpart(aux_a%m,aux_a%fida,aux_a%ia1,aux_a%ia2,np) + call build_mtpart(aux_a,np) + endif call psb_barrier(ictxt) call distr_mtpart(psb_root_,ictxt) @@ -230,14 +231,12 @@ program zf_sample write(*,'(" ")') end if - call psb_set_debug_level(0) iparm = 0 call psb_barrier(ictxt) t1 = psb_wtime() call psb_krylov(kmethd,a,prec,b_col,x_col,eps,desc_a,info,& & itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst) call psb_barrier(ictxt) - call psb_set_debug_level(0) t2 = psb_wtime() - t1 call psb_amx(ictxt,t2) call psb_geaxpby(zone,b_col,zzero,r_col,desc_a,info) diff --git a/test/util/zhb2mm.f90 b/test/util/zhb2mm.f90 index 69794545..990ed257 100644 --- a/test/util/zhb2mm.f90 +++ b/test/util/zhb2mm.f90 @@ -37,7 +37,7 @@ program zhb2mm use psb_base_mod use psb_util_mod - type(psb_zspmat_type) :: a + type(psb_z_sparse_mat) :: a integer :: info character(len=72) :: mtitle diff --git a/test/util/zmm2hb.f90 b/test/util/zmm2hb.f90 index cc45ad92..f211d06e 100644 --- a/test/util/zmm2hb.f90 +++ b/test/util/zmm2hb.f90 @@ -37,7 +37,7 @@ program zmm2hb use psb_base_mod use psb_util_mod - type(psb_zspmat_type) :: a + type(psb_z_sparse_mat) :: a integer info diff --git a/util/psb_hbio_mod.f90 b/util/psb_hbio_mod.f90 index d0f5dfbb..df165879 100644 --- a/util/psb_hbio_mod.f90 +++ b/util/psb_hbio_mod.f90 @@ -619,7 +619,7 @@ contains subroutine chb_read(a, iret, iunit, filename,b,g,x,mtitle) use psb_base_mod implicit none - type(psb_cspmat_type), intent(out) :: a + type(psb_c_sparse_mat), intent(out) :: a integer, intent(out) :: iret integer, optional, intent(in) :: iunit character(len=*), optional, intent(in) :: filename @@ -631,6 +631,8 @@ contains character indfmt*16,ptrfmt*16,rhsfmt*20,valfmt*20 integer :: indcrd, ptrcrd, totcrd,& & valcrd, rhscrd, nrow, ncol, nnzero, neltvl, nrhs, nrhsix + type(psb_c_csr_sparse_mat) :: acsr + type(psb_c_coo_sparse_mat) :: acoo integer :: ircode, i,nzr,infile, info character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' character(len=*), parameter :: fmt11='(a3,11x,2i14)' @@ -660,28 +662,26 @@ contains read (infile,fmt=fmt10) mtitle_,key,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix - - call psb_sp_all(a,nnzero,nrow+1,nnzero,ircode) + + call acsr%allocate(nrow,ncol,nnzero) if (ircode /= 0 ) then write(0,*) 'Memory allocation failed' goto 993 end if + if (present(mtitle)) mtitle=mtitle_ - - a%m = nrow - a%k = ncol - a%fida = 'CSR' - a%descra='G' - + if (psb_tolower(type(1:1)) == 'r') then if (psb_tolower(type(2:2)) == 'u') then - read (infile,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1) - read (infile,fmt=indfmt) (a%ia1(i),i=1,nnzero) - if (valcrd > 0) read (infile,fmt=valfmt) (a%aspk(i),i=1,nnzero) - + read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1) + read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero) + if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero) + + call a%mv_from(acsr) + if (present(b)) then if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then call psb_realloc(nrow,1,b,info) @@ -706,9 +706,9 @@ contains ! we are generally working with non-symmetric matrices, so ! we de-symmetrize what we are about to read - read (infile,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1) - read (infile,fmt=indfmt) (a%ia1(i),i=1,nnzero) - if (valcrd > 0) read (infile,fmt=valfmt) (a%aspk(i),i=1,nnzero) + read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1) + read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero) + if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero) if (present(b)) then @@ -730,23 +730,72 @@ contains endif endif - call psb_spcnv(a,ircode,afmt='csr') - if (ircode /= 0) goto 993 + + call acoo%mv_from_fmt(acsr,info) + call acoo%reallocate(2*nnzero) + ! A is now in COO format + nzr = nnzero + do i=1,nnzero + if (acoo%ia(i) /= acoo%ja(i)) then + nzr = nzr + 1 + acoo%val(nzr) = acoo%val(i) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) + end if + end do + call acoo%set_nzeros(nzr) + call acoo%fix(ircode) + if (ircode==0) call a%mv_from(acoo) + if (ircode==0) call a%cscnv(ircode,type='csr') + if (ircode/=0) goto 993 + + else if (psb_tolower(type(2:2)) == 'h') then - call psb_sp_reall(a,2*nnzero,ircode) + ! we are generally working with non-symmetric matrices, so + ! we de-symmetrize what we are about to read + + read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1) + read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero) + if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero) + + + if (present(b)) then + if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,b,info) + read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) + endif + endif + if (present(g)) then + if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,g,info) + read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) + endif + endif + if (present(x)) then + if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,x,info) + read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) + endif + endif + + + call acoo%mv_from_fmt(acsr,info) + call acoo%reallocate(2*nnzero) ! A is now in COO format nzr = nnzero do i=1,nnzero - if (a%ia1(i) /= a%ia2(i)) then + if (acoo%ia(i) /= acoo%ja(i)) then nzr = nzr + 1 - a%aspk(nzr) = a%aspk(i) - a%ia1(nzr) = a%ia2(i) - a%ia2(nzr) = a%ia1(i) + acoo%val(nzr) = conjg(acoo%val(i)) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) end if end do - a%infoa(psb_nnz_) = nzr - call psb_spcnv(a,ircode,afmt='csr') - if (ircode /= 0) goto 993 + call acoo%set_nzeros(nzr) + call acoo%fix(ircode) + if (ircode==0) call a%mv_from(acoo) + if (ircode==0) call a%cscnv(ircode,type='csr') + if (ircode/=0) goto 993 else write(0,*) 'read_matrix: matrix type not yet supported' @@ -772,11 +821,10 @@ contains return end subroutine chb_read - subroutine chb_write(a,iret,iunit,filename,key,rhs,g,x,mtitle) use psb_base_mod implicit none - type(psb_cspmat_type), intent(in) :: a + type(psb_c_sparse_mat), intent(in) :: a integer, intent(out) :: iret character(len=*), optional, intent(in) :: mtitle integer, optional, intent(in) :: iunit @@ -799,7 +847,7 @@ contains character :: rhstype*3,type*3 integer :: i,indcrd,ptrcrd,rhscrd,totcrd,valcrd,& - & nrow,ncol,nnzero, neltvl,nrhs,nrhsix + & nrow,ncol,nnzero, neltvl, nrhs, nrhsix iret = 0 @@ -832,12 +880,17 @@ contains else key_ = 'PSBMAT00' endif - if (psb_toupper(a%fida) == 'CSR') then + + + select type(aa=>a%a) + type is (psb_c_csr_sparse_mat) + + nrow = aa%get_nrows() + ncol = aa%get_ncols() + nnzero = aa%get_nzeros() - nrow = a%m - ncol = a%k - nnzero = a%ia2(nrow+1)-1 neltvl = 0 + ptrcrd = (nrow+1)/jptr if (mod(nrow+1,jptr) > 0) ptrcrd = ptrcrd + 1 indcrd = nnzero/jind @@ -856,34 +909,36 @@ contains rhstype(1:1) = 'F' else rhscrd = 0 - nrhs = 0 + nrhs = 0 end if totcrd = ptrcrd + indcrd + valcrd + rhscrd - nrhsix = nrhs * nrow + + nrhsix = nrhs*nrow + if (present(g)) then rhstype(2:2) = 'G' end if if (present(x)) then rhstype(3:3) = 'X' end if - - type='CUA' + type = 'RUA' write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix - write (iout,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1) - write (iout,fmt=indfmt) (a%ia1(i),i=1,nnzero) - if (valcrd > 0) write (iout,fmt=valfmt) (a%aspk(i),i=1,nnzero) + write (iout,fmt=ptrfmt) (aa%irp(i),i=1,nrow+1) + write (iout,fmt=indfmt) (aa%ja(i),i=1,nnzero) + if (valcrd > 0) write (iout,fmt=valfmt) (aa%val(i),i=1,nnzero) if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow) if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow) if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow) - else - write(0,*) 'format: ',a%fida,' not yet implemented' + class default - endif + write(0,*) 'format: ',a%get_fmt(),' not yet implemented' + + end select if (iout /= 6) close(iout) @@ -897,10 +952,11 @@ contains end subroutine chb_write + subroutine zhb_read(a, iret, iunit, filename,b,g,x,mtitle) use psb_base_mod implicit none - type(psb_zspmat_type), intent(out) :: a + type(psb_z_sparse_mat), intent(out) :: a integer, intent(out) :: iret integer, optional, intent(in) :: iunit character(len=*), optional, intent(in) :: filename @@ -912,6 +968,8 @@ contains character indfmt*16,ptrfmt*16,rhsfmt*20,valfmt*20 integer :: indcrd, ptrcrd, totcrd,& & valcrd, rhscrd, nrow, ncol, nnzero, neltvl, nrhs, nrhsix + type(psb_z_csr_sparse_mat) :: acsr + type(psb_z_coo_sparse_mat) :: acoo integer :: ircode, i,nzr,infile, info character(len=*), parameter :: fmt10='(a72,a8,/,5i14,/,a3,11x,4i14,/,2a16,2a20)' character(len=*), parameter :: fmt11='(a3,11x,2i14)' @@ -941,28 +999,26 @@ contains read (infile,fmt=fmt10) mtitle_,key,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt if (rhscrd > 0) read(infile,fmt=fmt11)rhstype,nrhs,nrhsix - - call psb_sp_all(a,nnzero,nrow+1,nnzero,ircode) + + call acsr%allocate(nrow,ncol,nnzero) if (ircode /= 0 ) then write(0,*) 'Memory allocation failed' goto 993 end if + if (present(mtitle)) mtitle=mtitle_ - - a%m = nrow - a%k = ncol - a%fida = 'CSR' - a%descra='G' - + if (psb_tolower(type(1:1)) == 'r') then if (psb_tolower(type(2:2)) == 'u') then - read (infile,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1) - read (infile,fmt=indfmt) (a%ia1(i),i=1,nnzero) - if (valcrd > 0) read (infile,fmt=valfmt) (a%aspk(i),i=1,nnzero) - + read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1) + read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero) + if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero) + + call a%mv_from(acsr) + if (present(b)) then if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then call psb_realloc(nrow,1,b,info) @@ -987,9 +1043,9 @@ contains ! we are generally working with non-symmetric matrices, so ! we de-symmetrize what we are about to read - read (infile,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1) - read (infile,fmt=indfmt) (a%ia1(i),i=1,nnzero) - if (valcrd > 0) read (infile,fmt=valfmt) (a%aspk(i),i=1,nnzero) + read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1) + read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero) + if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero) if (present(b)) then @@ -1011,23 +1067,72 @@ contains endif endif - call psb_spcnv(a,ircode,afmt='csr') - if (ircode /= 0) goto 993 + + call acoo%mv_from_fmt(acsr,info) + call acoo%reallocate(2*nnzero) + ! A is now in COO format + nzr = nnzero + do i=1,nnzero + if (acoo%ia(i) /= acoo%ja(i)) then + nzr = nzr + 1 + acoo%val(nzr) = acoo%val(i) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) + end if + end do + call acoo%set_nzeros(nzr) + call acoo%fix(ircode) + if (ircode==0) call a%mv_from(acoo) + if (ircode==0) call a%cscnv(ircode,type='csr') + if (ircode/=0) goto 993 + + else if (psb_tolower(type(2:2)) == 'h') then + + ! we are generally working with non-symmetric matrices, so + ! we de-symmetrize what we are about to read + + read (infile,fmt=ptrfmt) (acsr%irp(i),i=1,nrow+1) + read (infile,fmt=indfmt) (acsr%ja(i),i=1,nnzero) + if (valcrd > 0) read (infile,fmt=valfmt) (acsr%val(i),i=1,nnzero) + + + if (present(b)) then + if ((psb_toupper(rhstype(1:1)) == 'F').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,b,info) + read (infile,fmt=rhsfmt) (b(i,1),i=1,nrow) + endif + endif + if (present(g)) then + if ((psb_toupper(rhstype(2:2)) == 'G').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,g,info) + read (infile,fmt=rhsfmt) (g(i,1),i=1,nrow) + endif + endif + if (present(x)) then + if ((psb_toupper(rhstype(3:3)) == 'X').and.(rhscrd > 0)) then + call psb_realloc(nrow,1,x,info) + read (infile,fmt=rhsfmt) (x(i,1),i=1,nrow) + endif + endif - call psb_sp_reall(a,2*nnzero,ircode) + + call acoo%mv_from_fmt(acsr,info) + call acoo%reallocate(2*nnzero) ! A is now in COO format nzr = nnzero do i=1,nnzero - if (a%ia1(i) /= a%ia2(i)) then + if (acoo%ia(i) /= acoo%ja(i)) then nzr = nzr + 1 - a%aspk(nzr) = a%aspk(i) - a%ia1(nzr) = a%ia2(i) - a%ia2(nzr) = a%ia1(i) + acoo%val(nzr) = conjg(acoo%val(i)) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) end if end do - a%infoa(psb_nnz_) = nzr - call psb_spcnv(a,ircode,afmt='csr') - if (ircode /= 0) goto 993 + call acoo%set_nzeros(nzr) + call acoo%fix(ircode) + if (ircode==0) call a%mv_from(acoo) + if (ircode==0) call a%cscnv(ircode,type='csr') + if (ircode/=0) goto 993 else write(0,*) 'read_matrix: matrix type not yet supported' @@ -1053,11 +1158,10 @@ contains return end subroutine zhb_read - subroutine zhb_write(a,iret,iunit,filename,key,rhs,g,x,mtitle) use psb_base_mod implicit none - type(psb_zspmat_type), intent(in) :: a + type(psb_z_sparse_mat), intent(in) :: a integer, intent(out) :: iret character(len=*), optional, intent(in) :: mtitle integer, optional, intent(in) :: iunit @@ -1080,7 +1184,7 @@ contains character :: rhstype*3,type*3 integer :: i,indcrd,ptrcrd,rhscrd,totcrd,valcrd,& - & nrow,ncol,nnzero, neltvl,nrhs,nrhsix + & nrow,ncol,nnzero, neltvl, nrhs, nrhsix iret = 0 @@ -1113,12 +1217,17 @@ contains else key_ = 'PSBMAT00' endif - if (psb_toupper(a%fida) == 'CSR') then + + + select type(aa=>a%a) + type is (psb_z_csr_sparse_mat) + + nrow = aa%get_nrows() + ncol = aa%get_ncols() + nnzero = aa%get_nzeros() - nrow = a%m - ncol = a%k - nnzero = a%ia2(nrow+1)-1 neltvl = 0 + ptrcrd = (nrow+1)/jptr if (mod(nrow+1,jptr) > 0) ptrcrd = ptrcrd + 1 indcrd = nnzero/jind @@ -1137,10 +1246,11 @@ contains rhstype(1:1) = 'F' else rhscrd = 0 - nrhs = 0 + nrhs = 0 end if totcrd = ptrcrd + indcrd + valcrd + rhscrd - nrhsix = nrhs * nrow + + nrhsix = nrhs*nrow if (present(g)) then rhstype(2:2) = 'G' @@ -1148,24 +1258,24 @@ contains if (present(x)) then rhstype(3:3) = 'X' end if - type='CUA' + type = 'RUA' write (iout,fmt=fmt10) mtitle_,key_,totcrd,ptrcrd,indcrd,valcrd,rhscrd,& & type,nrow,ncol,nnzero,neltvl,ptrfmt,indfmt,valfmt,rhsfmt if (rhscrd > 0) write (iout,fmt=fmt11) rhstype,nrhs,nrhsix - write (iout,fmt=ptrfmt) (a%ia2(i),i=1,nrow+1) - write (iout,fmt=indfmt) (a%ia1(i),i=1,nnzero) - if (valcrd > 0) write (iout,fmt=valfmt) (a%aspk(i),i=1,nnzero) + write (iout,fmt=ptrfmt) (aa%irp(i),i=1,nrow+1) + write (iout,fmt=indfmt) (aa%ja(i),i=1,nnzero) + if (valcrd > 0) write (iout,fmt=valfmt) (aa%val(i),i=1,nnzero) if (rhscrd > 0) write (iout,fmt=rhsfmt) (rhs(i),i=1,nrow) if (present(g).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (g(i),i=1,nrow) if (present(x).and.(rhscrd>0)) write (iout,fmt=rhsfmt) (x(i),i=1,nrow) - else + class default - write(0,*) 'format: ',a%fida,' not yet implemented' + write(0,*) 'format: ',a%get_fmt(),' not yet implemented' - endif + end select if (iout /= 6) close(iout) @@ -1178,5 +1288,4 @@ contains return end subroutine zhb_write - end module psb_hbio_mod diff --git a/util/psb_mat_dist_mod.f90 b/util/psb_mat_dist_mod.f90 index 308f263f..68ff8024 100644 --- a/util/psb_mat_dist_mod.f90 +++ b/util/psb_mat_dist_mod.f90 @@ -927,6 +927,7 @@ contains end subroutine dmatdist + subroutine cmatdist(a_glob, a, ictxt, desc_a,& & b_glob, b, info, parts, v, inroot,fmt) ! @@ -986,14 +987,15 @@ contains ! on exit : unchanged. ! use psb_base_mod + use psb_mat_mod implicit none ! parameters - type(psb_cspmat_type) :: a_glob - complex(psb_spk_) :: b_glob(:) + type(psb_c_sparse_mat) :: a_glob + complex(psb_spk_) :: b_glob(:) integer :: ictxt - type(psb_cspmat_type) :: a - complex(psb_spk_), allocatable :: b(:) + type(psb_c_sparse_mat) :: a + complex(psb_spk_), allocatable :: b(:) type(psb_desc_type) :: desc_a integer, intent(out) :: info integer, optional :: inroot @@ -1037,22 +1039,15 @@ contains end if call psb_info(ictxt, iam, np) if (iam == root) then - ! extract information from a_glob - if (a_glob%fida /= 'CSR') then - info=135 - ch_err='CSR' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - endif - nrow = a_glob%m - ncol = a_glob%k + nrow = a_glob%get_nrows() + ncol = a_glob%get_ncols() if (nrow /= ncol) then write(0,*) 'a rectangular matrix ? ',nrow,ncol info=-1 call psb_errpush(info,name) goto 9999 endif - nnzero = size(a_glob%aspk) + nnzero = a_glob%get_nzeros() nrhs = 1 endif @@ -1157,7 +1152,7 @@ contains ll = 0 do i= i_count, j_count-1 - call psb_sp_getrow(i,a_glob,nz,& + call a_glob%csget(i,i,nz,& & irow,icol,val,info,nzin=ll,append=.true.) if (info /= 0) then if (nz >min(size(irow(ll+1:)),size(icol(ll+1:)),size(val(ll+1:)))) then @@ -1245,7 +1240,7 @@ contains ll = 0 do i= i_count, i_count - call psb_sp_getrow(i,a_glob,nz,& + call a_glob%csget(i,i,nz,& & irow,icol,val,info,nzin=ll,append=.true.) if (info /= 0) then if (nz >min(size(irow(ll+1:)),size(icol(ll+1:)),size(val(ll+1:)))) then @@ -1376,6 +1371,7 @@ contains return end subroutine cmatdist + subroutine zmatdist(a_glob, a, ictxt, desc_a,& & b_glob, b, info, parts, v, inroot,fmt) @@ -1436,14 +1432,15 @@ contains ! on exit : unchanged. ! use psb_base_mod + use psb_mat_mod implicit none ! parameters - type(psb_zspmat_type) :: a_glob - complex(psb_dpk_) :: b_glob(:) + type(psb_z_sparse_mat) :: a_glob + complex(psb_dpk_) :: b_glob(:) integer :: ictxt - type(psb_zspmat_type) :: a - complex(psb_dpk_), allocatable :: b(:) + type(psb_z_sparse_mat) :: a + complex(psb_dpk_), allocatable :: b(:) type(psb_desc_type) :: desc_a integer, intent(out) :: info integer, optional :: inroot @@ -1487,22 +1484,15 @@ contains end if call psb_info(ictxt, iam, np) if (iam == root) then - ! extract information from a_glob - if (a_glob%fida /= 'CSR') then - info=135 - ch_err='CSR' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - endif - nrow = a_glob%m - ncol = a_glob%k + nrow = a_glob%get_nrows() + ncol = a_glob%get_ncols() if (nrow /= ncol) then write(0,*) 'a rectangular matrix ? ',nrow,ncol info=-1 call psb_errpush(info,name) goto 9999 endif - nnzero = size(a_glob%aspk) + nnzero = a_glob%get_nzeros() nrhs = 1 endif @@ -1607,7 +1597,7 @@ contains ll = 0 do i= i_count, j_count-1 - call psb_sp_getrow(i,a_glob,nz,& + call a_glob%csget(i,i,nz,& & irow,icol,val,info,nzin=ll,append=.true.) if (info /= 0) then if (nz >min(size(irow(ll+1:)),size(icol(ll+1:)),size(val(ll+1:)))) then @@ -1695,7 +1685,7 @@ contains ll = 0 do i= i_count, i_count - call psb_sp_getrow(i,a_glob,nz,& + call a_glob%csget(i,i,nz,& & irow,icol,val,info,nzin=ll,append=.true.) if (info /= 0) then if (nz >min(size(irow(ll+1:)),size(icol(ll+1:)),size(val(ll+1:)))) then @@ -1827,5 +1817,4 @@ contains end subroutine zmatdist - end module psb_mat_dist_mod diff --git a/util/psb_metispart_mod.F90 b/util/psb_metispart_mod.F90 index 4a3f38ab..81b12c5e 100644 --- a/util/psb_metispart_mod.F90 +++ b/util/psb_metispart_mod.F90 @@ -60,7 +60,7 @@ module psb_metispart_mod integer, allocatable, save :: graph_vect(:) interface build_mtpart - module procedure build_mtpart, d_mat_build_mtpart, s_mat_build_mtpart + module procedure build_mtpart, d_mat_build_mtpart, s_mat_build_mtpart, z_mat_build_mtpart, c_mat_build_mtpart end interface contains @@ -167,6 +167,40 @@ contains end subroutine s_mat_build_mtpart + + subroutine z_mat_build_mtpart(a,nparts) + use psb_base_mod + type(psb_z_sparse_mat), intent(in) :: a + integer :: nparts + + + select type (aa=>a%a) + type is (psb_z_csr_sparse_mat) + call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts) + class default + write(0,*) 'Sorry, right now we only take CSR input!' + call psb_abort(ictxt) + end select + + end subroutine z_mat_build_mtpart + + + subroutine c_mat_build_mtpart(a,nparts) + use psb_base_mod + type(psb_c_sparse_mat), intent(in) :: a + integer :: nparts + + + select type (aa=>a%a) + type is (psb_c_csr_sparse_mat) + call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts) + class default + write(0,*) 'Sorry, right now we only take CSR input!' + call psb_abort(ictxt) + end select + + end subroutine c_mat_build_mtpart + subroutine build_mtpart(n,fida,ia1,ia2,nparts) use psb_base_mod diff --git a/util/psb_mmio_mod.f90 b/util/psb_mmio_mod.f90 index 7b356e80..9fa7a768 100644 --- a/util/psb_mmio_mod.f90 +++ b/util/psb_mmio_mod.f90 @@ -650,7 +650,7 @@ contains subroutine cmm_mat_read(a, info, iunit, filename) use psb_base_mod implicit none - type(psb_cspmat_type), intent(out) :: a + type(psb_c_sparse_mat), intent(out) :: a integer, intent(out) :: info integer, optional, intent(in) :: iunit character(len=*), optional, intent(in) :: filename @@ -658,8 +658,8 @@ contains character(1024) :: line integer :: nrow, ncol, nnzero integer :: ircode, i,nzr,infile - real(psb_spk_) :: are, aim - + type(psb_c_coo_sparse_mat), allocatable :: acoo + real(psb_spk_) :: are, aim info = 0 if (present(filename)) then @@ -694,73 +694,76 @@ contains if (line(1:1) /= '%') exit end do read(line,fmt=*) nrow,ncol,nnzero - + + allocate(acoo, stat=ircode) + if (ircode /= 0) goto 993 if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'general')) then - call psb_sp_all(nrow,ncol,a,nnzero,ircode) - if (ircode /= 0) goto 993 - a%fida = 'COO' - a%descra = 'G' + call acoo%allocate(nrow,ncol,nnzero) do i=1,nnzero - read(infile,fmt=*,end=902) a%ia1(i),a%ia2(i),are,aim - a%aspk(i) = cmplx(are,aim,kind=psb_spk_) + read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim + acoo%val(i) = cmplx(are,aim,kind=psb_spk_) end do - a%infoa(psb_nnz_) = nnzero - - call psb_spcnv(a,ircode,afmt='csr') + call acoo%set_nzeros(nnzero) + call acoo%fix(info) + + call a%mv_from(acoo) + call a%cscnv(ircode,type='csr') else if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'symmetric')) then ! we are generally working with non-symmetric matrices, so ! we de-symmetrize what we are about to read - call psb_sp_all(nrow,ncol,a,2*nnzero,ircode) - if (ircode /= 0) goto 993 - a%fida = 'COO' - a%descra = 'G' + call acoo%allocate(nrow,ncol,nnzero) do i=1,nnzero - read(infile,fmt=*,end=902) a%ia1(i),a%ia2(i),are,aim - a%aspk(i) = cmplx(are,aim,kind=psb_spk_) + read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim + acoo%val(i) = cmplx(are,aim,kind=psb_spk_) end do - nzr = nnzero do i=1,nnzero - if (a%ia1(i) /= a%ia2(i)) then + if (acoo%ia(i) /= acoo%ja(i)) then nzr = nzr + 1 - a%aspk(nzr) = a%aspk(i) - a%ia1(nzr) = a%ia2(i) - a%ia2(nzr) = a%ia1(i) + acoo%val(nzr) = acoo%val(i) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) end if end do - a%infoa(psb_nnz_) = nzr - call psb_spcnv(a,ircode,afmt='csr') + call acoo%set_nzeros(nzr) + call acoo%fix(info) + + call a%mv_from(acoo) + call a%cscnv(ircode,type='csr') else if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'hermitian')) then ! we are generally working with non-symmetric matrices, so ! we de-symmetrize what we are about to read - call psb_sp_all(nrow,ncol,a,2*nnzero,ircode) - if (ircode /= 0) goto 993 - a%fida = 'COO' - a%descra = 'G' + call acoo%allocate(nrow,ncol,nnzero) do i=1,nnzero - read(infile,fmt=*,end=902) a%ia1(i),a%ia2(i),are,aim - a%aspk(i) = cmplx(are,aim,kind=psb_spk_) + read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim + acoo%val(i) = cmplx(are,aim,kind=psb_spk_) end do - nzr = nnzero do i=1,nnzero - if (a%ia1(i) /= a%ia2(i)) then + if (acoo%ia(i) /= acoo%ja(i)) then nzr = nzr + 1 - a%aspk(nzr) = conjg(a%aspk(i)) - a%ia1(nzr) = a%ia2(i) - a%ia2(nzr) = a%ia1(i) + acoo%val(nzr) = conjg(acoo%val(i)) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) end if end do - a%infoa(psb_nnz_) = nzr - call psb_spcnv(a,ircode,afmt='csr') + call acoo%set_nzeros(nzr) + call acoo%fix(info) + + call a%mv_from(acoo) + call a%cscnv(ircode,type='csr') else write(0,*) 'read_matrix: matrix type not yet supported' info=904 end if + + if (infile/=5) close(infile) + + return ! open failed @@ -776,11 +779,10 @@ contains end subroutine cmm_mat_read - subroutine cmm_mat_write(a,mtitle,info,iunit,filename) use psb_base_mod implicit none - type(psb_cspmat_type), intent(in) :: a + type(psb_c_sparse_mat), intent(in) :: a integer, intent(out) :: info character(len=*), intent(in) :: mtitle integer, optional, intent(in) :: iunit @@ -809,7 +811,7 @@ contains endif endif - call psb_csprt(iout,a,head=mtitle) + call a%print(iout,head=mtitle) if (iout /= 6) close(iout) @@ -825,7 +827,7 @@ contains subroutine zmm_mat_read(a, info, iunit, filename) use psb_base_mod implicit none - type(psb_zspmat_type), intent(out) :: a + type(psb_z_sparse_mat), intent(out) :: a integer, intent(out) :: info integer, optional, intent(in) :: iunit character(len=*), optional, intent(in) :: filename @@ -833,8 +835,8 @@ contains character(1024) :: line integer :: nrow, ncol, nnzero integer :: ircode, i,nzr,infile - real(psb_dpk_) :: are, aim - + type(psb_z_coo_sparse_mat), allocatable :: acoo + real(psb_dpk_) :: are, aim info = 0 if (present(filename)) then @@ -869,73 +871,76 @@ contains if (line(1:1) /= '%') exit end do read(line,fmt=*) nrow,ncol,nnzero - + + allocate(acoo, stat=ircode) + if (ircode /= 0) goto 993 if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'general')) then - call psb_sp_all(nrow,ncol,a,nnzero,ircode) - if (ircode /= 0) goto 993 - a%fida = 'COO' - a%descra = 'G' + call acoo%allocate(nrow,ncol,nnzero) do i=1,nnzero - read(infile,fmt=*,end=902) a%ia1(i),a%ia2(i),are,aim - a%aspk(i) = cmplx(are,aim,kind=psb_dpk_) + read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim + acoo%val(i) = cmplx(are,aim,kind=psb_dpk_) end do - a%infoa(psb_nnz_) = nnzero - - call psb_spcnv(a,ircode,afmt='csr') + call acoo%set_nzeros(nnzero) + call acoo%fix(info) + + call a%mv_from(acoo) + call a%cscnv(ircode,type='csr') else if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'symmetric')) then ! we are generally working with non-symmetric matrices, so ! we de-symmetrize what we are about to read - call psb_sp_all(nrow,ncol,a,2*nnzero,ircode) - if (ircode /= 0) goto 993 - a%fida = 'COO' - a%descra = 'G' + call acoo%allocate(nrow,ncol,nnzero) do i=1,nnzero - read(infile,fmt=*,end=902) a%ia1(i),a%ia2(i),are,aim - a%aspk(i) = cmplx(are,aim,kind=psb_dpk_) + read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim + acoo%val(i) = cmplx(are,aim,kind=psb_dpk_) end do - nzr = nnzero do i=1,nnzero - if (a%ia1(i) /= a%ia2(i)) then + if (acoo%ia(i) /= acoo%ja(i)) then nzr = nzr + 1 - a%aspk(nzr) = a%aspk(i) - a%ia1(nzr) = a%ia2(i) - a%ia2(nzr) = a%ia1(i) + acoo%val(nzr) = acoo%val(i) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) end if end do - a%infoa(psb_nnz_) = nzr - call psb_spcnv(a,ircode,afmt='csr') + call acoo%set_nzeros(nzr) + call acoo%fix(info) + + call a%mv_from(acoo) + call a%cscnv(ircode,type='csr') else if ((psb_tolower(type) == 'complex').and.(psb_tolower(sym) == 'hermitian')) then ! we are generally working with non-symmetric matrices, so ! we de-symmetrize what we are about to read - call psb_sp_all(nrow,ncol,a,2*nnzero,ircode) - if (ircode /= 0) goto 993 - a%fida = 'COO' - a%descra = 'G' + call acoo%allocate(nrow,ncol,nnzero) do i=1,nnzero - read(infile,fmt=*,end=902) a%ia1(i),a%ia2(i),are,aim - a%aspk(i) = cmplx(are,aim,kind=psb_dpk_) + read(infile,fmt=*,end=902) acoo%ia(i),acoo%ja(i),are,aim + acoo%val(i) = cmplx(are,aim,kind=psb_dpk_) end do - nzr = nnzero do i=1,nnzero - if (a%ia1(i) /= a%ia2(i)) then + if (acoo%ia(i) /= acoo%ja(i)) then nzr = nzr + 1 - a%aspk(nzr) = conjg(a%aspk(i)) - a%ia1(nzr) = a%ia2(i) - a%ia2(nzr) = a%ia1(i) + acoo%val(nzr) = conjg(acoo%val(i)) + acoo%ia(nzr) = acoo%ja(i) + acoo%ja(nzr) = acoo%ia(i) end if end do - a%infoa(psb_nnz_) = nzr - call psb_spcnv(a,ircode,afmt='csr') + call acoo%set_nzeros(nzr) + call acoo%fix(info) + + call a%mv_from(acoo) + call a%cscnv(ircode,type='csr') else write(0,*) 'read_matrix: matrix type not yet supported' info=904 end if + + if (infile/=5) close(infile) + + return ! open failed @@ -951,11 +956,10 @@ contains end subroutine zmm_mat_read - subroutine zmm_mat_write(a,mtitle,info,iunit,filename) use psb_base_mod implicit none - type(psb_zspmat_type), intent(in) :: a + type(psb_z_sparse_mat), intent(in) :: a integer, intent(out) :: info character(len=*), intent(in) :: mtitle integer, optional, intent(in) :: iunit @@ -984,7 +988,7 @@ contains endif endif - call psb_csprt(iout,a,head=mtitle) + call a%print(iout,head=mtitle) if (iout /= 6) close(iout)