32 real(kind=
dp),
allocatable :: vol(:)
34 integer :: weight_group
36 integer :: weight_class
38 real(kind=
dp),
allocatable :: absorb_cross_sect(:)
40 real(kind=
dp),
allocatable :: scatter_cross_sect(:)
42 real(kind=
dp),
allocatable :: asymmetry(:)
44 complex(kind=dc),
allocatable :: refract_shell(:)
46 complex(kind=dc),
allocatable :: refract_core(:)
48 real(kind=
dp) :: core_vol
50 integer :: water_hyst_leg
56 real(kind=
dp) :: least_create_time
58 real(kind=
dp) :: greatest_create_time
62 real(kind=
dp) :: imf_temperature
64 real(kind=
dp) :: den_ice
66 real(kind=
dp) :: ice_shape_phi
68 integer :: n_primary_parts
87 call move_alloc(aero_particle_from%vol, aero_particle_to%vol)
88 aero_particle_to%weight_group = aero_particle_from%weight_group
89 aero_particle_to%weight_class = aero_particle_from%weight_class
90 call move_alloc(aero_particle_from%absorb_cross_sect, &
91 aero_particle_to%absorb_cross_sect)
92 call move_alloc(aero_particle_from%scatter_cross_sect, &
93 aero_particle_to%scatter_cross_sect)
94 call move_alloc(aero_particle_from%asymmetry, &
95 aero_particle_to%asymmetry)
96 call move_alloc(aero_particle_from%refract_shell, &
97 aero_particle_to%refract_shell)
98 call move_alloc(aero_particle_from%refract_core, &
99 aero_particle_to%refract_core)
100 aero_particle_to%core_vol = aero_particle_from%core_vol
101 aero_particle_to%water_hyst_leg = aero_particle_from%water_hyst_leg
102 aero_particle_to%id = aero_particle_from%id
103 call move_alloc(aero_particle_from%component, aero_particle_to%component)
104 aero_particle_to%least_create_time = aero_particle_from%least_create_time
105 aero_particle_to%greatest_create_time = &
106 aero_particle_from%greatest_create_time
107 aero_particle_to%frozen = aero_particle_from%frozen
108 aero_particle_to%imf_temperature = aero_particle_from%imf_temperature
109 aero_particle_to%den_ice = aero_particle_from%den_ice
110 aero_particle_to%ice_shape_phi = aero_particle_from%ice_shape_phi
111 aero_particle_to%n_primary_parts = aero_particle_from%n_primary_parts
126 aero_particle%vol = 0d0
127 aero_particle%weight_group = 0
128 aero_particle%weight_class = 0
130 aero_particle%absorb_cross_sect = 0d0
132 aero_particle%scatter_cross_sect = 0d0
134 aero_particle%asymmetry = 0d0
136 aero_particle%refract_shell = (0d0, 0d0)
138 aero_particle%refract_core = (0d0, 0d0)
139 aero_particle%core_vol = 0d0
140 aero_particle%water_hyst_leg = 0
142 if (
allocated(aero_particle%component))
deallocate(aero_particle%component)
143 allocate(aero_particle%component(0))
144 aero_particle%least_create_time = 0d0
145 aero_particle%greatest_create_time = 0d0
146 aero_particle%frozen = .false.
147 aero_particle%imf_temperature = 0d0
148 aero_particle%den_ice =
const%nan
149 aero_particle%ice_shape_phi =
const%nan
150 aero_particle%n_primary_parts = 0
175 real(kind=
dp),
intent(in) :: create_time
177 aero_particle%component(1)%create_time = create_time
178 aero_particle%least_create_time = create_time
179 aero_particle%greatest_create_time = create_time
191 integer,
intent(in) :: i_source
193 real(kind=
dp),
intent(in) :: create_time
195 if (
allocated(aero_particle%component))
deallocate(aero_particle%component)
196 allocate(aero_particle%component(1))
210 integer,
intent(inout) :: source_list(:)
212 integer :: i_comp, i_source
215 i_source = aero_particle%component(i_comp)%source_id
216 source_list(i_source) = source_list(i_source) + 1
229 real(kind=
dp),
intent(in) :: vols(:)
231 aero_particle%vol = vols
243 integer,
intent(in) :: i_source
245 aero_particle%component(1)%source_id = i_source
257 integer,
intent(in),
optional :: i_group
259 integer,
intent(in),
optional :: i_class
261 if (
present(i_group)) aero_particle%weight_group = i_group
262 if (
present(i_class)) aero_particle%weight_class = i_class
289 integer,
intent(in) :: i_spec
294 * aero_data%density(i_spec)
326 / aero_data%molec_weight)
346 aero_particle, i_spec)
351 integer,
intent(in) :: i_spec
372 if (i_spec /= aero_data%i_water)
then
374 + aero_particle%vol(i_spec)
384 aero_particle, aero_data, dry_volume)
391 logical,
intent(in) :: dry_volume
470 aero_data, env_state)
479 real(kind=
dp) :: volume, mobility_radius
482 mobility_radius = fractal_vol_to_mobility_rad(aero_data%fractal, &
483 volume, env_state%temp, env_state%pressure)
507 aero_particle, aero_data, quantity)
514 real(kind=
dp),
intent(in) :: quantity(:)
521 aero_data, quantity) &
537 real(kind=
dp),
intent(in) :: quantity(:)
544 if (i /= aero_data%i_water)
then
545 total = total + aero_particle%vol(i) * quantity(i)
563 real(kind=
dp),
intent(in) :: quantity(:)
565 call assert(420016623, aero_data%i_water > 0)
581 real(kind=
dp),
intent(in) :: quantity(:)
583 call assert(223343210, aero_data%i_water > 0)
585 = aero_particle%vol(aero_data%i_water) &
586 * quantity(aero_data%i_water)
599 call assert(772012490, aero_data%i_water > 0)
601 = aero_data%molec_weight(aero_data%i_water)
618 aero_data, aero_data%molec_weight)
635 aero_data, real(aero_data%num_ions, kind=
dp))
647 call assert(235482108, aero_data%i_water > 0)
665 aero_data, aero_data%density)
679 call assert(888636139, aero_data%i_water > 0)
681 * aero_data%density(aero_data%i_water)
697 aero_data, aero_data%density)
754 if (i_spec == aero_data%i_water)
then
756 elseif (aero_data%num_ions(i_spec) > 0)
then
757 call assert_msg(123681459, aero_data%kappa(i_spec) == 0d0, &
758 "species has nonzero num_ions and kappa: " &
759 // trim(aero_data%name(i_spec)))
760 m_a = aero_data%molec_weight(i_spec)
761 rho_a = aero_data%density(i_spec)
762 kappa(i_spec) = m_w * rho_a / (m_a * rho_w) &
763 * real(aero_data%num_ions(i_spec), kind=
dp)
765 kappa(i_spec) = aero_data%kappa(i_spec)
778 aero_data, env_state)
787 real(kind=
dp) :: kappa, diam, c, a
800 aero_data, env_state)
809 real(kind=
dp) :: kappa, crit_diam, dry_diam, a
816 if (kappa < 1d-30)
then
820 / (crit_diam**3 - dry_diam**3 * (1 - kappa)) * exp(a / crit_diam)
867 aero_data, env_state)
876 integer,
parameter :: crit_diam_max_iter = 100
878 real(kind=
dp) :: kappa, dry_diam, a, c4, c3, c0, d, f, df, dd
884 if (kappa < 1d-30)
then
890 c4 = - 3d0 * dry_diam**3 * kappa / a
891 c3 = - dry_diam**3 * (2d0 - kappa)
892 c0 = dry_diam**6 * (1d0 - kappa)
895 d = max(sqrt(-4d0 / 3d0 * c4), (-c3)**(1d0/3d0))
896 do i_newton = 1,crit_diam_max_iter
897 f = d**6 + c4 * d**4 + c3 * d**3 + c0
898 df = 6 * d**5 + 4 * c4 * d**3 + 3 * c3 * d**2
901 if (abs(dd / d) < 1d-14)
then
906 "critical diameter Newton loop failed to converge")
908 "critical diameter Newton loop converged to invalid solution")
918 aero_particle_2, aero_particle_new, aero_data)
930 real(kind=
dp) :: ice_vol_1, ice_vol_2
931 integer :: n_comp_1, n_comp_2, n_comp_1_new, n_comp_2_new, i
934 integer,
allocatable :: sample(:)
936 call assert(203741686,
size(aero_particle_1%vol) &
937 ==
size(aero_particle_2%vol))
938 aero_particle_new%vol = aero_particle_1%vol + aero_particle_2%vol
939 aero_particle_new%weight_group = 0
940 aero_particle_new%weight_class = 0
941 n_swbands =
size(aero_particle_1%absorb_cross_sect)
948 aero_particle_new%absorb_cross_sect = 0d0
949 aero_particle_new%scatter_cross_sect = 0d0
950 aero_particle_new%asymmetry = 0d0
951 aero_particle_new%refract_shell = (0d0, 0d0)
952 aero_particle_new%refract_core = (0d0, 0d0)
953 aero_particle_new%core_vol = 0d0
954 if ((aero_particle_1%water_hyst_leg == 1) &
955 .and. (aero_particle_2%water_hyst_leg == 1))
then
956 aero_particle_new%water_hyst_leg = 1
958 aero_particle_new%water_hyst_leg = 0
960 aero_particle_new%id = 0
962 call assert_msg(465791384, aero_particle_1%n_primary_parts >= &
963 n_comp_1,
'n_primary_parts = ' &
965 //
' is less than n_components = ' &
968 call assert_msg(465791385, aero_particle_2%n_primary_parts >= &
969 n_comp_2,
'n_primary_parts = ' &
971 //
' is less than n_components = ' &
974 n_comp_1_new =
prob_round(real(aero_particle_1%n_primary_parts, &
975 kind=
dp) / (aero_particle_1%n_primary_parts &
980 do i = 1,n_comp_1_new
981 new_aero_component(i) = aero_particle_1%component(sample(i))
984 do i = 1,n_comp_2_new
985 new_aero_component(i+n_comp_1_new) = aero_particle_2%component( &
988 aero_particle_new%component = new_aero_component
990 new_aero_component = [aero_particle_1%component, &
991 aero_particle_2%component]
992 call move_alloc(new_aero_component, aero_particle_new%component)
994 aero_particle_new%least_create_time = &
995 min(aero_particle_1%least_create_time, &
996 aero_particle_2%least_create_time)
997 aero_particle_new%greatest_create_time = &
998 max(aero_particle_1%greatest_create_time, &
999 aero_particle_2%greatest_create_time)
1000 aero_particle_new%frozen = aero_particle_1%frozen .OR. &
1001 aero_particle_2%frozen
1005 aero_particle_new%imf_temperature = max(aero_particle_1%imf_temperature, &
1006 aero_particle_2%imf_temperature)
1008 if (aero_particle_new%frozen)
then
1009 ice_vol_1 = aero_particle_1%vol(aero_data%i_water)
1010 ice_vol_2 = aero_particle_2%vol(aero_data%i_water)
1012 if (aero_particle_1%frozen .and. aero_particle_2%frozen)
then
1013 ice_vol_1 = aero_particle_1%vol(aero_data%i_water) * &
1014 const%water_density / aero_particle_1%den_ice
1015 ice_vol_2 = aero_particle_2%vol(aero_data%i_water) * &
1016 const%water_density / aero_particle_2%den_ice
1017 aero_particle_new%den_ice = (aero_particle_1%den_ice * ice_vol_1 + &
1018 aero_particle_2%den_ice * ice_vol_2) / (ice_vol_1 + ice_vol_2)
1019 else if(aero_particle_1%frozen)
then
1020 aero_particle_new%den_ice = aero_particle_1%den_ice
1022 aero_particle_new%den_ice = aero_particle_2%den_ice
1024 aero_particle_new%ice_shape_phi = 1d0
1026 aero_particle_new%den_ice =
const%nan
1030 aero_particle_new%n_primary_parts = aero_particle_1%n_primary_parts &
1031 + aero_particle_2%n_primary_parts
1043 if (
allocated(particle%component))
then
1095 character,
intent(inout) :: buffer(:)
1097 integer,
intent(inout) :: position
1102 integer :: prev_position, i
1104 prev_position = position
1128 call assert(810223998, position - prev_position &
1140 character,
intent(inout) :: buffer(:)
1142 integer,
intent(inout) :: position
1147 integer :: prev_position, n_components, i
1149 prev_position = position
1162 if (n_components > -1)
then
1163 allocate(val%component(n_components))
1165 do i = 1,n_components
1175 call assert(287447241, position - prev_position &
1192 logical,
intent(in) :: continue_on_error
1194 if (
allocated(aero_particle%vol))
then
1196 write(0, *)
'ERROR aero_particle A:'
1197 write(0, *)
'size(aero_particle%vol)',
size(aero_particle%vol)
1198 write(0, *)
'aero_data_n_spec(aero_data)', &
1200 call assert(185878626, continue_on_error)