From 6fc9a1c3694a411e387ceff266a097a79f50c370 Mon Sep 17 00:00:00 2001 From: Douglas Guptill <douglas.guptill@dal.ca> Date: Mon, 27 Jul 2009 16:22:18 +0000 Subject: [PATCH] same as octreesolve_shrink_xyz, for different type --- octreelsf_shrink_xyz.f90 | 91 ++++++++++++++++++++++++++++++++++++++++ octreev_shrink_xyz.f90 | 91 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 182 insertions(+) create mode 100644 octreelsf_shrink_xyz.f90 create mode 100644 octreev_shrink_xyz.f90 diff --git a/octreelsf_shrink_xyz.f90 b/octreelsf_shrink_xyz.f90 new file mode 100644 index 00000000..2c763076 --- /dev/null +++ b/octreelsf_shrink_xyz.f90 @@ -0,0 +1,91 @@ +subroutine octreelsf_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 (octreelsf) 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', 'octreelsf_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', 'octreelsf_shrink_xyz...', size(os%x), 'dp', -1) +deallocate(os%x) +allocate (os%x(new_size),stat=threadinfo%err) +call heap (threadinfo, 'os%x', 'octreelsf_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', 'octreelsf_shrink_xyz...', size(os%y), 'dp', -1) +deallocate(os%y) +allocate (os%y(new_size),stat=threadinfo%err) +call heap (threadinfo, 'os%y', 'octreelsf_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', 'octreelsf_shrink_xyz...', size(os%z), 'dp', -1) +deallocate(os%z) +allocate (os%z(new_size),stat=threadinfo%err) +call heap (threadinfo, 'os%z', 'octreelsf_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', 'octreelsf_shrink_xyz...', size(t), 'dp', -1) +deallocate(t) + +return +end diff --git a/octreev_shrink_xyz.f90 b/octreev_shrink_xyz.f90 new file mode 100644 index 00000000..e2b90969 --- /dev/null +++ b/octreev_shrink_xyz.f90 @@ -0,0 +1,91 @@ +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 -- GitLab