MOM6
MOM_OCMIP2_CFC.F90
Go to the documentation of this file.
1 !> Simulates CFCs using the OCMIP2 protocols
3 
4 ! This file is part of MOM6. See LICENSE.md for the license.
5 
7 use mom_error_handler, only : mom_error, fatal, warning
9 use mom_forcing_type, only : forcing
10 use mom_hor_index, only : hor_index_type
11 use mom_grid, only : ocean_grid_type
16 use mom_time_manager, only : time_type
21 use mom_variables, only : surface
23 
24 use coupler_types_mod, only : ind_flux, ind_alpha, ind_csurf
25 use coupler_types_mod, only : coupler_type_extract_data, coupler_type_set_data
27 
28 implicit none ; private
29 
30 #include <MOM_memory.h>
31 
35 
36 
37 integer, parameter :: ntr = 2 !< the number of tracers in this module.
38 
39 !> The control structure for the OCMPI2_CFC tracer package
40 type, public :: ocmip2_cfc_cs ; private
41  character(len=200) :: ic_file !< The file in which the CFC initial values can
42  !! be found, or an empty string for internal initilaization.
43  logical :: z_ic_file !< If true, the IC_file is in Z-space. The default is false..
44  type(time_type), pointer :: time => null() !< A pointer to the ocean model's clock.
45  type(tracer_registry_type), pointer :: tr_reg => null() !< A pointer to the MOM6 tracer registry
46  real, pointer, dimension(:,:,:) :: &
47  cfc11 => null(), & !< The CFC11 concentration [mol m-3].
48  cfc12 => null() !< The CFC12 concentration [mol m-3].
49  ! In the following variables a suffix of _11 refers to CFC11 and _12 to CFC12.
50  !>@{ Coefficients used in the CFC11 and CFC12 solubility calculation
51  real :: a1_11, a1_12 ! Coefficients for calculating CFC11 and CFC12 Schmidt numbers [nondim]
52  real :: a2_11, a2_12 ! Coefficients for calculating CFC11 and CFC12 Schmidt numbers [degC-1]
53  real :: a3_11, a3_12 ! Coefficients for calculating CFC11 and CFC12 Schmidt numbers [degC-2]
54  real :: a4_11, a4_12 ! Coefficients for calculating CFC11 and CFC12 Schmidt numbers [degC-3]
55 
56  real :: d1_11, d1_12 ! Coefficients for calculating CFC11 and CFC12 solubilities [nondim]
57  real :: d2_11, d2_12 ! Coefficients for calculating CFC11 and CFC12 solubilities [hectoKelvin-1]
58  real :: d3_11, d3_12 ! Coefficients for calculating CFC11 and CFC12 solubilities [log(hectoKelvin)-1]
59  real :: d4_11, d4_12 ! Coefficients for calculating CFC11 and CFC12 solubilities [hectoKelvin-2]
60 
61  real :: e1_11, e1_12 ! Coefficients for calculating CFC11 and CFC12 solubilities [PSU-1]
62  real :: e2_11, e2_12 ! Coefficients for calculating CFC11 and CFC12 solubilities [PSU-1 hectoKelvin-1]
63  real :: e3_11, e3_12 ! Coefficients for calculating CFC11 and CFC12 solubilities [PSU-2 hectoKelvin-2]
64  !!@}
65  real :: cfc11_ic_val = 0.0 !< The initial value assigned to CFC11 [mol m-3].
66  real :: cfc12_ic_val = 0.0 !< The initial value assigned to CFC12 [mol m-3].
67  real :: cfc11_land_val = -1.0 !< The value of CFC11 used where land is masked out [mol m-3].
68  real :: cfc12_land_val = -1.0 !< The value of CFC12 used where land is masked out [mol m-3].
69  logical :: tracers_may_reinit !< If true, tracers may be reset via the initialization code
70  !! if they are not found in the restart files.
71  character(len=16) :: cfc11_name !< CFC11 variable name
72  character(len=16) :: cfc12_name !< CFC12 variable name
73 
74  integer :: ind_cfc_11_flux !< Index returned by aof_set_coupler_flux that is used to
75  !! pack and unpack surface boundary condition arrays.
76  integer :: ind_cfc_12_flux !< Index returned by aof_set_coupler_flux that is used to
77  !! pack and unpack surface boundary condition arrays.
78 
79  type(diag_ctrl), pointer :: diag => null() ! A structure that is used to
80  ! regulate the timing of diagnostic output.
81  type(mom_restart_cs), pointer :: restart_csp => null()
82 
83  ! The following vardesc types contain a package of metadata about each tracer.
84  type(vardesc) :: cfc11_desc !< A set of metadata for the CFC11 tracer
85  type(vardesc) :: cfc12_desc !< A set of metadata for the CFC12 tracer
86 end type ocmip2_cfc_cs
87 
88 contains
89 
90 !> Register the OCMIP2 CFC tracers to be used with MOM and read the parameters
91 !! that are used with this tracer package
92 function register_ocmip2_cfc(HI, GV, param_file, CS, tr_Reg, restart_CS)
93  type(hor_index_type), intent(in) :: hi !< A horizontal index type structure.
94  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure.
95  type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters.
96  type(ocmip2_cfc_cs), pointer :: cs !< A pointer that is set to point to the control
97  !! structure for this module.
98  type(tracer_registry_type), &
99  pointer :: tr_reg !< A pointer to the tracer registry.
100  type(mom_restart_cs), pointer :: restart_cs !< A pointer to the restart control structure.
101 ! This subroutine is used to register tracer fields and subroutines
102 ! to be used with MOM.
103 
104  ! Local variables
105  character(len=40) :: mdl = "MOM_OCMIP2_CFC" ! This module's name.
106  character(len=200) :: inputdir ! The directory where NetCDF input files are.
107  ! This include declares and sets the variable "version".
108 #include "version_variable.h"
109  real, dimension(:,:,:), pointer :: tr_ptr => null()
110  real :: a11_dflt(4), a12_dflt(4) ! Default values of the various coefficients
111  real :: d11_dflt(4), d12_dflt(4) ! In the expressions for the solubility and
112  real :: e11_dflt(3), e12_dflt(3) ! Schmidt numbers.
113  character(len=48) :: flux_units ! The units for tracer fluxes.
114  logical :: register_ocmip2_cfc
115  integer :: isd, ied, jsd, jed, nz, m
116 
117  isd = hi%isd ; ied = hi%ied ; jsd = hi%jsd ; jed = hi%jed ; nz = gv%ke
118 
119  if (associated(cs)) then
120  call mom_error(warning, "register_OCMIP2_CFC called with an "// &
121  "associated control structure.")
122  return
123  endif
124  allocate(cs)
125 
126  ! This call sets default properties for the air-sea CFC fluxes and obtains the
127  ! indicies for the CFC11 and CFC12 flux coupling.
128  call flux_init_ocmip2_cfc(cs, verbosity=3)
129  if ((cs%ind_cfc_11_flux < 0) .or. (cs%ind_cfc_11_flux < 0)) then
130  ! This is most likely to happen with the dummy version of aof_set_coupler_flux
131  ! used in ocean-only runs.
132  call mom_error(warning, "CFCs are currently only set up to be run in " // &
133  " coupled model configurations, and will be disabled.")
134  deallocate(cs)
135  register_ocmip2_cfc = .false.
136  return
137  endif
138 
139  ! Read all relevant parameters and write them to the model log.
140  call log_version(param_file, mdl, version, "")
141  call get_param(param_file, mdl, "CFC_IC_FILE", cs%IC_file, &
142  "The file in which the CFC initial values can be "//&
143  "found, or an empty string for internal initialization.", &
144  default=" ")
145  if ((len_trim(cs%IC_file) > 0) .and. (scan(cs%IC_file,'/') == 0)) then
146  ! Add the directory if CS%IC_file is not already a complete path.
147  call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".")
148  cs%IC_file = trim(slasher(inputdir))//trim(cs%IC_file)
149  call log_param(param_file, mdl, "INPUTDIR/CFC_IC_FILE", cs%IC_file)
150  endif
151  call get_param(param_file, mdl, "CFC_IC_FILE_IS_Z", cs%Z_IC_file, &
152  "If true, CFC_IC_FILE is in depth space, not layer space", &
153  default=.false.)
154  call get_param(param_file, mdl, "TRACERS_MAY_REINIT", cs%tracers_may_reinit, &
155  "If true, tracers may go through the initialization code "//&
156  "if they are not found in the restart files. Otherwise "//&
157  "it is a fatal error if tracers are not found in the "//&
158  "restart files of a restarted run.", default=.false.)
159 
160  ! The following vardesc types contain a package of metadata about each tracer,
161  ! including, the name; units; longname; and grid information.
162  cs%CFC11_name = "CFC11" ; cs%CFC12_name = "CFC12"
163  cs%CFC11_desc = var_desc(cs%CFC11_name,"mol m-3","CFC-11 Concentration", caller=mdl)
164  cs%CFC12_desc = var_desc(cs%CFC12_name,"mol m-3","CFC-12 Concentration", caller=mdl)
165  if (gv%Boussinesq) then ; flux_units = "mol s-1"
166  else ; flux_units = "mol m-3 kg s-1" ; endif
167 
168  allocate(cs%CFC11(isd:ied,jsd:jed,nz)) ; cs%CFC11(:,:,:) = 0.0
169  allocate(cs%CFC12(isd:ied,jsd:jed,nz)) ; cs%CFC12(:,:,:) = 0.0
170 
171  ! This pointer assignment is needed to force the compiler not to do a copy in
172  ! the registration calls. Curses on the designers and implementers of F90.
173  tr_ptr => cs%CFC11
174  ! Register CFC11 for horizontal advection, diffusion, and restarts.
175  call register_tracer(tr_ptr, tr_reg, param_file, hi, gv, &
176  tr_desc=cs%CFC11_desc, registry_diags=.true., &
177  flux_units=flux_units, &
178  restart_cs=restart_cs, mandatory=.not.cs%tracers_may_reinit)
179  ! Do the same for CFC12
180  tr_ptr => cs%CFC12
181  call register_tracer(tr_ptr, tr_reg, param_file, hi, gv, &
182  tr_desc=cs%CFC12_desc, registry_diags=.true., &
183  flux_units=flux_units, &
184  restart_cs=restart_cs, mandatory=.not.cs%tracers_may_reinit)
185 
186  ! Set and read the various empirical coefficients.
187 
188 !-----------------------------------------------------------------------
189 ! Default Schmidt number coefficients for CFC11 (_11) and CFC12 (_12) are given
190 ! by Zheng et al (1998), JGR vol 103, C1.
191 !-----------------------------------------------------------------------
192  a11_dflt(:) = (/ 3501.8, -210.31, 6.1851, -0.07513 /)
193  a12_dflt(:) = (/ 3845.4, -228.95, 6.1908, -0.06743 /)
194  call get_param(param_file, mdl, "CFC11_A1", cs%a1_11, &
195  "A coefficient in the Schmidt number of CFC11.", &
196  units="nondim", default=a11_dflt(1))
197  call get_param(param_file, mdl, "CFC11_A2", cs%a2_11, &
198  "A coefficient in the Schmidt number of CFC11.", &
199  units="degC-1", default=a11_dflt(2))
200  call get_param(param_file, mdl, "CFC11_A3", cs%a3_11, &
201  "A coefficient in the Schmidt number of CFC11.", &
202  units="degC-2", default=a11_dflt(3))
203  call get_param(param_file, mdl, "CFC11_A4", cs%a4_11, &
204  "A coefficient in the Schmidt number of CFC11.", &
205  units="degC-3", default=a11_dflt(4))
206 
207  call get_param(param_file, mdl, "CFC12_A1", cs%a1_12, &
208  "A coefficient in the Schmidt number of CFC12.", &
209  units="nondim", default=a12_dflt(1))
210  call get_param(param_file, mdl, "CFC12_A2", cs%a2_12, &
211  "A coefficient in the Schmidt number of CFC12.", &
212  units="degC-1", default=a12_dflt(2))
213  call get_param(param_file, mdl, "CFC12_A3", cs%a3_12, &
214  "A coefficient in the Schmidt number of CFC12.", &
215  units="degC-2", default=a12_dflt(3))
216  call get_param(param_file, mdl, "CFC12_A4", cs%a4_12, &
217  "A coefficient in the Schmidt number of CFC12.", &
218  units="degC-3", default=a12_dflt(4))
219 
220 !-----------------------------------------------------------------------
221 ! Solubility coefficients for alpha in mol/l/atm for CFC11 (_11) and CFC12 (_12)
222 ! after Warner and Weiss (1985) DSR, vol 32.
223 !-----------------------------------------------------------------------
224  d11_dflt(:) = (/ -229.9261, 319.6552, 119.4471, -1.39165 /)
225  e11_dflt(:) = (/ -0.142382, 0.091459, -0.0157274 /)
226  d12_dflt(:) = (/ -218.0971, 298.9702, 113.8049, -1.39165 /)
227  e12_dflt(:) = (/ -0.143566, 0.091015, -0.0153924 /)
228 
229  call get_param(param_file, mdl, "CFC11_D1", cs%d1_11, &
230  "A coefficient in the solubility of CFC11.", &
231  units="none", default=d11_dflt(1))
232  call get_param(param_file, mdl, "CFC11_D2", cs%d2_11, &
233  "A coefficient in the solubility of CFC11.", &
234  units="hK", default=d11_dflt(2))
235  call get_param(param_file, mdl, "CFC11_D3", cs%d3_11, &
236  "A coefficient in the solubility of CFC11.", &
237  units="none", default=d11_dflt(3))
238  call get_param(param_file, mdl, "CFC11_D4", cs%d4_11, &
239  "A coefficient in the solubility of CFC11.", &
240  units="hK-2", default=d11_dflt(4))
241  call get_param(param_file, mdl, "CFC11_E1", cs%e1_11, &
242  "A coefficient in the solubility of CFC11.", &
243  units="PSU-1", default=e11_dflt(1))
244  call get_param(param_file, mdl, "CFC11_E2", cs%e2_11, &
245  "A coefficient in the solubility of CFC11.", &
246  units="PSU-1 hK-1", default=e11_dflt(2))
247  call get_param(param_file, mdl, "CFC11_E3", cs%e3_11, &
248  "A coefficient in the solubility of CFC11.", &
249  units="PSU-1 hK-2", default=e11_dflt(3))
250 
251  call get_param(param_file, mdl, "CFC12_D1", cs%d1_12, &
252  "A coefficient in the solubility of CFC12.", &
253  units="none", default=d12_dflt(1))
254  call get_param(param_file, mdl, "CFC12_D2", cs%d2_12, &
255  "A coefficient in the solubility of CFC12.", &
256  units="hK", default=d12_dflt(2))
257  call get_param(param_file, mdl, "CFC12_D3", cs%d3_12, &
258  "A coefficient in the solubility of CFC12.", &
259  units="none", default=d12_dflt(3))
260  call get_param(param_file, mdl, "CFC12_D4", cs%d4_12, &
261  "A coefficient in the solubility of CFC12.", &
262  units="hK-2", default=d12_dflt(4))
263  call get_param(param_file, mdl, "CFC12_E1", cs%e1_12, &
264  "A coefficient in the solubility of CFC12.", &
265  units="PSU-1", default=e12_dflt(1))
266  call get_param(param_file, mdl, "CFC12_E2", cs%e2_12, &
267  "A coefficient in the solubility of CFC12.", &
268  units="PSU-1 hK-1", default=e12_dflt(2))
269  call get_param(param_file, mdl, "CFC12_E3", cs%e3_12, &
270  "A coefficient in the solubility of CFC12.", &
271  units="PSU-1 hK-2", default=e12_dflt(3))
272 
273  cs%tr_Reg => tr_reg
274  cs%restart_CSp => restart_cs
275 
276  register_ocmip2_cfc = .true.
277 end function register_ocmip2_cfc
278 
279 !> This subroutine initializes the air-sea CFC fluxes, and optionally returns
280 !! the indicies of these fluxes. It can safely be called multiple times.
281 subroutine flux_init_ocmip2_cfc(CS, verbosity)
282  type(ocmip2_cfc_cs), optional, pointer :: cs !< An optional pointer to the control structure
283  !! for this module; if not present, the flux indicies
284  !! are not stored.
285  integer, optional, intent(in) :: verbosity !< A 0-9 integer indicating a level of verbosity.
286 
287  ! These can be overridden later in via the field manager?
288  character(len=128) :: default_ice_restart_file = 'ice_ocmip2_cfc.res.nc'
289  character(len=128) :: default_ocean_restart_file = 'ocmip2_cfc.res.nc'
290  integer :: ind_flux(2) ! Integer indices of the fluxes
291 
292  ! These calls obtain the indices for the CFC11 and CFC12 flux coupling. They
293  ! can safely be called multiple times.
294  ind_flux(1) = aof_set_coupler_flux('cfc_11_flux', &
295  flux_type = 'air_sea_gas_flux', implementation = 'ocmip2', &
296  param = (/ 9.36e-07, 9.7561e-06 /), &
297  ice_restart_file = default_ice_restart_file, &
298  ocean_restart_file = default_ocean_restart_file, &
299  caller = "register_OCMIP2_CFC", verbosity=verbosity)
300  ind_flux(2) = aof_set_coupler_flux('cfc_12_flux', &
301  flux_type = 'air_sea_gas_flux', implementation = 'ocmip2', &
302  param = (/ 9.36e-07, 9.7561e-06 /), &
303  ice_restart_file = default_ice_restart_file, &
304  ocean_restart_file = default_ocean_restart_file, &
305  caller = "register_OCMIP2_CFC", verbosity=verbosity)
306 
307  if (present(cs)) then ; if (associated(cs)) then
308  cs%ind_cfc_11_flux = ind_flux(1)
309  cs%ind_cfc_12_flux = ind_flux(2)
310  endif ; endif
311 
312 end subroutine flux_init_ocmip2_cfc
313 
314 !> Initialize the OCMP2 CFC tracer fields and set up the tracer output.
315 subroutine initialize_ocmip2_cfc(restart, day, G, GV, US, h, diag, OBC, CS, &
316  sponge_CSp)
317  logical, intent(in) :: restart !< .true. if the fields have already been
318  !! read from a restart file.
319  type(time_type), target, intent(in) :: day !< Time of the start of the run.
320  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure.
321  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure.
322  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
323  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
324  intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
325  type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate
326  !! diagnostic output.
327  type(ocean_obc_type), pointer :: obc !< This open boundary condition type
328  !! specifies whether, where, and what
329  !! open boundary conditions are used.
330  type(ocmip2_cfc_cs), pointer :: cs !< The control structure returned by a
331  !! previous call to register_OCMIP2_CFC.
332  type(sponge_cs), pointer :: sponge_csp !< A pointer to the control structure for
333  !! the sponges, if they are in use.
334  !! Otherwise this may be unassociated.
335 ! This subroutine initializes the NTR tracer fields in tr(:,:,:,:)
336 ! and it sets up the tracer output.
337 
338  logical :: from_file = .false.
339 
340  if (.not.associated(cs)) return
341 
342  cs%Time => day
343  cs%diag => diag
344 
345  if (.not.restart .or. (cs%tracers_may_reinit .and. &
346  .not.query_initialized(cs%CFC11, cs%CFC11_name, cs%restart_CSp))) &
347  call init_tracer_cfc(h, cs%CFC11, cs%CFC11_name, cs%CFC11_land_val, &
348  cs%CFC11_IC_val, g, us, cs)
349 
350  if (.not.restart .or. (cs%tracers_may_reinit .and. &
351  .not.query_initialized(cs%CFC12, cs%CFC12_name, cs%restart_CSp))) &
352  call init_tracer_cfc(h, cs%CFC12, cs%CFC12_name, cs%CFC12_land_val, &
353  cs%CFC12_IC_val, g, us, cs)
354 
355  if (associated(obc)) then
356  ! Steal from updated DOME in the fullness of time.
357  endif
358 
359 end subroutine initialize_ocmip2_cfc
360 
361 !>This subroutine initializes a tracer array.
362 subroutine init_tracer_cfc(h, tr, name, land_val, IC_val, G, US, CS)
363  type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
364  type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
365  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
366  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: tr !< The tracer concentration array
367  character(len=*), intent(in) :: name !< The tracer name
368  real, intent(in) :: land_val !< A value the tracer takes over land
369  real, intent(in) :: IC_val !< The initial condition value for the tracer
370  type(ocmip2_cfc_cs), pointer :: CS !< The control structure returned by a
371  !! previous call to register_OCMIP2_CFC.
372 
373  ! This subroutine initializes a tracer array.
374 
375  logical :: OK
376  integer :: i, j, k, is, ie, js, je, nz
377  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
378 
379  if (len_trim(cs%IC_file) > 0) then
380  ! Read the tracer concentrations from a netcdf file.
381  if (.not.file_exists(cs%IC_file, g%Domain)) &
382  call mom_error(fatal, "initialize_OCMIP2_CFC: Unable to open "//cs%IC_file)
383  if (cs%Z_IC_file) then
384  ok = tracer_z_init(tr, h, cs%IC_file, name, g, us)
385  if (.not.ok) then
386  ok = tracer_z_init(tr, h, cs%IC_file, trim(name), g, us)
387  if (.not.ok) call mom_error(fatal,"initialize_OCMIP2_CFC: "//&
388  "Unable to read "//trim(name)//" from "//&
389  trim(cs%IC_file)//".")
390  endif
391  else
392  call mom_read_data(cs%IC_file, trim(name), tr, g%Domain)
393  endif
394  else
395  do k=1,nz ; do j=js,je ; do i=is,ie
396  if (g%mask2dT(i,j) < 0.5) then
397  tr(i,j,k) = land_val
398  else
399  tr(i,j,k) = ic_val
400  endif
401  enddo ; enddo ; enddo
402  endif
403 
404 end subroutine init_tracer_cfc
405 
406 !> This subroutine applies diapycnal diffusion, souces and sinks and any other column
407 !! tracer physics or chemistry to the OCMIP2 CFC tracers.
408 !! CFCs are relatively simple, as they are passive tracers with only a surface flux as a source.
409 subroutine ocmip2_cfc_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, &
410  evap_CFL_limit, minimum_forcing_depth)
411  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure
412  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure
413  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
414  intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2].
415  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
416  intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2].
417  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
418  intent(in) :: ea !< an array to which the amount of fluid entrained
419  !! from the layer above during this call will be
420  !! added [H ~> m or kg m-2].
421  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
422  intent(in) :: eb !< an array to which the amount of fluid entrained
423  !! from the layer below during this call will be
424  !! added [H ~> m or kg m-2].
425  type(forcing), intent(in) :: fluxes !< A structure containing pointers to thermodynamic
426  !! and tracer forcing fields. Unused fields have NULL ptrs.
427  real, intent(in) :: dt !< The amount of time covered by this call [T ~> s]
428  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
429  type(ocmip2_cfc_cs), pointer :: cs !< The control structure returned by a
430  !! previous call to register_OCMIP2_CFC.
431  real, optional, intent(in) :: evap_cfl_limit !< Limit on the fraction of the water that can
432  !! be fluxed out of the top layer in a timestep [nondim]
433  real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which
434  !! fluxes can be applied [H ~> m or kg m-2]
435 ! This subroutine applies diapycnal diffusion and any other column
436 ! tracer physics or chemistry to the tracers from this file.
437 ! CFCs are relatively simple, as they are passive tracers. with only a surface
438 ! flux as a source.
439 
440 ! The arguments to this subroutine are redundant in that
441 ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1)
442 
443  ! Local variables
444  real :: b1(szi_(g)) ! b1 and c1 are variables used by the
445  real :: c1(szi_(g),szk_(g)) ! tridiagonal solver.
446  real, dimension(SZI_(G),SZJ_(G)) :: &
447  cfc11_flux, & ! The fluxes of CFC11 and CFC12 into the ocean, in the
448  cfc12_flux ! units of CFC concentrations times meters per second.
449  real, pointer, dimension(:,:,:) :: cfc11 => null(), cfc12 => null()
450  real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified
451  integer :: i, j, k, m, is, ie, js, je, nz, idim(4), jdim(4)
452 
453  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
454  idim(:) = (/g%isd, is, ie, g%ied/) ; jdim(:) = (/g%jsd, js, je, g%jed/)
455 
456  if (.not.associated(cs)) return
457 
458  cfc11 => cs%CFC11 ; cfc12 => cs%CFC12
459 
460  ! These two calls unpack the fluxes from the input arrays.
461  ! The -GV%Rho0 changes the sign convention of the flux and changes the units
462  ! of the flux from [Conc. m s-1] to [Conc. kg m-2 T-1].
463  call coupler_type_extract_data(fluxes%tr_fluxes, cs%ind_cfc_11_flux, ind_flux, cfc11_flux, &
464  scale_factor=-g%US%R_to_kg_m3*gv%Rho0*us%T_to_s, idim=idim, jdim=jdim)
465  call coupler_type_extract_data(fluxes%tr_fluxes, cs%ind_cfc_12_flux, ind_flux, cfc12_flux, &
466  scale_factor=-g%US%R_to_kg_m3*gv%Rho0*us%T_to_s, idim=idim, jdim=jdim)
467 
468  ! Use a tridiagonal solver to determine the concentrations after the
469  ! surface source is applied and diapycnal advection and diffusion occurs.
470  if (present(evap_cfl_limit) .and. present(minimum_forcing_depth)) then
471  do k=1,nz ;do j=js,je ; do i=is,ie
472  h_work(i,j,k) = h_old(i,j,k)
473  enddo ; enddo ; enddo
474  call applytracerboundaryfluxesinout(g, gv, cfc11, dt, fluxes, h_work, &
475  evap_cfl_limit, minimum_forcing_depth)
476  call tracer_vertdiff(h_work, ea, eb, dt, cfc11, g, gv, sfc_flux=cfc11_flux)
477 
478  do k=1,nz ;do j=js,je ; do i=is,ie
479  h_work(i,j,k) = h_old(i,j,k)
480  enddo ; enddo ; enddo
481  call applytracerboundaryfluxesinout(g, gv, cfc12, dt, fluxes, h_work, &
482  evap_cfl_limit, minimum_forcing_depth)
483  call tracer_vertdiff(h_work, ea, eb, dt, cfc12, g, gv, sfc_flux=cfc12_flux)
484  else
485  call tracer_vertdiff(h_old, ea, eb, dt, cfc11, g, gv, sfc_flux=cfc11_flux)
486  call tracer_vertdiff(h_old, ea, eb, dt, cfc12, g, gv, sfc_flux=cfc12_flux)
487  endif
488 
489  ! Write out any desired diagnostics from tracer sources & sinks here.
490 
491 end subroutine ocmip2_cfc_column_physics
492 
493 !> This function calculates the mass-weighted integral of all tracer stocks,
494 !! returning the number of stocks it has calculated. If the stock_index
495 !! is present, only the stock corresponding to that coded index is returned.
496 function ocmip2_cfc_stock(h, stocks, G, GV, CS, names, units, stock_index)
497  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure.
498  type(verticalgrid_type), intent(in) :: gv !< The ocean's vertical grid structure.
499  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
500  intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2].
501  real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount of each
502  !! tracer, in kg times concentration units [kg conc].
503  type(ocmip2_cfc_cs), pointer :: cs !< The control structure returned by a
504  !! previous call to register_OCMIP2_CFC.
505  character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated.
506  character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated.
507  integer, optional, intent(in) :: stock_index !< The coded index of a specific
508  !! stock being sought.
509  integer :: ocmip2_cfc_stock !< The number of stocks calculated here.
510 
511  ! Local variables
512  real :: mass
513  integer :: i, j, k, is, ie, js, je, nz
514  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = gv%ke
515 
516  ocmip2_cfc_stock = 0
517  if (.not.associated(cs)) return
518 
519  if (present(stock_index)) then ; if (stock_index > 0) then
520  ! Check whether this stock is available from this routine.
521 
522  ! No stocks from this routine are being checked yet. Return 0.
523  return
524  endif ; endif
525 
526  call query_vardesc(cs%CFC11_desc, name=names(1), units=units(1), caller="OCMIP2_CFC_stock")
527  call query_vardesc(cs%CFC12_desc, name=names(2), units=units(2), caller="OCMIP2_CFC_stock")
528  units(1) = trim(units(1))//" kg" ; units(2) = trim(units(2))//" kg"
529 
530  stocks(1) = 0.0 ; stocks(2) = 0.0
531  do k=1,nz ; do j=js,je ; do i=is,ie
532  mass = g%mask2dT(i,j) * g%US%L_to_m**2*g%areaT(i,j) * h(i,j,k)
533  stocks(1) = stocks(1) + cs%CFC11(i,j,k) * mass
534  stocks(2) = stocks(2) + cs%CFC12(i,j,k) * mass
535  enddo ; enddo ; enddo
536  stocks(1) = gv%H_to_kg_m2 * stocks(1)
537  stocks(2) = gv%H_to_kg_m2 * stocks(2)
538 
539  ocmip2_cfc_stock = 2
540 
541 end function ocmip2_cfc_stock
542 
543 !> This subroutine extracts the surface CFC concentrations and other fields that
544 !! are shared with the atmosphere to calculate CFC fluxes.
545 subroutine ocmip2_cfc_surface_state(state, h, G, CS)
546  type(ocean_grid_type), intent(in) :: g !< The ocean's grid structure.
547  type(surface), intent(inout) :: state !< A structure containing fields that
548  !! describe the surface state of the ocean.
549  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
550  intent(in) :: h !< Layer thickness [H ~> m or kg m-2].
551  type(ocmip2_cfc_cs), pointer :: cs !< The control structure returned by a previous
552  !! call to register_OCMIP2_CFC.
553 
554  ! Local variables
555  real, dimension(SZI_(G),SZJ_(G)) :: &
556  cfc11_csurf, & ! The CFC-11 surface concentrations times the Schmidt number term [mol m-3].
557  cfc12_csurf, & ! The CFC-12 surface concentrations times the Schmidt number term [mol m-3].
558  cfc11_alpha, & ! The CFC-11 solubility [mol m-3 pptv-1].
559  cfc12_alpha ! The CFC-12 solubility [mol m-3 pptv-1].
560  real :: ta ! Absolute sea surface temperature [hectoKelvin] (Why use such bizzare units?)
561  real :: sal ! Surface salinity [PSU].
562  real :: sst ! Sea surface temperature [degC].
563  real :: alpha_11 ! The solubility of CFC 11 [mol m-3 pptv-1].
564  real :: alpha_12 ! The solubility of CFC 12 [mol m-3 pptv-1].
565  real :: sc_11, sc_12 ! The Schmidt numbers of CFC 11 and CFC 12.
566  real :: sc_no_term ! A term related to the Schmidt number.
567  integer :: i, j, m, is, ie, js, je, idim(4), jdim(4)
568 
569  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
570  idim(:) = (/g%isd, is, ie, g%ied/) ; jdim(:) = (/g%jsd, js, je, g%jed/)
571 
572  if (.not.associated(cs)) return
573 
574  do j=js,je ; do i=is,ie
575  ta = max(0.01, (state%SST(i,j) + 273.15) * 0.01) ! Why is this in hectoKelvin?
576  sal = state%SSS(i,j) ; sst = state%SST(i,j)
577  ! Calculate solubilities using Warner and Weiss (1985) DSR, vol 32.
578  ! The final result is in mol/cm3/pptv (1 part per trillion 1e-12)
579  ! Use Bullister and Wisegavger for CCl4.
580  ! The factor 1.e-09 converts from mol/(l * atm) to mol/(m3 * pptv).
581  alpha_11 = exp(cs%d1_11 + cs%d2_11/ta + cs%d3_11*log(ta) + cs%d4_11*ta**2 +&
582  sal * ((cs%e3_11 * ta + cs%e2_11) * ta + cs%e1_11)) * &
583  1.0e-09 * g%mask2dT(i,j)
584  alpha_12 = exp(cs%d1_12 + cs%d2_12/ta + cs%d3_12*log(ta) + cs%d4_12*ta**2 +&
585  sal * ((cs%e3_12 * ta + cs%e2_12) * ta + cs%e1_12)) * &
586  1.0e-09 * g%mask2dT(i,j)
587  ! Calculate Schmidt numbers using coefficients given by
588  ! Zheng et al (1998), JGR vol 103, C1.
589  sc_11 = cs%a1_11 + sst * (cs%a2_11 + sst * (cs%a3_11 + sst * cs%a4_11)) * &
590  g%mask2dT(i,j)
591  sc_12 = cs%a1_12 + sst * (cs%a2_12 + sst * (cs%a3_12 + sst * cs%a4_12)) * &
592  g%mask2dT(i,j)
593  ! The abs here is to avoid NaNs. The model should be failing at this point.
594  sc_no_term = sqrt(660.0 / (abs(sc_11) + 1.0e-30))
595  cfc11_alpha(i,j) = alpha_11 * sc_no_term
596  cfc11_csurf(i,j) = cs%CFC11(i,j,1) * sc_no_term
597 
598  sc_no_term = sqrt(660.0 / (abs(sc_12) + 1.0e-30))
599  cfc12_alpha(i,j) = alpha_12 * sc_no_term
600  cfc12_csurf(i,j) = cs%CFC12(i,j,1) * sc_no_term
601  enddo ; enddo
602 
603  ! These calls load these values into the appropriate arrays in the
604  ! coupler-type structure.
605  call coupler_type_set_data(cfc11_alpha, cs%ind_cfc_11_flux, ind_alpha, &
606  state%tr_fields, idim=idim, jdim=jdim)
607  call coupler_type_set_data(cfc11_csurf, cs%ind_cfc_11_flux, ind_csurf, &
608  state%tr_fields, idim=idim, jdim=jdim)
609  call coupler_type_set_data(cfc12_alpha, cs%ind_cfc_12_flux, ind_alpha, &
610  state%tr_fields, idim=idim, jdim=jdim)
611  call coupler_type_set_data(cfc12_csurf, cs%ind_cfc_12_flux, ind_csurf, &
612  state%tr_fields, idim=idim, jdim=jdim)
613 
614 end subroutine ocmip2_cfc_surface_state
615 
616 !> Deallocate any memory associated with the OCMIP2 CFC tracer package
617 subroutine ocmip2_cfc_end(CS)
618  type(ocmip2_cfc_cs), pointer :: cs !< The control structure returned by a
619  !! previous call to register_OCMIP2_CFC.
620 ! This subroutine deallocates the memory owned by this module.
621 ! Argument: CS - The control structure returned by a previous call to
622 ! register_OCMIP2_CFC.
623  integer :: m
624 
625  if (associated(cs)) then
626  if (associated(cs%CFC11)) deallocate(cs%CFC11)
627  if (associated(cs%CFC12)) deallocate(cs%CFC12)
628 
629  deallocate(cs)
630  endif
631 end subroutine ocmip2_cfc_end
632 
633 
634 !> \namespace mom_ocmip2_cfc
635 !!
636 !! By Robert Hallberg, 2007
637 !!
638 !! This module contains the code that is needed to set
639 !! up and use CFC-11 and CFC-12 in a fully coupled or ice-ocean model
640 !! context using the OCMIP2 protocols
641 
642 end module mom_ocmip2_cfc
mom_ocmip2_cfc::init_tracer_cfc
subroutine init_tracer_cfc(h, tr, name, land_val, IC_val, G, US, CS)
This subroutine initializes a tracer array.
Definition: MOM_OCMIP2_CFC.F90:363
mom_time_manager
Wraps the FMS time manager functions.
Definition: MOM_time_manager.F90:2
mom_tracer_registry::register_tracer
subroutine, public register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, units, cmor_name, cmor_units, cmor_longname, tr_desc, OBC_inflow, OBC_in_u, OBC_in_v, ad_x, ad_y, df_x, df_y, ad_2d_x, ad_2d_y, df_2d_x, df_2d_y, advection_xy, registry_diags, flux_nameroot, flux_longname, flux_units, flux_scale, convergence_units, convergence_scale, cmor_tendprefix, diag_form, restart_CS, mandatory)
This subroutine registers a tracer to be advected and laterally diffused.
Definition: MOM_tracer_registry.F90:158
mom_variables::surface
Pointers to various fields which may be used describe the surface state of MOM, and which will be ret...
Definition: MOM_variables.F90:38
mom_io::var_desc
type(vardesc) function, public var_desc(name, units, longname, hor_grid, z_grid, t_grid, cmor_field_name, cmor_units, cmor_longname, conversion, caller)
Returns a vardesc type whose elements have been filled with the provided fields. The argument name is...
Definition: MOM_io.F90:600
mom_io::query_vardesc
subroutine, public query_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, cmor_field_name, cmor_units, cmor_longname, conversion, caller)
This routine queries vardesc.
Definition: MOM_io.F90:699
mom_verticalgrid
Provides a transparent vertical ocean grid type and supporting routines.
Definition: MOM_verticalGrid.F90:2
mom_ocmip2_cfc::ocmip2_cfc_column_physics
subroutine, public ocmip2_cfc_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, evap_CFL_limit, minimum_forcing_depth)
This subroutine applies diapycnal diffusion, souces and sinks and any other column tracer physics or ...
Definition: MOM_OCMIP2_CFC.F90:411
mom_tracer_diabatic::applytracerboundaryfluxesinout
subroutine, public applytracerboundaryfluxesinout(G, GV, Tr, dt, fluxes, h, evap_CFL_limit, minimum_forcing_depth, in_flux_optional, out_flux_optional, update_h_opt)
This routine is modeled after applyBoundaryFluxesInOut in MOM_diabatic_aux.F90 NOTE: Please note that...
Definition: MOM_tracer_diabatic.F90:230
mom_sponge::set_up_sponge_field
subroutine, public set_up_sponge_field(sp_val, f_ptr, G, nlay, CS, sp_val_i_mean)
This subroutine stores the reference profile for the variable whose address is given by f_ptr....
Definition: MOM_sponge.F90:214
mom_file_parser::log_version
An overloaded interface to log version information about modules.
Definition: MOM_file_parser.F90:109
atmos_ocean_fluxes_mod
A dummy version of atmos_ocean_fluxes_mod module for use when the vastly larger FMS package is not ne...
Definition: atmos_ocean_fluxes.F90:3
mom_ocmip2_cfc::ocmip2_cfc_end
subroutine, public ocmip2_cfc_end(CS)
Deallocate any memory associated with the OCMIP2 CFC tracer package.
Definition: MOM_OCMIP2_CFC.F90:618
mom_diag_mediator
The subroutines here provide convenient wrappers to the fms diag_manager interfaces with additional d...
Definition: MOM_diag_mediator.F90:3
mom_ocmip2_cfc::ocmip2_cfc_stock
integer function, public ocmip2_cfc_stock(h, stocks, G, GV, CS, names, units, stock_index)
This function calculates the mass-weighted integral of all tracer stocks, returning the number of sto...
Definition: MOM_OCMIP2_CFC.F90:497
mom_tracer_registry
This module contains the tracer_registry_type and the subroutines that handle registration of tracers...
Definition: MOM_tracer_registry.F90:5
mom_file_parser::param_file_type
A structure that can be parsed to read and document run-time parameters.
Definition: MOM_file_parser.F90:54
mom_file_parser::get_param
An overloaded interface to read and log the values of various types of parameters.
Definition: MOM_file_parser.F90:102
mom_hor_index
Defines the horizontal index type (hor_index_type) used for providing index ranges.
Definition: MOM_hor_index.F90:2
mom_ocmip2_cfc::register_ocmip2_cfc
logical function, public register_ocmip2_cfc(HI, GV, param_file, CS, tr_Reg, restart_CS)
Register the OCMIP2 CFC tracers to be used with MOM and read the parameters that are used with this t...
Definition: MOM_OCMIP2_CFC.F90:93
mom_io
This module contains I/O framework code.
Definition: MOM_io.F90:2
mom_restart::mom_restart_cs
A restart registry and the control structure for restarts.
Definition: MOM_restart.F90:72
mom_ocmip2_cfc
Simulates CFCs using the OCMIP2 protocols.
Definition: MOM_OCMIP2_CFC.F90:2
mom_tracer_z_init
Used to initialize tracers from a depth- (or z*-) space file.
Definition: MOM_tracer_Z_init.F90:2
mom_unit_scaling::unit_scale_type
Describes various unit conversion factors.
Definition: MOM_unit_scaling.F90:14
mom_tracer_diabatic
This module contains routines that implement physical fluxes of tracers (e.g. due to surface fluxes o...
Definition: MOM_tracer_diabatic.F90:4
mom_forcing_type
This module implements boundary forcing for MOM6.
Definition: MOM_forcing_type.F90:2
mom_ocmip2_cfc::flux_init_ocmip2_cfc
subroutine, public flux_init_ocmip2_cfc(CS, verbosity)
This subroutine initializes the air-sea CFC fluxes, and optionally returns the indicies of these flux...
Definition: MOM_OCMIP2_CFC.F90:282
mom_tracer_diabatic::tracer_vertdiff
subroutine, public tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, sfc_flux, btm_flux, btm_reservoir, sink_rate, convert_flux_in)
This subroutine solves a tridiagonal equation for the final tracer concentrations after the dual-entr...
Definition: MOM_tracer_diabatic.F90:27
mom_verticalgrid::verticalgrid_type
Describes the vertical ocean grid, including unit conversion factors.
Definition: MOM_verticalGrid.F90:24
mom_restart
The MOM6 facility for reading and writing restart files, and querying what has been read.
Definition: MOM_restart.F90:2
mom_variables
Provides transparent structures with groups of MOM6 variables and supporting routines.
Definition: MOM_variables.F90:2
mom_io::mom_read_data
Read a data field from a file.
Definition: MOM_io.F90:74
mom_open_boundary
Controls where open boundary conditions are applied.
Definition: MOM_open_boundary.F90:2
mom_file_parser
The MOM6 facility to parse input files for runtime parameters.
Definition: MOM_file_parser.F90:2
mom_sponge
Implements sponge regions in isopycnal mode.
Definition: MOM_sponge.F90:2
mom_tracer_z_init::tracer_z_init
logical function, public tracer_z_init(tr, h, filename, tr_name, G, US, missing_val, land_val)
This function initializes a tracer by reading a Z-space file, returning .true. if this appears to hav...
Definition: MOM_tracer_Z_init.F90:31
mom_tracer_registry::tracer_registry_type
Type to carry basic tracer information.
Definition: MOM_tracer_registry.F90:138
mom_hor_index::hor_index_type
Container for horizontal index ranges for data, computational and global domains.
Definition: MOM_hor_index.F90:15
mom_ocmip2_cfc::initialize_ocmip2_cfc
subroutine, public initialize_ocmip2_cfc(restart, day, G, GV, US, h, diag, OBC, CS, sponge_CSp)
Initialize the OCMP2 CFC tracer fields and set up the tracer output.
Definition: MOM_OCMIP2_CFC.F90:317
mom_grid
Provides the ocean grid type.
Definition: MOM_grid.F90:2
mom_open_boundary::ocean_obc_type
Open-boundary data.
Definition: MOM_open_boundary.F90:195
mom_sponge::sponge_cs
This control structure holds memory and parameters for the MOM_sponge module.
Definition: MOM_sponge.F90:41
mom_unit_scaling
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Definition: MOM_unit_scaling.F90:2
mom_forcing_type::forcing
Structure that contains pointers to the boundary forcing used to drive the liquid ocean simulated by ...
Definition: MOM_forcing_type.F90:50
mom_ocmip2_cfc::ocmip2_cfc_surface_state
subroutine, public ocmip2_cfc_surface_state(state, h, G, CS)
This subroutine extracts the surface CFC concentrations and other fields that are shared with the atm...
Definition: MOM_OCMIP2_CFC.F90:546
mom_io::vardesc
Type for describing a variable, typically a tracer.
Definition: MOM_io.F90:53
mom_io::file_exists
Indicate whether a file exists, perhaps with domain decomposition.
Definition: MOM_io.F90:68
mom_error_handler::mom_error
subroutine, public mom_error(level, message, all_print)
This provides a convenient interface for writing an mpp_error message with run-time filter based on a...
Definition: MOM_error_handler.F90:72
atmos_ocean_fluxes_mod::aof_set_coupler_flux
integer function, public aof_set_coupler_flux(name, flux_type, implementation, atm_tr_index, param, flag, mol_wt, ice_restart_file, ocean_restart_file, units, caller, verbosity)
This subroutine duplicates an interface used by the FMS coupler, but only returns a value of -1....
Definition: atmos_ocean_fluxes.F90:18
mom_file_parser::log_param
An overloaded interface to log the values of various types of parameters.
Definition: MOM_file_parser.F90:96
mom_restart::query_initialized
Indicate whether a field has been read from a restart file.
Definition: MOM_restart.F90:116
mom_ocmip2_cfc::ntr
integer, parameter ntr
the number of tracers in this module.
Definition: MOM_OCMIP2_CFC.F90:37
mom_error_handler
Routines for error handling and I/O management.
Definition: MOM_error_handler.F90:2
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:26
mom_ocmip2_cfc::ocmip2_cfc_cs
The control structure for the OCMPI2_CFC tracer package.
Definition: MOM_OCMIP2_CFC.F90:40
mom_diag_mediator::diag_ctrl
The following data type a list of diagnostic fields an their variants, as well as variables that cont...
Definition: MOM_diag_mediator.F90:239