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

Fixed problem: try realloc before giving up on temp_ovrlap

Browse Source
This commit is contained in:
Salvatore Filippone
2006-10-18 08:03:07 +00:00
parent 0fed5f7411
commit 246f04c660
1 changed files with 17 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/tools/psb_cdall.f90
+17 -14
View File
@@ -57,7 +57,7 @@ subroutine psb_cdall(m, n, parts, ictxt, desc_a, info)
!locals
Integer :: counter,i,j,np,me,loc_row,err,loc_col,nprocs,&
& l_ov_ix,l_ov_el,idx, err_act, itmpov, k
& l_ov_ix,l_ov_el,idx, err_act, itmpov, k, ns
integer :: int_err(5),exch(2)
integer, pointer :: prc_v(:), temp_ovrlap(:), ov_idx(:),ov_el(:)
logical, parameter :: debug=.false.
@@ -178,20 +178,23 @@ subroutine psb_cdall(m, n, parts, ictxt, desc_a, info)
counter=counter+1
desc_a%glob_to_loc(i) = counter
if (nprocs > 1) then
if ((itmpov+2+nprocs) > m) then
info=2025
int_err(1)=m
err=info
call psb_errpush(err,name,int_err)
goto 9999
else
itmpov = itmpov + 1
temp_ovrlap(itmpov) = i
itmpov = itmpov + 1
temp_ovrlap(itmpov) = nprocs
temp_ovrlap(itmpov+1:itmpov+nprocs) = prc_v(1:nprocs)
itmpov = itmpov + nprocs
if ((itmpov+2+nprocs) > size(temp_ovrlap)) then
ns = max(itmpov+2+nprocs,int(1.25*size(temp_ovrlap)))
call psb_realloc(ns,temp_ovrlap,info,pad=-1)
if (info /= 0) then
info=2025
int_err(1)=m
err=info
call psb_errpush(err,name,int_err)
goto 9999
endif
endif
itmpov = itmpov + 1
temp_ovrlap(itmpov) = i
itmpov = itmpov + 1
temp_ovrlap(itmpov) = nprocs
temp_ovrlap(itmpov+1:itmpov+nprocs) = prc_v(1:nprocs)
itmpov = itmpov + nprocs
endif
end if
end if