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