CAMP 1.0.0
Chemistry Across Multiple Phases
sub_model_factory.F90
Go to the documentation of this file.
1! Copyright (C) 2021 Barcelona Supercomputing Center and University of
2! Illinois at Urbana-Champaign
3! SPDX-License-Identifier: MIT
4
5!> \file
6!> The camp_sub_model_factory module.
7
8!> \page camp_sub_model_add CAMP: Adding a Sub Model
9!!
10!! TODO write instructions
11!!
12
13!> The sub_model_factory_t type and associated subroutines
15
16#ifdef CAMP_USE_JSON
17 use json_module
18#endif
19#ifdef CAMP_USE_MPI
20 use mpi
21#endif
22 use camp_constants, only : i_kind, dp
23 use camp_mpi
25 use camp_util, only : die_msg, string_t, assert_msg, &
27
28 ! Use all sub-models
32
33 implicit none
34 private
35
36 public :: sub_model_factory_t
37
38 !> Identifiers for sub-models - used by binary packing/unpacking functions
39 integer(kind=i_kind), parameter, public :: sub_model_unifac = 1
40 integer(kind=i_kind), parameter, public :: sub_model_zsr_aerosol_water = 2
41 integer(kind=i_kind), parameter, public :: sub_model_pdfite = 3
42
43 !> Factory type for sub-models
44 !!
45 !! Provides new instances of type extending sub_model_data_t by name or
46 !! from input file data
48 contains
49 !> Create a new sub-model by type name
50 procedure :: create
51 !> Create a new aerosol representation from input data
52 procedure :: load
53 !> Get the aerosol representation type
54 procedure :: get_type
55 !> Get a new update data object
57 !> Determine the number of bytes required to pack a given sub-model
58 procedure :: pack_size
59 !> Pack a given sub-model onto the buffer, advancing position
60 procedure :: bin_pack
61 !> Unpack a sub-model from the buffer, advancing position
62 procedure :: bin_unpack
63 end type sub_model_factory_t
64
65contains
66
67!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
68
69 !> Create a new sub-model by type name
70 function create(this, type_name) result (new_obj)
71
72 !> A new sub-model
73 class(sub_model_data_t), pointer :: new_obj
74 !> Sub-model factory
75 class(sub_model_factory_t), intent(in) :: this
76 !> Type of the sub-model
77 character(len=*), intent(in) :: type_name
78
79 new_obj => null()
80
81 select case (type_name)
82 case ("SUB_MODEL_PDFITE")
83 new_obj => sub_model_pdfite_t()
84 case ("SUB_MODEL_UNIFAC")
85 new_obj => sub_model_unifac_t()
86 case ("SUB_MODEL_ZSR_AEROSOL_WATER")
88 case default
89 call die_msg(293855421, "Unknown sub-model type: "//type_name)
90 end select
91
92 end function create
93
94!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
95
96 !> Load a sub-model based on its type
97#ifdef CAMP_USE_JSON
98 function load(this, json, j_obj) result (new_obj)
99
100 !> A new sub-model
101 class(sub_model_data_t), pointer :: new_obj
102 !> Sub-model factory
103 class(sub_model_factory_t), intent(in) :: this
104 !> JSON core
105 type(json_core), pointer, intent(in) :: json
106 !> JSON object
107 type(json_value), pointer, intent(in) :: j_obj
108
109 character(kind=json_ck, len=:), allocatable :: unicode_type_name
110 character(len=:), allocatable :: type_name
111 logical(kind=json_lk) :: found
112
113 new_obj => null()
114
115 ! Get the sub-model type
116 call json%get(j_obj, "type", unicode_type_name, found)
117 call assert_msg(447218460, found, 'Missing sub-model type.')
118 type_name = unicode_type_name
119
120 ! Create a new sub-model instance of the type specified
121 new_obj => this%create(type_name)
122
123 ! Load sub-model parameters from the json object
124 call new_obj%load(json, j_obj)
125
126#else
127 !> Generic warning function when no input file support exists
128 function load(this) result (new_obj)
129
130 !> A new sub-model
131 class(sub_model_data_t), pointer :: new_obj
132 !> Sub-model factory
133 class(sub_model_factory_t), intent(in) :: this
134
135 new_obj => null()
136
137 call warn_msg(545649418, "No support for input files.")
138#endif
139 end function load
140
141!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
142
143 !> Get the sub-model type as a constant
144 integer(kind=i_kind) function get_type(this, sub_model) &
145 result(sub_model_data_type)
146
147 !> Sub-model factory
148 class(sub_model_factory_t), intent(in) :: this
149 !> Sub-model to get type of
150 class(sub_model_data_t), intent(in) :: sub_model
151
152 select type (sub_model)
153 type is (sub_model_pdfite_t)
154 sub_model_data_type = sub_model_pdfite
155 type is (sub_model_unifac_t)
156 sub_model_data_type = sub_model_unifac
158 sub_model_data_type = sub_model_zsr_aerosol_water
159 class default
160 call die_msg(695653684, "Unknown sub-model type")
161 end select
162
163 end function get_type
164
165!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
166
167 !> Initialize an update data object
168 subroutine initialize_update_data(this, sub_model, update_data)
169
170 !> Sub-model factory
171 class(sub_model_factory_t), intent(in) :: this
172 !> Sub-model to be updated
173 class(sub_model_data_t), intent(inout) :: sub_model
174 !> Update data object
175 class(sub_model_update_data_t), intent(out) :: update_data
176
177 select type (update_data)
178 class default
179 call die_msg(245232793, "Internal error - update data type missing")
180 end select
181
182 end subroutine initialize_update_data
183
184!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
185
186 !> Determine the size of a binary required to pack a sub-model
187 integer(kind=i_kind) function pack_size(this, sub_model, comm)
188
189 !> Sub-model factory
190 class(sub_model_factory_t) :: this
191 !> Sub-model to pack
192 class(sub_model_data_t), intent(in) :: sub_model
193 !> MPI communicator
194 integer, intent(in) :: comm
195
196 pack_size = camp_mpi_pack_size_integer(int(1, kind=i_kind), comm) + &
197 sub_model%pack_size(comm)
198
199 end function pack_size
200
201!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
202
203 !> Pack the given value to the buffer, advancing position
204 subroutine bin_pack(this, sub_model, buffer, pos, comm)
205
206 !> Sub-model factory
207 class(sub_model_factory_t), intent(in) :: this
208 !> Sub-model to pack
209 class(sub_model_data_t), intent(in) :: sub_model
210 !> Memory buffer
211 character, intent(inout) :: buffer(:)
212 !> Current buffer position
213 integer, intent(inout) :: pos
214 !> MPI communicator
215 integer, intent(in) :: comm
216
217#ifdef CAMP_USE_MPI
218 integer :: sub_model_data_type, i_sub_model, prev_position
219
220 prev_position = pos
221 select type (sub_model)
222 type is (sub_model_pdfite_t)
223 sub_model_data_type = sub_model_pdfite
224 type is (sub_model_unifac_t)
225 sub_model_data_type = sub_model_unifac
227 sub_model_data_type = sub_model_zsr_aerosol_water
228 class default
229 call die_msg(850922257, "Trying to pack sub-model of unknown type.")
230 end select
231 call camp_mpi_pack_integer(buffer, pos, sub_model_data_type, comm)
232 call sub_model%bin_pack(buffer, pos, comm)
233 call assert(340451545, &
234 pos - prev_position <= this%pack_size(sub_model, comm))
235#endif
236
237 end subroutine bin_pack
238
239!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
240
241 !> Unpack the given value to the buffer, advancing position
242 function bin_unpack(this, buffer, pos, comm) result (sub_model)
243
244 !> Unpacked sub-model
245 class(sub_model_data_t), pointer :: sub_model
246 !> Sub-model factory
247 class(sub_model_factory_t), intent(in) :: this
248 !> Memory buffer
249 character, intent(inout) :: buffer(:)
250 !> Current buffer position
251 integer, intent(inout) :: pos
252 !> MPI communicator
253 integer, intent(in) :: comm
254
255#ifdef CAMP_USE_MPI
256 integer :: sub_model_data_type, i_sub_model, prev_position
257
258 prev_position = pos
259 call camp_mpi_unpack_integer(buffer, pos, sub_model_data_type, comm)
260 select case (sub_model_data_type)
261 case (sub_model_pdfite)
262 sub_model => sub_model_pdfite_t()
263 case (sub_model_unifac)
264 sub_model => sub_model_unifac_t()
266 sub_model => sub_model_zsr_aerosol_water_t()
267 case default
268 call die_msg(786366152, "Trying to unpack sub-model of unknown "// &
269 "type: "//trim(to_string(sub_model_data_type)))
270 end select
271 call sub_model%bin_unpack(buffer, pos, comm)
272 call assert(209433801, &
273 pos - prev_position <= this%pack_size(sub_model, comm))
274#endif
275
276 end function bin_unpack
277
278!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
279
280end module camp_sub_model_factory
Interface for to_string functions.
Definition util.F90:32
Physical constants.
Definition constants.F90:9
integer, parameter dp
Kind of a double precision real number.
Definition constants.F90:16
integer, parameter i_kind
Kind of an integer.
Definition constants.F90:21
Wrapper functions for MPI.
Definition mpi.F90:13
subroutine camp_mpi_unpack_integer(buffer, position, val, comm)
Unpacks the given value from the buffer, advancing position.
Definition mpi.F90:1023
subroutine camp_mpi_pack_integer(buffer, position, val, comm)
Packs the given value into the buffer, advancing position.
Definition mpi.F90:691
integer function camp_mpi_pack_size_integer(val, comm)
Determines the number of bytes required to pack the given value.
Definition mpi.F90:398
The abstract sub_model_data_t structure and associated subroutines.
subroutine load(this, json, j_obj)
Load a sub-model from an input file.
integer(kind=i_kind) function pack_size(this, comm)
Determine the size of a binary required to pack the reaction data.
subroutine bin_pack(this, buffer, pos, comm)
Pack the given value to the buffer, advancing position.
subroutine bin_unpack(this, buffer, pos, comm)
Unpack the given value from the buffer, advancing position.
The sub_model_factory_t type and associated subroutines.
integer(kind=i_kind) function get_type(this, sub_model)
Get the sub-model type as a constant.
class(sub_model_data_t) function, pointer create(this, type_name)
Create a new sub-model by type name.
integer(kind=i_kind), parameter, public sub_model_zsr_aerosol_water
subroutine initialize_update_data(this, sub_model, update_data)
Initialize an update data object.
integer(kind=i_kind), parameter, public sub_model_unifac
Identifiers for sub-models - used by binary packing/unpacking functions.
integer(kind=i_kind), parameter, public sub_model_pdfite
The sub_model_PDFiTE_t type and associated functions.
The sub_model_UNIFAC_t type and assocatiated subroutines.
The sub_model_ZSR_aerosol_water_t type and associated functions.
Common utility subroutines.
Definition util.F90:9
subroutine assert(code, condition_ok)
Errors unless condition_ok is true.
Definition util.F90:165
subroutine die_msg(code, error_msg)
Error immediately.
Definition util.F90:196
subroutine assert_msg(code, condition_ok, error_msg)
Errors unless condition_ok is true.
Definition util.F90:130
subroutine warn_msg(code, warning_msg, already_warned)
Prints a warning message.
Definition util.F90:90
Abstract sub-model data type.
UNIFAC activity coefficient calculation.
String type for building arrays of string of various size.
Definition util.F90:38