From 4507a6522ab8a773695b56d973e5496b5c4aeff6 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 1 Nov 2019 08:31:56 +0000 Subject: [PATCH] New indxmap component for process adjacency list, setters/getters. --- base/internals/psi_extrct_dl.F90 | 7 ++++ base/modules/Makefile | 2 +- base/modules/desc/psb_desc_mod.F90 | 36 ++++++++++++++++++-- base/modules/desc/psb_indx_map_mod.f90 | 47 +++++++++++++++++++++++++- 4 files changed, 87 insertions(+), 5 deletions(-) diff --git a/base/internals/psi_extrct_dl.F90 b/base/internals/psi_extrct_dl.F90 index 017ce78f..489f9270 100644 --- a/base/internals/psi_extrct_dl.F90 +++ b/base/internals/psi_extrct_dl.F90 @@ -251,6 +251,13 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& length_dl(me)=pointer_dep_list-1 dl_lda = max(length_dl(me),1) call psb_max(iictxt, dl_lda) + ! + ! This doubling of DL_LDA is not 100% safe, + ! but should work most of the time. + ! Will need to be improved later, perhaps move + ! from a 2D allocation (ellpack style) to + ! a 1D allocation (csr like). + ! dl_lda = min(2*dl_lda,np+1) allocate(dep_list(dl_lda,0:np),stat=info) if (info /= psb_success_) then diff --git a/base/modules/Makefile b/base/modules/Makefile index b6ab52ea..21525a3c 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -261,7 +261,7 @@ psi_z_mod.o: desc/psb_desc_mod.o serial/psb_z_vect_mod.o comm/psi_z_comm_a_mod.o psi_mod.o: psb_penv_mod.o desc/psb_desc_mod.o auxil/psi_serial_mod.o serial/psb_serial_mod.o\ psi_i_mod.o psi_l_mod.o psi_s_mod.o psi_d_mod.o psi_c_mod.o psi_z_mod.o -desc/psb_indx_map_mod.o: desc/psb_desc_const_mod.o psb_error_mod.o psb_penv_mod.o psb_realloc_mod.o +desc/psb_indx_map_mod.o: desc/psb_desc_const_mod.o psb_error_mod.o psb_penv_mod.o psb_realloc_mod.o auxil/psb_sort_mod.o desc/psb_hash_map_mod.o desc/psb_list_map_mod.o desc/psb_repl_map_mod.o desc/psb_gen_block_map_mod.o:\ desc/psb_indx_map_mod.o desc/psb_desc_const_mod.o \ auxil/psb_sort_mod.o psb_penv_mod.o diff --git a/base/modules/desc/psb_desc_mod.F90 b/base/modules/desc/psb_desc_mod.F90 index 7170af96..50f21808 100644 --- a/base/modules/desc/psb_desc_mod.F90 +++ b/base/modules/desc/psb_desc_mod.F90 @@ -233,6 +233,9 @@ module psb_desc_mod procedure, pass(desc) :: get_global_rows => psb_cd_get_global_rows procedure, pass(desc) :: get_global_cols => psb_cd_get_global_cols procedure, pass(desc) :: get_global_indices => psb_cd_get_global_indices + procedure, pass(desc) :: get_p_adjcncy => cd_get_p_adjcncy + procedure, pass(desc) :: set_p_adjcncy => cd_set_p_adjcncy + procedure, pass(desc) :: xtnd_p_adjcncy => cd_xtnd_p_adjcncy procedure, pass(desc) :: a_get_list => psb_cd_get_list procedure, pass(desc) :: v_get_list => psb_cd_v_get_list generic, public :: get_list => a_get_list, v_get_list @@ -557,9 +560,7 @@ contains end function psb_cd_get_global_indices - - - + function cd_get_fmt(desc) result(val) implicit none character(len=5) :: val @@ -620,6 +621,35 @@ contains end function psb_cd_get_mpic + function cd_get_p_adjcncy(desc) result(val) + implicit none + integer(psb_ipk_), allocatable :: val(:) + class(psb_desc_type), intent(in) :: desc + + if (allocated(desc%indxmap)) then + val = desc%indxmap%get_p_adjcncy() + endif + + end function cd_get_p_adjcncy + + subroutine cd_set_p_adjcncy(desc,val) + implicit none + class(psb_desc_type), intent(inout) :: desc + integer(psb_ipk_), intent(in) :: val(:) + if (allocated(desc%indxmap)) then + call desc%indxmap%xtnd_p_adjcncy(val) + endif + end subroutine cd_set_p_adjcncy + + subroutine cd_xtnd_p_adjcncy(desc,val) + implicit none + class(psb_desc_type), intent(inout) :: desc + integer(psb_ipk_), intent(in) :: val(:) + if (allocated(desc%indxmap)) then + call desc%indxmap%xtnd_p_adjcncy(val) + endif + end subroutine cd_xtnd_p_adjcncy + subroutine psb_cd_set_ovl_asb(desc,info) ! ! Change state of a descriptor into ovl_build. diff --git a/base/modules/desc/psb_indx_map_mod.f90 b/base/modules/desc/psb_indx_map_mod.f90 index 43ba1e8e..0a2098f9 100644 --- a/base/modules/desc/psb_indx_map_mod.f90 +++ b/base/modules/desc/psb_indx_map_mod.f90 @@ -146,6 +146,8 @@ module psb_indx_map_mod procedure, pass(idxmap) :: get_lr => base_get_lr procedure, pass(idxmap) :: get_lc => base_get_lc + procedure, pass(idxmap) :: get_p_adjcncy => base_get_p_adjcncy + procedure, pass(idxmap) :: set_gri => base_set_gri procedure, pass(idxmap) :: set_gci => base_set_gci @@ -157,6 +159,9 @@ module psb_indx_map_mod procedure, pass(idxmap) :: set_lr => base_set_lr procedure, pass(idxmap) :: set_lc => base_set_lc + procedure, pass(idxmap) :: set_p_adjcncy => base_set_p_adjcncy + procedure, pass(idxmap) :: xtnd_p_adjcncy => base_xtnd_p_adjcncy + procedure, pass(idxmap) :: set_ctxt => base_set_ctxt procedure, pass(idxmap) :: set_mpic => base_set_mpic procedure, pass(idxmap) :: get_ctxt => base_get_ctxt @@ -240,7 +245,8 @@ module psb_indx_map_mod & base_lg2lv2_ins, base_init_vl, base_is_null,& & base_row_extendable, base_clone, base_cpy, base_reinit, & & base_set_halo_owner, base_get_halo_owner, & - & base_fnd_halo_owner_s, base_fnd_halo_owner_v + & base_fnd_halo_owner_s, base_fnd_halo_owner_v,& + & base_get_p_adjcncy, base_set_p_adjcncy, base_xtnd_p_adjcncy !> Function: psi_indx_map_fnd_owner !! \memberof psb_indx_map @@ -355,6 +361,16 @@ contains end function base_get_lc + function base_get_p_adjcncy(idxmap) result(val) + use psb_realloc_mod + implicit none + class(psb_indx_map), intent(in) :: idxmap + integer(psb_ipk_), allocatable :: val(:) + integer(psb_ipk_) :: info + + call psb_safe_ab_cpy(idxmap%p_adjcncy,val,info) + + end function base_get_p_adjcncy function base_get_ctxt(idxmap) result(val) implicit none @@ -440,6 +456,35 @@ contains idxmap%local_cols = val end subroutine base_set_lc + subroutine base_set_p_adjcncy(idxmap,val) + use psb_realloc_mod + use psb_sort_mod + implicit none + class(psb_indx_map), intent(inout) :: idxmap + integer(psb_ipk_), intent(in) :: val(:) + + call idxmap%xtnd_p_adjcncy(val) + + end subroutine base_set_p_adjcncy + + subroutine base_xtnd_p_adjcncy(idxmap,val) + use psb_realloc_mod + use psb_sort_mod + implicit none + class(psb_indx_map), intent(inout) :: idxmap + integer(psb_ipk_), intent(in) :: val(:) + integer(psb_ipk_) :: info, nv, nx + + nv = size(val) + nx = psb_size(idxmap%p_adjcncy) + call psb_realloc(nv+nx,idxmap%p_adjcncy,info) + idxmap%p_adjcncy(nx+1:nx+nv) = val(1:nv) + nx = size(idxmap%p_adjcncy) + call psb_msort_unique(idxmap%p_adjcncy,nx,dir=psb_sort_up_) + call psb_realloc(nx,idxmap%p_adjcncy,info) + + end subroutine base_xtnd_p_adjcncy + subroutine base_set_mpic(idxmap,val) implicit none class(psb_indx_map), intent(inout) :: idxmap