From 252142ec16db188000955ef5f180802a1e28eaad Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 27 Apr 2020 09:40:10 +0200 Subject: [PATCH 01/21] Do not store temporary PDF file. --- docs/src/userguide.pdf | 1 - 1 file changed, 1 deletion(-) delete mode 120000 docs/src/userguide.pdf diff --git a/docs/src/userguide.pdf b/docs/src/userguide.pdf deleted file mode 120000 index 7b032aa3..00000000 --- a/docs/src/userguide.pdf +++ /dev/null @@ -1 +0,0 @@ -tmp/userguide.pdf \ No newline at end of file From 47a1ec95de02c7a0216e7018cb1e7f037d2ce012 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 27 Apr 2020 09:41:09 +0200 Subject: [PATCH 02/21] Repaired user's guide PDF file. --- docs/psblas-3.7.pdf | 23 +++-------------------- 1 file changed, 3 insertions(+), 20 deletions(-) diff --git a/docs/psblas-3.7.pdf b/docs/psblas-3.7.pdf index e42d4f14..3cff98c6 100644 --- a/docs/psblas-3.7.pdf +++ b/docs/psblas-3.7.pdf @@ -30137,18 +30137,8 @@ endobj 2131 0 obj << /Title (Parallel Sparse BLAS V. 3.7.0) /Subject (Parallel Sparse Basic Linear Algebra Subroutines) /Keywords (Computer Science Linear Algebra Fluid Dynamics Parallel Linux MPI PSBLAS Iterative Solvers Preconditioners) /Creator (pdfLaTeX) /Producer ($Id$) /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.19)/Keywords() -<<<<<<< HEAD -/CreationDate (D:20200425083929+02'00') -/ModDate (D:20200425083929+02'00') -======= -<<<<<<< HEAD -/CreationDate (D:20191217194209Z) -/ModDate (D:20191217194209Z) -======= -/CreationDate (D:20191218141557Z) -/ModDate (D:20191218141557Z) ->>>>>>> unify_aggr_bld ->>>>>>> merge-paraggr-newops +/CreationDate (D:20200427094023+02'00') +/ModDate (D:20200427094023+02'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.19 (TeX Live 2018) kpathsea version 6.3.0) >> @@ -30281,17 +30271,10 @@ endobj /Index [0 2133] /Size 2133 /W [1 3 1] -<<<<<<< HEAD -/Root 2129 0 R -/Info 2130 0 R -/ID [<362C1AAB92CF66A0E508C639DC7E96C3> <362C1AAB92CF66A0E508C639DC7E96C3>] -/Length 10660 -======= /Root 2130 0 R /Info 2131 0 R -/ID [ ] +/ID [<85A2244B7B7D8D6914EFC0C2A96A5BA7> <85A2244B7B7D8D6914EFC0C2A96A5BA7>] /Length 10665 ->>>>>>> unify_aggr_bld >> stream ZIS[c@b  From 9d34f465a958952a13f4a5742962edd34e449db8 Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Mon, 4 May 2020 10:21:43 +0200 Subject: [PATCH 03/21] Added C interface for util/idx2ijk --- cbind/util/psb_util_cbind.h | 1 + cbind/util/psb_util_cbind_mod.f90 | 24 ++++++++++++++++++++++++ 2 files changed, 25 insertions(+) diff --git a/cbind/util/psb_util_cbind.h b/cbind/util/psb_util_cbind.h index 4179b3b1..deb58c91 100644 --- a/cbind/util/psb_util_cbind.h +++ b/cbind/util/psb_util_cbind.h @@ -6,5 +6,6 @@ #include "psb_c_cutil.h" #include "psb_c_zutil.h" +psb_i_t psb_c_idx2ijk(psb_i_t *i, psb_i_t *j, psb_i_t idx, psb_i_t nx, psb_i_t ny, psb_i_t base ); #endif diff --git a/cbind/util/psb_util_cbind_mod.f90 b/cbind/util/psb_util_cbind_mod.f90 index 96bafe4a..4417eb81 100644 --- a/cbind/util/psb_util_cbind_mod.f90 +++ b/cbind/util/psb_util_cbind_mod.f90 @@ -1,6 +1,30 @@ module psb_base_util_cbind_mod + use iso_c_binding use psb_cutil_cbind_mod use psb_dutil_cbind_mod use psb_sutil_cbind_mod use psb_zutil_cbind_mod + +contains + + ! Routines for managing indexes are type independent + ! so we have them defined only in the common module + ! for all the types + + function psb_c_idx2ijk(i,j,idx,nx,ny,base) bind(c) result(res) + use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_ + implicit none + + integer(psb_c_ipk_) :: res + integer(psb_c_ipk_), value :: idx,nx,ny,base + integer(psb_c_ipk_) :: i,j + + res = -1 + + call idx2ijk(i,j,idx,nx,ny,base=base) + + res = 0 + + end function psb_c_idx2ijk + end module psb_base_util_cbind_mod From 3c3470b50e4f059a86f6789830a385d0d9d148f4 Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Mon, 4 May 2020 13:36:00 +0200 Subject: [PATCH 04/21] Disambiguated C interfaces for idx2ijk for type of the index --- cbind/util/psb_util_cbind.h | 2 ++ cbind/util/psb_util_cbind_mod.f90 | 17 +++++++++++++++++ 2 files changed, 19 insertions(+) diff --git a/cbind/util/psb_util_cbind.h b/cbind/util/psb_util_cbind.h index deb58c91..347d53b4 100644 --- a/cbind/util/psb_util_cbind.h +++ b/cbind/util/psb_util_cbind.h @@ -7,5 +7,7 @@ #include "psb_c_zutil.h" psb_i_t psb_c_idx2ijk(psb_i_t *i, psb_i_t *j, psb_i_t idx, psb_i_t nx, psb_i_t ny, psb_i_t base ); +psb_i_t psb_c_lidx2ijk(psb_i_t *i, psb_i_t *j, psb_l_t idx, psb_i_t nx, psb_i_t ny, psb_i_t base ); + #endif diff --git a/cbind/util/psb_util_cbind_mod.f90 b/cbind/util/psb_util_cbind_mod.f90 index 4417eb81..ec2c9678 100644 --- a/cbind/util/psb_util_cbind_mod.f90 +++ b/cbind/util/psb_util_cbind_mod.f90 @@ -27,4 +27,21 @@ contains end function psb_c_idx2ijk + function psb_c_lidx2ijk(i,j,idx,nx,ny,base) bind(c) result(res) + use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_ + implicit none + + integer(psb_c_ipk_) :: res + integer(psb_c_lpk_), value :: idx + integer(psb_c_ipk_), value :: nx,ny,base + integer(psb_c_ipk_) :: i,j + + res = -1 + + call idx2ijk(i,j,idx,nx,ny,base=base) + + res = 0 + + end function psb_c_lidx2ijk + end module psb_base_util_cbind_mod From ac3afe962d6c4e8c68e2ffedbdb10bb44350bfd9 Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Mon, 4 May 2020 13:39:11 +0200 Subject: [PATCH 05/21] Added C interface psb_c_cd_get_global_indices for descriptor objects --- cbind/base/psb_base_tools_cbind_mod.F90 | 29 ++++++++++++++++++ cbind/base/psb_c_base.h | 40 ++++++++++++------------- 2 files changed, 49 insertions(+), 20 deletions(-) diff --git a/cbind/base/psb_base_tools_cbind_mod.F90 b/cbind/base/psb_base_tools_cbind_mod.F90 index 75028e27..6d31778a 100644 --- a/cbind/base/psb_base_tools_cbind_mod.F90 +++ b/cbind/base/psb_base_tools_cbind_mod.F90 @@ -301,5 +301,34 @@ contains end function psb_c_cd_get_global_cols + function psb_c_cd_get_global_indices(idx,nidx,owned,cdh) bind(c,name='psb_c_cd_get_global_indices') result(res) + implicit none + + integer(psb_c_ipk_) :: res + type(psb_c_object_type) :: cdh + + integer(psb_c_lpk_) :: idx(nidx) + integer(psb_c_ipk_), value :: nidx + logical(c_bool), value :: owned + + + type(psb_desc_type), pointer :: descp + integer(psb_lpk_), allocatable :: myidx(:) + logical :: fowned + res = -1 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + + fowned = owned + myidx = descp%get_global_indices(owned=fowned) + + idx(1:nidx) = myidx(1:nidx) + res = 0 + + end if + + end function psb_c_cd_get_global_indices + end module psb_base_tools_cbind_mod diff --git a/cbind/base/psb_c_base.h b/cbind/base/psb_c_base.h index 055283b4..b00058ec 100644 --- a/cbind/base/psb_c_base.h +++ b/cbind/base/psb_c_base.h @@ -13,7 +13,7 @@ extern "C" { #include #include #include - + typedef int32_t psb_m_t; @@ -29,20 +29,20 @@ extern "C" { #else #endif typedef int64_t psb_e_t; - + typedef float psb_s_t; typedef double psb_d_t; typedef float complex psb_c_t; typedef double complex psb_z_t; #define PSB_ERR_ERROR -1 #define PSB_ERR_SUCCESS 0 - - + + typedef struct PSB_C_DESCRIPTOR { void *descriptor; - } psb_c_descriptor; - - + } psb_c_descriptor; + + psb_i_t psb_c_error(); psb_i_t psb_c_clean_errstack(); @@ -53,7 +53,7 @@ extern "C" { void psb_c_seterraction_print(); void psb_c_seterraction_abort(); - /* Environment routines */ + /* Environment routines */ psb_i_t psb_c_init(); void psb_c_exit_ctxt(psb_i_t ictxt); void psb_c_exit(psb_i_t ictxt); @@ -65,7 +65,7 @@ extern "C" { psb_i_t psb_c_get_index_base(); void psb_c_set_index_base(psb_i_t base); - + void psb_c_mbcast(psb_i_t ictxt, psb_i_t n, psb_m_t *v, psb_i_t root); void psb_c_ibcast(psb_i_t ictxt, psb_i_t n, psb_i_t *v, psb_i_t root); void psb_c_lbcast(psb_i_t ictxt, psb_i_t n, psb_l_t *v, psb_i_t root); @@ -75,8 +75,8 @@ extern "C" { void psb_c_cbcast(psb_i_t ictxt, psb_i_t n, psb_c_t *v, psb_i_t root); void psb_c_zbcast(psb_i_t ictxt, psb_i_t n, psb_z_t *v, psb_i_t root); void psb_c_hbcast(psb_i_t ictxt, const char *v, psb_i_t root); - - /* Descriptor/integer routines */ + + /* Descriptor/integer routines */ psb_c_descriptor* psb_c_new_descriptor(); psb_i_t psb_c_cdall_vg(psb_l_t ng, psb_i_t *vg, psb_i_t ictxt, psb_c_descriptor *cd); psb_i_t psb_c_cdall_vl(psb_i_t nl, psb_l_t *vl, psb_i_t ictxt, psb_c_descriptor *cd); @@ -85,25 +85,25 @@ extern "C" { psb_i_t psb_c_cdasb(psb_c_descriptor *cd); psb_i_t psb_c_cdfree(psb_c_descriptor *cd); psb_i_t psb_c_cdins(psb_i_t nz, const psb_l_t *ia, const psb_l_t *ja, psb_c_descriptor *cd); - + psb_i_t psb_c_cd_get_local_rows(psb_c_descriptor *cd); psb_i_t psb_c_cd_get_local_cols(psb_c_descriptor *cd); psb_l_t psb_c_cd_get_global_rows(psb_c_descriptor *cd); psb_l_t psb_c_cd_get_global_rows(psb_c_descriptor *cd); + psb_i_t psb_c_cd_get_global_indices(psb_l_t idx[], psb_i_t nidx, bool owned, psb_c_descriptor *cd); - - /* legal values for upd argument */ + /* legal values for upd argument */ #define psb_upd_srch_ 98764 #define psb_upd_perm_ 98765 #define psb_upd_def_ psb_upd_srch_ - /* legal values for dupl argument */ + /* legal values for dupl argument */ #define psb_dupl_ovwrt_ 0 #define psb_dupl_add_ 1 #define psb_dupl_err_ 2 #define psb_dupl_def_ psb_dupl_ovwrt_ - /* legal values for afmt */ + /* legal values for afmt */ #define PSB_AFMT_CSR "CSR" #define PSB_AFMT_CSC "CSC" #define PSB_AFMT_COO "COO" @@ -113,21 +113,21 @@ extern "C" { #define psb_NoTrans_ "N" #define psb_Trans_ "T" #define psb_ConjTrans_ "C" - - /* legal values for halo swap modes argument */ + + /* legal values for halo swap modes argument */ #define psb_swap_send_ 1 #define psb_swap_recv_ 2 #define psb_swap_sync_ 4 #define psb_swap_mpi_ 8 - /* legal values for ovrl update argument */ + /* legal values for ovrl update argument */ #define psb_none_ 0 #define psb_sum_ 1 #define psb_avg_ 2 #define psb_square_root_ 3 #define psb_setzero_ 4 - + #ifdef __cplusplus } #endif /* __cplusplus */ From dbdbea9c6f5161d8fb1b0f077c1d15424012f14d Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Mon, 4 May 2020 21:54:30 +0200 Subject: [PATCH 06/21] C Interfaces for ijk2idx idx2ijk redefined --- cbind/util/psb_util_cbind.h | 6 ++- cbind/util/psb_util_cbind_mod.f90 | 80 +++++++++++++++++++++++++------ 2 files changed, 70 insertions(+), 16 deletions(-) diff --git a/cbind/util/psb_util_cbind.h b/cbind/util/psb_util_cbind.h index 347d53b4..b844cd08 100644 --- a/cbind/util/psb_util_cbind.h +++ b/cbind/util/psb_util_cbind.h @@ -6,8 +6,10 @@ #include "psb_c_cutil.h" #include "psb_c_zutil.h" -psb_i_t psb_c_idx2ijk(psb_i_t *i, psb_i_t *j, psb_i_t idx, psb_i_t nx, psb_i_t ny, psb_i_t base ); -psb_i_t psb_c_lidx2ijk(psb_i_t *i, psb_i_t *j, psb_l_t idx, psb_i_t nx, psb_i_t ny, psb_i_t base ); +psb_i_t psb_c_i_idx2ijk(psb_i_t ijk[],psb_i_t idx,psb_i_t sizes[],psb_i_t modes,psb_i_t base); +psb_i_t psb_c_l_idx2ijk(psb_i_t ijk[],psb_l_t idx,psb_i_t sizes[],psb_i_t modes,psb_i_t base); +psb_i_t psb_c_i_ijk2idx(psb_i_t ijk[],psb_i_t sizes[],psb_i_t modes,psb_i_t base); +psb_l_t psb_c_l_ijk2idx(psb_i_t ijk[],psb_i_t sizes[],psb_i_t modes,psb_i_t base); #endif diff --git a/cbind/util/psb_util_cbind_mod.f90 b/cbind/util/psb_util_cbind_mod.f90 index ec2c9678..20e124bd 100644 --- a/cbind/util/psb_util_cbind_mod.f90 +++ b/cbind/util/psb_util_cbind_mod.f90 @@ -1,5 +1,6 @@ module psb_base_util_cbind_mod use iso_c_binding + use psb_util_mod use psb_cutil_cbind_mod use psb_dutil_cbind_mod use psb_sutil_cbind_mod @@ -9,39 +10,90 @@ contains ! Routines for managing indexes are type independent ! so we have them defined only in the common module - ! for all the types + ! for all the index lengths: - function psb_c_idx2ijk(i,j,idx,nx,ny,base) bind(c) result(res) + function psb_c_i_ijk2idx(ijk,sizes,modes,base) bind(c) result(idx) use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_ + use psb_util_mod implicit none - integer(psb_c_ipk_) :: res - integer(psb_c_ipk_), value :: idx,nx,ny,base - integer(psb_c_ipk_) :: i,j + integer(psb_c_ipk_) :: idx + integer(psb_c_ipk_), value :: modes, base + integer(psb_c_ipk_) :: ijk(modes) + integer(psb_c_ipk_) :: sizes(modes) + + integer(psb_ipk_) :: fijk(modes), fsizes(modes) + + fijk(1:modes) = ijk(1:modes) + fsizes(1:modes) = sizes(1:modes) + + call ijk2idx(idx,fijk,fsizes,base) + + end function psb_c_i_ijk2idx + + function psb_c_l_ijk2idx(ijk,sizes,modes,base) bind(c) result(idx) + use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_ + use psb_util_mod + implicit none + + integer(psb_c_lpk_) :: idx + integer(psb_c_ipk_), value :: modes, base + integer(psb_c_ipk_) :: ijk(modes) + integer(psb_c_ipk_) :: sizes(modes) + + integer(psb_ipk_) :: fijk(modes), fsizes(modes) + + fijk(1:modes) = ijk(1:modes) + fsizes(1:modes) = sizes(1:modes) + + call ijk2idx(idx,fijk,fsizes,base) + + end function psb_c_l_ijk2idx + + function psb_c_i_idx2ijk(ijk,idx,sizes,modes,base) bind(c) result(res) + use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_ + implicit none + + integer(psb_c_ipk_) :: res + integer(psb_c_ipk_), value :: idx + integer(psb_c_ipk_), value :: modes, base + integer(psb_c_ipk_) :: ijk(modes) + integer(psb_c_ipk_) :: sizes(modes) + + integer(psb_ipk_) :: fijk(modes), fsizes(modes) res = -1 - call idx2ijk(i,j,idx,nx,ny,base=base) + fsizes(1:modes) = sizes(1:modes) + call idx2ijk(fijk,idx,fsizes,base=base) + + ijk(1:modes) = fijk(1:modes) res = 0 - end function psb_c_idx2ijk + end function - function psb_c_lidx2ijk(i,j,idx,nx,ny,base) bind(c) result(res) + function psb_c_l_idx2ijk(ijk,idx,sizes,modes,base) bind(c) result(res) use psb_base_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_ implicit none - integer(psb_c_ipk_) :: res - integer(psb_c_lpk_), value :: idx - integer(psb_c_ipk_), value :: nx,ny,base - integer(psb_c_ipk_) :: i,j + integer(psb_c_ipk_) :: res + integer(psb_c_lpk_), value :: idx + integer(psb_c_ipk_), value :: modes, base + integer(psb_c_ipk_) :: ijk(modes) + integer(psb_c_ipk_) :: sizes(modes) + + integer(psb_ipk_) :: fijk(modes), fsizes(modes) res = -1 - call idx2ijk(i,j,idx,nx,ny,base=base) + fsizes(1:modes) = sizes(1:modes) + call idx2ijk(fijk,idx,fsizes,base=base) + + ijk(1:modes) = fijk(1:modes) res = 0 - end function psb_c_lidx2ijk + end function end module psb_base_util_cbind_mod From 93b8696df05fb02bd0666a19ac3b04d5e12bc834 Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Sun, 10 May 2020 11:08:45 +0200 Subject: [PATCH 07/21] Corrected C interface for mask operation to avoid memleak --- cbind/base/psb_c_dbase.h | 2 +- cbind/base/psb_c_sbase.h | 2 +- cbind/base/psb_d_psblas_cbind_mod.f90 | 6 +++--- cbind/base/psb_s_psblas_cbind_mod.f90 | 6 +++--- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/cbind/base/psb_c_dbase.h b/cbind/base/psb_c_dbase.h index ece7b840..d1bd39af 100644 --- a/cbind/base/psb_c_dbase.h +++ b/cbind/base/psb_c_dbase.h @@ -87,7 +87,7 @@ bool psb_c_dgecmpmat_val(psb_c_dspmat *ah,psb_d_t val,psb_d_t tol,psb_c_descri psb_i_t psb_c_dgeaddconst(psb_c_dvector *xh,psb_d_t bh,psb_c_dvector *zh,psb_c_descriptor *cdh); psb_d_t psb_c_dgenrm2_weight(psb_c_dvector *xh,psb_c_dvector *wh,psb_c_descriptor *cdh); psb_d_t psb_c_dgenrm2_weightmask(psb_c_dvector *xh,psb_c_dvector *wh,psb_c_dvector *idvh,psb_c_descriptor *cdh); -psb_i_t psb_c_dmask(psb_c_dvector *ch,psb_c_dvector *xh,psb_c_dvector *mh, void *t, psb_c_descriptor *cdh); +psb_i_t psb_c_dmask(psb_c_dvector *ch,psb_c_dvector *xh,psb_c_dvector *mh, bool *t, psb_c_descriptor *cdh); psb_d_t psb_c_dgemin(psb_c_dvector *xh,psb_c_descriptor *cdh); psb_d_t psb_c_dminquotient(psb_c_dvector *xh,psb_c_dvector *yh, psb_c_descriptor *cdh); psb_i_t psb_c_dspscal(psb_d_t alpha, psb_c_dspmat *ah, psb_c_descriptor *cdh); diff --git a/cbind/base/psb_c_sbase.h b/cbind/base/psb_c_sbase.h index 85333dec..c259767f 100644 --- a/cbind/base/psb_c_sbase.h +++ b/cbind/base/psb_c_sbase.h @@ -87,7 +87,7 @@ bool psb_c_sgecmpmat_val(psb_c_sspmat *ah,psb_s_t val,psb_s_t tol,psb_c_descript psb_i_t psb_c_sgeaddconst(psb_c_svector *xh,psb_s_t bh,psb_c_svector *zh,psb_c_descriptor *cdh); psb_s_t psb_c_sgenrm2_weight(psb_c_svector *xh,psb_c_svector *wh,psb_c_descriptor *cdh); psb_s_t psb_c_sgenrm2_weightmask(psb_c_svector *xh,psb_c_svector *wh,psb_c_svector *idvh,psb_c_descriptor *cdh); -psb_i_t psb_c_smask(psb_c_svector *ch,psb_c_svector *xh,psb_c_svector *mh, void *t, psb_c_descriptor *cdh); +psb_i_t psb_c_smask(psb_c_svector *ch,psb_c_svector *xh,psb_c_svector *mh, bool *t, psb_c_descriptor *cdh); psb_s_t psb_c_sgemin(psb_c_svector *xh,psb_c_descriptor *cdh); psb_i_t psb_c_sspscal(psb_s_t alpha, psb_c_sspmat *ah, psb_c_descriptor *cdh); psb_i_t psb_c_sspscalpid(psb_s_t alpha, psb_c_sspmat *ah, psb_c_descriptor *cdh); diff --git a/cbind/base/psb_d_psblas_cbind_mod.f90 b/cbind/base/psb_d_psblas_cbind_mod.f90 index 07c4d932..da5aa2e2 100644 --- a/cbind/base/psb_d_psblas_cbind_mod.f90 +++ b/cbind/base/psb_d_psblas_cbind_mod.f90 @@ -575,12 +575,12 @@ contains type(psb_c_dvector) :: ch,xh,mh type(psb_c_descriptor) :: cdh - type(c_ptr), value :: t + logical(c_bool) :: t type(psb_desc_type), pointer :: descp type(psb_d_vect_type), pointer :: cp,xp,mp integer(psb_c_ipk_) :: info - logical, pointer :: fp + logical :: fp res = -1 @@ -604,10 +604,10 @@ contains else return end if - call c_f_pointer(t,fp) call psb_mask(cp,xp,mp,fp,descp,info) + t = fp res = info end function psb_c_dmask diff --git a/cbind/base/psb_s_psblas_cbind_mod.f90 b/cbind/base/psb_s_psblas_cbind_mod.f90 index 271d8a1c..97cc5284 100644 --- a/cbind/base/psb_s_psblas_cbind_mod.f90 +++ b/cbind/base/psb_s_psblas_cbind_mod.f90 @@ -575,12 +575,12 @@ contains type(psb_c_svector) :: ch,xh,mh type(psb_c_descriptor) :: cdh - type(c_ptr), value :: t + logical(c_bool) :: t type(psb_desc_type), pointer :: descp type(psb_s_vect_type), pointer :: cp,xp,mp integer(psb_c_ipk_) :: info - logical, pointer :: fp + logical :: fp res = -1 @@ -604,10 +604,10 @@ contains else return end if - call c_f_pointer(t,fp) call psb_mask(cp,xp,mp,fp,descp,info) + t = fp res = info end function psb_c_smask From db1705792480e8b298628c62143b121f48acb39a Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 5 Jun 2020 11:26:16 +0200 Subject: [PATCH 08/21] Cosmetic changes to fnd_owner for BLOCK. --- base/modules/desc/psb_gen_block_map_mod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/base/modules/desc/psb_gen_block_map_mod.F90 b/base/modules/desc/psb_gen_block_map_mod.F90 index 4bb29294..6fc8123f 100644 --- a/base/modules/desc/psb_gen_block_map_mod.F90 +++ b/base/modules/desc/psb_gen_block_map_mod.F90 @@ -2192,7 +2192,7 @@ contains integer(psb_ipk_) :: lb, ub, m - choice: if (n >5) then + binsrch: if (n > 8) then lb = 1 ub = n ipos = -1 @@ -2201,7 +2201,7 @@ contains m = (lb+ub)/2 if (key==v(m)) then ipos = m - exit choice + exit binsrch else if (key < v(m)) then ub = m-1 else @@ -2215,7 +2215,7 @@ contains else ! No binary search, do everything in the final cleanup ipos = 0 - end if choice + end if binsrch ! Final cleanup ! This is needed because V may contain repeated entries @@ -2239,7 +2239,7 @@ contains integer(psb_ipk_) :: lb, ub, m - choice: if (n >5) then + binsrch: if (n > 8) then lb = 1 ub = n ipos = -1 @@ -2248,7 +2248,7 @@ contains m = (lb+ub)/2 if (key==v(m)) then ipos = m - exit choice + exit binsrch else if (key < v(m)) then ub = m-1 else @@ -2262,7 +2262,7 @@ contains else ! No binary search, do everything in the final cleanup ipos = 0 - end if choice + end if binsrch ! Final cleanup ! This is needed because V may contain repeated entries From eb03797ad592ee3d799a0f8321f5580d92e89478 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 12 Jun 2020 19:55:59 +0200 Subject: [PATCH 09/21] Better error messages from MAP%APPLY --- base/tools/psb_c_map.f90 | 5 ++--- base/tools/psb_d_map.f90 | 5 ++--- base/tools/psb_s_map.f90 | 5 ++--- base/tools/psb_z_map.f90 | 5 ++--- 4 files changed, 8 insertions(+), 12 deletions(-) diff --git a/base/tools/psb_c_map.f90 b/base/tools/psb_c_map.f90 index 6324b944..83a54d32 100644 --- a/base/tools/psb_c_map.f90 +++ b/base/tools/psb_c_map.f90 @@ -159,7 +159,7 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info) if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info + write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info info = -1 else if (.not.present(vty)) call yt%free(info) @@ -173,7 +173,6 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) nc1 = map%desc_U%get_local_cols() nr2 = map%desc_V%get_global_rows() nc2 = map%desc_V%get_local_cols() - if (present(vtx).and.present(vty)) then ptx => vtx pty => vty @@ -194,7 +193,7 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info) if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info + write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info info = -1 else if (.not.(present(vtx).and.present(vty) )) then diff --git a/base/tools/psb_d_map.f90 b/base/tools/psb_d_map.f90 index 3046482e..51672121 100644 --- a/base/tools/psb_d_map.f90 +++ b/base/tools/psb_d_map.f90 @@ -159,7 +159,7 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info) if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info + write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info info = -1 else if (.not.present(vty)) call yt%free(info) @@ -173,7 +173,6 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) nc1 = map%desc_U%get_local_cols() nr2 = map%desc_V%get_global_rows() nc2 = map%desc_V%get_local_cols() - if (present(vtx).and.present(vty)) then ptx => vtx pty => vty @@ -194,7 +193,7 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info) if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info + write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info info = -1 else if (.not.(present(vtx).and.present(vty) )) then diff --git a/base/tools/psb_s_map.f90 b/base/tools/psb_s_map.f90 index 1d10b879..6fa9b7b7 100644 --- a/base/tools/psb_s_map.f90 +++ b/base/tools/psb_s_map.f90 @@ -159,7 +159,7 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info) if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info + write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info info = -1 else if (.not.present(vty)) call yt%free(info) @@ -173,7 +173,6 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) nc1 = map%desc_U%get_local_cols() nr2 = map%desc_V%get_global_rows() nc2 = map%desc_V%get_local_cols() - if (present(vtx).and.present(vty)) then ptx => vtx pty => vty @@ -194,7 +193,7 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info) if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info + write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info info = -1 else if (.not.(present(vtx).and.present(vty) )) then diff --git a/base/tools/psb_z_map.f90 b/base/tools/psb_z_map.f90 index 6b07401f..86858c60 100644 --- a/base/tools/psb_z_map.f90 +++ b/base/tools/psb_z_map.f90 @@ -159,7 +159,7 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%p_desc_V,info) if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info + write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info info = -1 else if (.not.present(vty)) call yt%free(info) @@ -173,7 +173,6 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) nc1 = map%desc_U%get_local_cols() nr2 = map%desc_V%get_global_rows() nc2 = map%desc_V%get_local_cols() - if (present(vtx).and.present(vty)) then ptx => vtx pty => vty @@ -194,7 +193,7 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) end if if (info == psb_success_) call psb_geaxpby(alpha,pty,beta,y,map%desc_V,info) if (info /= psb_success_) then - write(psb_err_unit,*) trim(name),' Error from inner routines',info + write(psb_err_unit,*) iam,' ',trim(name),' Error from inner routines',info info = -1 else if (.not.(present(vtx).and.present(vty) )) then From 46736f9d39b6f54cf77b9a91bc917008e4a8370a Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 12 Jun 2020 19:56:13 +0200 Subject: [PATCH 10/21] Fix type handling bug in simple_triad --- base/modules/penv/psi_c_collective_mod.F90 | 2 +- base/modules/penv/psi_e_collective_mod.F90 | 2 +- base/modules/penv/psi_i2_collective_mod.F90 | 2 +- base/modules/penv/psi_m_collective_mod.F90 | 2 +- base/modules/penv/psi_s_collective_mod.F90 | 2 +- base/modules/penv/psi_z_collective_mod.F90 | 2 +- base/tools/psb_csphalo.F90 | 2 +- base/tools/psb_dsphalo.F90 | 2 +- base/tools/psb_ssphalo.F90 | 2 +- base/tools/psb_zsphalo.F90 | 2 +- 10 files changed, 10 insertions(+), 10 deletions(-) diff --git a/base/modules/penv/psi_c_collective_mod.F90 b/base/modules/penv/psi_c_collective_mod.F90 index de836d38..a1fa78a3 100644 --- a/base/modules/penv/psi_c_collective_mod.F90 +++ b/base/modules/penv/psi_c_collective_mod.F90 @@ -1048,7 +1048,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_complex_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_c_spk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_e_collective_mod.F90 b/base/modules/penv/psi_e_collective_mod.F90 index 4c3a006e..443f5f99 100644 --- a/base/modules/penv/psi_e_collective_mod.F90 +++ b/base/modules/penv/psi_e_collective_mod.F90 @@ -1416,7 +1416,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_int8_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_i2_collective_mod.F90 b/base/modules/penv/psi_i2_collective_mod.F90 index 911ed938..31a245b6 100644 --- a/base/modules/penv/psi_i2_collective_mod.F90 +++ b/base/modules/penv/psi_i2_collective_mod.F90 @@ -1416,7 +1416,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_int2_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_i2pk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_m_collective_mod.F90 b/base/modules/penv/psi_m_collective_mod.F90 index 206b15fa..8badcf87 100644 --- a/base/modules/penv/psi_m_collective_mod.F90 +++ b/base/modules/penv/psi_m_collective_mod.F90 @@ -1416,7 +1416,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_int4_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_s_collective_mod.F90 b/base/modules/penv/psi_s_collective_mod.F90 index eda86961..e4fb9d06 100644 --- a/base/modules/penv/psi_s_collective_mod.F90 +++ b/base/modules/penv/psi_s_collective_mod.F90 @@ -1539,7 +1539,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_real_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_r_spk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_z_collective_mod.F90 b/base/modules/penv/psi_z_collective_mod.F90 index a517cb03..8a58ffb5 100644 --- a/base/modules/penv/psi_z_collective_mod.F90 +++ b/base/modules/penv/psi_z_collective_mod.F90 @@ -1048,7 +1048,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_dcomplex_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_c_dpk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& diff --git a/base/tools/psb_csphalo.F90 b/base/tools/psb_csphalo.F90 index 668f7d52..79b2b5b7 100644 --- a/base/tools/psb_csphalo.F90 +++ b/base/tools/psb_csphalo.F90 @@ -1284,7 +1284,7 @@ Subroutine psb_c_lc_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& if(psb_get_errstatus() /= 0) return info=psb_success_ - name='psb_lc_csr_sphalo' + name='psb_c_lc_csr_sphalo' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 diff --git a/base/tools/psb_dsphalo.F90 b/base/tools/psb_dsphalo.F90 index 8d800f6d..24949cff 100644 --- a/base/tools/psb_dsphalo.F90 +++ b/base/tools/psb_dsphalo.F90 @@ -1284,7 +1284,7 @@ Subroutine psb_d_ld_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& if(psb_get_errstatus() /= 0) return info=psb_success_ - name='psb_ld_csr_sphalo' + name='psb_d_ld_csr_sphalo' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 diff --git a/base/tools/psb_ssphalo.F90 b/base/tools/psb_ssphalo.F90 index 038e72a5..f8958a45 100644 --- a/base/tools/psb_ssphalo.F90 +++ b/base/tools/psb_ssphalo.F90 @@ -1284,7 +1284,7 @@ Subroutine psb_s_ls_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& if(psb_get_errstatus() /= 0) return info=psb_success_ - name='psb_ls_csr_sphalo' + name='psb_s_ls_csr_sphalo' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 diff --git a/base/tools/psb_zsphalo.F90 b/base/tools/psb_zsphalo.F90 index 0e32938b..a862ce99 100644 --- a/base/tools/psb_zsphalo.F90 +++ b/base/tools/psb_zsphalo.F90 @@ -1284,7 +1284,7 @@ Subroutine psb_z_lz_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& if(psb_get_errstatus() /= 0) return info=psb_success_ - name='psb_lz_csr_sphalo' + name='psb_z_lz_csr_sphalo' call psb_erractionsave(err_act) if (psb_errstatus_fatal()) then info = psb_err_internal_error_ ; goto 9999 From c6dbee552eb2d428aac7325bec03b09592465011 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 12 Jun 2020 19:58:38 +0200 Subject: [PATCH 11/21] Fix type handling bug in simple_triad. --- base/modules/penv/psi_c_collective_mod.F90 | 2 +- base/modules/penv/psi_e_collective_mod.F90 | 2 +- base/modules/penv/psi_i2_collective_mod.F90 | 2 +- base/modules/penv/psi_m_collective_mod.F90 | 2 +- base/modules/penv/psi_s_collective_mod.F90 | 2 +- base/modules/penv/psi_z_collective_mod.F90 | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/base/modules/penv/psi_c_collective_mod.F90 b/base/modules/penv/psi_c_collective_mod.F90 index de836d38..a1fa78a3 100644 --- a/base/modules/penv/psi_c_collective_mod.F90 +++ b/base/modules/penv/psi_c_collective_mod.F90 @@ -1048,7 +1048,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_complex_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_c_spk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_e_collective_mod.F90 b/base/modules/penv/psi_e_collective_mod.F90 index 4c3a006e..443f5f99 100644 --- a/base/modules/penv/psi_e_collective_mod.F90 +++ b/base/modules/penv/psi_e_collective_mod.F90 @@ -1416,7 +1416,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_int8_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_i2_collective_mod.F90 b/base/modules/penv/psi_i2_collective_mod.F90 index 911ed938..31a245b6 100644 --- a/base/modules/penv/psi_i2_collective_mod.F90 +++ b/base/modules/penv/psi_i2_collective_mod.F90 @@ -1416,7 +1416,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_int2_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_i2pk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_m_collective_mod.F90 b/base/modules/penv/psi_m_collective_mod.F90 index 206b15fa..8badcf87 100644 --- a/base/modules/penv/psi_m_collective_mod.F90 +++ b/base/modules/penv/psi_m_collective_mod.F90 @@ -1416,7 +1416,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_int4_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_s_collective_mod.F90 b/base/modules/penv/psi_s_collective_mod.F90 index eda86961..e4fb9d06 100644 --- a/base/modules/penv/psi_s_collective_mod.F90 +++ b/base/modules/penv/psi_s_collective_mod.F90 @@ -1539,7 +1539,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_real_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_r_spk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& diff --git a/base/modules/penv/psi_z_collective_mod.F90 b/base/modules/penv/psi_z_collective_mod.F90 index a517cb03..8a58ffb5 100644 --- a/base/modules/penv/psi_z_collective_mod.F90 +++ b/base/modules/penv/psi_z_collective_mod.F90 @@ -1048,7 +1048,7 @@ contains idx = bsdindx(ip+1) p2ptag = psb_dcomplex_tag call mpi_send(valsnd(idx+1:idx+sz),sz,& - & psb_mpi_r_dpk_,prcid(ip+1),& + & psb_mpi_c_dpk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag call mpi_send(iasnd(idx+1:idx+sz),sz,& From e3649e1cb6ebe7ae9ac0ab5ae2db22718c515a98 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 17 Jun 2020 11:54:43 +0200 Subject: [PATCH 12/21] Do not use sorting on dependency lists unless dlavg<16 --- base/internals/psi_crea_index.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index 2b0a8321..69b58ac1 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -189,7 +189,9 @@ contains logical :: val val = .not.(((dlmax>(26*4)).or.((dlavg>=(26*2)).and.(np>=128)))) + val = (dlavg<16) !val = .true. + !val = .false. end function choose_sorting end subroutine psi_i_crea_index From 7df7b6ffcecd33eae17f14faba935b4b1ec3fa15 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 23 Jun 2020 11:28:37 +0200 Subject: [PATCH 13/21] Set adjacncy list during build of halo_index for all maps. --- base/internals/psi_bld_tmphalo.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/base/internals/psi_bld_tmphalo.f90 b/base/internals/psi_bld_tmphalo.f90 index f7143f18..dc13b7c2 100644 --- a/base/internals/psi_bld_tmphalo.f90 +++ b/base/internals/psi_bld_tmphalo.f90 @@ -104,6 +104,7 @@ subroutine psi_bld_tmphalo(desc,info) call desc%indxmap%l2gip(helem(1:nh),info) if (info == psb_success_) call desc%indxmap%fnd_owner(helem(1:nh),hproc,info) if (info == psb_success_) call desc%indxmap%set_halo_owner(hproc,info) + if (info == psb_success_) call desc%indxmap%xtnd_p_adjcncy(hproc) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='fnd_owner') From 64e4c194fdd74cbfba577797295ee582b41b3f5a Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 26 Jun 2020 14:33:35 +0200 Subject: [PATCH 14/21] Enable VECT objects in MMIO read/write. --- base/internals/psi_crea_index.f90 | 42 +- docs/html/userhtmlsu81.html | 17 +- docs/html/userhtmlsu82.html | 12 +- docs/html/userhtmlsu83.html | 33 +- docs/html/userhtmlsu90.html | 4 - docs/psblas-3.7.pdf | 1997 +++++++++++++++-------------- docs/src/util.tex | 16 +- util/psb_c_mmio_impl.f90 | 33 + util/psb_d_mmio_impl.f90 | 33 + util/psb_i_mmio_impl.F90 | 66 + util/psb_mmio_mod.F90 | 104 ++ util/psb_s_mmio_impl.f90 | 32 + util/psb_z_mmio_impl.f90 | 33 + 13 files changed, 1423 insertions(+), 999 deletions(-) diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index 69b58ac1..68bcbd20 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -71,9 +71,9 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) integer(psb_ipk_),parameter :: root=psb_root_,no_comm=-1 integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name - logical, parameter :: do_timings=.false. + logical, parameter :: do_timings=.false., shuffle_dep_list=.false. integer(psb_ipk_), save :: idx_phase1=-1, idx_phase2=-1, idx_phase3=-1 - integer(psb_ipk_), save :: idx_phase11=-1, idx_phase12=-1, idx_phase13=-1 + integer(psb_ipk_), save :: idx_phase21=-1, idx_phase22=-1, idx_phase13=-1 info = psb_success_ name='psi_crea_index' @@ -95,10 +95,10 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) & idx_phase2 = psb_get_timer_idx("PSI_CREA_INDEX: phase2") if ((do_timings).and.(idx_phase3==-1)) & & idx_phase3 = psb_get_timer_idx("PSI_CREA_INDEX: phase3") -!!$ if ((do_timings).and.(idx_phase11==-1)) & -!!$ & idx_phase11 = psb_get_timer_idx("PSI_CREA_INDEX: phase11 ") -!!$ if ((do_timings).and.(idx_phase12==-1)) & -!!$ & idx_phase12 = psb_get_timer_idx("PSI_CREA_INDEX: phase12") + if ((do_timings).and.(idx_phase21==-1)) & + & idx_phase21 = psb_get_timer_idx("PSI_CREA_INDEX: phase21 ") + if ((do_timings).and.(idx_phase22==-1)) & + & idx_phase22 = psb_get_timer_idx("PSI_CREA_INDEX: phase22") !!$ if ((do_timings).and.(idx_phase13==-1)) & !!$ & idx_phase13 = psb_get_timer_idx("PSI_CREA_INDEX: phase13") @@ -123,6 +123,7 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) if (do_timings) call psb_tic(idx_phase2) if (choose_sorting(dlmax,dlavg,np)) then + if (do_timings) call psb_tic(idx_phase21) call psi_bld_glb_dep_list(ictxt,& & loc_dl,length_dl,c_dep_list,dl_ptr,info) if (info /= 0) then @@ -131,13 +132,15 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) !!$ call psi_dl_check(dep_list,dl_lda,np,length_dl) !!$ !!$ ! ....now i can sort dependency lists. + if (do_timings) call psb_toc(idx_phase21) + if (do_timings) call psb_tic(idx_phase22) call psi_sort_dl(dl_ptr,c_dep_list,length_dl,ictxt,info) if (info /= 0) then write(0,*) me,trim(name),' From sort_dl ',info end if ldl = length_dl(me) loc_dl = c_dep_list(dl_ptr(me):dl_ptr(me)+ldl-1) - + if (do_timings) call psb_toc(idx_phase22) !!$ if(info /= psb_success_) then !!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psi_sort_dl') !!$ goto 9999 @@ -146,7 +149,26 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) else ! Do nothing ldl = length_dl(me) - loc_dl = loc_dl(1:ldl) + loc_dl = loc_dl(1:ldl) + if (shuffle_dep_list) then + ! + ! Apply a random shuffle to the dependency list + ! should improve the behaviour + ! + block + ! Algorithm 3.4.2P from TAOCP vol 2. + integer(psb_ipk_) :: tmp + integer :: j,k + real :: u + do j=ldl,2,-1 + call random_number(u) + k = min(j,floor(j*u)+1) + tmp = loc_dl(k) + loc_dl(k) = loc_dl(j) + loc_dl(j) = tmp + end do + end block + end if end if if (do_timings) call psb_toc(idx_phase2) @@ -189,9 +211,9 @@ contains logical :: val val = .not.(((dlmax>(26*4)).or.((dlavg>=(26*2)).and.(np>=128)))) - val = (dlavg<16) + val = (dlmax<16) !val = .true. - !val = .false. + val = .false. end function choose_sorting end subroutine psi_i_crea_index diff --git a/docs/html/userhtmlsu81.html b/docs/html/userhtmlsu81.html index 7bcaa337..b74cc797 100644 --- a/docs/html/userhtmlsu81.html +++ b/docs/html/userhtmlsu81.html @@ -66,9 +66,16 @@ class="description">Rigth hand side(s).
Type: required
An array of type real or complex, rank 1 or 2 and having the - ALLOCATABLE attribute; will be allocated and filled in if the input file - contains a right hand side, otherwise will be left in the UNALLOCATED - state. + ALLOCATABLE attribute, or an object of type psb_T_vect_type, of + type real or complex.
Will be allocated and filled in if the input file contains a right hand side, + otherwise will be left in the UNALLOCATED state.
iret
An integer value; 0 means no error has been detected.
call psb_scatter(glob_x, loc_x, desc_a, info, root, mold) +class="cmtt-10">call psb_scatter(glob_x, loc_x, desc_a, info, root, mold)
diff --git a/docs/html/userhtmlsu6.html b/docs/html/userhtmlsu6.html index 18b94c13..f0ba830f 100644 --- a/docs/html/userhtmlsu6.html +++ b/docs/html/userhtmlsu6.html @@ -45,8 +45,14 @@ class="description">Single precision complex;
Z
Double precision complex.
-

The actual data is contained in the polymorphic component Double precision complex; +

+LS,LD,LC,LZ
Same numeric type as above, but with psb_lpk_ integer + indices.
+

The actual data is contained in the polymorphic component a%a of type psb_spasb routine.


-

+

  type :: psb_Tspmat_type  
    class(psb_T_base_sparse_mat), allocatable  :: a  
  end type  psb_Tspmat_type
-

+


Figure 4: The PSBLAS defined data type that contains a sparse matrix.
-


-

The following very common formats are precompiled in PSBLAS and thus are +


+

The following very common formats are precompiled in PSBLAS and thus are always available:

_coo_sparse_mat
Coordinate storage; + + +
psb_csc_sparse_mat
Compressed storage by columns;
- - - -

The inner sparse matrix has an associated state, which can take the following +

The inner sparse matrix has an associated state, which can take the following values:

State entered after a reinitalization; this is used to handl in which the same sparsity pattern is used multiple times with different coefficients. In this state it is only possible to enter coefficients for already existing nonzero entries.
-

The only storage variant supporting the build state is COO; all other variants are +

The only storage variant supporting the build state is COO; all other variants are obtained by conversion to/from it. -

+

3.2.1 Sparse Matrix Methods
-

+

3.2.2 get_nrows — Get number of rows in a sparse matrix
@@ -135,8 +141,8 @@ obtained by conversion to/from it.
nr = a%get_nrows()
-

-

+

+

Type:
the sparse matrix
Scope: local
-

+

On Return
class="cmbx-10">Function value
The number of rows of sparse matrix a.
-

+

3.2.3 get_ncols — Get number of columns in a sparse matrix
@@ -171,8 +177,8 @@ class="cmtt-10">a.
nc = a%get_ncols()
-

-

+

+

Type:
the sparse matrix
Scope: local
-

+

On Return
class="cmbx-10">Function value
The number of columns of sparse matrix a.
-

+

3.2.4 get_nnzeros — Get number of nonzero elements in a sparse matrix
@@ -207,8 +213,8 @@ class="cmtt-10">a.
nz = a%get_nnzeros()
-

-

+

+

Type:
the sparse matrix
Scope: local
-

+

On Return
class="cmbx-10">Function value
The number of nonzero elements stored in sparse matrix a.
-

Notes

  1. Notes class="cmtt-10">a; some storage formats employ padding, thus the returned value for the same matrix may be different for different storage choices.
-

+

3.2.5 get_size — Get maximum number of nonzero elements in a sparse matrix
@@ -252,8 +258,8 @@ matrix
maxnz = a%get_size()
-

-

+

+

Type:
the sparse matrix
Scope: local
-

+

On Return
Function value
The maximum number of nonzero elements that can be stored in sparse matrix a using its current memory allocation.
-

+

3.2.6 sizeof — Get memory occupation in bytes of a sparse matrix
@@ -289,8 +295,8 @@ class="cmtt-10">a using its current memory allocation.
memory_size = a%sizeof()
-

-

+

+

Type:
the sparse matrix
Scope: local
-

+

On Return
Function value
The memory occupation in bytes.
-

+

3.2.7 get_fmt — Short description of the dynamic type
@@ -324,8 +330,8 @@ class="description">The memory occupation in bytes.
write(*,*) a%get_fmt()
-

-

+

+

Type:
the sparse matrix
Scope: local
-

+

On Return
NULL, COO, CSR and CSC.
-

+

3.2.8 is_bld, is_upd, is_asb — Status check
@@ -366,8 +372,8 @@ if (a%is_bld()) then  
if (a%is_upd()) then  
if (a%is_asb()) then -

-

+

+

Type:
the sparse matrix
Scope: local
-

+

On Return
Function value
A logical value indicating whether the matrix is in the Build, Update or Assembled state, respectively.
-

+

3.2.9 is_lower, is_upper, is_triangle, is_unit — Format check
@@ -406,8 +412,8 @@ if (a%is_triangle()) then  
if (a%is_lower()) then  
if (a%is_unit()) then -

-

+

+

Type:
the sparse matrix
Scope: local
-

+

On Return
logical value indicating whether the matrix class="cmtt-10">is_triangle() returns .true. check also if it is lower, upper and with a unit (i.e. assumed) diagonal.
-

+

3.2.10 cscnv — Convert to a different storage format
@@ -447,8 +453,8 @@ class="cmtt-10">.true. check also if it is lower, upper and call  a%cscnv(b,info [, type, mold, dupl])  
call  a%cscnv(info [, type, mold, dupl]) -

-

+

+

Type:
Type: optional. class="cmbx-10">dupl
an integer value specifing how to handle duplicates (see Named Constants below)
-

+

On Return
psb_Tspmat_type. info
Return code.
-

The

The mold arguments may be employed to interface with special devices, such as GPUs and other accelerators. -

+

3.2.11 csclip — Reduce to a submatrix
@@ -511,8 +517,8 @@ and other accelerators.     call a%csclip(b,info[,&  
       & imin,imax,jmin,jmax,rscale,cscale]) -

-

Returns the submatrix

+

Returns the submatrix A(imin:imax,jmin:jmax), optionally rescaling row/col indices to the range 1:imax-imin+1,1:jmax-jmin+1. @@ -542,7 +548,7 @@ class="newline" />Type: optional. rscale,cscale

Whether to rescale row/column indices. Type: optional.
-

+

On Return
psb_Tspmat_type. info
Return code.
-

+

3.2.12 clean_zeros — Eliminate zero coefficients
@@ -567,11 +573,11 @@ class="description">Return code.
    call a%clean_zeros(info)
-

-

Eliminates zero coefficients in the input matrix. Note that depending on the +

+

Eliminates zero coefficients in the input matrix. Note that depending on the internal storage format, there may still be some amount of zero padding in the output. -

+

Type:
psb_Tspmat_type.
Scope: local.
-

+

On Return
psb_Tspmat_type. info
Return code.
-

+

3.2.13 get_diag — Get main diagonal
@@ -614,8 +620,8 @@ class="description">Return code.
    call a%get_diag(d,info)
-

-

Returns a copy of the main diagonal. +

+

Returns a copy of the main diagonal.

Type:
psb_Tspmat_type.
Scope: local.
-

+

On Return
A one-dimensional array of the appropriate type. info
Return code.
-

+

3.2.14 clip_diag — Cut out main diagonal
@@ -656,8 +662,8 @@ class="description">Return code.
    call a%clip_diag(b,info)
-

-

Returns a copy of

+

Returns a copy of a without the main diagonal.

psb_Tspmat_type.
Scope: local.
-

+

On Return
psb_Tspmat_type. info
Return code.
-

+

3.2.15 tril — Return the lower triangle
@@ -702,8 +708,8 @@ class="description">Return code.     call a%tril(l,info[,&  
       & diag,imin,imax,jmin,jmax,rscale,cscale,u]) -

-

Returns the lower triangular part of submatrix

+

Returns the lower triangular part of submatrix A(imin:imax,jmin:jmax), optionally rescaling row/col indices to the range 1:imax-imin+1,1:jmax-jmin+1 and @@ -741,7 +747,7 @@ class="newline" />Type: optional. rscale,cscale

Whether to rescale row/column indices. Type: optional.
-

+

On Return
psb_Tspmat_type. info
Return code.
-

+

3.2.16 triu — Return the upper triangle
@@ -774,8 +780,8 @@ class="description">Return code.     call a%triu(u,info[,&  
       & diag,imin,imax,jmin,jmax,rscale,cscale,l]) -

-

Returns the upper triangular part of submatrix

+

Returns the upper triangular part of submatrix A(imin:imax,jmin:jmax), optionally rescaling row/col indices to the range 1:imax-imin+1,1:jmax-jmin+1, @@ -813,7 +819,7 @@ class="newline" />Type: optional. rscale,cscale

Whether to rescale row/column indices. Type: optional.
-

+

On Return
psb_Tspmat_type. info
Return code.
-

+

3.2.17 psb_set_mat_default — Set default storage format
@@ -845,8 +851,8 @@ class="description">Return code.
call  psb_set_mat_default(a)
-

-

+

+

Type:
a variable of class(psb_T_base_sparse_mat) requesting a new default storage format.
Type: required.
-

+

3.2.18 clone — Clone current object
@@ -871,8 +877,8 @@ class="newline" />Type: required.
call  a%clone(b,info)
-

-

+

+

Type:
the sparse matrix.
Scope: local.
-

+

On Return
A copy of the input object. info
Return code.
-

+

3.2.19 Named Constants
-

+

psbUpdate strategy based on additional permutation data (see -
Double precision complex.
-

The actual data is contained in the polymorphic component

The actual data is contained in the polymorphic component v%v; the separation between the application and the actual data is essential for cases where it is necessary to link to data storage made available elsewhere outside the direct control of the @@ -70,7 +70,7 @@ compiler/application, e.g. data stored in a graphics accelerator’s private id="x15-460015">

-

+

  type psb_T_base_vect_type  
    TYPE(KIND_), allocatable :: v(:) @@ -81,18 +81,18 @@ compiler/application, e.g. data stored in a graphics accelerator’s private  
  end type  psb_T_vect_type  
-

+


Figure 5: The PSBLAS defined data type that contains a dense vector.
-


-

+


+

3.3.1 Vector Methods
-

+

3.3.2 get_nrows — Get number of rows in a dense vector
@@ -101,8 +101,8 @@ class="content"> The PSBLAS defined data type that contains a dense vector. nr = v%get_nrows() -

-

+

+

Type:
the dense vector
Scope: local
-

+

On Return
class="cmbx-10">Function value
The number of rows of dense vector v.
-

+

3.3.3 sizeof — Get memory occupation in bytes of a dense vector
@@ -137,8 +137,8 @@ class="cmtt-10">v.
memory_size = v%sizeof()
-

-

+

+

Type:
the dense vector
Scope: local
-

+

On Return
Function value
The memory occupation in bytes.
-

+

3.3.4 set — Set contents of the vector
@@ -174,8 +174,8 @@ class="description">The memory occupation in bytes.  
 call  v%set(vect[,first,last])  
 call  v%zero() -

-

+

+

Type:
Intent: in.
Specified as: a number of the data type indicated in Table 1.
-

Note that a call to

Note that a call to v%zero() is provided as a shorthand, but is equivalent to a call to v%set(zero) with the zero constant having the appropriate type and kind. -

+

On Return
-

+

3.3.5 get_vect — Get a copy of the vector contents
@@ -256,8 +256,8 @@ class="newline" />
extv = v%get_vect([n])
-

-

+

+

Type:
Type: optional; default: entire vector.
-

+

On Return
n and the internal size of the vector, or 0 if n is negative; otherwise, the size of the array is the same as the internal size of the vector.
-

+

3.3.6 clone — Clone current object
@@ -308,8 +308,8 @@ class="cmmi-10">n is negative; otherwise, the size of the array is the sa
call  x%clone(y,info)
-

-

+

+

Type:
the dense vector.
Scope: local.
-

+

On Return
Return code.
-
call psb_errpush(err_c, r_name, i_err, a_err) +class="cmtt-10">call psb_errpush(err_c, r_name, i_err, a_err)

diff --git a/docs/html/userhtmlsu75.html b/docs/html/userhtmlsu75.html index b4726464..1b0b6bcd 100644 --- a/docs/html/userhtmlsu75.html +++ b/docs/html/userhtmlsu75.html @@ -21,7 +21,12 @@ href="userhtmlsu76.html#userhtmlse9.html" >up]

call psb_error(icontxt) +class="cmtt-10">call psb_error(icontxt)

diff --git a/docs/html/userhtmlsu76.html b/docs/html/userhtmlsu76.html index 218404fa..6ae8a04e 100644 --- a/docs/html/userhtmlsu76.html +++ b/docs/html/userhtmlsu76.html @@ -21,7 +21,12 @@ href="userhtmlsu76.html#userhtmlsu78.html" >up]

call psb_set_errverbosity(v) +class="cmtt-10">call psb_set_errverbosity(v)

diff --git a/docs/html/userhtmlsu77.html b/docs/html/userhtmlsu77.html index e1e62e1b..e3002b2c 100644 --- a/docs/html/userhtmlsu77.html +++ b/docs/html/userhtmlsu77.html @@ -21,7 +21,12 @@ condition

call psb_set_erraction(err_act) +class="cmtt-10">call psb_set_erraction(err_act)

diff --git a/docs/html/userhtmlsu78.html b/docs/html/userhtmlsu78.html index d7e6fd9f..d793b344 100644 --- a/docs/html/userhtmlsu78.html +++ b/docs/html/userhtmlsu78.html @@ -21,7 +21,27 @@ format

call hb_read(a, iret, iunit, filename, b, mtitle) +class="cmtt-10">call hb_read(a, iret, iunit, filename, b, mtitle)

diff --git a/docs/html/userhtmlsu79.html b/docs/html/userhtmlsu79.html index 47418d21..55d166d1 100644 --- a/docs/html/userhtmlsu79.html +++ b/docs/html/userhtmlsu79.html @@ -22,7 +22,30 @@ format

call hb_write(a, iret, iunit, filename, key, rhs, mtitle) +class="cmtt-10">call hb_write(a, iret, iunit, filename, key, rhs, mtitle)

diff --git a/docs/html/userhtmlsu8.html b/docs/html/userhtmlsu8.html index 5c0ff71c..5a02be22 100644 --- a/docs/html/userhtmlsu8.html +++ b/docs/html/userhtmlsu8.html @@ -10,7 +10,7 @@ -


Figure 6: The PSBLAS defined data type that contains a preconditioner.
-


+


-