octreev_shrink_xyz.f90

subroutine octreev_shrink_xyz(os, threadinfo)

! resize the x,y,z arrays.
! Author: Douglas Guptill
! Copyright (c) 2009 Douglas Guptill. All rights reserved.
! 2009-07-27: new, from a copy of octreesolve_shring_xyz,
!                  and identical to it, 
!                  except for the type of the first parameter.
!             I wish I knew a better way.!

use threads
use definitions

implicit none

! parameters, in
type (thread) threadinfo

! parameters, in/out
type (octreev) os

! local variables
integer i, new_size
double precision, dimension(:),pointer::t

new_size = os%nnode

! make a temporary array
allocate  (t(new_size),stat=threadinfo%err)
call heap (threadinfo, 't', 'octreev_shrink_xyz...', size(t), 'dp', +1)

! shrink x...............................................

! transfer the x data to it
do i = 1, new_size
  t(i) = os%x(i)
enddo

! delete and re-create the x array
call heap (threadinfo, 'os%x', 'octreev_shrink_xyz...', size(os%x), 'dp', -1)
deallocate(os%x)
allocate  (os%x(new_size),stat=threadinfo%err)               
call heap (threadinfo, 'os%x', 'octreev_shrink_xyz...', size(os%x), 'dp', +1)

! transfer the data from the temporary array to the new x aray
do i = 1, new_size
  os%x(i) = t(i)
enddo

! shrink y...............................................

! transfer the y data to it
do i = 1, new_size
  t(i) = os%y(i)
enddo

! delete and re-create the y array
call heap (threadinfo, 'os%y', 'octreev_shrink_xyz...', size(os%y), 'dp', -1)
deallocate(os%y)
allocate  (os%y(new_size),stat=threadinfo%err)               
call heap (threadinfo, 'os%y', 'octreev_shrink_xyz...', size(os%y), 'dp', +1)

! transfer the data from the temporary array to the new y aray
do i = 1, new_size
  os%y(i) = t(i)
enddo

! shrink z...............................................

! transfer the z data to it
do i = 1, new_size
  t(i) = os%z(i)
enddo

! delete and re-create the z array
call heap (threadinfo, 'os%z', 'octreev_shrink_xyz...', size(os%z), 'dp', -1)
deallocate(os%z)
allocate  (os%z(new_size),stat=threadinfo%err)               
call heap (threadinfo, 'os%z', 'octreev_shrink_xyz...', size(os%z), 'dp', +1)

! transfer the data from the temporary array to the new z aray
do i = 1, new_size
  os%z(i) = t(i)
enddo

! delete the temporary array
call heap (threadinfo, 't', 'octreev_shrink_xyz...', size(t), 'dp', -1)
deallocate(t)

return
end