Newer
Older
subroutine shrink_dp_pointer_array(threadinfo, x, new_size)
! resize the input array.
! Author: Douglas Guptill
! Copyright (c) 2009 Douglas Guptill. All rights reserved.
! 2009-07-14: new
!
! Does not work as desired; x is not available.
! Not called in douar.
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
use threads
use definitions
implicit none
! parameters, in
integer new_size
type (thread) threadinfo
! parameters, in/out
double precision, dimension(:),pointer::x
! local variables
integer i
double precision, dimension(:),pointer::t
! make a temporary array
allocate (t(new_size),stat=threadinfo%err)
call heap (threadinfo, 't', 'shrink_dp_pointer_array...', size(t), 'dp', +1)
! transfer the input data to it
do i = 1, new_size
t(i) = x(i)
enddo
! delete the input array
call heap (threadinfo, 'x', 'shrink_dp_pointer_array...', size(x), 'dp', -1)
deallocate(x)
! re-create the input array, with a new size
allocate (x(new_size),stat=threadinfo%err)
call heap (threadinfo, 'x', 'shrink_dp_pointer_array...', size(x), 'dp', +1)
! transfer the data from the temporary array to the new input aray
do i = 1, new_size
x(i) = t(i)
enddo
! delete the temporary array
call heap (threadinfo, 't', 'shrink_dp_pointer_array...', size(t), 'dp', -1)
deallocate(t)
return
end