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

Last change on this file since 849 was 849, checked in by raasch, 10 years ago

Changed:


Original routine advec_particles split into several new subroutines and renamed
lpm.
init_particles renamed lpm_init
user_advec_particles renamed user_lpm_advec,
particle_boundary_conds renamed lpm_boundary_conds,
set_particle_attributes renamed lpm_set_attributes,
user_init_particles renamed user_lpm_init,
user_particle_attributes renamed user_lpm_set_attributes
(Makefile, lpm_droplet_collision, lpm_droplet_condensation, init_3d_model, modules, palm, read_var_list, time_integration, write_var_list, deleted: advec_particles, init_particles, particle_boundary_conds, set_particle_attributes, user_advec_particles, user_init_particles, user_particle_attributes, new: lpm, lpm_advec, lpm_boundary_conds, lpm_calc_liquid_water_content, lpm_data_output_particles, lpm_droplet_collision, lpm_drollet_condensation, lpm_exchange_horiz, lpm_extend_particle_array, lpm_extend_tails, lpm_extend_tail_array, lpm_init, lpm_init_sgs_tke, lpm_pack_arrays, lpm_read_restart_file, lpm_release_set, lpm_set_attributes, lpm_sort_arrays, lpm_write_exchange_statistics, lpm_write_restart_file, user_lpm_advec, user_lpm_init, user_lpm_set_attributes

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