PartMC 2.1.3
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      !> Number of species.
00044      integer :: n_spec
00045      !> Number of sources.
00046      integer :: n_source
00047      !> Particle array.
00048      type(aero_particle_t), pointer :: particle(:)
00049   end type aero_particle_array_t
00050 
00051 contains
00052 
00053 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00054 
00055   !> Allocates and initializes.
00056   subroutine aero_particle_array_allocate(aero_particle_array)
00057 
00058     !> Result.
00059     type(aero_particle_array_t), intent(out) :: aero_particle_array
00060 
00061     aero_particle_array%n_part = 0
00062     aero_particle_array%n_spec = 0
00063     aero_particle_array%n_source = 0
00064     allocate(aero_particle_array%particle(0))
00065 
00066   end subroutine aero_particle_array_allocate
00067   
00068 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00069 
00070   !> Allocates and initializes to the given size.
00071   subroutine aero_particle_array_allocate_size(aero_particle_array, &
00072        n_part, n_spec, n_source)
00073 
00074     !> Result.
00075     type(aero_particle_array_t), intent(out) :: aero_particle_array
00076     !> Number of particles.
00077     integer, intent(in) :: n_part
00078     !> Number of species.
00079     integer, intent(in) :: n_spec
00080     !> Number of sources.
00081     integer, intent(in) :: n_source
00082 
00083     integer :: i
00084 
00085     aero_particle_array%n_part = n_part
00086     aero_particle_array%n_spec = n_spec
00087     aero_particle_array%n_source = n_source
00088     allocate(aero_particle_array%particle(n_part))
00089     do i = 1,n_part
00090        call aero_particle_allocate_size(aero_particle_array%particle(i), &
00091             n_spec, n_source)
00092     end do
00093 
00094   end subroutine aero_particle_array_allocate_size
00095   
00096 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00097 
00098   !> Deallocates.
00099   subroutine aero_particle_array_deallocate(aero_particle_array)
00100 
00101     !> Structure to deallocate.
00102     type(aero_particle_array_t), intent(inout) :: aero_particle_array
00103 
00104     integer :: i
00105     
00106     do i = 1,aero_particle_array%n_part
00107        call aero_particle_deallocate(aero_particle_array%particle(i))
00108     end do
00109     deallocate(aero_particle_array%particle)
00110 
00111   end subroutine aero_particle_array_deallocate
00112   
00113 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00114 
00115   !> Copies aero_particle_array_from to aero_particle_array_to, both
00116   !> of which must already be allocated.
00117   subroutine aero_particle_array_copy(aero_particle_array_from, &
00118        aero_particle_array_to)
00119 
00120     !> Origin structure.
00121     type(aero_particle_array_t), intent(in) :: aero_particle_array_from
00122     !> Destination structure.
00123     type(aero_particle_array_t), intent(inout) :: aero_particle_array_to
00124 
00125     integer :: i
00126     
00127     call aero_particle_array_deallocate(aero_particle_array_to)
00128     call aero_particle_array_allocate_size(aero_particle_array_to, &
00129          aero_particle_array_from%n_part, aero_particle_array_from%n_spec, &
00130          aero_particle_array_from%n_source)
00131     do i = 1,aero_particle_array_from%n_part
00132        call aero_particle_copy(aero_particle_array_from%particle(i), &
00133             aero_particle_array_to%particle(i))
00134     end do
00135 
00136   end subroutine aero_particle_array_copy
00137   
00138 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00139 
00140   !> Resets an aero_particle_array to contain zero particles.
00141   subroutine aero_particle_array_zero(aero_particle_array)
00142 
00143     !> Structure to reset.
00144     type(aero_particle_array_t), intent(inout) :: aero_particle_array
00145 
00146     call aero_particle_array_deallocate(aero_particle_array)
00147     allocate(aero_particle_array%particle(0))
00148     aero_particle_array%n_part = 0
00149 
00150   end subroutine aero_particle_array_zero
00151   
00152 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00153 
00154   !> Changes the given aero_particle_array to exactly the given
00155   !> new_length.
00156   !!
00157   !! This function should not be called directly, but rather use
00158   !! aero_particle_array_enlarge(), aero_particle_array_enlarge_to()
00159   !! or aero_particle_array_shrink().
00160   subroutine aero_particle_array_realloc(aero_particle_array, new_length)
00161 
00162     !> Array to reallocate (must already be allocated on entry).
00163     type(aero_particle_array_t), intent(inout) :: aero_particle_array
00164     !> New length of the array.
00165     integer, intent(in) :: new_length
00166 
00167     integer :: n_part, i
00168     type(aero_particle_t), pointer :: new_particles(:)
00169 
00170     n_part = aero_particle_array%n_part
00171     call assert(867444847, new_length >= n_part)
00172     allocate(new_particles(new_length))
00173     do i = 1,aero_particle_array%n_part
00174        call aero_particle_shift(aero_particle_array%particle(i), &
00175             new_particles(i))
00176     end do
00177     deallocate(aero_particle_array%particle)
00178     aero_particle_array%particle => new_particles
00179     
00180   end subroutine aero_particle_array_realloc
00181 
00182 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00183 
00184   !> Enlarges the given aero_particle_array by at least one element
00185   !!
00186   !! Currently this doubles the length.
00187   subroutine aero_particle_array_enlarge(aero_particle_array)
00188 
00189     !> Array to enlarge.
00190     type(aero_particle_array_t), intent(inout) :: aero_particle_array
00191 
00192     integer :: length, new_length
00193 
00194     length = size(aero_particle_array%particle)
00195     new_length = max(length * 2, length + 1)
00196     call aero_particle_array_realloc(aero_particle_array, new_length)
00197     
00198   end subroutine aero_particle_array_enlarge
00199 
00200 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00201 
00202   !> Enlarges the given array so that it is at least of size n.
00203   subroutine aero_particle_array_enlarge_to(aero_particle_array, n)
00204 
00205     !> Array to enlarge.
00206     type(aero_particle_array_t), intent(inout) :: aero_particle_array
00207     !> Minimum new size of array.
00208     integer, intent(in) :: n
00209 
00210     do while (size(aero_particle_array%particle) < n)
00211        call aero_particle_array_enlarge(aero_particle_array)
00212     end do
00213 
00214   end subroutine aero_particle_array_enlarge_to
00215 
00216 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00217 
00218   !> Possibly shrinks the storage of the given array, ensuring that
00219   !> it can still store the allocated particles.
00220   subroutine aero_particle_array_shrink(aero_particle_array)
00221 
00222     !> Array to shrink.
00223     type(aero_particle_array_t), intent(inout) :: aero_particle_array
00224 
00225     integer :: n_part, length, new_length
00226 
00227     n_part = aero_particle_array%n_part
00228     length = size(aero_particle_array%particle)
00229     new_length = length / 2
00230     do while ((n_part <= new_length) .and. (length > 0))
00231        call aero_particle_array_realloc(aero_particle_array, new_length)
00232        length = size(aero_particle_array%particle)
00233        new_length = length / 2
00234     end do
00235 
00236   end subroutine aero_particle_array_shrink
00237 
00238 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00239 
00240   !> Adds the given particle to the end of the array.
00241   subroutine aero_particle_array_add_particle(aero_particle_array, &
00242        aero_particle)
00243 
00244     !> Array to add to.
00245     type(aero_particle_array_t), intent(inout) :: aero_particle_array
00246     !> Particle to add.
00247     type(aero_particle_t), intent(in) :: aero_particle
00248 
00249     integer :: n
00250 
00251     n = aero_particle_array%n_part + 1
00252     call aero_particle_array_enlarge_to(aero_particle_array, n)
00253     call aero_particle_allocate(aero_particle_array%particle(n))
00254     call aero_particle_copy(aero_particle, &
00255          aero_particle_array%particle(n))
00256     aero_particle_array%n_part = aero_particle_array%n_part + 1
00257 
00258   end subroutine aero_particle_array_add_particle
00259 
00260 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00261 
00262   !> Removes the particle at the given index.
00263   subroutine aero_particle_array_remove_particle(aero_particle_array, &
00264        index)
00265 
00266     !> Array to remove from.
00267     type(aero_particle_array_t), intent(inout) :: aero_particle_array
00268     !> Index of particle to remove.
00269     integer, intent(in) :: index
00270 
00271     call assert(992946227, index >= 1)
00272     call assert(711246139, index <= aero_particle_array%n_part)
00273     call aero_particle_deallocate(aero_particle_array%particle(index))
00274     if (index < aero_particle_array%n_part) then
00275        ! shift last particle into empty slot to preserve dense packing
00276        call aero_particle_shift( &
00277             aero_particle_array%particle(aero_particle_array%n_part), &
00278             aero_particle_array%particle(index))
00279     end if
00280     aero_particle_array%n_part = aero_particle_array%n_part - 1
00281     call aero_particle_array_shrink(aero_particle_array)
00282 
00283   end subroutine aero_particle_array_remove_particle
00284 
00285 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00286 
00287   !> Doubles the number of particles by making a duplicate of each
00288   !> one.
00289   subroutine aero_particle_array_double(aero_particle_array)
00290 
00291     !> Array to double.
00292     type(aero_particle_array_t), intent(inout) :: aero_particle_array
00293 
00294     integer :: n, i
00295 
00296     n = aero_particle_array%n_part
00297     call aero_particle_array_enlarge_to(aero_particle_array, 2 * n)
00298     do i = 1,n
00299        call aero_particle_allocate_size(aero_particle_array%particle(i + n), &
00300             aero_particle_array%n_spec, aero_particle_array%n_source)
00301        call aero_particle_copy(aero_particle_array%particle(i), &
00302             aero_particle_array%particle(i + n))
00303        call aero_particle_new_id(aero_particle_array%particle(i + n))
00304     end do
00305     aero_particle_array%n_part = 2 * n
00306 
00307   end subroutine aero_particle_array_double
00308 
00309 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00310 
00311   !> Determines the number of bytes required to pack the given value.
00312   integer function pmc_mpi_pack_size_apa(val)
00313 
00314     !> Value to pack.
00315     type(aero_particle_array_t), intent(in) :: val
00316 
00317     integer :: i, total_size
00318 
00319     total_size = 0
00320     total_size = total_size + pmc_mpi_pack_size_integer(val%n_part)
00321     total_size = total_size + pmc_mpi_pack_size_integer(val%n_spec)
00322     total_size = total_size + pmc_mpi_pack_size_integer(val%n_source)
00323     do i = 1,val%n_part
00324        total_size = total_size &
00325             + pmc_mpi_pack_size_aero_particle(val%particle(i))
00326     end do
00327     pmc_mpi_pack_size_apa = total_size
00328 
00329   end function pmc_mpi_pack_size_apa
00330 
00331 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00332 
00333   !> Packs the given value into the buffer, advancing position.
00334   subroutine pmc_mpi_pack_aero_particle_array(buffer, position, val)
00335 
00336     !> Memory buffer.
00337     character, intent(inout) :: buffer(:)
00338     !> Current buffer position.
00339     integer, intent(inout) :: position
00340     !> Value to pack.
00341     type(aero_particle_array_t), intent(in) :: val
00342 
00343 #ifdef PMC_USE_MPI
00344     integer :: prev_position, i
00345 
00346     prev_position = position
00347     call pmc_mpi_pack_integer(buffer, position, val%n_part)
00348     call pmc_mpi_pack_integer(buffer, position, val%n_spec)
00349     call pmc_mpi_pack_integer(buffer, position, val%n_source)
00350     do i = 1,val%n_part
00351        call pmc_mpi_pack_aero_particle(buffer, position, val%particle(i))
00352     end do
00353     call assert(803856329, &
00354          position - prev_position <= pmc_mpi_pack_size_apa(val))
00355 #endif
00356 
00357   end subroutine pmc_mpi_pack_aero_particle_array
00358 
00359 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00360 
00361   !> Unpacks the given value from the buffer, advancing position.
00362   subroutine pmc_mpi_unpack_aero_particle_array(buffer, position, val)
00363 
00364     !> Memory buffer.
00365     character, intent(inout) :: buffer(:)
00366     !> Current buffer position.
00367     integer, intent(inout) :: position
00368     !> Value to pack.
00369     type(aero_particle_array_t), intent(inout) :: val
00370 
00371 #ifdef PMC_USE_MPI
00372     integer :: prev_position, i
00373 
00374     call aero_particle_array_deallocate(val)
00375     prev_position = position
00376     call pmc_mpi_unpack_integer(buffer, position, val%n_part)
00377     call pmc_mpi_unpack_integer(buffer, position, val%n_spec)
00378     call pmc_mpi_unpack_integer(buffer, position, val%n_source)
00379     allocate(val%particle(val%n_part))
00380     do i = 1,val%n_part
00381        call aero_particle_allocate(val%particle(i))
00382        call pmc_mpi_unpack_aero_particle(buffer, position, val%particle(i))
00383     end do
00384     call assert(138783294, &
00385          position - prev_position <= pmc_mpi_pack_size_apa(val))
00386 #endif
00387 
00388   end subroutine pmc_mpi_unpack_aero_particle_array
00389 
00390 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00391   
00392 end module pmc_aero_particle_array