fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-19 20:32:12 +00:00
Code Issues Packages Projects Releases Wiki Activity

Memory allocation for COO/CSC/CSR.

Browse Source
This commit is contained in:
Salvatore Filippone
2019-07-09 13:30:15 +01:00
parent 57d08dc4d7
commit 239f25a913
12 changed files with 184 additions and 92 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/serial/impl/psb_c_coo_impl.f90
+34 -7
View File
@@ -3241,20 +3241,26 @@ subroutine psb_c_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
allocate(iaux(max(nr,nc,nzin)+2),stat=info)
allocate(iaux(nzin+2),stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(max(nr,nc,nzin)+2), stat=info)
use_buffers = (info == 0)
select case(idir_)
case(psb_row_major_)
! Row major order
if (nr <= nzin) then
! Avoid strange situations with large indices
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(nzin+2), stat=info)
use_buffers = (info == 0)
else
use_buffers = .false.
end if
if (use_buffers) then
if (.not.( (ia(1) < 1).or.(ia(1)> nr)) ) then
iaux(:) = 0
@@ -3576,6 +3582,14 @@ subroutine psb_c_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
case(psb_col_major_)
if (nc <= nzin) then
! Avoid strange situations with large indices
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(nzin+2), stat=info)
use_buffers = (info == 0)
else
use_buffers = .false.
end if
if (use_buffers) then
iaux(:) = 0
if (.not.( (ja(1) < 1).or.(ja(1)> nc)) ) then
@@ -6127,20 +6141,25 @@ subroutine psb_lc_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
allocate(iaux(max(nr,nc,nzin)+2),stat=info)
allocate(iaux(nzin+2),stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(max(nr,nc,nzin)+2), stat=info)
use_buffers = (info == 0)
select case(idir_)
case(psb_row_major_)
! Row major order
if (nr <= nzin) then
! Avoid strange situations with large indices
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(nzin+2), stat=info)
use_buffers = (info == 0)
else
use_buffers = .false.
end if
if (use_buffers) then
if (.not.( (ia(1) < 1).or.(ia(1)> nr)) ) then
iaux(:) = 0
@@ -6463,6 +6482,14 @@ subroutine psb_lc_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
case(psb_col_major_)
if (nc <= nzin) then
! Avoid strange situations with large indices
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(nzin+2), stat=info)
use_buffers = (info == 0)
else
use_buffers = .false.
end if
if (use_buffers) then
iaux(:) = 0
if (.not.( (ja(1) < 1).or.(ja(1)> nc)) ) then
base/serial/impl/psb_c_csc_impl.f90
+4 -6
View File
@@ -2220,7 +2220,7 @@ subroutine psb_c_mv_csc_from_coo(a,b,info)
call move_alloc(b%ja,itemp)
call move_alloc(b%ia,a%ia)
call move_alloc(b%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%icp,info)
call psb_realloc(nc+1,a%icp,info)
call b%free()
a%icp(:) = 0
@@ -2489,8 +2489,7 @@ subroutine psb_c_csc_reallocate_nz(nz,a)
call psb_realloc(max(nz,ione),a%ia,info)
if (info == psb_success_) call psb_realloc(max(nz,ione),a%val,info)
if (info == psb_success_) call psb_realloc(max(nz,a%get_nrows()+1,&
& a%get_ncols()+1), a%icp,info)
if (info == psb_success_) call psb_realloc(a%get_ncols()+1, a%icp,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -4071,7 +4070,7 @@ subroutine psb_lc_mv_csc_from_coo(a,b,info)
call move_alloc(b%ja,itemp)
call move_alloc(b%ia,a%ia)
call move_alloc(b%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%icp,info)
call psb_realloc(nc+1,a%icp,info)
call b%free()
a%icp(:) = 0
@@ -4340,8 +4339,7 @@ subroutine psb_lc_csc_reallocate_nz(nz,a)
call psb_realloc(max(nz,ione),a%ia,info)
if (info == psb_success_) call psb_realloc(max(nz,ione),a%val,info)
if (info == psb_success_) call psb_realloc(max(nz,a%get_nrows()+1,&
& a%get_ncols()+1), a%icp,info)
if (info == psb_success_) call psb_realloc(a%get_ncols()+1, a%icp,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
base/serial/impl/psb_c_csr_impl.f90
+8 -10
View File
@@ -1708,8 +1708,7 @@ subroutine psb_c_csr_reallocate_nz(nz,a)
call psb_realloc(max(nz,ione),a%ja,info)
if (info == psb_success_) call psb_realloc(max(nz,ione),a%val,info)
if (info == psb_success_) call psb_realloc(&
& max(nz,a%get_nrows()+1,a%get_ncols()+1),a%irp,info)
if (info == psb_success_) call psb_realloc(a%get_nrows()+1,a%irp,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -2866,7 +2865,7 @@ subroutine psb_c_cp_csr_from_coo(a,b,info)
call move_alloc(tmp%ia,itemp)
call move_alloc(tmp%ja,a%ja)
call move_alloc(tmp%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%irp,info)
call psb_realloc(nr+1,a%irp,info)
call tmp%free()
else
@@ -2884,7 +2883,7 @@ subroutine psb_c_cp_csr_from_coo(a,b,info)
call psb_safe_ab_cpy(b%ia,itemp,info)
if (info == psb_success_) call psb_safe_ab_cpy(b%ja,a%ja,info)
if (info == psb_success_) call psb_safe_ab_cpy(b%val,a%val,info)
if (info == psb_success_) call psb_realloc(max(nr+1,nc+1),a%irp,info)
if (info == psb_success_) call psb_realloc(nr+1,a%irp,info)
endif
@@ -3035,7 +3034,7 @@ subroutine psb_c_mv_csr_from_coo(a,b,info)
call move_alloc(b%ia,itemp)
call move_alloc(b%ja,a%ja)
call move_alloc(b%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%irp,info)
call psb_realloc(nr+1,a%irp,info)
call b%free()
@@ -3831,8 +3830,7 @@ subroutine psb_lc_csr_reallocate_nz(nz,a)
call psb_realloc(max(nz,ione),a%ja,info)
if (info == psb_success_) call psb_realloc(max(nz,ione),a%val,info)
if (info == psb_success_) call psb_realloc(&
& max(nz,a%get_nrows()+1,a%get_ncols()+1),a%irp,info)
if (info == psb_success_) call psb_realloc(a%get_nrows()+1,a%irp,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -4991,7 +4989,7 @@ subroutine psb_lc_cp_csr_from_coo(a,b,info)
call move_alloc(tmp%ia,itemp)
call move_alloc(tmp%ja,a%ja)
call move_alloc(tmp%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%irp,info)
call psb_realloc(nr+1,a%irp,info)
call tmp%free()
else
@@ -5009,7 +5007,7 @@ subroutine psb_lc_cp_csr_from_coo(a,b,info)
call psb_safe_ab_cpy(b%ia,itemp,info)
if (info == psb_success_) call psb_safe_ab_cpy(b%ja,a%ja,info)
if (info == psb_success_) call psb_safe_ab_cpy(b%val,a%val,info)
if (info == psb_success_) call psb_realloc(max(nr+1,nc+1),a%irp,info)
if (info == psb_success_) call psb_realloc(nr+1,a%irp,info)
endif
@@ -5160,7 +5158,7 @@ subroutine psb_lc_mv_csr_from_coo(a,b,info)
call move_alloc(b%ia,itemp)
call move_alloc(b%ja,a%ja)
call move_alloc(b%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%irp,info)
call psb_realloc(nr+1,a%irp,info)
call b%free()
base/serial/impl/psb_d_coo_impl.f90
+34 -7
View File
@@ -3241,20 +3241,26 @@ subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
allocate(iaux(max(nr,nc,nzin)+2),stat=info)
allocate(iaux(nzin+2),stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(max(nr,nc,nzin)+2), stat=info)
use_buffers = (info == 0)
select case(idir_)
case(psb_row_major_)
! Row major order
if (nr <= nzin) then
! Avoid strange situations with large indices
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(nzin+2), stat=info)
use_buffers = (info == 0)
else
use_buffers = .false.
end if
if (use_buffers) then
if (.not.( (ia(1) < 1).or.(ia(1)> nr)) ) then
iaux(:) = 0
@@ -3576,6 +3582,14 @@ subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
case(psb_col_major_)
if (nc <= nzin) then
! Avoid strange situations with large indices
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(nzin+2), stat=info)
use_buffers = (info == 0)
else
use_buffers = .false.
end if
if (use_buffers) then
iaux(:) = 0
if (.not.( (ja(1) < 1).or.(ja(1)> nc)) ) then
@@ -6127,20 +6141,25 @@ subroutine psb_ld_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
allocate(iaux(max(nr,nc,nzin)+2),stat=info)
allocate(iaux(nzin+2),stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(max(nr,nc,nzin)+2), stat=info)
use_buffers = (info == 0)
select case(idir_)
case(psb_row_major_)
! Row major order
if (nr <= nzin) then
! Avoid strange situations with large indices
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(nzin+2), stat=info)
use_buffers = (info == 0)
else
use_buffers = .false.
end if
if (use_buffers) then
if (.not.( (ia(1) < 1).or.(ia(1)> nr)) ) then
iaux(:) = 0
@@ -6463,6 +6482,14 @@ subroutine psb_ld_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
case(psb_col_major_)
if (nc <= nzin) then
! Avoid strange situations with large indices
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(nzin+2), stat=info)
use_buffers = (info == 0)
else
use_buffers = .false.
end if
if (use_buffers) then
iaux(:) = 0
if (.not.( (ja(1) < 1).or.(ja(1)> nc)) ) then
base/serial/impl/psb_d_csc_impl.f90
+4 -6
View File
@@ -2220,7 +2220,7 @@ subroutine psb_d_mv_csc_from_coo(a,b,info)
call move_alloc(b%ja,itemp)
call move_alloc(b%ia,a%ia)
call move_alloc(b%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%icp,info)
call psb_realloc(nc+1,a%icp,info)
call b%free()
a%icp(:) = 0
@@ -2489,8 +2489,7 @@ subroutine psb_d_csc_reallocate_nz(nz,a)
call psb_realloc(max(nz,ione),a%ia,info)
if (info == psb_success_) call psb_realloc(max(nz,ione),a%val,info)
if (info == psb_success_) call psb_realloc(max(nz,a%get_nrows()+1,&
& a%get_ncols()+1), a%icp,info)
if (info == psb_success_) call psb_realloc(a%get_ncols()+1, a%icp,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -4071,7 +4070,7 @@ subroutine psb_ld_mv_csc_from_coo(a,b,info)
call move_alloc(b%ja,itemp)
call move_alloc(b%ia,a%ia)
call move_alloc(b%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%icp,info)
call psb_realloc(nc+1,a%icp,info)
call b%free()
a%icp(:) = 0
@@ -4340,8 +4339,7 @@ subroutine psb_ld_csc_reallocate_nz(nz,a)
call psb_realloc(max(nz,ione),a%ia,info)
if (info == psb_success_) call psb_realloc(max(nz,ione),a%val,info)
if (info == psb_success_) call psb_realloc(max(nz,a%get_nrows()+1,&
& a%get_ncols()+1), a%icp,info)
if (info == psb_success_) call psb_realloc(a%get_ncols()+1, a%icp,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
base/serial/impl/psb_d_csr_impl.f90
+8 -10
View File
@@ -1708,8 +1708,7 @@ subroutine psb_d_csr_reallocate_nz(nz,a)
call psb_realloc(max(nz,ione),a%ja,info)
if (info == psb_success_) call psb_realloc(max(nz,ione),a%val,info)
if (info == psb_success_) call psb_realloc(&
& max(nz,a%get_nrows()+1,a%get_ncols()+1),a%irp,info)
if (info == psb_success_) call psb_realloc(a%get_nrows()+1,a%irp,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -2866,7 +2865,7 @@ subroutine psb_d_cp_csr_from_coo(a,b,info)
call move_alloc(tmp%ia,itemp)
call move_alloc(tmp%ja,a%ja)
call move_alloc(tmp%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%irp,info)
call psb_realloc(nr+1,a%irp,info)
call tmp%free()
else
@@ -2884,7 +2883,7 @@ subroutine psb_d_cp_csr_from_coo(a,b,info)
call psb_safe_ab_cpy(b%ia,itemp,info)
if (info == psb_success_) call psb_safe_ab_cpy(b%ja,a%ja,info)
if (info == psb_success_) call psb_safe_ab_cpy(b%val,a%val,info)
if (info == psb_success_) call psb_realloc(max(nr+1,nc+1),a%irp,info)
if (info == psb_success_) call psb_realloc(nr+1,a%irp,info)
endif
@@ -3035,7 +3034,7 @@ subroutine psb_d_mv_csr_from_coo(a,b,info)
call move_alloc(b%ia,itemp)
call move_alloc(b%ja,a%ja)
call move_alloc(b%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%irp,info)
call psb_realloc(nr+1,a%irp,info)
call b%free()
@@ -3831,8 +3830,7 @@ subroutine psb_ld_csr_reallocate_nz(nz,a)
call psb_realloc(max(nz,ione),a%ja,info)
if (info == psb_success_) call psb_realloc(max(nz,ione),a%val,info)
if (info == psb_success_) call psb_realloc(&
& max(nz,a%get_nrows()+1,a%get_ncols()+1),a%irp,info)
if (info == psb_success_) call psb_realloc(a%get_nrows()+1,a%irp,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -4991,7 +4989,7 @@ subroutine psb_ld_cp_csr_from_coo(a,b,info)
call move_alloc(tmp%ia,itemp)
call move_alloc(tmp%ja,a%ja)
call move_alloc(tmp%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%irp,info)
call psb_realloc(nr+1,a%irp,info)
call tmp%free()
else
@@ -5009,7 +5007,7 @@ subroutine psb_ld_cp_csr_from_coo(a,b,info)
call psb_safe_ab_cpy(b%ia,itemp,info)
if (info == psb_success_) call psb_safe_ab_cpy(b%ja,a%ja,info)
if (info == psb_success_) call psb_safe_ab_cpy(b%val,a%val,info)
if (info == psb_success_) call psb_realloc(max(nr+1,nc+1),a%irp,info)
if (info == psb_success_) call psb_realloc(nr+1,a%irp,info)
endif
@@ -5160,7 +5158,7 @@ subroutine psb_ld_mv_csr_from_coo(a,b,info)
call move_alloc(b%ia,itemp)
call move_alloc(b%ja,a%ja)
call move_alloc(b%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%irp,info)
call psb_realloc(nr+1,a%irp,info)
call b%free()
base/serial/impl/psb_s_coo_impl.f90
+34 -7
View File
@@ -3241,20 +3241,26 @@ subroutine psb_s_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
allocate(iaux(max(nr,nc,nzin)+2),stat=info)
allocate(iaux(nzin+2),stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(max(nr,nc,nzin)+2), stat=info)
use_buffers = (info == 0)
select case(idir_)
case(psb_row_major_)
! Row major order
if (nr <= nzin) then
! Avoid strange situations with large indices
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(nzin+2), stat=info)
use_buffers = (info == 0)
else
use_buffers = .false.
end if
if (use_buffers) then
if (.not.( (ia(1) < 1).or.(ia(1)> nr)) ) then
iaux(:) = 0
@@ -3576,6 +3582,14 @@ subroutine psb_s_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
case(psb_col_major_)
if (nc <= nzin) then
! Avoid strange situations with large indices
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(nzin+2), stat=info)
use_buffers = (info == 0)
else
use_buffers = .false.
end if
if (use_buffers) then
iaux(:) = 0
if (.not.( (ja(1) < 1).or.(ja(1)> nc)) ) then
@@ -6127,20 +6141,25 @@ subroutine psb_ls_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
allocate(iaux(max(nr,nc,nzin)+2),stat=info)
allocate(iaux(nzin+2),stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(max(nr,nc,nzin)+2), stat=info)
use_buffers = (info == 0)
select case(idir_)
case(psb_row_major_)
! Row major order
if (nr <= nzin) then
! Avoid strange situations with large indices
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(nzin+2), stat=info)
use_buffers = (info == 0)
else
use_buffers = .false.
end if
if (use_buffers) then
if (.not.( (ia(1) < 1).or.(ia(1)> nr)) ) then
iaux(:) = 0
@@ -6463,6 +6482,14 @@ subroutine psb_ls_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
case(psb_col_major_)
if (nc <= nzin) then
! Avoid strange situations with large indices
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(nzin+2), stat=info)
use_buffers = (info == 0)
else
use_buffers = .false.
end if
if (use_buffers) then
iaux(:) = 0
if (.not.( (ja(1) < 1).or.(ja(1)> nc)) ) then
base/serial/impl/psb_s_csc_impl.f90
+4 -6
View File
@@ -2220,7 +2220,7 @@ subroutine psb_s_mv_csc_from_coo(a,b,info)
call move_alloc(b%ja,itemp)
call move_alloc(b%ia,a%ia)
call move_alloc(b%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%icp,info)
call psb_realloc(nc+1,a%icp,info)
call b%free()
a%icp(:) = 0
@@ -2489,8 +2489,7 @@ subroutine psb_s_csc_reallocate_nz(nz,a)
call psb_realloc(max(nz,ione),a%ia,info)
if (info == psb_success_) call psb_realloc(max(nz,ione),a%val,info)
if (info == psb_success_) call psb_realloc(max(nz,a%get_nrows()+1,&
& a%get_ncols()+1), a%icp,info)
if (info == psb_success_) call psb_realloc(a%get_ncols()+1, a%icp,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -4071,7 +4070,7 @@ subroutine psb_ls_mv_csc_from_coo(a,b,info)
call move_alloc(b%ja,itemp)
call move_alloc(b%ia,a%ia)
call move_alloc(b%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%icp,info)
call psb_realloc(nc+1,a%icp,info)
call b%free()
a%icp(:) = 0
@@ -4340,8 +4339,7 @@ subroutine psb_ls_csc_reallocate_nz(nz,a)
call psb_realloc(max(nz,ione),a%ia,info)
if (info == psb_success_) call psb_realloc(max(nz,ione),a%val,info)
if (info == psb_success_) call psb_realloc(max(nz,a%get_nrows()+1,&
& a%get_ncols()+1), a%icp,info)
if (info == psb_success_) call psb_realloc(a%get_ncols()+1, a%icp,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
base/serial/impl/psb_s_csr_impl.f90
+8 -10
View File
@@ -1708,8 +1708,7 @@ subroutine psb_s_csr_reallocate_nz(nz,a)
call psb_realloc(max(nz,ione),a%ja,info)
if (info == psb_success_) call psb_realloc(max(nz,ione),a%val,info)
if (info == psb_success_) call psb_realloc(&
& max(nz,a%get_nrows()+1,a%get_ncols()+1),a%irp,info)
if (info == psb_success_) call psb_realloc(a%get_nrows()+1,a%irp,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -2866,7 +2865,7 @@ subroutine psb_s_cp_csr_from_coo(a,b,info)
call move_alloc(tmp%ia,itemp)
call move_alloc(tmp%ja,a%ja)
call move_alloc(tmp%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%irp,info)
call psb_realloc(nr+1,a%irp,info)
call tmp%free()
else
@@ -2884,7 +2883,7 @@ subroutine psb_s_cp_csr_from_coo(a,b,info)
call psb_safe_ab_cpy(b%ia,itemp,info)
if (info == psb_success_) call psb_safe_ab_cpy(b%ja,a%ja,info)
if (info == psb_success_) call psb_safe_ab_cpy(b%val,a%val,info)
if (info == psb_success_) call psb_realloc(max(nr+1,nc+1),a%irp,info)
if (info == psb_success_) call psb_realloc(nr+1,a%irp,info)
endif
@@ -3035,7 +3034,7 @@ subroutine psb_s_mv_csr_from_coo(a,b,info)
call move_alloc(b%ia,itemp)
call move_alloc(b%ja,a%ja)
call move_alloc(b%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%irp,info)
call psb_realloc(nr+1,a%irp,info)
call b%free()
@@ -3831,8 +3830,7 @@ subroutine psb_ls_csr_reallocate_nz(nz,a)
call psb_realloc(max(nz,ione),a%ja,info)
if (info == psb_success_) call psb_realloc(max(nz,ione),a%val,info)
if (info == psb_success_) call psb_realloc(&
& max(nz,a%get_nrows()+1,a%get_ncols()+1),a%irp,info)
if (info == psb_success_) call psb_realloc(a%get_nrows()+1,a%irp,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -4991,7 +4989,7 @@ subroutine psb_ls_cp_csr_from_coo(a,b,info)
call move_alloc(tmp%ia,itemp)
call move_alloc(tmp%ja,a%ja)
call move_alloc(tmp%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%irp,info)
call psb_realloc(nr+1,a%irp,info)
call tmp%free()
else
@@ -5009,7 +5007,7 @@ subroutine psb_ls_cp_csr_from_coo(a,b,info)
call psb_safe_ab_cpy(b%ia,itemp,info)
if (info == psb_success_) call psb_safe_ab_cpy(b%ja,a%ja,info)
if (info == psb_success_) call psb_safe_ab_cpy(b%val,a%val,info)
if (info == psb_success_) call psb_realloc(max(nr+1,nc+1),a%irp,info)
if (info == psb_success_) call psb_realloc(nr+1,a%irp,info)
endif
@@ -5160,7 +5158,7 @@ subroutine psb_ls_mv_csr_from_coo(a,b,info)
call move_alloc(b%ia,itemp)
call move_alloc(b%ja,a%ja)
call move_alloc(b%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%irp,info)
call psb_realloc(nr+1,a%irp,info)
call b%free()
base/serial/impl/psb_z_coo_impl.f90
+34 -7
View File
@@ -3241,20 +3241,26 @@ subroutine psb_z_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
allocate(iaux(max(nr,nc,nzin)+2),stat=info)
allocate(iaux(nzin+2),stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(max(nr,nc,nzin)+2), stat=info)
use_buffers = (info == 0)
select case(idir_)
case(psb_row_major_)
! Row major order
if (nr <= nzin) then
! Avoid strange situations with large indices
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(nzin+2), stat=info)
use_buffers = (info == 0)
else
use_buffers = .false.
end if
if (use_buffers) then
if (.not.( (ia(1) < 1).or.(ia(1)> nr)) ) then
iaux(:) = 0
@@ -3576,6 +3582,14 @@ subroutine psb_z_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
case(psb_col_major_)
if (nc <= nzin) then
! Avoid strange situations with large indices
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(nzin+2), stat=info)
use_buffers = (info == 0)
else
use_buffers = .false.
end if
if (use_buffers) then
iaux(:) = 0
if (.not.( (ja(1) < 1).or.(ja(1)> nc)) ) then
@@ -6127,20 +6141,25 @@ subroutine psb_lz_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
allocate(iaux(max(nr,nc,nzin)+2),stat=info)
allocate(iaux(nzin+2),stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(max(nr,nc,nzin)+2), stat=info)
use_buffers = (info == 0)
select case(idir_)
case(psb_row_major_)
! Row major order
if (nr <= nzin) then
! Avoid strange situations with large indices
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(nzin+2), stat=info)
use_buffers = (info == 0)
else
use_buffers = .false.
end if
if (use_buffers) then
if (.not.( (ia(1) < 1).or.(ia(1)> nr)) ) then
iaux(:) = 0
@@ -6463,6 +6482,14 @@ subroutine psb_lz_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
case(psb_col_major_)
if (nc <= nzin) then
! Avoid strange situations with large indices
allocate(ias(nzin),jas(nzin),vs(nzin),ix2(nzin+2), stat=info)
use_buffers = (info == 0)
else
use_buffers = .false.
end if
if (use_buffers) then
iaux(:) = 0
if (.not.( (ja(1) < 1).or.(ja(1)> nc)) ) then
base/serial/impl/psb_z_csc_impl.f90
+4 -6
View File
@@ -2220,7 +2220,7 @@ subroutine psb_z_mv_csc_from_coo(a,b,info)
call move_alloc(b%ja,itemp)
call move_alloc(b%ia,a%ia)
call move_alloc(b%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%icp,info)
call psb_realloc(nc+1,a%icp,info)
call b%free()
a%icp(:) = 0
@@ -2489,8 +2489,7 @@ subroutine psb_z_csc_reallocate_nz(nz,a)
call psb_realloc(max(nz,ione),a%ia,info)
if (info == psb_success_) call psb_realloc(max(nz,ione),a%val,info)
if (info == psb_success_) call psb_realloc(max(nz,a%get_nrows()+1,&
& a%get_ncols()+1), a%icp,info)
if (info == psb_success_) call psb_realloc(a%get_ncols()+1, a%icp,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -4071,7 +4070,7 @@ subroutine psb_lz_mv_csc_from_coo(a,b,info)
call move_alloc(b%ja,itemp)
call move_alloc(b%ia,a%ia)
call move_alloc(b%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%icp,info)
call psb_realloc(nc+1,a%icp,info)
call b%free()
a%icp(:) = 0
@@ -4340,8 +4339,7 @@ subroutine psb_lz_csc_reallocate_nz(nz,a)
call psb_realloc(max(nz,ione),a%ia,info)
if (info == psb_success_) call psb_realloc(max(nz,ione),a%val,info)
if (info == psb_success_) call psb_realloc(max(nz,a%get_nrows()+1,&
& a%get_ncols()+1), a%icp,info)
if (info == psb_success_) call psb_realloc(a%get_ncols()+1, a%icp,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
base/serial/impl/psb_z_csr_impl.f90
+8 -10
View File
@@ -1708,8 +1708,7 @@ subroutine psb_z_csr_reallocate_nz(nz,a)
call psb_realloc(max(nz,ione),a%ja,info)
if (info == psb_success_) call psb_realloc(max(nz,ione),a%val,info)
if (info == psb_success_) call psb_realloc(&
& max(nz,a%get_nrows()+1,a%get_ncols()+1),a%irp,info)
if (info == psb_success_) call psb_realloc(a%get_nrows()+1,a%irp,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -2866,7 +2865,7 @@ subroutine psb_z_cp_csr_from_coo(a,b,info)
call move_alloc(tmp%ia,itemp)
call move_alloc(tmp%ja,a%ja)
call move_alloc(tmp%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%irp,info)
call psb_realloc(nr+1,a%irp,info)
call tmp%free()
else
@@ -2884,7 +2883,7 @@ subroutine psb_z_cp_csr_from_coo(a,b,info)
call psb_safe_ab_cpy(b%ia,itemp,info)
if (info == psb_success_) call psb_safe_ab_cpy(b%ja,a%ja,info)
if (info == psb_success_) call psb_safe_ab_cpy(b%val,a%val,info)
if (info == psb_success_) call psb_realloc(max(nr+1,nc+1),a%irp,info)
if (info == psb_success_) call psb_realloc(nr+1,a%irp,info)
endif
@@ -3035,7 +3034,7 @@ subroutine psb_z_mv_csr_from_coo(a,b,info)
call move_alloc(b%ia,itemp)
call move_alloc(b%ja,a%ja)
call move_alloc(b%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%irp,info)
call psb_realloc(nr+1,a%irp,info)
call b%free()
@@ -3831,8 +3830,7 @@ subroutine psb_lz_csr_reallocate_nz(nz,a)
call psb_realloc(max(nz,ione),a%ja,info)
if (info == psb_success_) call psb_realloc(max(nz,ione),a%val,info)
if (info == psb_success_) call psb_realloc(&
& max(nz,a%get_nrows()+1,a%get_ncols()+1),a%irp,info)
if (info == psb_success_) call psb_realloc(a%get_nrows()+1,a%irp,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -4991,7 +4989,7 @@ subroutine psb_lz_cp_csr_from_coo(a,b,info)
call move_alloc(tmp%ia,itemp)
call move_alloc(tmp%ja,a%ja)
call move_alloc(tmp%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%irp,info)
call psb_realloc(nr+1,a%irp,info)
call tmp%free()
else
@@ -5009,7 +5007,7 @@ subroutine psb_lz_cp_csr_from_coo(a,b,info)
call psb_safe_ab_cpy(b%ia,itemp,info)
if (info == psb_success_) call psb_safe_ab_cpy(b%ja,a%ja,info)
if (info == psb_success_) call psb_safe_ab_cpy(b%val,a%val,info)
if (info == psb_success_) call psb_realloc(max(nr+1,nc+1),a%irp,info)
if (info == psb_success_) call psb_realloc(nr+1,a%irp,info)
endif
@@ -5160,7 +5158,7 @@ subroutine psb_lz_mv_csr_from_coo(a,b,info)
call move_alloc(b%ia,itemp)
call move_alloc(b%ja,a%ja)
call move_alloc(b%val,a%val)
call psb_realloc(max(nr+1,nc+1),a%irp,info)
call psb_realloc(nr+1,a%irp,info)
call b%free()