PartMC 2.1.4
aero_info_array.F90
Go to the documentation of this file.
00001 ! Copyright (C) 2007-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_info_array module.
00007 
00008 !> The aero_info_array_t structure and assoicated subroutines.
00009 module pmc_aero_info_array
00010 
00011   use pmc_aero_info
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 aero_info_t structure.
00020   !!
00021   !! This type implements a variable-length array of aero_info_t
00022   !! structures. To give a reasonable tradeoff between frequent
00023   !! re-allocs and memory usage, the length of an aero_info_array is
00024   !! generally a bit longer than the number of particles stored in
00025   !! it. When the array is full then a larger array is allocated with
00026   !! new extra space. As a balance between memory usage and frequency
00027   !! of re-allocs the length of the array is currently doubled when
00028   !! necessary and halved when possible.
00029   !!
00030   !! The true allocated length of the aero_info_array can be obtained
00031   !! by size(aero_info_array%%aero_info), while the number of used
00032   !! particle slots in it is given by aero_info_array%%n_item. It must
00033   !! be that aero_info_array%%n_item is less than or equal to
00034   !! size(aero_info_array%%aero_info).
00035   type aero_info_array_t
00036      !> Number of items in the array (not the same as the length of
00037      !> the allocated memory).
00038      integer :: n_item
00039      !> Array of aero_info_t structures.
00040      type(aero_info_t), pointer :: aero_info(:)
00041   end type aero_info_array_t
00042 
00043 contains
00044 
00045 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00046 
00047   !> Allocates the structure.
00048   subroutine aero_info_array_allocate(aero_info_array)
00049 
00050     !> Result.
00051     type(aero_info_array_t), intent(out) :: aero_info_array
00052 
00053     integer :: i
00054 
00055     aero_info_array%n_item = 0
00056     allocate(aero_info_array%aero_info(0))
00057 
00058   end subroutine aero_info_array_allocate
00059   
00060 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00061 
00062   !> Allocates with the given size.
00063   subroutine aero_info_array_allocate_size(aero_info_array, n_item)
00064 
00065     !> Result.
00066     type(aero_info_array_t), intent(out) :: aero_info_array
00067     !> Number of items.
00068     integer, intent(in) :: n_item
00069 
00070     integer :: i
00071 
00072     aero_info_array%n_item = n_item
00073     allocate(aero_info_array%aero_info(n_item))
00074     do i = 1,n_item
00075        call aero_info_allocate(aero_info_array%aero_info(i))
00076     end do
00077 
00078   end subroutine aero_info_array_allocate_size
00079   
00080 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00081 
00082   !> Deallocates.
00083   subroutine aero_info_array_deallocate(aero_info_array)
00084 
00085     !> Structure to deallocate.
00086     type(aero_info_array_t), intent(inout) :: aero_info_array
00087 
00088     integer :: i
00089     
00090     do i = 1,aero_info_array%n_item
00091        call aero_info_deallocate(aero_info_array%aero_info(i))
00092     end do
00093     deallocate(aero_info_array%aero_info)
00094 
00095   end subroutine aero_info_array_deallocate
00096   
00097 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00098 
00099   !> Copies aero_info_array_from to aero_info_array_to, both
00100   !> of which must already be allocated.
00101   subroutine aero_info_array_copy(aero_info_array_from, &
00102        aero_info_array_to)
00103 
00104     !> Origin structure.
00105     type(aero_info_array_t), intent(in) :: aero_info_array_from
00106     !> Destination structure.
00107     type(aero_info_array_t), intent(inout) :: aero_info_array_to
00108 
00109     integer :: i
00110     
00111     call aero_info_array_deallocate(aero_info_array_to)
00112     call aero_info_array_allocate_size(aero_info_array_to, &
00113          aero_info_array_from%n_item)
00114     do i = 1,aero_info_array_from%n_item
00115        call aero_info_copy(aero_info_array_from%aero_info(i), &
00116             aero_info_array_to%aero_info(i))
00117     end do
00118 
00119   end subroutine aero_info_array_copy
00120   
00121 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00122 
00123   !> Resets an aero_info_array to contain zero particles.
00124   subroutine aero_info_array_zero(aero_info_array)
00125 
00126     !> Structure to reset.
00127     type(aero_info_array_t), intent(inout) :: aero_info_array
00128 
00129     call aero_info_array_deallocate(aero_info_array)
00130     allocate(aero_info_array%aero_info(0))
00131     aero_info_array%n_item = 0
00132 
00133   end subroutine aero_info_array_zero
00134   
00135 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00136 
00137   !> Changes the given aero_info_array to exactly the given
00138   !> new_length.
00139   !!
00140   !! This function should not be called directly, but rather use
00141   !! aero_info_array_enlarge(), aero_info_array_enlarge_to()
00142   !! or aero_info_array_shrink().
00143   subroutine aero_info_array_realloc(aero_info_array, new_length)
00144 
00145     !> Array to reallocate (must already be allocated on entry).
00146     type(aero_info_array_t), intent(inout) :: aero_info_array
00147     !> New length of the array.
00148     integer, intent(in) :: new_length
00149 
00150     integer :: n_item, i
00151     type(aero_info_t), pointer :: new_particles(:)
00152 
00153     n_item = aero_info_array%n_item
00154     call assert(372938429, new_length >= n_item)
00155     allocate(new_particles(new_length))
00156     do i = 1,aero_info_array%n_item
00157        call aero_info_copy(aero_info_array%aero_info(i), &
00158             new_particles(i))
00159        call aero_info_deallocate(aero_info_array%aero_info(i))
00160     end do
00161     deallocate(aero_info_array%aero_info)
00162     aero_info_array%aero_info => new_particles
00163     
00164   end subroutine aero_info_array_realloc
00165 
00166 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00167 
00168   !> Enlarges the given aero_info_array by at least one element
00169   !!
00170   !! Currently this doubles the length.
00171   subroutine aero_info_array_enlarge(aero_info_array)
00172 
00173     !> Array to enlarge.
00174     type(aero_info_array_t), intent(inout) :: aero_info_array
00175 
00176     integer :: length, new_length
00177 
00178     length = size(aero_info_array%aero_info)
00179     new_length = max(length * 2, length + 1)
00180     call aero_info_array_realloc(aero_info_array, new_length)
00181     
00182   end subroutine aero_info_array_enlarge
00183 
00184 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00185 
00186   !> Enlarges the given array so that it is at least of size n.
00187   subroutine aero_info_array_enlarge_to(aero_info_array, n)
00188 
00189     !> Array to enlarge.
00190     type(aero_info_array_t), intent(inout) :: aero_info_array
00191     !> Minimum new size of array.
00192     integer, intent(in) :: n
00193 
00194     do while (size(aero_info_array%aero_info) < n)
00195        call aero_info_array_enlarge(aero_info_array)
00196     end do
00197 
00198   end subroutine aero_info_array_enlarge_to
00199 
00200 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00201 
00202   !> Possibly shrinks the storage of the given array, ensuring that
00203   !> it can still store the allocated particles.
00204   subroutine aero_info_array_shrink(aero_info_array)
00205 
00206     !> Array to shrink.
00207     type(aero_info_array_t), intent(inout) :: aero_info_array
00208 
00209     integer :: n_item, length, new_length
00210 
00211     n_item = aero_info_array%n_item
00212     length = size(aero_info_array%aero_info)
00213     new_length = length / 2
00214     do while ((n_item <= new_length) .and. (length > 0))
00215        call aero_info_array_realloc(aero_info_array, new_length)
00216        length = size(aero_info_array%aero_info)
00217        new_length = length / 2
00218     end do
00219 
00220   end subroutine aero_info_array_shrink
00221 
00222 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00223 
00224   !> Adds the given aero_info to the end of the array.
00225   subroutine aero_info_array_add_aero_info(aero_info_array, &
00226        aero_info)
00227 
00228     !> Array to add to.
00229     type(aero_info_array_t), intent(inout) :: aero_info_array
00230     !> Aero_info to add.
00231     type(aero_info_t), intent(in) :: aero_info
00232 
00233     integer :: n
00234 
00235     n = aero_info_array%n_item + 1
00236     call aero_info_array_enlarge_to(aero_info_array, n)
00237     call aero_info_allocate(aero_info_array%aero_info(n))
00238     call aero_info_copy(aero_info, aero_info_array%aero_info(n))
00239     aero_info_array%n_item = aero_info_array%n_item + 1
00240 
00241   end subroutine aero_info_array_add_aero_info
00242 
00243 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00244 
00245   !> Removes the aero_info at the given index.
00246   subroutine aero_info_array_remove_aero_info(aero_info_array, &
00247        index)
00248 
00249     !> Array to remove from.
00250     type(aero_info_array_t), intent(inout) :: aero_info_array
00251     !> Index of aero_info to remove.
00252     integer, intent(in) :: index
00253 
00254     call assert(213892348, index >= 1)
00255     call assert(953927392, index <= aero_info_array%n_item)
00256     call aero_info_deallocate(aero_info_array%aero_info(index))
00257     if (index < aero_info_array%n_item) then
00258        ! shift last aero_info into empty slot to preserve dense packing
00259        call aero_info_copy( &
00260             aero_info_array%aero_info(aero_info_array%n_item), &
00261             aero_info_array%aero_info(index))
00262        call aero_info_deallocate( &
00263             aero_info_array%aero_info(aero_info_array%n_item))
00264     end if
00265     aero_info_array%n_item = aero_info_array%n_item - 1
00266     call aero_info_array_shrink(aero_info_array)
00267 
00268   end subroutine aero_info_array_remove_aero_info
00269 
00270 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00271 
00272   !> Adds \c aero_info_array_delta to the end of \c aero_info_array.
00273   subroutine aero_info_array_add(aero_info_array, &
00274        aero_info_array_delta)
00275 
00276     !> Array to add to.
00277     type(aero_info_array_t), intent(inout) :: aero_info_array
00278     !> Aero_info to add.
00279     type(aero_info_array_t), intent(in) :: aero_info_array_delta
00280 
00281     integer :: i, n, n_delta, n_new
00282 
00283     n = aero_info_array%n_item
00284     n_delta = aero_info_array_delta%n_item
00285     n_new = n + n_delta
00286     call aero_info_array_enlarge_to(aero_info_array, n_new)
00287     do i = 1,n_delta
00288        call aero_info_allocate(aero_info_array%aero_info(n + i))
00289        call aero_info_copy(aero_info_array_delta%aero_info(i), &
00290             aero_info_array%aero_info(n + i))
00291     end do
00292     aero_info_array%n_item = n_new
00293 
00294   end subroutine aero_info_array_add
00295 
00296 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00297 
00298   !> Determines the number of bytes required to pack the given value.
00299   integer function pmc_mpi_pack_size_aia(val)
00300 
00301     !> Value to pack.
00302     type(aero_info_array_t), intent(in) :: val
00303 
00304     integer :: i, total_size
00305 
00306     total_size = 0
00307     total_size = total_size + pmc_mpi_pack_size_integer(val%n_item)
00308     do i = 1,val%n_item
00309        total_size = total_size &
00310             + pmc_mpi_pack_size_aero_info(val%aero_info(i))
00311     end do
00312     pmc_mpi_pack_size_aia = total_size
00313 
00314   end function pmc_mpi_pack_size_aia
00315 
00316 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00317 
00318   !> Packs the given value into the buffer, advancing position.
00319   subroutine pmc_mpi_pack_aero_info_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_info_array_t), intent(in) :: val
00327 
00328 #ifdef PMC_USE_MPI
00329     integer :: prev_position, i
00330 
00331     prev_position = position
00332     call pmc_mpi_pack_integer(buffer, position, val%n_item)
00333     do i = 1,val%n_item
00334        call pmc_mpi_pack_aero_info(buffer, position, val%aero_info(i))
00335     end do
00336     call assert(732927292, &
00337          position - prev_position <= pmc_mpi_pack_size_aia(val))
00338 #endif
00339 
00340   end subroutine pmc_mpi_pack_aero_info_array
00341 
00342 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00343 
00344   !> Unpacks the given value from the buffer, advancing position.
00345   subroutine pmc_mpi_unpack_aero_info_array(buffer, position, val)
00346 
00347     !> Memory buffer.
00348     character, intent(inout) :: buffer(:)
00349     !> Current buffer position.
00350     integer, intent(inout) :: position
00351     !> Value to pack.
00352     type(aero_info_array_t), intent(inout) :: val
00353 
00354 #ifdef PMC_USE_MPI
00355     integer :: prev_position, i
00356 
00357     call aero_info_array_deallocate(val)
00358     prev_position = position
00359     call pmc_mpi_unpack_integer(buffer, position, val%n_item)
00360     allocate(val%aero_info(val%n_item))
00361     do i = 1,val%n_item
00362        call aero_info_allocate(val%aero_info(i))
00363        call pmc_mpi_unpack_aero_info(buffer, position, val%aero_info(i))
00364     end do
00365     call assert(262838429, &
00366          position - prev_position <= pmc_mpi_pack_size_aia(val))
00367 #endif
00368 
00369   end subroutine pmc_mpi_unpack_aero_info_array
00370 
00371 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00372   
00373 end module pmc_aero_info_array