fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-19 12:22:10 +00:00
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.
This commit is contained in:
Salvatore Filippone
2008-03-05 13:13:52 +00:00
parent c1d96960d8
commit 9bbfebc3a1
1 changed files with 4 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psb_realloc_mod.F90
+4 -4
View File
@@ -1628,13 +1628,13 @@ Contains
end if
else if (allocated(vin)) 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
else
if (size(vout) /= size(vin)) then
deallocate(vout,stat=info)
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
end if
end if
@@ -1778,13 +1778,13 @@ Contains
end if
else if (allocated(vin)) 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
else
if (size(vout) /= size(vin)) then
deallocate(vout,stat=info)
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
end if
end if