SUBROUTINE lpm_sort_arrays !--------------------------------------------------------------------------------! ! This file is part of PALM. ! ! PALM is free software: you can redistribute it and/or modify it under the terms ! of the GNU General Public License as published by the Free Software Foundation, ! either version 3 of the License, or (at your option) any later version. ! ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License along with ! PALM. If not, see . ! ! Copyright 1997-2012 Leibniz University Hannover !--------------------------------------------------------------------------------! ! ! Current revisions: ! ------------------ ! ! ! Former revisions: ! ----------------- ! $Id: lpm_sort_arrays.f90 1036 2012-10-22 13:43:42Z raasch $ ! ! 849 2012-03-15 10:35:09Z raasch ! initial revision (former part of advec_particles) ! ! ! Description: ! ------------ ! Sort particles in the sequence the grid boxes are stored in memory. !------------------------------------------------------------------------------! USE arrays_3d USE control_parameters USE cpulog USE grid_variables USE indices USE interfaces USE particle_attributes IMPLICIT NONE INTEGER :: i, ilow, j, k, n TYPE(particle_type), DIMENSION(:), POINTER :: particles_temp CALL cpu_log( log_point_s(47), 'lpm_sort_arrays', 'start' ) ! !-- Initialize counters and set pointer of the temporary array into which !-- particles are sorted to free memory prt_count = 0 sort_count = sort_count +1 SELECT CASE ( MOD( sort_count, 2 ) ) CASE ( 0 ) particles_temp => part_1 CASE ( 1 ) particles_temp => part_2 END SELECT ! !-- Count the particles per gridbox DO n = 1, number_of_particles i = ( particles(n)%x + 0.5 * dx ) * ddx j = ( particles(n)%y + 0.5 * dy ) * ddy k = particles(n)%z / dz + 1 + offset_ocean_nzt ! only exact if equidistant prt_count(k,j,i) = prt_count(k,j,i) + 1 IF ( i < nxl .OR. i > nxr .OR. j < nys .OR. j > nyn .OR. k < nzb+1 .OR. & k > nzt ) THEN WRITE( message_string, * ) ' particle out of range: i=', i, ' j=', & j, ' k=', k, & ' nxl=', nxl, ' nxr=', nxr, & ' nys=', nys, ' nyn=', nyn, & ' nzb=', nzb, ' nzt=', nzt CALL message( 'lpm_sort_arrays', 'PA0149', 1, 2, 0, 6, 0 ) ENDIF ENDDO ! !-- Calculate the lower indices of those ranges of the particles-array !-- containing particles which belong to the same gridpox i,j,k ilow = 1 DO i = nxl, nxr DO j = nys, nyn DO k = nzb+1, nzt prt_start_index(k,j,i) = ilow ilow = ilow + prt_count(k,j,i) ENDDO ENDDO ENDDO ! !-- Sorting the particles DO n = 1, number_of_particles i = ( particles(n)%x + 0.5 * dx ) * ddx j = ( particles(n)%y + 0.5 * dy ) * ddy k = particles(n)%z / dz + 1 + offset_ocean_nzt ! only exact if equidistant particles_temp(prt_start_index(k,j,i)) = particles(n) prt_start_index(k,j,i) = prt_start_index(k,j,i) + 1 ENDDO ! !-- Redirect the particles pointer to the sorted array SELECT CASE ( MOD( sort_count, 2 ) ) CASE ( 0 ) particles => part_1 CASE ( 1 ) particles => part_2 END SELECT ! !-- Reset the index array to the actual start position DO i = nxl, nxr DO j = nys, nyn DO k = nzb+1, nzt prt_start_index(k,j,i) = prt_start_index(k,j,i) - prt_count(k,j,i) ENDDO ENDDO ENDDO CALL cpu_log( log_point_s(47), 'lpm_sort_arrays', 'stop' ) END SUBROUTINE lpm_sort_arrays