-
Notifications
You must be signed in to change notification settings - Fork 17
Expand file tree
/
Copy pathaero_state.F90
More file actions
3231 lines (2777 loc) · 131 KB
/
aero_state.F90
File metadata and controls
3231 lines (2777 loc) · 131 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
! Copyright (C) 2005-2021 Nicole Riemer and 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 pmc_aero_state module.
!> The aero_state_t structure and assocated subroutines.
module pmc_aero_state
use pmc_aero_particle_array
use pmc_aero_sorted
use pmc_integer_varray
use pmc_bin_grid
use pmc_aero_data
use pmc_aero_particle
use pmc_aero_dist
use pmc_util
use pmc_rand
use pmc_aero_binned
use pmc_mpi
use pmc_spec_file
use pmc_aero_info
use pmc_aero_info_array
use pmc_aero_weight
use pmc_aero_weight_array
#ifdef PMC_USE_MPI
use mpi
#endif
!> MPI tag for mixing particles between processes.
integer, parameter :: AERO_STATE_TAG_MIX = 4987
!> MPI tag for gathering between processes.
integer, parameter :: AERO_STATE_TAG_GATHER = 4988
!> MPI tag for scattering between processes.
integer, parameter :: AERO_STATE_TAG_SCATTER = 4989
!> Single flat weighting scheme.
integer, parameter :: AERO_STATE_WEIGHT_NONE = 1
!> Single flat weighting scheme.
integer, parameter :: AERO_STATE_WEIGHT_FLAT = 2
!> Power-law weighting scheme.
integer, parameter :: AERO_STATE_WEIGHT_POWER = 3
!> Coupled number/mass weighting scheme.
integer, parameter :: AERO_STATE_WEIGHT_NUMMASS = 4
!> Flat weighting by source.
integer, parameter :: AERO_STATE_WEIGHT_FLAT_SOURCE = 5
!> Power-law weighting by source.
integer, parameter :: AERO_STATE_WEIGHT_POWER_SOURCE = 6
!> Coupled number/mass weighting by source.
integer, parameter :: AERO_STATE_WEIGHT_NUMMASS_SOURCE = 7
!> The current collection of aerosol particles.
!!
!! The particles in \c aero_state_t are stored in a single flat
!! array (the \c apa data member), with a sorting into size bins and
!! weight groups/classes possibly stored in the \c aero_sorted data
!! member (if \c valid_sort is true).
!!
!! Every time we remove particles we keep track of the particle ID
!! and the action performed in the aero_info_array_t structure. This
!! is typically cleared each time we output data to disk.
type aero_state_t
!> Linear array of particles.
type(aero_particle_array_t) :: apa
!> Sorting of particles into size bins and weight groups/classes.
type(aero_sorted_t) :: aero_sorted
!> Whether the \c aero_sorted is a correct sorting.
logical :: valid_sort
!> Weighting functions.
type(aero_weight_array_t) :: awa
!> Ideal number of computational particles, per weight group and class.
real(kind=dp), allocatable :: n_part_ideal(:, :)
!> Information on removed particles.
type(aero_info_array_t) :: aero_info_array
#ifdef PMC_USE_CAMP
!> CAMP update number conc cookie
type(aero_rep_update_data_single_particle_number_t) :: update_number
#endif
end type aero_state_t
contains
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Return the current number of particles.
elemental integer function aero_state_n_part(aero_state)
!> Aerosol state.
type(aero_state_t), intent(in) :: aero_state
aero_state_n_part = aero_particle_array_n_part(aero_state%apa)
end function aero_state_n_part
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Read the specification for a weighting type from a spec file.
subroutine spec_file_read_aero_state_weighting_type(file, weighting_type, &
exponent)
!> Spec file.
type(spec_file_t), intent(inout) :: file
!> Aerosol weighting scheme.
integer, intent(out) :: weighting_type
!> Exponent for power-law weighting (only used if \c weight_type
!> is \c AERO_STATE_WEIGHT_POWER).
real(kind=dp), intent(out) :: exponent
character(len=SPEC_LINE_MAX_VAR_LEN) :: weighting_name
!> \page input_format_weight_type Input File Format: Type of aerosol size distribution weighting functions.
!!
!! The weighting function is specified by the parameters:
!! - \b weight_type (string): the type of weighting function ---
!! must be one of: \c flat for flat weighting, \c flat_source for
!! flat weighting by source, \c power for power weighting,
!! \c power_source for power source weighting, \c nummass for number
!! and mass weighting, and \c nummass_source for number and mass
!! weighting by source. If \c weight_type is \c power or \c
!! power_source then the next parameter must also be provided:
!! - \b weighting_exponent (real): the exponent for \c power or
!! \c power_source. Setting the \c exponent to 0 is equivalent to no
!! weighting, while setting the exponent negative uses more
!! computational particles at larger diameters and setting the
!! exponent positive uses more computaitonal partilces at smaller
!! diameters; in practice exponents between 0 and -3 are most useful.
!!
!! See also:
!! - \ref spec_file_format --- the input file text format
call spec_file_read_string(file, 'weight_type', weighting_name)
if (trim(weighting_name) == 'flat') then
weighting_type = AERO_STATE_WEIGHT_FLAT
elseif (trim(weighting_name) == 'power') then
weighting_type = AERO_STATE_WEIGHT_POWER
call spec_file_read_real(file, 'weighting_exponent', exponent)
elseif (trim(weighting_name) == 'nummass') then
weighting_type = AERO_STATE_WEIGHT_NUMMASS
elseif (trim(weighting_name) == 'flat_source') then
weighting_type = AERO_STATE_WEIGHT_FLAT_SOURCE
elseif (trim(weighting_name) == 'power_source') then
weighting_type = AERO_STATE_WEIGHT_POWER_SOURCE
call spec_file_read_real(file, 'weighting_exponent', exponent)
elseif (trim(weighting_name) == 'nummass_source') then
weighting_type = AERO_STATE_WEIGHT_NUMMASS_SOURCE
else
call spec_file_die_msg(920321729, file, &
"Unknown weighting type: " // trim(weighting_name))
end if
end subroutine spec_file_read_aero_state_weighting_type
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Copies weighting information for an \c aero_state.
subroutine aero_state_copy_weight(aero_state_from, aero_state_to)
!> Reference aerosol.
type(aero_state_t), intent(in) :: aero_state_from
!> Already allocated.
type(aero_state_t), intent(inout) :: aero_state_to
aero_state_to%awa = aero_state_from%awa
end subroutine aero_state_copy_weight
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Sets the weighting functions for an \c aero_state.
subroutine aero_state_set_weight(aero_state, aero_data, weight_type, &
exponent)
!> Aerosol to set the weights on.
type(aero_state_t), intent(inout) :: aero_state
!> Aerosol data.
type(aero_data_t), intent(in) :: aero_data
!> Type of weighting scheme to use.
integer, intent(in) :: weight_type
!> Exponent for power-law weighting (only used if \c weight_type
!> is \c AERO_STATE_WEIGHT_POWER).
real(kind=dp), intent(in), optional :: exponent
aero_state%valid_sort = .false.
select case(weight_type)
case(AERO_STATE_WEIGHT_NONE)
case(AERO_STATE_WEIGHT_FLAT)
call aero_weight_array_set_flat(aero_state%awa, 1)
case(AERO_STATE_WEIGHT_POWER)
call assert_msg(656670336, present(exponent), &
"exponent parameter required for AERO_STATE_WEIGHT_POWER")
call aero_weight_array_set_power(aero_state%awa, 1, exponent)
case(AERO_STATE_WEIGHT_NUMMASS)
call aero_weight_array_set_nummass(aero_state%awa, 1)
case(AERO_STATE_WEIGHT_FLAT_SOURCE)
call aero_weight_array_set_flat(aero_state%awa, &
aero_data_n_source(aero_data))
case(AERO_STATE_WEIGHT_POWER_SOURCE)
call assert_msg(102143848, present(exponent), &
"exponent parameter required for AERO_STATE_WEIGHT_POWER")
call aero_weight_array_set_power(aero_state%awa, &
aero_data_n_source(aero_data), exponent)
case(AERO_STATE_WEIGHT_NUMMASS_SOURCE)
call aero_weight_array_set_nummass(aero_state%awa, &
aero_data_n_source(aero_data))
case default
call die_msg(969076992, "unknown weight_type: " &
// trim(integer_to_string(weight_type)))
end select
end subroutine aero_state_set_weight
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Set the ideal number of particles to the given value. The \c
!> aero_state%%awa must be already set correctly.
subroutine aero_state_set_n_part_ideal(aero_state, n_part)
!> Aerosol state (with \c aero_state%%awa set).
type(aero_state_t), intent(inout) :: aero_state
!> Ideal total number of particles.
real(kind=dp), intent(in) :: n_part
integer :: n_group, n_class
n_group = aero_weight_array_n_group(aero_state%awa)
n_class = aero_weight_array_n_class(aero_state%awa)
if (allocated(aero_state%n_part_ideal)) then
deallocate(aero_state%n_part_ideal)
end if
allocate(aero_state%n_part_ideal(n_group, n_class))
aero_state%n_part_ideal = n_part / real(n_group * n_class, kind=dp)
end subroutine aero_state_set_n_part_ideal
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Determine the appropriate weight class for a source.
integer function aero_state_weight_class_for_source(aero_state, source)
!> Aerosol state.
type(aero_state_t), intent(in) :: aero_state
!> Source to find the class for.
integer, intent(in) :: source
integer :: n_class
call assert(932390238, source >= 1)
n_class = aero_weight_array_n_class(aero_state%awa)
! we are either using i_class = i_source or always i_class = n_class = 1
if (n_class > 1) then
call assert(765048788, source <= n_class)
aero_state_weight_class_for_source = source
else
aero_state_weight_class_for_source = 1
end if
end function aero_state_weight_class_for_source
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Returns the total number of particles in an aerosol distribution.
integer function aero_state_total_particles(aero_state, i_group, i_class)
!> Aerosol state.
type(aero_state_t), intent(in) :: aero_state
!> Weight group.
integer, optional, intent(in) :: i_group
!> Weight class.
integer, optional, intent(in) :: i_class
integer :: i_part
if (present(i_group)) then
call assert(908743823, present(i_class))
if (aero_state%valid_sort) then
aero_state_total_particles &
= integer_varray_n_entry( &
aero_state%aero_sorted%group_class%inverse(i_group, i_class))
else
! FIXME: should we just sort?
aero_state_total_particles = 0
do i_part = 1,aero_state_n_part(aero_state)
if ((aero_state%apa%particle(i_part)%weight_group == i_group) &
.and. &
(aero_state%apa%particle(i_part)%weight_class == i_class)) &
then
aero_state_total_particles = aero_state_total_particles + 1
end if
end do
end if
else
aero_state_total_particles = aero_state_n_part(aero_state)
end if
end function aero_state_total_particles
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Returns the total number of particles across all processes.
integer function aero_state_total_particles_all_procs(aero_state, i_group, &
i_class)
!> Aerosol state.
type(aero_state_t), intent(in) :: aero_state
!> Weight group.
integer, optional, intent(in) :: i_group
!> Weight class.
integer, optional, intent(in) :: i_class
call pmc_mpi_allreduce_sum_integer(&
aero_state_total_particles(aero_state, i_group, i_class), &
aero_state_total_particles_all_procs)
end function aero_state_total_particles_all_procs
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Resets an aero_state to have zero particles per bin.
subroutine aero_state_zero(aero_state)
!> State to zero.
type(aero_state_t), intent(inout) :: aero_state
integer :: i, n_bin
call aero_particle_array_zero(aero_state%apa)
aero_state%valid_sort = .false.
call aero_info_array_zero(aero_state%aero_info_array)
end subroutine aero_state_zero
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Add the given particle.
subroutine aero_state_add_particle(aero_state, aero_particle, aero_data, &
allow_resort)
!> Aerosol state.
type(aero_state_t), intent(inout) :: aero_state
!> Particle to add.
type(aero_particle_t), intent(in) :: aero_particle
!> Aerosol data.
type(aero_data_t), intent(in) :: aero_data
!> Whether to allow a resort due to the add.
logical, optional, intent(in) :: allow_resort
if (aero_state%valid_sort) then
call aero_sorted_add_particle(aero_state%aero_sorted, aero_state%apa, &
aero_particle, aero_data, allow_resort)
else
call aero_particle_array_add_particle(aero_state%apa, aero_particle)
end if
end subroutine aero_state_add_particle
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Remove the given particle without recording it.
subroutine aero_state_remove_particle_no_info(aero_state, i_part)
!> Aerosol state.
type(aero_state_t), intent(inout) :: aero_state
!> Index of particle to remove.
integer, intent(in) :: i_part
if (aero_state%valid_sort) then
call aero_sorted_remove_particle(aero_state%aero_sorted, &
aero_state%apa, i_part)
else
call aero_particle_array_remove_particle(aero_state%apa, i_part)
end if
end subroutine aero_state_remove_particle_no_info
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Remove the given particle and record the removal.
subroutine aero_state_remove_particle_with_info(aero_state, i_part, &
aero_info)
!> Aerosol state.
type(aero_state_t), intent(inout) :: aero_state
!> Index of particle to remove.
integer, intent(in) :: i_part
!> Removal info.
type(aero_info_t), intent(in) :: aero_info
call aero_state_remove_particle_no_info(aero_state, i_part)
call aero_info_array_add_aero_info(aero_state%aero_info_array, &
aero_info)
end subroutine aero_state_remove_particle_with_info
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Remove the given particle and possibly record the removal.
subroutine aero_state_remove_particle(aero_state, i_part, &
record_removal, aero_info)
!> Aerosol state.
type(aero_state_t), intent(inout) :: aero_state
!> Index of particle to remove.
integer, intent(in) :: i_part
!> Whether to record the removal in the aero_info_array.
logical, intent(in) :: record_removal
!> Removal info.
type(aero_info_t), intent(in) :: aero_info
if (record_removal) then
call aero_state_remove_particle_with_info(aero_state, i_part, &
aero_info)
else
call aero_state_remove_particle_no_info(aero_state, i_part)
end if
end subroutine aero_state_remove_particle
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Remove a randomly chosen particle from the given bin and return
!> it.
subroutine aero_state_remove_rand_particle_from_bin(aero_state, &
i_bin, i_class, aero_particle)
!> Aerosol state.
type(aero_state_t), intent(inout) :: aero_state
!> Bin number to remove particle from.
integer, intent(in) :: i_bin
!> Weight class to remove particle from.
integer, intent(in) :: i_class
!> Removed particle.
type(aero_particle_t), intent(inout) :: aero_particle
integer :: i_entry, i_part
call assert(742996300, aero_state%valid_sort)
call assert(392182617, integer_varray_n_entry( &
aero_state%aero_sorted%size_class%inverse(i_bin, i_class)) > 0)
i_entry = pmc_rand_int(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)
aero_particle = aero_state%apa%particle(i_part)
call aero_state_remove_particle_no_info(aero_state, i_part)
end subroutine aero_state_remove_rand_particle_from_bin
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Add copies or remove a particle, with a given mean number of
!> resulting particles.
!!
!! The particle number \c i_part is either removed, or zero or more
!! copies are added, with a random number of copies with the given
!! mean \c n_part_mean. The final number of particles is either
!! <tt>floor(n_part_mean)</tt> or <tt>ceiling(n_part_mean)</tt>,
!! chosen randomly so the mean is \c n_part_mean.
subroutine aero_state_dup_particle(aero_state, aero_data, i_part, &
n_part_mean, random_weight_group)
!> Aerosol state.
type(aero_state_t), intent(inout) :: aero_state
!> Aerosol data.
type(aero_data_t), intent(in) :: aero_data
!> Particle number.
integer, intent(in) :: i_part
!> Mean number of resulting particles.
real(kind=dp), intent(in) :: n_part_mean
!> Whether particle copies should be placed in a randomly chosen
!> weight group.
logical, optional, intent(in) :: random_weight_group
integer :: n_copies, i_dup, new_group
type(aero_particle_t) :: new_aero_particle
type(aero_info_t) :: aero_info
n_copies = prob_round(n_part_mean)
if (n_copies == 0) then
aero_info%id = aero_state%apa%particle(i_part)%id
aero_info%action = AERO_INFO_WEIGHT
aero_info%other_id = 0
call aero_state_remove_particle_with_info(aero_state, &
i_part, aero_info)
elseif (n_copies > 1) then
do i_dup = 1,(n_copies - 1)
new_aero_particle = aero_state%apa%particle(i_part)
call aero_particle_new_id(new_aero_particle)
if (present(random_weight_group)) then
if (random_weight_group) then
new_group &
= aero_weight_array_rand_group(aero_state%awa, &
aero_state%apa%particle(i_part)%weight_class, &
aero_particle_radius(aero_state%apa%particle(i_part), &
aero_data))
call aero_particle_set_weight(new_aero_particle, new_group)
end if
end if
call aero_state_add_particle(aero_state, new_aero_particle, &
aero_data)
end do
end if
end subroutine aero_state_dup_particle
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> The number concentration of a single particle (m^{-3}).
real(kind=dp) function aero_state_particle_num_conc(aero_state, &
aero_particle, aero_data)
!> Aerosol state containing the particle.
type(aero_state_t), intent(in) :: aero_state
!> Aerosol particle.
type(aero_particle_t), intent(in) :: aero_particle
!> Aerosol data.
type(aero_data_t), intent(in) :: aero_data
aero_state_particle_num_conc &
= aero_weight_array_num_conc(aero_state%awa, aero_particle, &
aero_data)
end function aero_state_particle_num_conc
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Save the correct number concentrations for later use by
!> aero_state_reweight().
subroutine aero_state_num_conc_for_reweight(aero_state, aero_data, &
reweight_num_conc)
!> Aerosol state.
type(aero_state_t), intent(in) :: aero_state
!> Aerosol data.
type(aero_data_t), intent(in) :: aero_data
!> Number concentrations for later use by aero_state_reweight().
real(kind=dp), intent(out) &
:: reweight_num_conc(aero_state_n_part(aero_state))
integer :: i_part
do i_part = 1,aero_state_n_part(aero_state)
reweight_num_conc(i_part) &
= aero_weight_array_single_num_conc(aero_state%awa, &
aero_state%apa%particle(i_part), aero_data)
end do
end subroutine aero_state_num_conc_for_reweight
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Reweight all particles after their constituent volumes have been
!> altered.
!!
!! The pattern for use should be like:
!! <pre>
!! call aero_state_num_conc_for_reweight(aero_state, aero_data,
!! reweight_num_conc)
!! ... alter particle species volumes in aero_state ...
!! call aero_state_reweight(aero_state, aero_data, reweight_num_conc)
!! </pre>
subroutine aero_state_reweight(aero_state, aero_data, reweight_num_conc)
!> Aerosol state.
type(aero_state_t), intent(inout) :: aero_state
!> Aerosol data.
type(aero_data_t), intent(in) :: aero_data
!> Number concentrations previously computed by
!> aero_state_num_conc_for_reweight().
real(kind=dp), intent(in) &
:: reweight_num_conc(aero_state_n_part(aero_state))
integer :: i_part, i_group, i_class
real(kind=dp) :: n_part_old(size(aero_state%awa%weight, 1), &
size(aero_state%awa%weight, 2))
real(kind=dp) :: n_part_new(size(aero_state%awa%weight, 1), &
size(aero_state%awa%weight, 2))
real(kind=dp) :: old_num_conc, new_num_conc, n_part_mean
! find average number of new particles in each weight group, if
! weight is not changed
n_part_old = 0d0
n_part_new = 0d0
do i_part = 1,aero_state_n_part(aero_state)
old_num_conc = reweight_num_conc(i_part)
new_num_conc = aero_weight_array_single_num_conc(aero_state%awa, &
aero_state%apa%particle(i_part), aero_data)
n_part_mean = old_num_conc / new_num_conc
i_group = aero_state%apa%particle(i_part)%weight_group
i_class = aero_state%apa%particle(i_part)%weight_class
n_part_new(i_group, i_class) = n_part_new(i_group, i_class) &
+ n_part_mean
n_part_old(i_group, i_class) = n_part_old(i_group, i_class) + 1d0
end do
! alter weight to leave the number of computational particles
! per weight bin unchanged
do i_group = 1,size(aero_state%awa%weight, 1)
do i_class = 1,size(aero_state%awa%weight, 2)
if (n_part_old(i_group, i_class) == 0d0) cycle
call aero_weight_scale(aero_state%awa%weight(i_group, i_class), &
n_part_new(i_group, i_class) / n_part_old(i_group, i_class))
end do
end do
! work backwards so any additions and removals will only affect
! particles that we've already dealt with
do i_part = aero_state_n_part(aero_state),1,-1
old_num_conc = reweight_num_conc(i_part)
new_num_conc &
= aero_weight_array_single_num_conc(aero_state%awa, &
aero_state%apa%particle(i_part), aero_data)
n_part_mean = old_num_conc / new_num_conc
call aero_state_dup_particle(aero_state, aero_data, i_part, &
n_part_mean)
end do
end subroutine aero_state_reweight
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> <tt>aero_state += aero_state_delta</tt>, including combining the
!> weights, so the new concentration is the weighted average of the
!> two concentrations.
subroutine aero_state_add(aero_state, aero_state_delta, aero_data)
!> Aerosol state.
type(aero_state_t), intent(inout) :: aero_state
!> Increment.
type(aero_state_t), intent(in) :: aero_state_delta
!> Aerosol data.
type(aero_data_t), intent(in) :: aero_data
call aero_state_add_particles(aero_state, aero_state_delta, aero_data)
call aero_weight_array_combine(aero_state%awa, aero_state_delta%awa)
end subroutine aero_state_add
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> <tt>aero_state += aero_state_delta</tt>, with the weight
!> of \c aero_state left unchanged, so the new concentration is the
!> sum of the two concentrations, computed with \c aero_state%%awa.
subroutine aero_state_add_particles(aero_state, aero_state_delta, aero_data)
!> Aerosol state.
type(aero_state_t), intent(inout) :: aero_state
!> Increment.
type(aero_state_t), intent(in) :: aero_state_delta
!> Aerosol data.
type(aero_data_t), intent(in) :: aero_data
integer :: i_part, i_bin
do i_part = 1,aero_state_delta%apa%n_part
call aero_state_add_particle(aero_state, &
aero_state_delta%apa%particle(i_part), aero_data)
end do
call aero_info_array_add(aero_state%aero_info_array, &
aero_state_delta%aero_info_array)
end subroutine aero_state_add_particles
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Change the weight if necessary to ensure that the addition of
!> about \c n_add computational particles will give the correct
!> final particle number.
subroutine aero_state_prepare_weight_for_add(aero_state, aero_data, &
i_group, i_class, n_add, allow_doubling, allow_halving)
!> Aero state to add to.
type(aero_state_t), intent(inout) :: aero_state
!> Aerosol data.
type(aero_data_t), intent(in) :: aero_data
!> Weight group number to add to.
integer, intent(in) :: i_group
!> Weight class number to add to.
integer, intent(in) :: i_class
!> Approximate number of particles to be added at current weighting.
real(kind=dp), intent(in) :: n_add
!> Whether to allow doubling of the population.
logical, intent(in) :: allow_doubling
!> Whether to allow halving of the population.
logical, intent(in) :: allow_halving
integer :: global_n_part, n_group, n_class
real(kind=dp) :: mean_n_part, n_part_new, weight_ratio
real(kind=dp) :: n_part_ideal_local_group
n_group = aero_weight_array_n_group(aero_state%awa)
n_class = aero_weight_array_n_class(aero_state%awa)
global_n_part = aero_state_total_particles_all_procs(aero_state, &
i_group, i_class)
mean_n_part = real(global_n_part, kind=dp) / real(pmc_mpi_size(), kind=dp)
n_part_new = mean_n_part + n_add
if (n_part_new == 0d0) return
n_part_ideal_local_group = aero_state%n_part_ideal(i_group, i_class) &
/ real(pmc_mpi_size(), kind=dp)
if ((n_part_new < n_part_ideal_local_group / 2d0) &
.or. (n_part_new > n_part_ideal_local_group * 2d0)) &
then
weight_ratio = n_part_new / n_part_ideal_local_group
call aero_state_scale_weight(aero_state, aero_data, i_group, &
i_class, weight_ratio, allow_doubling, allow_halving)
end if
end subroutine aero_state_prepare_weight_for_add
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Generates a Poisson sample of an \c aero_dist, adding to \c
!> aero_state, with the given sample proportion.
subroutine aero_state_add_aero_dist_sample(aero_state, aero_data, &
aero_dist, sample_prop, create_time, allow_doubling, allow_halving, &
n_part_add)
!> Aero state to add to.
type(aero_state_t), intent(inout) :: aero_state
!> Aero data values.
type(aero_data_t), intent(in) :: aero_data
!> Distribution to sample.
type(aero_dist_t), intent(in) :: aero_dist
!> Fraction to sample (1).
real(kind=dp), intent(in) :: sample_prop
!> Creation time for new particles (s).
real(kind=dp), intent(in) :: create_time
!> Whether to allow doubling of the population.
logical, intent(in) :: allow_doubling
!> Whether to allow halving of the population.
logical, intent(in) :: allow_halving
!> Number of particles added.
integer, intent(out), optional :: n_part_add
real(kind=dp) :: n_samp_avg, radius, total_vol
real(kind=dp) :: vols(aero_data_n_spec(aero_data))
integer :: n_samp, i_mode, i_samp, i_group, i_class, n_group, n_class
type(aero_particle_t) :: aero_particle
n_group = size(aero_state%awa%weight, 1)
n_class = size(aero_state%awa%weight, 2)
if (present(n_part_add)) then
n_part_add = 0
end if
do i_group = 1,n_group
do i_mode = 1,aero_dist_n_mode(aero_dist)
i_class = aero_state_weight_class_for_source(aero_state, &
aero_dist%mode(i_mode)%source)
! adjust weight if necessary
n_samp_avg = sample_prop * aero_mode_number(aero_dist%mode(i_mode), &
aero_state%awa%weight(i_group, i_class))
call aero_state_prepare_weight_for_add(aero_state, aero_data, &
i_group, i_class, n_samp_avg, allow_doubling, allow_halving)
if (n_samp_avg == 0d0) cycle
! sample particles
n_samp_avg = sample_prop * aero_mode_number(aero_dist%mode(i_mode), &
aero_state%awa%weight(i_group, i_class))
n_samp = rand_poisson(n_samp_avg)
if (present(n_part_add)) then
n_part_add = n_part_add + n_samp
end if
do i_samp = 1,n_samp
call aero_particle_zero(aero_particle, aero_data)
call aero_mode_sample_radius(aero_dist%mode(i_mode), aero_data, &
aero_state%awa%weight(i_group, i_class), radius)
total_vol = aero_data_rad2vol(aero_data, radius)
call aero_mode_sample_vols(aero_dist%mode(i_mode), total_vol, &
vols)
call aero_particle_set_vols(aero_particle, vols)
call aero_particle_new_id(aero_particle)
call aero_particle_set_weight(aero_particle, i_group, i_class)
call aero_particle_set_create_time(aero_particle, create_time)
call aero_particle_set_source(aero_particle, &
aero_dist%mode(i_mode)%source)
call aero_state_add_particle(aero_state, aero_particle, aero_data)
end do
end do
end do
end subroutine aero_state_add_aero_dist_sample
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Choose a random particle from the aero_state.
subroutine aero_state_rand_particle(aero_state, i_part)
!> Original state.
type(aero_state_t), intent(in) :: aero_state
!> Chosen random particle number.
integer, intent(out) :: i_part
call assert(950725003, aero_state_n_part(aero_state) > 0)
i_part = pmc_rand_int(aero_state_n_part(aero_state))
end subroutine aero_state_rand_particle
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Generates a random sample by removing particles from
!> aero_state_from and adding them to aero_state_to, which must be
!> already allocated (and should have its weight set).
!!
!! None of the weights are altered by this sampling, making this the
!! equivalent of aero_state_add_particles().
subroutine aero_state_sample_particles(aero_state_from, aero_state_to, &
aero_data, sample_prob, removal_action)
!> Original state.
type(aero_state_t), intent(inout) :: aero_state_from
!> Destination state.
type(aero_state_t), intent(inout) :: aero_state_to
!> Aerosol data.
type(aero_data_t), intent(in) :: aero_data
!> Probability of sampling each particle.
real(kind=dp), intent(in) :: sample_prob
!> Action for removal (see pmc_aero_info module for action
!> parameters). Set to AERO_INFO_NONE to not log removal.
integer, intent(in) :: removal_action
integer :: n_transfer, i_transfer, i_part
logical :: do_add, do_remove
real(kind=dp) :: num_conc_from, num_conc_to
type(aero_info_t) :: aero_info
call assert(721006962, (sample_prob >= 0d0) .and. (sample_prob <= 1d0))
call aero_state_zero(aero_state_to)
call aero_state_copy_weight(aero_state_from, aero_state_to)
n_transfer = rand_binomial(aero_state_total_particles(aero_state_from), &
sample_prob)
i_transfer = 0
do while (i_transfer < n_transfer)
if (aero_state_total_particles(aero_state_from) <= 0) exit
call aero_state_rand_particle(aero_state_from, i_part)
num_conc_from = aero_weight_array_num_conc(aero_state_from%awa, &
aero_state_from%apa%particle(i_part), aero_data)
num_conc_to = aero_weight_array_num_conc(aero_state_to%awa, &
aero_state_from%apa%particle(i_part), aero_data)
if (num_conc_to == num_conc_from) then ! add and remove
do_add = .true.
do_remove = .true.
elseif (num_conc_to < num_conc_from) then ! always add, maybe remove
do_add = .true.
do_remove = .false.
if (pmc_random() < num_conc_to / num_conc_from) then
do_remove = .true.
end if
else ! always remove, maybe add
do_add = .false.
if (pmc_random() < num_conc_from / num_conc_to) then
do_add = .true.
end if
do_remove = .true.
end if
if (do_add) then
call aero_state_add_particle(aero_state_to, &
aero_state_from%apa%particle(i_part), aero_data)
end if
if (do_remove) then
if (removal_action /= AERO_INFO_NONE) then
aero_info%id = aero_state_from%apa%particle(i_part)%id
aero_info%action = removal_action
call aero_state_remove_particle_with_info(aero_state_from, &
i_part, aero_info)
else
call aero_state_remove_particle_no_info(aero_state_from, &
i_part)
end if
i_transfer = i_transfer + 1
end if
end do
end subroutine aero_state_sample_particles
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Generates a random sample by removing particles from
!> aero_state_from and adding them to aero_state_to, transfering
!> weight as well. This is the equivalent of aero_state_add().
subroutine aero_state_sample(aero_state_from, aero_state_to, &
aero_data, sample_prob, removal_action)
!> Original state.
type(aero_state_t), intent(inout) :: aero_state_from
!> Destination state (previous contents will be lost).
type(aero_state_t), intent(inout) :: aero_state_to
!> Aerosol data.
type(aero_data_t), intent(in) :: aero_data
!> Probability of sampling each particle.
real(kind=dp), intent(in) :: sample_prob
!> Action for removal (see pmc_aero_info module for action
!> parameters). Set to AERO_INFO_NONE to not log removal.
integer, intent(in) :: removal_action
integer :: n_transfer, i_transfer, i_part
logical :: do_add, do_remove, overwrite_to
real(kind=dp) :: num_conc_from, num_conc_to
type(aero_info_t) :: aero_info
call assert(393205561, (sample_prob >= 0d0) .and. (sample_prob <= 1d0))
call aero_state_zero(aero_state_to)
call aero_state_copy_weight(aero_state_from, aero_state_to)
call aero_weight_array_normalize(aero_state_to%awa)
n_transfer = rand_binomial(aero_state_total_particles(aero_state_from), &
sample_prob)
do i_transfer = 1,n_transfer
if (aero_state_total_particles(aero_state_from) <= 0) exit
call aero_state_rand_particle(aero_state_from, i_part)
call aero_state_add_particle(aero_state_to, &
aero_state_from%apa%particle(i_part), aero_data)
if (removal_action /= AERO_INFO_NONE) then
aero_info%id = aero_state_from%apa%particle(i_part)%id
aero_info%action = removal_action
call aero_state_remove_particle_with_info(aero_state_from, &
i_part, aero_info)
else
call aero_state_remove_particle_no_info(aero_state_from, &
i_part)
end if
end do
overwrite_to = .true.
call aero_weight_array_shift(aero_state_from%awa, aero_state_to%awa, &
sample_prob, overwrite_to)
end subroutine aero_state_sample
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Create binned number and mass arrays.
subroutine aero_state_to_binned(bin_grid, aero_data, aero_state, &
aero_binned)
!> Bin grid.
type(bin_grid_t), intent(in) :: bin_grid
!> Aerosol data.
type(aero_data_t), intent(in) :: aero_data
!> Aerosol state.
type(aero_state_t), intent(in) :: aero_state
!> Binned distributions.
type(aero_binned_t), intent(inout) :: aero_binned
integer :: i_part, i_bin
real(kind=dp) :: factor
aero_binned%num_conc = 0d0
aero_binned%vol_conc = 0d0
do i_part = 1,aero_state_n_part(aero_state)
i_bin = bin_grid_find(bin_grid, &
aero_particle_radius(aero_state%apa%particle(i_part), aero_data))
if ((i_bin < 1) .or. (i_bin > bin_grid_size(bin_grid))) then
call warn_msg(980232449, "particle ID " &
// trim(integer_to_string(aero_state%apa%particle(i_part)%id)) &
// " outside of bin_grid, discarding")
else
factor = aero_weight_array_num_conc(aero_state%awa, &
aero_state%apa%particle(i_part), aero_data) &
/ bin_grid%widths(i_bin)
aero_binned%vol_conc(i_bin,:) = aero_binned%vol_conc(i_bin,:) &
+ aero_state%apa%particle(i_part)%vol * factor
aero_binned%num_conc(i_bin) = aero_binned%num_conc(i_bin) &
+ factor
end if
end do
end subroutine aero_state_to_binned
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Returns the IDs of all particles.
function aero_state_ids(aero_state)
!> Aerosol state.
type(aero_state_t), intent(in) :: aero_state
!> Return value.
integer :: aero_state_ids(aero_state_n_part(aero_state))
integer :: i_part
do i_part = 1,aero_state_n_part(aero_state)
aero_state_ids(i_part) = aero_state%apa%particle(i_part)%id
end do
end function aero_state_ids
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!> Returns the diameters of all particles.
function aero_state_diameters(aero_state, aero_data, include, exclude)
!> Aerosol state.
type(aero_state_t), intent(in) :: aero_state
!> Aerosol data.
type(aero_data_t), intent(in) :: aero_data
!> Species names to include in the diameter.
character(len=*), optional, intent(in) :: include(:)
!> Species names to exclude in the diameter.