15 use camp_rxn_photolysis
24 public :: photolysis_t
30 type(camp_core_t),
pointer :: camp_core => null()
32 real(kind=
dp),
allocatable :: base_rates(:)
34 type(rxn_update_data_photolysis_t),
allocatable :: photo_rxns(:)
37 procedure :: update_rate_constants
39 procedure :: pack_size
43 procedure :: bin_unpack
45 procedure :: print => do_print
49 interface photolysis_t
50 procedure :: constructor
51 end interface photolysis_t
58 function constructor(camp_core)
result(new_obj)
61 type(photolysis_t),
pointer :: new_obj
63 type(camp_core_t),
pointer,
intent(in),
optional :: camp_core
65 character(len=:),
allocatable :: rxn_key, rxn_val, rate_key, str_val
66 real(kind=
dp) :: rate_val
67 integer :: i_mech, i_rxn, i_photo_rxn, n_photo_rxns
68 class(rxn_data_t),
pointer :: rxn
73 if (.not.
present(camp_core))
return
77 rxn_val =
"PHOTOLYSIS"
78 rate_key =
"base rate"
80 call assert(254347663,
associated(camp_core))
81 call assert(689045432, camp_core%is_initialized())
82 call assert(256253197,
associated(camp_core%mechanism))
85 new_obj%camp_core => camp_core
89 do i_mech = 1,
size(camp_core%mechanism)
90 do i_rxn = 1, camp_core%mechanism(i_mech)%val%size()
91 rxn => camp_core%mechanism(i_mech)%val%get_rxn(i_rxn)
92 call assert(106297725, rxn%property_set%get_string(rxn_key, str_val))
93 if (trim(str_val) == rxn_val) n_photo_rxns = n_photo_rxns + 1
100 allocate(new_obj%photo_rxns(n_photo_rxns))
101 allocate(new_obj%base_rates(n_photo_rxns))
102 do i_mech = 1,
size(camp_core%mechanism)
105 do i_rxn = 1, camp_core%mechanism(i_mech)%val%size()
106 rxn => camp_core%mechanism(i_mech)%val%get_rxn(i_rxn)
107 call assert(799145523, rxn%property_set%get_string(rxn_key, str_val))
110 if (trim(str_val) /= rxn_val) cycle
111 i_photo_rxn = i_photo_rxn + 1
115 rxn%property_set%get_real(rate_key, rate_val), &
116 "Missing 'base rate' for photolysis reaction "// &
118 new_obj%base_rates(i_photo_rxn) = rate_val
121 select type (rxn_photo => rxn)
122 class is (rxn_photolysis_t)
123 call camp_core%initialize_update_object(rxn_photo, &
124 new_obj%photo_rxns(i_photo_rxn))
131 end function constructor
136 subroutine update_rate_constants(this)
139 class(photolysis_t),
intent(inout) :: this
144 do i_rxn = 1,
size(this%photo_rxns)
145 call this%photo_rxns(i_rxn)%set_rate(this%base_rates(i_rxn))
146 call this%camp_core%update_data(this%photo_rxns(i_rxn))
149 end subroutine update_rate_constants
154 integer function pack_size(this, comm)
159 class(photolysis_t),
intent(in) :: this
161 integer,
intent(in),
optional :: comm
163 integer :: i_rxn, l_comm
166 if (
present(comm))
then
169 l_comm = mpi_comm_world
172 call assert(127027009,
allocated(this%base_rates))
173 call assert(634138948,
allocated(this%photo_rxns))
179 do i_rxn = 1,
size(this%photo_rxns)
180 pack_size = pack_size + this%photo_rxns(i_rxn)%pack_size(l_comm)
186 end function pack_size
191 subroutine bin_pack(this, buffer, pos, comm)
196 class(photolysis_t),
intent(in) :: this
198 character,
intent(inout) :: buffer(:)
200 integer,
intent(inout) :: pos
202 integer,
intent(in),
optional :: comm
205 integer :: l_comm, i_rxn, prev_position
207 if (
present(comm))
then
210 l_comm = mpi_comm_world
213 call assert(971093983,
allocated(this%base_rates))
214 call assert(913255424,
allocated(this%photo_rxns))
219 do i_rxn = 1,
size(this%photo_rxns)
220 call this%photo_rxns(i_rxn)%bin_pack(buffer, pos, l_comm)
222 call assert(234533342, pos - prev_position <= this%pack_size(l_comm))
225 end subroutine bin_pack
230 subroutine bin_unpack(this, buffer, pos, comm)
235 class(photolysis_t),
intent(out) :: this
237 character,
intent(inout) :: buffer(:)
239 integer,
intent(inout) :: pos
241 integer,
intent(in),
optional :: comm
244 integer :: l_comm, i_rxn, n_rxns, prev_position
246 if (
present(comm))
then
249 l_comm = mpi_comm_world
255 allocate(this%photo_rxns(n_rxns))
256 do i_rxn = 1,
size(this%photo_rxns)
257 call this%photo_rxns(i_rxn)%bin_unpack(buffer, pos, l_comm)
259 call assert(391255154, pos - prev_position <= this%pack_size(l_comm))
262 end subroutine bin_unpack
267 subroutine do_print(this, file_unit)
270 class(photolysis_t),
intent(in) :: this
272 integer,
optional :: file_unit
274 integer :: f_unit, i_rxn
277 if (
present(file_unit)) f_unit = file_unit
279 write(f_unit,*)
"***************************"
280 write(f_unit,*)
"*** Photolysis Data ***"
281 write(f_unit,*)
"***************************"
283 if (
allocated(this%base_rates))
then
284 do i_rxn = 1,
size(this%base_rates)
285 write(f_unit,*)
" photo rxn(",i_rxn,
") = ", this%base_rates(i_rxn)
288 write(f_unit,*)
" No photolysis data"
291 write(f_unit,*)
"***************************"
292 write(f_unit,*)
"*** End Photolysis Data ***"
293 write(f_unit,*)
"***************************"
295 end subroutine do_print