Making external mixtures

CMakeLists.txt

@@ -265,6 +265,13 @@ add_executable(bin_average_comp src/bin_average_comp.F90)
 
 target_link_libraries(bin_average_comp partmclib)
 
+######################################################################
+# bin_deaverage_comp
+
+add_executable(bin_deaverage_comp src/bin_deaverage_comp.F90)
+
+target_link_libraries(bin_deaverage_comp partmclib)
+
 ######################################################################
 # bin_average_size
 

src/aero_state.F90

@@ -1939,6 +1939,232 @@ subroutine aero_state_bin_average_comp(aero_state, bin_grid, aero_data)
 
   end subroutine aero_state_bin_average_comp
 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  !> Set each aerosol particle to have its original total volume, but
+  !> species volume ratios given by the group species volume ratio
+  !> within each bin. If no groups are specified, each particle contain a
+  !> single species (fully externally mixed). If groups are specified,
+  !> particles contain the volume fractions of the speices within the group.
+  !> This preserves per-particle total volumes.
+  subroutine aero_state_bin_deaverage_comp(aero_state, bin_grid, aero_data, &
+       groups)
+
+    !> Aerosol state to de-average.
+    type(aero_state_t), intent(inout) :: aero_state
+    !> Bin grid to de-average within.
+    type(bin_grid_t), intent(in) :: bin_grid
+    !> Aerosol data.
+    type(aero_data_t), intent(in) :: aero_data
+    !> Sets of species names to group together.
+    character(len=*), optional :: groups(:,:)
+
+    real(kind=dp) :: species_volume_conc(aero_data_n_spec(aero_data))
+    real(kind=dp) :: total_volume_conc, particle_volume, num_conc
+    integer :: i_bin, i_class, i_entry, i_part, i_spec
+    real(kind=dp) :: factors(aero_data_n_spec(aero_data))
+    integer :: n_part_spec, start_val, i, n_part
+    integer :: species_group_numbers(aero_data_n_spec(aero_data))
+    integer :: n_group, i_group, i_name
+    real(kind=dp), allocatable :: group_fractions(:), &
+        group_volume_conc(:)
+    ! Flag to control algorithm selection - false uses low-variance method.
+    logical, parameter :: do_naive_algorithm = .false.
+    real(kind=dp), allocatable :: cumulative_vals(:)
+    real(kind=dp), allocatable :: factors_2d(:,:)
+    integer, allocatable :: particle_group(:)
+    real(kind=dp) :: x
+    integer, allocatable :: particle_index(:)
+    real(kind=dp) :: v_aerosol, v_bulk, p, v_group, v_particle, v_group_prev
+
+    call aero_state_sort(aero_state, aero_data, bin_grid)
+
+    if (present(groups)) then
+       n_group = size(groups, 1)
+       ! species_group_numbers(i_spec) will give the group number for
+       ! each species
+       species_group_numbers = 0
+       do i_group = 1,n_group
+          do i_name = 1,size(groups, 2)
+             if (len_trim(groups(i_group, i_name)) > 0) then
+                i_spec = aero_data_spec_by_name(aero_data, &
+                     groups(i_group, i_name))
+                call assert_msg(926066862, i_spec > 0, &
+                     "unknown species: " // trim(groups(i_group, i_name)))
+                species_group_numbers(i_spec) = i_group
+             end if
+          end do
+       end do
+       ! Assign left overs to their own groups
+       do i_spec = 1,aero_data_n_spec(aero_data)
+          if (species_group_numbers(i_spec) == 0) then
+             n_group = n_group + 1
+             species_group_numbers(i_spec) = n_group
+          end if
+       end do
+    else
+       ! Assign each species to a group
+       do i_spec = 1,aero_data_n_spec(aero_data)
+          species_group_numbers(i_spec) = i_spec
+       end do
+       n_group = aero_data_n_spec(aero_data)
+    end if
+
+    do i_bin = 1,bin_grid_size(bin_grid)
+       species_volume_conc = 0d0
+       total_volume_conc = 0d0
+       do i_class = 1,size(aero_state%awa%weight, 2)
+          do i_entry = 1,integer_varray_n_entry( &
+               aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
+             i_part = aero_state%aero_sorted%size_class%inverse(i_bin, &
+                  i_class)%entry(i_entry)
+             num_conc = aero_weight_array_num_conc(aero_state%awa, &
+                  aero_state%apa%particle(i_part), aero_data)
+             particle_volume = aero_particle_volume( &
+                  aero_state%apa%particle(i_part))
+             species_volume_conc = species_volume_conc &
+                  + num_conc * aero_state%apa%particle(i_part)%vol
+             total_volume_conc = total_volume_conc + num_conc * particle_volume
+          end do
+       end do
+
+       allocate(group_volume_conc(n_group))
+       group_volume_conc = 0.0d0
+       do i_spec = 1,aero_data_n_spec(aero_data)
+          group_volume_conc(species_group_numbers(i_spec)) &
+             =  group_volume_conc(species_group_numbers(i_spec)) &
+             + species_volume_conc(i_spec)
+       end do
+
+       allocate(factors_2d(n_group,aero_data_n_spec(aero_data)))
+       factors_2d = 0.0d0
+       do i_group = 1,n_group
+          do i_spec = 1,aero_data_n_spec(aero_data)
+             if (species_group_numbers(i_spec) == i_group) then
+                factors_2d(i_group,i_spec) = &
+                     species_volume_conc(i_spec) &
+                     / group_volume_conc(i_group)
+             end if
+          end do
+       end do
+
+       if (do_naive_algorithm) then
+          do i_class = 1,size(aero_state%awa%weight, 2)
+             n_part = integer_varray_n_entry( &
+                  aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
+             if (n_part > 0) then
+                allocate(group_fractions(n_group))
+                group_fractions = 0.0d0
+                do i_group = 1,n_group
+                   group_fractions(i_group) = n_part &
+                        * group_volume_conc(i_group) / total_volume_conc
+                end do
+                allocate(cumulative_vals(n_group+1))
+                cumulative_vals = 0.0d0
+                do i_group = 2,n_group + 1
+                   cumulative_vals(i_group) = cumulative_vals(i_group-1) &
+                        + group_fractions(i_group-1)
+                end do
+                allocate(particle_group(n_part))
+                do i_part = 1,n_part
+                   x = pmc_random() * n_part
+                   particle_group(i_part) = find_1d(n_group+1, &
+                       cumulative_vals, x)
+                end do
+
+                do i_entry = 1,n_part
+                   i_part = aero_state%aero_sorted%size_class%inverse( &
+                        i_bin, i_class)%entry(i_entry)
+                   particle_volume = aero_particle_volume( &
+                        aero_state%apa%particle(i_part))
+                   aero_state%apa%particle(i_part)%vol = 0.0d0
+                   i_group = particle_group(i_entry)
+                   do i_spec = 1,aero_data_n_spec(aero_data)
+                      aero_state%apa%particle(i_part)%vol(i_spec) &
+                           = particle_volume * factors_2d(i_group,i_spec)
+                   end do
+                end do
+                deallocate(particle_group)
+                deallocate(cumulative_vals)
+                deallocate(group_fractions)
+             end if
+          end do
+       else
+          n_part = 0
+          do i_class = 1,size(aero_state%awa%weight, 2)
+             n_part = n_part + integer_varray_n_entry( &
+                  aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
+          end do
+
+          if (n_part > 0) then
+             allocate(particle_index(n_part))
+             i_part = 1
+             do i_class = 1,size(aero_state%awa%weight, 2)
+                do i_entry = 1, integer_varray_n_entry( &
+                     aero_state%aero_sorted%size_class%inverse(i_bin, i_class))
+                   particle_index(i_part) = &
+                        aero_state%aero_sorted%size_class%inverse( &
+                           i_bin, i_class)%entry(i_entry)
+                   i_part = i_part + 1
+                end do
+             end do
+
+             call pmc_rand_shuffle_array(particle_index, n_part)
+
+             i_entry = 1
+             v_aerosol = 0.0d0
+             v_bulk = 0.0d0
+             v_particle = 0.0d0
+             v_group = 0.0d0
+             v_group_prev = 0.0d0
+             i_group = 0
+             do while (i_entry <= n_part)
+                if (v_aerosol + v_particle >= v_bulk) then
+                   i_group = i_group + 1
+                   v_group = group_volume_conc(i_group)
+                   v_group_prev = v_bulk
+                   v_bulk = v_bulk + v_group
+                end if
+                i_part = particle_index(i_entry)
+                particle_volume = aero_particle_volume( &
+                     aero_state%apa%particle(i_part))
+                num_conc = aero_weight_array_num_conc(aero_state%awa, &
+                     aero_state%apa%particle(i_part), aero_data)
+                v_particle = particle_volume * num_conc
+                if (min(v_particle + v_aerosol, sum(group_volume_conc)) &
+                     <= v_bulk) then
+                   aero_state%apa%particle(i_part)%vol = 0.0d0
+                   do i_spec = 1,aero_data_n_spec(aero_data)
+                      aero_state%apa%particle(i_part)%vol(i_spec) = &
+                           particle_volume  * factors_2d(i_group,i_spec)
+                   end do
+                   v_aerosol = v_aerosol + v_particle
+                   i_entry = i_entry + 1
+                   v_particle = 0.0d0
+                else
+                   p = (v_bulk - max(v_aerosol, v_group_prev)) &
+                        / (v_particle)
+                   if (pmc_random() < p) then
+                      aero_state%apa%particle(i_part)%vol = 0.0d0
+                      do i_spec = 1,aero_data_n_spec(aero_data)
+                         aero_state%apa%particle(i_part)%vol(i_spec) = &
+                              particle_volume  * factors_2d(i_group,i_spec)
+                      end do
+                      v_aerosol = v_aerosol + v_particle
+                      i_entry = i_entry + 1
+                      v_particle = 0.0d0
+                   end if
+                end if
+             end do
+             deallocate(particle_index)
+          end if
+       end if
+       deallocate(group_volume_conc)
+       deallocate(factors_2d)
+    end do
+
+  end subroutine aero_state_bin_deaverage_comp
+
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
   !> Set each aerosol particle to have its original species ratios,

src/bin_average_comp.F90

@@ -66,6 +66,8 @@ program bin_average_comp
 
   call pmc_mpi_init()
 
+  call pmc_srand(0, pmc_mpi_rank())
+
   call bin_grid_make(bin_grid, BIN_GRID_TYPE_LOG, n_bin, diam2rad(d_min), &
        diam2rad(d_max))
 

src/bin_deaverage_comp.F90

@@ -0,0 +1,99 @@
+! Copyright (C) 2009-2013 Matthew West
+! Licensed under the GNU General Public License version 2 or (at your
+! option) any later version. See the file COPYING for details.
+
+!> \file
+!> The bin_average_comp program.
+
+!> Read a NetCDF file, average the composition of all particles within
+!> each bin, and write the data out as another NetCDF file.
+program bin_deaverage_comp
+
+  use pmc_aero_state
+  use pmc_gas_data
+  use pmc_gas_state
+  use pmc_env_state
+  use pmc_aero_data
+  use pmc_bin_grid
+  use pmc_output
+  use pmc_rand
+  use netcdf
+
+  character(len=1000) :: in_filename, out_prefix
+  type(bin_grid_t) :: bin_grid
+  type(aero_data_t) :: aero_data
+  type(aero_state_t) :: aero_state
+  type(gas_data_t) :: gas_data
+  type(gas_state_t) :: gas_state
+  type(env_state_t) :: env_state
+  integer :: n_bin, index, i_repeat, output_type
+  real(kind=dp) :: d_min, d_max, time, del_t
+  character(len=1000) :: tmp_str
+  logical :: record_removals, dry_volume, record_optical
+  character(len=PMC_UUID_LEN) :: uuid
+  character(len=AERO_NAME_LEN), allocatable :: external_groups(:,:)
+
+  allocate(external_groups(3, 4)) ! 3 groups, max 4 species per group
+  external_groups(1,:) = ["OC    ", "BC    ", "      ", "      "]
+  external_groups(2,:) = ["API1  ", "API2  ", "LIM1  ", "LIM2  "]
+  external_groups(3,:) = ["SO4   ", "NO3   ", "NH4   ", "      "]
+
+  ! process commandline arguments
+  if (command_argument_count() .ne. 6) then
+     write(6,*) 'Usage: bin_average_comp <d_min> <d_max> <n_bin> ' &
+          // '<"wet" or "dry"> <input_filename> <output_prefix>'
+     write(6,*) ''
+     write(6,*) '  d_min: minimum bin diameter (m)'
+     write(6,*) '  d_max: maximum bin diameter (m)'
+     write(6,*) '  n_bin: number of bins'
+     write(6,*) '  wet/dry: average wet or dry sizes'
+     write(6,*) '  input_filename: like scenario_0001_00000001.nc'
+     write(6,*) '  output_prefix: like scenario_comp_average'
+     stop 2
+  endif
+  call get_command_argument(1, tmp_str)
+  d_min = string_to_real(tmp_str)
+  call get_command_argument(2, tmp_str)
+  d_max = string_to_real(tmp_str)
+  call get_command_argument(3, tmp_str)
+  n_bin = string_to_integer(tmp_str)
+  call get_command_argument(4, tmp_str)
+  if (trim(tmp_str) == "wet") then
+     dry_volume = .false.
+  elseif (trim(tmp_str) == "dry") then
+     dry_volume = .true.
+  else
+     write(6,*) 'Argument 4 must be "wet" or "dry", not ' &
+          // trim(tmp_str)
+     stop 1
+  end if
+  call get_command_argument(5, in_filename)
+  call get_command_argument(6, out_prefix)
+
+  call pmc_mpi_init()
+
+  call pmc_srand(0, pmc_mpi_rank())
+
+  call bin_grid_make(bin_grid, BIN_GRID_TYPE_LOG, n_bin, diam2rad(d_min), &
+       diam2rad(d_max))
+
+  call input_state(in_filename, index, time, del_t, i_repeat, uuid, &
+       aero_data, aero_state, gas_data, gas_state, env_state)
+
+  if (dry_volume) then
+     call aero_state_make_dry(aero_state, aero_data)
+  end if
+
+  call aero_state_bin_deaverage_comp(aero_state, bin_grid, aero_data, &
+       external_groups)
+
+  output_type = OUTPUT_TYPE_SINGLE
+  record_removals = .false.
+  record_optical = .true.
+  call output_state(out_prefix, output_type, aero_data, aero_state, &
+       gas_data, gas_state, env_state, index, time, del_t, i_repeat, &
+       record_removals, record_optical, uuid)
+
+  call pmc_mpi_finalize()
+
+end program bin_deaverage_comp