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

psblas2:

Browse Source 
base/modules/psb_realloc_mod.F90

Fixed psb_transfer for platforms without MOVE_ALLOC.
psblas3-type-indexed
Salvatore Filippone 17 years ago
parent 54287e0390
commit 5e4519f8b6
1 changed files with 53 additions and 121 deletions
Show Stats Download Patch File Download Diff File

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

@ -1621,26 +1621,14 @@ Contains
end if end if
#else #else
if (allocated(vout)) then
if (.not.allocated(vin) ) then deallocate(vout,stat=info)
if (allocated(vout)) then end if
deallocate(vout,stat=info) if (.not.allocated(vin) ) return
end if allocate(vout(lbound(vin,1):ubound(vin,1)),stat=info)
else if (allocated(vin)) then if (info /= 0) return
if (.not.allocated(vout)) then vout = vin
allocate(vout(vout(lbound(vin,1):ubound(vin,1)),stat=info) deallocate(vin,stat=info)
if (info /= 0) return
else
if (size(vout) /= size(vin)) then
deallocate(vout,stat=info)
if (info /= 0) return
allocate(vout(vout(lbound(vin,1):ubound(vin,1)),stat=info)
if (info /= 0) return
end if
end if
vout = vin
deallocate(vin,stat=info)
end if
#endif #endif
end Subroutine psb_dtransfer1d end Subroutine psb_dtransfer1d
@ -1658,28 +1646,16 @@ Contains
deallocate(vout) deallocate(vout)
end if end if
#else #else
if (allocated(vout)) then
deallocate(vout,stat=info)
end if
if (.not.allocated(vin) ) return
if (.not.allocated(vin) ) then allocate(vout(lbound(vin,1):ubound(vin,1),&
if (allocated(vout)) then & lbound(vin,2):ubound(vin,2)),stat=info)
deallocate(vout,stat=info) if (info /= 0) return
end if vout = vin
else if (allocated(vin)) then deallocate(vin,stat=info)
if (.not.allocated(vout)) then
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(lbound(vin,1):ubound(vin,1),&
& lbound(vin,2):ubound(vin,2)),stat=info)
if (info /= 0) return
end if
end if
vout = vin
deallocate(vin,stat=info)
end if
#endif #endif
end Subroutine psb_dtransfer2d end Subroutine psb_dtransfer2d
@ -1697,25 +1673,14 @@ Contains
deallocate(vout) deallocate(vout)
end if end if
#else #else
if (.not.allocated(vin) ) then if (allocated(vout)) then
if (allocated(vout)) then deallocate(vout,stat=info)
deallocate(vout,stat=info) end if
end if if (.not.allocated(vin) ) return
else if (allocated(vin)) then allocate(vout(lbound(vin,1):ubound(vin,1)),stat=info)
if (.not.allocated(vout)) then if (info /= 0) return
allocate(vout(size(vin)),stat=info) vout = vin
if (info /= 0) return deallocate(vin,stat=info)
else
if (size(vout) /= size(vin)) then
deallocate(vout,stat=info)
if (info /= 0) return
allocate(vout(size(vin)),stat=info)
if (info /= 0) return
end if
end if
vout = vin
deallocate(vin,stat=info)
end if
#endif #endif
end Subroutine psb_ztransfer1d end Subroutine psb_ztransfer1d
@ -1733,27 +1698,16 @@ Contains
deallocate(vout) deallocate(vout)
end if end if
#else #else
if (.not.allocated(vin) ) then if (allocated(vout)) then
if (allocated(vout)) then deallocate(vout,stat=info)
deallocate(vout,stat=info) end if
end if if (.not.allocated(vin) ) return
else if (allocated(vin)) then
if (.not.allocated(vout)) then allocate(vout(lbound(vin,1):ubound(vin,1),&
allocate(vout(lbound(vin,1):ubound(vin,1),& & lbound(vin,2):ubound(vin,2)),stat=info)
& lbound(vin,2):ubound(vin,2)),stat=info) if (info /= 0) return
if (info /= 0) return vout = vin
else deallocate(vin,stat=info)
if (size(vout) /= size(vin)) then
deallocate(vout,stat=info)
if (info /= 0) return
allocate(vout(lbound(vin,1):ubound(vin,1),&
& lbound(vin,2):ubound(vin,2)),stat=info)
if (info /= 0) return
end if
end if
vout = vin
deallocate(vin,stat=info)
end if
#endif #endif
end Subroutine psb_ztransfer2d end Subroutine psb_ztransfer2d
@ -1772,25 +1726,14 @@ Contains
deallocate(vout) deallocate(vout)
end if end if
#else #else
if (.not.allocated(vin) ) then if (allocated(vout)) then
if (allocated(vout)) then deallocate(vout,stat=info)
deallocate(vout,stat=info) end if
end if if (.not.allocated(vin) ) return
else if (allocated(vin)) then allocate(vout(lbound(vin,1):ubound(vin,1)),stat=info)
if (.not.allocated(vout)) then if (info /= 0) return
allocate(vout(vout(lbound(vin,1):ubound(vin,1)),stat=info) vout = vin
if (info /= 0) return deallocate(vin,stat=info)
else
if (size(vout) /= size(vin)) then
deallocate(vout,stat=info)
if (info /= 0) return
allocate(vout(vout(lbound(vin,1):ubound(vin,1)),stat=info)
if (info /= 0) return
end if
end if
vout = vin
deallocate(vin,stat=info)
end if
#endif #endif
end Subroutine psb_itransfer1d end Subroutine psb_itransfer1d
@ -1808,27 +1751,16 @@ Contains
deallocate(vout) deallocate(vout)
end if end if
#else #else
if (.not.allocated(vin) ) then if (allocated(vout)) then
if (allocated(vout)) then deallocate(vout,stat=info)
deallocate(vout,stat=info) end if
end if if (.not.allocated(vin) ) return
else if (allocated(vin)) then
if (.not.allocated(vout)) then allocate(vout(lbound(vin,1):ubound(vin,1),&
allocate(vout(lbound(vin,1):ubound(vin,1),& & lbound(vin,2):ubound(vin,2)),stat=info)
& lbound(vin,2):ubound(vin,2)),stat=info) if (info /= 0) return
if (info /= 0) return vout = vin
else deallocate(vin,stat=info)
if (size(vout) /= size(vin)) then
deallocate(vout,stat=info)
if (info /= 0) return
allocate(vout(lbound(vin,1):ubound(vin,1),&
& lbound(vin,2):ubound(vin,2)),stat=info)
if (info /= 0) return
end if
end if
vout = vin
deallocate(vin,stat=info)
end if
#endif #endif
end Subroutine psb_itransfer2d end Subroutine psb_itransfer2d

Write Preview
Loading…
Cancel
Save