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

psblas2/base/modules:

Browse Source 
psb_realloc_mod.F90

Fixed lower/upper bound handling in realloc when no MOVE_ALLOC.
psblas3-type-indexed
Salvatore Filippone 17 years ago
parent c1d96960d8
commit 9bbfebc3a1
1 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File

8
base/modules/psb_realloc_mod.F90
Unescape Escape View File

@ -1628,13 +1628,13 @@ Contains
end if end if
else if (allocated(vin)) then else if (allocated(vin)) then
if (.not.allocated(vout)) then if (.not.allocated(vout)) then
allocate(vout(size(vin)),stat=info) allocate(vout(vout(lbound(vin,1):ubound(vin,1)),stat=info)
if (info /= 0) return if (info /= 0) return
else else
if (size(vout) /= size(vin)) then if (size(vout) /= size(vin)) then
deallocate(vout,stat=info) deallocate(vout,stat=info)
if (info /= 0) return if (info /= 0) return
allocate(vout(size(vin)),stat=info) allocate(vout(vout(lbound(vin,1):ubound(vin,1)),stat=info)
if (info /= 0) return if (info /= 0) return
end if end if
end if end if
@ -1778,13 +1778,13 @@ Contains
end if end if
else if (allocated(vin)) then else if (allocated(vin)) then
if (.not.allocated(vout)) then if (.not.allocated(vout)) then
allocate(vout(size(vin)),stat=info) allocate(vout(vout(lbound(vin,1):ubound(vin,1)),stat=info)
if (info /= 0) return if (info /= 0) return
else else
if (size(vout) /= size(vin)) then if (size(vout) /= size(vin)) then
deallocate(vout,stat=info) deallocate(vout,stat=info)
if (info /= 0) return if (info /= 0) return
allocate(vout(size(vin)),stat=info) allocate(vout(vout(lbound(vin,1):ubound(vin,1)),stat=info)
if (info /= 0) return if (info /= 0) return
end if end if
end if end if

Write Preview
Loading…
Cancel
Save