37 real(kind=dp),
allocatable :: centers(:)
39 real(kind=dp),
allocatable :: edges(:)
41 real(kind=dp),
allocatable :: widths(:)
55 if (
allocated(bin_grid%centers))
then 70 real(kind=dp),
intent(in) :: r
72 real(kind=dp),
intent(in) :: f_vol
74 real(kind=dp),
intent(out) :: f_lnr
76 f_lnr = f_vol * 4d0 *
const%pi * r**3
88 integer,
intent(in) :: type
90 integer,
intent(in) :: n_bin
92 real(kind=dp),
intent(in) :: min
94 real(kind=dp),
intent(in) :: max
96 real(kind=dp) :: c1, c2
100 "bin_grid requires a non-negative n_bin, not: " &
105 "log bin_grid requires a positive min value, not: " &
109 "bin_grid requires min < max, not: " &
114 if (n_bin == 0)
return 116 bin_grid%edges =
logspace(min, max, n_bin + 1)
120 bin_grid%centers =
logspace(c1, c2, n_bin)
121 bin_grid%widths = [ ((log(max) - log(min)) /
real(n_bin, kind=dp), &
124 bin_grid%edges =
linspace(min, max, n_bin + 1)
127 bin_grid%centers =
linspace(c1, c2, n_bin)
128 bin_grid%widths = [ ((max - min) /
real(n_bin, kind=dp), i=1,n_bin) ]
130 call die_msg(678302366,
"unknown bin_grid type: " &
148 real(kind=dp),
intent(in) :: val
163 call die_msg(348908641,
"unknown bin_grid type: " &
178 real(kind=dp),
intent(in) :: x_data(:)
180 real(kind=dp),
intent(in) :: weight_data(size(x_data))
183 real(kind=dp) :: bin_grid_histogram_1d(
bin_grid_size(x_bin_grid))
185 integer :: i_data, x_bin
187 bin_grid_histogram_1d = 0d0
188 do i_data = 1,
size(x_data)
190 if ((x_bin >= 1) .and. (x_bin <=
bin_grid_size(x_bin_grid)))
then 191 bin_grid_histogram_1d(x_bin) = bin_grid_histogram_1d(x_bin) &
192 + weight_data(i_data) / x_bin_grid%widths(x_bin)
208 real(kind=dp),
intent(in) :: x_data(:)
212 real(kind=dp),
intent(in) :: y_data(size(x_data))
214 real(kind=dp),
intent(in) :: weight_data(size(x_data))
217 real(kind=dp) :: bin_grid_histogram_2d(
bin_grid_size(x_bin_grid), &
218 bin_grid_size(y_bin_grid))
220 integer :: i_data, x_bin, y_bin
222 bin_grid_histogram_2d = 0d0
223 do i_data = 1,
size(x_data)
226 if ((x_bin >= 1) .and. (x_bin <= bin_grid_size(x_bin_grid)) &
227 .and. (y_bin >= 1) .and. (y_bin <= bin_grid_size(y_bin_grid)))
then 228 bin_grid_histogram_2d(x_bin, y_bin) &
229 = bin_grid_histogram_2d(x_bin, y_bin) + weight_data(i_data) &
230 / x_bin_grid%widths(x_bin) / y_bin_grid%widths(y_bin)
239 subroutine spec_file_read_radius_bin_grid(file, bin_grid)
247 real(kind=dp) :: d_min, d_max
276 end subroutine spec_file_read_radius_bin_grid
300 character,
intent(inout) :: buffer(:)
302 integer,
intent(inout) :: position
307 integer :: prev_position
309 prev_position = position
326 character,
intent(inout) :: buffer(:)
328 integer,
intent(inout) :: position
333 integer :: prev_position
335 prev_position = position
392 integer,
intent(in) :: ncid
394 character(len=*),
intent(in) :: dim_name
396 character(len=*),
intent(in) :: unit
398 integer,
intent(out) :: dimid
400 character(len=*),
intent(in),
optional :: long_name
402 real(kind=dp),
intent(in),
optional :: scale
404 integer :: status, varid, dimid_edges, varid_edges, varid_widths, i
405 real(kind=dp) :: centers(size(bin_grid%centers))
406 real(kind=dp) :: edges(size(bin_grid%edges))
407 real(kind=dp) :: widths(size(bin_grid%widths))
408 character(len=(len_trim(dim_name)+10)) :: dim_name_edges
409 character(len=255) :: use_long_name
411 status = nf90_inq_dimid(ncid, dim_name, dimid)
412 if (status == nf90_noerr)
return 417 dim_name_edges = trim(dim_name) //
"_edges" 418 if (
present(long_name))
then 419 call assert_msg(125084459, len_trim(long_name) <= len(use_long_name), &
420 "long_name is longer than " &
422 use_long_name = trim(long_name)
424 call assert_msg(660927086, len_trim(dim_name) <= len(use_long_name), &
425 "dim_name is longer than " &
427 use_long_name = trim(dim_name)
431 call pmc_nc_check(nf90_def_dim(ncid, dim_name,
size(bin_grid%centers), &
434 size(bin_grid%edges), dimid_edges))
437 centers = bin_grid%centers
438 edges = bin_grid%edges
439 widths = bin_grid%widths
441 if (
present(scale))
then 442 centers = centers * scale
443 edges = edges * scale
446 unit=unit, long_name=(trim(use_long_name) //
" grid centers"), &
447 description=(
"logarithmically spaced centers of " &
448 // trim(use_long_name) //
" grid, so that " // trim(dim_name) &
449 //
"(i) is the geometric mean of " // trim(dim_name_edges) &
450 //
"(i) and " // trim(dim_name_edges) //
"(i + 1)"))
452 (/ dimid_edges /), unit=unit, &
453 long_name=(trim(use_long_name) //
" grid edges"), &
454 description=(
"logarithmically spaced edges of " &
455 // trim(use_long_name) //
" grid, with one more edge than center"))
457 (/ dimid /), unit=
"1", &
458 long_name=(trim(use_long_name) //
" grid widths"), &
459 description=(
"base-e logarithmic widths of " &
460 // trim(use_long_name) //
" grid, with " // trim(dim_name) &
461 //
"_widths(i) = ln(" // trim(dim_name_edges) //
"(i + 1) / " &
462 // trim(dim_name_edges) //
"(i))"))
464 if (
present(scale))
then 465 centers = centers * scale
466 edges = edges * scale
467 widths = widths * scale
470 unit=unit, long_name=(trim(use_long_name) //
" grid centers"), &
471 description=(
"linearly spaced centers of " // trim(use_long_name) &
472 //
" grid, so that " // trim(dim_name) //
"(i) is the mean of " &
473 // trim(dim_name_edges) //
"(i) and " // trim(dim_name_edges) &
476 (/ dimid_edges /), unit=unit, &
477 long_name=(trim(use_long_name) //
" grid edges"), &
478 description=(
"linearly spaced edges of " &
479 // trim(use_long_name) //
" grid, with one more edge than center"))
481 (/ dimid /), unit=unit, &
482 long_name=(trim(use_long_name) //
" grid widths"), &
483 description=(
"widths of " // trim(use_long_name) &
484 //
" grid, with " // trim(dim_name) //
"_widths(i) = " &
485 // trim(dim_name_edges) //
"(i + 1) - " // trim(dim_name_edges) &
488 call die_msg(942560572,
"unknown bin_grid type: " &
503 integer,
intent(in) :: ncid
505 character(len=*),
intent(in) :: dim_name
507 character(len=*),
intent(in) :: unit
509 character(len=*),
intent(in),
optional :: long_name
511 real(kind=dp),
intent(in),
optional :: scale
528 integer,
intent(in) :: ncid
530 character(len=*),
intent(in) :: dim_name
532 real(kind=dp),
intent(in),
optional :: scale
534 integer :: dimid, varid, n_bin, type
535 character(len=1000) :: name, description
536 real(kind=dp),
allocatable :: edges(:)
538 call pmc_nc_check(nf90_inq_dimid(ncid, dim_name, dimid))
539 call pmc_nc_check(nf90_inquire_dimension(ncid, dimid, name, n_bin))
540 call pmc_nc_check(nf90_inq_varid(ncid, dim_name, varid))
541 call pmc_nc_check(nf90_get_att(ncid, varid,
"description", description))
545 if (
starts_with(description,
"logarithmically"))
then 550 call die_msg(792158584,
"cannot identify grid type for NetCDF " &
551 //
"dimension: " // trim(dim_name))
554 if (
present(scale))
then 555 call bin_grid_make(bin_grid,
type, n_bin, scale * edges(1), &
556 scale * edges(n_bin + 1))
558 call bin_grid_make(bin_grid,
type, n_bin, edges(1), edges(n_bin + 1))
subroutine assert_msg(code, condition_ok, error_msg)
Errors unless condition_ok is true.
subroutine pmc_mpi_pack_bin_grid(buffer, position, val)
Packs the given value into the buffer, advancing position.
integer function linspace_find(min_x, max_x, n, x)
Find the position of a real number in a 1D linear array.
An input file with extra data for printing messages.
logical function starts_with(string, start_string)
Checks whether a string starts with a given other string.
integer function pmc_mpi_pack_size_bin_grid(val)
Determines the number of bytes required to pack the given value.
real(kind=dp) function, dimension(:), allocatable logspace(min_x, max_x, n)
Makes a logarithmically spaced array of length n from min to max.
Wrapper functions for NetCDF. These all take a NetCDF ncid in data mode and return with it again in d...
subroutine pmc_nc_read_real_1d(ncid, var, name, must_be_present)
Read a simple real array from a NetCDF file.
The bin_grid_t structure and associated subroutines.
real(kind=dp) function, dimension(bin_grid_size(x_bin_grid), bin_grid_size(y_bin_grid)) bin_grid_histogram_2d(x_bin_grid, x_data, y_bin_grid, y_data, weight_data)
Make a 2D histogram with of the given weighted data, scaled by the bin sizes.
integer, parameter bin_grid_type_invalid
Invalid type of bin grid.
integer function pmc_mpi_pack_size_real_array(val)
Determines the number of bytes required to pack the given value.
subroutine assert(code, condition_ok)
Errors unless condition_ok is true.
subroutine spec_file_read_real(file, name, var)
Read a real number from a spec file that must have the given name.
subroutine pmc_nc_check(status)
Check the status of a NetCDF function call.
logical function pmc_mpi_allequal_integer(val)
Returns whether all processors have the same value.
subroutine spec_file_read_integer(file, name, var)
Read an integer from a spec file that must have the given name.
real(kind=dp) function, dimension(bin_grid_size(x_bin_grid)) bin_grid_histogram_1d(x_bin_grid, x_data, weight_data)
Make a histogram with of the given weighted data, scaled by the bin sizes.
subroutine die_msg(code, error_msg)
Error immediately.
elemental integer function bin_grid_size(bin_grid)
Return the number of bins in the grid, or -1 if the bin grid is not allocated.
real(kind=dp) function, dimension(:), allocatable linspace(min_x, max_x, n)
Makes a linearly spaced array from min to max.
logical function pmc_mpi_allequal_real(val)
Returns whether all processors have the same value.
character(len=pmc_util_convert_string_len) function real_to_string(val)
Convert a real to a string format.
subroutine bin_grid_netcdf_dim(bin_grid, ncid, dim_name, unit, dimid, long_name, scale)
Write a bin grid dimension to the given NetCDF file if it is not already present and in any case retu...
real(kind=dp) elemental function diam2rad(d)
Convert diameter (m) to radius (m).
1D grid, either logarithmic or linear.
subroutine pmc_mpi_pack_integer(buffer, position, val)
Packs the given value into the buffer, advancing position.
subroutine bin_grid_make(bin_grid, type, n_bin, min, max)
Generates the bin grid given the range and number of bins.
integer function logspace_find(min_x, max_x, n, x)
Find the position of a real number in a 1D logarithmic array.
logical function pmc_mpi_allequal_bin_grid(val)
Check whether all processors have the same value.
Reading formatted text input.
integer function bin_grid_find(bin_grid, val)
Find the bin number that contains a given value.
subroutine pmc_mpi_pack_real_array(buffer, position, val)
Packs the given value into the buffer, advancing position.
subroutine pmc_mpi_unpack_real_array(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
subroutine bin_grid_output_netcdf(bin_grid, ncid, dim_name, unit, long_name, scale)
Write a bin grid to the given NetCDF file.
subroutine vol_to_lnr(r, f_vol, f_lnr)
Convert a concentration f(vol)d(vol) to f(ln(r))d(ln(r)) where vol = 4/3 pi r^3.
subroutine pmc_nc_write_real_1d(ncid, var, name, dimids, dim_name, unit, long_name, standard_name, description)
Write a simple real array to a NetCDF file.
integer function pmc_mpi_pack_size_integer(val)
Determines the number of bytes required to pack the given value.
subroutine pmc_mpi_unpack_integer(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
subroutine pmc_mpi_unpack_bin_grid(buffer, position, val)
Unpacks the given value from the buffer, advancing position.
type(const_t), save const
Fixed variable for accessing the constant's values.
integer, parameter bin_grid_type_log
Logarithmically spaced bin grid.
integer, parameter bin_grid_type_linear
Linearly spaced bin grid.
character(len=pmc_util_convert_string_len) function integer_to_string(val)
Convert an integer to a string format.
subroutine bin_grid_input_netcdf(bin_grid, ncid, dim_name, scale)
Read full state.
Common utility subroutines.
Wrapper functions for MPI.
real(kind=dp) function interp_linear_disc(x_1, x_n, n, i)
Linear interpolation over discrete indices.