mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-20 04:42:08 +00:00
psblas3:
base/tools/psb_ccdbldext.F90 base/tools/psb_cins.f90 base/tools/psb_cspins.f90 base/tools/psb_dcdbldext.F90 base/tools/psb_dins.f90 base/tools/psb_scdbldext.F90 base/tools/psb_sins.f90 base/tools/psb_sspins.f90 base/tools/psb_zcdbldext.F90 base/tools/psb_zins.f90 base/tools/psb_zspins.f90 Take out desc%indxmap% indirection where it makes sense, take 2.
This commit is contained in:
@@ -254,7 +254,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
Do j=0,n_elem_recv-1
|
||||
|
||||
idx = desc_a%ovrlap_index(counter+psb_elem_recv_+j)
|
||||
call desc_ov%indxmap%l2g(idx,gidx,info)
|
||||
call desc_ov%l2g(idx,gidx,info)
|
||||
If (gidx < 0) then
|
||||
info=-3
|
||||
call psb_errpush(info,name)
|
||||
@@ -355,7 +355,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
end If
|
||||
|
||||
idx = halo(counter+psb_elem_recv_+j)
|
||||
call desc_ov%indxmap%l2g(idx,gidx,info)
|
||||
call desc_ov%l2g(idx,gidx,info)
|
||||
If (gidx < 0) then
|
||||
info=-3
|
||||
call psb_errpush(info,name)
|
||||
@@ -399,7 +399,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
Do j=0,n_elem_send-1
|
||||
|
||||
idx = halo(counter+psb_elem_send_+j)
|
||||
call desc_ov%indxmap%l2g(idx,gidx,info)
|
||||
call desc_ov%l2g(idx,gidx,info)
|
||||
If (gidx < 0) then
|
||||
info=-3
|
||||
call psb_errpush(info,name)
|
||||
@@ -435,7 +435,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
call psb_errpush(info,name,a_err='psb_ensure_size')
|
||||
goto 9999
|
||||
end if
|
||||
call desc_ov%indxmap%l2g(icol(1:n_elem),&
|
||||
call desc_ov%l2g(icol(1:n_elem),&
|
||||
& works(idxs+tot_elem+1:idxs+tot_elem+n_elem),&
|
||||
& info)
|
||||
|
||||
@@ -523,7 +523,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& ': going for first idx_cnv', desc_ov%indxmap%get_state()
|
||||
|
||||
call desc_ov%indxmap%g2l(workr(1:iszr),maskr(1:iszr),info)
|
||||
call desc_ov%g2l(workr(1:iszr),maskr(1:iszr),info)
|
||||
iszs = count(maskr(1:iszr)<=0)
|
||||
if (iszs > size(works)) call psb_realloc(iszs,works,info)
|
||||
j = 0
|
||||
@@ -543,7 +543,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& ': going for fnd_owner', desc_ov%indxmap%get_state()
|
||||
call desc_a%indxmap%fnd_owner(works(1:iszs),temp,info)
|
||||
call desc_a%fnd_owner(works(1:iszs),temp,info)
|
||||
n_col = desc_ov%get_local_cols()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
@@ -553,7 +553,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
do i=1,iszs
|
||||
idx = works(i)
|
||||
n_col = desc_ov%get_local_cols()
|
||||
call desc_ov%indxmap%g2l_ins(idx,lidx,info)
|
||||
call desc_ov%g2l_ins(idx,lidx,info)
|
||||
if (desc_ov%get_local_cols() > n_col ) then
|
||||
!
|
||||
! This is a new index. Assigning a local index as
|
||||
|
||||
@@ -134,7 +134,7 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl,local)
|
||||
if (local_) then
|
||||
irl(1:m) = irw(1:m)
|
||||
else
|
||||
call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
end if
|
||||
select case(dupl_)
|
||||
case(psb_dupl_ovwrt_)
|
||||
@@ -280,7 +280,7 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl,local)
|
||||
if (local_) then
|
||||
irl(1:m) = irw(1:m)
|
||||
else
|
||||
call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
end if
|
||||
call x%ins(m,irl,val,dupl_,info)
|
||||
if (info /= 0) then
|
||||
@@ -400,7 +400,7 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
|
||||
if (local_) then
|
||||
irl(1:m) = irw(1:m)
|
||||
else
|
||||
call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
end if
|
||||
|
||||
do i=1,n
|
||||
@@ -569,7 +569,7 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl,local)
|
||||
if (local_) then
|
||||
irl(1:m) = irw(1:m)
|
||||
else
|
||||
call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
end if
|
||||
|
||||
select case(dupl_)
|
||||
|
||||
@@ -128,8 +128,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
|
||||
call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0))
|
||||
call desc_a%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
|
||||
call desc_a%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0))
|
||||
|
||||
if (info /= psb_success_) then
|
||||
ierr(1) = info
|
||||
@@ -174,8 +174,8 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info)
|
||||
call desc_a%indxmap%g2l(ja(1:nz),jla(1:nz),info)
|
||||
call desc_a%g2l(ia(1:nz),ila(1:nz),info)
|
||||
call desc_a%g2l(ja(1:nz),jla(1:nz),info)
|
||||
|
||||
call a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info)
|
||||
if (info /= psb_success_) then
|
||||
@@ -277,8 +277,8 @@ subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call desc_ar%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
|
||||
call desc_ac%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0))
|
||||
call desc_ar%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
|
||||
call desc_ac%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0))
|
||||
|
||||
if (psb_errstatus_fatal()) then
|
||||
ierr(1) = info
|
||||
|
||||
@@ -254,7 +254,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
Do j=0,n_elem_recv-1
|
||||
|
||||
idx = desc_a%ovrlap_index(counter+psb_elem_recv_+j)
|
||||
call desc_ov%indxmap%l2g(idx,gidx,info)
|
||||
call desc_ov%l2g(idx,gidx,info)
|
||||
If (gidx < 0) then
|
||||
info=-3
|
||||
call psb_errpush(info,name)
|
||||
@@ -355,7 +355,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
end If
|
||||
|
||||
idx = halo(counter+psb_elem_recv_+j)
|
||||
call desc_ov%indxmap%l2g(idx,gidx,info)
|
||||
call desc_ov%l2g(idx,gidx,info)
|
||||
If (gidx < 0) then
|
||||
info=-3
|
||||
call psb_errpush(info,name)
|
||||
@@ -399,7 +399,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
Do j=0,n_elem_send-1
|
||||
|
||||
idx = halo(counter+psb_elem_send_+j)
|
||||
call desc_ov%indxmap%l2g(idx,gidx,info)
|
||||
call desc_ov%l2g(idx,gidx,info)
|
||||
If (gidx < 0) then
|
||||
info=-3
|
||||
call psb_errpush(info,name)
|
||||
@@ -435,7 +435,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
call psb_errpush(info,name,a_err='psb_ensure_size')
|
||||
goto 9999
|
||||
end if
|
||||
call desc_ov%indxmap%l2g(icol(1:n_elem),&
|
||||
call desc_ov%l2g(icol(1:n_elem),&
|
||||
& works(idxs+tot_elem+1:idxs+tot_elem+n_elem),&
|
||||
& info)
|
||||
|
||||
@@ -523,7 +523,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& ': going for first idx_cnv', desc_ov%indxmap%get_state()
|
||||
|
||||
call desc_ov%indxmap%g2l(workr(1:iszr),maskr(1:iszr),info)
|
||||
call desc_ov%g2l(workr(1:iszr),maskr(1:iszr),info)
|
||||
iszs = count(maskr(1:iszr)<=0)
|
||||
if (iszs > size(works)) call psb_realloc(iszs,works,info)
|
||||
j = 0
|
||||
@@ -543,7 +543,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& ': going for fnd_owner', desc_ov%indxmap%get_state()
|
||||
call desc_a%indxmap%fnd_owner(works(1:iszs),temp,info)
|
||||
call desc_a%fnd_owner(works(1:iszs),temp,info)
|
||||
n_col = desc_ov%get_local_cols()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
@@ -553,7 +553,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
do i=1,iszs
|
||||
idx = works(i)
|
||||
n_col = desc_ov%get_local_cols()
|
||||
call desc_ov%indxmap%g2l_ins(idx,lidx,info)
|
||||
call desc_ov%g2l_ins(idx,lidx,info)
|
||||
if (desc_ov%get_local_cols() > n_col ) then
|
||||
!
|
||||
! This is a new index. Assigning a local index as
|
||||
|
||||
@@ -134,7 +134,7 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl,local)
|
||||
if (local_) then
|
||||
irl(1:m) = irw(1:m)
|
||||
else
|
||||
call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
end if
|
||||
select case(dupl_)
|
||||
case(psb_dupl_ovwrt_)
|
||||
@@ -280,7 +280,7 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl,local)
|
||||
if (local_) then
|
||||
irl(1:m) = irw(1:m)
|
||||
else
|
||||
call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
end if
|
||||
call x%ins(m,irl,val,dupl_,info)
|
||||
if (info /= 0) then
|
||||
@@ -400,7 +400,7 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
|
||||
if (local_) then
|
||||
irl(1:m) = irw(1:m)
|
||||
else
|
||||
call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
end if
|
||||
|
||||
do i=1,n
|
||||
@@ -569,7 +569,7 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl,local)
|
||||
if (local_) then
|
||||
irl(1:m) = irw(1:m)
|
||||
else
|
||||
call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
end if
|
||||
|
||||
select case(dupl_)
|
||||
|
||||
@@ -254,7 +254,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
Do j=0,n_elem_recv-1
|
||||
|
||||
idx = desc_a%ovrlap_index(counter+psb_elem_recv_+j)
|
||||
call desc_ov%indxmap%l2g(idx,gidx,info)
|
||||
call desc_ov%l2g(idx,gidx,info)
|
||||
If (gidx < 0) then
|
||||
info=-3
|
||||
call psb_errpush(info,name)
|
||||
@@ -355,7 +355,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
end If
|
||||
|
||||
idx = halo(counter+psb_elem_recv_+j)
|
||||
call desc_ov%indxmap%l2g(idx,gidx,info)
|
||||
call desc_ov%l2g(idx,gidx,info)
|
||||
If (gidx < 0) then
|
||||
info=-3
|
||||
call psb_errpush(info,name)
|
||||
@@ -399,7 +399,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
Do j=0,n_elem_send-1
|
||||
|
||||
idx = halo(counter+psb_elem_send_+j)
|
||||
call desc_ov%indxmap%l2g(idx,gidx,info)
|
||||
call desc_ov%l2g(idx,gidx,info)
|
||||
If (gidx < 0) then
|
||||
info=-3
|
||||
call psb_errpush(info,name)
|
||||
@@ -435,7 +435,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
call psb_errpush(info,name,a_err='psb_ensure_size')
|
||||
goto 9999
|
||||
end if
|
||||
call desc_ov%indxmap%l2g(icol(1:n_elem),&
|
||||
call desc_ov%l2g(icol(1:n_elem),&
|
||||
& works(idxs+tot_elem+1:idxs+tot_elem+n_elem),&
|
||||
& info)
|
||||
|
||||
@@ -523,7 +523,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& ': going for first idx_cnv', desc_ov%indxmap%get_state()
|
||||
|
||||
call desc_ov%indxmap%g2l(workr(1:iszr),maskr(1:iszr),info)
|
||||
call desc_ov%g2l(workr(1:iszr),maskr(1:iszr),info)
|
||||
iszs = count(maskr(1:iszr)<=0)
|
||||
if (iszs > size(works)) call psb_realloc(iszs,works,info)
|
||||
j = 0
|
||||
@@ -543,7 +543,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& ': going for fnd_owner', desc_ov%indxmap%get_state()
|
||||
call desc_a%indxmap%fnd_owner(works(1:iszs),temp,info)
|
||||
call desc_a%fnd_owner(works(1:iszs),temp,info)
|
||||
n_col = desc_ov%get_local_cols()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
@@ -553,7 +553,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
do i=1,iszs
|
||||
idx = works(i)
|
||||
n_col = desc_ov%get_local_cols()
|
||||
call desc_ov%indxmap%g2l_ins(idx,lidx,info)
|
||||
call desc_ov%g2l_ins(idx,lidx,info)
|
||||
if (desc_ov%get_local_cols() > n_col ) then
|
||||
!
|
||||
! This is a new index. Assigning a local index as
|
||||
|
||||
@@ -134,7 +134,7 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl,local)
|
||||
if (local_) then
|
||||
irl(1:m) = irw(1:m)
|
||||
else
|
||||
call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
end if
|
||||
select case(dupl_)
|
||||
case(psb_dupl_ovwrt_)
|
||||
@@ -280,7 +280,7 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl,local)
|
||||
if (local_) then
|
||||
irl(1:m) = irw(1:m)
|
||||
else
|
||||
call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
end if
|
||||
call x%ins(m,irl,val,dupl_,info)
|
||||
if (info /= 0) then
|
||||
@@ -400,7 +400,7 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
|
||||
if (local_) then
|
||||
irl(1:m) = irw(1:m)
|
||||
else
|
||||
call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
end if
|
||||
|
||||
do i=1,n
|
||||
@@ -569,7 +569,7 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl,local)
|
||||
if (local_) then
|
||||
irl(1:m) = irw(1:m)
|
||||
else
|
||||
call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
end if
|
||||
|
||||
select case(dupl_)
|
||||
|
||||
@@ -128,8 +128,8 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
|
||||
call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0))
|
||||
call desc_a%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
|
||||
call desc_a%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0))
|
||||
|
||||
if (info /= psb_success_) then
|
||||
ierr(1) = info
|
||||
@@ -174,8 +174,8 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info)
|
||||
call desc_a%indxmap%g2l(ja(1:nz),jla(1:nz),info)
|
||||
call desc_a%g2l(ia(1:nz),ila(1:nz),info)
|
||||
call desc_a%g2l(ja(1:nz),jla(1:nz),info)
|
||||
|
||||
call a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info)
|
||||
if (info /= psb_success_) then
|
||||
@@ -277,8 +277,8 @@ subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call desc_ar%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
|
||||
call desc_ac%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0))
|
||||
call desc_ar%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
|
||||
call desc_ac%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0))
|
||||
|
||||
if (psb_errstatus_fatal()) then
|
||||
ierr(1) = info
|
||||
|
||||
@@ -254,7 +254,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
Do j=0,n_elem_recv-1
|
||||
|
||||
idx = desc_a%ovrlap_index(counter+psb_elem_recv_+j)
|
||||
call desc_ov%indxmap%l2g(idx,gidx,info)
|
||||
call desc_ov%l2g(idx,gidx,info)
|
||||
If (gidx < 0) then
|
||||
info=-3
|
||||
call psb_errpush(info,name)
|
||||
@@ -355,7 +355,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
end If
|
||||
|
||||
idx = halo(counter+psb_elem_recv_+j)
|
||||
call desc_ov%indxmap%l2g(idx,gidx,info)
|
||||
call desc_ov%l2g(idx,gidx,info)
|
||||
If (gidx < 0) then
|
||||
info=-3
|
||||
call psb_errpush(info,name)
|
||||
@@ -399,7 +399,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
Do j=0,n_elem_send-1
|
||||
|
||||
idx = halo(counter+psb_elem_send_+j)
|
||||
call desc_ov%indxmap%l2g(idx,gidx,info)
|
||||
call desc_ov%l2g(idx,gidx,info)
|
||||
If (gidx < 0) then
|
||||
info=-3
|
||||
call psb_errpush(info,name)
|
||||
@@ -435,7 +435,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
call psb_errpush(info,name,a_err='psb_ensure_size')
|
||||
goto 9999
|
||||
end if
|
||||
call desc_ov%indxmap%l2g(icol(1:n_elem),&
|
||||
call desc_ov%l2g(icol(1:n_elem),&
|
||||
& works(idxs+tot_elem+1:idxs+tot_elem+n_elem),&
|
||||
& info)
|
||||
|
||||
@@ -523,7 +523,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& ': going for first idx_cnv', desc_ov%indxmap%get_state()
|
||||
|
||||
call desc_ov%indxmap%g2l(workr(1:iszr),maskr(1:iszr),info)
|
||||
call desc_ov%g2l(workr(1:iszr),maskr(1:iszr),info)
|
||||
iszs = count(maskr(1:iszr)<=0)
|
||||
if (iszs > size(works)) call psb_realloc(iszs,works,info)
|
||||
j = 0
|
||||
@@ -543,7 +543,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& ': going for fnd_owner', desc_ov%indxmap%get_state()
|
||||
call desc_a%indxmap%fnd_owner(works(1:iszs),temp,info)
|
||||
call desc_a%fnd_owner(works(1:iszs),temp,info)
|
||||
n_col = desc_ov%get_local_cols()
|
||||
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
@@ -553,7 +553,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
|
||||
do i=1,iszs
|
||||
idx = works(i)
|
||||
n_col = desc_ov%get_local_cols()
|
||||
call desc_ov%indxmap%g2l_ins(idx,lidx,info)
|
||||
call desc_ov%g2l_ins(idx,lidx,info)
|
||||
if (desc_ov%get_local_cols() > n_col ) then
|
||||
!
|
||||
! This is a new index. Assigning a local index as
|
||||
|
||||
@@ -134,7 +134,7 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl,local)
|
||||
if (local_) then
|
||||
irl(1:m) = irw(1:m)
|
||||
else
|
||||
call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
end if
|
||||
select case(dupl_)
|
||||
case(psb_dupl_ovwrt_)
|
||||
@@ -280,7 +280,7 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl,local)
|
||||
if (local_) then
|
||||
irl(1:m) = irw(1:m)
|
||||
else
|
||||
call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
end if
|
||||
call x%ins(m,irl,val,dupl_,info)
|
||||
if (info /= 0) then
|
||||
@@ -400,7 +400,7 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
|
||||
if (local_) then
|
||||
irl(1:m) = irw(1:m)
|
||||
else
|
||||
call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
end if
|
||||
|
||||
do i=1,n
|
||||
@@ -569,7 +569,7 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl,local)
|
||||
if (local_) then
|
||||
irl(1:m) = irw(1:m)
|
||||
else
|
||||
call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
call desc_a%g2l(irw(1:m),irl(1:m),info,owned=.true.)
|
||||
end if
|
||||
|
||||
select case(dupl_)
|
||||
|
||||
@@ -128,8 +128,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
|
||||
call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0))
|
||||
call desc_a%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
|
||||
call desc_a%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0))
|
||||
|
||||
if (info /= psb_success_) then
|
||||
ierr(1) = info
|
||||
@@ -174,8 +174,8 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info)
|
||||
call desc_a%indxmap%g2l(ja(1:nz),jla(1:nz),info)
|
||||
call desc_a%g2l(ia(1:nz),ila(1:nz),info)
|
||||
call desc_a%g2l(ja(1:nz),jla(1:nz),info)
|
||||
|
||||
call a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info)
|
||||
if (info /= psb_success_) then
|
||||
@@ -277,8 +277,8 @@ subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
call desc_ar%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
|
||||
call desc_ac%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0))
|
||||
call desc_ar%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
|
||||
call desc_ac%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0))
|
||||
|
||||
if (psb_errstatus_fatal()) then
|
||||
ierr(1) = info
|
||||
|
||||
Reference in New Issue
Block a user