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

Fix realloc for 2D arrays.

Browse Source
This commit is contained in:
Salvatore Filippone
2008-01-07 16:59:15 +00:00
parent 1c89518644
commit 84cdf8ff6d
1 changed files with 12 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psb_realloc_mod.F90
+12 -6
View File
@@ -1329,13 +1329,15 @@ Contains
end if
else if (allocated(vin)) then
if (.not.allocated(vout)) then
allocate(vout(size(vin,1),size(vin,2)),stat=info)
allocate(vout(lbound(vin,1):ubound(vin,1),&
& lbound(vin,2):ubound(vin,2)),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,1),size(vin,2)),stat=info)
allocate(vout(lbound(vin,1):ubound(vin,1),&
& lbound(vin,2):ubound(vin,2)),stat=info)
if (info /= 0) return
end if
end if
@@ -1401,13 +1403,15 @@ Contains
end if
else if (allocated(vin)) then
if (.not.allocated(vout)) then
allocate(vout(size(vin,1),size(vin,2)),stat=info)
allocate(vout(lbound(vin,1):ubound(vin,1),&
& lbound(vin,2):ubound(vin,2)),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,1),size(vin,2)),stat=info)
allocate(vout(lbound(vin,1):ubound(vin,1),&
& lbound(vin,2):ubound(vin,2)),stat=info)
if (info /= 0) return
end if
end if
@@ -1474,13 +1478,15 @@ Contains
end if
else if (allocated(vin)) then
if (.not.allocated(vout)) then
allocate(vout(size(vin,1),size(vin,2)),stat=info)
allocate(vout(lbound(vin,1):ubound(vin,1),&
& lbound(vin,2):ubound(vin,2)),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,1),size(vin,2)),stat=info)
allocate(vout(lbound(vin,1):ubound(vin,1),&
& lbound(vin,2):ubound(vin,2)),stat=info)
if (info /= 0) return
end if
end if