Changeset 4017 for palm/trunk/SOURCE/pmc_particle_interface.f90
- Timestamp:
- Jun 6, 2019 12:16:46 PM (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_particle_interface.f90
r3948 r4017 90 90 ONLY: prt_count, particles, grid_particles, & 91 91 particle_type, number_of_particles, zero_particle, & 92 ibc_par_t, ibc_par_lr, ibc_par_ns, alloc_factor 93 94 USE lpm_pack_and_sort_mod 95 96 USE lpm_exchange_horiz_mod, & 97 ONLY: realloc_particles_array 92 ibc_par_t, ibc_par_lr, ibc_par_ns, alloc_factor, min_nr_particle 93 94 ! USE lpm_pack_and_sort_mod 98 95 99 96 #if defined( __parallel ) … … 956 953 prt_count(kp,jp,ip) = prt_count(kp,jp,ip) + 1 957 954 IF ( prt_count(kp,jp,ip) > SIZE( grid_particles(kp,jp,ip)%particles ) ) THEN 958 CALL realloc_particles_array( ip, jp, kp )955 CALL pmc_realloc_particles_array( ip, jp, kp ) 959 956 ENDIF 960 957 coarse_particles(jc,ic)%parent_particles(n)%x = xc ! Adjust coordinates to child grid … … 1082 1079 !- Pack particles (eliminate those marked for deletion), 1083 1080 !- determine new number of particles 1084 CALL lpm_sort_in_subboxes1081 ! CALL lpm_sort_in_subboxes 1085 1082 1086 1083 #endif … … 1137 1134 prt_count(k,j,i) = prt_count(k,j,i) + 1 1138 1135 IF ( prt_count(k,j,i) > SIZE( grid_particles(k,j,i)%particles ) ) THEN 1139 CALL realloc_particles_array( i, j, k )1136 CALL pmc_realloc_particles_array( i, j, k ) 1140 1137 ENDIF 1141 1138 grid_particles(k,j,i)%particles(prt_count(k,j,i)) = particle_in_win(pindex) … … 1155 1152 #endif 1156 1153 END SUBROUTINE p_copy_particle_to_org_grid 1157 1154 1155 !------------------------------------------------------------------------------! 1156 ! Description: 1157 ! ------------ 1158 !> If the allocated memory for the particle array do not suffice to add arriving 1159 !> particles from neighbour grid cells, this subrouting reallocates the 1160 !> particle array to assure enough memory is available. 1161 !------------------------------------------------------------------------------! 1162 SUBROUTINE pmc_realloc_particles_array ( i, j, k, size_in ) 1163 1164 INTEGER(iwp), INTENT(IN) :: i !< 1165 INTEGER(iwp), INTENT(IN) :: j !< 1166 INTEGER(iwp), INTENT(IN) :: k !< 1167 INTEGER(iwp), INTENT(IN), OPTIONAL :: size_in !< 1168 1169 INTEGER(iwp) :: old_size !< 1170 INTEGER(iwp) :: new_size !< 1171 TYPE(particle_type), DIMENSION(:), ALLOCATABLE :: tmp_particles_d !< 1172 TYPE(particle_type), DIMENSION(500) :: tmp_particles_s !< 1173 1174 old_size = SIZE(grid_particles(k,j,i)%particles) 1175 1176 IF ( PRESENT(size_in) ) THEN 1177 new_size = size_in 1178 ELSE 1179 new_size = old_size * ( 1.0_wp + alloc_factor / 100.0_wp ) 1180 ENDIF 1181 1182 new_size = MAX( new_size, min_nr_particle, old_size + 1 ) 1183 1184 IF ( old_size <= 500 ) THEN 1185 1186 tmp_particles_s(1:old_size) = grid_particles(k,j,i)%particles(1:old_size) 1187 1188 DEALLOCATE(grid_particles(k,j,i)%particles) 1189 ALLOCATE(grid_particles(k,j,i)%particles(new_size)) 1190 1191 grid_particles(k,j,i)%particles(1:old_size) = tmp_particles_s(1:old_size) 1192 grid_particles(k,j,i)%particles(old_size+1:new_size) = zero_particle 1193 1194 ELSE 1195 1196 ALLOCATE(tmp_particles_d(new_size)) 1197 tmp_particles_d(1:old_size) = grid_particles(k,j,i)%particles 1198 1199 DEALLOCATE(grid_particles(k,j,i)%particles) 1200 ALLOCATE(grid_particles(k,j,i)%particles(new_size)) 1201 1202 grid_particles(k,j,i)%particles(1:old_size) = tmp_particles_d(1:old_size) 1203 grid_particles(k,j,i)%particles(old_size+1:new_size) = zero_particle 1204 1205 DEALLOCATE(tmp_particles_d) 1206 1207 ENDIF 1208 particles => grid_particles(k,j,i)%particles(1:new_size) 1209 1210 RETURN 1211 1212 END SUBROUTINE pmc_realloc_particles_array 1158 1213 1159 1214 END MODULE pmc_particle_interface
Note: See TracChangeset
for help on using the changeset viewer.