61#define NUM_LAYERS_ this%condensed_data_int(1)
62#define AERO_REP_ID_ this%condensed_data_int(2)
63#define MAX_PARTICLES_ this%condensed_data_int(3)
64#define PARTICLE_STATE_SIZE_ this%condensed_data_int(4)
65#define NUM_INT_PROP_ 4
66#define NUM_REAL_PROP_ 0
67#define NUM_ENV_PARAM_PER_PARTICLE_ 1
68#define LAYER_PHASE_START_(l) this%condensed_data_int(NUM_INT_PROP_+l)
69#define LAYER_PHASE_END_(l) this%condensed_data_int(NUM_INT_PROP_+NUM_LAYERS_+l)
70#define TOTAL_NUM_PHASES_ (LAYER_PHASE_END_(NUM_LAYERS_))
71#define NUM_PHASES_(l) (LAYER_PHASE_END_(l)-LAYER_PHASE_START_(l)+1)
72#define PHASE_STATE_ID_(l,p) this%condensed_data_int(NUM_INT_PROP_+2*NUM_LAYERS_+LAYER_PHASE_START_(l)+p-1)
73#define PHASE_MODEL_DATA_ID_(l,p) this%condensed_data_int(NUM_INT_PROP_+2*NUM_LAYERS_+TOTAL_NUM_PHASES_+LAYER_PHASE_START_(l)+p-1)
74#define PHASE_NUM_JAC_ELEM_(l,p) this%condensed_data_int(NUM_INT_PROP_+2*NUM_LAYERS_+2*TOTAL_NUM_PHASES_+LAYER_PHASE_START_(l)+p-1)
89 type(
string_t),
allocatable,
private :: unique_names_(:)
91 type(
string_t),
allocatable,
private :: layer_names_(:)
93 integer(kind=i_kind) :: state_id_start = -99999
163 procedure :: constructor
171 logical :: is_malloced = .false.
173 integer(kind=i_kind) :: aero_rep_unique_id = 0
194 result(update_data)
bind (c)
197 type(c_ptr) :: update_data
202 update_data, aero_rep_unique_id, particle_id, number_conc) &
206 type(c_ptr),
value :: update_data
208 integer(kind=c_int),
value :: aero_rep_unique_id
210 integer(kind=c_int),
value :: particle_id
212 real(kind=c_double),
value :: number_conc
219 type(c_ptr),
value,
intent(in) :: update_data
254 integer(kind=i_kind),
intent(in) :: spec_state_id
257 type(
string_t),
allocatable :: layer_names_unordered(:)
259 type(
string_t),
allocatable :: cover_names_unordered(:)
262 integer(kind=i_kind),
allocatable :: ordered_layer_id(:)
264 character(len=:),
allocatable :: key_name, layer_name, layer_covers, &
268 integer(kind=i_kind) :: i_particle, i_phase, i_layer, i_aero, curr_id
269 integer(kind=i_kind) :: i_cover, j_phase, j_layer, i_map, curr_phase
270 integer(kind=i_kind) :: num_phases, num_int_param, num_float_param, &
275 key_name =
"maximum computational particles"
277 this%property_set%get_int(key_name, num_particles), &
278 "Missing maximum number of computational particles")
283 this%property_set%get_property_t(key_name, layers), &
284 "Missing layers for single-particle aerosol "// &
285 "representation '"//this%rep_name//
"'")
286 call assert_msg(168669831, layers%size() .gt. 0, &
287 "No Layers specified for single-particle layer "// &
288 "aerosol representation '"//this%rep_name//
"'")
291 allocate(phases(layers%size()))
292 allocate(cover_names_unordered(layers%size()))
293 allocate(layer_names_unordered(layers%size()))
298 call layers%iter_reset()
299 do i_layer = 1, layers%size()
302 call assert_msg(303808978, layers%get_property_t(val=layer), &
303 "Invalid structure for layer '"// &
304 layer_names_unordered(i_layer)%string// &
305 "' in single-particle layer representation '"// &
310 call assert_msg(364496472, layer%get_string(key_name, layer_name), &
311 "Missing layer name in single-particle layer aerosol "// &
312 "representation '"//this%rep_name//
"'")
313 layer_names_unordered(i_layer)%string = layer_name
317 call assert_msg(350939595, layer%get_string(key_name, layer_covers), &
318 "Missing cover name in layer'"// &
319 layer_names_unordered(i_layer)%string// &
320 "' in single-particle layer aerosol representation '"// &
322 cover_names_unordered(i_layer)%string = layer_covers
327 layer%get_property_t(key_name, phases(i_layer)%val_), &
328 "Missing phases for layer '"// &
329 layer_names_unordered(i_layer)%string// &
330 "' in single-particle layer aerosol representation '"// &
334 call assert_msg(002679882, phases(i_layer)%val_%size().gt.0, &
335 "No phases specified for layer '"// &
336 layer_names_unordered(i_layer)%string// &
337 "' in single-particle layer aerosol representation '"// &
341 num_phases = num_phases + phases(i_layer)%val_%size()
343 call layers%iter_next()
348 cover_names_unordered)
351 allocate(this%layer_names_(
size(ordered_layer_id)))
352 this%layer_names_(:) = layer_names_unordered(ordered_layer_id(:))
355 num_int_param = num_int_prop_ + 2 * layers%size() + 3 * num_phases
356 num_float_param = num_real_prop_
357 allocate(this%condensed_data_int(num_int_param))
358 allocate(this%condensed_data_real(num_float_param))
359 this%condensed_data_int(:) = int(0, kind=i_kind)
360 this%condensed_data_real(:) = real(0.0, kind=dp)
363 this%num_env_params = num_env_param_per_particle_ * num_particles
366 num_layers_ = layers%size()
367 max_particles_ = num_particles
372 allocate(this%aero_phase(num_phases * num_particles))
373 allocate(this%aero_phase_is_at_surface(num_phases * num_particles))
375 do i_layer = 1,
size(ordered_layer_id)
376 j_layer = ordered_layer_id(i_layer)
379 layer_phase_start_(i_layer) = curr_phase
380 layer_phase_end_(i_layer) = curr_phase + phases(j_layer)%val_%size() - 1
382 curr_phase = curr_phase + phases(j_layer)%val_%size()
388 do i_layer = 1,
size(ordered_layer_id)
389 j_layer = ordered_layer_id(i_layer)
391 call phases(j_layer)%val_%iter_reset()
392 do i_phase = 1, phases(j_layer)%val_%size()
396 phases(j_layer)%val_%get_string(val=phase_name), &
397 "Non-string phase name for layer '"// &
398 layer_names_unordered(j_layer)%string// &
399 "' in single-particle layer aerosol representation '"// &
403 do j_phase = 1,
size(aero_phase_set)
404 if (aero_phase_set(j_phase)%val%name() .eq. phase_name)
then
406 do i_particle = 0, num_particles-1
407 this%aero_phase(i_particle*num_phases + curr_phase) = &
408 aero_phase_set(j_phase)
409 if (i_layer .eq. num_layers_)
then
410 this%aero_phase_is_at_surface(i_particle*num_phases + curr_phase) = &
413 this%aero_phase_is_at_surface(i_particle*num_phases + curr_phase) = &
417 phase_state_id_(i_layer,i_phase) = curr_id
418 phase_model_data_id_(i_layer,i_phase) = j_phase
419 curr_id = curr_id + aero_phase_set(j_phase)%val%size()
420 curr_phase = curr_phase + 1
424 call assert(373124707, found)
426 call phases(j_layer)%val_%iter_next()
435 this%unique_names_ = this%unique_names( )
463 integer(kind=i_kind) :: state_size
467 state_size = max_particles_ * particle_state_size_
481 integer(kind=i_kind) :: state_size
485 state_size = particle_state_size_
508 character(len=*),
optional,
intent(in) :: phase_name
510 integer(kind=i_kind),
optional,
intent(in) :: tracer_type
512 character(len=*),
optional,
intent(in) ::
spec_name
514 logical,
optional,
intent(in) :: phase_is_at_surface
516 integer :: i_particle, i_layer, i_phase, i_spec, j_spec
517 integer :: num_spec, curr_tracer_type
518 type(
string_t),
allocatable :: spec_names(:)
521 if (.not.
present(phase_name) .and. &
522 .not.
present(tracer_type) .and. &
524 allocated(this%unique_names_))
then
531 do i_phase = 1,
size(this%aero_phase)
532 if (
present(phase_name))
then
533 if(phase_name .ne. this%aero_phase(i_phase)%val%name()) cycle
535 if (
present(phase_is_at_surface))
then
536 if (phase_is_at_surface .neqv. &
537 this%aero_phase_is_at_surface(i_phase)) cycle
539 if (
present(
spec_name) .or.
present(tracer_type))
then
540 spec_names = this%aero_phase(i_phase)%val%get_species_names()
541 do j_spec = 1,
size(spec_names)
543 if (
spec_name .ne. spec_names(j_spec)%string) cycle
545 if (
present(tracer_type))
then
547 this%aero_phase(i_phase)%val%get_species_type( &
548 spec_names(j_spec)%string)
549 if (tracer_type .ne. curr_tracer_type) cycle
551 num_spec = num_spec + 1
553 deallocate(spec_names)
555 num_spec = num_spec + this%aero_phase(i_phase)%val%size()
560 num_spec = num_spec / max_particles_
563 do i_layer = 1, num_layers_
564 do i_phase = layer_phase_start_(i_layer), layer_phase_end_(i_layer)
565 if (
present(phase_name))
then
566 if(phase_name .ne. this%aero_phase(i_phase)%val%name()) cycle
568 if (
present(phase_is_at_surface))
then
569 if (phase_is_at_surface .neqv. &
570 this%aero_phase_is_at_surface(i_phase)) cycle
572 spec_names = this%aero_phase(i_phase)%val%get_species_names()
573 do j_spec = 1, this%aero_phase(i_phase)%val%size()
575 if (
spec_name .ne. spec_names(j_spec)%string) cycle
577 if (
present(tracer_type))
then
579 this%aero_phase(i_phase)%val%get_species_type( &
580 spec_names(j_spec)%string)
581 if (tracer_type .ne. curr_tracer_type) cycle
583 do i_particle = 1, max_particles_
584 unique_names((i_particle-1)*num_spec+i_spec)%string =
'P'// &
586 this%layer_names_(i_layer)%string//
"."// &
587 this%aero_phase(i_phase)%val%name()//
"."// &
588 spec_names(j_spec)%string
592 deallocate(spec_names)
616 integer(kind=i_kind) :: spec_id
620 character(len=*),
intent(in) :: unique_name
622 integer(kind=i_kind) :: i_spec
624 spec_id = this%state_id_start
625 do i_spec = 1,
size(this%unique_names_)
626 if (this%unique_names_(i_spec)%string .eq. unique_name)
then
629 spec_id = spec_id + 1
631 call die_msg( 449087541,
"Cannot find species '"//unique_name//
"'" )
642 character(len=:),
allocatable ::
spec_name
646 character(len=*),
intent(in) :: unique_name
648 type(string_t) :: l_unique_name
649 type(string_t),
allocatable :: substrs(:)
651 l_unique_name%string = unique_name
652 substrs = l_unique_name%split(
".")
653 call assert(407537518,
size( substrs ) .eq. 4 )
669 character(len=*),
intent(in) :: phase_name
671 logical,
intent(in),
optional :: is_at_surface
673 integer(kind=i_kind) :: i_phase, i_layer, phase_index
676 if (
present(is_at_surface))
then
677 do i_layer = 1, num_layers_
678 do i_phase = layer_phase_start_(i_layer), layer_phase_end_(i_layer)
679 if (this%aero_phase(i_phase)%val%name() .eq. phase_name)
then
680 if (this%aero_phase_is_at_surface(i_phase) .eqv. is_at_surface)
then
687 do i_layer = 1, num_layers_
688 do i_phase = layer_phase_start_(i_layer), layer_phase_end_(i_layer)
689 if (this%aero_phase(i_phase)%val%name() .eq. phase_name)
then
710 integer(kind=i_kind),
intent(in) :: phase_id
712 integer(kind=i_kind) :: i_phase
714 call assert_msg(927040495, phase_id .ge. 1 .and. &
715 phase_id .le.
size( this%aero_phase ), &
716 "Aerosol phase index out of range. Got "// &
717 trim( integer_to_string( phase_id ) )//
", expected 1:"// &
718 trim( integer_to_string(
size( this%aero_phase ) ) ) )
720 do i_phase = 1, total_num_phases_
722 this%aero_phase(i_phase)%val%num_jac_elem()
747 integer,
optional,
intent(in) :: layer
749 if (
present(layer))
then
750 num_phases = layer_phase_end_(layer) - layer_phase_start_(layer) + 1
752 num_phases = layer_phase_end_(num_layers_) - layer_phase_start_(1) + 1
767 integer,
optional,
intent(in) :: layer
769 integer,
optional,
intent(in) :: phase
771 if (
present(layer) .and.
present(phase))
then
772 if (layer .eq. num_layers_ .and. phase .eq. num_phases_(layer))
then
774 phase_state_id_(layer, phase)
775 else if (phase .eq. num_phases_(layer))
then
777 phase_state_id_(layer, phase)
780 phase_state_id_(layer, phase)
782 else if (
present(layer))
then
783 if (layer .eq. num_layers_)
then
785 phase_state_id_(layer, 1)
788 phase_state_id_(layer, 1)
790 else if (
present(phase))
then
791 call die_msg(917793122,
"Must specify layer if including phase is "// &
792 "state size request")
805 phase_name_second)
result(index_pairs)
809 character(len=*),
intent(in) :: phase_name_first
810 character(len=*),
intent(in) :: phase_name_second
811 type(
index_pair_t),
allocatable :: temp_index_pairs(:), index_pairs(:)
813 integer(kind=i_kind),
allocatable :: layer_first(:)
814 integer(kind=i_kind),
allocatable :: layer_second(:)
815 integer(kind=i_kind),
allocatable :: phase_id_first_(:)
816 integer(kind=i_kind),
allocatable :: phase_id_second_(:)
817 integer(kind=i_kind) :: i_layer, i_phase, i_instance, j_phase
819 allocate(layer_first(num_layers_))
820 allocate(layer_second(num_layers_))
821 allocate(phase_id_first_(num_layers_))
822 allocate(phase_id_second_(num_layers_))
825 phase_id_first_ = -9999
826 phase_id_second_ = -9999
830 do i_layer = 1, num_layers_
831 do i_phase = 1, num_phases_(i_layer)
832 if (phase_name_first .eq. phase_name_second)
then
833 if (this%aero_phase(i_instance)%val%name() .eq. phase_name_first)
then
834 layer_first(i_layer) = phase_model_data_id_(i_layer, i_phase)
835 phase_id_first_(i_layer) = i_instance
838 if (this%aero_phase(i_instance)%val%name() .eq. phase_name_first)
then
839 layer_first(i_layer) = phase_model_data_id_(i_layer, i_phase)
840 phase_id_first_(i_layer) = i_instance
841 else if (this%aero_phase(i_instance)%val%name() .eq. phase_name_second)
then
842 layer_second(i_layer) = phase_model_data_id_(i_layer, i_phase)
843 phase_id_second_(i_layer) = i_instance
846 i_instance = i_instance + 1
851 allocate(temp_index_pairs(i_instance))
853 do i_layer = 1, num_layers_-1
854 do i_phase = 1, num_phases_(i_layer)
855 do j_phase = 1, num_phases_(i_layer+1)
856 if (phase_name_first .eq. phase_name_second)
then
857 if (layer_first(i_layer) .eq. phase_model_data_id_(i_layer,i_phase) .and. &
858 layer_first(i_layer+1) .eq. phase_model_data_id_(i_layer+1,j_phase))
then
859 temp_index_pairs(i_instance)%first_ = phase_id_first_(i_layer)
860 temp_index_pairs(i_instance)%second_ = phase_id_first_(i_layer+1)
861 i_instance = i_instance + 1
864 if (layer_first(i_layer) .eq. phase_model_data_id_(i_layer, i_phase) .and. &
865 layer_second(i_layer+1) .eq. phase_model_data_id_(i_layer+1, j_phase))
then
866 temp_index_pairs(i_instance)%first_ = phase_id_first_(i_layer)
867 temp_index_pairs(i_instance)%second_ = phase_id_second_(i_layer+1)
868 i_instance = i_instance + 1
869 else if (layer_second(i_layer) .eq. phase_model_data_id_(i_layer, i_phase) .and. &
870 layer_first(i_layer+1) .eq. phase_model_data_id_(i_layer+1, j_phase))
then
871 temp_index_pairs(i_instance)%first_ = phase_id_second_(i_layer)
872 temp_index_pairs(i_instance)%second_ = phase_id_first_(i_layer+1)
873 i_instance = i_instance + 1
880 allocate(index_pairs(i_instance-1))
881 index_pairs(:)%first_ = temp_index_pairs(1:i_instance-1)%first_
882 index_pairs(:)%second_ = temp_index_pairs(1:i_instance-1)%second_
883 deallocate(temp_index_pairs)
895 if (
allocated(this%rep_name))
deallocate(this%rep_name)
896 if (
allocated(this%aero_phase))
then
898 call this%aero_phase(:)%dereference()
899 deallocate(this%aero_phase)
901 if (
allocated(this%unique_names_))
deallocate(this%unique_names_)
902 if (
allocated(this%layer_names_))
deallocate(this%layer_names_)
903 if (
associated(this%property_set))
deallocate(this%property_set)
904 if (
allocated(this%condensed_data_real)) &
905 deallocate(this%condensed_data_real)
906 if (
allocated(this%condensed_data_int)) &
907 deallocate(this%condensed_data_int)
919 integer(kind=i_kind) :: i_aero
921 do i_aero = 1,
size(this_array)
940 integer(kind=i_kind),
intent(in) :: aero_rep_type
943 if (aero_rep_id_.eq.-1)
then
947 update_data%aero_rep_unique_id = aero_rep_id_
948 update_data%maximum_computational_particles = &
949 this%maximum_computational_particles( )
950 update_data%aero_rep_type = int(aero_rep_type, kind=c_int)
951 update_data%update_data = &
953 update_data%is_malloced = .true.
963 type(string_t),
intent(in) :: layer_names_unordered(:)
965 type(string_t),
intent(in) :: cover_names_unordered(:)
969 integer(kind=i_kind) :: i_layer, j_layer, i_cover
972 do i_layer = 1,
size(layer_names_unordered)
973 do j_layer = 1,
size(layer_names_unordered)
974 if (i_layer .eq. j_layer) cycle
975 call assert_msg(781626922, layer_names_unordered(i_layer)%string .ne. &
976 layer_names_unordered(j_layer)%string, &
977 "Duplicate layer name in single particle "// &
978 "representation: '"// &
979 trim(layer_names_unordered(i_layer)%string)//
"'")
986 do i_layer = 1,
size(layer_names_unordered)
987 if (cover_names_unordered(i_layer)%string ==
"none")
then
994 do i_layer = 1,
size(layer_names_unordered)
996 .eq. cover_names_unordered(i_layer)%string)
then
1015 integer(kind=i_kind),
intent(in) :: particle_id
1017 real(kind=dp),
intent(in) :: number_conc
1019 call assert_msg(611967802, this%is_malloced, &
1020 "Trying to set number of uninitialized update object.")
1021 call assert_msg(689085496, particle_id .ge. 1 .and. &
1022 particle_id .le. this%maximum_computational_particles, &
1023 "Invalid computational particle index: "// &
1024 trim(integer_to_string(particle_id)))
1026 this%get_data(), this%aero_rep_unique_id, particle_id-1, &
1040 integer,
intent(in) :: comm
1057 character,
intent(inout) :: buffer(:)
1059 integer,
intent(inout) :: pos
1061 integer,
intent(in) :: comm
1064 integer :: prev_position
1069 this%maximum_computational_particles, comm)
1071 call assert(411585487, &
1072 pos - prev_position <= this%pack_size(comm))
1085 character,
intent(inout) :: buffer(:)
1087 integer,
intent(inout) :: pos
1089 integer,
intent(in) :: comm
1092 integer :: prev_position
1097 this%maximum_computational_particles, comm)
1099 call assert(351557153, &
1100 pos - prev_position <= this%pack_size(comm))
1127 integer(kind=i_kind) :: i_aero
1129 do i_aero = 1,
size(this)
Get the size of the section of the camp_camp_state::camp_state_t::state_var array required for this a...
Initialize the aerosol representation data, validating component data and loading any required inform...
Extending-type binary pack function (Internal use only)
Extending-type binary unpack function (Internal use only)
Extending-type binary pack size (internal use only)
Get the number of Jacobian elements used in calculations of aerosol mass, volume, number,...
Get the number of instances of a specified aerosol phase.
Get the non-unique name of a chemical species by its unique name.
Get a species id on the camp_camp_state::camp_state_t::state_var array by unique name....
Get a list of unique names for each element on the camp_camp_state::camp_state_t::state_var array for...
Free an update data object.
Interface to c aerosol representation functions.
Set a new particle number concentration.
Interface for to_string functions.
The abstract aero_phase_data_t structure and associated subroutines.
subroutine finalize_array(this)
Finalize the aerosol phase data.
type(aero_phase_data_t) function, pointer constructor(phase_name, init_size)
Constructor for aero_phase_data_t.
subroutine finalize(this)
Finalize the aerosol phase data.
integer(kind=i_kind) function pack_size(this, comm)
Determine the size of a binary required to pack the aerosol representation data.
The abstract aero_rep_data_t structure and associated subroutines.
The aero_rep_single_particle_t type and associated subroutines.
integer(kind=i_kind) function internal_pack_size_number(this, comm)
Determine the size of a binary required to pack the reaction data.
subroutine update_data_init_number(this, update_data, aero_rep_type)
Initialize an update data object.
integer function num_layers(this)
Returns the number of layers.
subroutine update_data_number_finalize_array(this)
Finalize an array of number update data objects.
subroutine internal_bin_unpack_number(this, buffer, pos, comm)
Unpack the given value from the buffer, advancing position.
integer(kind=i_kind) function per_particle_size(this)
Get the number of state variables per-particle.
integer(kind=i_kind), parameter, public update_number_conc
subroutine update_data_number_finalize(this)
Finalize a number update data object.
subroutine update_data_set_number__n_m3(this, particle_id, number_conc)
Set packed update data for particle number (#/m3) for a particular computational particle.
integer function, dimension(:), allocatable, public ordered_layer_ids(layer_names_unordered, cover_names_unordered)
Order layer array from inner most layer to outermost.
subroutine internal_bin_pack_number(this, buffer, pos, comm)
Pack the given value to the buffer, advancing position.
type(index_pair_t) function, dimension(:), allocatable adjacent_phases(this, phase_name_first, phase_name_second)
Determine is specified phase(s) exist in adjacent layers. Returns array of phase_ids for adjacent pha...
integer function phase_state_size(this, layer, phase)
Returns the number of state variables for a layer and phase.
integer function num_phases(this, layer)
Returns the number of phases in a layer or overall.
integer(kind=i_kind) function maximum_computational_particles(this)
Returns the maximum nunmber of computational particles.
The camp_state_t structure and associated subroutines.
The chem_spec_data_t structure and associated subroutines.
Wrapper functions for MPI.
subroutine camp_mpi_pack_logical(buffer, position, val, comm)
Packs the given value into the buffer, advancing position.
subroutine camp_mpi_unpack_integer(buffer, position, val, comm)
Unpacks the given value from the buffer, advancing position.
subroutine camp_mpi_unpack_logical(buffer, position, val, comm)
Unpacks the given value from the buffer, advancing position.
integer function camp_mpi_pack_size_logical(val, comm)
Determines the number of bytes required to pack the given value.
subroutine camp_mpi_pack_integer(buffer, position, val, comm)
Packs the given value into the buffer, advancing position.
integer function camp_mpi_pack_size_integer(val, comm)
Determines the number of bytes required to pack the given value.
The property_t structure and associated subroutines.
Random number generators.
integer(kind=i_kind) function generate_int_id()
Generate an integer id Ids will be sequential, and can only be generated by the primary process.
Common utility subroutines.
subroutine assert(code, condition_ok)
Errors unless condition_ok is true.
subroutine die_msg(code, error_msg)
Error immediately.
subroutine assert_msg(code, condition_ok, error_msg)
Errors unless condition_ok is true.
character(len=camp_util_convert_string_len) function integer_to_string(val)
Convert an integer to a string format.
Pointer type for building arrays.
Abstract aerosol representation data type.
Define index_pair array for adjacent_phases functions.
Single particle aerosol representation.
Single particle update number concentration object.
String type for building arrays of string of various size.