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

Fix realloc for 2D arrays.

Browse Source
psblas3-type-indexed
Salvatore Filippone 17 years ago
parent 1c89518644
commit 84cdf8ff6d
1 changed files with 12 additions and 6 deletions
Show Stats Download Patch File Download Diff File

18
base/modules/psb_realloc_mod.F90
Unescape Escape 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

Write Preview
Loading…
Cancel
Save