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. 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