PartMC 2.1.2
coag_kernel.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_coag_kernel module.
00007 
00008 !> Generic coagulation kernel.
00009 module pmc_coag_kernel
00010 
00011   use pmc_env_state
00012   use pmc_bin_grid
00013   use pmc_aero_particle
00014   use pmc_aero_data
00015   use pmc_aero_weight
00016   use pmc_coag_kernel_sedi
00017   use pmc_coag_kernel_additive
00018   use pmc_coag_kernel_constant
00019   use pmc_coag_kernel_brown
00020   use pmc_coag_kernel_zero
00021 
00022   !> Maximum length of a mode type.
00023   integer, parameter :: COAG_KERNEL_TYPE_LEN = 20
00024 
00025   !> Type code for an undefined or invalid kernel.
00026   integer, parameter :: COAG_KERNEL_TYPE_INVALID  = 0
00027   !> Type code for a sedimentation kernel.
00028   integer, parameter :: COAG_KERNEL_TYPE_SEDI     = 1
00029   !> Type code for an additive kernel.
00030   integer, parameter :: COAG_KERNEL_TYPE_ADDITIVE = 2
00031   !> Type code for a constant kernel.
00032   integer, parameter :: COAG_KERNEL_TYPE_CONSTANT = 3
00033   !> Type code for a Brownian kernel.
00034   integer, parameter :: COAG_KERNEL_TYPE_BROWN    = 4
00035   !> Type code for a zero kernel.
00036   integer, parameter :: COAG_KERNEL_TYPE_ZERO     = 5
00037   
00038 contains
00039 
00040 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00041 
00042   !> Return a string representation of a kernel type.
00043   character(len=COAG_KERNEL_TYPE_LEN) function coag_kernel_type_to_string( &
00044        coag_kernel_type)
00045 
00046     !> Coagulation kernel type.
00047     integer, intent(in) :: coag_kernel_type
00048    
00049     if (coag_kernel_type == COAG_KERNEL_TYPE_INVALID) then
00050        coag_kernel_type_to_string = "invalid"
00051     elseif (coag_kernel_type == COAG_KERNEL_TYPE_SEDI) then
00052        coag_kernel_type_to_string = "sedi"
00053     elseif (coag_kernel_type == COAG_KERNEL_TYPE_ADDITIVE) then
00054        coag_kernel_type_to_string = "additive"
00055     elseif (coag_kernel_type == COAG_KERNEL_TYPE_CONSTANT) then
00056        coag_kernel_type_to_string = "constant"
00057     elseif (coag_kernel_type == COAG_KERNEL_TYPE_BROWN) then
00058        coag_kernel_type_to_string = "brown"
00059     elseif (coag_kernel_type == COAG_KERNEL_TYPE_ZERO) then
00060        coag_kernel_type_to_string = "zero"
00061     else
00062        coag_kernel_type_to_string = "unknown"
00063     end if
00064 
00065   end function coag_kernel_type_to_string
00066 
00067 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00068 
00069   !> Evalulate a coagulation kernel function.
00070   subroutine kernel(coag_kernel_type, aero_particle_1, aero_particle_2, &
00071        aero_data, env_state, k)
00072 
00073     !> Coagulation kernel type.
00074     integer, intent(in) :: coag_kernel_type
00075     !> First particle.
00076     type(aero_particle_t), intent(in) :: aero_particle_1
00077     !> Second particle.
00078     type(aero_particle_t), intent(in) :: aero_particle_2
00079     !> Aerosol data.
00080     type(aero_data_t), intent(in) :: aero_data
00081     !> Environment state.
00082     type(env_state_t), intent(in) :: env_state
00083     !> Kernel k(a,b) (m^3/s).
00084     real(kind=dp), intent(out) :: k
00085 
00086     if (coag_kernel_type == COAG_KERNEL_TYPE_SEDI) then
00087        call kernel_sedi(aero_particle_1, aero_particle_2, &
00088        aero_data, env_state, k)
00089     elseif (coag_kernel_type == COAG_KERNEL_TYPE_ADDITIVE) then
00090        call kernel_additive(aero_particle_1, aero_particle_2, &
00091        aero_data, env_state, k)
00092     elseif (coag_kernel_type == COAG_KERNEL_TYPE_CONSTANT) then
00093        call kernel_constant(aero_particle_1, aero_particle_2, &
00094        aero_data, env_state, k)
00095     elseif (coag_kernel_type == COAG_KERNEL_TYPE_BROWN) then
00096        call kernel_brown(aero_particle_1, aero_particle_2, &
00097        aero_data, env_state, k)
00098     elseif (coag_kernel_type == COAG_KERNEL_TYPE_ZERO) then
00099        call kernel_zero(aero_particle_1, aero_particle_2, &
00100        aero_data, env_state, k)
00101     else
00102        call die_msg(200724934, "Unknown kernel type: " &
00103             // trim(integer_to_string(coag_kernel_type)))
00104     end if
00105 
00106   end subroutine kernel
00107 
00108 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00109 
00110   !> Compute the maximum coagulation kernel.
00111   subroutine kernel_max(coag_kernel_type, v1, v2, aero_data, env_state, k_max)
00112 
00113     !> Coagulation kernel type.
00114     integer, intent(in) :: coag_kernel_type
00115     !> Volume of first particle (m^3).
00116     real(kind=dp), intent(in) :: v1
00117     !> Volume of second particle (m^3).
00118     real(kind=dp), intent(in) :: v2
00119     !> Aerosol data.
00120     type(aero_data_t), intent(in) :: aero_data
00121     !> Environment state.
00122     type(env_state_t), intent(in) :: env_state
00123     !> Maximum kernel value (m^3/s).
00124     real(kind=dp), intent(out) :: k_max
00125 
00126     if (coag_kernel_type == COAG_KERNEL_TYPE_SEDI) then
00127        call kernel_sedi_max(v1, v2, aero_data, env_state, k_max)
00128     elseif (coag_kernel_type == COAG_KERNEL_TYPE_ADDITIVE) then
00129        call kernel_additive_max(v1, v2, aero_data, env_state, k_max)
00130     elseif (coag_kernel_type == COAG_KERNEL_TYPE_CONSTANT) then
00131        call kernel_constant_max(v1, v2, aero_data, env_state, k_max)
00132     elseif (coag_kernel_type == COAG_KERNEL_TYPE_BROWN) then
00133        call kernel_brown_max(v1, v2, aero_data, env_state, k_max)
00134     elseif (coag_kernel_type == COAG_KERNEL_TYPE_ZERO) then
00135        call kernel_zero_max(v1, v2, aero_data, env_state, k_max)
00136     else
00137        call die_msg(330498208, "Unknown kernel type: " &
00138             // trim(integer_to_string(coag_kernel_type)))
00139     end if
00140 
00141   end subroutine kernel_max
00142 
00143 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00144 
00145   !> Compute the kernel value with the given weight.
00146   subroutine weighted_kernel(coag_kernel_type, aero_particle_1, &
00147        aero_particle_2, aero_data, aero_weight, env_state, k)
00148 
00149     !> Coagulation kernel type.
00150     integer, intent(in) :: coag_kernel_type
00151     !> First particle.
00152     type(aero_particle_t), intent(in) :: aero_particle_1
00153     !> Second particle.
00154     type(aero_particle_t), intent(in) :: aero_particle_2
00155     !> Aerosol data.
00156     type(aero_data_t), intent(in) :: aero_data
00157     !> Aerosol weight.
00158     type(aero_weight_t), intent(in) :: aero_weight
00159     !> Environment state.
00160     type(env_state_t), intent(in) :: env_state
00161     !> Coagulation kernel.
00162     real(kind=dp), intent(out) :: k
00163 
00164     real(kind=dp) :: unweighted_k
00165     real(kind=dp) :: radius_1, radius_2, radius_1_plus_2
00166     real(kind=dp) :: weight_1, weight_2, weight_1_plus_2, weight_min
00167 
00168     call kernel(coag_kernel_type, aero_particle_1, aero_particle_2, &
00169          aero_data, env_state, unweighted_k)
00170     radius_1 = aero_particle_radius(aero_particle_1)
00171     radius_2 = aero_particle_radius(aero_particle_2)
00172     radius_1_plus_2 = vol2rad(rad2vol(radius_1) + rad2vol(radius_2))
00173     weight_1 = aero_weight_value(aero_weight, radius_1)
00174     weight_2 = aero_weight_value(aero_weight, radius_2)
00175     weight_1_plus_2 = aero_weight_value(aero_weight, radius_1_plus_2)
00176     weight_min = min(weight_1, weight_2, weight_1_plus_2)
00177     k = unweighted_k * weight_1 * weight_2 / weight_min
00178     
00179   end subroutine weighted_kernel
00180 
00181 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00182 
00183   !> Compute the max kernel value with the given weight.
00184   subroutine weighted_kernel_max(coag_kernel_type, v1, v2, aero_data, &
00185        aero_weight, env_state, k_max)
00186 
00187     !> Coagulation kernel type.
00188     integer, intent(in) :: coag_kernel_type
00189     !> Volume of first particle.
00190     real(kind=dp), intent(in) :: v1
00191     !> Volume of second particle.
00192     real(kind=dp), intent(in) :: v2
00193     !> Aerosol data.
00194     type(aero_data_t), intent(in) :: aero_data
00195     !> Aerosol weight.
00196     type(aero_weight_t), intent(in) :: aero_weight
00197     !> Environment state.
00198     type(env_state_t), intent(in) :: env_state
00199     !> Coagulation kernel maximum value.
00200     real(kind=dp), intent(out) :: k_max
00201 
00202     real(kind=dp) :: unweighted_k_max, weight_1, weight_2, weight_1_plus_2
00203     real(kind=dp) :: weight_min
00204 
00205     call kernel_max(coag_kernel_type, v1, v2, aero_data, env_state, &
00206          unweighted_k_max)
00207 
00208     weight_1 = aero_weight_value(aero_weight, vol2rad(v1))
00209     weight_2 = aero_weight_value(aero_weight, vol2rad(v2))
00210     weight_1_plus_2 = aero_weight_value(aero_weight, vol2rad(v1 + v2))
00211     weight_min = min(weight_1, weight_2, weight_1_plus_2)
00212     k_max = unweighted_k_max * weight_1 * weight_2 / weight_min
00213 
00214   end subroutine weighted_kernel_max
00215 
00216 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00217 
00218   !> Computes an array of kernel values for each bin pair. k(i,j) is
00219   !> the kernel value at the centers of bins i and j. This assumes the
00220   !> kernel is only a function of the particle volumes.
00221   subroutine bin_kernel(n_bin, bin_r, aero_data, coag_kernel_type, &
00222        env_state, k)
00223     
00224     !> Number of bins.
00225     integer, intent(in) :: n_bin
00226     !> Radii of particles in bins (m).
00227     real(kind=dp), intent(in) :: bin_r(n_bin)
00228     !> Aerosol data.
00229     type(aero_data_t), intent(in) :: aero_data
00230     !> Coagulation kernel type.
00231     integer, intent(in) :: coag_kernel_type
00232     !> Environment state.
00233     type(env_state_t), intent(in) :: env_state
00234     !> Kernel values.
00235     real(kind=dp), intent(out) :: k(n_bin,n_bin)
00236 
00237     integer :: i, j
00238     type(aero_particle_t) :: aero_particle_1, aero_particle_2
00239     
00240     call aero_particle_allocate_size(aero_particle_1, aero_data%n_spec, &
00241          aero_data%n_source)
00242     call aero_particle_allocate_size(aero_particle_2, aero_data%n_spec, &
00243          aero_data%n_source)
00244     do i = 1,n_bin
00245        do j = 1,n_bin
00246           aero_particle_1%vol(1) = rad2vol(bin_r(i))
00247           aero_particle_2%vol(1) = rad2vol(bin_r(j))
00248           call kernel(coag_kernel_type, aero_particle_1, aero_particle_2, &
00249                aero_data, env_state, k(i,j))
00250        end do
00251     end do
00252     call aero_particle_deallocate(aero_particle_1)
00253     call aero_particle_deallocate(aero_particle_2)
00254     
00255   end subroutine bin_kernel
00256   
00257 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00258 
00259   !> Estimate an array of maximum kernel values. Given particles v1 in
00260   !> bin b1 and v2 in bin b2, it is probably true that kernel(v1,v2)
00261   !> <= k_max(b1,b2).
00262   subroutine est_k_max_binned(bin_grid, coag_kernel_type, aero_data, &
00263        aero_weight, env_state, k_max)
00264 
00265     !> Bin_grid.
00266     type(bin_grid_t), intent(in) :: bin_grid
00267     !> Coagulation kernel type.
00268     integer, intent(in) :: coag_kernel_type
00269     !> Aerosol data.
00270     type(aero_data_t), intent(in) :: aero_data
00271     !> Aerosol weight.
00272     type(aero_weight_t), intent(in) :: aero_weight
00273     !> Environment state.
00274     type(env_state_t), intent(in) :: env_state
00275     !> Max kernel vals.
00276     real(kind=dp), intent(out) :: k_max(bin_grid%n_bin,bin_grid%n_bin)
00277     
00278     integer i, j
00279     
00280     do i = 1,bin_grid%n_bin
00281        do j = 1,bin_grid%n_bin
00282           call est_k_max_for_bin(bin_grid, coag_kernel_type, i, j, &
00283                aero_data, aero_weight, env_state, k_max(i,j))
00284        end do
00285     end do
00286     
00287   end subroutine est_k_max_binned
00288   
00289 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00290 
00291   !> Samples within bins b1 and b2 to find the maximum value of the
00292   !> kernel between particles from the two bins.
00293   subroutine est_k_max_for_bin(bin_grid, coag_kernel_type, b1, b2, &
00294        aero_data, aero_weight, env_state, k_max)
00295    
00296     !> Bin_grid.
00297     type(bin_grid_t), intent(in) :: bin_grid
00298     !> Coagulation kernel type.
00299     integer, intent(in) :: coag_kernel_type
00300     !> First bin.
00301     integer, intent(in) :: b1
00302     !> Second bin.
00303     integer, intent(in) :: b2
00304     !> Aerosol data.
00305     type(aero_data_t), intent(in) :: aero_data
00306     !> Aerosol weight.
00307     type(aero_weight_t), intent(in) :: aero_weight
00308     !> Environment state.
00309     type(env_state_t), intent(in) :: env_state
00310     !> Maximum kernel values.
00311     real(kind=dp), intent(out) :: k_max
00312     
00313     !> Number of sample points per bin.
00314     integer, parameter :: n_sample = 3
00315     !> Over-estimation scale factor parameter.
00316     real(kind=dp), parameter :: over_scale = 1.1d0
00317     
00318     real(kind=dp) :: v1, v2, v1_high, v1_low, v2_high, v2_low, k
00319     integer :: i, j
00320     
00321     ! v1_low < bin_v(b1) < v1_high
00322     v1_low = rad2vol(bin_grid%edge_radius(b1))
00323     v1_high = rad2vol(bin_grid%edge_radius(b1 + 1))
00324     
00325     ! v2_low < bin_v(b2) < v2_high
00326     v2_low = rad2vol(bin_grid%edge_radius(b2))
00327     v2_high = rad2vol(bin_grid%edge_radius(b2 + 1))
00328     
00329     k_max = 0d0
00330     do i = 1,n_sample
00331        do j = 1,n_sample
00332           v1 = interp_linear_disc(v1_low, v1_high, n_sample, i)
00333           v2 = interp_linear_disc(v2_low, v2_high, n_sample, j)
00334           call weighted_kernel_max(coag_kernel_type, v1, v2, aero_data, &
00335                aero_weight, env_state, k)
00336           if (k .gt. k_max) k_max = k
00337        end do
00338     end do
00339     
00340     k_max = k_max * over_scale
00341     
00342   end subroutine est_k_max_for_bin
00343   
00344 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00345 
00346   !> Read the specification for a kernel type from a spec file and
00347   !> generate it.
00348   subroutine spec_file_read_coag_kernel_type(file, coag_kernel_type)
00349 
00350     !> Spec file.
00351     type(spec_file_t), intent(inout) :: file
00352     !> Kernel type.
00353     integer, intent(out) :: coag_kernel_type
00354 
00355     character(len=SPEC_LINE_MAX_VAR_LEN) :: kernel_name
00356 
00357     !> \page input_format_coag_kernel Input File Format: Coagulation Kernel
00358     !!
00359     !! The coagulation kernel is specified by the parameter:
00360     !!   - \b coag_kernel (string): the type of coagulation kernel ---
00361     !!     must be one of: \c sedi for the gravitational sedimentation
00362     !!     kernel; \c additive for the additive kernel; \c constant
00363     !!     for the constant kernel; \c brown for the Brownian kernel,
00364     !!     or \c zero for no coagulation
00365     !!
00366     !! See also:
00367     !!   - \ref spec_file_format --- the input file text format
00368 
00369     call spec_file_read_string(file, 'coag_kernel', kernel_name)
00370     if (trim(kernel_name) == 'sedi') then
00371        coag_kernel_type = COAG_KERNEL_TYPE_SEDI
00372     elseif (trim(kernel_name) == 'additive') then
00373        coag_kernel_type = COAG_KERNEL_TYPE_ADDITIVE
00374     elseif (trim(kernel_name) == 'constant') then
00375        coag_kernel_type = COAG_KERNEL_TYPE_CONSTANT
00376     elseif (trim(kernel_name) == 'brown') then
00377        coag_kernel_type = COAG_KERNEL_TYPE_BROWN
00378     elseif (trim(kernel_name) == 'zero') then
00379        coag_kernel_type = COAG_KERNEL_TYPE_ZERO
00380     else
00381        call spec_file_die_msg(494684716, file, &
00382             "Unknown coagulation kernel type: " // trim(kernel_name))
00383     end if
00384 
00385   end subroutine spec_file_read_coag_kernel_type
00386 
00387 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00388 
00389 end module pmc_coag_kernel