base/internals/psi_desc_index.F90
 base/tools/psb_ccdbldext.F90
 base/tools/psb_cdins.f90
 base/tools/psb_cins.f90
 base/tools/psb_cspins.f90
 base/tools/psb_dcdbldext.F90
 base/tools/psb_dins.f90
 base/tools/psb_dspins.f90
 base/tools/psb_glob_to_loc.f90
 base/tools/psb_loc_to_glob.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

Revert: in tight loops on small sizes it's better to call directly
into %indxmap%
psblas-testmv
Salvatore Filippone 11 years ago
parent fa91864df2
commit fb8e8ae927

@ -261,7 +261,7 @@ subroutine psi_desc_index(desc,index_in,dep_list,&
end do
else
call desc%l2g(index_in(i+1:i+nerv),&
call desc%indxmap%l2g(index_in(i+1:i+nerv),&
& sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),&
& info)
@ -310,13 +310,13 @@ subroutine psi_desc_index(desc,index_in,dep_list,&
i = i + 1
nerv = sdsz(proc+1)
desc_index(i) = nerv
call desc%g2l(sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),&
call desc%indxmap%g2l(sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),&
& desc_index(i+1:i+nerv),info)
i = i + nerv + 1
nesd = rvsz(proc+1)
desc_index(i) = nesd
call desc%g2l(rcvbuf(brvindx(proc+1)+1:brvindx(proc+1)+nesd),&
call desc%indxmap%g2l(rcvbuf(brvindx(proc+1)+1:brvindx(proc+1)+nesd),&
& desc_index(i+1:i+nesd),info)
i = i + nesd + 1
end do

@ -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%g2l(workr(1:iszr),maskr(1:iszr),info)
call desc_ov%indxmap%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
@ -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%g2l_ins(idx,lidx,info)
call desc_ov%indxmap%g2l_ins(idx,lidx,info)
if (desc_ov%get_local_cols() > n_col ) then
!
! This is a new index. Assigning a local index as

@ -118,9 +118,9 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla)
end if
if (present(ila).and.present(jla)) then
call desc_a%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
if (info == psb_success_) &
& call desc_a%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0))
& call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0))
else
if (present(ila).or.present(jla)) then
write(psb_err_unit,*) 'Inconsistent call : ',present(ila),present(jla)
@ -131,10 +131,10 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla)
call psb_errpush(info,name)
goto 9999
end if
call desc_a%g2l(ia(1:nz),ila_(1:nz),info,owned=.true.)
call desc_a%indxmap%g2l(ia(1:nz),ila_(1:nz),info,owned=.true.)
if (info == psb_success_) then
jla_(1:nz) = ja(1:nz)
call desc_a%g2lip_ins(jla_(1:nz),info,mask=(ila_(1:nz)>0))
call desc_a%indxmap%g2lip_ins(jla_(1:nz),info,mask=(ila_(1:nz)>0))
end if
deallocate(ila_,jla_,stat=info)
end if
@ -249,7 +249,7 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx)
end if
if (present(jla)) then
call desc%g2l_ins(ja(1:nz),jla(1:nz),info,mask=mask,lidx=lidx)
call desc%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=mask,lidx=lidx)
else
allocate(jla_(nz),stat=info)
if (info /= psb_success_) then
@ -257,7 +257,7 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx)
call psb_errpush(info,name)
goto 9999
end if
call desc%g2l_ins(ja(1:nz),jla_(1:nz),info,mask=mask,lidx=lidx)
call desc%indxmap%g2l_ins(ja(1:nz),jla_(1:nz),info,mask=mask,lidx=lidx)
deallocate(jla_)
end if

@ -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%g2l(irw(1:m),irl(1:m),info,owned=.true.)
call desc_a%indxmap%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%g2l(irw(1:m),irl(1:m),info,owned=.true.)
call desc_a%indxmap%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%g2l(irw(1:m),irl(1:m),info,owned=.true.)
call desc_a%indxmap%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%g2l(irw(1:m),irl(1:m),info,owned=.true.)
call desc_a%indxmap%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%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))
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))
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%g2l(ia(1:nz),ila(1:nz),info)
call desc_a%g2l(ja(1:nz),jla(1:nz),info)
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 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%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))
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))
if (psb_errstatus_fatal()) then
ierr(1) = 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%g2l(workr(1:iszr),maskr(1:iszr),info)
call desc_ov%indxmap%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
@ -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%g2l_ins(idx,lidx,info)
call desc_ov%indxmap%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%g2l(irw(1:m),irl(1:m),info,owned=.true.)
call desc_a%indxmap%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%g2l(irw(1:m),irl(1:m),info,owned=.true.)
call desc_a%indxmap%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%g2l(irw(1:m),irl(1:m),info,owned=.true.)
call desc_a%indxmap%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%g2l(irw(1:m),irl(1:m),info,owned=.true.)
call desc_a%indxmap%g2l(irw(1:m),irl(1:m),info,owned=.true.)
end if
select case(dupl_)

@ -128,8 +128,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
goto 9999
end if
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))
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))
if (info /= psb_success_) then
ierr(1) = info
@ -174,8 +174,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
goto 9999
end if
call desc_a%g2l(ia(1:nz),ila(1:nz),info)
call desc_a%g2l(ja(1:nz),jla(1:nz),info)
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 a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info)
if (info /= psb_success_) then
@ -277,8 +277,8 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
goto 9999
end if
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))
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))
if (psb_errstatus_fatal()) then
ierr(1) = info

@ -94,7 +94,7 @@ subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned)
act = psb_toupper(act)
n = size(x)
call desc_a%g2l(x(1:n),y(1:n),info,owned=owned)
call desc_a%indxmap%g2l(x(1:n),y(1:n),info,owned=owned)
select case(act)
case('E','I')
@ -217,7 +217,7 @@ subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned)
act = psb_toupper(act)
call desc_a%g2lip(x,info,owned=owned)
call desc_a%indxmap%g2lip(x,info,owned=owned)
select case(act)
case('E','I')

@ -80,7 +80,7 @@ subroutine psb_loc_to_glob2v(x,y,desc_a,info,iact)
endif
act=psb_toupper(act)
call desc_a%l2g(x,y,info)
call desc_a%indxmap%l2g(x,y,info)
if (info /= psb_success_) then
select case(act)
@ -190,7 +190,7 @@ subroutine psb_loc_to_glob1v(x,desc_a,info,iact)
endif
act = psb_toupper(act)
call desc_a%l2gip(x,info)
call desc_a%indxmap%l2gip(x,info)
if (info /= psb_success_) then
select case(act)

@ -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%g2l(workr(1:iszr),maskr(1:iszr),info)
call desc_ov%indxmap%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
@ -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%g2l_ins(idx,lidx,info)
call desc_ov%indxmap%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%g2l(irw(1:m),irl(1:m),info,owned=.true.)
call desc_a%indxmap%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%g2l(irw(1:m),irl(1:m),info,owned=.true.)
call desc_a%indxmap%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%g2l(irw(1:m),irl(1:m),info,owned=.true.)
call desc_a%indxmap%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%g2l(irw(1:m),irl(1:m),info,owned=.true.)
call desc_a%indxmap%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%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))
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))
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%g2l(ia(1:nz),ila(1:nz),info)
call desc_a%g2l(ja(1:nz),jla(1:nz),info)
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 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%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))
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))
if (psb_errstatus_fatal()) then
ierr(1) = 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%g2l(workr(1:iszr),maskr(1:iszr),info)
call desc_ov%indxmap%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
@ -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%g2l_ins(idx,lidx,info)
call desc_ov%indxmap%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%g2l(irw(1:m),irl(1:m),info,owned=.true.)
call desc_a%indxmap%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%g2l(irw(1:m),irl(1:m),info,owned=.true.)
call desc_a%indxmap%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%g2l(irw(1:m),irl(1:m),info,owned=.true.)
call desc_a%indxmap%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%g2l(irw(1:m),irl(1:m),info,owned=.true.)
call desc_a%indxmap%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%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))
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))
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%g2l(ia(1:nz),ila(1:nz),info)
call desc_a%g2l(ja(1:nz),jla(1:nz),info)
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 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%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))
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))
if (psb_errstatus_fatal()) then
ierr(1) = info

Loading…
Cancel
Save