Newer
Older
subroutine octreesolve_shrink_xyz(os, threadinfo)
! resize the x,y,z arrays.
! Author: Douglas Guptill
! Copyright (c) 2009 Douglas Guptill. All rights reserved.
! 2009-07-14: new
! 2009-07-27: remove parameter new_size, reverse order of remaining two.
use threads
use definitions
implicit none
! parameters, in
type (thread) threadinfo
! parameters, in/out
type (octreesolve) os
! local variables
integer i, new_size
double precision, dimension(:),pointer::t
new_size = os%nnode
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
! make a temporary array
allocate (t(new_size),stat=threadinfo%err)
call heap (threadinfo, 't', 'octreesolve_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', 'octreesolve_shrink_xyz...', size(os%x), 'dp', -1)
deallocate(os%x)
allocate (os%x(new_size),stat=threadinfo%err)
call heap (threadinfo, 'os%x', 'octreesolve_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', 'octreesolve_shrink_xyz...', size(os%y), 'dp', -1)
deallocate(os%y)
allocate (os%y(new_size),stat=threadinfo%err)
call heap (threadinfo, 'os%y', 'octreesolve_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', 'octreesolve_shrink_xyz...', size(os%z), 'dp', -1)
deallocate(os%z)
allocate (os%z(new_size),stat=threadinfo%err)
call heap (threadinfo, 'os%z', 'octreesolve_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', 'octreesolve_shrink_xyz...', size(t), 'dp', -1)
deallocate(t)
return
end