Ignore:
Timestamp:
Jun 6, 2019 12:16:46 PM (2 years ago)
Author:
schwenkel
Message:

Modularization of all lagrangian particle model code components

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/pmc_particle_interface.f90

    r3948 r4017  
    9090       ONLY:  prt_count, particles, grid_particles,                            &
    9191              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
    9895
    9996#if defined( __parallel )
     
    956953                   prt_count(kp,jp,ip) = prt_count(kp,jp,ip) + 1
    957954                   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 )
    959956                   ENDIF
    960957                   coarse_particles(jc,ic)%parent_particles(n)%x = xc                   ! Adjust coordinates to child grid
     
    10821079!- Pack particles (eliminate those marked for deletion),
    10831080!- determine new number of particles
    1084    CALL lpm_sort_in_subboxes
     1081!    CALL lpm_sort_in_subboxes
    10851082
    10861083#endif
     
    11371134                prt_count(k,j,i) = prt_count(k,j,i) + 1
    11381135                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 )
    11401137                ENDIF
    11411138                grid_particles(k,j,i)%particles(prt_count(k,j,i)) = particle_in_win(pindex)
     
    11551152#endif
    11561153 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
    11581213
    11591214END MODULE pmc_particle_interface
Note: See TracChangeset for help on using the changeset viewer.