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

psblas3:

Browse Source 
base/serial/impl/psb_c_coo_impl.f90
 base/serial/impl/psb_d_coo_impl.f90
 base/serial/impl/psb_s_coo_impl.f90
 base/serial/impl/psb_z_coo_impl.f90


Fix fix_coo for corner cases.
psblas-3.2.0
Salvatore Filippone 11 years ago
parent e4ee141ff8
commit 1b5d767caf
4 changed files with 172 additions and 96 deletions
Show Stats Download Patch File Download Diff File

65
base/serial/impl/psb_c_coo_impl.f90
Unescape Escape View File

@ -3455,6 +3455,7 @@ subroutine psb_c_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
dupl_ = dupl dupl_ = dupl
allocate(iaux(max(nr,nc,nzin)+2),stat=info) allocate(iaux(max(nr,nc,nzin)+2),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
@ -3462,24 +3463,32 @@ subroutine psb_c_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
goto 9999 goto 9999
end if end if
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(max(nr,nc,nzin)), stat=info)
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(max(nr,nc)), stat=info)
use_buffers = (info == 0) use_buffers = (info == 0)
select case(idir_) select case(idir_)
case(psb_row_major_) case(psb_row_major_)
! Row major order ! Row major order
if (use_buffers) then if (use_buffers) then
iaux(:)=0 if (.not.( (ia(1) < 1).or.(ia(1)> nr)) ) then
iaux(:) = 0
iaux(ia(1)) = iaux(ia(1)) + 1 iaux(ia(1)) = iaux(ia(1)) + 1
srt_inp = .true. srt_inp = .true.
do i=2,nzin do i=2,nzin
iaux(ia(i)) = iaux(ia(i)) + 1 if ( (ia(i) < 1).or.(ia(i)> nr)) then
srt_inp = srt_inp .and.(ia(i-1)<=ia(i)) use_buffers = .false.
end do exit
end if
iaux(ia(i)) = iaux(ia(i)) + 1
srt_inp = srt_inp .and.(ia(i-1)<=ia(i))
end do
else
use_buffers=.false.
end if
end if
! Check again use_buffers.
if (use_buffers) then
if (srt_inp) then if (srt_inp) then
! If input was already row-major ! If input was already row-major
! we can do it row-by-row here. ! we can do it row-by-row here.
@ -3782,14 +3791,26 @@ subroutine psb_c_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
case(psb_col_major_) case(psb_col_major_)
if (use_buffers) then if (use_buffers) then
iaux(:)=0 iaux(:) = 0
if (.not.( (ja(1) < 1).or.(ja(1)> nc)) ) then
iaux(ja(1)) = iaux(ja(1)) + 1
srt_inp = .true.
do i=2,nzin
if ( (ja(i) < 1).or.(ja(i)> nc)) then
use_buffers = .false.
exit
end if
iaux(ja(i)) = iaux(ja(i)) + 1
srt_inp = srt_inp .and.(ja(i-1)<=ja(i))
end do
else
use_buffers=.false.
end if
end if
!use_buffers=use_buffers.and.srt_inp
! Check again use_buffers.
if (use_buffers) then
iaux(ja(1)) = iaux(ja(1)) + 1
srt_inp = .true.
do i=2,nzin
iaux(ja(i)) = iaux(ja(i)) + 1
srt_inp = srt_inp .and.(ja(i-1)<=ja(i))
end do
if (srt_inp) then if (srt_inp) then
! If input was already col-major ! If input was already col-major
! we can do it col-by-col here. ! we can do it col-by-col here.
@ -3883,17 +3904,16 @@ subroutine psb_c_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
enddo enddo
else if (.not.srt_inp) then else if (.not.srt_inp) then
! If input was not already row-major ! If input was not already col-major
! we have to sort all ! we have to sort all
ip = iaux(1) ip = iaux(1)
iaux(1) = 0 iaux(1) = 0
do i=2, nr do i=2, nc
is = iaux(i) is = iaux(i)
iaux(i) = ip iaux(i) = ip
ip = ip + is ip = ip + is
end do end do
iaux(nr+1) = ip iaux(nc+1) = ip
do i=1,nzin do i=1,nzin
icl = ja(i) icl = ja(i)
@ -3914,7 +3934,6 @@ subroutine psb_c_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
if (iret == 0) & if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),& & call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2) & ias(i:imx),jas(i:imx),ix2)
select case(dupl_) select case(dupl_)
case(psb_dupl_ovwrt_) case(psb_dupl_ovwrt_)
k = k + 1 k = k + 1

65
base/serial/impl/psb_d_coo_impl.f90
Unescape Escape View File

@ -3455,6 +3455,7 @@ subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
dupl_ = dupl dupl_ = dupl
allocate(iaux(max(nr,nc,nzin)+2),stat=info) allocate(iaux(max(nr,nc,nzin)+2),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
@ -3462,24 +3463,32 @@ subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
goto 9999 goto 9999
end if end if
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(max(nr,nc,nzin)), stat=info)
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(max(nr,nc)), stat=info)
use_buffers = (info == 0) use_buffers = (info == 0)
select case(idir_) select case(idir_)
case(psb_row_major_) case(psb_row_major_)
! Row major order ! Row major order
if (use_buffers) then if (use_buffers) then
iaux(:)=0 if (.not.( (ia(1) < 1).or.(ia(1)> nr)) ) then
iaux(:) = 0
iaux(ia(1)) = iaux(ia(1)) + 1 iaux(ia(1)) = iaux(ia(1)) + 1
srt_inp = .true. srt_inp = .true.
do i=2,nzin do i=2,nzin
iaux(ia(i)) = iaux(ia(i)) + 1 if ( (ia(i) < 1).or.(ia(i)> nr)) then
srt_inp = srt_inp .and.(ia(i-1)<=ia(i)) use_buffers = .false.
end do exit
end if
iaux(ia(i)) = iaux(ia(i)) + 1
srt_inp = srt_inp .and.(ia(i-1)<=ia(i))
end do
else
use_buffers=.false.
end if
end if
! Check again use_buffers.
if (use_buffers) then
if (srt_inp) then if (srt_inp) then
! If input was already row-major ! If input was already row-major
! we can do it row-by-row here. ! we can do it row-by-row here.
@ -3782,14 +3791,26 @@ subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
case(psb_col_major_) case(psb_col_major_)
if (use_buffers) then if (use_buffers) then
iaux(:)=0 iaux(:) = 0
if (.not.( (ja(1) < 1).or.(ja(1)> nc)) ) then
iaux(ja(1)) = iaux(ja(1)) + 1
srt_inp = .true.
do i=2,nzin
if ( (ja(i) < 1).or.(ja(i)> nc)) then
use_buffers = .false.
exit
end if
iaux(ja(i)) = iaux(ja(i)) + 1
srt_inp = srt_inp .and.(ja(i-1)<=ja(i))
end do
else
use_buffers=.false.
end if
end if
!use_buffers=use_buffers.and.srt_inp
! Check again use_buffers.
if (use_buffers) then
iaux(ja(1)) = iaux(ja(1)) + 1
srt_inp = .true.
do i=2,nzin
iaux(ja(i)) = iaux(ja(i)) + 1
srt_inp = srt_inp .and.(ja(i-1)<=ja(i))
end do
if (srt_inp) then if (srt_inp) then
! If input was already col-major ! If input was already col-major
! we can do it col-by-col here. ! we can do it col-by-col here.
@ -3883,17 +3904,16 @@ subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
enddo enddo
else if (.not.srt_inp) then else if (.not.srt_inp) then
! If input was not already row-major ! If input was not already col-major
! we have to sort all ! we have to sort all
ip = iaux(1) ip = iaux(1)
iaux(1) = 0 iaux(1) = 0
do i=2, nr do i=2, nc
is = iaux(i) is = iaux(i)
iaux(i) = ip iaux(i) = ip
ip = ip + is ip = ip + is
end do end do
iaux(nr+1) = ip iaux(nc+1) = ip
do i=1,nzin do i=1,nzin
icl = ja(i) icl = ja(i)
@ -3914,7 +3934,6 @@ subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
if (iret == 0) & if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),& & call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2) & ias(i:imx),jas(i:imx),ix2)
select case(dupl_) select case(dupl_)
case(psb_dupl_ovwrt_) case(psb_dupl_ovwrt_)
k = k + 1 k = k + 1

65
base/serial/impl/psb_s_coo_impl.f90
Unescape Escape View File

@ -3455,6 +3455,7 @@ subroutine psb_s_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
dupl_ = dupl dupl_ = dupl
allocate(iaux(max(nr,nc,nzin)+2),stat=info) allocate(iaux(max(nr,nc,nzin)+2),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
@ -3462,24 +3463,32 @@ subroutine psb_s_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
goto 9999 goto 9999
end if end if
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(max(nr,nc,nzin)), stat=info)
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(max(nr,nc)), stat=info)
use_buffers = (info == 0) use_buffers = (info == 0)
select case(idir_) select case(idir_)
case(psb_row_major_) case(psb_row_major_)
! Row major order ! Row major order
if (use_buffers) then if (use_buffers) then
iaux(:)=0 if (.not.( (ia(1) < 1).or.(ia(1)> nr)) ) then
iaux(:) = 0
iaux(ia(1)) = iaux(ia(1)) + 1 iaux(ia(1)) = iaux(ia(1)) + 1
srt_inp = .true. srt_inp = .true.
do i=2,nzin do i=2,nzin
iaux(ia(i)) = iaux(ia(i)) + 1 if ( (ia(i) < 1).or.(ia(i)> nr)) then
srt_inp = srt_inp .and.(ia(i-1)<=ia(i)) use_buffers = .false.
end do exit
end if
iaux(ia(i)) = iaux(ia(i)) + 1
srt_inp = srt_inp .and.(ia(i-1)<=ia(i))
end do
else
use_buffers=.false.
end if
end if
! Check again use_buffers.
if (use_buffers) then
if (srt_inp) then if (srt_inp) then
! If input was already row-major ! If input was already row-major
! we can do it row-by-row here. ! we can do it row-by-row here.
@ -3782,14 +3791,26 @@ subroutine psb_s_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
case(psb_col_major_) case(psb_col_major_)
if (use_buffers) then if (use_buffers) then
iaux(:)=0 iaux(:) = 0
if (.not.( (ja(1) < 1).or.(ja(1)> nc)) ) then
iaux(ja(1)) = iaux(ja(1)) + 1
srt_inp = .true.
do i=2,nzin
if ( (ja(i) < 1).or.(ja(i)> nc)) then
use_buffers = .false.
exit
end if
iaux(ja(i)) = iaux(ja(i)) + 1
srt_inp = srt_inp .and.(ja(i-1)<=ja(i))
end do
else
use_buffers=.false.
end if
end if
!use_buffers=use_buffers.and.srt_inp
! Check again use_buffers.
if (use_buffers) then
iaux(ja(1)) = iaux(ja(1)) + 1
srt_inp = .true.
do i=2,nzin
iaux(ja(i)) = iaux(ja(i)) + 1
srt_inp = srt_inp .and.(ja(i-1)<=ja(i))
end do
if (srt_inp) then if (srt_inp) then
! If input was already col-major ! If input was already col-major
! we can do it col-by-col here. ! we can do it col-by-col here.
@ -3883,17 +3904,16 @@ subroutine psb_s_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
enddo enddo
else if (.not.srt_inp) then else if (.not.srt_inp) then
! If input was not already row-major ! If input was not already col-major
! we have to sort all ! we have to sort all
ip = iaux(1) ip = iaux(1)
iaux(1) = 0 iaux(1) = 0
do i=2, nr do i=2, nc
is = iaux(i) is = iaux(i)
iaux(i) = ip iaux(i) = ip
ip = ip + is ip = ip + is
end do end do
iaux(nr+1) = ip iaux(nc+1) = ip
do i=1,nzin do i=1,nzin
icl = ja(i) icl = ja(i)
@ -3914,7 +3934,6 @@ subroutine psb_s_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
if (iret == 0) & if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),& & call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2) & ias(i:imx),jas(i:imx),ix2)
select case(dupl_) select case(dupl_)
case(psb_dupl_ovwrt_) case(psb_dupl_ovwrt_)
k = k + 1 k = k + 1

65
base/serial/impl/psb_z_coo_impl.f90
Unescape Escape View File

@ -3455,6 +3455,7 @@ subroutine psb_z_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
dupl_ = dupl dupl_ = dupl
allocate(iaux(max(nr,nc,nzin)+2),stat=info) allocate(iaux(max(nr,nc,nzin)+2),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
@ -3462,24 +3463,32 @@ subroutine psb_z_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
goto 9999 goto 9999
end if end if
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(max(nr,nc,nzin)), stat=info)
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(max(nr,nc)), stat=info)
use_buffers = (info == 0) use_buffers = (info == 0)
select case(idir_) select case(idir_)
case(psb_row_major_) case(psb_row_major_)
! Row major order ! Row major order
if (use_buffers) then if (use_buffers) then
iaux(:)=0 if (.not.( (ia(1) < 1).or.(ia(1)> nr)) ) then
iaux(:) = 0
iaux(ia(1)) = iaux(ia(1)) + 1 iaux(ia(1)) = iaux(ia(1)) + 1
srt_inp = .true. srt_inp = .true.
do i=2,nzin do i=2,nzin
iaux(ia(i)) = iaux(ia(i)) + 1 if ( (ia(i) < 1).or.(ia(i)> nr)) then
srt_inp = srt_inp .and.(ia(i-1)<=ia(i)) use_buffers = .false.
end do exit
end if
iaux(ia(i)) = iaux(ia(i)) + 1
srt_inp = srt_inp .and.(ia(i-1)<=ia(i))
end do
else
use_buffers=.false.
end if
end if
! Check again use_buffers.
if (use_buffers) then
if (srt_inp) then if (srt_inp) then
! If input was already row-major ! If input was already row-major
! we can do it row-by-row here. ! we can do it row-by-row here.
@ -3782,14 +3791,26 @@ subroutine psb_z_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
case(psb_col_major_) case(psb_col_major_)
if (use_buffers) then if (use_buffers) then
iaux(:)=0 iaux(:) = 0
if (.not.( (ja(1) < 1).or.(ja(1)> nc)) ) then
iaux(ja(1)) = iaux(ja(1)) + 1
srt_inp = .true.
do i=2,nzin
if ( (ja(i) < 1).or.(ja(i)> nc)) then
use_buffers = .false.
exit
end if
iaux(ja(i)) = iaux(ja(i)) + 1
srt_inp = srt_inp .and.(ja(i-1)<=ja(i))
end do
else
use_buffers=.false.
end if
end if
!use_buffers=use_buffers.and.srt_inp
! Check again use_buffers.
if (use_buffers) then
iaux(ja(1)) = iaux(ja(1)) + 1
srt_inp = .true.
do i=2,nzin
iaux(ja(i)) = iaux(ja(i)) + 1
srt_inp = srt_inp .and.(ja(i-1)<=ja(i))
end do
if (srt_inp) then if (srt_inp) then
! If input was already col-major ! If input was already col-major
! we can do it col-by-col here. ! we can do it col-by-col here.
@ -3883,17 +3904,16 @@ subroutine psb_z_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
enddo enddo
else if (.not.srt_inp) then else if (.not.srt_inp) then
! If input was not already row-major ! If input was not already col-major
! we have to sort all ! we have to sort all
ip = iaux(1) ip = iaux(1)
iaux(1) = 0 iaux(1) = 0
do i=2, nr do i=2, nc
is = iaux(i) is = iaux(i)
iaux(i) = ip iaux(i) = ip
ip = ip + is ip = ip + is
end do end do
iaux(nr+1) = ip iaux(nc+1) = ip
do i=1,nzin do i=1,nzin
icl = ja(i) icl = ja(i)
@ -3914,7 +3934,6 @@ subroutine psb_z_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
if (iret == 0) & if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),& & call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2) & ias(i:imx),jas(i:imx),ix2)
select case(dupl_) select case(dupl_)
case(psb_dupl_ovwrt_) case(psb_dupl_ovwrt_)
k = k + 1 k = k + 1

Write Preview
Loading…
Cancel
Save