diff --git a/base/internals/psi_idx_ins_cnv.f90 b/base/internals/psi_idx_ins_cnv.f90 index 0e3a7f93..b4f0d475 100644 --- a/base/internals/psi_idx_ins_cnv.f90 +++ b/base/internals/psi_idx_ins_cnv.f90 @@ -214,6 +214,7 @@ subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask) integer :: i,ictxt,k,mglob, nglob integer :: np, me, isize integer :: pnt_halo,nrow,ncol, nh, ip, err_act,lip,nxt + logical :: pnth_ok integer, parameter :: relocsz=200 character(len=20) :: name,ch_err logical, pointer :: mask_(:) @@ -319,11 +320,26 @@ subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask) if (.not.allocated(desc%halo_index)) then allocate(desc%halo_index(relocsz)) desc%halo_index(:) = -1 + desc%matrix_data(psb_pnt_h_) = 1 endif - pnt_halo=1 - do while (desc%halo_index(pnt_halo) /= -1 ) - pnt_halo = pnt_halo + 1 - end do + pnt_halo = desc%matrix_data(psb_pnt_h_) + + pnth_ok = .false. + if (desc%halo_index(pnt_halo) == -1 ) then + if (pnt_halo == 1) then + pnth_ok = .true. + else if (desc%halo_index(pnt_halo-1) /= -1 ) then + pnth_ok = .true. + end if + end if + + if (.not.pnth_ok) then + pnt_halo = 1 + do while (desc%halo_index(pnt_halo) /= -1 ) + pnt_halo = pnt_halo + 1 + end do + end if + isize = size(desc%halo_index) do i = 1, nv @@ -377,7 +393,7 @@ subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask) idxout(i) = -1 end if enddo - + desc%matrix_data(psb_pnt_h_) = pnt_halo end if desc%matrix_data(psb_n_col_) = ncol diff --git a/base/modules/psb_desc_type.f90 b/base/modules/psb_desc_type.f90 index beb997a9..dbe7dd28 100644 --- a/base/modules/psb_desc_type.f90 +++ b/base/modules/psb_desc_type.f90 @@ -66,23 +66,28 @@ module psb_descriptor_type ! ! Entries and values in desc%matrix_data ! - integer, parameter :: psb_dec_type_=1, psb_m_=2,psb_n_=3 - integer, parameter :: psb_n_row_=4, psb_n_col_=5,psb_ctxt_=6 - integer, parameter :: psb_desc_size_=7 - integer, parameter :: psb_mpi_c_=9 - integer, parameter :: psb_thal_xch_=11 - integer, parameter :: psb_thal_snd_=12 - integer, parameter :: psb_thal_rcv_=13 - integer, parameter :: psb_tovr_xch_=14 - integer, parameter :: psb_tovr_snd_=15 - integer, parameter :: psb_tovr_rcv_=16 - integer, parameter :: psb_text_xch_=17 - integer, parameter :: psb_text_snd_=18 - integer, parameter :: psb_text_rcv_=19 - integer, parameter :: psb_tmov_xch_=20 - integer, parameter :: psb_tmov_snd_=21 - integer, parameter :: psb_tmov_rcv_=22 - integer, parameter :: psb_mdata_size_=24 + integer, parameter :: psb_dec_type_ = 1 + integer, parameter :: psb_m_ = 2 + integer, parameter :: psb_n_ = 3 + integer, parameter :: psb_n_row_ = 4 + integer, parameter :: psb_n_col_ = 5 + integer, parameter :: psb_ctxt_ = 6 + integer, parameter :: psb_desc_size_ = 7 + integer, parameter :: psb_mpi_c_ = 9 + integer, parameter :: psb_pnt_h_ = 10 + integer, parameter :: psb_thal_xch_ = 11 + integer, parameter :: psb_thal_snd_ = 12 + integer, parameter :: psb_thal_rcv_ = 13 + integer, parameter :: psb_tovr_xch_ = 14 + integer, parameter :: psb_tovr_snd_ = 15 + integer, parameter :: psb_tovr_rcv_ = 16 + integer, parameter :: psb_text_xch_ = 17 + integer, parameter :: psb_text_snd_ = 18 + integer, parameter :: psb_text_rcv_ = 19 + integer, parameter :: psb_tmov_xch_ = 20 + integer, parameter :: psb_tmov_snd_ = 21 + integer, parameter :: psb_tmov_rcv_ = 22 + integer, parameter :: psb_mdata_size_= 24 integer, parameter :: psb_desc_asb_=3099 integer, parameter :: psb_desc_bld_=psb_desc_asb_+1 integer, parameter :: psb_desc_repl_=3199 diff --git a/base/tools/psb_cd_inloc.f90 b/base/tools/psb_cd_inloc.f90 index d3fef3be..65c183ad 100644 --- a/base/tools/psb_cd_inloc.f90 +++ b/base/tools/psb_cd_inloc.f90 @@ -354,15 +354,17 @@ subroutine psb_cd_inloc(v, ictxt, desc, info) desc%matrix_data(psb_n_row_) = loc_row desc%matrix_data(psb_n_col_) = loc_row - call psb_realloc(1,desc%halo_index, info) - if (info == 0) call psb_realloc(1,desc%ext_index, info) + call psb_realloc(max(1,loc_row/2),desc%halo_index, info) + if (info == 0) call psb_realloc(1,desc%ext_index, info) if (info /= 0) then info=4010 call psb_errpush(info,name,a_err='psb_realloc') Goto 9999 end if - desc%halo_index(:) = -1 - desc%ext_index(:) = -1 + desc%matrix_data(psb_pnt_h_) = 1 + desc%halo_index(:) = -1 + desc%ext_index(:) = -1 + if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': end' diff --git a/base/tools/psb_cdals.f90 b/base/tools/psb_cdals.f90 index 596558ce..b6fc5ec4 100644 --- a/base/tools/psb_cdals.f90 +++ b/base/tools/psb_cdals.f90 @@ -168,6 +168,7 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info) ! hashed by the low order bits of the entries. ! loc_col = (m+np-1)/np + loc_col = min(2*loc_col,m) allocate(desc%loc_to_glob(loc_col), desc%lprm(1),& & desc%ptree(2),stat=info) if (info == 0) call InitPairSearchTree(desc%ptree,info) @@ -380,15 +381,16 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info) desc%matrix_data(psb_n_row_) = loc_row desc%matrix_data(psb_n_col_) = loc_row - call psb_realloc(1,desc%halo_index, info) + call psb_realloc(max(1,loc_row/2),desc%halo_index, info) if (info == 0) call psb_realloc(1,desc%ext_index, info) if (info /= 0) then info=4010 call psb_errpush(info,name,a_err='psb_realloc') Goto 9999 end if - desc%halo_index(:) = -1 - desc%ext_index(:) = -1 + desc%matrix_data(psb_pnt_h_) = 1 + desc%halo_index(:) = -1 + desc%ext_index(:) = -1 call psb_cd_set_bld(desc,info) diff --git a/base/tools/psb_cdalv.f90 b/base/tools/psb_cdalv.f90 index ecdbdba7..351d8ef7 100644 --- a/base/tools/psb_cdalv.f90 +++ b/base/tools/psb_cdalv.f90 @@ -314,21 +314,16 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) desc%matrix_data(psb_n_row_) = loc_row desc%matrix_data(psb_n_col_) = loc_row - call psb_realloc(1,desc%halo_index, info) - if (info /= psb_no_err_) then + call psb_realloc(max(1,loc_row/2),desc%halo_index, info) + if (info == 0) call psb_realloc(1,desc%ext_index, info) + if (info /= 0) then info=4010 - call psb_errpush(err,name,a_err='psb_realloc') + call psb_errpush(info,name,a_err='psb_realloc') Goto 9999 end if - desc%halo_index(:) = -1 - - call psb_realloc(1,desc%ext_index, info) - if (info /= psb_no_err_) then - info=4010 - call psb_errpush(err,name,a_err='psb_realloc') - Goto 9999 - end if - desc%ext_index(:) = -1 + desc%matrix_data(psb_pnt_h_) = 1 + desc%halo_index(:) = -1 + desc%ext_index(:) = -1 call psb_cd_set_bld(desc,info)