Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
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
90
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