From 6e5df61dc04cd1fa4f99e34d7bac9bbdc9a78bce Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 5 Apr 2018 17:53:58 +0100 Subject: [PATCH] Fixed use of LPK variables in cbldext. --- base/tools/psb_ccdbldext.F90 | 18 +++++++++++------- base/tools/psb_dcdbldext.F90 | 18 +++++++++++------- base/tools/psb_lallc.f90 | 2 +- base/tools/psb_lasb.f90 | 8 ++------ base/tools/psb_scdbldext.F90 | 18 +++++++++++------- base/tools/psb_zcdbldext.F90 | 18 +++++++++++------- 6 files changed, 47 insertions(+), 35 deletions(-) diff --git a/base/tools/psb_ccdbldext.F90 b/base/tools/psb_ccdbldext.F90 index 38474ae4..62f05bf4 100644 --- a/base/tools/psb_ccdbldext.F90 +++ b/base/tools/psb_ccdbldext.F90 @@ -84,15 +84,18 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) integer(psb_ipk_) :: i, j, err_act,m,& & lovr, lworks,lworkr, n_row,n_col, n_col_prev, & & index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo - integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,& + integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e, & + & idx,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(psb_lpk_) :: gidx, lnz integer(psb_mpk_) :: icomm, ictxt, me, np, minfo integer(psb_ipk_), allocatable :: irow(:), icol(:) integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) - integer(psb_ipk_), allocatable :: halo(:),ovrlap(:),works(:),workr(:),& + integer(psb_lpk_), allocatable :: works(:),workr(:) + integer(psb_ipk_), allocatable :: halo(:),ovrlap(:),& & t_halo_in(:), t_halo_out(:),temp(:),maskr(:) integer(psb_mpk_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:) integer(psb_ipk_) :: debug_level, debug_unit @@ -448,8 +451,8 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) if (i_ovr <= novr) then if (tot_elem > 1) then - call psb_msort_unique(works(idxs+1:idxs+tot_elem),i) - tot_elem=i + call psb_msort_unique(works(idxs+1:idxs+tot_elem),lnz) + tot_elem = lnz endif sdsz(proc+1) = tot_elem @@ -536,7 +539,8 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) end if end do ! Eliminate duplicates from request - call psb_msort_unique(works(1:j),iszs) + call psb_msort_unique(works(1:j),lnz) + iszs = lnz ! ! fnd_owner on desc_a because we want the procs who @@ -553,9 +557,9 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype) & ': Done fnd_owner', desc_ov%indxmap%get_state() do i=1,iszs - idx = works(i) + gidx = works(i) n_col = desc_ov%get_local_cols() - call desc_ov%indxmap%g2l_ins(idx,lidx,info) + call desc_ov%indxmap%g2l_ins(gidx,lidx,info) if (desc_ov%get_local_cols() > n_col ) then ! ! This is a new index. Assigning a local index as diff --git a/base/tools/psb_dcdbldext.F90 b/base/tools/psb_dcdbldext.F90 index 80d4f8e8..b0877243 100644 --- a/base/tools/psb_dcdbldext.F90 +++ b/base/tools/psb_dcdbldext.F90 @@ -84,15 +84,18 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) integer(psb_ipk_) :: i, j, err_act,m,& & lovr, lworks,lworkr, n_row,n_col, n_col_prev, & & index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo - integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,& + integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e, & + & idx,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(psb_lpk_) :: gidx, lnz integer(psb_mpk_) :: icomm, ictxt, me, np, minfo integer(psb_ipk_), allocatable :: irow(:), icol(:) integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) - integer(psb_ipk_), allocatable :: halo(:),ovrlap(:),works(:),workr(:),& + integer(psb_lpk_), allocatable :: works(:),workr(:) + integer(psb_ipk_), allocatable :: halo(:),ovrlap(:),& & t_halo_in(:), t_halo_out(:),temp(:),maskr(:) integer(psb_mpk_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:) integer(psb_ipk_) :: debug_level, debug_unit @@ -448,8 +451,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) if (i_ovr <= novr) then if (tot_elem > 1) then - call psb_msort_unique(works(idxs+1:idxs+tot_elem),i) - tot_elem=i + call psb_msort_unique(works(idxs+1:idxs+tot_elem),lnz) + tot_elem = lnz endif sdsz(proc+1) = tot_elem @@ -536,7 +539,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) end if end do ! Eliminate duplicates from request - call psb_msort_unique(works(1:j),iszs) + call psb_msort_unique(works(1:j),lnz) + iszs = lnz ! ! fnd_owner on desc_a because we want the procs who @@ -553,9 +557,9 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype) & ': Done fnd_owner', desc_ov%indxmap%get_state() do i=1,iszs - idx = works(i) + gidx = works(i) n_col = desc_ov%get_local_cols() - call desc_ov%indxmap%g2l_ins(idx,lidx,info) + call desc_ov%indxmap%g2l_ins(gidx,lidx,info) if (desc_ov%get_local_cols() > n_col ) then ! ! This is a new index. Assigning a local index as diff --git a/base/tools/psb_lallc.f90 b/base/tools/psb_lallc.f90 index 6a0be295..c79be292 100644 --- a/base/tools/psb_lallc.f90 +++ b/base/tools/psb_lallc.f90 @@ -225,7 +225,7 @@ subroutine psb_lalloc_multivect(x, desc_a,info,n) implicit none !....parameters... - type(psb_l_multivect_type), allocatable, intent(out) :: x + type(psb_l_multivect_type), intent(out) :: x type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_),intent(out) :: info integer(psb_ipk_), optional, intent(in) :: n diff --git a/base/tools/psb_lasb.f90 b/base/tools/psb_lasb.f90 index 515c5b33..10f52b47 100644 --- a/base/tools/psb_lasb.f90 +++ b/base/tools/psb_lasb.f90 @@ -101,9 +101,7 @@ subroutine psb_lasb_vect(x, desc_a, info, mold, scratch) call psb_errpush(info,name,a_err='psb_halo') goto 9999 end if - if (present(mold)) then - call x%cnv(mold) - end if + call x%cnv(mold) end if if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': end' @@ -179,9 +177,7 @@ subroutine psb_lasb_vect_r2(x, desc_a, info, mold, scratch) ! ..update halo elements.. call psb_halo(x(i),desc_a,info) if (info /= 0) exit - if (present(mold)) then - call x(i)%cnv(mold) - end if + call x(i)%cnv(mold) end do if(info /= psb_success_) then info=psb_err_from_subroutine_ diff --git a/base/tools/psb_scdbldext.F90 b/base/tools/psb_scdbldext.F90 index 1d88e3d3..92f8711a 100644 --- a/base/tools/psb_scdbldext.F90 +++ b/base/tools/psb_scdbldext.F90 @@ -84,15 +84,18 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) integer(psb_ipk_) :: i, j, err_act,m,& & lovr, lworks,lworkr, n_row,n_col, n_col_prev, & & index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo - integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,& + integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e, & + & idx,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(psb_lpk_) :: gidx, lnz integer(psb_mpk_) :: icomm, ictxt, me, np, minfo integer(psb_ipk_), allocatable :: irow(:), icol(:) integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) - integer(psb_ipk_), allocatable :: halo(:),ovrlap(:),works(:),workr(:),& + integer(psb_lpk_), allocatable :: works(:),workr(:) + integer(psb_ipk_), allocatable :: halo(:),ovrlap(:),& & t_halo_in(:), t_halo_out(:),temp(:),maskr(:) integer(psb_mpk_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:) integer(psb_ipk_) :: debug_level, debug_unit @@ -448,8 +451,8 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) if (i_ovr <= novr) then if (tot_elem > 1) then - call psb_msort_unique(works(idxs+1:idxs+tot_elem),i) - tot_elem=i + call psb_msort_unique(works(idxs+1:idxs+tot_elem),lnz) + tot_elem = lnz endif sdsz(proc+1) = tot_elem @@ -536,7 +539,8 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) end if end do ! Eliminate duplicates from request - call psb_msort_unique(works(1:j),iszs) + call psb_msort_unique(works(1:j),lnz) + iszs = lnz ! ! fnd_owner on desc_a because we want the procs who @@ -553,9 +557,9 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype) & ': Done fnd_owner', desc_ov%indxmap%get_state() do i=1,iszs - idx = works(i) + gidx = works(i) n_col = desc_ov%get_local_cols() - call desc_ov%indxmap%g2l_ins(idx,lidx,info) + call desc_ov%indxmap%g2l_ins(gidx,lidx,info) if (desc_ov%get_local_cols() > n_col ) then ! ! This is a new index. Assigning a local index as diff --git a/base/tools/psb_zcdbldext.F90 b/base/tools/psb_zcdbldext.F90 index 96bc3884..bc31b3d3 100644 --- a/base/tools/psb_zcdbldext.F90 +++ b/base/tools/psb_zcdbldext.F90 @@ -84,15 +84,18 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) integer(psb_ipk_) :: i, j, err_act,m,& & lovr, lworks,lworkr, n_row,n_col, n_col_prev, & & index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo - integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e,idx,gidx,proc,n_elem_recv,& + integer(psb_ipk_) :: counter,counter_h, counter_o, counter_e, & + & idx,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(psb_lpk_) :: gidx, lnz integer(psb_mpk_) :: icomm, ictxt, me, np, minfo integer(psb_ipk_), allocatable :: irow(:), icol(:) integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) - integer(psb_ipk_), allocatable :: halo(:),ovrlap(:),works(:),workr(:),& + integer(psb_lpk_), allocatable :: works(:),workr(:) + integer(psb_ipk_), allocatable :: halo(:),ovrlap(:),& & t_halo_in(:), t_halo_out(:),temp(:),maskr(:) integer(psb_mpk_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:) integer(psb_ipk_) :: debug_level, debug_unit @@ -448,8 +451,8 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) if (i_ovr <= novr) then if (tot_elem > 1) then - call psb_msort_unique(works(idxs+1:idxs+tot_elem),i) - tot_elem=i + call psb_msort_unique(works(idxs+1:idxs+tot_elem),lnz) + tot_elem = lnz endif sdsz(proc+1) = tot_elem @@ -536,7 +539,8 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) end if end do ! Eliminate duplicates from request - call psb_msort_unique(works(1:j),iszs) + call psb_msort_unique(works(1:j),lnz) + iszs = lnz ! ! fnd_owner on desc_a because we want the procs who @@ -553,9 +557,9 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype) & ': Done fnd_owner', desc_ov%indxmap%get_state() do i=1,iszs - idx = works(i) + gidx = works(i) n_col = desc_ov%get_local_cols() - call desc_ov%indxmap%g2l_ins(idx,lidx,info) + call desc_ov%indxmap%g2l_ins(gidx,lidx,info) if (desc_ov%get_local_cols() > n_col ) then ! ! This is a new index. Assigning a local index as