From 3ae846edb5a99bdad89f7fd757a6f8a2b12b0144 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 23 Oct 2019 15:57:47 +0100 Subject: [PATCH] Start refactoring of crea_index --- base/internals/psi_crea_index.f90 | 16 ++++++++-------- base/internals/psi_extrct_dl.F90 | 28 +++++++++++++++++----------- base/modules/psi_i_mod.F90 | 14 +++++++------- test/pargen/psb_d_pde3d.f90 | 4 ++-- 4 files changed, 34 insertions(+), 28 deletions(-) diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index 56be421e..c948be88 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -88,13 +88,13 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) ! allocate dependency list ! This should be computed more efficiently to save space when ! the number of processors becomes very high - dl_lda=np+1 - - allocate(dep_list(max(1,dl_lda),0:np),length_dl(0:np),stat=info) - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') - goto 9999 - end if +!!$ dl_lda=np+1 +!!$ +!!$ allocate(dep_list(max(1,dl_lda),0:np),length_dl(0:np),stat=info) +!!$ if (info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') +!!$ goto 9999 +!!$ end if ! ...extract dependence list (ordered list of identifer process ! which every process must communcate with... @@ -104,7 +104,7 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) call psi_extract_dep_list(ictxt,& & desc_a%is_bld(), desc_a%is_upd(),& - & index_in, dep_list,length_dl,np,max(1,dl_lda),mode,info) + & index_in, dep_list,length_dl,dl_lda,mode,info) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='extrct_dl') goto 9999 diff --git a/base/internals/psi_extrct_dl.F90 b/base/internals/psi_extrct_dl.F90 index 7e36e940..32a0264f 100644 --- a/base/internals/psi_extrct_dl.F90 +++ b/base/internals/psi_extrct_dl.F90 @@ -30,7 +30,7 @@ ! ! subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& - & length_dl,np,dl_lda,mode,info) + & length_dl,dl_lda,mode,info) ! internal routine ! == = ============= @@ -131,13 +131,12 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& include 'mpif.h' #endif ! ....scalar parameters... - logical :: is_bld, is_upd - integer(psb_ipk_) :: ictxt - integer(psb_ipk_) :: np,dl_lda,mode, info - - ! ....array parameters.... - integer(psb_ipk_) :: desc_str(*) - integer(psb_ipk_) :: dep_list(dl_lda,0:np),length_dl(0:np) + logical, intent(in) :: is_bld, is_upd + integer(psb_ipk_), intent(in) :: ictxt,mode + integer(psb_ipk_), intent(out) :: dl_lda + integer(psb_ipk_), intent(in) :: desc_str(*) + integer(psb_ipk_), allocatable, intent(out) :: dep_list(:,:),length_dl(:) + integer(psb_ipk_), intent(out) :: info ! .....local arrays.... integer(psb_ipk_) :: int_err(5) integer(psb_ipk_), allocatable :: itmp(:) @@ -146,7 +145,7 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& integer(psb_ipk_) :: i,pointer_dep_list,proc,j,err_act integer(psb_ipk_) :: err integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_mpk_) :: iictxt, icomm, me, npr, dl_mpi, minfo + integer(psb_mpk_) :: iictxt, icomm, me, np, dl_mpi, minfo character name*20 name='psi_extrct_dl' @@ -156,7 +155,14 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& iictxt = ictxt info = psb_success_ - call psb_info(iictxt,me,npr) + call psb_info(iictxt,me,np) + dl_lda=np+1 + allocate(dep_list(dl_lda,0:np),length_dl(0:np),stat=info) + if (info /= psb_success_) then + call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate') + goto 9999 + end if + do i=0,np length_dl(i) = 0 enddo @@ -176,7 +182,7 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& if ((desc_str(i+1) /= 0).or.(desc_str(i+2) /= 0)) then ! ..if number of element to be exchanged !=0 proc=desc_str(i) - if ((proc < 0).or.(proc >= npr)) then + if ((proc < 0).or.(proc >= np)) then if (debug_level >= psb_debug_inner_)& & write(debug_unit,*) me,' ',trim(name),': error ',i,desc_str(i) info = 9999 diff --git a/base/modules/psi_i_mod.F90 b/base/modules/psi_i_mod.F90 index b41f20b5..099d62a4 100644 --- a/base/modules/psi_i_mod.F90 +++ b/base/modules/psi_i_mod.F90 @@ -115,15 +115,15 @@ module psi_i_mod interface psi_extract_dep_list subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& - & length_dl,np,dl_lda,mode,info) + & length_dl,dl_lda,mode,info) import implicit none - logical :: is_bld, is_upd - integer(psb_ipk_) :: ictxt - integer(psb_ipk_) :: dl_lda,mode - integer(psb_ipk_) :: desc_str(*),dep_list(dl_lda,0:np),length_dl(0:np) - integer(psb_ipk_) :: np - integer(psb_ipk_) :: info + logical, intent(in) :: is_bld, is_upd + integer(psb_ipk_), intent(in) :: ictxt,mode + integer(psb_ipk_), intent(out) :: dl_lda + integer(psb_ipk_), intent(in) :: desc_str(*) + integer(psb_ipk_), allocatable, intent(out) :: dep_list(:,:),length_dl(:) + integer(psb_ipk_), intent(out) :: info end subroutine psi_i_extract_dep_list end interface diff --git a/test/pargen/psb_d_pde3d.f90 b/test/pargen/psb_d_pde3d.f90 index 429e9a0e..74508a87 100644 --- a/test/pargen/psb_d_pde3d.f90 +++ b/test/pargen/psb_d_pde3d.f90 @@ -235,8 +235,8 @@ contains call psb_erractionsave(err_act) call psb_info(ictxt, iam, np) - - + call psb_cd_set_large_threshold(1000) + if (present(f)) then f_ => f else