FMS 2025.01-dev
Flexible Modeling System
Loading...
Searching...
No Matches
atmos_ocean_fluxes.F90
1!***********************************************************************
2!* GNU Lesser General Public License
3!*
4!* This file is part of the GFDL Flexible Modeling System (FMS).
5!*
6!* FMS is free software: you can redistribute it and/or modify it under
7!* the terms of the GNU Lesser General Public License as published by
8!* the Free Software Foundation, either version 3 of the License, or (at
9!* your option) any later version.
10!*
11!* FMS is distributed in the hope that it will be useful, but WITHOUT
12!* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13!* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14!* for more details.
15!*
16!* You should have received a copy of the GNU Lesser General Public
17!* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18!***********************************************************************
19!> @defgroup atmos_ocean_fluxes_mod atmos_ocean_fluxes_mod
20!> @ingroup coupler
21!> @brief Implementation of routines to solve the gas fluxes at the
22!! ocean surface for a coupled model as outlined in the Biotic-HOWTO
23!! documentation below, revision 1.7, 1999/10/05.
24!!
25!> @author Richard Slater, John Dunne
26!!
27!! Ocean Carbon Model Intercomparison Study II: Gas exchange coupler.
28!!
29!! This module will take fields from an atmospheric and an
30!! oceanic model and calculate ocean surface fluxes for
31!! CO2, O2, CFC-11 or CFC-12 as outlined in the various
32!! HOWTO documents at the OCMIP2 website. Multiple instances
33!! of a given tracer may be given, resulting in multiple
34!! surface fluxes. Additionally, data may be overridden at
35!! the individual fields, or fluxes. This could be used in
36!! the absence of an atmospheric or oceanic model.
37
38!> @addtogroup atmos_ocean_fluxes_mod
39!> @{
40module atmos_ocean_fluxes_mod
41 use mpp_mod, only: stdout, mpp_error, fatal, mpp_sum, mpp_npes
42 use fms_mod, only: write_version_number
43
44 use coupler_types_mod, only: coupler_1d_bc_type
45 use coupler_types_mod, only: ind_alpha, ind_csurf, ind_sc_no
46 use coupler_types_mod, only: ind_pcair, ind_u10, ind_psurf
47 use coupler_types_mod, only: ind_deposition
48 use coupler_types_mod, only: ind_runoff
49 use coupler_types_mod, only: ind_flux, ind_deltap, ind_kw, ind_flux0
50
51 use field_manager_mod, only: fm_string_len, fm_exists, fm_get_index
52 use field_manager_mod, only: fm_new_list, fm_get_current_list, fm_change_list
53 use field_manager_mod, only: fm_field_name_len, fm_type_name_len, fm_dump_list
54 use field_manager_mod, only: fm_loop_over_list
55
56 use fm_util_mod, only: fm_util_default_caller
57 use fm_util_mod, only: fm_util_get_length
58 use fm_util_mod, only: fm_util_set_value, fm_util_set_good_name_list
59 use fm_util_mod, only: fm_util_set_no_overwrite, fm_util_set_caller
60 use fm_util_mod, only: fm_util_reset_good_name_list, fm_util_reset_no_overwrite
61 use fm_util_mod, only: fm_util_reset_caller, fm_util_get_string_array
62 use fm_util_mod, only: fm_util_check_for_bad_fields, fm_util_get_string
63 use fm_util_mod, only: fm_util_get_real_array, fm_util_get_real, fm_util_get_integer
64 use fm_util_mod, only: fm_util_get_logical, fm_util_get_logical_array
65 use fms_io_utils_mod, only: get_data_type_string
66 use platform_mod, only: r4_kind, r8_kind, fms_path_len
67
68 implicit none
69 private
70
71 public :: atmos_ocean_fluxes_init
72 public :: atmos_ocean_type_fluxes_init
73 public :: aof_set_coupler_flux
74
75 character(len=*), parameter :: mod_name = 'atmos_ocean_fluxes_mod'
76 real(r8_kind), parameter :: epsln=1.0e-30_r8_kind
77
78
79 ! Include variable "version" to be written to log file.
80#include<file_version.h>
81
82contains
83
84 !> @brief Set the values for a coupler flux
85 !! @return its index (0 on error)
86 !! @throw FATAL, "Empty name given"
87 !! Name is empty
88 !! @throw FATAL, "Could not get coupler flux"
89 !! coupler_index is less than 1
90 !! @throw FATAL, "Could not set coupler flux"
91 !! coupler_index is less than 1
92 !! @throw FATAL, "Could not get the current list"
93 !! Current list is empty
94 !! @throw FATAL, "Could not change to the new list"
95 !! fm_change_list(coupler_list) returns false
96 !! @throw FATAL, "Blank flux_type given"
97 !! flux_type or implementation is empty
98 !! @throw FATAL, "Undefined flux_type given from field_table"
99 !! flux_type does not equal flux_type_test
100 !! @throw FATAL, "Undefined flux_type given as argument to the subroutine"
101 !! flux_type does not equal flux_type_test
102 !! @throw FATAL, "Undefined flux_type/implementation (implementation given from field_table)"
103 !! flux_type does not equal flux_type_test
104 !! @throw FATAL, "Undefined flux_type/implementation (flux_type given from field_table)"
105 !! flux_type does not equal flux_type_test
106 !! @throw FATAL, "Undefined flux_type/implementation (both given from field_table)"
107 !! flux_type does not equal flux_type_test
108 !! @throw FATAL, "Undefined flux_type/implementation given as argument to the subroutine"
109 !! flux_type does not equal flux_type_test
110 !! @throw NOTE, "Number of parameters provided for [variable] does not match the number of parameters required"
111 !! Mismatch between parameter input and the parameters being replaced
112 !! @throw FATAL, "Could not change back to [current_list]"
113 !! @throw FATAL, "Empty [name] list"
114 function aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, param, flag,&
115 & mol_wt, ice_restart_file, ocean_restart_file, units, caller, verbosity) &
116 & result(coupler_index)
117 character(len=*), intent(in) :: name !< name
118 character(len=*), intent(in) :: flux_type !< flux_type
119 character(len=*), intent(in) :: implementation !< implementation
120 integer, intent(in), optional :: atm_tr_index !< atm_tr_index
121 class(*), intent(in), dimension(:), optional :: param !< param
122 logical, intent(in), dimension(:), optional :: flag !< flag
123 class(*), intent(in), optional :: mol_wt !< mol_wt
124 character(len=*), intent(in), optional :: ice_restart_file !< ice_restart_file
125 character(len=*), intent(in), optional :: ocean_restart_file !< ocean_restart_file
126 character(len=*), intent(in), optional :: units !< units
127 character(len=*), intent(in), optional :: caller !< caller
128 integer, intent(in), optional :: verbosity !< A 0-9 integer indicating a level of verbosity.
129
130 integer :: coupler_index
131
132 character(len=*), parameter :: sub_name = 'aof_set_coupler_flux'
133
134 integer :: n
135 integer :: length
136 integer :: num_parameters
137 integer :: outunit
138 character(len=FMS_PATH_LEN) :: coupler_list
139 character(len=FMS_PATH_LEN) :: current_list
140 character(len=fm_string_len) :: flux_type_test
141 character(len=fm_string_len) :: implementation_test
142 character(len=256) :: error_header
143 character(len=256) :: warn_header
144 character(len=256) :: note_header
145 character(len=128) :: flux_list
146 character(len=128) :: caller_str
147 character(len=fm_string_len), pointer, dimension(:) :: good_list => null()
148 character(len=256) :: long_err_msg
149 integer :: verbose !< An integer indicating the level of verbosity.
150 character(len=17) :: err_str
151
152 verbose = 5 ! Default verbosity level
153 if (present(verbosity)) verbose = verbosity
154
155 ! Set the caller string and headers.
156 if (present(caller)) then
157 caller_str = '[' // trim(caller) // ']'
158 else
159 caller_str = fm_util_default_caller
160 endif
161
162 error_header = '==>Error from ' // trim(mod_name) //&
163 & '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
164 warn_header = '==>Warning from ' // trim(mod_name) //&
165 & '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
166 note_header = '==>Note from ' // trim(mod_name) //&
167 & '(' // trim(sub_name) // ')' // trim(caller_str) // ':'
168
169 ! Check that a name is given (fatal if not).
170 if (name .eq. ' ') then
171 call mpp_error(fatal, trim(error_header) // ' Empty name given')
172 endif
173 outunit = stdout()
174 if (verbose >= 5) then
175 write (outunit,*)
176 write (outunit,*) trim(note_header), ' Processing coupler fluxes ', trim(name)
177 endif
178
179 ! Define the coupler list name.
180 coupler_list = '/coupler_mod/fluxes/' // trim(name)
181
182 ! Check whether a flux has already been set for this name, and if so, return the index for it
183 ! (this is because the fluxes may be defined in both the atmosphere and ocean models) (check
184 ! whether the good_list list exists, since this will indicate that this routine has already been
185 ! called, and not just that the field table input has this list defined)
186 if (fm_exists('/coupler_mod/GOOD/fluxes/' // trim(name) // '/good_list')) then
187 if (verbose >= 5) then
188 write (outunit,*)
189 write (outunit,*) trim(note_header), ' Using previously defined coupler flux'
190 endif
191 coupler_index = fm_get_index(coupler_list)
192 if (coupler_index .le. 0) then
193 call mpp_error(fatal, trim(error_header) // ' Could not get coupler flux ')
194 endif
195
196 ! Allow atm_tr_index to be set here, since it will only be set from atmospheric
197 ! PEs, and the atmospheric routines call this routine last, thus overwriting the
198 ! current value is safe (furthermore, this is not a value which could have any meaningful
199 ! value set from the run script.
200 if (present(atm_tr_index)) then
201 if (verbose >= 5) &
202 write (outunit,*) trim(note_header), ' Redefining atm_tr_index to ', atm_tr_index
203 call fm_util_set_value(trim(coupler_list) // '/atm_tr_index', atm_tr_index,&
204 & no_create = .true., no_overwrite = .false., caller = caller_str)
205 endif
206 return
207 endif
208
209 ! Set a new coupler flux and get its index.
210 coupler_index = fm_new_list(coupler_list)
211 if (coupler_index .le. 0) then
212 call mpp_error(fatal, trim(error_header) // ' Could not set coupler flux ')
213 endif
214
215 ! Change to the new list, first saving the current list.
216 current_list = fm_get_current_list()
217 if (current_list .eq. ' ') then
218 call mpp_error(fatal, trim(error_header) // ' Could not get the current list')
219 endif
220
221 if (.not. fm_change_list(coupler_list)) then
222 call mpp_error(fatal, trim(error_header) // ' Could not change to the new list')
223 endif
224
225 ! Set the array in which to save the valid names for this list,
226 ! used later for a consistency check. This is used in the fm_util_set_value
227 ! routines to make the list of valid values.
228 call fm_util_set_good_name_list('/coupler_mod/GOOD/fluxes/' // trim(name) // '/good_list')
229
230 ! Set other defaults for the fm_util_set_value routines.
231 call fm_util_set_no_overwrite(.true.)
232 call fm_util_set_caller(caller_str)
233
234 ! Set various values to given values, or to defaults if not given.
235 if (flux_type .eq. ' ') then
236 call mpp_error(fatal, trim(error_header) // ' Blank flux_type given')
237 else
238 if (fm_exists('/coupler_mod/types/' // trim(flux_type))) then
239 call fm_util_set_value('flux_type', flux_type)
240
241 ! Check that the flux_type that we will use (possibly given from the field_table)
242 ! is defined.
243 flux_type_test = fm_util_get_string('flux_type', scalar = .true.)
244 if (.not. fm_exists('/coupler_mod/types/' // trim(flux_type_test))) then
245 call mpp_error(fatal, trim(error_header) //&
246 & ' Undefined flux_type given from field_table: ' // trim(flux_type_test))
247 endif
248 else
249 call mpp_error(fatal, trim(error_header) //&
250 & ' Undefined flux_type given as argument to the subroutine: ' // trim(flux_type))
251 endif
252 endif
253
254 if (implementation .eq. ' ') then
255 call mpp_error(fatal, trim(error_header) // ' Blank flux_type given')
256 else
257 if (fm_exists('/coupler_mod/types/' // trim(flux_type) // '/implementation/' // trim(implementation))) then
258 call fm_util_set_value('implementation', implementation)
259
260 ! Check that the flux_type/implementation that we will use
261 ! (both possibly given from the field_table) is defined
262 implementation_test = fm_util_get_string('implementation', scalar = .true.)
263 if (.not. fm_exists('/coupler_mod/types/' // trim(flux_type_test) // '/implementation/' // &
264 & trim(implementation_test))) then
265 if (flux_type .eq. flux_type_test) then
266 if (implementation .eq. implementation_test) then
267 call mpp_error(fatal, trim(error_header) // ' Should not get here, as it is tested for above')
268 else
269 call mpp_error(fatal, trim(error_header) //&
270 & ' Undefined flux_type/implementation (implementation given from field_table): ' //&
271 & trim(flux_type_test) // '/implementation/' // trim(implementation_test))
272 endif
273 else
274 if (implementation .eq. implementation_test) then
275 long_err_msg = 'Undefined flux_type/implementation (flux_type given from field_table): '
276 long_err_msg = long_err_msg // trim(flux_type_test) // '/implementation/'&
277 & // trim(implementation_test)
278 call mpp_error(fatal, trim(error_header) // long_err_msg)
279 else
280 long_err_msg = ' Undefined flux_type/implementation (both given from field_table): '
281 long_err_msg = long_err_msg // trim(flux_type_test) // '/implementation/'&
282 & // trim(implementation_test)
283 call mpp_error(fatal, trim(error_header) // long_err_msg)
284 endif
285 endif
286 endif
287 else
288 call mpp_error(fatal, trim(error_header) //&
289 & ' Undefined flux_type/implementation given as argument to the subroutine: ' //&
290 & trim(flux_type) // '/implementation/' // trim(implementation))
291 endif
292 endif
293
294 if (present(atm_tr_index)) then
295 call fm_util_set_value('atm_tr_index', atm_tr_index)
296 else
297 call fm_util_set_value('atm_tr_index', 0)
298 endif
299
300 if (present(mol_wt)) then
301
302 select type(mol_wt)
303 type is (real(r8_kind))
304 call fm_util_set_value('mol_wt', mol_wt)
305 type is (real(r4_kind))
306 call fm_util_set_value('mol_wt', mol_wt)
307 class default
308 call get_data_type_string(mol_wt, err_str)
309 call mpp_error(fatal, "aof_set_coupler_flux: invalid type for passed in mol_wt, type should be" // &
310 "real(r4_kind) or real(r8_kind). Passed in type:"//err_str)
311 end select
312 else
313 call fm_util_set_value('mol_wt', 0.0_r8_kind)
314 endif
315
316 if (present(ice_restart_file)) then
317 call fm_util_set_value('ice_restart_file', ice_restart_file)
318 else
319 call fm_util_set_value('ice_restart_file', 'ice_coupler_fluxes.res.nc')
320 endif
321
322 if (present(ocean_restart_file)) then
323 call fm_util_set_value('ocean_restart_file', ocean_restart_file)
324 else
325 call fm_util_set_value('ocean_restart_file', 'ocean_coupler_fluxes.res.nc')
326 endif
327
328 if (present(param)) then
329 num_parameters = fm_util_get_integer('/coupler_mod/types/' //&
330 & trim(fm_util_get_string('flux_type', scalar = .true.)) // '/implementation/' //&
331 & trim(fm_util_get_string('implementation', scalar = .true.)) // '/num_parameters',&
332 & scalar = .true.)
333 length = min(size(param(:)),num_parameters)
334 if ((length .ne. num_parameters) .and. (verbose >= 5)) then
335 write (outunit,*) trim(note_header), ' Number of parameters provided for ', trim(name), ' does not match the'
336 write (outunit,*) 'number of parameters required (', size(param(:)), ' != ', num_parameters, ').'
337 write (outunit,*) 'This could be an error, or more likely is just a result of the implementation being'
338 write (outunit,*) 'overridden by the field table input'
339 endif
340 if (length .gt. 0) then
341 select type (param)
342 type is (real(r4_kind))
343 call fm_util_set_value('param', param(1:length), length)
344 type is (real(r8_kind))
345 call fm_util_set_value('param', param(1:length), length)
346 class default
347 call get_data_type_string(param, err_str)
348 call mpp_error(fatal, "aof_set_coupler_flux: invalid type for passed in param, type should be" // &
349 "real(r4_kind) or real(r8_kind). Passed in type:"//err_str)
350 end select
351 else
352 call fm_util_set_value('param', 'null', index = 0)
353 endif
354 else
355 call fm_util_set_value('param', 'null', index = 0)
356 endif
357
358 if (present(flag)) then
359 call fm_util_set_value('flag', flag, size(flag(:)))
360 else
361 call fm_util_set_value('flag', .false., index = 0)
362 endif
363
364 flux_list = '/coupler_mod/types/' // trim(flux_type) // '/'
365
366 if (present(units)) then
367 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) // 'flux/name', index = ind_flux)) // '-units',&
368 & units)
369 else
370 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) // 'flux/name', index = ind_flux)) // '-units',&
371 & fm_util_get_string(trim(flux_list) // 'flux/units', index = ind_flux))
372 endif
373
374 do n = 1, fm_util_get_length(trim(flux_list) // 'flux/name')
375 if (n .ne. ind_flux) then
376 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) // 'flux/name', index = n)) // '-units',&
377 & fm_util_get_string(trim(flux_list) // 'flux/units', index = n))
378 endif
379 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) // 'flux/name', index = n)) // '-long_name',&
380 & fm_util_get_string(trim(flux_list) // 'flux/long_name', index = n))
381 enddo ! n
382
383 do n = 1, fm_util_get_length(trim(flux_list) // 'atm/name')
384 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) // 'atm/name', index = n)) //&
385 & '-units', fm_util_get_string(trim(flux_list) // 'atm/units', index = n))
386 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) // 'atm/name', index = n)) // '-long_name',&
387 & fm_util_get_string(trim(flux_list) // 'atm/long_name', index = n))
388 enddo ! n
389
390 do n = 1, fm_util_get_length(trim(flux_list) // 'ice/name')
391 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) // 'ice/name', index = n)) // '-units',&
392 & fm_util_get_string(trim(flux_list) // 'ice/units', index = n))
393 call fm_util_set_value(trim(fm_util_get_string(trim(flux_list) // 'ice/name', index = n)) // '-long_name',&
394 & fm_util_get_string(trim(flux_list) // 'ice/long_name', index = n))
395 enddo ! n
396
397 ! Reset the defaults for the fm_util_set_value calls.
398 call fm_util_reset_good_name_list
399 call fm_util_reset_no_overwrite
400 call fm_util_reset_caller
401
402 ! Change back to the saved current list.
403 if (.not. fm_change_list(current_list)) then
404 call mpp_error(fatal, trim(error_header) // ' Could not change back to ' // trim(current_list))
405 endif
406
407 ! Check for any errors in the number of fields in this list.
408 if (caller_str .eq. ' ') then
409 caller_str = trim(mod_name) // '(' // trim(sub_name) // ')'
410 endif
411 good_list => fm_util_get_string_array('/coupler_mod/GOOD/fluxes/' // trim(name) // '/good_list',&
412 & caller = caller_str)
413 if (associated(good_list)) then
414 call fm_util_check_for_bad_fields(trim(coupler_list), good_list, caller = caller_str)
415 deallocate(good_list)
416 else
417 call mpp_error(fatal, trim(error_header) // ' Empty "' // trim(name) // '" list')
418 endif
419
420 return
421 end function aof_set_coupler_flux
422
423 !> @brief Initialize gas flux structures.
424 !!Will allocate to r8_kind unless use_r4_kind is present and true.
425 !! @throw FATAL, "Could not get number of fluxes"
426 !! Number of gas fluxes is not a valid number
427 !! @throw NOTE, "No gas fluxes"
428 !! No gas fluxes were found
429 !! @throw NOTE, "Processing [gas_fluxes%num_bcs] gas fluxes"
430 !! Gas fluxes were found
431 !! @throw FATAL, "[name] is not a list"
432 !! name needs to be a list, or typ is incorrectly defined
433 !! @throw FATAL, "Flux index, [ind] does not match array index, [n] for [name]"
434 !! @throw FATAL, "Problem changing to [name]"
435 !! @throw FATAL, "Undefined flux_type given for [name]: [gas_fluxes%bc(n)%flux_type]"
436 !! @throw FATAL, "Undefined implementation given for [name]:
437 !! [gas_fluxes%bc(n)%flux_type]/implementation/[gas_fluxes%bc(n)%implementation]"
438 !! @throw FATAL, "No param for [name]: need [num_parameters]"
439 !! @throw FATAL, "Wrong number of param for [name]: [size(gas_fluxes%bc(n)%param(:))] given, need [num_parameters]"
440 !! @throw FATAL, "No params needed for [name] but has size of [size(gas_fluxes%bc(n)%param(:))]"
441 !! @throw FATAL, "Num_parameters is negative for [name]: [num_parameters]"
442 !! @throw FATAL, "No flag for [name]: need [num_flags]"
443 !! @throw FATAL, "Wrong number of flag for [name]: [size(gas_fluxes%bc(n)%flag(:))] given, need [num_flags]"
444 !! @throw FATAL, "No flags needed for [name] but has size of [size(gas_fluxes%bc(n)%flag(:))]"
445 !! @throw FATAL, "Num_flags is negative for [name]: [num_flags]"
446 !! @throw FATAL, "Problem dumping fluxes tracer tree"
447 !! @throw FATAL, "Number of fluxes does not match across the processors: [gas_fluxes%num_bcs] fluxes"
448 subroutine atmos_ocean_fluxes_init(gas_fluxes, gas_fields_atm, gas_fields_ice, verbosity, use_r4_kind)
449
450 type(coupler_1d_bc_type), intent(inout) :: gas_fluxes !< Structure containing the gas fluxes between
451 !! the atmosphere and the ocean and parameters
452 !! related to the calculation of these fluxes.
453 !! The properties stored in this type are set
454 !! here, but the actual value arrays are set later.
455 type(coupler_1d_bc_type), intent(inout) :: gas_fields_atm !< Structure containing atmospheric surface
456 !! variables that are used in the calculation
457 !! of the atmosphere-ocean gas fluxes.
458 !! The properties stored in this type are set
459 !! here, but the actual value arrays are set later.
460 type(coupler_1d_bc_type), intent(inout) :: gas_fields_ice !< Structure containing ice-top and ocean
461 !! surface variables that are used in the
462 !! calculation of the atmosphere-ocean gas fluxes.
463 !! The properties stored in this type are set
464 !! here, but the actual value arrays are set later.
465 integer, optional, intent(in) :: verbosity !< A 0-9 integer indicating a level of verbosity.
466 logical, optional, intent(in) :: use_r4_kind!< Allocate field data to r4 kind instead of r8 kind.
467 !! Defaults to r8_kind if not present.
468 logical :: use_r4_kind_loc = .false.
469
470 character(len=*), parameter :: sub_name = 'atmos_ocean_fluxes_init'
471 character(len=*), parameter :: error_header =&
472 & '==>Error from ' // trim(mod_name) // '(' // trim(sub_name) // '):'
473 character(len=*), parameter :: warn_header =&
474 & '==>Warning from ' // trim(mod_name) // '(' // trim(sub_name) // '):'
475 character(len=*), parameter :: note_header =&
476 & '==>Note from ' // trim(mod_name) // '(' // trim(sub_name) // '):'
477
478 integer :: num_parameters
479 integer :: num_flags
480 integer :: n
481 integer :: m
482 character(len=128) :: caller_str
483 character(len=fm_type_name_len) :: typ
484 character(len=fm_field_name_len) :: name
485 integer :: ind
486 integer :: outunit
487 integer :: total_fluxes
488 character(len=8) :: string
489 character(len=128) :: error_string
490 character(len=128) :: flux_list
491 logical, save :: initialized = .false.
492 integer :: verbose !< An integer indicating the level of verbosity.
493
494 if (initialized) return
495
496 verbose = 5 ! Default verbosity level
497 if (present(verbosity)) verbose = verbosity
498
499 ! Write out the version of the file to the log file.
500 call write_version_number(trim(mod_name), version)
501
502 initialized = .true.
503 outunit = stdout()
504
505 ! initialize the coupler type flux tracers
506 call atmos_ocean_type_fluxes_init(verbose)
507
508 if (verbose >= 9) then
509 write (outunit,*)
510 write (outunit,*) 'Dumping field manager tree'
511 if (.not. fm_dump_list('/', recursive = .true.)) &
512 call mpp_error(fatal, trim(error_header) // ' Problem dumping field manager tree')
513 endif
514
515 caller_str = trim(mod_name) // '(' // trim(sub_name) // ')'
516
517 ! Set other defaults for the fm_util_set_value routines.
518 call fm_util_set_no_overwrite(.true.)
519 call fm_util_set_caller(caller_str)
520
521 ! Determine the number of flux fields.
522 gas_fluxes%num_bcs = fm_util_get_length('/coupler_mod/fluxes/')
523 gas_fluxes%set = .true.
524 gas_fields_atm%num_bcs = gas_fluxes%num_bcs ; gas_fields_atm%set = .true.
525 gas_fields_ice%num_bcs = gas_fluxes%num_bcs ; gas_fields_ice%set = .true.
526 if (gas_fluxes%num_bcs .lt. 0) then
527 call mpp_error(fatal, trim(error_header) // ' Could not get number of fluxes')
528 elseif (gas_fluxes%num_bcs .eq. 0) then
529 if (verbose >= 5) &
530 write (outunit,*) trim(note_header), ' No gas fluxes'
531 return
532 else
533 if (verbose >= 5) &
534 write (outunit,*) trim(note_header), ' Processing ', gas_fluxes%num_bcs, ' gas fluxes'
535 endif
536
537 if(present(use_r4_kind)) use_r4_kind_loc = use_r4_kind
538
539 ! allocate the arrays for selected kind (default r8)
540 if( .not. use_r4_kind_loc) then
541 allocate (gas_fluxes%bc(gas_fluxes%num_bcs))
542 allocate (gas_fields_atm%bc(gas_fields_atm%num_bcs))
543 allocate (gas_fields_ice%bc(gas_fields_ice%num_bcs))
544 else
545 allocate (gas_fluxes%bc_r4(gas_fluxes%num_bcs))
546 allocate (gas_fields_atm%bc_r4(gas_fields_atm%num_bcs))
547 allocate (gas_fields_ice%bc_r4(gas_fields_ice%num_bcs))
548 endif
549
550 ! Loop over the input fields, setting the values in the flux_type.
551 n = 0
552 do while (fm_loop_over_list('/coupler_mod/fluxes', name, typ, ind))
553 if (typ .ne. 'list') then
554 call mpp_error(fatal, trim(error_header) // ' ' // trim(name) // ' is not a list')
555 endif
556
557 n = n + 1 ! increment the array index
558
559 if (n .ne. ind) then
560 if (verbose >= 3) &
561 write (outunit,*) trim(warn_header), ' Flux index, ', ind,&
562 & ' does not match array index, ', n, ' for ', trim(name)
563 endif
564
565 ! Change list to the new flux.
566 if (.not. fm_change_list('/coupler_mod/fluxes/' // trim(name))) then
567 call mpp_error(fatal, trim(error_header) // ' Problem changing to ' // trim(name))
568 endif
569
570 !! mixed precision support
571 !! if use_r4_kind is false or not present will allocate to r8_kind
572 if (.not.use_r4_kind_loc) then
573 ! Save and check the flux_type.
574 gas_fluxes%bc(n)%flux_type = fm_util_get_string('flux_type', scalar = .true.)
575 if (.not. fm_exists('/coupler_mod/types/' // trim(gas_fluxes%bc(n)%flux_type))) then
576 call mpp_error(fatal, trim(error_header) // ' Undefined flux_type given for ' //&
577 & trim(name) // ': ' // trim(gas_fluxes%bc(n)%flux_type))
578 endif
579 gas_fields_atm%bc(n)%flux_type = gas_fluxes%bc(n)%flux_type
580 gas_fields_ice%bc(n)%flux_type = gas_fluxes%bc(n)%flux_type
581
582 ! Save and check the implementation.
583 gas_fluxes%bc(n)%implementation = fm_util_get_string('implementation', scalar = .true.)
584 if (.not. fm_exists('/coupler_mod/types/' // trim(gas_fluxes%bc(n)%flux_type) //&
585 & '/implementation/' // trim(gas_fluxes%bc(n)%implementation))) then
586 call mpp_error(fatal, trim(error_header) // ' Undefined implementation given for ' //&
587 & trim(name) // ': ' // trim(gas_fluxes%bc(n)%flux_type) // '/implementation/' //&
588 & trim(gas_fluxes%bc(n)%implementation))
589 endif
590 gas_fields_atm%bc(n)%implementation = gas_fluxes%bc(n)%implementation
591 gas_fields_ice%bc(n)%implementation = gas_fluxes%bc(n)%implementation
592
593 ! Set the flux list name.
594 flux_list = '/coupler_mod/types/' // trim(gas_fluxes%bc(n)%flux_type) // '/'
595
596 ! allocate the arrays
597 gas_fluxes%bc(n)%num_fields = fm_util_get_length(trim(flux_list) // 'flux/name')
598 allocate (gas_fluxes%bc(n)%field(gas_fluxes%bc(n)%num_fields))
599 gas_fields_atm%bc(n)%num_fields = fm_util_get_length(trim(flux_list) // 'atm/name')
600 allocate (gas_fields_atm%bc(n)%field(gas_fields_atm%bc(n)%num_fields))
601 gas_fields_ice%bc(n)%num_fields = fm_util_get_length(trim(flux_list) // 'ice/name')
602 allocate (gas_fields_ice%bc(n)%field(gas_fields_ice%bc(n)%num_fields))
603
604 ! Save the name and generate unique field names for Flux, Ice and Atm.
605 gas_fluxes%bc(n)%name = name
606 do m = 1, fm_util_get_length(trim(flux_list) // 'flux/name')
607 gas_fluxes%bc(n)%field(m)%name = trim(name) // "_" // fm_util_get_string(trim(flux_list) //&
608 & 'flux/name', index = m)
609 gas_fluxes%bc(n)%field(m)%override = .false.
610 gas_fluxes%bc(n)%field(m)%mean = .false.
611 enddo
612
613 gas_fields_atm%bc(n)%name = name
614 do m = 1, fm_util_get_length(trim(flux_list) // 'atm/name')
615 gas_fields_atm%bc(n)%field(m)%name = trim(name) // "_" // fm_util_get_string(trim(flux_list) //&
616 & 'atm/name', index = m)
617 gas_fields_atm%bc(n)%field(m)%override = .false.
618 gas_fields_atm%bc(n)%field(m)%mean = .false.
619 enddo
620
621 gas_fields_ice%bc(n)%name = name
622 do m = 1, fm_util_get_length(trim(flux_list) // 'ice/name')
623 gas_fields_ice%bc(n)%field(m)%name = trim(name) // "_" // fm_util_get_string(trim(flux_list) // &
624 & 'ice/name', index = m)
625 gas_fields_ice%bc(n)%field(m)%override = .false.
626 gas_fields_ice%bc(n)%field(m)%mean = .false.
627 enddo
628
629 ! Save the units.
630 do m = 1, fm_util_get_length(trim(flux_list) // 'flux/name')
631 gas_fluxes%bc(n)%field(m)%units =&
632 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) // 'flux/name', index = m)) // &
633 & '-units', scalar = .true.)
634 enddo
635 do m = 1, fm_util_get_length(trim(flux_list) // 'atm/name')
636 gas_fields_atm%bc(n)%field(m)%units =&
637 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) // 'atm/name', index = m)) // '-units')
638 enddo
639 do m = 1, fm_util_get_length(trim(flux_list) // 'ice/name')
640 gas_fields_ice%bc(n)%field(m)%units =&
641 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) // 'ice/name', index = m)) // '-units')
642 enddo
643
644 ! Save the long names.
645 do m = 1, fm_util_get_length(trim(flux_list) // 'flux/name')
646 gas_fluxes%bc(n)%field(m)%long_name =&
647 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) // 'flux/name', index = m)) // &
648 & '-long_name', scalar = .true.)
649 gas_fluxes%bc(n)%field(m)%long_name = trim(gas_fluxes%bc(n)%field(m)%long_name) // ' for ' // name
650 enddo
651 do m = 1, fm_util_get_length(trim(flux_list) // 'atm/name')
652 gas_fields_atm%bc(n)%field(m)%long_name =&
653 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) // 'atm/name', index = m)) // '-long_name')
654 gas_fields_atm%bc(n)%field(m)%long_name = trim(gas_fields_atm%bc(n)%field(m)%long_name) // ' for ' // name
655 enddo
656 do m = 1, fm_util_get_length(trim(flux_list) // 'ice/name')
657 gas_fields_ice%bc(n)%field(m)%long_name =&
658 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) // 'ice/name', index = m)) // '-long_name')
659 gas_fields_ice%bc(n)%field(m)%long_name = trim(gas_fields_ice%bc(n)%field(m)%long_name) // ' for ' // name
660 enddo
661
662 ! Save the atm_tr_index.
663 gas_fluxes%bc(n)%atm_tr_index = fm_util_get_integer('atm_tr_index', scalar = .true.)
664
665 ! Save the molecular weight.
666 gas_fluxes%bc(n)%mol_wt = fm_util_get_real('mol_wt', scalar = .true.)
667 gas_fields_atm%bc(n)%mol_wt = gas_fluxes%bc(n)%mol_wt
668 gas_fields_ice%bc(n)%mol_wt = gas_fluxes%bc(n)%mol_wt
669
670 ! Save the ice_restart_file.
671 gas_fluxes%bc(n)%ice_restart_file = fm_util_get_string('ice_restart_file', scalar = .true.)
672 gas_fields_atm%bc(n)%ice_restart_file = gas_fluxes%bc(n)%ice_restart_file
673 gas_fields_ice%bc(n)%ice_restart_file = gas_fluxes%bc(n)%ice_restart_file
674
675 ! Save the ocean_restart_file.
676 gas_fluxes%bc(n)%ocean_restart_file = fm_util_get_string('ocean_restart_file', scalar = .true.)
677 gas_fields_atm%bc(n)%ocean_restart_file = gas_fluxes%bc(n)%ocean_restart_file
678 gas_fields_ice%bc(n)%ocean_restart_file = gas_fluxes%bc(n)%ocean_restart_file
679
680 ! Save the params.
681 gas_fluxes%bc(n)%param => fm_util_get_real_array('param')
682
683 ! Save the flags.
684 gas_fluxes%bc(n)%flag => fm_util_get_logical_array('flag')
685
686 ! Perform some integrity checks.
687 num_parameters = fm_util_get_integer(trim(flux_list) // 'implementation/' //&
688 & trim(gas_fluxes%bc(n)%implementation) // '/num_parameters', scalar = .true.)
689 if (num_parameters .gt. 0) then
690 if (.not. associated(gas_fluxes%bc(n)%param)) then
691 write (error_string,'(a,i2)') ': need ', num_parameters
692 call mpp_error(fatal, trim(error_header) // ' No param for ' // trim(name) // trim(error_string))
693 elseif (size(gas_fluxes%bc(n)%param(:)) .ne. num_parameters) then
694 write (error_string,'(a,i2,a,i2)') ': ', size(gas_fluxes%bc(n)%param(:)), ' given, need ', num_parameters
695 call mpp_error(fatal, trim(error_header) // &
696 & ' Wrong number of param for ' // trim(name) // trim(error_string))
697 endif
698 elseif (num_parameters .eq. 0) then
699 if (associated(gas_fluxes%bc(n)%param)) then
700 write (error_string,'(a,i3)') ' but has size of ', size(gas_fluxes%bc(n)%param(:))
701 call mpp_error(fatal, trim(error_header) // ' No params needed for ' // trim(name) // trim(error_string))
702 endif
703 else
704 write (error_string,'(a,i2)') ': ', num_parameters
705 call mpp_error(fatal, trim(error_header) // &
706 & 'Num_parameters is negative for ' // trim(name) // trim(error_string))
707 endif
708 num_flags = fm_util_get_integer(trim(flux_list) // '/num_flags', scalar = .true.)
709 if (num_flags .gt. 0) then
710 if (.not. associated(gas_fluxes%bc(n)%flag)) then
711 write (error_string,'(a,i2)') ': need ', num_flags
712 call mpp_error(fatal, trim(error_header) // ' No flag for ' // trim(name) // trim(error_string))
713 elseif (size(gas_fluxes%bc(n)%flag(:)) .ne. num_flags) then
714 write (error_string,'(a,i2,a,i2)') ': ', size(gas_fluxes%bc(n)%flag(:)), ' given, need ', num_flags
715 call mpp_error(fatal, trim(error_header) // ' Wrong number of flag for ' // trim(name)//trim(error_string))
716 endif
717 elseif (num_flags .eq. 0) then
718 if (associated(gas_fluxes%bc(n)%flag)) then
719 write (error_string,'(a,i3)') ' but has size of ', size(gas_fluxes%bc(n)%flag(:))
720 call mpp_error(fatal, trim(error_header) // ' No flags needed for ' // trim(name) // trim(error_string))
721 endif
722 else
723 write (error_string,'(a,i2)') ': ', num_flags
724 call mpp_error(fatal, trim(error_header) // 'Num_flags is negative for ' // trim(name) // trim(error_string))
725 endif
726
727 ! Set some flags for this flux_type.
728 gas_fluxes%bc(n)%use_atm_pressure = fm_util_get_logical(trim(flux_list) // '/use_atm_pressure')
729 gas_fields_atm%bc(n)%use_atm_pressure = gas_fluxes%bc(n)%use_atm_pressure
730 gas_fields_ice%bc(n)%use_atm_pressure = gas_fluxes%bc(n)%use_atm_pressure
731
732 gas_fluxes%bc(n)%use_10m_wind_speed = fm_util_get_logical(trim(flux_list) // '/use_10m_wind_speed')
733 gas_fields_atm%bc(n)%use_10m_wind_speed = gas_fluxes%bc(n)%use_10m_wind_speed
734 gas_fields_ice%bc(n)%use_10m_wind_speed = gas_fluxes%bc(n)%use_10m_wind_speed
735
736 gas_fluxes%bc(n)%pass_through_ice = fm_util_get_logical(trim(flux_list) // '/pass_through_ice')
737 gas_fields_atm%bc(n)%pass_through_ice = gas_fluxes%bc(n)%pass_through_ice
738 gas_fields_ice%bc(n)%pass_through_ice = gas_fluxes%bc(n)%pass_through_ice
739 !! mixed precision support
740 !! if use_r4_kind is present and true will intialize to the r4_kind type
741 else
742 ! Save and check the flux_type.
743 gas_fluxes%bc_r4(n)%flux_type = fm_util_get_string('flux_type', scalar = .true.)
744 if (.not. fm_exists('/coupler_mod/types/' // trim(gas_fluxes%bc_r4(n)%flux_type))) then
745 call mpp_error(fatal, trim(error_header) // ' Undefined flux_type given for ' //&
746 & trim(name) // ': ' // trim(gas_fluxes%bc_r4(n)%flux_type))
747 endif
748 gas_fields_atm%bc_r4(n)%flux_type = gas_fluxes%bc_r4(n)%flux_type
749 gas_fields_ice%bc_r4(n)%flux_type = gas_fluxes%bc_r4(n)%flux_type
750
751 ! Save and check the implementation.
752 gas_fluxes%bc_r4(n)%implementation = fm_util_get_string('implementation', scalar = .true.)
753 if (.not. fm_exists('/coupler_mod/types/' // trim(gas_fluxes%bc_r4(n)%flux_type) //&
754 & '/implementation/' // trim(gas_fluxes%bc_r4(n)%implementation))) then
755 call mpp_error(fatal, trim(error_header) // ' Undefined implementation given for ' //&
756 & trim(name) // ': ' // trim(gas_fluxes%bc_r4(n)%flux_type) // '/implementation/' //&
757 & trim(gas_fluxes%bc_r4(n)%implementation))
758 endif
759 gas_fields_atm%bc_r4(n)%implementation = gas_fluxes%bc_r4(n)%implementation
760 gas_fields_ice%bc_r4(n)%implementation = gas_fluxes%bc_r4(n)%implementation
761
762 ! Set the flux list name.
763 flux_list = '/coupler_mod/types/' // trim(gas_fluxes%bc_r4(n)%flux_type) // '/'
764
765 ! allocate the arrays
766 gas_fluxes%bc_r4(n)%num_fields = fm_util_get_length(trim(flux_list) // 'flux/name')
767 allocate (gas_fluxes%bc_r4(n)%field(gas_fluxes%bc_r4(n)%num_fields))
768 gas_fields_atm%bc_r4(n)%num_fields = fm_util_get_length(trim(flux_list) // 'atm/name')
769 allocate (gas_fields_atm%bc_r4(n)%field(gas_fields_atm%bc_r4(n)%num_fields))
770 gas_fields_ice%bc_r4(n)%num_fields = fm_util_get_length(trim(flux_list) // 'ice/name')
771 allocate (gas_fields_ice%bc_r4(n)%field(gas_fields_ice%bc_r4(n)%num_fields))
772
773 ! Save the name and generate unique field names for Flux, Ice and Atm.
774 gas_fluxes%bc_r4(n)%name = name
775 do m = 1, fm_util_get_length(trim(flux_list) // 'flux/name')
776 gas_fluxes%bc_r4(n)%field(m)%name = trim(name) // "_" // fm_util_get_string(trim(flux_list) //&
777 & 'flux/name', index = m)
778 gas_fluxes%bc_r4(n)%field(m)%override = .false.
779 gas_fluxes%bc_r4(n)%field(m)%mean = .false.
780 enddo
781
782 gas_fields_atm%bc_r4(n)%name = name
783 do m = 1, fm_util_get_length(trim(flux_list) // 'atm/name')
784 gas_fields_atm%bc_r4(n)%field(m)%name = trim(name) // "_" // fm_util_get_string(trim(flux_list) //&
785 & 'atm/name', index = m)
786 gas_fields_atm%bc_r4(n)%field(m)%override = .false.
787 gas_fields_atm%bc_r4(n)%field(m)%mean = .false.
788 enddo
789
790 gas_fields_ice%bc_r4(n)%name = name
791 do m = 1, fm_util_get_length(trim(flux_list) // 'ice/name')
792 gas_fields_ice%bc_r4(n)%field(m)%name = trim(name) // "_" // fm_util_get_string(trim(flux_list) // &
793 & 'ice/name', index = m)
794 gas_fields_ice%bc_r4(n)%field(m)%override = .false.
795 gas_fields_ice%bc_r4(n)%field(m)%mean = .false.
796 enddo
797
798 ! Save the units.
799 do m = 1, fm_util_get_length(trim(flux_list) // 'flux/name')
800 gas_fluxes%bc_r4(n)%field(m)%units =&
801 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) // 'flux/name', index = m)) // &
802 & '-units', scalar = .true.)
803 enddo
804 do m = 1, fm_util_get_length(trim(flux_list) // 'atm/name')
805 gas_fields_atm%bc_r4(n)%field(m)%units =&
806 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) // 'atm/name', index = m)) // '-units')
807 enddo
808 do m = 1, fm_util_get_length(trim(flux_list) // 'ice/name')
809 gas_fields_ice%bc_r4(n)%field(m)%units =&
810 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) // 'ice/name', index = m)) // '-units')
811 enddo
812
813 ! Save the long names.
814 do m = 1, fm_util_get_length(trim(flux_list) // 'flux/name')
815 gas_fluxes%bc_r4(n)%field(m)%long_name =&
816 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) // 'flux/name', index = m)) // &
817 & '-long_name', scalar = .true.)
818 gas_fluxes%bc_r4(n)%field(m)%long_name = trim(gas_fluxes%bc_r4(n)%field(m)%long_name) // ' for ' // name
819 enddo
820 do m = 1, fm_util_get_length(trim(flux_list) // 'atm/name')
821 gas_fields_atm%bc_r4(n)%field(m)%long_name =&
822 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) // 'atm/name', index = m)) // '-long_name')
823 gas_fields_atm%bc_r4(n)%field(m)%long_name = trim(gas_fields_atm%bc_r4(n)%field(m)%long_name)// &
824 ' for '// name
825 enddo
826 do m = 1, fm_util_get_length(trim(flux_list) // 'ice/name')
827 gas_fields_ice%bc_r4(n)%field(m)%long_name =&
828 & fm_util_get_string(trim(fm_util_get_string(trim(flux_list) // 'ice/name', index = m)) // '-long_name')
829 gas_fields_ice%bc_r4(n)%field(m)%long_name = trim(gas_fields_ice%bc_r4(n)%field(m)%long_name) // &
830 ' for ' // name
831 enddo
832
833 ! Save the atm_tr_index.
834 gas_fluxes%bc_r4(n)%atm_tr_index = fm_util_get_integer('atm_tr_index', scalar = .true.)
835
836 ! Save the molecular weight.
837 gas_fluxes%bc_r4(n)%mol_wt = fm_util_get_real('mol_wt', scalar = .true.)
838 gas_fields_atm%bc_r4(n)%mol_wt = gas_fluxes%bc_r4(n)%mol_wt
839 gas_fields_ice%bc_r4(n)%mol_wt = gas_fluxes%bc_r4(n)%mol_wt
840
841 ! Save the ice_restart_file.
842 gas_fluxes%bc_r4(n)%ice_restart_file = fm_util_get_string('ice_restart_file', scalar = .true.)
843 gas_fields_atm%bc_r4(n)%ice_restart_file = gas_fluxes%bc_r4(n)%ice_restart_file
844 gas_fields_ice%bc_r4(n)%ice_restart_file = gas_fluxes%bc_r4(n)%ice_restart_file
845
846 ! Save the ocean_restart_file.
847 gas_fluxes%bc_r4(n)%ocean_restart_file = fm_util_get_string('ocean_restart_file', scalar = .true.)
848 gas_fields_atm%bc_r4(n)%ocean_restart_file = gas_fluxes%bc_r4(n)%ocean_restart_file
849 gas_fields_ice%bc_r4(n)%ocean_restart_file = gas_fluxes%bc_r4(n)%ocean_restart_file
850
851 ! Save the params.
852 gas_fluxes%bc_r4(n)%param => fm_util_get_real_array('param')
853
854 ! Save the flags.
855 gas_fluxes%bc_r4(n)%flag => fm_util_get_logical_array('flag')
856
857 ! Perform some integrity checks.
858 num_parameters = fm_util_get_integer(trim(flux_list) // 'implementation/' //&
859 & trim(gas_fluxes%bc_r4(n)%implementation) // '/num_parameters', scalar = .true.)
860 if (num_parameters .gt. 0) then
861 if (.not. associated(gas_fluxes%bc_r4(n)%param)) then
862 write (error_string,'(a,i2)') ': need ', num_parameters
863 call mpp_error(fatal, trim(error_header) // ' No param for ' // trim(name) // trim(error_string))
864 elseif (size(gas_fluxes%bc_r4(n)%param(:)) .ne. num_parameters) then
865 write (error_string,'(a,i2,a,i2)') ': ', size(gas_fluxes%bc_r4(n)%param(:)), ' given, need ', num_parameters
866 call mpp_error(fatal, trim(error_header) // &
867 & ' Wrong number of param for ' // trim(name) // trim(error_string))
868 endif
869 elseif (num_parameters .eq. 0) then
870 if (associated(gas_fluxes%bc_r4(n)%param)) then
871 write (error_string,'(a,i3)') ' but has size of ', size(gas_fluxes%bc_r4(n)%param(:))
872 call mpp_error(fatal, trim(error_header) // ' No params needed for ' // trim(name) // trim(error_string))
873 endif
874 else
875 write (error_string,'(a,i2)') ': ', num_parameters
876 call mpp_error(fatal, trim(error_header) // &
877 & 'Num_parameters is negative for ' // trim(name) // trim(error_string))
878 endif
879 num_flags = fm_util_get_integer(trim(flux_list) // '/num_flags', scalar = .true.)
880 if (num_flags .gt. 0) then
881 if (.not. associated(gas_fluxes%bc_r4(n)%flag)) then
882 write (error_string,'(a,i2)') ': need ', num_flags
883 call mpp_error(fatal, trim(error_header) // ' No flag for ' // trim(name) // trim(error_string))
884 elseif (size(gas_fluxes%bc_r4(n)%flag(:)) .ne. num_flags) then
885 write (error_string,'(a,i2,a,i2)') ': ', size(gas_fluxes%bc_r4(n)%flag(:)), ' given, need ', num_flags
886 call mpp_error(fatal, trim(error_header) // ' Wrong number of flag for '//trim(name)//trim(error_string))
887 endif
888 elseif (num_flags .eq. 0) then
889 if (associated(gas_fluxes%bc_r4(n)%flag)) then
890 write (error_string,'(a,i3)') ' but has size of ', size(gas_fluxes%bc_r4(n)%flag(:))
891 call mpp_error(fatal, trim(error_header) // ' No flags needed for ' // trim(name) // trim(error_string))
892 endif
893 else
894 write (error_string,'(a,i2)') ': ', num_flags
895 call mpp_error(fatal, trim(error_header) // 'Num_flags is negative for ' // trim(name) // trim(error_string))
896 endif
897
898 ! Set some flags for this flux_type.
899 gas_fluxes%bc_r4(n)%use_atm_pressure = fm_util_get_logical(trim(flux_list) // '/use_atm_pressure')
900 gas_fields_atm%bc_r4(n)%use_atm_pressure = gas_fluxes%bc_r4(n)%use_atm_pressure
901 gas_fields_ice%bc_r4(n)%use_atm_pressure = gas_fluxes%bc_r4(n)%use_atm_pressure
902
903 gas_fluxes%bc_r4(n)%use_10m_wind_speed = fm_util_get_logical(trim(flux_list) // '/use_10m_wind_speed')
904 gas_fields_atm%bc_r4(n)%use_10m_wind_speed = gas_fluxes%bc_r4(n)%use_10m_wind_speed
905 gas_fields_ice%bc_r4(n)%use_10m_wind_speed = gas_fluxes%bc_r4(n)%use_10m_wind_speed
906
907 gas_fluxes%bc_r4(n)%pass_through_ice = fm_util_get_logical(trim(flux_list) // '/pass_through_ice')
908 gas_fields_atm%bc_r4(n)%pass_through_ice = gas_fluxes%bc_r4(n)%pass_through_ice
909 gas_fields_ice%bc_r4(n)%pass_through_ice = gas_fluxes%bc_r4(n)%pass_through_ice
910 endif ! r8/r4kind if
911 enddo ! while loop
912
913 if (verbose >= 5) then
914 write (outunit,*)
915 write (outunit,*) 'Dumping fluxes tracer tree'
916 if (.not. fm_dump_list('/coupler_mod/fluxes', recursive = .true.)) then
917 call mpp_error(fatal, trim(error_header) // ' Problem dumping fluxes tracer tree')
918 endif
919 endif
920
921 ! Check that the number of fluxes is the same on all processors
922 ! If they are, then the sum of the number of fluxes across all processors
923 ! should equal to the number of fluxes on each processor times the number of processors
924 total_fluxes = gas_fluxes%num_bcs
925 call mpp_sum(total_fluxes)
926 if (total_fluxes .ne. mpp_npes() * gas_fluxes%num_bcs) then
927 write (string, '(i4)') gas_fluxes%num_bcs
928 call mpp_error(fatal, trim(error_header) //&
929 & ' Number of fluxes does not match across the processors: ' // trim(string) // ' fluxes')
930 endif
931
932 ! Reset the defaults for the fm_util_set_value calls.
933 call fm_util_reset_no_overwrite
934 call fm_util_reset_caller
935 end subroutine atmos_ocean_fluxes_init
936
937 !> @brief Initialize the coupler type flux tracers
938 !> Initialize the /coupler_mod/types/ fields in the field manager. These fields
939 !! include:
940 !! @verbatim
941 !! air_sea_gas_flux_generic/
942 !! implementation/
943 !! ocmip2/
944 !! num_parameters = 2
945 !! num_flags = 0
946 !! use_atm_pressure = t
947 !! use_10m_wind_speed = t
948 !! pass_through_ice = f
949 !! atm/
950 !! name/
951 !! pcair, u10, psurf
952 !! long_name/
953 !! 'Atmospheric concentration'
954 !! 'Wind speed at 10 m'
955 !! 'Surface atmospheric pressure'
956 !! units/
957 !! 'mol/mol', 'm/s', 'Pa'
958 !! ice/
959 !! name/
960 !! alpha, csurf, sc_no
961 !! long_name/
962 !! 'Solubility from atmosphere'
963 !! 'Surface concentration from ocean'
964 !! 'Schmidt number'
965 !! units/
966 !! 'mol/m^3/atm', 'mol/m^3', 'dimensionless'
967 !! flux/
968 !! name/
969 !! flux, deltap, kw
970 !! long_name/
971 !! 'Surface gas flux'
972 !! 'ocean-air delta pressure'
973 !! 'piston velocity'
974 !! units/
975 !! 'mol/m^2/s', 'uatm', 'm/s'
976 !! air_sea_gas_flux/
977 !! implementation/
978 !! ocmip2/
979 !! num_parameters = 2
980 !! ocmip2_data/
981 !! num_parameters = 2
982 !! linear/
983 !! num_parameters = 3
984 !! num_flags = 0
985 !! use_atm_pressure = t
986 !! use_10m_wind_speed = t
987 !! pass_through_ice = f
988 !! atm/
989 !! name/
990 !! pcair, u10, psurf
991 !! long_name/
992 !! 'Atmospheric concentration'
993 !! 'Wind speed at 10 m'
994 !! 'Surface atmospheric pressure'
995 !! units/
996 !! 'mol/mol', 'm/s', 'Pa'
997 !! ice/
998 !! name/
999 !! alpha, csurf
1000 !! long_name/
1001 !! 'Solubility from atmosphere'
1002 !! 'Surface concentration from ocean'
1003 !! units/
1004 !! 'mol/m^3/atm', 'mol/m^3'
1005 !! flux/
1006 !! name/
1007 !! flux
1008 !! long_name/
1009 !! 'Surface gas flux'
1010 !! units/
1011 !! 'mol/m^2/s'
1012 !! air_sea_deposition/
1013 !! implementation/
1014 !! dry/
1015 !! num_parameters = 1
1016 !! wet/
1017 !! num_parameters = 1
1018 !! num_flags = 0
1019 !! use_atm_pressure = f
1020 !! use_10m_wind_speed = f
1021 !! pass_through_ice = t
1022 !! atm/
1023 !! name/
1024 !! depostion
1025 !! long_name/
1026 !! 'Atmospheric deposition'
1027 !! units/
1028 !! 'kg/m^2/s'
1029 !! ice/
1030 !! name/
1031 !! long_name/
1032 !! units/
1033 !! flux/
1034 !! name/
1035 !! flux
1036 !! long_name/
1037 !! 'Surface deposition'
1038 !! units/
1039 !! 'mol/m^2/s'
1040 !! land_sea_runoff/
1041 !! implementation/
1042 !! river/
1043 !! num_parameters = 1
1044 !! num_flags = 0
1045 !! use_atm_pressure = f
1046 !! use_10m_wind_speed = f
1047 !! pass_through_ice = t
1048 !! atm/ ! really land (perhaps should change this?)
1049 !! name/
1050 !! runoff
1051 !! long_name/
1052 !! 'Concentration in land runoff'
1053 !! units/
1054 !! 'kg/m^3'
1055 !! ice/
1056 !! name/
1057 !! long_name/
1058 !! units/
1059 !! flux/
1060 !! name/
1061 !! flux
1062 !! long_name/
1063 !! 'Concentration in land runoff'
1064 !! units/
1065 !! 'mol/m^3'
1066 !! @endverbatim
1067 !!
1068 !! @throw FATAL, Could not set the \coupler_mod\ list
1069 !! @throw FATAL, Could not set the \GOOD\ list
1070 !! @throw FATAL, Could not set the \/coupler_mod/fluxes\ list
1071 !! @throw FATAL, Could not set the \/coupler_mod/types\ list
1072 !! @throw FATAL, Could not change to \/coupler_mod/types\
1073 !! @throw FATAL, Could not set the \air_sea_gas_flux_generic\ list
1074 !! @throw FATAL, Could not set the \air_sea_gas_flux_generic\ list
1075 !! @throw FATAL, Could not set the \air_sea_gas_flux_generic/implementation\ list
1076 !! @throw FATAL, Could not set the \air_sea_gas_flux_generic/implementation/ocmip2\ list
1077 !! @throw FATAL, Could not set the \air_sea_gas_flux_generic/atm\ list
1078 !! @throw FATAL, Could not set the \air_sea_gas_flux_generic/ice\ list
1079 !! @throw FATAL, Could not set the \air_sea_gas_flux_generic/flux\ list
1080 !! @throw FATAL, Could not set the \air_sea_gas_flux\ list
1081 !! @throw FATAL, Could not set the \air_sea_gas_flux/implementation\ list
1082 !! @throw FATAL, Could not set the \air_sea_gas_flux/implementation/ocmip2\ list
1083 !! @throw FATAL, Could not set the \air_sea_gas_flux/implementation/ocmip2_data\ list
1084 !! @throw FATAL, Could not set the \air_sea_gas_flux/implementation/linear\ list
1085 !! @throw FATAL, Could not set the \air_sea_gas_flux/atm\ list
1086 !! @throw FATAL, Could not set the \air_sea_gas_flux/ice\ list
1087 !! @throw FATAL, Could not set the \air_sea_gas_flux/flux\ list
1088 !! @throw FATAL, Could not set the \air_sea_deposition\ list
1089 !! @throw FATAL, Could not set the \air_sea_deposition/implementation\ list
1090 !! @throw FATAL, Could not set the \air_sea_deposition/implementation/dry\ list
1091 !! @throw FATAL, Could not set the \air_sea_deposition/implementation/wet\ list
1092 !! @throw FATAL, Could not set the \air_sea_deposition/atm\ list
1093 !! @throw FATAL, Could not set the \air_sea_deposition/ice\ list
1094 !! @throw FATAL, Could not set the \air_sea_deposition/flux\ list
1095 !! @throw FATAL, Could not set the \land_sea_runoff\ list
1096 !! @throw FATAL, Could not set the \land_sea_runoff/implementation\ list
1097 !! @throw FATAL, Could not set the \land_sea_runoff/implementation/river\ list
1098 !! @throw FATAL, Could not set the \land_sea_runoff/atm\ list
1099 !! @throw FATAL, Could not set the \land_sea_runoff/ice\ list
1100 !! @throw FATAL, Could not set the \land_sea_runoff/flux\ list
1101 !! @throw FATAL, Could not change to \/\
1102 !! @throw FATAL, Problem dumping /coupler_mod/types tree
1103 subroutine atmos_ocean_type_fluxes_init(verbosity)
1104 integer, intent(in), optional :: verbosity !< A 0-9 integer indicating a level of verbosity.
1105
1106 integer :: verbose !< An integer indicating the level of verbosity.
1107 integer :: outunit
1108 character(len=*), parameter :: sub_name = 'atmos_ocean_type_fluxes_init'
1109 character(len=*), parameter :: caller_str =&
1110 & trim(mod_name) // '(' // trim(sub_name) // ')'
1111 character(len=*), parameter :: error_header =&
1112 & '==>Error from ' // trim(mod_name) // '(' // trim(sub_name) // '):'
1113 logical, save :: initialized = .false.
1114
1115 if (initialized) return
1116
1117 verbose = 5 ! Default verbosity level
1118 if (present(verbosity)) verbose = verbosity
1119
1120 initialized = .true.
1121
1122 call fm_util_set_no_overwrite(.true.)
1123 call fm_util_set_caller(caller_str)
1124
1125 ! Be sure that the various lists and fields are defined in the field manager tree.
1126 if (fm_new_list('/coupler_mod') .le. 0) then
1127 call mpp_error(fatal, trim(error_header) // ' Could not set the "coupler_mod" list')
1128 endif
1129
1130 if (fm_new_list('/coupler_mod/GOOD') .le. 0) then
1131 call mpp_error(fatal, trim(error_header) // ' Could not set the "GOOD" list')
1132 endif
1133 call fm_util_set_value('/coupler_mod/GOOD/good_coupler_mod_list', 'GOOD', append = .true.)
1134
1135 if (fm_new_list('/coupler_mod/fluxes') .le. 0) then
1136 call mpp_error(fatal, trim(error_header) // ' Could not set the "/coupler_mod/fluxes" list')
1137 endif
1138 call fm_util_set_value('/coupler_mod/GOOD/good_coupler_mod_list', 'fluxes', append = .true.)
1139
1140 if (fm_new_list('/coupler_mod/types') .le. 0) then
1141 call mpp_error(fatal, trim(error_header) // ' Could not set the "/coupler_mod/types" list')
1142 endif
1143 call fm_util_set_value('/coupler_mod/GOOD/good_coupler_mod_list', 'types', append = .true.)
1144
1145 ! Change to the "/coupler_mod/types" list.
1146 if (.not. fm_change_list('/coupler_mod/types')) then
1147 call mpp_error(fatal, trim(error_header) // ' Could not change to "/coupler_mod/types"')
1148 endif
1149
1150
1151 ! Define the air_sea_gas_flux_generic type and add it.
1152 if (fm_new_list('air_sea_gas_flux_generic') .le. 0) then
1153 call mpp_error(fatal, trim(error_header) //&
1154 & ' Could not set the "air_sea_gas_flux_generic" list')
1155 endif
1156
1157 ! Add the implementation list.
1158 if (fm_new_list('air_sea_gas_flux_generic/implementation') .le. 0) then
1159 call mpp_error(fatal, trim(error_header) //&
1160 & ' Could not set the "air_sea_gas_flux_generic/implementation" list')
1161 endif
1162
1163 ! Add the names of the different implementations.
1164 if (fm_new_list('air_sea_gas_flux_generic/implementation/ocmip2') .le. 0) then
1165 call mpp_error(fatal, trim(error_header) //&
1166 & ' Could not set the "air_sea_gas_flux_generic/implementation/ocmip2" list')
1167 endif
1168 call fm_util_set_value('air_sea_gas_flux_generic/implementation/ocmip2/num_parameters', 2)
1169
1170 if (fm_new_list('air_sea_gas_flux_generic/implementation/duce') .le. 0) then
1171 call mpp_error(fatal, trim(error_header) //&
1172 & ' Could not set the "air_sea_gas_flux_generic/implementation/duce" list')
1173 endif
1174 call fm_util_set_value('air_sea_gas_flux_generic/implementation/duce/num_parameters', 1)
1175
1176 if (fm_new_list('air_sea_gas_flux_generic/implementation/johnson') .le. 0) then
1177 call mpp_error(fatal, trim(error_header) // &
1178 & ' Could not set the "air_sea_gas_flux_generic/implementation/johnson" list')
1179 endif
1180 call fm_util_set_value('air_sea_gas_flux_generic/implementation/johnson/num_parameters', 2)
1181
1182 ! Add some scalar quantaties.
1183 call fm_util_set_value('air_sea_gas_flux_generic/num_flags', 0)
1184 call fm_util_set_value('air_sea_gas_flux_generic/use_atm_pressure', .true.)
1185 call fm_util_set_value('air_sea_gas_flux_generic/use_10m_wind_speed', .true.)
1186 call fm_util_set_value('air_sea_gas_flux_generic/pass_through_ice', .false.)
1187
1188 ! Add required fields that will come from the atmosphere model.
1189 if (fm_new_list('air_sea_gas_flux_generic/atm') .le. 0) then
1190 call mpp_error(fatal, trim(error_header) // ' Could not set the "air_sea_gas_flux_generic/atm" list')
1191 endif
1192
1193 call fm_util_set_value('air_sea_gas_flux_generic/atm/name', 'pcair', index = ind_pcair)
1194 call fm_util_set_value('air_sea_gas_flux_generic/atm/long_name', 'Atmospheric concentration', index = ind_pcair)
1195 call fm_util_set_value('air_sea_gas_flux_generic/atm/units', 'mol/mol', index = ind_pcair)
1196
1197 call fm_util_set_value('air_sea_gas_flux_generic/atm/name', 'u10', index = ind_u10)
1198 call fm_util_set_value('air_sea_gas_flux_generic/atm/long_name', 'Wind speed at 10 m', index = ind_u10)
1199 call fm_util_set_value('air_sea_gas_flux_generic/atm/units', 'm/s', index = ind_u10)
1200
1201 call fm_util_set_value('air_sea_gas_flux_generic/atm/name', 'psurf', index = ind_psurf)
1202 call fm_util_set_value('air_sea_gas_flux_generic/atm/long_name', 'Surface atmospheric pressure', index = ind_psurf)
1203 call fm_util_set_value('air_sea_gas_flux_generic/atm/units', 'Pa', index = ind_psurf)
1204
1205 ! Add required fields that will come from the ice model.
1206 if (fm_new_list('air_sea_gas_flux_generic/ice') .le. 0) then
1207 call mpp_error(fatal, trim(error_header) // ' Could not set the "air_sea_gas_flux_generic/ice" list')
1208 endif
1209
1210 call fm_util_set_value('air_sea_gas_flux_generic/ice/name', 'alpha', index = ind_alpha)
1211 call fm_util_set_value('air_sea_gas_flux_generic/ice/long_name', 'Solubility w.r.t. atmosphere', index = ind_alpha)
1212 call fm_util_set_value('air_sea_gas_flux_generic/ice/units', 'mol/m^3/atm', index = ind_alpha)
1213
1214 call fm_util_set_value('air_sea_gas_flux_generic/ice/name', 'csurf', index = ind_csurf)
1215 call fm_util_set_value('air_sea_gas_flux_generic/ice/long_name', 'Ocean concentration', index = ind_csurf)
1216 call fm_util_set_value('air_sea_gas_flux_generic/ice/units', 'mol/m^3', index = ind_csurf)
1217
1218 call fm_util_set_value('air_sea_gas_flux_generic/ice/name', 'sc_no', index = ind_sc_no)
1219 call fm_util_set_value('air_sea_gas_flux_generic/ice/long_name', 'Schmidt number', index = ind_sc_no)
1220 call fm_util_set_value('air_sea_gas_flux_generic/ice/units', 'dimensionless', index = ind_sc_no)
1221
1222 ! Add the flux output field(s).
1223 if (fm_new_list('air_sea_gas_flux_generic/flux') .le. 0) then
1224 call mpp_error(fatal, trim(error_header) // ' Could not set the "air_sea_gas_flux_generic/flux" list')
1225 endif
1226
1227 call fm_util_set_value('air_sea_gas_flux_generic/flux/name', 'flux', index = ind_flux)
1228 call fm_util_set_value('air_sea_gas_flux_generic/flux/long_name', 'Surface flux', index = ind_flux)
1229 call fm_util_set_value('air_sea_gas_flux_generic/flux/units', 'mol/m^2/s', index = ind_flux)
1230
1231 call fm_util_set_value('air_sea_gas_flux_generic/flux/name', 'deltap', index = ind_deltap)
1232 call fm_util_set_value('air_sea_gas_flux_generic/flux/long_name', 'Ocean-air delta pressure', index = ind_deltap)
1233 call fm_util_set_value('air_sea_gas_flux_generic/flux/units', 'uatm', index = ind_deltap)
1234
1235 call fm_util_set_value('air_sea_gas_flux_generic/flux/name', 'kw', index = ind_kw)
1236 call fm_util_set_value('air_sea_gas_flux_generic/flux/long_name', 'Piston velocity', index = ind_kw)
1237 call fm_util_set_value('air_sea_gas_flux_generic/flux/units', 'm/s', index = ind_kw)
1238
1239 call fm_util_set_value('air_sea_gas_flux_generic/flux/name', 'flux0', index = ind_flux0)
1240 call fm_util_set_value('air_sea_gas_flux_generic/flux/long_name', 'Surface flux no atm', index = ind_flux0)
1241 call fm_util_set_value('air_sea_gas_flux_generic/flux/units', 'mol/m^2/s', index = ind_flux0)
1242
1243 ! Define the air_sea_gas_flux type and add it.
1244 if (fm_new_list('air_sea_gas_flux') .le. 0) then
1245 call mpp_error(fatal, trim(error_header) // ' Could not set the "air_sea_gas_flux" list')
1246 endif
1247
1248 ! Add the implementation list.
1249 if (fm_new_list('air_sea_gas_flux/implementation') .le. 0) then
1250 call mpp_error(fatal, trim(error_header) // ' Could not set the "air_sea_gas_flux/implementation" list')
1251 endif
1252
1253 ! Add the names of the different implementations.
1254 if (fm_new_list('air_sea_gas_flux/implementation/ocmip2') .le. 0) then
1255 call mpp_error(fatal, trim(error_header) // ' Could not set the "air_sea_gas_flux/implementation/ocmip2" list')
1256 endif
1257 call fm_util_set_value('air_sea_gas_flux/implementation/ocmip2/num_parameters', 2)
1258 if (fm_new_list('air_sea_gas_flux/implementation/ocmip2_data') .le. 0) then
1259 call mpp_error(fatal, trim(error_header) // &
1260 & ' Could not set the "air_sea_gas_flux/implementation/ocmip2_data" list')
1261 endif
1262 call fm_util_set_value('air_sea_gas_flux/implementation/ocmip2_data/num_parameters', 2)
1263 if (fm_new_list('air_sea_gas_flux/implementation/linear') .le. 0) then
1264 call mpp_error(fatal, trim(error_header) // ' Could not set the "air_sea_gas_flux/implementation/linear" list')
1265 endif
1266 call fm_util_set_value('air_sea_gas_flux/implementation/linear/num_parameters', 3)
1267
1268 ! Add some scalar quantaties.
1269 call fm_util_set_value('air_sea_gas_flux/num_flags', 0)
1270 call fm_util_set_value('air_sea_gas_flux/use_atm_pressure', .true.)
1271 call fm_util_set_value('air_sea_gas_flux/use_10m_wind_speed', .true.)
1272 call fm_util_set_value('air_sea_gas_flux/pass_through_ice', .false.)
1273
1274 ! Add required fields that will come from the atmosphere model.
1275 if (fm_new_list('air_sea_gas_flux/atm') .le. 0) then
1276 call mpp_error(fatal, trim(error_header) // ' Could not set the "air_sea_gas_flux/atm" list')
1277 endif
1278
1279 call fm_util_set_value('air_sea_gas_flux/atm/name', 'pcair', index = ind_pcair)
1280 call fm_util_set_value('air_sea_gas_flux/atm/long_name', 'Atmospheric concentration', index = ind_pcair)
1281 call fm_util_set_value('air_sea_gas_flux/atm/units', 'mol/mol', index = ind_pcair)
1282
1283 call fm_util_set_value('air_sea_gas_flux/atm/name', 'u10', index = ind_u10)
1284 call fm_util_set_value('air_sea_gas_flux/atm/long_name', 'Wind speed at 10 m', index = ind_u10)
1285 call fm_util_set_value('air_sea_gas_flux/atm/units', 'm/s', index = ind_u10)
1286
1287 call fm_util_set_value('air_sea_gas_flux/atm/name', 'psurf', index = ind_psurf)
1288 call fm_util_set_value('air_sea_gas_flux/atm/long_name', 'Surface atmospheric pressure', index = ind_psurf)
1289 call fm_util_set_value('air_sea_gas_flux/atm/units', 'Pa', index = ind_psurf)
1290
1291 ! Add required fields that will come from the ice model.
1292 if (fm_new_list('air_sea_gas_flux/ice') .le. 0) then
1293 call mpp_error(fatal, trim(error_header) // ' Could not set the "air_sea_gas_flux/ice" list')
1294 endif
1295
1296 call fm_util_set_value('air_sea_gas_flux/ice/name', 'alpha', index = ind_alpha)
1297 call fm_util_set_value('air_sea_gas_flux/ice/long_name', &
1298 & 'Solubility from atmosphere times Schmidt number term', index = ind_alpha)
1299 call fm_util_set_value('air_sea_gas_flux/ice/units', 'mol/m^3/atm', index = ind_alpha)
1300
1301 call fm_util_set_value('air_sea_gas_flux/ice/name', 'csurf', index = ind_csurf)
1302 call fm_util_set_value('air_sea_gas_flux/ice/long_name', 'Ocean concentration times Schmidt number term', &
1303 & index = ind_csurf)
1304 call fm_util_set_value('air_sea_gas_flux/ice/units', 'mol/m^3', index = ind_csurf)
1305
1306 ! Add the flux output field(s).
1307 if (fm_new_list('air_sea_gas_flux/flux') .le. 0) then
1308 call mpp_error(fatal, trim(error_header) // ' Could not set the "air_sea_gas_flux/flux" list')
1309 endif
1310
1311 call fm_util_set_value('air_sea_gas_flux/flux/name', 'flux', index = ind_flux)
1312 call fm_util_set_value('air_sea_gas_flux/flux/long_name', 'Surface flux', index = ind_flux)
1313 call fm_util_set_value('air_sea_gas_flux/flux/units', 'mol/m^2/s', index = ind_flux)
1314
1315 ! Define the air_sea_deposition type and add it.
1316 if (fm_new_list('air_sea_deposition') .le. 0) then
1317 call mpp_error(fatal, trim(error_header) // ' Could not set the "air_sea_deposition" list')
1318 endif
1319
1320 ! Add the implementation list.
1321 if (fm_new_list('air_sea_deposition/implementation') .le. 0) then
1322 call mpp_error(fatal, trim(error_header) // ' Could not set the "air_sea_deposition/implementation" list')
1323 endif
1324
1325 ! Add the names of the different implementations.
1326 if (fm_new_list('air_sea_deposition/implementation/dry') .le. 0) then
1327 call mpp_error(fatal, trim(error_header) // ' Could not set the "air_sea_deposition/implementation/dry" list')
1328 endif
1329 call fm_util_set_value('air_sea_deposition/implementation/dry/num_parameters', 1)
1330 if (fm_new_list('air_sea_deposition/implementation/wet') .le. 0) then
1331 call mpp_error(fatal, trim(error_header) // ' Could not set the "air_sea_deposition/implementation/wet" list')
1332 endif
1333 call fm_util_set_value('air_sea_deposition/implementation/wet/num_parameters', 1)
1334
1335 ! Add some scalar quantaties.
1336 call fm_util_set_value('air_sea_deposition/num_flags', 0)
1337 call fm_util_set_value('air_sea_deposition/use_atm_pressure', .false.)
1338 call fm_util_set_value('air_sea_deposition/use_10m_wind_speed', .false.)
1339 call fm_util_set_value('air_sea_deposition/pass_through_ice', .true.)
1340
1341 ! Add required fields that will come from the atmosphere model.
1342 if (fm_new_list('air_sea_deposition/atm') .le. 0) then
1343 call mpp_error(fatal, trim(error_header) // ' Could not set the "air_sea_deposition/atm" list')
1344 endif
1345
1346 call fm_util_set_value('air_sea_deposition/atm/name', 'deposition', index = ind_deposition)
1347 call fm_util_set_value('air_sea_deposition/atm/long_name', 'Atmospheric deposition', index = ind_deposition)
1348 call fm_util_set_value('air_sea_deposition/atm/units', 'kg/m^2/s', index = ind_deposition)
1349
1350 ! Add required fields that will come from the ice model.
1351 if (fm_new_list('air_sea_deposition/ice') .le. 0) then
1352 call mpp_error(fatal, trim(error_header) // ' Could not set the "air_sea_deposition/ice" list')
1353 endif
1354
1355 call fm_util_set_value('air_sea_deposition/ice/name', ' ', index = 0)
1356 call fm_util_set_value('air_sea_deposition/ice/long_name', ' ', index = 0)
1357 call fm_util_set_value('air_sea_deposition/ice/units', ' ', index = 0)
1358
1359 ! Add the flux output field(s).
1360 if (fm_new_list('air_sea_deposition/flux') .le. 0) then
1361 call mpp_error(fatal, trim(error_header) // ' Could not set the "air_sea_deposition/flux" list')
1362 endif
1363
1364 call fm_util_set_value('air_sea_deposition/flux/name', 'flux', index = ind_flux)
1365 call fm_util_set_value('air_sea_deposition/flux/long_name', 'Surface deposition', index = ind_flux)
1366 call fm_util_set_value('air_sea_deposition/flux/units', 'mol/m^2/s', index = ind_flux)
1367
1368 ! Define the land_sea_runoff type and add it.
1369 if (fm_new_list('land_sea_runoff') .le. 0) then
1370 call mpp_error(fatal, trim(error_header) // ' Could not set the "land_sea_runoff" list')
1371 endif
1372
1373 ! Add the implementation list.
1374 if (fm_new_list('land_sea_runoff/implementation') .le. 0) then
1375 call mpp_error(fatal, trim(error_header) // ' Could not set the "land_sea_runoff/implementation" list')
1376 endif
1377
1378 ! Add the names of the different implementations.
1379 if (fm_new_list('land_sea_runoff/implementation/river') .le. 0) then
1380 call mpp_error(fatal, trim(error_header) // ' Could not set the "land_sea_runoff/implementation/river" list')
1381 endif
1382 call fm_util_set_value('land_sea_runoff/implementation/river/num_parameters', 1)
1383
1384 ! Add some scalar quantaties.
1385 call fm_util_set_value('land_sea_runoff/num_flags', 0)
1386 call fm_util_set_value('land_sea_runoff/use_atm_pressure', .false.)
1387 call fm_util_set_value('land_sea_runoff/use_10m_wind_speed', .false.)
1388 call fm_util_set_value('land_sea_runoff/pass_through_ice', .true.)
1389
1390 ! Add required fields that will come from the land model (the array name is still called "atm").
1391 if (fm_new_list('land_sea_runoff/atm') .le. 0) then
1392 call mpp_error(fatal, trim(error_header) // ' Could not set the "land_sea_runoff/atm" list')
1393 endif
1394
1395 call fm_util_set_value('land_sea_runoff/atm/name', 'runoff', index = ind_runoff)
1396 call fm_util_set_value('land_sea_runoff/atm/long_name', 'Concentration in land runoff', index = ind_runoff)
1397 call fm_util_set_value('land_sea_runoff/atm/units', 'mol/m^3', index = ind_runoff)
1398
1399 ! Add required fields that will come from the ice model.
1400 if (fm_new_list('land_sea_runoff/ice') .le. 0) then
1401 call mpp_error(fatal, trim(error_header) // ' Could not set the "land_sea_runoff/ice" list')
1402 endif
1403
1404 call fm_util_set_value('land_sea_runoff/ice/name', ' ', index = 0)
1405 call fm_util_set_value('land_sea_runoff/ice/long_name', ' ', index = 0)
1406 call fm_util_set_value('land_sea_runoff/ice/units', ' ', index = 0)
1407
1408 ! Add the flux output field(s).
1409
1410 if (fm_new_list('land_sea_runoff/flux') .le. 0) then
1411 call mpp_error(fatal, trim(error_header) // ' Could not set the "land_sea_runoff/flux" list')
1412 endif
1413
1414 call fm_util_set_value('land_sea_runoff/flux/name', 'flux', index = ind_flux)
1415 call fm_util_set_value('land_sea_runoff/flux/long_name', 'Concentration in land runoff', index = ind_flux)
1416 call fm_util_set_value('land_sea_runoff/flux/units', 'mol/m^3', index = ind_flux)
1417
1418 ! Change back to root list.
1419 if (.not. fm_change_list('/')) then
1420 call mpp_error(fatal, trim(error_header) // ' Could not change to "/"')
1421 endif
1422
1423 ! Reset the defaults for the fm_util_set_value calls.
1424 call fm_util_reset_no_overwrite
1425 call fm_util_reset_caller
1426
1427 ! Dump the coupler_mod types list.
1428 if (verbose >= 5) then
1429 outunit = stdout()
1430 write (outunit,*)
1431 write (outunit,*) 'Dumping coupler_mod/types tree'
1432 if (.not. fm_dump_list('/coupler_mod/types', recursive = .true.)) then
1433 call mpp_error(fatal, trim(error_header) // ' Problem dumping /coupler_mod/types tree')
1434 endif
1435 endif
1436 return
1437 end subroutine atmos_ocean_type_fluxes_init
1438end module atmos_ocean_fluxes_mod
1439!> @}
1440! close documentation grouping
atmos_ocean_fluxes_mod::atmos_ocean_fluxes_init
subroutine, public atmos_ocean_fluxes_init(gas_fluxes, gas_fields_atm, gas_fields_ice, verbosity, use_r4_kind)
Initialize gas flux structures. Will allocate to r8_kind unless use_r4_kind is present and true.
Definition atmos_ocean_fluxes.F90:449
atmos_ocean_fluxes_mod::atmos_ocean_type_fluxes_init
subroutine, public atmos_ocean_type_fluxes_init(verbosity)
Initialize the coupler type flux tracers Initialize the /coupler_mod/types/ fields in the field manag...
Definition atmos_ocean_fluxes.F90:1104
atmos_ocean_fluxes_mod::aof_set_coupler_flux
integer function, public aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, param, flag, mol_wt, ice_restart_file, ocean_restart_file, units, caller, verbosity)
Set the values for a coupler flux.
Definition atmos_ocean_fluxes.F90:117
coupler_types_mod::ind_kw
integer, public ind_kw
The index for the piston velocity.
Definition coupler_types.F90:388
coupler_types_mod::ind_u10
integer, public ind_u10
The index of the 10 m wind speed.
Definition coupler_types.F90:381
coupler_types_mod::ind_runoff
integer, public ind_runoff
The index for a runoff flux.
Definition coupler_types.F90:391
coupler_types_mod::ind_csurf
integer, public ind_csurf
The index of the ocean surface concentration.
Definition coupler_types.F90:384
coupler_types_mod::ind_sc_no
integer, public ind_sc_no
The index for the Schmidt number for a tracer flux.
Definition coupler_types.F90:385
coupler_types_mod::ind_deposition
integer, public ind_deposition
The index for the atmospheric deposition flux.
Definition coupler_types.F90:390
coupler_types_mod::ind_alpha
integer, public ind_alpha
The index of the solubility array for a tracer.
Definition coupler_types.F90:383
coupler_types_mod::ind_flux
integer, public ind_flux
The index for the tracer flux.
Definition coupler_types.F90:386
coupler_types_mod::ind_pcair
integer, public ind_pcair
The index of the atmospheric concentration.
Definition coupler_types.F90:380
coupler_types_mod::ind_flux0
integer, public ind_flux0
The index for the piston velocity.
Definition coupler_types.F90:389
coupler_types_mod::ind_psurf
integer, public ind_psurf
The index of the surface atmospheric pressure.
Definition coupler_types.F90:382
coupler_types_mod::ind_deltap
integer, public ind_deltap
The index for ocean-air gas partial pressure change.
Definition coupler_types.F90:387
coupler_types_mod::coupler_1d_bc_type
Coupler data for 1D boundary conditions.
Definition coupler_types.F90:365
field_manager_mod::fm_get_current_list
character(len=fms_path_len) function, public fm_get_current_list()
A function to return the full path of the current list.
Definition field_manager.F90:2190
field_manager_mod::fm_get_index
integer function, public fm_get_index(name)
A function to return the index of a named field.
Definition field_manager.F90:2156
field_manager_mod::fm_string_len
integer, parameter, public fm_string_len
The length of a character string representing character values for the field.
Definition field_manager.F90:266
field_manager_mod::fm_dump_list
logical function, public fm_dump_list(name, recursive, unit)
A function to list properties associated with a field.
Definition field_manager.F90:2088
field_manager_mod::fm_change_list
logical function, public fm_change_list(name)
Change the current list. Return true on success, false otherwise.
Definition field_manager.F90:2006
field_manager_mod::fm_field_name_len
integer, parameter, public fm_field_name_len
The length of a character string representing the field name.
Definition field_manager.F90:260
field_manager_mod::fm_type_name_len
integer, parameter, public fm_type_name_len
The length of a character string representing the various types that the values of the field can take...
Definition field_manager.F90:268
field_manager_mod::fm_new_list
integer function, public fm_new_list(name, create, keep)
A function to create a new list.
Definition field_manager.F90:2593
field_manager_mod::fm_exists
logical function, public fm_exists(name)
A function to test whether a named field exists.
Definition field_manager.F90:2133
field_manager_mod::fm_loop_over_list
A function for looping over a list.
Definition field_manager.F90:432
fm_util_mod::fm_util_get_length
integer function, public fm_util_get_length(name, caller)
Get the length of an element of the Field Manager tree.
Definition fm_util.F90:501
fm_util_mod::fm_util_set_good_name_list
subroutine, public fm_util_set_good_name_list(good_name_list)
Set the default value for the optional "good_name_list" variable used in many of these subroutines.
Definition fm_util.F90:222
fm_util_mod::fm_util_get_real_array
real(r8_kind) function, dimension(:), pointer, public fm_util_get_real_array(name, caller)
Get a real value from the Field Manager tree.
Definition fm_util.F90:948
fm_util_mod::fm_util_reset_good_name_list
subroutine, public fm_util_reset_good_name_list
Reset the default value for the optional "good_name_list" variable used in many of these subroutines ...
Definition fm_util.F90:256
fm_util_mod::fm_util_get_string
character(len=fm_string_len) function, public fm_util_get_string(name, caller, index, default_value, scalar)
Get a string value from the Field Manager tree.
Definition fm_util.F90:1481
fm_util_mod::fm_util_check_for_bad_fields
subroutine, public fm_util_check_for_bad_fields(list, good_fields, caller)
Check for unrecognized fields in a list.
Definition fm_util.F90:343
fm_util_mod::fm_util_get_logical_array
logical function, dimension(:), pointer, public fm_util_get_logical_array(name, caller)
Get a logical value from the Field Manager tree.
Definition fm_util.F90:856
fm_util_mod::fm_util_set_caller
subroutine, public fm_util_set_caller(caller)
Set the default value for the optional "caller" variable used in many of these subroutines....
Definition fm_util.F90:157
fm_util_mod::fm_util_get_real
real(r8_kind) function, public fm_util_get_real(name, caller, index, default_value, scalar)
Get a real value from the Field Manager tree.
Definition fm_util.F90:1360
fm_util_mod::fm_util_get_integer
integer function, public fm_util_get_integer(name, caller, index, default_value, scalar)
Get an integer value from the Field Manager tree.
Definition fm_util.F90:1133
fm_util_mod::fm_util_reset_caller
subroutine, public fm_util_reset_caller
Reset the default value for the optional "caller" variable used in many of these subroutines to blank...
Definition fm_util.F90:195
fm_util_mod::fm_util_get_logical
logical function, public fm_util_get_logical(name, caller, index, default_value, scalar)
Get a logical value from the Field Manager tree.
Definition fm_util.F90:1246
fm_util_mod::fm_util_reset_no_overwrite
subroutine, public fm_util_reset_no_overwrite
Reset the default value for the optional "no_overwrite" variable used in some of these subroutines to...
Definition fm_util.F90:317
fm_util_mod::fm_util_get_string_array
character(len=fm_string_len) function, dimension(:), pointer, public fm_util_get_string_array(name, caller)
Get a string value from the Field Manager tree.
Definition fm_util.F90:1041
fm_util_mod::fm_util_set_no_overwrite
subroutine, public fm_util_set_no_overwrite(no_overwrite)
Set the default value for the optional "no_overwrite" variable used in some of these subroutines.
Definition fm_util.F90:283
fm_util_mod::fm_util_set_value
Definition fm_util.F90:130
fms_io_utils_mod::get_data_type_string
Definition fms_io_utils.F90:170
mpp_mod::mpp_error
Error handler.
Definition mpp.F90:382
mpp_mod::mpp_sum
Reduction operation.
Definition mpp.F90:597