source: palm/trunk/SOURCE/lpm_sort_arrays.f90 @ 978

Last change on this file since 978 was 850, checked in by raasch, 12 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 3.2 KB
Line 
1 SUBROUTINE lpm_sort_arrays
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! ------------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: lpm_sort_arrays.f90 850 2012-03-15 12:09:25Z fricke $
11!
12! 849 2012-03-15 10:35:09Z raasch
13! initial revision (former part of advec_particles)
14!
15!
16! Description:
17! ------------
18! Sort particles in the sequence the grid boxes are stored in memory.
19!------------------------------------------------------------------------------!
20
21    USE arrays_3d
22    USE control_parameters
23    USE cpulog
24    USE grid_variables
25    USE indices
26    USE interfaces
27    USE particle_attributes
28
29    IMPLICIT NONE
30
31    INTEGER ::  i, ilow, j, k, n
32
33    TYPE(particle_type), DIMENSION(:), POINTER ::  particles_temp
34
35
36    CALL cpu_log( log_point_s(47), 'lpm_sort_arrays', 'start' )
37
38!
39!-- Initialize counters and set pointer of the temporary array into which
40!-- particles are sorted to free memory
41    prt_count  = 0
42    sort_count = sort_count +1
43
44    SELECT CASE ( MOD( sort_count, 2 ) )
45
46       CASE ( 0 )
47
48          particles_temp => part_1
49
50       CASE ( 1 )
51
52          particles_temp => part_2
53
54    END SELECT
55
56!
57!-- Count the particles per gridbox
58    DO  n = 1, number_of_particles
59
60       i = ( particles(n)%x + 0.5 * dx ) * ddx
61       j = ( particles(n)%y + 0.5 * dy ) * ddy
62       k = particles(n)%z / dz + 1 + offset_ocean_nzt
63           ! only exact if equidistant
64
65       prt_count(k,j,i) = prt_count(k,j,i) + 1
66
67       IF ( i < nxl .OR. i > nxr .OR. j < nys .OR. j > nyn .OR. k < nzb+1 .OR. &
68            k > nzt )  THEN
69          WRITE( message_string, * ) ' particle out of range: i=', i, ' j=', &
70                          j, ' k=', k,                                       &
71                          ' nxl=', nxl, ' nxr=', nxr,                        &
72                          ' nys=', nys, ' nyn=', nyn,                        &
73                          ' nzb=', nzb, ' nzt=', nzt
74         CALL message( 'lpm_sort_arrays', 'PA0149', 1, 2, 0, 6, 0 ) 
75       ENDIF
76
77    ENDDO
78
79!
80!-- Calculate the lower indices of those ranges of the particles-array
81!-- containing particles which belong to the same gridpox i,j,k
82    ilow = 1
83    DO  i = nxl, nxr
84       DO  j = nys, nyn
85          DO  k = nzb+1, nzt
86             prt_start_index(k,j,i) = ilow
87             ilow = ilow + prt_count(k,j,i)
88          ENDDO
89       ENDDO
90    ENDDO
91
92!
93!-- Sorting the particles
94    DO  n = 1, number_of_particles
95
96       i = ( particles(n)%x + 0.5 * dx ) * ddx
97       j = ( particles(n)%y + 0.5 * dy ) * ddy
98       k = particles(n)%z / dz + 1 + offset_ocean_nzt
99           ! only exact if equidistant
100
101       particles_temp(prt_start_index(k,j,i)) = particles(n)
102
103       prt_start_index(k,j,i) = prt_start_index(k,j,i) + 1
104
105    ENDDO
106
107!
108!-- Redirect the particles pointer to the sorted array
109    SELECT CASE ( MOD( sort_count, 2 ) )
110
111       CASE ( 0 )
112
113          particles => part_1
114
115       CASE ( 1 )
116
117          particles => part_2
118
119    END SELECT
120
121!
122!-- Reset the index array to the actual start position
123    DO  i = nxl, nxr
124       DO  j = nys, nyn
125          DO  k = nzb+1, nzt
126             prt_start_index(k,j,i) = prt_start_index(k,j,i) - prt_count(k,j,i)
127          ENDDO
128       ENDDO
129    ENDDO
130
131    CALL cpu_log( log_point_s(47), 'lpm_sort_arrays', 'stop' )
132
133
134 END SUBROUTINE lpm_sort_arrays
Note: See TracBrowser for help on using the repository browser.