Changeset 1359 for palm/trunk/SOURCE/lpm_pack_arrays.f90
- Timestamp:
- Apr 11, 2014 5:15:14 PM (10 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/lpm_pack_arrays.f90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/lpm_pack_arrays.f90
r1321 r1359 1 SUBROUTINE lpm_pack_arrays1 MODULE lpm_pack_arrays_mod 2 2 3 3 !--------------------------------------------------------------------------------! … … 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! New particle structure integrated. 23 ! Kind definition added to all floating point numbers. 23 24 ! 24 25 ! Former revisions: … … 47 48 !------------------------------------------------------------------------------! 48 49 49 USE kinds50 51 50 USE particle_attributes, & 52 ONLY: deleted_particles, deleted_tails, new_tail_id, & 53 number_of_particles, number_of_tails, particles, particle_mask, & 51 ONLY: deleted_tails, grid_particles, new_tail_id, & 52 number_of_particles, number_of_tails, offset_ocean_nzt, & 53 offset_ocean_nzt_m1, particles, particle_type, prt_count, & 54 54 particle_tail_coordinates, tail_mask, use_particle_tails 55 55 56 57 IMPLICIT NONE 58 59 INTEGER(iwp) :: n !: 60 INTEGER(iwp) :: nd !: 61 INTEGER(iwp) :: nn !: 62 ! 63 !-- Find out elements marked for deletion and move data with higher index 64 !-- values to these free indices 65 nn = 0 66 nd = 0 67 68 DO n = 1, number_of_particles 69 70 IF ( particle_mask(n) ) THEN 71 nn = nn + 1 72 particles(nn) = particles(n) 73 ELSE 74 nd = nd + 1 56 PRIVATE 57 PUBLIC lpm_pack_all_arrays, lpm_pack_arrays 58 59 INTERFACE lpm_pack_all_arrays 60 MODULE PROCEDURE lpm_pack_all_arrays 61 END INTERFACE lpm_pack_all_arrays 62 63 INTERFACE lpm_pack_arrays 64 MODULE PROCEDURE lpm_pack_arrays 65 END INTERFACE lpm_pack_arrays 66 67 CONTAINS 68 69 SUBROUTINE lpm_pack_all_arrays 70 71 USE cpulog, & 72 ONLY: cpu_log, log_point_s 73 74 USE indices, & 75 ONLY: nxl, nxr, nys, nyn, nzb, nzt 76 77 USE kinds 78 79 IMPLICIT NONE 80 81 INTEGER(iwp) :: i !: 82 INTEGER(iwp) :: j !: 83 INTEGER(iwp) :: k !: 84 85 CALL cpu_log( log_point_s(51), 'lpm_pack_all_arrays', 'start' ) 86 DO i = nxl, nxr 87 DO j = nys, nyn 88 DO k = nzb+1, nzt 89 number_of_particles = prt_count(k,j,i) 90 IF ( number_of_particles <= 0 ) CYCLE 91 particles => grid_particles(k,j,i)%particles(1:number_of_particles) 92 CALL lpm_pack_and_sort(i,j,k) 93 prt_count(k,j,i) = number_of_particles 94 ENDDO 95 ENDDO 96 ENDDO 97 CALL cpu_log( log_point_s(51), 'lpm_pack_all_arrays', 'stop' ) 98 RETURN 99 100 END SUBROUTINE lpm_pack_all_arrays 101 102 SUBROUTINE lpm_pack_arrays 103 104 USE kinds 105 106 IMPLICIT NONE 107 108 INTEGER(iwp) :: n !: 109 INTEGER(iwp) :: nd !: 110 INTEGER(iwp) :: nn !: 111 ! 112 !-- Find out elements marked for deletion and move data from highest index 113 !-- values to these free indices 114 nn = number_of_particles 115 116 DO WHILE ( .NOT. particles(nn)%particle_mask ) 117 nn = nn-1 118 IF ( nn == 0 ) EXIT 119 ENDDO 120 121 IF ( nn > 0 ) THEN 122 DO n = 1, number_of_particles 123 IF ( .NOT. particles(n)%particle_mask ) THEN 124 particles(n) = particles(nn) 125 nn = nn - 1 126 DO WHILE ( .NOT. particles(nn)%particle_mask ) 127 nn = nn-1 128 IF ( n == nn ) EXIT 129 ENDDO 130 ENDIF 131 IF ( n == nn ) EXIT 132 ENDDO 75 133 ENDIF 76 134 77 ENDDO 78 ! 79 !-- The number of deleted particles has been determined in routines 80 !-- lpm_boundary_conds, lpm_droplet_collision, and lpm_exchange_horiz 81 number_of_particles = number_of_particles - deleted_particles 82 135 ! 136 !-- The number of deleted particles has been determined in routines 137 !-- lpm_boundary_conds, lpm_droplet_collision, and lpm_exchange_horiz 138 number_of_particles = nn 139 140 ! 141 !-- particle tails are currently not available 83 142 ! 84 143 !-- Handle tail array in the same way, store the new tail ids and re-assign it 85 144 !-- to the respective particles 86 IF ( use_particle_tails ) THEN87 88 nn = 089 nd = 090 91 DO n = 1, number_of_tails92 93 IF ( tail_mask(n) ) THEN94 nn = nn + 195 particle_tail_coordinates(:,:,nn) = &96 particle_tail_coordinates(:,:,n)97 new_tail_id(n) = nn98 ELSE99 nd = nd + 1100 ENDIF101 102 ENDDO103 104 DO n = 1, number_of_particles105 IF ( particles(n)%tail_id /= 0 ) THEN106 particles(n)%tail_id = new_tail_id(particles(n)%tail_id)107 ENDIF108 ENDDO109 110 ENDIF145 ! IF ( use_particle_tails ) THEN 146 ! 147 ! nn = 0 148 ! nd = 0 149 ! 150 ! DO n = 1, number_of_tails 151 ! 152 ! IF ( tail_mask(n) ) THEN 153 ! nn = nn + 1 154 ! particle_tail_coordinates(:,:,nn) = & 155 ! particle_tail_coordinates(:,:,n) 156 ! new_tail_id(n) = nn 157 ! ELSE 158 ! nd = nd + 1 159 ! ENDIF 160 ! 161 ! ENDDO 162 ! 163 ! DO n = 1, number_of_particles 164 ! IF ( particles(n)%tail_id /= 0 ) THEN 165 ! particles(n)%tail_id = new_tail_id(particles(n)%tail_id) 166 ! ENDIF 167 ! ENDDO 168 ! 169 ! ENDIF 111 170 112 171 ! 113 172 !-- The number of deleted tails has been determined in routines 114 173 !-- lpm_boundary_conds and lpm_exchange_horiz 115 number_of_tails = number_of_tails - deleted_tails 116 117 118 END SUBROUTINE lpm_pack_arrays 174 ! number_of_tails = number_of_tails - deleted_tails 175 176 177 END SUBROUTINE lpm_pack_arrays 178 179 SUBROUTINE lpm_pack_and_sort (ip,jp,kp) 180 181 USE control_parameters, & 182 ONLY: dz, atmos_ocean_sign 183 184 USE indices, & 185 ONLY: nxl, nxr, nys, nyn, nzb, nzt 186 187 USE kinds 188 189 USE grid_variables, & 190 ONLY: ddx, ddy 191 192 IMPLICIT NONE 193 194 INTEGER(iwp), INTENT(IN) :: ip 195 INTEGER(iwp), INTENT(IN) :: jp 196 INTEGER(iwp), INTENT(IN) :: kp 197 198 INTEGER(iwp) :: i 199 INTEGER(iwp) :: j 200 INTEGER(iwp) :: k 201 INTEGER(iwp) :: n 202 INTEGER(iwp) :: nn 203 INTEGER(iwp) :: m 204 INTEGER(iwp) :: sort_index 205 INTEGER(iwp) :: is 206 INTEGER(iwp) :: kk 207 208 INTEGER(iwp),DIMENSION(0:7) :: sort_count 209 210 TYPE(particle_type), DIMENSION(number_of_particles,0:7) :: sort_particles 211 212 nn = 0 213 sort_count = 0 214 215 DO n = 1, number_of_particles 216 sort_index = 0 217 218 IF ( particles(n)%particle_mask ) THEN 219 nn = nn + 1 220 i = particles(n)%x * ddx 221 j = particles(n)%y * ddy 222 k = ( particles(n)%z + 0.5_wp * dz * atmos_ocean_sign ) / dz + & 223 offset_ocean_nzt 224 kk= particles(n)%z / dz + 1 + offset_ocean_nzt_m1 225 IF ( i == ip ) sort_index = sort_index+4 226 IF ( j == jp ) sort_index = sort_index+2 227 IF ( k == kp ) sort_index = sort_index+1 228 sort_count(sort_index) = sort_count(sort_index)+1 229 m = sort_count(sort_index) 230 sort_particles(m,sort_index) = particles(n) 231 sort_particles(m,sort_index)%block_nr = sort_index 232 ENDIF 233 234 ENDDO 235 236 nn = 0 237 238 DO is = 0,7 239 grid_particles(kp,jp,ip)%start_index(is) = nn + 1 240 DO n = 1,sort_count(is) 241 nn = nn+1 242 particles(nn) = sort_particles(n,is) 243 ENDDO 244 grid_particles(kp,jp,ip)%end_index(is) = nn 245 ENDDO 246 247 number_of_particles = nn 248 RETURN 249 250 END SUBROUTINE lpm_pack_and_sort 251 252 253 END module lpm_pack_arrays_mod
Note: See TracChangeset
for help on using the changeset viewer.
