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