FMS  2024.03
Flexible Modeling System
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 !> @{
40 module 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
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
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
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 
82 contains
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
1438 end module atmos_ocean_fluxes_mod
1439 !> @}
1440 ! close documentation grouping
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.
subroutine, public atmos_ocean_type_fluxes_init(verbosity)
Initialize the coupler type flux tracers Initialize the /coupler_mod/types/ fields in the field manag...
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.
integer, public ind_kw
The index for the piston velocity.
integer, public ind_u10
The index of the 10 m wind speed.
integer, public ind_runoff
The index for a runoff flux.
integer, public ind_csurf
The index of the ocean surface concentration.
integer, public ind_sc_no
The index for the Schmidt number for a tracer flux.
integer, public ind_deposition
The index for the atmospheric deposition flux.
integer, public ind_alpha
The index of the solubility array for a tracer.
integer, public ind_flux
The index for the tracer flux.
integer, public ind_pcair
The index of the atmospheric concentration.
integer, public ind_flux0
The index for the piston velocity.
integer, public ind_psurf
The index of the surface atmospheric pressure.
integer, public ind_deltap
The index for ocean-air gas partial pressure change.
Coupler data for 1D boundary conditions.
integer, parameter, public fm_string_len
The length of a character string representing character values for the field.
logical function, public fm_exists(name)
A function to test whether a named field exists.
logical function, public fm_change_list(name)
Change the current list. Return true on success, false otherwise.
integer function, public fm_new_list(name, create, keep)
A function to create a new list.
character(len=fms_path_len) function, public fm_get_current_list()
A function to return the full path of the current list.
integer function, public fm_get_index(name)
A function to return the index of a named field.
integer, parameter, public fm_field_name_len
The length of a character string representing the field name.
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...
logical function, public fm_dump_list(name, recursive, unit)
A function to list properties associated with a field.
A function for looping over a list.
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
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
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
subroutine, public fm_util_check_for_bad_fields(list, good_fields, caller)
Check for unrecognized fields in a list.
Definition: fm_util.F90:343
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
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
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
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
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
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
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
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
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
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
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
subroutine, public write_version_number(version, tag, unit)
Prints to the log file (or a specified unit) the version id string and tag name.
Definition: fms.F90:758
integer function stdout()
This function returns the current standard fortran unit numbers for output.
Definition: mpp_util.inc:43
integer function mpp_npes()
Returns processor count for current pelist.
Definition: mpp_util.inc:421
Error handler.
Definition: mpp.F90:382
Reduction operation.
Definition: mpp.F90:597