PartMC  2.2.1
aero_particle_array.F90
Go to the documentation of this file.
00001 ! Copyright (C) 2005-2011 Nicole Riemer and Matthew West
00002 ! Licensed under the GNU General Public License version 2 or (at your
00003 ! option) any later version. See the file COPYING for details.
00004 
00005 !> \file
00006 !> The pmc_aero_particle_array module.
00007 
00008 !> The aero_particle_array_t structure and assoicated subroutines.
00009 module pmc_aero_particle_array
00010 
00011   use pmc_aero_particle
00012   use pmc_util
00013   use pmc_spec_file
00014   use pmc_mpi
00015 #ifdef PMC_USE_MPI
00016   use mpi
00017 #endif
00018 
00019   !> 1-D arrays of particles, used by aero_state to build a ragged
00020   !> array.
00021   !!
00022   !! One aero_particle_array is generally a list of particles in a
00023   !! single size bin, but the basic type can be used for any list of
00024   !! particles.
00025   !!
00026   !! To give a reasonable tradeoff between frequent re-allocs and
00027   !! memory usage, the length of an aero_particle_array is generally a
00028   !! bit longer than the number of particles stored in it. When the
00029   !! array is full then a larger array is allocated with new extra
00030   !! space. As a balance between memory usage and frequency of
00031   !! re-allocs the length of the array is currently doubled when
00032   !! necessary and halved when possible.
00033   !!
00034   !! The true allocated length of the aero_particle_array can be
00035   !! obtained by size(aero_particle_array%%particle), while the number
00036   !! of used particle slots in it is given by
00037   !! aero_particle_array%%n_part. It must be that
00038   !! aero_particle_array%%n_part is less than or equal to
00039   !! size(aero_particle_array%%particle).
00040   type aero_particle_array_t
00041      !> Number of particles.
00042      integer :: n_part
00043      !> Particle array.
00044      type(aero_particle_t), pointer :: particle(:)
00045   end type aero_particle_array_t
00046 
00047 contains
00048 
00049 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00050 
00051   !> Allocates and initializes.
00052   subroutine aero_particle_array_allocate(aero_particle_array)
00053 
00054     !> Result.
00055     type(aero_particle_array_t), intent(out) :: aero_particle_array
00056 
00057     aero_particle_array%n_part = 0
00058     allocate(aero_particle_array%particle(0))
00059 
00060   end subroutine aero_particle_array_allocate
00061   
00062 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00063 
00064   !> Allocates and initializes to the given size.
00065   subroutine aero_particle_array_allocate_size(aero_particle_array, n_part)
00066 
00067     !> Result.
00068     type(aero_particle_array_t), intent(out) :: aero_particle_array
00069     !> Number of particles.
00070     integer, intent(in) :: n_part
00071 
00072     integer :: i
00073 
00074     aero_particle_array%n_part = n_part
00075     allocate(aero_particle_array%particle(n_part))
00076     do i = 1,n_part
00077        call aero_particle_allocate(aero_particle_array%particle(i))
00078     end do
00079 
00080   end subroutine aero_particle_array_allocate_size
00081   
00082 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00083 
00084   !> Deallocates.
00085   subroutine aero_particle_array_deallocate(aero_particle_array)
00086 
00087     !> Structure to deallocate.
00088     type(aero_particle_array_t), intent(inout) :: aero_particle_array
00089 
00090     integer :: i
00091     
00092     do i = 1,aero_particle_array%n_part
00093        call aero_particle_deallocate(aero_particle_array%particle(i))
00094     end do
00095     deallocate(aero_particle_array%particle)
00096 
00097   end subroutine aero_particle_array_deallocate
00098   
00099 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00100 
00101   !> Copies aero_particle_array_from to aero_particle_array_to, both
00102   !> of which must already be allocated.
00103   subroutine aero_particle_array_copy(aero_particle_array_from, &
00104        aero_particle_array_to)
00105 
00106     !> Origin structure.
00107     type(aero_particle_array_t), intent(in) :: aero_particle_array_from
00108     !> Destination structure.
00109     type(aero_particle_array_t), intent(inout) :: aero_particle_array_to
00110 
00111     integer :: i
00112     
00113     call aero_particle_array_deallocate(aero_particle_array_to)
00114     call aero_particle_array_allocate_size(aero_particle_array_to, &
00115          aero_particle_array_from%n_part)
00116     do i = 1,aero_particle_array_from%n_part
00117        call aero_particle_copy(aero_particle_array_from%particle(i), &
00118             aero_particle_array_to%particle(i))
00119     end do
00120 
00121   end subroutine aero_particle_array_copy
00122   
00123 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00124 
00125   !> Resets an aero_particle_array to contain zero particles.
00126   subroutine aero_particle_array_zero(aero_particle_array)
00127 
00128     !> Structure to reset.
00129     type(aero_particle_array_t), intent(inout) :: aero_particle_array
00130 
00131     call aero_particle_array_deallocate(aero_particle_array)
00132     allocate(aero_particle_array%particle(0))
00133     aero_particle_array%n_part = 0
00134 
00135   end subroutine aero_particle_array_zero
00136   
00137 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00138 
00139   !> Changes the given aero_particle_array to exactly the given
00140   !> new_length.
00141   !!
00142   !! This function should not be called directly, but rather use
00143   !! aero_particle_array_enlarge(), aero_particle_array_enlarge_to()
00144   !! or aero_particle_array_shrink().
00145   subroutine aero_particle_array_realloc(aero_particle_array, new_length)
00146 
00147     !> Array to reallocate (must already be allocated on entry).
00148     type(aero_particle_array_t), intent(inout) :: aero_particle_array
00149     !> New length of the array.
00150     integer, intent(in) :: new_length
00151 
00152     integer :: n_part, i
00153     type(aero_particle_t), pointer :: new_particles(:)
00154 
00155     n_part = aero_particle_array%n_part
00156     call assert(867444847, new_length >= n_part)
00157     allocate(new_particles(new_length))
00158     do i = 1,aero_particle_array%n_part
00159        call aero_particle_shift(aero_particle_array%particle(i), &
00160             new_particles(i))
00161     end do
00162     deallocate(aero_particle_array%particle)
00163     aero_particle_array%particle => new_particles
00164     
00165   end subroutine aero_particle_array_realloc
00166 
00167 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00168 
00169   !> Enlarges the given aero_particle_array by at least one element
00170   !!
00171   !! Currently this doubles the length.
00172   subroutine aero_particle_array_enlarge(aero_particle_array)
00173 
00174     !> Array to enlarge.
00175     type(aero_particle_array_t), intent(inout) :: aero_particle_array
00176 
00177     integer :: length, new_length
00178 
00179     length = size(aero_particle_array%particle)
00180     new_length = max(length * 2, length + 1)
00181     call aero_particle_array_realloc(aero_particle_array, new_length)
00182     
00183   end subroutine aero_particle_array_enlarge
00184 
00185 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00186 
00187   !> Enlarges the given array so that it is at least of size n.
00188   subroutine aero_particle_array_enlarge_to(aero_particle_array, n)
00189 
00190     !> Array to enlarge.
00191     type(aero_particle_array_t), intent(inout) :: aero_particle_array
00192     !> Minimum new size of array.
00193     integer, intent(in) :: n
00194 
00195     do while (size(aero_particle_array%particle) < n)
00196        call aero_particle_array_enlarge(aero_particle_array)
00197     end do
00198 
00199   end subroutine aero_particle_array_enlarge_to
00200 
00201 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00202 
00203   !> Possibly shrinks the storage of the given array, ensuring that
00204   !> it can still store the allocated particles.
00205   subroutine aero_particle_array_shrink(aero_particle_array)
00206 
00207     !> Array to shrink.
00208     type(aero_particle_array_t), intent(inout) :: aero_particle_array
00209 
00210     integer :: n_part, length, new_length
00211 
00212     n_part = aero_particle_array%n_part
00213     length = size(aero_particle_array%particle)
00214     new_length = length / 2
00215     do while ((n_part <= new_length) .and. (length > 0))
00216        call aero_particle_array_realloc(aero_particle_array, new_length)
00217        length = size(aero_particle_array%particle)
00218        new_length = length / 2
00219     end do
00220 
00221   end subroutine aero_particle_array_shrink
00222 
00223 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00224 
00225   !> Adds the given particle to the end of the array.
00226   subroutine aero_particle_array_add_particle(aero_particle_array, &
00227        aero_particle)
00228 
00229     !> Array to add to.
00230     type(aero_particle_array_t), intent(inout) :: aero_particle_array
00231     !> Particle to add.
00232     type(aero_particle_t), intent(in) :: aero_particle
00233 
00234     integer :: n
00235 
00236     n = aero_particle_array%n_part + 1
00237     call aero_particle_array_enlarge_to(aero_particle_array, n)
00238     call aero_particle_allocate(aero_particle_array%particle(n))
00239     call aero_particle_copy(aero_particle, &
00240          aero_particle_array%particle(n))
00241     aero_particle_array%n_part = aero_particle_array%n_part + 1
00242 
00243   end subroutine aero_particle_array_add_particle
00244 
00245 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00246 
00247   !> Removes the particle at the given index.
00248   subroutine aero_particle_array_remove_particle(aero_particle_array, &
00249        index)
00250 
00251     !> Array to remove from.
00252     type(aero_particle_array_t), intent(inout) :: aero_particle_array
00253     !> Index of particle to remove.
00254     integer, intent(in) :: index
00255 
00256     call assert(992946227, index >= 1)
00257     call assert(711246139, index <= aero_particle_array%n_part)
00258     call aero_particle_deallocate(aero_particle_array%particle(index))
00259     if (index < aero_particle_array%n_part) then
00260        ! shift last particle into empty slot to preserve dense packing
00261        call aero_particle_shift( &
00262             aero_particle_array%particle(aero_particle_array%n_part), &
00263             aero_particle_array%particle(index))
00264     end if
00265     aero_particle_array%n_part = aero_particle_array%n_part - 1
00266     call aero_particle_array_shrink(aero_particle_array)
00267 
00268   end subroutine aero_particle_array_remove_particle
00269 
00270 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00271 
00272   !> Determines the number of bytes required to pack the given value.
00273   integer function pmc_mpi_pack_size_apa(val)
00274 
00275     !> Value to pack.
00276     type(aero_particle_array_t), intent(in) :: val
00277 
00278     integer :: i, total_size
00279 
00280     total_size = 0
00281     total_size = total_size + pmc_mpi_pack_size_integer(val%n_part)
00282     do i = 1,val%n_part
00283        total_size = total_size &
00284             + pmc_mpi_pack_size_aero_particle(val%particle(i))
00285     end do
00286     pmc_mpi_pack_size_apa = total_size
00287 
00288   end function pmc_mpi_pack_size_apa
00289 
00290 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00291 
00292   !> Packs the given value into the buffer, advancing position.
00293   subroutine pmc_mpi_pack_aero_particle_array(buffer, position, val)
00294 
00295     !> Memory buffer.
00296     character, intent(inout) :: buffer(:)
00297     !> Current buffer position.
00298     integer, intent(inout) :: position
00299     !> Value to pack.
00300     type(aero_particle_array_t), intent(in) :: val
00301 
00302 #ifdef PMC_USE_MPI
00303     integer :: prev_position, i
00304 
00305     prev_position = position
00306     call pmc_mpi_pack_integer(buffer, position, val%n_part)
00307     do i = 1,val%n_part
00308        call pmc_mpi_pack_aero_particle(buffer, position, val%particle(i))
00309     end do
00310     call assert(803856329, &
00311          position - prev_position <= pmc_mpi_pack_size_apa(val))
00312 #endif
00313 
00314   end subroutine pmc_mpi_pack_aero_particle_array
00315 
00316 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00317 
00318   !> Unpacks the given value from the buffer, advancing position.
00319   subroutine pmc_mpi_unpack_aero_particle_array(buffer, position, val)
00320 
00321     !> Memory buffer.
00322     character, intent(inout) :: buffer(:)
00323     !> Current buffer position.
00324     integer, intent(inout) :: position
00325     !> Value to pack.
00326     type(aero_particle_array_t), intent(inout) :: val
00327 
00328 #ifdef PMC_USE_MPI
00329     integer :: prev_position, i
00330 
00331     call aero_particle_array_deallocate(val)
00332     prev_position = position
00333     call pmc_mpi_unpack_integer(buffer, position, val%n_part)
00334     allocate(val%particle(val%n_part))
00335     do i = 1,val%n_part
00336        call aero_particle_allocate(val%particle(i))
00337        call pmc_mpi_unpack_aero_particle(buffer, position, val%particle(i))
00338     end do
00339     call assert(138783294, &
00340          position - prev_position <= pmc_mpi_pack_size_apa(val))
00341 #endif
00342 
00343   end subroutine pmc_mpi_unpack_aero_particle_array
00344 
00345 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00346   
00347 end module pmc_aero_particle_array