52 integer,
intent(in) :: n_group
54 integer,
intent(in) :: n_class
56 if (
allocated(aero_weight_array%weight))
then 57 deallocate(aero_weight_array%weight)
59 allocate(aero_weight_array%weight(n_group, n_class))
71 integer,
intent(in) :: n_class
75 aero_weight_array%weight%magnitude = 1d0
76 aero_weight_array%weight%exponent = 0d0
89 integer,
intent(in) :: n_class
91 real(kind=dp),
intent(in) :: exponent
95 aero_weight_array%weight%magnitude = 1d0
96 aero_weight_array%weight%exponent = exponent
108 integer,
intent(in) :: n_class
112 aero_weight_array%weight(1, :)%magnitude = 1d0
113 aero_weight_array%weight(1, :)%exponent = 0d0
115 aero_weight_array%weight(2, :)%magnitude = 1d0
116 aero_weight_array%weight(2, :)%exponent = -3d0
165 real(kind=dp),
intent(in) :: factor
176 aero_weight_array_delta)
184 aero_weight_array_delta%weight)
194 aero_weight_array_to, sample_prop, overwrite_to)
201 real(kind=dp),
intent(in) :: sample_prop
203 logical,
intent(in),
optional :: overwrite_to
206 aero_weight_array_to%weight, sample_prop, overwrite_to)
214 aero_particle, aero_data)
224 aero_weight_array%weight(aero_particle%weight_group, &
225 aero_particle%weight_class), aero_particle, aero_data)
233 aero_weight_array, i_class, radius)
238 integer,
intent(in) :: i_class
240 real(kind=dp),
intent(in) :: radius
243 real(kind=dp) :: num_conc(size(aero_weight_array%weight, 1))
245 do i_group = 1,
size(aero_weight_array%weight, 1)
247 aero_weight_array%weight(i_group, i_class), radius)
258 aero_particle, aero_data)
268 aero_weight_array, aero_particle%weight_class, &
281 integer :: i_group, i_class
284 do i_group = 1,
size(aero_weight_array%weight, 1)
285 do i_class = 1,
size(aero_weight_array%weight, 2)
287 aero_weight_array%weight(i_group, i_class))
291 if (all(abs(sum(aero_weight_array%weight%exponent, 1)) &
292 < 1d-20 * sum(abs(aero_weight_array%weight%exponent), 1)))
then 305 monotone_increasing, monotone_decreasing)
310 logical,
intent(out) :: monotone_increasing
312 logical,
intent(out) :: monotone_decreasing
314 integer :: i_group, i_class
315 logical :: mono_increasing_array(size(aero_weight_array%weight, 1), &
316 size(aero_weight_array%weight, 2))
317 logical :: mono_decreasing_array(size(aero_weight_array%weight, 1), &
318 size(aero_weight_array%weight, 2))
320 do i_group = 1,
size(aero_weight_array%weight, 1)
321 do i_class = 1,
size(aero_weight_array%weight, 2)
323 aero_weight_array%weight(i_group, i_class), &
324 mono_increasing_array(i_group, i_class), &
325 mono_decreasing_array(i_group, i_class))
329 monotone_increasing = all(mono_increasing_array)
330 monotone_decreasing = all(mono_decreasing_array)
339 radius_1, radius_2, num_conc_min, num_conc_max)
344 integer,
intent(in) :: i_class
346 real(kind=dp),
intent(in) :: radius_1
348 real(kind=dp),
intent(in) :: radius_2
350 real(kind=dp),
intent(out) :: num_conc_min
352 real(kind=dp),
intent(out) :: num_conc_max
354 real(kind=dp) :: num_conc_1, num_conc_2
355 logical :: monotone_increasing, monotone_decreasing
358 monotone_increasing, monotone_decreasing)
359 call assert(857727714, monotone_increasing .or. monotone_decreasing)
365 num_conc_min = min(num_conc_1, num_conc_2)
366 num_conc_max = max(num_conc_1, num_conc_2)
380 integer,
intent(in) :: i_class
382 real(kind=dp),
intent(in) :: radius
384 real(kind=dp) :: comp_vols(size(aero_weight_array%weight, 1))
387 do i_group = 1,
size(aero_weight_array%weight, 1)
389 aero_weight_array%weight(i_group, i_class), radius)
405 integer :: i_group, i_class
407 do i_group = 1,
size(aero_weight_array%weight, 1)
408 do i_class = 1,
size(aero_weight_array%weight, 2)
409 call spec_file_read_aero_weight(file, &
410 aero_weight_array%weight(i_group, i_class))
424 integer :: i_group, i_class, total_size
425 logical :: is_allocated
428 is_allocated =
allocated(val%weight)
430 if (is_allocated)
then 431 total_size = total_size &
434 do i_group = 1,
size(val%weight, 1)
435 do i_class = 1,
size(val%weight, 2)
436 total_size = total_size &
451 character,
intent(inout) :: buffer(:)
453 integer,
intent(inout) :: position
458 integer :: prev_position, i_group, i_class
459 logical :: is_allocated
461 prev_position = position
462 is_allocated =
allocated(val%weight)
464 if (is_allocated)
then 467 do i_group = 1,
size(val%weight, 1)
468 do i_class = 1,
size(val%weight, 2)
470 val%weight(i_group, i_class))
486 character,
intent(inout) :: buffer(:)
488 integer,
intent(inout) :: position
493 integer :: prev_position, n_group, n_class, i_group, i_class
494 logical :: is_allocated
496 prev_position = position
498 if (is_allocated)
then 502 do i_group = 1,
size(val%weight, 1)
503 do i_class = 1,
size(val%weight, 2)
505 val%weight(i_group, i_class))
509 if (
allocated(val%weight))
then 510 deallocate(val%weight)
525 ncid, dimid_aero_weight_group)
530 integer,
intent(in) :: ncid
532 integer,
intent(out) :: dimid_aero_weight_group
534 integer :: status, i_group, n_group
535 integer :: varid_aero_weight_group
536 integer :: aero_weight_group_centers(size(aero_weight_array%weight, 1))
539 status = nf90_inq_dimid(ncid,
"aero_weight_group", dimid_aero_weight_group)
540 if (status == nf90_noerr)
return 546 n_group =
size(aero_weight_array%weight, 1)
548 call pmc_nc_check(nf90_def_dim(ncid,
"aero_weight_group", n_group, &
549 dimid_aero_weight_group))
550 call pmc_nc_check(nf90_def_var(ncid,
"aero_weight_group", nf90_int, &
551 dimid_aero_weight_group, varid_aero_weight_group))
552 call pmc_nc_check(nf90_put_att(ncid, varid_aero_weight_group, &
553 "description",
"dummy dimension variable (no useful value)"))
557 do i_group = 1,n_group
558 aero_weight_group_centers(i_group) = i_group
560 call pmc_nc_check(nf90_put_var(ncid, varid_aero_weight_group, &
561 aero_weight_group_centers))
571 ncid, dimid_aero_weight_class)
576 integer,
intent(in) :: ncid
578 integer,
intent(out) :: dimid_aero_weight_class
580 integer :: status, i_class, n_class
581 integer :: varid_aero_weight_class
582 integer :: aero_weight_class_centers(size(aero_weight_array%weight, 2))
585 status = nf90_inq_dimid(ncid,
"aero_weight_class", dimid_aero_weight_class)
586 if (status == nf90_noerr)
return 592 n_class =
size(aero_weight_array%weight, 2)
594 call pmc_nc_check(nf90_def_dim(ncid,
"aero_weight_class", n_class, &
595 dimid_aero_weight_class))
596 call pmc_nc_check(nf90_def_var(ncid,
"aero_weight_class", nf90_int, &
597 dimid_aero_weight_class, varid_aero_weight_class))
598 call pmc_nc_check(nf90_put_att(ncid, varid_aero_weight_class, &
599 "description",
"dummy dimension variable (no useful value)"))
603 do i_class = 1,n_class
604 aero_weight_class_centers(i_class) = i_class
606 call pmc_nc_check(nf90_put_var(ncid, varid_aero_weight_class, &
607 aero_weight_class_centers))
614 subroutine aero_weight_array_output_netcdf(aero_weight_array, ncid)
619 integer,
intent(in) :: ncid
621 integer :: dimid_aero_weight_group, dimid_aero_weight_class
644 dimid_aero_weight_group)
646 dimid_aero_weight_class)
650 (/ dimid_aero_weight_group, dimid_aero_weight_class /), &
651 description=
"type of each aerosol weighting function: 0 = invalid, " &
652 //
"1 = none (w(D) = 1), 2 = power (w(D) = (D/D_0)^alpha), " &
653 //
"3 = MFA (mass flow) (w(D) = (D/D_0)^(-3))")
655 "weight_magnitude", &
656 (/ dimid_aero_weight_group, dimid_aero_weight_class /), &
658 description=
"magnitude for each weighting function")
661 (/ dimid_aero_weight_group, dimid_aero_weight_class /), unit=
"1", &
662 description=
"exponent alpha for the power weight_type, " &
663 //
"set to -3 for MFA, and zero otherwise")
665 end subroutine aero_weight_array_output_netcdf
675 integer,
intent(in) :: ncid
677 integer :: dimid_aero_weight_group, dimid_aero_weight_class, n_group
679 character(len=1000) :: name
680 integer,
allocatable ::
type(:, :)
681 real(kind=dp),
allocatable :: magnitude(:, :), exponent(:, :)
683 call pmc_nc_check(nf90_inq_dimid(ncid,
"aero_weight_group", &
684 dimid_aero_weight_group))
685 call pmc_nc_check(nf90_inq_dimid(ncid,
"aero_weight_class", &
686 dimid_aero_weight_class))
688 dimid_aero_weight_group, name, n_group))
690 dimid_aero_weight_class, name, n_class))
691 call assert(719221386, n_group < 1000)
692 call assert(520105999, n_class < 1000)
698 call assert(309191498,
size(magnitude) ==
size(type))
699 call assert(588649520,
size(magnitude) ==
size(exponent))
703 aero_weight_array%weight%type =
type 704 aero_weight_array%weight%magnitude = magnitude
705 aero_weight_array%weight%exponent = exponent
elemental real(kind=dp) function aero_particle_radius(aero_particle, aero_data)
Total radius of the particle (m).
subroutine aero_weight_netcdf_dim_aero_weight_class(aero_weight_array, ncid, dimid_aero_weight_class)
Write the aero_weight_class dimension to the given NetCDF file if it is not already present and in an...
real(kind=dp) function aero_weight_array_single_num_conc(aero_weight_array, aero_particle, aero_data)
Compute the number concentration for a particle (m^{-3}).
subroutine pmc_mpi_unpack_aero_weight(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
subroutine aero_weight_array_check_monotonicity(aero_weight_array, monotone_increasing, monotone_decreasing)
Determine whether all weight functions in an array are monotone increasing, monotone decreasing...
Random number generators.
An input file with extra data for printing messages.
Wrapper functions for NetCDF. These all take a NetCDF ncid in data mode and return with it again in d...
The aero_weight_array_t structure and associated subroutines.
real(kind=dp) function aero_weight_num_conc(aero_weight, aero_particle, aero_data)
Compute the number concentration for a particle (m^{-3}).
subroutine aero_weight_array_set_nummass(aero_weight_array, n_class)
Allocates an aero_weight_array as joint flat/power-3 weightings..
integer, parameter aero_weight_type_power
Type code for power function weighting.
integer function pmc_mpi_pack_size_aero_weight_array(val)
Determines the number of bytes required to pack the given value.
elemental subroutine aero_weight_normalize(aero_weight)
Sets the aero_weight to a non-zero normalized value.
The aero_particle_t structure and associated subroutines.
subroutine pmc_mpi_pack_aero_weight(buffer, position, val)
Packs the given value into the buffer, advancing position.
An aerosol size distribution weighting function.
elemental subroutine aero_weight_combine(aero_weight, aero_weight_delta)
Combine aero_weight_delta into aero_weight with a harmonic mean.
subroutine pmc_mpi_unpack_aero_weight_array(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
subroutine assert(code, condition_ok)
Errors unless condition_ok is true.
subroutine aero_weight_netcdf_dim_aero_weight_group(aero_weight_array, ncid, dimid_aero_weight_group)
Write the aero_weight_group dimension to the given NetCDF file if it is not already present and in an...
subroutine aero_weight_array_input_netcdf(aero_weight_array, ncid)
Read full aero_weight_array.
real(kind=dp) function aero_weight_array_num_conc_at_radius(aero_weight_array, i_class, radius)
Compute the total number concentration at a given radius (m^3).
subroutine pmc_nc_check(status)
Check the status of a NetCDF function call.
integer function pmc_mpi_pack_size_aero_weight(val)
Determines the number of bytes required to pack the given value.
subroutine aero_weight_array_set_flat(aero_weight_array, n_class)
Allocates an aero_weight_array as flat weightings.
subroutine pmc_mpi_pack_logical(buffer, position, val)
Packs the given value into the buffer, advancing position.
An array of aerosol size distribution weighting functions.
real(kind=dp) function aero_weight_array_num_conc(aero_weight_array, aero_particle, aero_data)
Compute the number concentration for a particle (m^{-3}).
integer function sample_cts_pdf(pdf)
Sample the given continuous probability density function.
subroutine aero_weight_array_set_power(aero_weight_array, n_class, exponent)
Allocates an aero_weight_array as power weightings.
subroutine aero_weight_array_set_sizes(aero_weight_array, n_group, n_class)
Sets the number of weight groups and classes.
elemental subroutine aero_weight_scale(aero_weight, factor)
Scale the weight by the given fraction, so new_weight = old_weight * factor.
The aero_data_t structure and associated subroutines.
Single aerosol particle data structure.
subroutine pmc_nc_write_real_2d(ncid, var, name, dimids, dim_name_1, dim_name_2, unit, long_name, standard_name, description)
Write a simple real 2D array to a NetCDF file.
subroutine pmc_mpi_pack_integer(buffer, position, val)
Packs the given value into the buffer, advancing position.
subroutine aero_weight_array_combine(aero_weight_array, aero_weight_array_delta)
Combine aero_weight_array_delta into aero_weight_array with a harmonic mean.
Reading formatted text input.
subroutine aero_weight_check_monotonicity(aero_weight, monotone_increasing, monotone_decreasing)
Determine whether a weight function is monotone increasing, monotone decreasing, or neither...
subroutine aero_weight_array_minmax_num_conc(aero_weight_array, i_class, radius_1, radius_2, num_conc_min, num_conc_max)
Compute the maximum and minimum number concentrations between the given radii.
subroutine pmc_nc_read_real_2d(ncid, var, name, must_be_present)
Read a simple real 2D array from a NetCDF file.
integer function aero_weight_array_rand_group(aero_weight_array, i_class, radius)
Choose a random group at the given radius, with probability inversely proportional to group weight at...
subroutine pmc_nc_read_integer_2d(ncid, var, name, must_be_present)
Read a simple integer 2D array from a NetCDF file.
subroutine pmc_mpi_pack_aero_weight_array(buffer, position, val)
Packs the given value into the buffer, advancing position.
logical function aero_weight_array_check_flat(aero_weight_array)
Check whether a given aero_weight array is flat in total.
integer function pmc_mpi_pack_size_logical(val)
Determines the number of bytes required to pack the given value.
subroutine spec_file_read_aero_weight_array(file, aero_weight_array)
Read an aero_weight_array from a spec file.
elemental subroutine aero_weight_array_normalize(aero_weight_array)
Normalizes the aero_weight_array to a non-zero value.
subroutine pmc_mpi_unpack_logical(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
elemental subroutine aero_weight_shift(aero_weight_from, aero_weight_to, sample_prop, overwrite_to)
Adjust source and destination weights to reflect moving sample_prop proportion of particles from aero...
integer function pmc_mpi_pack_size_integer(val)
Determines the number of bytes required to pack the given value.
subroutine pmc_nc_write_integer_2d(ncid, var, name, dimids, dim_name_1, dim_name_2, unit, long_name, standard_name, description)
Write a simple integer 2D array to a NetCDF file.
subroutine pmc_mpi_unpack_integer(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
integer, parameter aero_weight_type_none
Type code for no (or flat) weighting.
integer function aero_weight_array_n_group(aero_weight_array)
Return the number of weight groups.
real(kind=dp) function aero_weight_num_conc_at_radius(aero_weight, radius)
Compute the number concentration at a given radius (m^{-3}).
integer function aero_weight_array_n_class(aero_weight_array)
Return the number of weight classes.
subroutine aero_weight_array_shift(aero_weight_array_from, aero_weight_array_to, sample_prop, overwrite_to)
Adjust source and destination weights to reflect moving sample_prop proportion of particles from aero...
Aerosol material properties and associated data.
subroutine aero_weight_array_scale(aero_weight_array, factor)
Scale the weights by the given factor, so new_weight = old_weight * factor.
Common utility subroutines.
Wrapper functions for MPI.
The aero_weight_t structure and associated subroutines.
subroutine aero_weight_check_valid_exponent(aero_weight)
Ensures that a weight function exponent is valid.