fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Fixed use of LPK variables in cbldext.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent 5063309e9c
commit 6e5df61dc0
6 changed files with 47 additions and 35 deletions
Show Stats Download Patch File Download Diff File

18
base/tools/psb_ccdbldext.F90
Unescape Escape View File

@ -84,15 +84,18 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
integer(psb_ipk_) :: i, j, err_act,m,& integer(psb_ipk_) :: i, j, err_act,m,&
& lovr, lworks,lworkr, n_row,n_col, n_col_prev, & & lovr, lworks,lworkr, n_row,n_col, n_col_prev, &
& index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo & 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,& & n_elem_send,tot_recv,tot_elem,cntov_o,&
& counter_t,n_elem,i_ovr,jj,proc_id,isz, & & counter_t,n_elem,i_ovr,jj,proc_id,isz, &
& idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_
integer(psb_lpk_) :: gidx, lnz
integer(psb_mpk_) :: icomm, ictxt, me, np, minfo integer(psb_mpk_) :: icomm, ictxt, me, np, minfo
integer(psb_ipk_), allocatable :: irow(:), icol(:) integer(psb_ipk_), allocatable :: irow(:), icol(:)
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) 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(:) & t_halo_in(:), t_halo_out(:),temp(:),maskr(:)
integer(psb_mpk_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:) integer(psb_mpk_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
integer(psb_ipk_) :: debug_level, debug_unit 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 (i_ovr <= novr) then
if (tot_elem > 1) then if (tot_elem > 1) then
call psb_msort_unique(works(idxs+1:idxs+tot_elem),i) call psb_msort_unique(works(idxs+1:idxs+tot_elem),lnz)
tot_elem=i tot_elem = lnz
endif endif
sdsz(proc+1) = tot_elem sdsz(proc+1) = tot_elem
@ -536,7 +539,8 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
end if end if
end do end do
! Eliminate duplicates from request ! 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 ! 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() & ': Done fnd_owner', desc_ov%indxmap%get_state()
do i=1,iszs do i=1,iszs
idx = works(i) gidx = works(i)
n_col = desc_ov%get_local_cols() 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 if (desc_ov%get_local_cols() > n_col ) then
! !
! This is a new index. Assigning a local index as ! This is a new index. Assigning a local index as

18
base/tools/psb_dcdbldext.F90
Unescape Escape View File

@ -84,15 +84,18 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
integer(psb_ipk_) :: i, j, err_act,m,& integer(psb_ipk_) :: i, j, err_act,m,&
& lovr, lworks,lworkr, n_row,n_col, n_col_prev, & & lovr, lworks,lworkr, n_row,n_col, n_col_prev, &
& index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo & 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,& & n_elem_send,tot_recv,tot_elem,cntov_o,&
& counter_t,n_elem,i_ovr,jj,proc_id,isz, & & counter_t,n_elem,i_ovr,jj,proc_id,isz, &
& idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_
integer(psb_lpk_) :: gidx, lnz
integer(psb_mpk_) :: icomm, ictxt, me, np, minfo integer(psb_mpk_) :: icomm, ictxt, me, np, minfo
integer(psb_ipk_), allocatable :: irow(:), icol(:) integer(psb_ipk_), allocatable :: irow(:), icol(:)
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) 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(:) & t_halo_in(:), t_halo_out(:),temp(:),maskr(:)
integer(psb_mpk_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:) integer(psb_mpk_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
integer(psb_ipk_) :: debug_level, debug_unit 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 (i_ovr <= novr) then
if (tot_elem > 1) then if (tot_elem > 1) then
call psb_msort_unique(works(idxs+1:idxs+tot_elem),i) call psb_msort_unique(works(idxs+1:idxs+tot_elem),lnz)
tot_elem=i tot_elem = lnz
endif endif
sdsz(proc+1) = tot_elem sdsz(proc+1) = tot_elem
@ -536,7 +539,8 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
end if end if
end do end do
! Eliminate duplicates from request ! 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 ! 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() & ': Done fnd_owner', desc_ov%indxmap%get_state()
do i=1,iszs do i=1,iszs
idx = works(i) gidx = works(i)
n_col = desc_ov%get_local_cols() 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 if (desc_ov%get_local_cols() > n_col ) then
! !
! This is a new index. Assigning a local index as ! This is a new index. Assigning a local index as

2
base/tools/psb_lallc.f90
Unescape Escape View File

@ -225,7 +225,7 @@ subroutine psb_lalloc_multivect(x, desc_a,info,n)
implicit none implicit none
!....parameters... !....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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(out) :: info integer(psb_ipk_),intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: n integer(psb_ipk_), optional, intent(in) :: n

8
base/tools/psb_lasb.f90
Unescape Escape View File

@ -101,9 +101,7 @@ subroutine psb_lasb_vect(x, desc_a, info, mold, scratch)
call psb_errpush(info,name,a_err='psb_halo') call psb_errpush(info,name,a_err='psb_halo')
goto 9999 goto 9999
end if end if
if (present(mold)) then call x%cnv(mold)
call x%cnv(mold)
end if
end if end if
if (debug_level >= psb_debug_ext_) & if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end' & 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.. ! ..update halo elements..
call psb_halo(x(i),desc_a,info) call psb_halo(x(i),desc_a,info)
if (info /= 0) exit if (info /= 0) exit
if (present(mold)) then call x(i)%cnv(mold)
call x(i)%cnv(mold)
end if
end do end do
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_

18
base/tools/psb_scdbldext.F90
Unescape Escape View File

@ -84,15 +84,18 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
integer(psb_ipk_) :: i, j, err_act,m,& integer(psb_ipk_) :: i, j, err_act,m,&
& lovr, lworks,lworkr, n_row,n_col, n_col_prev, & & lovr, lworks,lworkr, n_row,n_col, n_col_prev, &
& index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo & 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,& & n_elem_send,tot_recv,tot_elem,cntov_o,&
& counter_t,n_elem,i_ovr,jj,proc_id,isz, & & counter_t,n_elem,i_ovr,jj,proc_id,isz, &
& idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_
integer(psb_lpk_) :: gidx, lnz
integer(psb_mpk_) :: icomm, ictxt, me, np, minfo integer(psb_mpk_) :: icomm, ictxt, me, np, minfo
integer(psb_ipk_), allocatable :: irow(:), icol(:) integer(psb_ipk_), allocatable :: irow(:), icol(:)
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) 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(:) & t_halo_in(:), t_halo_out(:),temp(:),maskr(:)
integer(psb_mpk_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:) integer(psb_mpk_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
integer(psb_ipk_) :: debug_level, debug_unit 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 (i_ovr <= novr) then
if (tot_elem > 1) then if (tot_elem > 1) then
call psb_msort_unique(works(idxs+1:idxs+tot_elem),i) call psb_msort_unique(works(idxs+1:idxs+tot_elem),lnz)
tot_elem=i tot_elem = lnz
endif endif
sdsz(proc+1) = tot_elem sdsz(proc+1) = tot_elem
@ -536,7 +539,8 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
end if end if
end do end do
! Eliminate duplicates from request ! 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 ! 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() & ': Done fnd_owner', desc_ov%indxmap%get_state()
do i=1,iszs do i=1,iszs
idx = works(i) gidx = works(i)
n_col = desc_ov%get_local_cols() 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 if (desc_ov%get_local_cols() > n_col ) then
! !
! This is a new index. Assigning a local index as ! This is a new index. Assigning a local index as

18
base/tools/psb_zcdbldext.F90
Unescape Escape View File

@ -84,15 +84,18 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
integer(psb_ipk_) :: i, j, err_act,m,& integer(psb_ipk_) :: i, j, err_act,m,&
& lovr, lworks,lworkr, n_row,n_col, n_col_prev, & & lovr, lworks,lworkr, n_row,n_col, n_col_prev, &
& index_dim,elem_dim, l_tmp_ovr_idx,l_tmp_halo, nztot,nhalo & 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,& & n_elem_send,tot_recv,tot_elem,cntov_o,&
& counter_t,n_elem,i_ovr,jj,proc_id,isz, & & counter_t,n_elem,i_ovr,jj,proc_id,isz, &
& idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_ & idxr, idxs, iszr, iszs, nxch, nsnd, nrcv,lidx, extype_
integer(psb_lpk_) :: gidx, lnz
integer(psb_mpk_) :: icomm, ictxt, me, np, minfo integer(psb_mpk_) :: icomm, ictxt, me, np, minfo
integer(psb_ipk_), allocatable :: irow(:), icol(:) integer(psb_ipk_), allocatable :: irow(:), icol(:)
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ovr_idx(:), orig_ovr(:) 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(:) & t_halo_in(:), t_halo_out(:),temp(:),maskr(:)
integer(psb_mpk_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:) integer(psb_mpk_),allocatable :: brvindx(:),rvsz(:), bsdindx(:),sdsz(:)
integer(psb_ipk_) :: debug_level, debug_unit 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 (i_ovr <= novr) then
if (tot_elem > 1) then if (tot_elem > 1) then
call psb_msort_unique(works(idxs+1:idxs+tot_elem),i) call psb_msort_unique(works(idxs+1:idxs+tot_elem),lnz)
tot_elem=i tot_elem = lnz
endif endif
sdsz(proc+1) = tot_elem sdsz(proc+1) = tot_elem
@ -536,7 +539,8 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
end if end if
end do end do
! Eliminate duplicates from request ! 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 ! 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() & ': Done fnd_owner', desc_ov%indxmap%get_state()
do i=1,iszs do i=1,iszs
idx = works(i) gidx = works(i)
n_col = desc_ov%get_local_cols() 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 if (desc_ov%get_local_cols() > n_col ) then
! !
! This is a new index. Assigning a local index as ! This is a new index. Assigning a local index as

Write Preview
Loading…
Cancel
Save