MOM6
mom_ocmip2_cfc Module Reference

Detailed Description

Simulates CFCs using the OCMIP2 protocols.

By Robert Hallberg, 2007

This module contains the code that is needed to set up and use CFC-11 and CFC-12 in a fully coupled or ice-ocean model context using the OCMIP2 protocols

Data Types

type  ocmip2_cfc_cs
 The control structure for the OCMPI2_CFC tracer package. More...
 

Functions/Subroutines

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 tracer package. More...
 
subroutine, public flux_init_ocmip2_cfc (CS, verbosity)
 This subroutine initializes the air-sea CFC fluxes, and optionally returns the indicies of these fluxes. It can safely be called multiple times. More...
 
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. More...
 
subroutine init_tracer_cfc (h, tr, name, land_val, IC_val, G, US, CS)
 This subroutine initializes a tracer array. More...
 
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 chemistry to the OCMIP2 CFC tracers. CFCs are relatively simple, as they are passive tracers with only a surface flux as a source. More...
 
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 stocks it has calculated. If the stock_index is present, only the stock corresponding to that coded index is returned. More...
 
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 atmosphere to calculate CFC fluxes. More...
 
subroutine, public ocmip2_cfc_end (CS)
 Deallocate any memory associated with the OCMIP2 CFC tracer package. More...
 

Variables

integer, parameter ntr = 2
 the number of tracers in this module. More...
 

Function/Subroutine Documentation

◆ flux_init_ocmip2_cfc()

subroutine, public mom_ocmip2_cfc::flux_init_ocmip2_cfc ( type(ocmip2_cfc_cs), optional, pointer  CS,
integer, intent(in), optional  verbosity 
)

This subroutine initializes the air-sea CFC fluxes, and optionally returns the indicies of these fluxes. It can safely be called multiple times.

Parameters
csAn optional pointer to the control structure for this module; if not present, the flux indicies are not stored.
[in]verbosityA 0-9 integer indicating a level of verbosity.

Definition at line 282 of file MOM_OCMIP2_CFC.F90.

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 

References atmos_ocean_fluxes_mod::aof_set_coupler_flux().

Referenced by register_ocmip2_cfc().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ init_tracer_cfc()

subroutine mom_ocmip2_cfc::init_tracer_cfc ( real, dimension( g %isd: g %ied, g %jsd: g %jed, g %ke), intent(in)  h,
real, dimension( g %isd: g %ied, g %jsd: g %jed, g %ke), intent(out)  tr,
character(len=*), intent(in)  name,
real, intent(in)  land_val,
real, intent(in)  IC_val,
type(ocean_grid_type), intent(in)  G,
type(unit_scale_type), intent(in)  US,
type(ocmip2_cfc_cs), pointer  CS 
)
private

This subroutine initializes a tracer array.

Parameters
[in]gThe ocean's grid structure
[in]usA dimensional unit scaling type
[in]hLayer thicknesses [H ~> m or kg m-2]
[out]trThe tracer concentration array
[in]nameThe tracer name
[in]land_valA value the tracer takes over land
[in]ic_valThe initial condition value for the tracer
csThe control structure returned by a previous call to register_OCMIP2_CFC.

Definition at line 363 of file MOM_OCMIP2_CFC.F90.

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 

References mom_error_handler::mom_error(), and mom_tracer_z_init::tracer_z_init().

Referenced by initialize_ocmip2_cfc().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ initialize_ocmip2_cfc()

subroutine, public mom_ocmip2_cfc::initialize_ocmip2_cfc ( logical, intent(in)  restart,
type(time_type), intent(in), target  day,
type(ocean_grid_type), intent(in)  G,
type(verticalgrid_type), intent(in)  GV,
type(unit_scale_type), intent(in)  US,
real, dimension(szi_(g),szj_(g),szk_(g)), intent(in)  h,
type(diag_ctrl), intent(in), target  diag,
type(ocean_obc_type), pointer  OBC,
type(ocmip2_cfc_cs), pointer  CS,
type(sponge_cs), pointer  sponge_CSp 
)

Initialize the OCMP2 CFC tracer fields and set up the tracer output.

Parameters
[in]restart.true. if the fields have already been read from a restart file.
[in]dayTime of the start of the run.
[in]gThe ocean's grid structure.
[in]gvThe ocean's vertical grid structure.
[in]usA dimensional unit scaling type
[in]hLayer thicknesses [H ~> m or kg m-2].
[in]diagA structure that is used to regulate diagnostic output.
obcThis open boundary condition type specifies whether, where, and what open boundary conditions are used.
csThe control structure returned by a previous call to register_OCMIP2_CFC.
sponge_cspA pointer to the control structure for the sponges, if they are in use. Otherwise this may be unassociated.

Definition at line 317 of file MOM_OCMIP2_CFC.F90.

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 

References init_tracer_cfc().

Here is the call graph for this function:

◆ ocmip2_cfc_column_physics()

subroutine, public mom_ocmip2_cfc::ocmip2_cfc_column_physics ( real, dimension( g %isd: g %ied, g %jsd: g %jed, g %ke), intent(in)  h_old,
real, dimension( g %isd: g %ied, g %jsd: g %jed, g %ke), intent(in)  h_new,
real, dimension( g %isd: g %ied, g %jsd: g %jed, g %ke), intent(in)  ea,
real, dimension( g %isd: g %ied, g %jsd: g %jed, g %ke), intent(in)  eb,
type(forcing), intent(in)  fluxes,
real, intent(in)  dt,
type(ocean_grid_type), intent(in)  G,
type(verticalgrid_type), intent(in)  GV,
type(unit_scale_type), intent(in)  US,
type(ocmip2_cfc_cs), pointer  CS,
real, intent(in), optional  evap_CFL_limit,
real, intent(in), optional  minimum_forcing_depth 
)

This subroutine applies diapycnal diffusion, souces and sinks and any other column tracer physics or chemistry to the OCMIP2 CFC tracers. CFCs are relatively simple, as they are passive tracers with only a surface flux as a source.

Parameters
[in]gThe ocean's grid structure
[in]gvThe ocean's vertical grid structure
[in]h_oldLayer thickness before entrainment [H ~> m or kg m-2].
[in]h_newLayer thickness after entrainment [H ~> m or kg m-2].
[in]eaan array to which the amount of fluid entrained
[in]eban array to which the amount of fluid entrained
[in]fluxesA structure containing pointers to thermodynamic and tracer forcing fields. Unused fields have NULL ptrs.
[in]dtThe amount of time covered by this call [T ~> s]
[in]usA dimensional unit scaling type
csThe control structure returned by a previous call to register_OCMIP2_CFC.
[in]evap_cfl_limitLimit on the fraction of the water that can be fluxed out of the top layer in a timestep [nondim]
[in]minimum_forcing_depthThe smallest depth over which fluxes can be applied [H ~> m or kg m-2]

Definition at line 411 of file MOM_OCMIP2_CFC.F90.

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 

References mom_tracer_diabatic::applytracerboundaryfluxesinout(), and mom_tracer_diabatic::tracer_vertdiff().

Here is the call graph for this function:

◆ ocmip2_cfc_end()

subroutine, public mom_ocmip2_cfc::ocmip2_cfc_end ( type(ocmip2_cfc_cs), pointer  CS)

Deallocate any memory associated with the OCMIP2 CFC tracer package.

Parameters
csThe control structure returned by a previous call to register_OCMIP2_CFC.

Definition at line 618 of file MOM_OCMIP2_CFC.F90.

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

◆ ocmip2_cfc_stock()

integer function, public mom_ocmip2_cfc::ocmip2_cfc_stock ( real, dimension( g %isd: g %ied, g %jsd: g %jed, g %ke), intent(in)  h,
real, dimension(:), intent(out)  stocks,
type(ocean_grid_type), intent(in)  G,
type(verticalgrid_type), intent(in)  GV,
type(ocmip2_cfc_cs), pointer  CS,
character(len=*), dimension(:), intent(out)  names,
character(len=*), dimension(:), intent(out)  units,
integer, intent(in), optional  stock_index 
)

This function calculates the mass-weighted integral of all tracer stocks, returning the number of stocks it has calculated. If the stock_index is present, only the stock corresponding to that coded index is returned.

Parameters
[in]gThe ocean's grid structure.
[in]gvThe ocean's vertical grid structure.
[in]hLayer thicknesses [H ~> m or kg m-2].
[out]stocksthe mass-weighted integrated amount of each tracer, in kg times concentration units [kg conc].
csThe control structure returned by a previous call to register_OCMIP2_CFC.
[out]namesThe names of the stocks calculated.
[out]unitsThe units of the stocks calculated.
[in]stock_indexThe coded index of a specific stock being sought.
Returns
The number of stocks calculated here.

Definition at line 497 of file MOM_OCMIP2_CFC.F90.

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 

References mom_io::query_vardesc().

Referenced by mom_tracer_flow_control::call_tracer_stocks().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ocmip2_cfc_surface_state()

subroutine, public mom_ocmip2_cfc::ocmip2_cfc_surface_state ( type(surface), intent(inout)  state,
real, dimension(szi_(g),szj_(g),szk_(g)), intent(in)  h,
type(ocean_grid_type), intent(in)  G,
type(ocmip2_cfc_cs), pointer  CS 
)

This subroutine extracts the surface CFC concentrations and other fields that are shared with the atmosphere to calculate CFC fluxes.

Parameters
[in]gThe ocean's grid structure.
[in,out]stateA structure containing fields that describe the surface state of the ocean.
[in]hLayer thickness [H ~> m or kg m-2].
csThe control structure returned by a previous call to register_OCMIP2_CFC.

Definition at line 546 of file MOM_OCMIP2_CFC.F90.

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 

◆ register_ocmip2_cfc()

logical function, public mom_ocmip2_cfc::register_ocmip2_cfc ( type(hor_index_type), intent(in)  HI,
type(verticalgrid_type), intent(in)  GV,
type(param_file_type), intent(in)  param_file,
type(ocmip2_cfc_cs), pointer  CS,
type(tracer_registry_type), pointer  tr_Reg,
type(mom_restart_cs), pointer  restart_CS 
)

Register the OCMIP2 CFC tracers to be used with MOM and read the parameters that are used with this tracer package.

Parameters
[in]hiA horizontal index type structure.
[in]gvThe ocean's vertical grid structure.
[in]param_fileA structure to parse for run-time parameters.
csA pointer that is set to point to the control structure for this module.
tr_regA pointer to the tracer registry.
restart_csA pointer to the restart control structure.

Definition at line 93 of file MOM_OCMIP2_CFC.F90.

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.

References flux_init_ocmip2_cfc(), mom_error_handler::mom_error(), mom_tracer_registry::register_tracer(), and mom_io::var_desc().

Here is the call graph for this function:

Variable Documentation

◆ ntr

integer, parameter mom_ocmip2_cfc::ntr = 2
private

the number of tracers in this module.

Definition at line 37 of file MOM_OCMIP2_CFC.F90.

37 integer, parameter :: NTR = 2 !< the number of tracers in this module.