MOM6
MOM_forcing_type.F90
Go to the documentation of this file.
1 !> This module implements boundary forcing for MOM6.
3 
4 ! This file is part of MOM6. See LICENSE.md for the license.
5 
6 use mom_debugging, only : hchksum, uvchksum
7 use mom_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, clock_routine
9 use mom_diag_mediator, only : time_type, diag_ctrl, safe_alloc_alloc, query_averaging_enabled
11 use mom_error_handler, only : mom_error, fatal, warning
14 use mom_grid, only : ocean_grid_type
20 
21 use coupler_types_mod, only : coupler_2d_bc_type, coupler_type_spawn
22 use coupler_types_mod, only : coupler_type_increment_data, coupler_type_initialized
23 use coupler_types_mod, only : coupler_type_copy_data, coupler_type_destructor
24 
25 implicit none ; private
26 
27 #include <MOM_memory.h>
28 
38 
39 ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
40 ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
41 ! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units
42 ! vary with the Boussinesq approximation, the Boussinesq variant is given first.
43 
44 !> Structure that contains pointers to the boundary forcing used to drive the
45 !! liquid ocean simulated by MOM.
46 !!
47 !! Data in this type is allocated in the module MOM_surface_forcing.F90, of which there
48 !! are three: solo, coupled, and ice-shelf. Alternatively, they are allocated in
49 !! MESO_surface_forcing.F90, which is a special case of solo_driver/MOM_surface_forcing.F90.
50 type, public :: forcing
51 
52  ! surface stress components and turbulent velocity scale
53  real, pointer, dimension(:,:) :: &
54  ustar => null(), & !< surface friction velocity scale [Z T-1 ~> m s-1].
55  ustar_gustless => null() !< surface friction velocity scale without any
56  !! any augmentation for gustiness [Z T-1 ~> m s-1].
57 
58  ! surface buoyancy force, used when temperature is not a state variable
59  real, pointer, dimension(:,:) :: &
60  buoy => null() !< buoyancy flux [L2 T-3 ~> m2 s-3]
61 
62  ! radiative heat fluxes into the ocean [W m-2]
63  real, pointer, dimension(:,:) :: &
64  sw => null(), & !< shortwave [W m-2]
65  sw_vis_dir => null(), & !< visible, direct shortwave [W m-2]
66  sw_vis_dif => null(), & !< visible, diffuse shortwave [W m-2]
67  sw_nir_dir => null(), & !< near-IR, direct shortwave [W m-2]
68  sw_nir_dif => null(), & !< near-IR, diffuse shortwave [W m-2]
69  lw => null() !< longwave [W m-2] (typically negative)
70 
71  ! turbulent heat fluxes into the ocean [W m-2]
72  real, pointer, dimension(:,:) :: &
73  latent => null(), & !< latent [W m-2] (typically < 0)
74  sens => null(), & !< sensible [W m-2] (typically negative)
75  seaice_melt_heat => null(), & !< sea ice and snow melt or formation [W m-2] (typically negative)
76  heat_added => null() !< additional heat flux from SST restoring or flux adjustments [W m-2]
77 
78  ! components of latent heat fluxes used for diagnostic purposes
79  real, pointer, dimension(:,:) :: &
80  latent_evap_diag => null(), & !< latent [W m-2] from evaporating liquid water (typically < 0)
81  latent_fprec_diag => null(), & !< latent [W m-2] from melting fprec (typically < 0)
82  latent_frunoff_diag => null() !< latent [W m-2] from melting frunoff (calving) (typically < 0)
83 
84  ! water mass fluxes into the ocean [kg m-2 s-1]; these fluxes impact the ocean mass
85  real, pointer, dimension(:,:) :: &
86  evap => null(), & !< (-1)*fresh water flux evaporated out of the ocean [R Z T-1 ~> kg m-2 s-1]
87  lprec => null(), & !< precipitating liquid water into the ocean [R Z T-1 ~> kg m-2 s-1]
88  fprec => null(), & !< precipitating frozen water into the ocean [R Z T-1 ~> kg m-2 s-1]
89  vprec => null(), & !< virtual liquid precip associated w/ SSS restoring [R Z T-1 ~> kg m-2 s-1]
90  lrunoff => null(), & !< liquid river runoff entering ocean [R Z T-1 ~> kg m-2 s-1]
91  frunoff => null(), & !< frozen river runoff (calving) entering ocean [R Z T-1 ~> kg m-2 s-1]
92  seaice_melt => null(), & !< snow/seaice melt (positive) or formation (negative) [R Z T-1 ~> kg m-2 s-1]
93  netmassin => null(), & !< Sum of water mass flux out of the ocean [kg m-2 s-1]
94  netmassout => null(), & !< Net water mass flux into of the ocean [kg m-2 s-1]
95  netsalt => null() !< Net salt entering the ocean [kgSalt m-2 s-1]
96 
97  ! heat associated with water crossing ocean surface
98  real, pointer, dimension(:,:) :: &
99  heat_content_cond => null(), & !< heat content associated with condensating water [J kg-1 R Z T-1 ~> W m-2]
100  heat_content_lprec => null(), & !< heat content associated with liquid >0 precip [J kg-1 R Z T-1 ~> W m-2]
101  heat_content_icemelt => null(), & !< heat content associated with snow and seaice
102  !! melt and formation [J kg-1 R Z T-1 ~> W m-2]
103  heat_content_fprec => null(), & !< heat content associated with frozen precip [J kg-1 R Z T-1 ~> W m-2]
104  heat_content_vprec => null(), & !< heat content associated with virtual >0 precip [J kg-1 R Z T-1 ~> W m-2]
105  heat_content_lrunoff => null(), & !< heat content associated with liquid runoff [J kg-1 R Z T-1 ~> W m-2]
106  heat_content_frunoff => null(), & !< heat content associated with frozen runoff [J kg-1 R Z T-1 ~> W m-2]
107  heat_content_massout => null(), & !< heat content associated with mass leaving ocean [J kg-1 R Z T-1 ~> W m-2]
108  heat_content_massin => null() !< heat content associated with mass entering ocean [J kg-1 R Z T-1 ~> W m-2]
109 
110  ! salt mass flux (contributes to ocean mass only if non-Bouss )
111  real, pointer, dimension(:,:) :: &
112  salt_flux => null(), & !< net salt flux into the ocean [R Z T-1 ~> kgSalt m-2 s-1]
113  salt_flux_in => null(), & !< salt flux provided to the ocean from coupler [R Z T-1 ~> kgSalt m-2 s-1]
114  salt_flux_added => null() !< additional salt flux from restoring or flux adjustment before adjustment
115  !! to net zero [R Z T-1 ~> kgSalt m-2 s-1]
116 
117  ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice)
118  real, pointer, dimension(:,:) :: p_surf_full => null()
119  !< Pressure at the top ocean interface [Pa].
120  !! if there is sea-ice, then p_surf_flux is at ice-ocean interface
121  real, pointer, dimension(:,:) :: p_surf => null()
122  !< Pressure at the top ocean interface [Pa] as used to drive the ocean model.
123  !! If p_surf is limited, p_surf may be smaller than p_surf_full, otherwise they are the same.
124  real, pointer, dimension(:,:) :: p_surf_ssh => null()
125  !< Pressure at the top ocean interface [Pa] that is used in corrections to the sea surface
126  !! height field that is passed back to the calling routines.
127  !! p_surf_SSH may point to p_surf or to p_surf_full.
128  logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere
129  !! and various types of ice needs to be accumulated, and the
130  !! surface pressure explicitly reset to zero at the driver level
131  !! when appropriate.
132 
133  ! tide related inputs
134  real, pointer, dimension(:,:) :: &
135  tke_tidal => null(), & !< tidal energy source driving mixing in bottom boundary layer [R Z3 T-3 ~> W m-2]
136  ustar_tidal => null() !< tidal contribution to bottom ustar [Z T-1 ~> m s-1]
137 
138  ! iceberg related inputs
139  real, pointer, dimension(:,:) :: &
140  ustar_berg => null(), & !< iceberg contribution to top ustar [Z T-1 ~> m s-1].
141  area_berg => null(), & !< area of ocean surface covered by icebergs [m2 m-2]
142  mass_berg => null() !< mass of icebergs [kg m-2]
143 
144  ! land ice-shelf related inputs
145  real, pointer, dimension(:,:) :: ustar_shelf => null() !< Friction velocity under ice-shelves [Z T-1 ~> m s-1].
146  !! as computed by the ocean at the previous time step.
147  real, pointer, dimension(:,:) :: frac_shelf_h => null() !< Fractional ice shelf coverage of
148  !! h-cells, nondimensional from 0 to 1. This is only
149  !! associated if ice shelves are enabled, and are
150  !! exactly 0 away from shelves or on land.
151  real, pointer, dimension(:,:) :: iceshelf_melt => null() !< Ice shelf melt rate (positive)
152  !! or freezing (negative) [m year-1]
153 
154  ! Scalars set by surface forcing modules
155  real :: vprecglobaladj = 0. !< adjustment to restoring vprec to zero out global net [kg m-2 s-1]
156  real :: saltfluxglobaladj = 0. !< adjustment to restoring salt flux to zero out global net [kgSalt m-2 s-1]
157  real :: netfwglobaladj = 0. !< adjustment to net fresh water to zero out global net [kg m-2 s-1]
158  real :: vprecglobalscl = 0. !< scaling of restoring vprec to zero out global net ( -1..1 ) [nondim]
159  real :: saltfluxglobalscl = 0. !< scaling of restoring salt flux to zero out global net ( -1..1 ) [nondim]
160  real :: netfwglobalscl = 0. !< scaling of net fresh water to zero out global net ( -1..1 ) [nondim]
161 
162  logical :: fluxes_used = .true. !< If true, all of the heat, salt, and mass
163  !! fluxes have been applied to the ocean.
164  real :: dt_buoy_accum = -1.0 !< The amount of time over which the buoyancy fluxes
165  !! should be applied [T ~> s]. If negative, this forcing
166  !! type variable has not yet been inialized.
167 
168  real :: c_p !< heat capacity of seawater [J kg-1 degC-1].
169  !! C_p is is the same value as in thermovar_ptrs_type.
170 
171  ! passive tracer surface fluxes
172  type(coupler_2d_bc_type) :: tr_fluxes !< This structure contains arrays of
173  !! of named fields used for passive tracer fluxes.
174  !! All arrays in tr_fluxes use the coupler indexing, which has no halos.
175  !! This is not a convenient convention, but imposed on MOM6 by the coupler.
176 
177  ! For internal error tracking
178  integer :: num_msg = 0 !< Number of messages issued about excessive SW penetration
179  integer :: max_msg = 2 !< Maximum number of messages to issue about excessive SW penetration
180 
181 end type forcing
182 
183 !> Structure that contains pointers to the mechanical forcing at the surface
184 !! used to drive the liquid ocean simulated by MOM.
185 !! Data in this type is allocated in the module MOM_surface_forcing.F90,
186 !! of which there are three versions: solo, coupled, and ice-shelf.
187 type, public :: mech_forcing
188  ! surface stress components and turbulent velocity scale
189  real, pointer, dimension(:,:) :: &
190  taux => null(), & !< zonal wind stress [R L Z T-2 ~> Pa]
191  tauy => null(), & !< meridional wind stress [R L Z T-2 ~> Pa]
192  ustar => null(), & !< surface friction velocity scale [Z T-1 ~> m s-1].
193  net_mass_src => null() !< The net mass source to the ocean [kg m-2 s-1].
194 
195  ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice)
196  real, pointer, dimension(:,:) :: p_surf_full => null()
197  !< Pressure at the top ocean interface [Pa].
198  !! if there is sea-ice, then p_surf_flux is at ice-ocean interface
199  real, pointer, dimension(:,:) :: p_surf => null()
200  !< Pressure at the top ocean interface [Pa] as used to drive the ocean model.
201  !! If p_surf is limited, p_surf may be smaller than p_surf_full, otherwise they are the same.
202  real, pointer, dimension(:,:) :: p_surf_ssh => null()
203  !< Pressure at the top ocean interface that is used in corrections to the sea surface
204  !! height field that is passed back to the calling routines.
205  !! p_surf_SSH may point to p_surf or to p_surf_full.
206 
207  ! iceberg related inputs
208  real, pointer, dimension(:,:) :: &
209  area_berg => null(), & !< fractional area of ocean surface covered by icebergs [m2 m-2]
210  mass_berg => null() !< mass of icebergs per unit ocean area [kg m-2]
211 
212  ! land ice-shelf related inputs
213  real, pointer, dimension(:,:) :: frac_shelf_u => null() !< Fractional ice shelf coverage of u-cells,
214  !! nondimensional from 0 to 1 [nondim]. This is only associated if ice shelves are enabled,
215  !! and is exactly 0 away from shelves or on land.
216  real, pointer, dimension(:,:) :: frac_shelf_v => null() !< Fractional ice shelf coverage of v-cells,
217  !! nondimensional from 0 to 1 [nondim]. This is only associated if ice shelves are enabled,
218  !! and is exactly 0 away from shelves or on land.
219  real, pointer, dimension(:,:) :: &
220  rigidity_ice_u => null(), & !< Depth-integrated lateral viscosity of ice shelves or sea ice at u-points [m3 s-1]
221  rigidity_ice_v => null() !< Depth-integrated lateral viscosity of ice shelves or sea ice at v-points [m3 s-1]
222  real :: dt_force_accum = -1.0 !< The amount of time over which the mechanical forcing fluxes
223  !! have been averaged [s].
224  logical :: net_mass_src_set = .false. !< If true, an estimate of net_mass_src has been provided.
225  logical :: accumulate_p_surf = .false. !< If true, the surface pressure due to the atmosphere
226  !! and various types of ice needs to be accumulated, and the
227  !! surface pressure explicitly reset to zero at the driver level
228  !! when appropriate.
229  logical :: accumulate_rigidity = .false. !< If true, the rigidity due to various types of
230  !! ice needs to be accumulated, and the rigidity explicitly
231  !! reset to zero at the driver level when appropriate.
232 
233  logical :: initialized = .false. !< This indicates whether the appropriate arrays have been initialized.
234 end type mech_forcing
235 
236 !> Structure that defines the id handles for the forcing type
237 type, public :: forcing_diags
238 
239  !>@{ Forcing diagnostic handles
240  ! mass flux diagnostic handles
241  integer :: id_prcme = -1, id_evap = -1
242  integer :: id_precip = -1, id_vprec = -1
243  integer :: id_lprec = -1, id_fprec = -1
244  integer :: id_lrunoff = -1, id_frunoff = -1
245  integer :: id_net_massout = -1, id_net_massin = -1
246  integer :: id_massout_flux = -1, id_massin_flux = -1
247  integer :: id_seaice_melt = -1
248 
249  ! global area integrated mass flux diagnostic handles
250  integer :: id_total_prcme = -1, id_total_evap = -1
251  integer :: id_total_precip = -1, id_total_vprec = -1
252  integer :: id_total_lprec = -1, id_total_fprec = -1
253  integer :: id_total_lrunoff = -1, id_total_frunoff = -1
254  integer :: id_total_net_massout = -1, id_total_net_massin = -1
255  integer :: id_total_seaice_melt = -1
256 
257  ! global area averaged mass flux diagnostic handles
258  integer :: id_prcme_ga = -1, id_evap_ga = -1
259  integer :: id_lprec_ga = -1, id_fprec_ga= -1
260  integer :: id_precip_ga = -1, id_vprec_ga= -1
261 
262  ! heat flux diagnostic handles
263  integer :: id_net_heat_coupler = -1, id_net_heat_surface = -1
264  integer :: id_sens = -1, id_lwlatsens = -1
265  integer :: id_sw = -1, id_lw = -1
266  integer :: id_sw_vis = -1, id_sw_nir = -1
267  integer :: id_lat_evap = -1, id_lat_frunoff = -1
268  integer :: id_lat = -1, id_lat_fprec = -1
269  integer :: id_heat_content_lrunoff= -1, id_heat_content_frunoff = -1
270  integer :: id_heat_content_lprec = -1, id_heat_content_fprec = -1
271  integer :: id_heat_content_cond = -1, id_heat_content_surfwater= -1
272  integer :: id_heat_content_vprec = -1, id_heat_content_massout = -1
273  integer :: id_heat_added = -1, id_heat_content_massin = -1
274  integer :: id_hfrainds = -1, id_hfrunoffds = -1
275  integer :: id_seaice_melt_heat = -1, id_heat_content_icemelt = -1
276 
277  ! global area integrated heat flux diagnostic handles
278  integer :: id_total_net_heat_coupler = -1, id_total_net_heat_surface = -1
279  integer :: id_total_sens = -1, id_total_lwlatsens = -1
280  integer :: id_total_sw = -1, id_total_lw = -1
281  integer :: id_total_lat_evap = -1, id_total_lat_frunoff = -1
282  integer :: id_total_lat = -1, id_total_lat_fprec = -1
283  integer :: id_total_heat_content_lrunoff= -1, id_total_heat_content_frunoff = -1
284  integer :: id_total_heat_content_lprec = -1, id_total_heat_content_fprec = -1
285  integer :: id_total_heat_content_cond = -1, id_total_heat_content_surfwater= -1
286  integer :: id_total_heat_content_vprec = -1, id_total_heat_content_massout = -1
287  integer :: id_total_heat_added = -1, id_total_heat_content_massin = -1
288  integer :: id_total_seaice_melt_heat = -1, id_total_heat_content_icemelt = -1
289 
290  ! global area averaged heat flux diagnostic handles
291  integer :: id_net_heat_coupler_ga = -1, id_net_heat_surface_ga = -1
292  integer :: id_sens_ga = -1, id_lwlatsens_ga = -1
293  integer :: id_sw_ga = -1, id_lw_ga = -1
294  integer :: id_lat_ga = -1
295 
296  ! salt flux diagnostic handles
297  integer :: id_saltflux = -1
298  integer :: id_saltfluxin = -1
299  integer :: id_saltfluxadded = -1
300 
301  integer :: id_total_saltflux = -1
302  integer :: id_total_saltfluxin = -1
303  integer :: id_total_saltfluxadded = -1
304 
305  integer :: id_vprecglobaladj = -1
306  integer :: id_vprecglobalscl = -1
307  integer :: id_saltfluxglobaladj = -1
308  integer :: id_saltfluxglobalscl = -1
309  integer :: id_netfwglobaladj = -1
310  integer :: id_netfwglobalscl = -1
311 
312  ! momentum flux and forcing diagnostic handles
313  integer :: id_taux = -1
314  integer :: id_tauy = -1
315  integer :: id_ustar = -1
316 
317  integer :: id_psurf = -1
318  integer :: id_tke_tidal = -1
319  integer :: id_buoy = -1
320 
321  ! iceberg diagnostic handles
322  integer :: id_ustar_berg = -1
323  integer :: id_area_berg = -1
324  integer :: id_mass_berg = -1
325 
326  ! Iceberg + Ice shelf diagnostic handles
327  integer :: id_ustar_ice_cover = -1
328  integer :: id_frac_ice_cover = -1
329  !!@}
330 
331  integer :: id_clock_forcing = -1 !< CPU clock id
332 
333 end type forcing_diags
334 
335 contains
336 
337 !> This subroutine extracts fluxes from the surface fluxes type. It works on a j-row
338 !! for optimization purposes. The 2d (i,j) wrapper is the next subroutine below.
339 !! This routine multiplies fluxes by dt, so that the result is an accumulation of fluxes
340 !! over a time step.
341 subroutine extractfluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, &
342  FluxRescaleDepth, useRiverHeatContent, useCalvingHeatContent, &
343  h, T, netMassInOut, netMassOut, net_heat, net_salt, pen_SW_bnd, tv, &
344  aggregate_FW, nonpenSW, netmassInOut_rate, net_Heat_Rate, &
345  net_salt_rate, pen_sw_bnd_Rate, skip_diags)
346 
347  type(ocean_grid_type), intent(in) :: g !< ocean grid structure
348  type(verticalgrid_type), intent(in) :: gv !< ocean vertical grid structure
349  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
350  type(forcing), intent(inout) :: fluxes !< structure containing pointers to possible
351  !! forcing fields. NULL unused fields.
352  type(optics_type), pointer :: optics !< pointer to optics
353  integer, intent(in) :: nsw !< number of bands of penetrating SW
354  integer, intent(in) :: j !< j-index to work on
355  real, intent(in) :: dt_in_t !< The time step for these fluxes [T ~> s]
356  real, intent(in) :: fluxrescaledepth !< min ocean depth before fluxes
357  !! are scaled away [H ~> m or kg m-2]
358  logical, intent(in) :: useriverheatcontent !< logical for river heat content
359  logical, intent(in) :: usecalvingheatcontent !< logical for calving heat content
360  real, dimension(SZI_(G),SZK_(G)), &
361  intent(in) :: h !< layer thickness [H ~> m or kg m-2]
362  real, dimension(SZI_(G),SZK_(G)), &
363  intent(in) :: t !< layer temperatures [degC]
364  real, dimension(SZI_(G)), intent(out) :: netmassinout !< net mass flux (non-Bouss) or volume flux
365  !! (if Bouss) of water in/out of ocean over
366  !! a time step [H ~> m or kg m-2]
367  real, dimension(SZI_(G)), intent(out) :: netmassout !< net mass flux (non-Bouss) or volume flux
368  !! (if Bouss) of water leaving ocean surface
369  !! over a time step [H ~> m or kg m-2].
370  !! netMassOut < 0 means mass leaves ocean.
371  real, dimension(SZI_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a
372  !! time step for coupler + restoring.
373  !! Exclude two terms from net_heat:
374  !! (1) downwelling (penetrative) SW,
375  !! (2) evaporation heat content,
376  !! (since do not yet know evap temperature).
377  !! [degC H ~> degC m or degC kg m-2].
378  real, dimension(SZI_(G)), intent(out) :: net_salt !< surface salt flux into the ocean
379  !! accumulated over a time step
380  !! [ppt H ~> ppt m or ppt kg m-2].
381  real, dimension(max(1,nsw),G%isd:G%ied), intent(out) :: pen_sw_bnd !< penetrating SW flux, split into bands.
382  !! [degC H ~> degC m or degC kg m-2]
383  !! and array size nsw x SZI_(G), where
384  !! nsw=number of SW bands in pen_SW_bnd.
385  !! This heat flux is not part of net_heat.
386  type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available
387  !! thermodynamic fields. Used to keep
388  !! track of the heat flux associated with net
389  !! mass fluxes into the ocean.
390  logical, intent(in) :: aggregate_fw !< For determining how to aggregate forcing.
391  real, dimension(SZI_(G)), &
392  optional, intent(out) :: nonpensw !< Non-penetrating SW used in net_heat
393  !! [degC H ~> degC m or degC kg m-2].
394  !! Summed over SW bands when diagnosing nonpenSW.
395  real, dimension(SZI_(G)), &
396  optional, intent(out) :: net_heat_rate !< Rate of net surface heating
397  !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1].
398  real, dimension(SZI_(G)), &
399  optional, intent(out) :: net_salt_rate !< Surface salt flux into the ocean
400  !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1].
401  real, dimension(SZI_(G)), &
402  optional, intent(out) :: netmassinout_rate !< Rate of net mass flux into the ocean
403  !! [H T-1 ~> m s-1 or kg m-2 s-1].
404  real, dimension(max(1,nsw),G%isd:G%ied), &
405  optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating
406  !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1].
407  logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating diagnostics
408 
409  ! local
410  real :: htot(szi_(g)) ! total ocean depth [H ~> m or kg m-2]
411  real :: pen_sw_tot(szi_(g)) ! sum across all bands of Pen_SW [degC H ~> degC m or degC kg m-2].
412  real :: pen_sw_tot_rate(szi_(g)) ! Summed rate of shortwave heating across bands
413  ! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1]
414  real :: ih_limit ! inverse depth at which surface fluxes start to be limited
415  ! or 0 for no limiting [H-1 ~> m-1 or m2 kg-1]
416  real :: scale ! scale scales away fluxes if depth < FluxRescaleDepth
417  real :: w_m2_to_h_t ! converts W/m^2 to H degC T-1 [degC H T-1 W-2 m2 ~> degC m3 J-1 or degC kg J-1]
418  real :: rz_t_to_w_m2_degc ! Converts mass fluxes to heat fluxes per degree temperature
419  ! change [W m-2 degC-1 T R-1 Z-1 ~> J kg degC]
420  real :: i_cp ! 1.0 / C_p [kg decC J-1]
421  real :: rzcp_to_h ! Unit convsersion factors divided by the heat capacity
422  ! [kg degC H R-1 Z-1 J-1 ~> degC m3 J-1 or kg degC J-1]
423  logical :: calculate_diags ! Indicate to calculate/update diagnostic arrays
424  character(len=200) :: mesg
425  integer :: is, ie, nz, i, k, n
426 
427  logical :: do_nhr, do_nsr, do_nmior, do_pswbr
428 
429  !BGR-Jul 5,2017{
430  ! Initializes/sets logicals if 'rates' are requested
431  ! These factors are required for legacy reasons
432  ! and therefore computed only when optional outputs are requested
433  do_nhr = .false.
434  do_nsr = .false.
435  do_nmior = .false.
436  do_pswbr = .false.
437  if (present(net_heat_rate)) do_nhr = .true.
438  if (present(net_salt_rate)) do_nsr = .true.
439  if (present(netmassinout_rate)) do_nmior = .true.
440  if (present(pen_sw_bnd_rate)) do_pswbr = .true.
441  !}BGR
442 
443  ih_limit = 0.0 ; if (fluxrescaledepth > 0.0) ih_limit = 1.0 / fluxrescaledepth
444  rz_t_to_w_m2_degc = fluxes%C_p*us%R_to_kg_m3*us%Z_to_m*us%s_to_T
445  i_cp = 1.0 / fluxes%C_p
446  w_m2_to_h_t = 1.0 / (us%s_to_T * gv%H_to_kg_m2 * fluxes%C_p)
447 
448  rzcp_to_h = 1.0 / (gv%H_to_RZ * fluxes%C_p)
449 
450  is = g%isc ; ie = g%iec ; nz = g%ke
451 
452  calculate_diags = .true.
453  if (present(skip_diags)) calculate_diags = .not. skip_diags
454 
455  ! error checking
456 
457  if (nsw > 0) then ; if (nsw /= optics_nbands(optics)) call mom_error(warning, &
458  "mismatch in the number of bands of shortwave radiation in MOM_forcing_type extract_fluxes.")
459  endif
460 
461  if (.not.associated(fluxes%sw)) call mom_error(fatal, &
462  "MOM_forcing_type extractFluxes1d: fluxes%sw is not associated.")
463 
464  if (.not.associated(fluxes%lw)) call mom_error(fatal, &
465  "MOM_forcing_type extractFluxes1d: fluxes%lw is not associated.")
466 
467  if (.not.associated(fluxes%latent)) call mom_error(fatal, &
468  "MOM_forcing_type extractFluxes1d: fluxes%latent is not associated.")
469 
470  if (.not.associated(fluxes%sens)) call mom_error(fatal, &
471  "MOM_forcing_type extractFluxes1d: fluxes%sens is not associated.")
472 
473  if (.not.associated(fluxes%evap)) call mom_error(fatal, &
474  "MOM_forcing_type extractFluxes1d: No evaporation defined.")
475 
476  if (.not.associated(fluxes%vprec)) call mom_error(fatal, &
477  "MOM_forcing_type extractFluxes1d: fluxes%vprec not defined.")
478 
479  if ((.not.associated(fluxes%lprec)) .or. &
480  (.not.associated(fluxes%fprec))) call mom_error(fatal, &
481  "MOM_forcing_type extractFluxes1d: No precipitation defined.")
482 
483  do i=is,ie ; htot(i) = h(i,1) ; enddo
484  do k=2,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,k) ; enddo ; enddo
485 
486  if (nsw >= 1) then
487  call extract_optics_slice(optics, j, g, gv, pensw_top=pen_sw_bnd) !, penSW_scale=W_m2_to_H_T*dt_in_T
488  if (do_pswbr) call extract_optics_slice(optics, j, g, gv, pensw_top=pen_sw_bnd_rate) !, penSW_scale=W_m2_to_H_T
489  endif
490 
491  do i=is,ie
492 
493  scale = 1.0 ; if ((ih_limit > 0.0) .and. (htot(i)*ih_limit < 1.0)) scale = htot(i)*ih_limit
494 
495  ! Convert the penetrating shortwave forcing to (K * H) and reduce fluxes for shallow depths.
496  ! (H=m for Bouss, H=kg/m2 for non-Bouss)
497  pen_sw_tot(i) = 0.0
498  if (nsw >= 1) then
499  do n=1,nsw
500  pen_sw_bnd(n,i) = w_m2_to_h_t*scale*dt_in_t * max(0.0, pen_sw_bnd(n,i))
501  pen_sw_tot(i) = pen_sw_tot(i) + pen_sw_bnd(n,i)
502  enddo
503  else
504  pen_sw_bnd(1,i) = 0.0
505  endif
506 
507  if (do_pswbr) then ! Repeat the above code w/ dt=1s for legacy reasons
508  pen_sw_tot_rate(i) = 0.0
509  if (nsw >= 1) then
510  do n=1,nsw
511  pen_sw_bnd_rate(n,i) = w_m2_to_h_t*scale * max(0.0, pen_sw_bnd_rate(n,i))
512  pen_sw_tot_rate(i) = pen_sw_tot_rate(i) + pen_sw_bnd_rate(n,i)
513  enddo
514  else
515  pen_sw_bnd_rate(1,i) = 0.0
516  endif
517  endif
518 
519  ! net volume/mass of liquid and solid passing through surface boundary fluxes
520  netmassinout(i) = dt_in_t * (scale * &
521  (((((( fluxes%lprec(i,j) &
522  + fluxes%fprec(i,j) ) &
523  + fluxes%evap(i,j) ) &
524  + fluxes%lrunoff(i,j) ) &
525  + fluxes%vprec(i,j) ) &
526  + fluxes%seaice_melt(i,j)) &
527  + fluxes%frunoff(i,j) ))
528 
529  if (do_nmior) then ! Repeat the above code without multiplying by a timestep for legacy reasons
530  netmassinout_rate(i) = (scale * &
531  (((((( fluxes%lprec(i,j) &
532  + fluxes%fprec(i,j) ) &
533  + fluxes%evap(i,j) ) &
534  + fluxes%lrunoff(i,j) ) &
535  + fluxes%vprec(i,j) ) &
536  + fluxes%seaice_melt(i,j)) &
537  + fluxes%frunoff(i,j) ))
538  endif
539 
540  ! smg:
541  ! for non-Bouss, we add/remove salt mass to total ocean mass. to conserve
542  ! total salt mass ocean+ice, the sea ice model must lose mass when salt mass
543  ! is added to the ocean, which may still need to be coded. Not that the units
544  ! of netMassInOut are still kg_m2, so no conversion to H should occur yet.
545  if (.not.gv%Boussinesq .and. associated(fluxes%salt_flux)) then
546  netmassinout(i) = netmassinout(i) + dt_in_t * (scale * fluxes%salt_flux(i,j))
547  if (do_nmior) netmassinout_rate(i) = netmassinout_rate(i) + &
548  (scale * fluxes%salt_flux(i,j))
549  endif
550 
551  ! net volume/mass of water leaving the ocean.
552  ! check that fluxes are < 0, which means mass is indeed leaving.
553  netmassout(i) = 0.0
554 
555  ! evap > 0 means condensating water is added into ocean.
556  ! evap < 0 means evaporation of water from the ocean, in
557  ! which case heat_content_evap is computed in MOM_diabatic_driver.F90
558  if (fluxes%evap(i,j) < 0.0) netmassout(i) = netmassout(i) + fluxes%evap(i,j)
559  ! if (associated(fluxes%heat_content_cond)) fluxes%heat_content_cond(i,j) = 0.0 !??? --AJA
560 
561  ! lprec < 0 means sea ice formation taking water from the ocean.
562  ! smg: we should split the ice melt/formation from the lprec
563  if (fluxes%lprec(i,j) < 0.0) netmassout(i) = netmassout(i) + fluxes%lprec(i,j)
564 
565  ! seaice_melt < 0 means sea ice formation taking water from the ocean.
566  if (fluxes%seaice_melt(i,j) < 0.0) netmassout(i) = netmassout(i) + fluxes%seaice_melt(i,j)
567 
568  ! vprec < 0 means virtual evaporation arising from surface salinity restoring,
569  ! in which case heat_content_vprec is computed in MOM_diabatic_driver.F90.
570  if (fluxes%vprec(i,j) < 0.0) netmassout(i) = netmassout(i) + fluxes%vprec(i,j)
571 
572  netmassout(i) = dt_in_t * scale * netmassout(i)
573 
574  ! convert to H units (Bouss=meter or non-Bouss=kg/m^2)
575  netmassinout(i) = gv%RZ_to_H * netmassinout(i)
576  if (do_nmior) netmassinout_rate(i) = gv%RZ_to_H * netmassinout_rate(i)
577  netmassout(i) = gv%RZ_to_H * netmassout(i)
578 
579  ! surface heat fluxes from radiation and turbulent fluxes (K * H)
580  ! (H=m for Bouss, H=kg/m2 for non-Bouss)
581 
582  ! CIME provides heat flux from snow&ice melt (seaice_melt_heat), so this is added below
583  if (associated(fluxes%seaice_melt_heat)) then
584  net_heat(i) = scale * dt_in_t * w_m2_to_h_t * &
585  ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) + &
586  fluxes%seaice_melt_heat(i,j)) )
587  !Repeats above code w/ dt=1. for legacy reason
588  if (do_nhr) net_heat_rate(i) = scale * w_m2_to_h_t * &
589  ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) + &
590  fluxes%seaice_melt_heat(i,j)))
591  else
592  net_heat(i) = scale * dt_in_t * w_m2_to_h_t * &
593  ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) )
594  !Repeats above code w/ dt=1. for legacy reason
595  if (do_nhr) net_heat_rate(i) = scale * w_m2_to_h_t * &
596  ( fluxes%sw(i,j) + ((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) )
597  endif
598 
599  ! Add heat flux from surface damping (restoring) (K * H) or flux adjustments.
600  if (associated(fluxes%heat_added)) then
601  net_heat(i) = net_heat(i) + (scale * (dt_in_t * w_m2_to_h_t)) * fluxes%heat_added(i,j)
602  if (do_nhr) net_heat_rate(i) = net_heat_rate(i) + (scale * (w_m2_to_h_t)) * fluxes%heat_added(i,j)
603  endif
604 
605  ! Add explicit heat flux for runoff (which is part of the ice-ocean boundary
606  ! flux type). Runoff is otherwise added with a temperature of SST.
607  if (useriverheatcontent) then
608  ! remove lrunoff*SST here, to counteract its addition elsewhere
609  net_heat(i) = (net_heat(i) + (scale*(dt_in_t * rzcp_to_h)) * fluxes%heat_content_lrunoff(i,j)) - &
610  (gv%RZ_to_H * (scale * dt_in_t)) * fluxes%lrunoff(i,j) * t(i,1)
611  !BGR-Jul 5, 2017{
612  !Intentionally neglect the following contribution to rate for legacy reasons.
613  !if (do_NHR) net_heat_rate(i) = (net_heat_rate(i) + (scale*RZcP_to_H) * fluxes%heat_content_lrunoff(i,j)) - &
614  ! (GV%RZ_to_H * (scale)) * fluxes%lrunoff(i,j) * T(i,1)
615  !}BGR
616  if (calculate_diags .and. associated(tv%TempxPmE)) then
617  tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + (scale * dt_in_t) * &
618  (i_cp*fluxes%heat_content_lrunoff(i,j) - fluxes%lrunoff(i,j)*t(i,1))
619  endif
620  endif
621 
622  ! Add explicit heat flux for calving (which is part of the ice-ocean boundary
623  ! flux type). Calving is otherwise added with a temperature of SST.
624  if (usecalvingheatcontent) then
625  ! remove frunoff*SST here, to counteract its addition elsewhere
626  net_heat(i) = net_heat(i) + (scale*(dt_in_t * rzcp_to_h)) * fluxes%heat_content_frunoff(i,j) - &
627  (gv%RZ_to_H * (scale * dt_in_t)) * fluxes%frunoff(i,j) * t(i,1)
628  !BGR-Jul 5, 2017{
629  !Intentionally neglect the following contribution to rate for legacy reasons.
630 ! if (do_NHR) net_heat_rate(i) = net_heat_rate(i) + (scale*RZcP_to_H) * fluxes%heat_content_frunoff(i,j) - &
631 ! (GV%RZ_to_H * scale) * fluxes%frunoff(i,j) * T(i,1)
632  !}BGR
633  if (calculate_diags .and. associated(tv%TempxPmE)) then
634  tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + (scale * dt_in_t) * &
635  (i_cp*fluxes%heat_content_frunoff(i,j) - fluxes%frunoff(i,j)*t(i,1))
636  endif
637  endif
638 
639 ! smg: new code
640  ! add heat from all terms that may add mass to the ocean (K * H).
641  ! if evap, lprec, or vprec < 0, then compute their heat content
642  ! inside MOM_diabatic_driver.F90 and fill in fluxes%heat_content_massout.
643  ! we do so since we do not here know the temperature
644  ! of water leaving the ocean, as it could be leaving from more than
645  ! one layer of the upper ocean in the case of very thin layers.
646  ! When evap, lprec, or vprec > 0, then we know their heat content here
647  ! via settings from inside of the appropriate config_src driver files.
648 ! if (associated(fluxes%heat_content_lprec)) then
649 ! net_heat(i) = net_heat(i) + scale * dt_in_T * RZcP_to_H * &
650 ! (fluxes%heat_content_lprec(i,j) + (fluxes%heat_content_fprec(i,j) + &
651 ! (fluxes%heat_content_lrunoff(i,j) + (fluxes%heat_content_frunoff(i,j) + &
652 ! (fluxes%heat_content_cond(i,j) + fluxes%heat_content_vprec(i,j))))))
653 ! endif
654 
655  if (fluxes%num_msg < fluxes%max_msg) then
656  if (pen_sw_tot(i) > 1.000001 * w_m2_to_h_t*scale*dt_in_t*fluxes%sw(i,j)) then
657  fluxes%num_msg = fluxes%num_msg + 1
658  write(mesg,'("Penetrating shortwave of ",1pe17.10, &
659  &" exceeds total shortwave of ",1pe17.10,&
660  &" at ",1pg11.4,"E, "1pg11.4,"N.")') &
661  pen_sw_tot(i),w_m2_to_h_t*scale*dt_in_t * fluxes%sw(i,j),&
662  g%geoLonT(i,j),g%geoLatT(i,j)
663  call mom_error(warning,mesg)
664  endif
665  endif
666 
667  ! remove penetrative portion of the SW that is NOT absorbed within a
668  ! tiny layer at the top of the ocean.
669  net_heat(i) = net_heat(i) - pen_sw_tot(i)
670  !Repeat above code for 'rate' term
671  if (do_nhr) net_heat_rate(i) = net_heat_rate(i) - pen_sw_tot_rate(i)
672 
673  ! diagnose non-downwelling SW
674  if (present(nonpensw)) then
675  nonpensw(i) = scale * dt_in_t * w_m2_to_h_t * fluxes%sw(i,j) - pen_sw_tot(i)
676  endif
677 
678  ! Salt fluxes
679  net_salt(i) = 0.0
680  if (do_nsr) net_salt_rate(i) = 0.0
681  ! Convert salt_flux from kg (salt)/(m^2 * s) to
682  ! Boussinesq: (ppt * m)
683  ! non-Bouss: (g/m^2)
684  if (associated(fluxes%salt_flux)) then
685  net_salt(i) = (scale * dt_in_t * (1000.0 * fluxes%salt_flux(i,j))) * gv%RZ_to_H
686  !Repeat above code for 'rate' term
687  if (do_nsr) net_salt_rate(i) = (scale * 1. * (1000.0 * fluxes%salt_flux(i,j))) * gv%RZ_to_H
688  endif
689 
690  ! Diagnostics follow...
691  if (calculate_diags) then
692 
693  ! Store Net_salt for unknown reason?
694  if (associated(fluxes%salt_flux)) then
695  ! This seems like a bad idea to me. -RWH
696  if (calculate_diags) fluxes%netSalt(i,j) = us%kg_m3_to_R*us%m_to_Z*us%T_to_s*net_salt(i)
697  endif
698 
699  ! Initialize heat_content_massin that is diagnosed in mixedlayer_convection or
700  ! applyBoundaryFluxes such that the meaning is as the sum of all incoming components.
701  if (associated(fluxes%heat_content_massin)) then
702  if (aggregate_fw) then
703  if (netmassinout(i) > 0.0) then ! net is "in"
704  fluxes%heat_content_massin(i,j) = -fluxes%C_p * netmassout(i) * t(i,1) * gv%H_to_RZ / dt_in_t
705  else ! net is "out"
706  fluxes%heat_content_massin(i,j) = fluxes%C_p * ( netmassinout(i) - netmassout(i) ) * &
707  t(i,1) * gv%H_to_RZ / dt_in_t
708  endif
709  else
710  fluxes%heat_content_massin(i,j) = 0.
711  endif
712  endif
713 
714  ! Initialize heat_content_massout that is diagnosed in mixedlayer_convection or
715  ! applyBoundaryFluxes such that the meaning is as the sum of all outgoing components.
716  if (associated(fluxes%heat_content_massout)) then
717  if (aggregate_fw) then
718  if (netmassinout(i) > 0.0) then ! net is "in"
719  fluxes%heat_content_massout(i,j) = fluxes%C_p * netmassout(i) * t(i,1) * gv%H_to_RZ / dt_in_t
720  else ! net is "out"
721  fluxes%heat_content_massout(i,j) = -fluxes%C_p * ( netmassinout(i) - netmassout(i) ) * &
722  t(i,1) * gv%H_to_RZ / dt_in_t
723  endif
724  else
725  fluxes%heat_content_massout(i,j) = 0.0
726  endif
727  endif
728 
729  ! smg: we should remove sea ice melt from lprec!!!
730  ! fluxes%lprec > 0 means ocean gains mass via liquid precipitation and/or sea ice melt.
731  ! When atmosphere does not provide heat of this precipitation, the ocean assumes
732  ! it enters the ocean at the SST.
733  ! fluxes%lprec < 0 means ocean loses mass via sea ice formation. As we do not yet know
734  ! the layer at which this mass is removed, we cannot compute it heat content. We must
735  ! wait until MOM_diabatic_driver.F90.
736  if (associated(fluxes%heat_content_lprec)) then
737  if (fluxes%lprec(i,j) > 0.0) then
738  fluxes%heat_content_lprec(i,j) = fluxes%C_p*fluxes%lprec(i,j)*t(i,1)
739  else
740  fluxes%heat_content_lprec(i,j) = 0.0
741  endif
742  endif
743 
744  ! fprec SHOULD enter ocean at 0degC if atmos model does not provide fprec heat content.
745  ! However, we need to adjust netHeat above to reflect the difference between 0decC and SST
746  ! and until we do so fprec is treated like lprec and enters at SST. -AJA
747  if (associated(fluxes%heat_content_fprec)) then
748  if (fluxes%fprec(i,j) > 0.0) then
749  fluxes%heat_content_fprec(i,j) = fluxes%C_p*fluxes%fprec(i,j)*t(i,1)
750  else
751  fluxes%heat_content_fprec(i,j) = 0.0
752  endif
753  endif
754 
755  ! Following lprec and fprec, water flux due to sea ice melt (seaice_melt) enters at SST - GMM
756  if (associated(fluxes%heat_content_icemelt)) then
757  if (fluxes%seaice_melt(i,j) > 0.0) then
758  fluxes%heat_content_icemelt(i,j) = fluxes%C_p*fluxes%seaice_melt(i,j)*t(i,1)
759  else
760  fluxes%heat_content_icemelt(i,j) = 0.0
761  endif
762  endif
763 
764  ! virtual precip associated with salinity restoring
765  ! vprec > 0 means add water to ocean, assumed to be at SST
766  ! vprec < 0 means remove water from ocean; set heat_content_vprec in MOM_diabatic_driver.F90
767  if (associated(fluxes%heat_content_vprec)) then
768  if (fluxes%vprec(i,j) > 0.0) then
769  fluxes%heat_content_vprec(i,j) = fluxes%C_p*fluxes%vprec(i,j)*t(i,1)
770  else
771  fluxes%heat_content_vprec(i,j) = 0.0
772  endif
773  endif
774 
775  ! fluxes%evap < 0 means ocean loses mass due to evaporation.
776  ! Evaporation leaves ocean surface at a temperature that has yet to be determined,
777  ! since we do not know the precise layer that the water evaporates. We therefore
778  ! compute fluxes%heat_content_massout at the relevant point inside MOM_diabatic_driver.F90.
779  ! fluxes%evap > 0 means ocean gains moisture via condensation.
780  ! Condensation is assumed to drop into the ocean at the SST, just like lprec.
781  if (associated(fluxes%heat_content_cond)) then
782  if (fluxes%evap(i,j) > 0.0) then
783  fluxes%heat_content_cond(i,j) = fluxes%C_p*fluxes%evap(i,j)*t(i,1)
784  else
785  fluxes%heat_content_cond(i,j) = 0.0
786  endif
787  endif
788 
789  ! Liquid runoff enters ocean at SST if land model does not provide runoff heat content.
790  if (.not. useriverheatcontent) then
791  if (associated(fluxes%lrunoff) .and. associated(fluxes%heat_content_lrunoff)) then
792  fluxes%heat_content_lrunoff(i,j) = fluxes%C_p*fluxes%lrunoff(i,j)*t(i,1)
793  endif
794  endif
795 
796  ! Icebergs enter ocean at SST if land model does not provide calving heat content.
797  if (.not. usecalvingheatcontent) then
798  if (associated(fluxes%frunoff) .and. associated(fluxes%heat_content_frunoff)) then
799  fluxes%heat_content_frunoff(i,j) = fluxes%C_p*fluxes%frunoff(i,j)*t(i,1)
800  endif
801  endif
802 
803  endif ! calculate_diags
804 
805  enddo ! i-loop
806 
807 end subroutine extractfluxes1d
808 
809 
810 !> 2d wrapper for 1d extract fluxes from surface fluxes type.
811 !! This subroutine extracts fluxes from the surface fluxes type. It multiplies the
812 !! fluxes by dt, so that the result is an accumulation of the fluxes over a time step.
813 subroutine extractfluxes2d(G, GV, US, fluxes, optics, nsw, dt_in_T, FluxRescaleDepth, &
814  useRiverHeatContent, useCalvingHeatContent, h, T, &
815  netMassInOut, netMassOut, net_heat, Net_salt, Pen_SW_bnd, tv, &
816  aggregate_FW)
817 
818  type(ocean_grid_type), intent(in) :: g !< ocean grid structure
819  type(verticalgrid_type), intent(in) :: gv !< ocean vertical grid structure
820  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
821  type(forcing), intent(inout) :: fluxes !< structure containing pointers to forcing.
822  type(optics_type), pointer :: optics !< pointer to optics
823  integer, intent(in) :: nsw !< number of bands of penetrating SW
824  real, intent(in) :: dt_in_t !< The time step for these fluxes [T ~> s]
825  real, intent(in) :: fluxrescaledepth !< min ocean depth before fluxes
826  !! are scaled away [H ~> m or kg m-2]
827  logical, intent(in) :: useriverheatcontent !< logical for river heat content
828  logical, intent(in) :: usecalvingheatcontent !< logical for calving heat content
829  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
830  intent(in) :: h !< layer thickness [H ~> m or kg m-2]
831  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
832  intent(in) :: t !< layer temperatures [degC]
833  real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netmassinout !< net mass flux (non-Bouss) or volume flux
834  !! (if Bouss) of water in/out of ocean over
835  !! a time step [H ~> m or kg m-2]
836  real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netmassout !< net mass flux (non-Bouss) or volume flux
837  !! (if Bouss) of water leaving ocean surface
838  !! over a time step [H ~> m or kg m-2].
839  real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a
840  !! time step associated with coupler + restore.
841  !! Exclude two terms from net_heat:
842  !! (1) downwelling (penetrative) SW,
843  !! (2) evaporation heat content,
844  !! (since do not yet know temperature of evap).
845  !! [degC H ~> degC m or degC kg m-2]
846  real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated
847  !! over a time step [ppt H ~> ppt m or ppt kg m-2]
848  real, dimension(max(1,nsw),G%isd:G%ied,G%jsd:G%jed), intent(out) :: pen_sw_bnd !< penetrating SW flux, by frequency
849  !! band [degC H ~> degC m or degC kg m-2] with array
850  !! size nsw x SZI_(G), where nsw=number of SW bands
851  !! in pen_SW_bnd. This heat flux is not in net_heat.
852  type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available
853  !! thermodynamic fields. Here it is used to keep
854  !! track of the heat flux associated with net
855  !! mass fluxes into the ocean.
856  logical, intent(in) :: aggregate_fw !< For determining how to aggregate the forcing.
857 
858  integer :: j
859 !$OMP parallel do default(none) shared(G, GV, US, fluxes, optics, nsw, dt_in_T, FluxRescaleDepth, &
860 !$OMP useRiverHeatContent, useCalvingHeatContent, &
861 !$OMP h,T,netMassInOut,netMassOut,Net_heat,Net_salt,Pen_SW_bnd,tv, &
862 !$OMP aggregate_FW)
863  do j=g%jsc, g%jec
864  call extractfluxes1d(g, gv, us, fluxes, optics, nsw, j, dt_in_t, &
865  fluxrescaledepth, useriverheatcontent, usecalvingheatcontent,&
866  h(:,j,:), t(:,j,:), netmassinout(:,j), netmassout(:,j), &
867  net_heat(:,j), net_salt(:,j), pen_sw_bnd(:,:,j), tv, aggregate_fw)
868  enddo
869 
870 end subroutine extractfluxes2d
871 
872 
873 !> This routine calculates surface buoyancy flux by adding up the heat, FW & salt fluxes.
874 !! These are actual fluxes, with units of stuff per time. Setting dt=1 in the call to
875 !! extractFluxes routine allows us to get "stuf per time" rather than the time integrated
876 !! fluxes needed in other routines that call extractFluxes.
877 subroutine calculatebuoyancyflux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt, tv, j, &
878  buoyancyFlux, netHeatMinusSW, netSalt, skip_diags)
879  type(ocean_grid_type), intent(in) :: g !< ocean grid
880  type(verticalgrid_type), intent(in) :: gv !< ocean vertical grid structure
881  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
882  type(forcing), intent(inout) :: fluxes !< surface fluxes
883  type(optics_type), pointer :: optics !< penetrating SW optics
884  integer, intent(in) :: nsw !< The number of frequency bands of
885  !! penetrating shortwave radiation
886  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness [H ~> m or kg m-2]
887  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp !< prognostic temp [degC]
888  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: salt !< salinity [ppt]
889  type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type
890  integer, intent(in) :: j !< j-row to work on
891  real, dimension(SZI_(G),SZK_(G)+1), intent(inout) :: buoyancyflux !< buoyancy fluxes [L2 T-3 ~> m2 s-3]
892  real, dimension(SZI_(G)), intent(inout) :: netheatminussw !< surf Heat flux
893  !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1]
894  real, dimension(SZI_(G)), intent(inout) :: netsalt !< surf salt flux
895  !! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1]
896  logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating
897  !! diagnostics inside extractFluxes1d()
898  ! local variables
899  integer :: start, npts, k
900  real, parameter :: dt = 1. ! to return a rate from extractFluxes1d
901  real, dimension(SZI_(G)) :: neth ! net FW flux [H s-1 ~> m s-1 or kg m-2 s-1]
902  real, dimension(SZI_(G)) :: netevap ! net FW flux leaving ocean via evaporation
903  ! [H s-1 ~> m s-1 or kg m-2 s-1]
904  real, dimension(SZI_(G)) :: netheat ! net temp flux [degC H s-1 ~> degC m s-2 or degC kg m-2 s-1]
905  real, dimension(max(nsw,1), SZI_(G)) :: penswbnd ! penetrating SW radiation by band
906  ! [degC H ~> degC m or degC kg m-2]
907  real, dimension(SZI_(G)) :: pressure ! pressurea the surface [Pa]
908  real, dimension(SZI_(G)) :: drhodt ! density partial derivative wrt temp [R degC-1 ~> kg m-3 degC-1]
909  real, dimension(SZI_(G)) :: drhods ! density partial derivative wrt saln [R ppt-1 ~> kg m-3 ppt-1]
910  real, dimension(SZI_(G),SZK_(G)+1) :: netpen ! The net penetrating shortwave radiation at each level
911  ! [degC H ~> degC m or degC kg m-2]
912 
913  logical :: useriverheatcontent
914  logical :: usecalvingheatcontent
915  real :: depthbeforescalingfluxes ! A depth scale [H ~> m or kg m-2]
916  real :: gorho ! The gravitational acceleration divided by mean density times some
917  ! unit conversion factors [L2 H-1 s R-1 T-3 ~> m4 kg-1 s-2 or m7 kg-2 s-2]
918  real :: h_limit_fluxes ! Another depth scale [H ~> m or kg m-2]
919 
920  ! smg: what do we do when have heat fluxes from calving and river?
921  useriverheatcontent = .false.
922  usecalvingheatcontent = .false.
923 
924  depthbeforescalingfluxes = max( gv%Angstrom_H, 1.e-30*gv%m_to_H )
925  pressure(:) = 0. ! Ignore atmospheric pressure
926  gorho = (gv%g_Earth * gv%H_to_Z*us%T_to_s) / gv%Rho0
927  start = 1 + g%isc - g%isd
928  npts = 1 + g%iec - g%isc
929 
930  h_limit_fluxes = depthbeforescalingfluxes
931 
932  ! The surface forcing is contained in the fluxes type.
933  ! We aggregate the thermodynamic forcing for a time step into the following:
934  ! netH = water added/removed via surface fluxes [H s-1 ~> m s-1 or kg m-2 s-1]
935  ! netHeat = heat via surface fluxes [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1]
936  ! netSalt = salt via surface fluxes [ppt H s-1 ~> ppt m s-1 or gSalt m-2 s-1]
937  ! Note that unlike other calls to extractFLuxes1d() that return the time-integrated flux
938  ! this call returns the rate because dt=1
939  call extractfluxes1d(g, gv, us, fluxes, optics, nsw, j, dt*us%s_to_T, &
940  depthbeforescalingfluxes, useriverheatcontent, usecalvingheatcontent, &
941  h(:,j,:), temp(:,j,:), neth, netevap, netheatminussw, &
942  netsalt, penswbnd, tv, .false., skip_diags=skip_diags)
943 
944  ! Sum over bands and attenuate as a function of depth
945  ! netPen is the netSW as a function of depth
946  call sumswoverbands(g, gv, us, h(:,j,:), optics_nbands(optics), optics, j, dt*us%s_to_T, &
947  h_limit_fluxes, .true., penswbnd, netpen)
948 
949  ! Density derivatives
950  call calculate_density_derivs(temp(:,j,1), salt(:,j,1), pressure, &
951  drhodt, drhods, start, npts, tv%eqn_of_state, scale=us%kg_m3_to_R)
952 
953  ! Adjust netSalt to reflect dilution effect of FW flux
954  netsalt(g%isc:g%iec) = netsalt(g%isc:g%iec) - salt(g%isc:g%iec,j,1) * neth(g%isc:g%iec) ! ppt H/s
955 
956  ! Add in the SW heating for purposes of calculating the net
957  ! surface buoyancy flux affecting the top layer.
958  !netHeat(:) = netHeatMinusSW(:) + sum( penSWbnd, dim=1 )
959  netheat(g%isc:g%iec) = netheatminussw(g%isc:g%iec) + netpen(g%isc:g%iec,1) ! K H/s
960 
961  ! Convert to a buoyancy flux, excluding penetrating SW heating
962  buoyancyflux(g%isc:g%iec,1) = - gorho * ( drhods(g%isc:g%iec) * netsalt(g%isc:g%iec) + &
963  drhodt(g%isc:g%iec) * netheat(g%isc:g%iec) ) ! [L2 T-3 ~> m2 s-3]
964  ! We also have a penetrative buoyancy flux associated with penetrative SW
965  do k=2, g%ke+1
966  buoyancyflux(g%isc:g%iec,k) = - gorho * ( drhodt(g%isc:g%iec) * netpen(g%isc:g%iec,k) ) ! [L2 T-3 ~> m2 s-3]
967  enddo
968 
969 end subroutine calculatebuoyancyflux1d
970 
971 
972 !> Calculates surface buoyancy flux by adding up the heat, FW and salt fluxes,
973 !! for 2d arrays. This is a wrapper for calculateBuoyancyFlux1d.
974 subroutine calculatebuoyancyflux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, &
975  buoyancyFlux, netHeatMinusSW, netSalt, skip_diags)
976  type(ocean_grid_type), intent(in) :: g !< ocean grid
977  type(verticalgrid_type), intent(in) :: gv !< ocean vertical grid structure
978  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
979  type(forcing), intent(inout) :: fluxes !< surface fluxes
980  type(optics_type), pointer :: optics !< SW ocean optics
981  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness [H ~> m or kg m-2]
982  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp !< temperature [degC]
983  real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: salt !< salinity [ppt]
984  type(thermo_var_ptrs), intent(inout) :: tv !< thermodynamics type
985  real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: buoyancyflux !< buoyancy fluxes [L2 T-3 ~> m2 s-3]
986  real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netheatminussw !< surf temp flux
987  !! [degC H ~> degC m or degC kg m-2]
988  real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netsalt !< surf salt flux
989  !! [ppt H ~> ppt m or ppt kg m-2]
990  logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating
991  !! diagnostics inside extractFluxes1d()
992  ! local variables
993  real, dimension( SZI_(G) ) :: nett ! net temperature flux [degC H s-1 ~> degC m s-2 or degC kg m-2 s-1]
994  real, dimension( SZI_(G) ) :: nets ! net saln flux !! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1]
995  integer :: j
996 
997  nett(g%isc:g%iec) = 0. ; nets(g%isc:g%iec) = 0.
998 
999  !$OMP parallel do default(shared) firstprivate(netT,netS)
1000  do j=g%jsc,g%jec
1001  call calculatebuoyancyflux1d(g, gv, us, fluxes, optics, optics_nbands(optics), h, temp, salt, &
1002  tv, j, buoyancyflux(:,j,:), nett, nets, skip_diags=skip_diags)
1003  if (present(netheatminussw)) netheatminussw(g%isc:g%iec,j) = nett(g%isc:g%iec)
1004  if (present(netsalt)) netsalt(g%isc:g%iec,j) = nets(g%isc:g%iec)
1005  enddo
1006 
1007 end subroutine calculatebuoyancyflux2d
1008 
1009 
1010 !> Write out chksums for thermodynamic fluxes.
1011 subroutine mom_forcing_chksum(mesg, fluxes, G, US, haloshift)
1012  character(len=*), intent(in) :: mesg !< message
1013  type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields
1014  type(ocean_grid_type), intent(in) :: g !< grid type
1015  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
1016  integer, optional, intent(in) :: haloshift !< shift in halo
1017 
1018  real :: rz_t_conversion ! A combination of scaling factors for mass fluxes [kg T m-2 s-1 R-1 Z-1 ~> 1]
1019  integer :: is, ie, js, je, nz, hshift
1020  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
1021 
1022  hshift = 1 ; if (present(haloshift)) hshift = haloshift
1023  rz_t_conversion = us%R_to_kg_m3*us%Z_to_m*us%s_to_T
1024 
1025  ! Note that for the chksum calls to be useful for reproducing across PE
1026  ! counts, there must be no redundant points, so all variables use is..ie
1027  ! and js...je as their extent.
1028  if (associated(fluxes%ustar)) &
1029  call hchksum(fluxes%ustar, mesg//" fluxes%ustar",g%HI, haloshift=hshift, scale=us%Z_to_m*us%s_to_T)
1030  if (associated(fluxes%buoy)) &
1031  call hchksum(fluxes%buoy, mesg//" fluxes%buoy ",g%HI, haloshift=hshift, scale=us%L_to_m**2*us%s_to_T**3)
1032  if (associated(fluxes%sw)) &
1033  call hchksum(fluxes%sw, mesg//" fluxes%sw",g%HI,haloshift=hshift)
1034  if (associated(fluxes%sw_vis_dir)) &
1035  call hchksum(fluxes%sw_vis_dir, mesg//" fluxes%sw_vis_dir",g%HI,haloshift=hshift)
1036  if (associated(fluxes%sw_vis_dif)) &
1037  call hchksum(fluxes%sw_vis_dif, mesg//" fluxes%sw_vis_dif",g%HI,haloshift=hshift)
1038  if (associated(fluxes%sw_nir_dir)) &
1039  call hchksum(fluxes%sw_nir_dir, mesg//" fluxes%sw_nir_dir",g%HI,haloshift=hshift)
1040  if (associated(fluxes%sw_nir_dif)) &
1041  call hchksum(fluxes%sw_nir_dif, mesg//" fluxes%sw_nir_dif",g%HI,haloshift=hshift)
1042  if (associated(fluxes%lw)) &
1043  call hchksum(fluxes%lw, mesg//" fluxes%lw",g%HI,haloshift=hshift)
1044  if (associated(fluxes%latent)) &
1045  call hchksum(fluxes%latent, mesg//" fluxes%latent",g%HI,haloshift=hshift)
1046  if (associated(fluxes%latent_evap_diag)) &
1047  call hchksum(fluxes%latent_evap_diag, mesg//" fluxes%latent_evap_diag",g%HI,haloshift=hshift)
1048  if (associated(fluxes%latent_fprec_diag)) &
1049  call hchksum(fluxes%latent_fprec_diag, mesg//" fluxes%latent_fprec_diag",g%HI,haloshift=hshift)
1050  if (associated(fluxes%latent_frunoff_diag)) &
1051  call hchksum(fluxes%latent_frunoff_diag, mesg//" fluxes%latent_frunoff_diag",g%HI,haloshift=hshift)
1052  if (associated(fluxes%sens)) &
1053  call hchksum(fluxes%sens, mesg//" fluxes%sens",g%HI,haloshift=hshift)
1054  if (associated(fluxes%evap)) &
1055  call hchksum(fluxes%evap, mesg//" fluxes%evap",g%HI,haloshift=hshift, scale=rz_t_conversion)
1056  if (associated(fluxes%lprec)) &
1057  call hchksum(fluxes%lprec, mesg//" fluxes%lprec",g%HI,haloshift=hshift, scale=rz_t_conversion)
1058  if (associated(fluxes%fprec)) &
1059  call hchksum(fluxes%fprec, mesg//" fluxes%fprec",g%HI,haloshift=hshift, scale=rz_t_conversion)
1060  if (associated(fluxes%vprec)) &
1061  call hchksum(fluxes%vprec, mesg//" fluxes%vprec",g%HI,haloshift=hshift, scale=rz_t_conversion)
1062  if (associated(fluxes%seaice_melt)) &
1063  call hchksum(fluxes%seaice_melt, mesg//" fluxes%seaice_melt",g%HI,haloshift=hshift, scale=rz_t_conversion)
1064  if (associated(fluxes%seaice_melt_heat)) &
1065  call hchksum(fluxes%seaice_melt_heat, mesg//" fluxes%seaice_melt_heat",g%HI,haloshift=hshift)
1066  if (associated(fluxes%p_surf)) &
1067  call hchksum(fluxes%p_surf, mesg//" fluxes%p_surf",g%HI,haloshift=hshift)
1068  if (associated(fluxes%salt_flux)) &
1069  call hchksum(fluxes%salt_flux, mesg//" fluxes%salt_flux",g%HI,haloshift=hshift, scale=rz_t_conversion)
1070  if (associated(fluxes%TKE_tidal)) &
1071  call hchksum(fluxes%TKE_tidal, mesg//" fluxes%TKE_tidal",g%HI,haloshift=hshift, &
1072  scale=us%R_to_kg_m3**3*us%Z_to_m**3*us%s_to_T)
1073  if (associated(fluxes%ustar_tidal)) &
1074  call hchksum(fluxes%ustar_tidal, mesg//" fluxes%ustar_tidal",g%HI,haloshift=hshift, scale=us%Z_to_m*us%s_to_T)
1075  if (associated(fluxes%lrunoff)) &
1076  call hchksum(fluxes%lrunoff, mesg//" fluxes%lrunoff",g%HI,haloshift=hshift, scale=rz_t_conversion)
1077  if (associated(fluxes%frunoff)) &
1078  call hchksum(fluxes%frunoff, mesg//" fluxes%frunoff",g%HI,haloshift=hshift, scale=rz_t_conversion)
1079  if (associated(fluxes%heat_content_lrunoff)) &
1080  call hchksum(fluxes%heat_content_lrunoff, mesg//" fluxes%heat_content_lrunoff", g%HI, &
1081  haloshift=hshift, scale=rz_t_conversion)
1082  if (associated(fluxes%heat_content_frunoff)) &
1083  call hchksum(fluxes%heat_content_frunoff, mesg//" fluxes%heat_content_frunoff", g%HI, &
1084  haloshift=hshift, scale=rz_t_conversion)
1085  if (associated(fluxes%heat_content_lprec)) &
1086  call hchksum(fluxes%heat_content_lprec, mesg//" fluxes%heat_content_lprec", g%HI, &
1087  haloshift=hshift, scale=rz_t_conversion)
1088  if (associated(fluxes%heat_content_fprec)) &
1089  call hchksum(fluxes%heat_content_fprec, mesg//" fluxes%heat_content_fprec", g%HI, &
1090  haloshift=hshift, scale=rz_t_conversion)
1091  if (associated(fluxes%heat_content_icemelt)) &
1092  call hchksum(fluxes%heat_content_icemelt, mesg//" fluxes%heat_content_icemelt", g%HI, &
1093  haloshift=hshift, scale=rz_t_conversion)
1094  if (associated(fluxes%heat_content_cond)) &
1095  call hchksum(fluxes%heat_content_cond, mesg//" fluxes%heat_content_cond", g%HI, &
1096  haloshift=hshift, scale=rz_t_conversion)
1097  if (associated(fluxes%heat_content_massout)) &
1098  call hchksum(fluxes%heat_content_massout, mesg//" fluxes%heat_content_massout", g%HI, &
1099  haloshift=hshift, scale=rz_t_conversion)
1100 end subroutine mom_forcing_chksum
1101 
1102 !> Write out chksums for the driving mechanical forces.
1103 subroutine mom_mech_forcing_chksum(mesg, forces, G, US, haloshift)
1104  character(len=*), intent(in) :: mesg !< message
1105  type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
1106  type(ocean_grid_type), intent(in) :: g !< grid type
1107  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
1108  integer, optional, intent(in) :: haloshift !< shift in halo
1109 
1110  integer :: is, ie, js, je, nz, hshift
1111  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec ; nz = g%ke
1112 
1113  hshift=1; if (present(haloshift)) hshift=haloshift
1114 
1115  ! Note that for the chksum calls to be useful for reproducing across PE
1116  ! counts, there must be no redundant points, so all variables use is..ie
1117  ! and js...je as their extent.
1118  if (associated(forces%taux) .and. associated(forces%tauy)) &
1119  call uvchksum(mesg//" forces%tau[xy]", forces%taux, forces%tauy, g%HI, &
1120  haloshift=hshift, symmetric=.true., scale=us%R_to_kg_m3*us%L_T_to_m_s**2*us%Z_to_L)
1121  if (associated(forces%p_surf)) &
1122  call hchksum(forces%p_surf, mesg//" forces%p_surf",g%HI,haloshift=hshift)
1123  if (associated(forces%ustar)) &
1124  call hchksum(forces%ustar, mesg//" forces%ustar",g%HI,haloshift=hshift, scale=us%Z_to_m*us%s_to_T)
1125  if (associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)) &
1126  call uvchksum(mesg//" forces%rigidity_ice_[uv]", forces%rigidity_ice_u, &
1127  forces%rigidity_ice_v, g%HI, haloshift=hshift, symmetric=.true.)
1128 
1129 end subroutine mom_mech_forcing_chksum
1130 
1131 !> Write out values of the mechanical forcing arrays at the i,j location. This is a debugging tool.
1132 subroutine mech_forcing_singlepointprint(forces, G, i, j, mesg)
1133  type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
1134  type(ocean_grid_type), intent(in) :: G !< Grid type
1135  character(len=*), intent(in) :: mesg !< Message
1136  integer, intent(in) :: i !< i-index
1137  integer, intent(in) :: j !< j-index
1138 
1139  write(0,'(2a)') 'MOM_forcing_type, forcing_SinglePointPrint: Called from ',mesg
1140  write(0,'(a,2es15.3)') 'MOM_forcing_type, forcing_SinglePointPrint: lon,lat = ',g%geoLonT(i,j),g%geoLatT(i,j)
1141  call locmsg(forces%taux,'taux')
1142  call locmsg(forces%tauy,'tauy')
1143 
1144  contains
1145  !> Format and write a message depending on associated state of array
1146  subroutine locmsg(array,aname)
1147  real, dimension(:,:), pointer :: array !< Array to write element from
1148  character(len=*) :: aname !< Name of array
1149 
1150  if (associated(array)) then
1151  write(0,'(3a,es15.3)') 'MOM_forcing_type, mech_forcing_SinglePointPrint: ',trim(aname),' = ',array(i,j)
1152  else
1153  write(0,'(4a)') 'MOM_forcing_type, mech_forcing_SinglePointPrint: ',trim(aname),' is not associated.'
1154  endif
1155  end subroutine locmsg
1156 
1157 end subroutine mech_forcing_singlepointprint
1158 
1159 !> Write out values of the fluxes arrays at the i,j location. This is a debugging tool.
1160 subroutine forcing_singlepointprint(fluxes, G, i, j, mesg)
1161  type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields
1162  type(ocean_grid_type), intent(in) :: g !< Grid type
1163  character(len=*), intent(in) :: mesg !< Message
1164  integer, intent(in) :: i !< i-index
1165  integer, intent(in) :: j !< j-index
1166 
1167  write(0,'(2a)') 'MOM_forcing_type, forcing_SinglePointPrint: Called from ',mesg
1168  write(0,'(a,2es15.3)') 'MOM_forcing_type, forcing_SinglePointPrint: lon,lat = ',g%geoLonT(i,j),g%geoLatT(i,j)
1169  call locmsg(fluxes%ustar,'ustar')
1170  call locmsg(fluxes%buoy,'buoy')
1171  call locmsg(fluxes%sw,'sw')
1172  call locmsg(fluxes%sw_vis_dir,'sw_vis_dir')
1173  call locmsg(fluxes%sw_vis_dif,'sw_vis_dif')
1174  call locmsg(fluxes%sw_nir_dir,'sw_nir_dir')
1175  call locmsg(fluxes%sw_nir_dif,'sw_nir_dif')
1176  call locmsg(fluxes%lw,'lw')
1177  call locmsg(fluxes%latent,'latent')
1178  call locmsg(fluxes%latent_evap_diag,'latent_evap_diag')
1179  call locmsg(fluxes%latent_fprec_diag,'latent_fprec_diag')
1180  call locmsg(fluxes%latent_frunoff_diag,'latent_frunoff_diag')
1181  call locmsg(fluxes%sens,'sens')
1182  call locmsg(fluxes%evap,'evap')
1183  call locmsg(fluxes%lprec,'lprec')
1184  call locmsg(fluxes%fprec,'fprec')
1185  call locmsg(fluxes%vprec,'vprec')
1186  call locmsg(fluxes%seaice_melt,'seaice_melt')
1187  call locmsg(fluxes%seaice_melt_heat,'seaice_melt_heat')
1188  call locmsg(fluxes%p_surf,'p_surf')
1189  call locmsg(fluxes%salt_flux,'salt_flux')
1190  call locmsg(fluxes%TKE_tidal,'TKE_tidal')
1191  call locmsg(fluxes%ustar_tidal,'ustar_tidal')
1192  call locmsg(fluxes%lrunoff,'lrunoff')
1193  call locmsg(fluxes%frunoff,'frunoff')
1194  call locmsg(fluxes%heat_content_lrunoff,'heat_content_lrunoff')
1195  call locmsg(fluxes%heat_content_frunoff,'heat_content_frunoff')
1196  call locmsg(fluxes%heat_content_lprec,'heat_content_lprec')
1197  call locmsg(fluxes%heat_content_fprec,'heat_content_fprec')
1198  call locmsg(fluxes%heat_content_icemelt,'heat_content_icemelt')
1199  call locmsg(fluxes%heat_content_vprec,'heat_content_vprec')
1200  call locmsg(fluxes%heat_content_cond,'heat_content_cond')
1201  call locmsg(fluxes%heat_content_cond,'heat_content_massout')
1202 
1203  contains
1204  !> Format and write a message depending on associated state of array
1205  subroutine locmsg(array,aname)
1206  real, dimension(:,:), pointer :: array !< Array to write element from
1207  character(len=*) :: aname !< Name of array
1208 
1209  if (associated(array)) then
1210  write(0,'(3a,es15.3)') 'MOM_forcing_type, forcing_SinglePointPrint: ',trim(aname),' = ',array(i,j)
1211  else
1212  write(0,'(4a)') 'MOM_forcing_type, forcing_SinglePointPrint: ',trim(aname),' is not associated.'
1213  endif
1214  end subroutine locmsg
1215 
1216 end subroutine forcing_singlepointprint
1217 
1218 
1219 !> Register members of the forcing type for diagnostics
1220 subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, use_berg_fluxes)
1221  type(time_type), intent(in) :: time !< time type
1222  type(diag_ctrl), intent(inout) :: diag !< diagnostic control type
1223  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
1224  logical, intent(in) :: use_temperature !< True if T/S are in use
1225  type(forcing_diags), intent(inout) :: handles !< handles for diagnostics
1226  logical, optional, intent(in) :: use_berg_fluxes !< If true, allow iceberg flux diagnostics
1227 
1228  ! Clock for forcing diagnostics
1229  handles%id_clock_forcing=cpu_clock_id('(Ocean forcing diagnostics)', grain=clock_routine)
1230 
1231 
1232  handles%id_taux = register_diag_field('ocean_model', 'taux', diag%axesCu1, time, &
1233  'Zonal surface stress from ocean interactions with atmos and ice', &
1234  'Pa', conversion=us%R_to_kg_m3*us%L_T_to_m_s**2*us%Z_to_L, &
1235  standard_name='surface_downward_x_stress', cmor_field_name='tauuo', &
1236  cmor_units='N m-2', cmor_long_name='Surface Downward X Stress', &
1237  cmor_standard_name='surface_downward_x_stress')
1238 
1239  handles%id_tauy = register_diag_field('ocean_model', 'tauy', diag%axesCv1, time, &
1240  'Meridional surface stress ocean interactions with atmos and ice', &
1241  'Pa', conversion=us%R_to_kg_m3*us%L_T_to_m_s**2*us%Z_to_L, &
1242  standard_name='surface_downward_y_stress', cmor_field_name='tauvo', &
1243  cmor_units='N m-2', cmor_long_name='Surface Downward Y Stress', &
1244  cmor_standard_name='surface_downward_y_stress')
1245 
1246  handles%id_ustar = register_diag_field('ocean_model', 'ustar', diag%axesT1, time, &
1247  'Surface friction velocity = [(gustiness + tau_magnitude)/rho0]^(1/2)', &
1248  'm s-1', conversion=us%Z_to_m*us%s_to_T)
1249 
1250  if (present(use_berg_fluxes)) then
1251  if (use_berg_fluxes) then
1252  handles%id_ustar_berg = register_diag_field('ocean_model', 'ustar_berg', diag%axesT1, time, &
1253  'Friction velocity below iceberg ', 'm s-1', conversion=us%Z_to_m*us%s_to_T)
1254 
1255  handles%id_area_berg = register_diag_field('ocean_model', 'area_berg', diag%axesT1, time, &
1256  'Area of grid cell covered by iceberg ', 'm2 m-2')
1257 
1258  handles%id_mass_berg = register_diag_field('ocean_model', 'mass_berg', diag%axesT1, time, &
1259  'Mass of icebergs ', 'kg m-2')
1260 
1261  handles%id_ustar_ice_cover = register_diag_field('ocean_model', 'ustar_ice_cover', diag%axesT1, time, &
1262  'Friction velocity below iceberg and ice shelf together', 'm s-1', conversion=us%Z_to_m*us%s_to_T)
1263 
1264  handles%id_frac_ice_cover = register_diag_field('ocean_model', 'frac_ice_cover', diag%axesT1, time, &
1265  'Area of grid cell below iceberg and ice shelf together ', 'm2 m-2')
1266  endif
1267  endif
1268 
1269  handles%id_psurf = register_diag_field('ocean_model', 'p_surf', diag%axesT1, time, &
1270  'Pressure at ice-ocean or atmosphere-ocean interface', 'Pa', cmor_field_name='pso', &
1271  cmor_long_name='Sea Water Pressure at Sea Water Surface', &
1272  cmor_standard_name='sea_water_pressure_at_sea_water_surface')
1273 
1274  handles%id_TKE_tidal = register_diag_field('ocean_model', 'TKE_tidal', diag%axesT1, time, &
1275  'Tidal source of BBL mixing', 'W m-2', conversion=us%R_to_kg_m3*us%Z_to_m**3*us%s_to_T**3)
1276 
1277  if (.not. use_temperature) then
1278  handles%id_buoy = register_diag_field('ocean_model', 'buoy', diag%axesT1, time, &
1279  'Buoyancy forcing', 'm2 s-3', conversion=us%L_to_m**2*us%s_to_T**3)
1280  return
1281  endif
1282 
1283 
1284  !===============================================================
1285  ! surface mass flux maps
1286 
1287  handles%id_prcme = register_diag_field('ocean_model', 'PRCmE', diag%axesT1, time, &
1288  'Net surface water flux (precip+melt+lrunoff+ice calving-evap)', 'kg m-2 s-1', &
1289  standard_name='water_flux_into_sea_water', cmor_field_name='wfo', &
1290  cmor_standard_name='water_flux_into_sea_water',cmor_long_name='Water Flux Into Sea Water')
1291  ! This diagnostic is rescaled to MKS units when combined.
1292 
1293  handles%id_evap = register_diag_field('ocean_model', 'evap', diag%axesT1, time, &
1294  'Evaporation/condensation at ocean surface (evaporation is negative)', &
1295  'kg m-2 s-1', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T, &
1296  standard_name='water_evaporation_flux', cmor_field_name='evs', &
1297  cmor_standard_name='water_evaporation_flux', &
1298  cmor_long_name='Water Evaporation Flux Where Ice Free Ocean over Sea')
1299 
1300  ! smg: seaice_melt field requires updates to the sea ice model
1301  handles%id_seaice_melt = register_diag_field('ocean_model', 'seaice_melt', &
1302  diag%axesT1, time, 'water flux to ocean from snow/sea ice melting(> 0) or formation(< 0)', &
1303  'kg m-2 s-1', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T, &
1304  standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics', &
1305  cmor_field_name='fsitherm', &
1306  cmor_standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics',&
1307  cmor_long_name='water flux to ocean from sea ice melt(> 0) or form(< 0)')
1308 
1309  handles%id_precip = register_diag_field('ocean_model', 'precip', diag%axesT1, time, &
1310  'Liquid + frozen precipitation into ocean', 'kg m-2 s-1')
1311  ! This diagnostic is rescaled to MKS units when combined.
1312 
1313  handles%id_fprec = register_diag_field('ocean_model', 'fprec', diag%axesT1, time, &
1314  'Frozen precipitation into ocean', &
1315  units='kg m-2 s-1', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T, &
1316  standard_name='snowfall_flux', cmor_field_name='prsn', &
1317  cmor_standard_name='snowfall_flux', cmor_long_name='Snowfall Flux where Ice Free Ocean over Sea')
1318 
1319  handles%id_lprec = register_diag_field('ocean_model', 'lprec', diag%axesT1, time, &
1320  'Liquid precipitation into ocean', &
1321  units='kg m-2 s-1', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T, &
1322  standard_name='rainfall_flux', &
1323  cmor_field_name='prlq', cmor_standard_name='rainfall_flux', &
1324  cmor_long_name='Rainfall Flux where Ice Free Ocean over Sea')
1325 
1326  handles%id_vprec = register_diag_field('ocean_model', 'vprec', diag%axesT1, time, &
1327  'Virtual liquid precip into ocean due to SSS restoring', &
1328  units='kg m-2 s-1', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T)
1329 
1330  handles%id_frunoff = register_diag_field('ocean_model', 'frunoff', diag%axesT1, time, &
1331  'Frozen runoff (calving) and iceberg melt into ocean', &
1332  units='kg m-2 s-1', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T, &
1333  standard_name='water_flux_into_sea_water_from_icebergs', &
1334  cmor_field_name='ficeberg', &
1335  cmor_standard_name='water_flux_into_sea_water_from_icebergs', &
1336  cmor_long_name='Water Flux into Seawater from Icebergs')
1337 
1338  handles%id_lrunoff = register_diag_field('ocean_model', 'lrunoff', diag%axesT1, time, &
1339  'Liquid runoff (rivers) into ocean', &
1340  units='kg m-2 s-1', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T, &
1341  standard_name='water_flux_into_sea_water_from_rivers', cmor_field_name='friver', &
1342  cmor_standard_name='water_flux_into_sea_water_from_rivers', &
1343  cmor_long_name='Water Flux into Sea Water From Rivers')
1344 
1345  handles%id_net_massout = register_diag_field('ocean_model', 'net_massout', diag%axesT1, time, &
1346  'Net mass leaving the ocean due to evaporation, seaice formation', 'kg m-2 s-1')
1347  ! This diagnostic is rescaled to MKS units when combined.
1348 
1349  handles%id_net_massin = register_diag_field('ocean_model', 'net_massin', diag%axesT1, time, &
1350  'Net mass entering ocean due to precip, runoff, ice melt', 'kg m-2 s-1')
1351  ! This diagnostic is rescaled to MKS units when combined.
1352 
1353  handles%id_massout_flux = register_diag_field('ocean_model', 'massout_flux', diag%axesT1, time, &
1354  'Net mass flux of freshwater out of the ocean (used in the boundary flux calculation)', &
1355  'kg m-2', conversion=diag%GV%H_to_kg_m2)
1356  ! This diagnostic is calculated in MKS units.
1357 
1358  handles%id_massin_flux = register_diag_field('ocean_model', 'massin_flux', diag%axesT1, time, &
1359  'Net mass flux of freshwater into the ocean (used in boundary flux calculation)', 'kg m-2')
1360  ! This diagnostic is calculated in MKS units.
1361 
1362  !=========================================================================
1363  ! area integrated surface mass transport, all are rescaled to MKS units before area integration.
1364 
1365  handles%id_total_prcme = register_scalar_field('ocean_model', 'total_PRCmE', time, diag, &
1366  long_name='Area integrated net surface water flux (precip+melt+liq runoff+ice calving-evap)',&
1367  units='kg s-1', standard_name='water_flux_into_sea_water_area_integrated', &
1368  cmor_field_name='total_wfo', &
1369  cmor_standard_name='water_flux_into_sea_water_area_integrated', &
1370  cmor_long_name='Water Transport Into Sea Water Area Integrated')
1371 
1372  handles%id_total_evap = register_scalar_field('ocean_model', 'total_evap', time, diag,&
1373  long_name='Area integrated evap/condense at ocean surface', &
1374  units='kg s-1', standard_name='water_evaporation_flux_area_integrated', &
1375  cmor_field_name='total_evs', &
1376  cmor_standard_name='water_evaporation_flux_area_integrated', &
1377  cmor_long_name='Evaporation Where Ice Free Ocean over Sea Area Integrated')
1378 
1379  ! seaice_melt field requires updates to the sea ice model
1380  handles%id_total_seaice_melt = register_scalar_field('ocean_model', 'total_icemelt', time, diag, &
1381  long_name='Area integrated sea ice melt (>0) or form (<0)', units='kg s-1', &
1382  standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics_area_integrated', &
1383  cmor_field_name='total_fsitherm', &
1384  cmor_standard_name='water_flux_into_sea_water_due_to_sea_ice_thermodynamics_area_integrated', &
1385  cmor_long_name='Water Melt/Form from Sea Ice Area Integrated')
1386 
1387  handles%id_total_precip = register_scalar_field('ocean_model', 'total_precip', time, diag, &
1388  long_name='Area integrated liquid+frozen precip into ocean', units='kg s-1')
1389 
1390  handles%id_total_fprec = register_scalar_field('ocean_model', 'total_fprec', time, diag,&
1391  long_name='Area integrated frozen precip into ocean', units='kg s-1', &
1392  standard_name='snowfall_flux_area_integrated', &
1393  cmor_field_name='total_prsn', &
1394  cmor_standard_name='snowfall_flux_area_integrated', &
1395  cmor_long_name='Snowfall Flux where Ice Free Ocean over Sea Area Integrated')
1396 
1397  handles%id_total_lprec = register_scalar_field('ocean_model', 'total_lprec', time, diag,&
1398  long_name='Area integrated liquid precip into ocean', units='kg s-1', &
1399  standard_name='rainfall_flux_area_integrated', &
1400  cmor_field_name='total_pr', &
1401  cmor_standard_name='rainfall_flux_area_integrated', &
1402  cmor_long_name='Rainfall Flux where Ice Free Ocean over Sea Area Integrated')
1403 
1404  handles%id_total_vprec = register_scalar_field('ocean_model', 'total_vprec', time, diag, &
1405  long_name='Area integrated virtual liquid precip due to SSS restoring', units='kg s-1')
1406 
1407  handles%id_total_frunoff = register_scalar_field('ocean_model', 'total_frunoff', time, diag, &
1408  long_name='Area integrated frozen runoff (calving) & iceberg melt into ocean', units='kg s-1',&
1409  cmor_field_name='total_ficeberg', &
1410  cmor_standard_name='water_flux_into_sea_water_from_icebergs_area_integrated', &
1411  cmor_long_name='Water Flux into Seawater from Icebergs Area Integrated')
1412 
1413  handles%id_total_lrunoff = register_scalar_field('ocean_model', 'total_lrunoff', time, diag,&
1414  long_name='Area integrated liquid runoff into ocean', units='kg s-1', &
1415  cmor_field_name='total_friver', &
1416  cmor_standard_name='water_flux_into_sea_water_from_rivers_area_integrated', &
1417  cmor_long_name='Water Flux into Sea Water From Rivers Area Integrated')
1418 
1419  handles%id_total_net_massout = register_scalar_field('ocean_model', 'total_net_massout', time, diag, &
1420  long_name='Area integrated mass leaving ocean due to evap and seaice form', units='kg s-1')
1421 
1422  handles%id_total_net_massin = register_scalar_field('ocean_model', 'total_net_massin', time, diag, &
1423  long_name='Area integrated mass entering ocean due to predip, runoff, ice melt', units='kg s-1')
1424 
1425  !=========================================================================
1426  ! area averaged surface mass transport
1427 
1428  handles%id_prcme_ga = register_scalar_field('ocean_model', 'PRCmE_ga', time, diag, &
1429  long_name='Area averaged net surface water flux (precip+melt+liq runoff+ice calving-evap)',&
1430  units='kg m-2 s-1', standard_name='water_flux_into_sea_water_area_averaged', &
1431  cmor_field_name='ave_wfo', &
1432  cmor_standard_name='rainfall_flux_area_averaged', &
1433  cmor_long_name='Water Transport Into Sea Water Area Averaged')
1434 
1435  handles%id_evap_ga = register_scalar_field('ocean_model', 'evap_ga', time, diag,&
1436  long_name='Area averaged evap/condense at ocean surface', &
1437  units='kg m-2 s-1', standard_name='water_evaporation_flux_area_averaged', &
1438  cmor_field_name='ave_evs', &
1439  cmor_standard_name='water_evaporation_flux_area_averaged', &
1440  cmor_long_name='Evaporation Where Ice Free Ocean over Sea Area Averaged')
1441 
1442  handles%id_lprec_ga = register_scalar_field('ocean_model', 'lprec_ga', time, diag,&
1443  long_name='Area integrated liquid precip into ocean', units='kg m-2 s-1', &
1444  standard_name='rainfall_flux_area_averaged', &
1445  cmor_field_name='ave_pr', &
1446  cmor_standard_name='rainfall_flux_area_averaged', &
1447  cmor_long_name='Rainfall Flux where Ice Free Ocean over Sea Area Averaged')
1448 
1449  handles%id_fprec_ga = register_scalar_field('ocean_model', 'fprec_ga', time, diag,&
1450  long_name='Area integrated frozen precip into ocean', units='kg m-2 s-1', &
1451  standard_name='snowfall_flux_area_averaged', &
1452  cmor_field_name='ave_prsn', &
1453  cmor_standard_name='snowfall_flux_area_averaged', &
1454  cmor_long_name='Snowfall Flux where Ice Free Ocean over Sea Area Averaged')
1455 
1456  handles%id_precip_ga = register_scalar_field('ocean_model', 'precip_ga', time, diag, &
1457  long_name='Area averaged liquid+frozen precip into ocean', units='kg m-2 s-1')
1458 
1459  handles%id_vprec_ga = register_scalar_field('ocean_model', 'vrec_ga', time, diag, &
1460  long_name='Area averaged virtual liquid precip due to SSS restoring', units='kg m-2 s-1')
1461 
1462  !===============================================================
1463  ! surface heat flux maps
1464 
1465  handles%id_heat_content_frunoff = register_diag_field('ocean_model', 'heat_content_frunoff', &
1466  diag%axesT1, time, 'Heat content (relative to 0C) of solid runoff into ocean', &
1467  'W m-2', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T, &
1468  standard_name='temperature_flux_due_to_solid_runoff_expressed_as_heat_flux_into_sea_water')
1469 
1470  handles%id_heat_content_lrunoff = register_diag_field('ocean_model', 'heat_content_lrunoff', &
1471  diag%axesT1, time, 'Heat content (relative to 0C) of liquid runoff into ocean', &
1472  'W m-2', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T, &
1473  standard_name='temperature_flux_due_to_runoff_expressed_as_heat_flux_into_sea_water')
1474 
1475  handles%id_hfrunoffds = register_diag_field('ocean_model', 'hfrunoffds', &
1476  diag%axesT1, time, 'Heat content (relative to 0C) of liquid+solid runoff into ocean', &
1477  'W m-2', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T, &
1478  standard_name='temperature_flux_due_to_runoff_expressed_as_heat_flux_into_sea_water')
1479 
1480  handles%id_heat_content_lprec = register_diag_field('ocean_model', 'heat_content_lprec', &
1481  diag%axesT1,time,'Heat content (relative to 0degC) of liquid precip entering ocean', &
1482  'W m-2', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T)
1483 
1484  handles%id_heat_content_fprec = register_diag_field('ocean_model', 'heat_content_fprec',&
1485  diag%axesT1,time,'Heat content (relative to 0degC) of frozen prec entering ocean',&
1486  'W m-2', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T)
1487 
1488  handles%id_heat_content_icemelt = register_diag_field('ocean_model', 'heat_content_icemelt',&
1489  diag%axesT1,time,'Heat content (relative to 0degC) of water flux due to sea ice melting/freezing',&
1490  'W m-2', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T)
1491 
1492  handles%id_heat_content_vprec = register_diag_field('ocean_model', 'heat_content_vprec', &
1493  diag%axesT1,time,'Heat content (relative to 0degC) of virtual precip entering ocean',&
1494  'W m-2', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T)
1495 
1496  handles%id_heat_content_cond = register_diag_field('ocean_model', 'heat_content_cond', &
1497  diag%axesT1,time,'Heat content (relative to 0degC) of water condensing into ocean',&
1498  'W m-2', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T)
1499 
1500  handles%id_hfrainds = register_diag_field('ocean_model', 'hfrainds', &
1501  diag%axesT1,time,'Heat content (relative to 0degC) of liquid+frozen precip entering ocean', &
1502  'W m-2', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T, &
1503  standard_name='temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water',&
1504  cmor_long_name='Heat Content (relative to 0degC) of Liquid + Frozen Precipitation')
1505 
1506  handles%id_heat_content_surfwater = register_diag_field('ocean_model', 'heat_content_surfwater',&
1507  diag%axesT1, time, &
1508  'Heat content (relative to 0degC) of net water crossing ocean surface (frozen+liquid)', &
1509  'W m-2', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T)
1510 
1511  handles%id_heat_content_massout = register_diag_field('ocean_model', 'heat_content_massout', &
1512  diag%axesT1, time,'Heat content (relative to 0degC) of net mass leaving ocean ocean via evap and ice form',&
1513  'W m-2', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T, &
1514  cmor_field_name='hfevapds', &
1515  cmor_standard_name='temperature_flux_due_to_evaporation_expressed_as_heat_flux_out_of_sea_water', &
1516  cmor_long_name='Heat Content (relative to 0degC) of Water Leaving Ocean via Evaporation and Ice Formation')
1517 
1518  handles%id_heat_content_massin = register_diag_field('ocean_model', 'heat_content_massin', &
1519  diag%axesT1, time,'Heat content (relative to 0degC) of net mass entering ocean ocean',&
1520  'W m-2', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T)
1521 
1522  handles%id_net_heat_coupler = register_diag_field('ocean_model', 'net_heat_coupler', &
1523  diag%axesT1,time,'Surface ocean heat flux from SW+LW+latent+sensible+seaice_melt_heat (via the coupler)',&
1524  'W m-2')
1525 
1526  handles%id_net_heat_surface = register_diag_field('ocean_model', 'net_heat_surface',diag%axesT1, time, &
1527  'Surface ocean heat flux from SW+LW+lat+sens+mass transfer+frazil+restore+seaice_melt_heat or '// &
1528  'flux adjustments',&
1529  'W m-2',&
1530  standard_name='surface_downward_heat_flux_in_sea_water', cmor_field_name='hfds', &
1531  cmor_standard_name='surface_downward_heat_flux_in_sea_water', &
1532  cmor_long_name='Surface ocean heat flux from SW+LW+latent+sensible+masstransfer+frazil+seaice_melt_heat')
1533 
1534  handles%id_sw = register_diag_field('ocean_model', 'SW', diag%axesT1, time, &
1535  'Shortwave radiation flux into ocean', 'W m-2', &
1536  standard_name='net_downward_shortwave_flux_at_sea_water_surface', &
1537  cmor_field_name='rsntds', &
1538  cmor_standard_name='net_downward_shortwave_flux_at_sea_water_surface', &
1539  cmor_long_name='Net Downward Shortwave Radiation at Sea Water Surface')
1540  handles%id_sw_vis = register_diag_field('ocean_model', 'sw_vis', diag%axesT1, time, &
1541  'Shortwave radiation direct and diffuse flux into the ocean in the visible band', &
1542  'W m-2')
1543  handles%id_sw_nir = register_diag_field('ocean_model', 'sw_nir', diag%axesT1, time, &
1544  'Shortwave radiation direct and diffuse flux into the ocean in the near-infrared band', &
1545  'W m-2')
1546 
1547  handles%id_LwLatSens = register_diag_field('ocean_model', 'LwLatSens', diag%axesT1, time, &
1548  'Combined longwave, latent, and sensible heating at ocean surface', 'W m-2')
1549 
1550  handles%id_lw = register_diag_field('ocean_model', 'LW', diag%axesT1, time, &
1551  'Longwave radiation flux into ocean', 'W m-2', &
1552  standard_name='surface_net_downward_longwave_flux', &
1553  cmor_field_name='rlntds', &
1554  cmor_standard_name='surface_net_downward_longwave_flux', &
1555  cmor_long_name='Surface Net Downward Longwave Radiation')
1556 
1557  handles%id_lat = register_diag_field('ocean_model', 'latent', diag%axesT1, time, &
1558  'Latent heat flux into ocean due to fusion and evaporation (negative means ocean heat loss)', &
1559  'W m-2', cmor_field_name='hflso', &
1560  cmor_standard_name='surface_downward_latent_heat_flux', &
1561  cmor_long_name='Surface Downward Latent Heat Flux due to Evap + Melt Snow/Ice')
1562 
1563  handles%id_lat_evap = register_diag_field('ocean_model', 'latent_evap', diag%axesT1, time, &
1564  'Latent heat flux into ocean due to evaporation/condensation', 'W m-2')
1565 
1566  handles%id_lat_fprec = register_diag_field('ocean_model', 'latent_fprec_diag', diag%axesT1, time,&
1567  'Latent heat flux into ocean due to melting of frozen precipitation', 'W m-2', &
1568  cmor_field_name='hfsnthermds', &
1569  cmor_standard_name='heat_flux_into_sea_water_due_to_snow_thermodynamics', &
1570  cmor_long_name='Latent Heat to Melt Frozen Precipitation')
1571 
1572  handles%id_lat_frunoff = register_diag_field('ocean_model', 'latent_frunoff', diag%axesT1, time, &
1573  'Latent heat flux into ocean due to melting of icebergs', 'W m-2', &
1574  cmor_field_name='hfibthermds', &
1575  cmor_standard_name='heat_flux_into_sea_water_due_to_iceberg_thermodynamics', &
1576  cmor_long_name='Latent Heat to Melt Frozen Runoff/Iceberg')
1577 
1578  handles%id_sens = register_diag_field('ocean_model', 'sensible', diag%axesT1, time,&
1579  'Sensible heat flux into ocean', 'W m-2', &
1580  standard_name='surface_downward_sensible_heat_flux', &
1581  cmor_field_name='hfsso', &
1582  cmor_standard_name='surface_downward_sensible_heat_flux', &
1583  cmor_long_name='Surface Downward Sensible Heat Flux')
1584 
1585  handles%id_seaice_melt_heat = register_diag_field('ocean_model', 'seaice_melt_heat', diag%axesT1, time,&
1586  'Heat flux into ocean due to snow and sea ice melt/freeze', 'W m-2', &
1587  standard_name='snow_ice_melt_heat_flux', &
1588  !GMM TODO cmor_field_name='hfsso', &
1589  cmor_standard_name='snow_ice_melt_heat_flux', &
1590  cmor_long_name='Heat flux into ocean from snow and sea ice melt')
1591 
1592  handles%id_heat_added = register_diag_field('ocean_model', 'heat_added', diag%axesT1, time, &
1593  'Flux Adjustment or restoring surface heat flux into ocean', 'W m-2')
1594 
1595 
1596  !===============================================================
1597  ! area integrated surface heat fluxes
1598 
1599  handles%id_total_heat_content_frunoff = register_scalar_field('ocean_model', &
1600  'total_heat_content_frunoff', time, diag, &
1601  long_name='Area integrated heat content (relative to 0C) of solid runoff', &
1602  units='W', cmor_field_name='total_hfsolidrunoffds', &
1603  cmor_standard_name= &
1604  'temperature_flux_due_to_solid_runoff_expressed_as_heat_flux_into_sea_water_area_integrated',&
1605  cmor_long_name= &
1606  'Temperature Flux due to Solid Runoff Expressed as Heat Flux into Sea Water Area Integrated')
1607 
1608  handles%id_total_heat_content_lrunoff = register_scalar_field('ocean_model', &
1609  'total_heat_content_lrunoff', time, diag, &
1610  long_name='Area integrated heat content (relative to 0C) of liquid runoff', &
1611  units='W', cmor_field_name='total_hfrunoffds', &
1612  cmor_standard_name= &
1613  'temperature_flux_due_to_runoff_expressed_as_heat_flux_into_sea_water_area_integrated',&
1614  cmor_long_name= &
1615  'Temperature Flux due to Runoff Expressed as Heat Flux into Sea Water Area Integrated')
1616 
1617  handles%id_total_heat_content_lprec = register_scalar_field('ocean_model', &
1618  'total_heat_content_lprec', time, diag, &
1619  long_name='Area integrated heat content (relative to 0C) of liquid precip', &
1620  units='W', cmor_field_name='total_hfrainds', &
1621  cmor_standard_name= &
1622  'temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water_area_integrated',&
1623  cmor_long_name= &
1624  'Temperature Flux due to Rainfall Expressed as Heat Flux into Sea Water Area Integrated')
1625 
1626  handles%id_total_heat_content_fprec = register_scalar_field('ocean_model', &
1627  'total_heat_content_fprec', time, diag, &
1628  long_name='Area integrated heat content (relative to 0C) of frozen precip',&
1629  units='W')
1630 
1631  handles%id_total_heat_content_icemelt = register_scalar_field('ocean_model', &
1632  'total_heat_content_icemelt', time, diag,long_name= &
1633  'Area integrated heat content (relative to 0C) of water flux due sea ice melting/freezing', &
1634  units='W')
1635 
1636  handles%id_total_heat_content_vprec = register_scalar_field('ocean_model', &
1637  'total_heat_content_vprec', time, diag, &
1638  long_name='Area integrated heat content (relative to 0C) of virtual precip',&
1639  units='W')
1640 
1641  handles%id_total_heat_content_cond = register_scalar_field('ocean_model', &
1642  'total_heat_content_cond', time, diag, &
1643  long_name='Area integrated heat content (relative to 0C) of condensate',&
1644  units='W')
1645 
1646  handles%id_total_heat_content_surfwater = register_scalar_field('ocean_model', &
1647  'total_heat_content_surfwater', time, diag, &
1648  long_name='Area integrated heat content (relative to 0C) of water crossing surface',&
1649  units='W')
1650 
1651  handles%id_total_heat_content_massout = register_scalar_field('ocean_model', &
1652  'total_heat_content_massout', time, diag, &
1653  long_name='Area integrated heat content (relative to 0C) of water leaving ocean', &
1654  units='W', &
1655  cmor_field_name='total_hfevapds', &
1656  cmor_standard_name= &
1657  'temperature_flux_due_to_evaporation_expressed_as_heat_flux_out_of_sea_water_area_integrated',&
1658  cmor_long_name='Heat Flux Out of Sea Water due to Evaporating Water Area Integrated')
1659 
1660  handles%id_total_heat_content_massin = register_scalar_field('ocean_model', &
1661  'total_heat_content_massin', time, diag, &
1662  long_name='Area integrated heat content (relative to 0C) of water entering ocean',&
1663  units='W')
1664 
1665  handles%id_total_net_heat_coupler = register_scalar_field('ocean_model', &
1666  'total_net_heat_coupler', time, diag, &
1667  long_name='Area integrated surface heat flux from SW+LW+latent+sensible+seaice_melt_heat (via the coupler)',&
1668  units='W')
1669 
1670  handles%id_total_net_heat_surface = register_scalar_field('ocean_model', &
1671  'total_net_heat_surface', time, diag, &
1672  long_name='Area integrated surface heat flux from SW+LW+lat+sens+mass+frazil+restore or flux adjustments', &
1673  units='W', &
1674  cmor_field_name='total_hfds', &
1675  cmor_standard_name='surface_downward_heat_flux_in_sea_water_area_integrated', &
1676  cmor_long_name= &
1677  'Surface Ocean Heat Flux from SW+LW+latent+sensible+mass transfer+frazil Area Integrated')
1678 
1679  handles%id_total_sw = register_scalar_field('ocean_model', &
1680  'total_sw', time, diag, &
1681  long_name='Area integrated net downward shortwave at sea water surface', &
1682  units='W', &
1683  cmor_field_name='total_rsntds', &
1684  cmor_standard_name='net_downward_shortwave_flux_at_sea_water_surface_area_integrated',&
1685  cmor_long_name= &
1686  'Net Downward Shortwave Radiation at Sea Water Surface Area Integrated')
1687 
1688  handles%id_total_LwLatSens = register_scalar_field('ocean_model',&
1689  'total_LwLatSens', time, diag, &
1690  long_name='Area integrated longwave+latent+sensible heating',&
1691  units='W')
1692 
1693  handles%id_total_lw = register_scalar_field('ocean_model', &
1694  'total_lw', time, diag, &
1695  long_name='Area integrated net downward longwave at sea water surface', &
1696  units='W', &
1697  cmor_field_name='total_rlntds', &
1698  cmor_standard_name='surface_net_downward_longwave_flux_area_integrated',&
1699  cmor_long_name= &
1700  'Surface Net Downward Longwave Radiation Area Integrated')
1701 
1702  handles%id_total_lat = register_scalar_field('ocean_model', &
1703  'total_lat', time, diag, &
1704  long_name='Area integrated surface downward latent heat flux', &
1705  units='W', &
1706  cmor_field_name='total_hflso', &
1707  cmor_standard_name='surface_downward_latent_heat_flux_area_integrated',&
1708  cmor_long_name= &
1709  'Surface Downward Latent Heat Flux Area Integrated')
1710 
1711  handles%id_total_lat_evap = register_scalar_field('ocean_model', &
1712  'total_lat_evap', time, diag, &
1713  long_name='Area integrated latent heat flux due to evap/condense',&
1714  units='W')
1715 
1716  handles%id_total_lat_fprec = register_scalar_field('ocean_model', &
1717  'total_lat_fprec', time, diag, &
1718  long_name='Area integrated latent heat flux due to melting frozen precip', &
1719  units='W', &
1720  cmor_field_name='total_hfsnthermds', &
1721  cmor_standard_name='heat_flux_into_sea_water_due_to_snow_thermodynamics_area_integrated',&
1722  cmor_long_name= &
1723  'Latent Heat to Melt Frozen Precipitation Area Integrated')
1724 
1725  handles%id_total_lat_frunoff = register_scalar_field('ocean_model', &
1726  'total_lat_frunoff', time, diag, &
1727  long_name='Area integrated latent heat flux due to melting icebergs', &
1728  units='W', &
1729  cmor_field_name='total_hfibthermds', &
1730  cmor_standard_name='heat_flux_into_sea_water_due_to_iceberg_thermodynamics_area_integrated',&
1731  cmor_long_name= &
1732  'Heat Flux into Sea Water due to Iceberg Thermodynamics Area Integrated')
1733 
1734  handles%id_total_sens = register_scalar_field('ocean_model', &
1735  'total_sens', time, diag, &
1736  long_name='Area integrated downward sensible heat flux', &
1737  units='W', &
1738  cmor_field_name='total_hfsso', &
1739  cmor_standard_name='surface_downward_sensible_heat_flux_area_integrated',&
1740  cmor_long_name= &
1741  'Surface Downward Sensible Heat Flux Area Integrated')
1742 
1743  handles%id_total_heat_added = register_scalar_field('ocean_model',&
1744  'total_heat_adjustment', time, diag, &
1745  long_name='Area integrated surface heat flux from restoring and/or flux adjustment', &
1746  units='W')
1747 
1748  handles%id_total_seaice_melt_heat = register_scalar_field('ocean_model',&
1749  'total_seaice_melt_heat', time, diag, &
1750  long_name='Area integrated surface heat flux from snow and sea ice melt', &
1751  units='W')
1752 
1753  !===============================================================
1754  ! area averaged surface heat fluxes
1755 
1756  handles%id_net_heat_coupler_ga = register_scalar_field('ocean_model', &
1757  'net_heat_coupler_ga', time, diag, &
1758  long_name='Area averaged surface heat flux from SW+LW+latent+sensible+seaice_melt_heat (via the coupler)',&
1759  units='W m-2')
1760 
1761  handles%id_net_heat_surface_ga = register_scalar_field('ocean_model', &
1762  'net_heat_surface_ga', time, diag, long_name= &
1763  'Area averaged surface heat flux from SW+LW+lat+sens+mass+frazil+restore+seaice_melt_heat or flux adjustments', &
1764  units='W m-2', &
1765  cmor_field_name='ave_hfds', &
1766  cmor_standard_name='surface_downward_heat_flux_in_sea_water_area_averaged', &
1767  cmor_long_name= &
1768  'Surface Ocean Heat Flux from SW+LW+latent+sensible+mass transfer+frazil Area Averaged')
1769 
1770  handles%id_sw_ga = register_scalar_field('ocean_model', &
1771  'sw_ga', time, diag, &
1772  long_name='Area averaged net downward shortwave at sea water surface', &
1773  units='W m-2', &
1774  cmor_field_name='ave_rsntds', &
1775  cmor_standard_name='net_downward_shortwave_flux_at_sea_water_surface_area_averaged',&
1776  cmor_long_name= &
1777  'Net Downward Shortwave Radiation at Sea Water Surface Area Averaged')
1778 
1779  handles%id_LwLatSens_ga = register_scalar_field('ocean_model',&
1780  'LwLatSens_ga', time, diag, &
1781  long_name='Area averaged longwave+latent+sensible heating',&
1782  units='W m-2')
1783 
1784  handles%id_lw_ga = register_scalar_field('ocean_model', &
1785  'lw_ga', time, diag, &
1786  long_name='Area averaged net downward longwave at sea water surface', &
1787  units='W m-2', &
1788  cmor_field_name='ave_rlntds', &
1789  cmor_standard_name='surface_net_downward_longwave_flux_area_averaged',&
1790  cmor_long_name= &
1791  'Surface Net Downward Longwave Radiation Area Averaged')
1792 
1793  handles%id_lat_ga = register_scalar_field('ocean_model', &
1794  'lat_ga', time, diag, &
1795  long_name='Area averaged surface downward latent heat flux', &
1796  units='W m-2', &
1797  cmor_field_name='ave_hflso', &
1798  cmor_standard_name='surface_downward_latent_heat_flux_area_averaged',&
1799  cmor_long_name= &
1800  'Surface Downward Latent Heat Flux Area Averaged')
1801 
1802  handles%id_sens_ga = register_scalar_field('ocean_model', &
1803  'sens_ga', time, diag, &
1804  long_name='Area averaged downward sensible heat flux', &
1805  units='W m-2', &
1806  cmor_field_name='ave_hfsso', &
1807  cmor_standard_name='surface_downward_sensible_heat_flux_area_averaged',&
1808  cmor_long_name= &
1809  'Surface Downward Sensible Heat Flux Area Averaged')
1810 
1811 
1812  !===============================================================
1813  ! maps of surface salt fluxes, virtual precip fluxes, and adjustments
1814 
1815  handles%id_saltflux = register_diag_field('ocean_model', 'salt_flux', diag%axesT1, time,&
1816  'Net salt flux into ocean at surface (restoring + sea-ice)', &
1817  units='kg m-2 s-1', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T, &
1818  cmor_field_name='sfdsi', cmor_standard_name='downward_sea_ice_basal_salt_flux', &
1819  cmor_long_name='Downward Sea Ice Basal Salt Flux')
1820 
1821  handles%id_saltFluxIn = register_diag_field('ocean_model', 'salt_flux_in', diag%axesT1, time, &
1822  'Salt flux into ocean at surface from coupler', &
1823  units='kg m-2 s-1', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T)
1824 
1825  handles%id_saltFluxAdded = register_diag_field('ocean_model', 'salt_flux_added', &
1826  diag%axesT1,time,'Salt flux into ocean at surface due to restoring or flux adjustment', &
1827  units='kg m-2 s-1', conversion=us%R_to_kg_m3*us%Z_to_m*us%s_to_T)
1828 
1829  handles%id_saltFluxGlobalAdj = register_scalar_field('ocean_model', &
1830  'salt_flux_global_restoring_adjustment', time, diag, &
1831  'Adjustment needed to balance net global salt flux into ocean at surface', &
1832  units='kg m-2 s-1') !, conversion=US%R_to_kg_m3*US%Z_to_m*US%s_to_T)
1833 
1834  handles%id_vPrecGlobalAdj = register_scalar_field('ocean_model', &
1835  'vprec_global_adjustment', time, diag, &
1836  'Adjustment needed to adjust net vprec into ocean to zero', &
1837  'kg m-2 s-1')
1838 
1839  handles%id_netFWGlobalAdj = register_scalar_field('ocean_model', &
1840  'net_fresh_water_global_adjustment', time, diag, &
1841  'Adjustment needed to adjust net fresh water into ocean to zero',&
1842  'kg m-2 s-1')
1843 
1844  handles%id_saltFluxGlobalScl = register_scalar_field('ocean_model', &
1845  'salt_flux_global_restoring_scaling', time, diag, &
1846  'Scaling applied to balance net global salt flux into ocean at surface', &
1847  'nondim')
1848 
1849  handles%id_vPrecGlobalScl = register_scalar_field('ocean_model',&
1850  'vprec_global_scaling', time, diag, &
1851  'Scaling applied to adjust net vprec into ocean to zero', &
1852  'nondim')
1853 
1854  handles%id_netFWGlobalScl = register_scalar_field('ocean_model', &
1855  'net_fresh_water_global_scaling', time, diag, &
1856  'Scaling applied to adjust net fresh water into ocean to zero', &
1857  'nondim')
1858 
1859  !===============================================================
1860  ! area integrals of surface salt fluxes
1861 
1862  handles%id_total_saltflux = register_scalar_field('ocean_model', &
1863  'total_salt_flux', time, diag, &
1864  long_name='Area integrated surface salt flux', units='kg', &
1865  cmor_field_name='total_sfdsi', &
1866  cmor_units='kg s-1', &
1867  cmor_standard_name='downward_sea_ice_basal_salt_flux_area_integrated',&
1868  cmor_long_name='Downward Sea Ice Basal Salt Flux Area Integrated')
1869 
1870  handles%id_total_saltFluxIn = register_scalar_field('ocean_model', 'total_salt_Flux_In', &
1871  time, diag, long_name='Area integrated surface salt flux at surface from coupler', units='kg')
1872 
1873  handles%id_total_saltFluxAdded = register_scalar_field('ocean_model', 'total_salt_Flux_Added', &
1874  time, diag, long_name='Area integrated surface salt flux due to restoring or flux adjustment', units='kg')
1875 
1876 
1877 end subroutine register_forcing_type_diags
1878 
1879 !> Accumulate the forcing over time steps, taking input from a mechanical forcing type
1880 !! and a temporary forcing-flux type.
1881 subroutine forcing_accumulate(flux_tmp, forces, fluxes, G, wt2)
1882  type(forcing), intent(in) :: flux_tmp !< A temporary structure with current
1883  !!thermodynamic forcing fields
1884  type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
1885  type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged
1886  !! thermodynamic forcing fields
1887  type(ocean_grid_type), intent(inout) :: g !< The ocean's grid structure
1888  real, intent(out) :: wt2 !< The relative weight of the new fluxes
1889 
1890  ! This subroutine copies mechancal forcing from flux_tmp to fluxes and
1891  ! stores the time-weighted averages of the various buoyancy fluxes in fluxes,
1892  ! and increments the amount of time over which the buoyancy forcing should be
1893  ! applied, all via a call to fluxes accumulate.
1894 
1895  call fluxes_accumulate(flux_tmp, fluxes, g, wt2, forces)
1896 
1897 end subroutine forcing_accumulate
1898 
1899 !> Accumulate the thermodynamic fluxes over time steps
1900 subroutine fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces)
1901  type(forcing), intent(in) :: flux_tmp !< A temporary structure with current
1902  !! thermodynamic forcing fields
1903  type(forcing), intent(inout) :: fluxes !< A structure containing time-averaged
1904  !! thermodynamic forcing fields
1905  type(ocean_grid_type), intent(inout) :: g !< The ocean's grid structure
1906  real, intent(out) :: wt2 !< The relative weight of the new fluxes
1907  type(mech_forcing), optional, intent(in) :: forces !< A structure with the driving mechanical forces
1908 
1909  ! This subroutine copies mechancal forcing from flux_tmp to fluxes and
1910  ! stores the time-weighted averages of the various buoyancy fluxes in fluxes,
1911  ! and increments the amount of time over which the buoyancy forcing in fluxes should be
1912  ! applied based on the time interval stored in flux_tmp.
1913 
1914  real :: wt1
1915  integer :: i, j, is, ie, js, je, isq, ieq, jsq, jeq, i0, j0
1916  integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb, isr, ier, jsr, jer
1917  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
1918  isq = g%IscB ; ieq = g%IecB ; jsq = g%JscB ; jeq = g%JecB
1919  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
1920  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
1921 
1922 
1923  if (fluxes%dt_buoy_accum < 0) call mom_error(fatal, "fluxes_accumulate: "//&
1924  "fluxes must be initialzed before it can be augmented.")
1925 
1926  ! wt1 is the relative weight of the previous fluxes.
1927  wt1 = fluxes%dt_buoy_accum / (fluxes%dt_buoy_accum + flux_tmp%dt_buoy_accum)
1928  wt2 = 1.0 - wt1 ! = flux_tmp%dt_buoy_accum / (fluxes%dt_buoy_accum + flux_tmp%dt_buoy_accum)
1929  fluxes%dt_buoy_accum = fluxes%dt_buoy_accum + flux_tmp%dt_buoy_accum
1930 
1931  ! Copy over the pressure fields and accumulate averages of ustar, either from the forcing
1932  ! type or from the temporary fluxes type.
1933  if (present(forces)) then
1934  do j=js,je ; do i=is,ie
1935  fluxes%p_surf(i,j) = forces%p_surf(i,j)
1936  fluxes%p_surf_full(i,j) = forces%p_surf_full(i,j)
1937 
1938  fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*forces%ustar(i,j)
1939  enddo ; enddo
1940  else
1941  do j=js,je ; do i=is,ie
1942  fluxes%p_surf(i,j) = flux_tmp%p_surf(i,j)
1943  fluxes%p_surf_full(i,j) = flux_tmp%p_surf_full(i,j)
1944 
1945  fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*flux_tmp%ustar(i,j)
1946  enddo ; enddo
1947  endif
1948 
1949  ! Average the water, heat, and salt fluxes, and ustar.
1950  do j=js,je ; do i=is,ie
1951 !### Replace the expression for ustar_gustless with this one...
1952 ! fluxes%ustar_gustless(i,j) = wt1*fluxes%ustar_gustless(i,j) + wt2*flux_tmp%ustar_gustless(i,j)
1953  fluxes%ustar_gustless(i,j) = flux_tmp%ustar_gustless(i,j)
1954 
1955  fluxes%evap(i,j) = wt1*fluxes%evap(i,j) + wt2*flux_tmp%evap(i,j)
1956  fluxes%lprec(i,j) = wt1*fluxes%lprec(i,j) + wt2*flux_tmp%lprec(i,j)
1957  fluxes%fprec(i,j) = wt1*fluxes%fprec(i,j) + wt2*flux_tmp%fprec(i,j)
1958  fluxes%vprec(i,j) = wt1*fluxes%vprec(i,j) + wt2*flux_tmp%vprec(i,j)
1959  fluxes%lrunoff(i,j) = wt1*fluxes%lrunoff(i,j) + wt2*flux_tmp%lrunoff(i,j)
1960  fluxes%frunoff(i,j) = wt1*fluxes%frunoff(i,j) + wt2*flux_tmp%frunoff(i,j)
1961  fluxes%seaice_melt(i,j) = wt1*fluxes%seaice_melt(i,j) + wt2*flux_tmp%seaice_melt(i,j)
1962  fluxes%sw(i,j) = wt1*fluxes%sw(i,j) + wt2*flux_tmp%sw(i,j)
1963  fluxes%sw_vis_dir(i,j) = wt1*fluxes%sw_vis_dir(i,j) + wt2*flux_tmp%sw_vis_dir(i,j)
1964  fluxes%sw_vis_dif(i,j) = wt1*fluxes%sw_vis_dif(i,j) + wt2*flux_tmp%sw_vis_dif(i,j)
1965  fluxes%sw_nir_dir(i,j) = wt1*fluxes%sw_nir_dir(i,j) + wt2*flux_tmp%sw_nir_dir(i,j)
1966  fluxes%sw_nir_dif(i,j) = wt1*fluxes%sw_nir_dif(i,j) + wt2*flux_tmp%sw_nir_dif(i,j)
1967  fluxes%lw(i,j) = wt1*fluxes%lw(i,j) + wt2*flux_tmp%lw(i,j)
1968  fluxes%latent(i,j) = wt1*fluxes%latent(i,j) + wt2*flux_tmp%latent(i,j)
1969  fluxes%sens(i,j) = wt1*fluxes%sens(i,j) + wt2*flux_tmp%sens(i,j)
1970 
1971  fluxes%salt_flux(i,j) = wt1*fluxes%salt_flux(i,j) + wt2*flux_tmp%salt_flux(i,j)
1972  enddo ; enddo
1973  if (associated(fluxes%heat_added) .and. associated(flux_tmp%heat_added)) then
1974  do j=js,je ; do i=is,ie
1975  fluxes%heat_added(i,j) = wt1*fluxes%heat_added(i,j) + wt2*flux_tmp%heat_added(i,j)
1976  enddo ; enddo
1977  endif
1978  ! These might always be associated, in which case they can be combined?
1979  if (associated(fluxes%heat_content_cond) .and. associated(flux_tmp%heat_content_cond)) then
1980  do j=js,je ; do i=is,ie
1981  fluxes%heat_content_cond(i,j) = wt1*fluxes%heat_content_cond(i,j) + wt2*flux_tmp%heat_content_cond(i,j)
1982  enddo ; enddo
1983  endif
1984  if (associated(fluxes%heat_content_lprec) .and. associated(flux_tmp%heat_content_lprec)) then
1985  do j=js,je ; do i=is,ie
1986  fluxes%heat_content_lprec(i,j) = wt1*fluxes%heat_content_lprec(i,j) + wt2*flux_tmp%heat_content_lprec(i,j)
1987  enddo ; enddo
1988  endif
1989  if (associated(fluxes%heat_content_fprec) .and. associated(flux_tmp%heat_content_fprec)) then
1990  do j=js,je ; do i=is,ie
1991  fluxes%heat_content_fprec(i,j) = wt1*fluxes%heat_content_fprec(i,j) + wt2*flux_tmp%heat_content_fprec(i,j)
1992  enddo ; enddo
1993  endif
1994  if (associated(fluxes%heat_content_icemelt) .and. associated(flux_tmp%heat_content_icemelt)) then
1995  do j=js,je ; do i=is,ie
1996  fluxes%heat_content_icemelt(i,j) = wt1*fluxes%heat_content_icemelt(i,j) + wt2*flux_tmp%heat_content_icemelt(i,j)
1997  enddo ; enddo
1998  endif
1999  if (associated(fluxes%heat_content_vprec) .and. associated(flux_tmp%heat_content_vprec)) then
2000  do j=js,je ; do i=is,ie
2001  fluxes%heat_content_vprec(i,j) = wt1*fluxes%heat_content_vprec(i,j) + wt2*flux_tmp%heat_content_vprec(i,j)
2002  enddo ; enddo
2003  endif
2004  if (associated(fluxes%heat_content_lrunoff) .and. associated(flux_tmp%heat_content_lrunoff)) then
2005  do j=js,je ; do i=is,ie
2006  fluxes%heat_content_lrunoff(i,j) = wt1*fluxes%heat_content_lrunoff(i,j) + wt2*flux_tmp%heat_content_lrunoff(i,j)
2007  enddo ; enddo
2008  endif
2009  if (associated(fluxes%heat_content_frunoff) .and. associated(flux_tmp%heat_content_frunoff)) then
2010  do j=js,je ; do i=is,ie
2011  fluxes%heat_content_frunoff(i,j) = wt1*fluxes%heat_content_frunoff(i,j) + wt2*flux_tmp%heat_content_frunoff(i,j)
2012  enddo ; enddo
2013  endif
2014  if (associated(fluxes%heat_content_icemelt) .and. associated(flux_tmp%heat_content_icemelt)) then
2015  do j=js,je ; do i=is,ie
2016  fluxes%heat_content_icemelt(i,j) = wt1*fluxes%heat_content_icemelt(i,j) + wt2*flux_tmp%heat_content_icemelt(i,j)
2017  enddo ; enddo
2018  endif
2019 
2020  if (associated(fluxes%ustar_shelf) .and. associated(flux_tmp%ustar_shelf)) then
2021  do i=isd,ied ; do j=jsd,jed
2022  fluxes%ustar_shelf(i,j) = flux_tmp%ustar_shelf(i,j)
2023  enddo ; enddo
2024  endif
2025  if (associated(fluxes%iceshelf_melt) .and. associated(flux_tmp%iceshelf_melt)) then
2026  do i=isd,ied ; do j=jsd,jed
2027  fluxes%iceshelf_melt(i,j) = flux_tmp%iceshelf_melt(i,j)
2028  enddo ; enddo
2029  endif
2030  if (associated(fluxes%frac_shelf_h) .and. associated(flux_tmp%frac_shelf_h)) then
2031  do i=isd,ied ; do j=jsd,jed
2032  fluxes%frac_shelf_h(i,j) = flux_tmp%frac_shelf_h(i,j)
2033  enddo ; enddo
2034  endif
2035 
2036  if (coupler_type_initialized(fluxes%tr_fluxes) .and. &
2037  coupler_type_initialized(flux_tmp%tr_fluxes)) &
2038  call coupler_type_increment_data(flux_tmp%tr_fluxes, fluxes%tr_fluxes, &
2039  scale_factor=wt2, scale_prev=wt1)
2040 
2041 end subroutine fluxes_accumulate
2042 
2043 !> This subroutine copies the computational domains of common forcing fields
2044 !! from a mech_forcing type to a (thermodynamic) forcing type.
2045 subroutine copy_common_forcing_fields(forces, fluxes, G, skip_pres)
2046  type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
2047  type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields
2048  type(ocean_grid_type), intent(in) :: g !< grid type
2049  logical, optional, intent(in) :: skip_pres !< If present and true, do not copy pressure fields.
2050 
2051  real :: taux2, tauy2 ! Squared wind stress components [Pa2].
2052  logical :: do_pres
2053  integer :: i, j, is, ie, js, je
2054  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
2055 
2056  do_pres = .true. ; if (present(skip_pres)) do_pres = .not.skip_pres
2057 
2058  if (associated(forces%ustar) .and. associated(fluxes%ustar)) then
2059  do j=js,je ; do i=is,ie
2060  fluxes%ustar(i,j) = forces%ustar(i,j)
2061  enddo ; enddo
2062  endif
2063 
2064  if (do_pres) then
2065  if (associated(forces%p_surf) .and. associated(fluxes%p_surf)) then
2066  do j=js,je ; do i=is,ie
2067  fluxes%p_surf(i,j) = forces%p_surf(i,j)
2068  enddo ; enddo
2069  endif
2070 
2071  if (associated(forces%p_surf_full) .and. associated(fluxes%p_surf_full)) then
2072  do j=js,je ; do i=is,ie
2073  fluxes%p_surf_full(i,j) = forces%p_surf_full(i,j)
2074  enddo ; enddo
2075  endif
2076 
2077  if (associated(forces%p_surf_SSH, forces%p_surf_full)) then
2078  fluxes%p_surf_SSH => fluxes%p_surf_full
2079  elseif (associated(forces%p_surf_SSH, forces%p_surf)) then
2080  fluxes%p_surf_SSH => fluxes%p_surf
2081  endif
2082  endif
2083 
2084 end subroutine copy_common_forcing_fields
2085 
2086 !> This subroutine calculates certain derived forcing fields based on information
2087 !! from a mech_forcing type and stores them in a (thermodynamic) forcing type.
2088 subroutine set_derived_forcing_fields(forces, fluxes, G, US, Rho0)
2089  type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
2090  type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields
2091  type(ocean_grid_type), intent(in) :: g !< grid type
2092  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
2093  real, intent(in) :: rho0 !< A reference density of seawater [R ~> kg m-3],
2094  !! as used to calculate ustar.
2095 
2096  real :: taux2, tauy2 ! Squared wind stress components [R2 L2 Z2 T-4 ~> Pa2].
2097  real :: irho0 ! Inverse of the mean density rescaled to [Z L-1 R-1 ~> m3 kg-1]
2098  integer :: i, j, is, ie, js, je
2099  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
2100 
2101  irho0 = us%L_to_Z / rho0
2102 
2103  if (associated(forces%taux) .and. associated(forces%tauy) .and. &
2104  associated(fluxes%ustar_gustless)) then
2105  do j=js,je ; do i=is,ie
2106  taux2 = 0.0
2107  if ((g%mask2dCu(i-1,j) + g%mask2dCu(i,j)) > 0) &
2108  taux2 = (g%mask2dCu(i-1,j) * forces%taux(i-1,j)**2 + &
2109  g%mask2dCu(i,j) * forces%taux(i,j)**2) / &
2110  (g%mask2dCu(i-1,j) + g%mask2dCu(i,j))
2111  tauy2 = 0.0
2112  if ((g%mask2dCv(i,j-1) + g%mask2dCv(i,j)) > 0) &
2113  tauy2 = (g%mask2dCv(i,j-1) * forces%tauy(i,j-1)**2 + &
2114  g%mask2dCv(i,j) * forces%tauy(i,j)**2) / &
2115  (g%mask2dCv(i,j-1) + g%mask2dCv(i,j))
2116 
2117  fluxes%ustar_gustless(i,j) = sqrt(us%L_to_Z * sqrt(taux2 + tauy2) / rho0)
2118 !### For efficiency this could be changed to:
2119 ! fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) * Irho0)
2120  enddo ; enddo
2121  endif
2122 
2123 end subroutine set_derived_forcing_fields
2124 
2125 
2126 !> This subroutine determines the net mass source to the ocean from
2127 !! a (thermodynamic) forcing type and stores it in a mech_forcing type.
2128 subroutine set_net_mass_forcing(fluxes, forces, G, US)
2129  type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields
2130  type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces
2131  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
2132  type(ocean_grid_type), intent(in) :: g !< The ocean grid type
2133 
2134  if (associated(forces%net_mass_src)) &
2135  call get_net_mass_forcing(fluxes, g, us, forces%net_mass_src)
2136 
2137 end subroutine set_net_mass_forcing
2138 
2139 !> This subroutine calculates determines the net mass source to the ocean from
2140 !! a (thermodynamic) forcing type and stores it in a provided array.
2141 subroutine get_net_mass_forcing(fluxes, G, US, net_mass_src)
2142  type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields
2143  type(ocean_grid_type), intent(in) :: g !< The ocean grid type
2144  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
2145  real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_mass_src !< The net mass flux of water into the ocean
2146  !! [kg m-2 s-1].
2147 
2148  real :: rz_t_conversion ! A combination of scaling factors for mass fluxes [kg T m-2 s-1 R-1 Z-1 ~> 1]
2149  integer :: i, j, is, ie, js, je
2150  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
2151 
2152  rz_t_conversion = us%R_to_kg_m3*us%Z_to_m*us%s_to_T
2153 
2154  net_mass_src(:,:) = 0.0
2155  if (associated(fluxes%lprec)) then ; do j=js,je ; do i=is,ie
2156  net_mass_src(i,j) = net_mass_src(i,j) + rz_t_conversion*fluxes%lprec(i,j)
2157  enddo ; enddo ; endif
2158  if (associated(fluxes%fprec)) then ; do j=js,je ; do i=is,ie
2159  net_mass_src(i,j) = net_mass_src(i,j) + rz_t_conversion*fluxes%fprec(i,j)
2160  enddo ; enddo ; endif
2161  if (associated(fluxes%vprec)) then ; do j=js,je ; do i=is,ie
2162  net_mass_src(i,j) = net_mass_src(i,j) + rz_t_conversion*fluxes%vprec(i,j)
2163  enddo ; enddo ; endif
2164  if (associated(fluxes%lrunoff)) then ; do j=js,je ; do i=is,ie
2165  net_mass_src(i,j) = net_mass_src(i,j) + rz_t_conversion*fluxes%lrunoff(i,j)
2166  enddo ; enddo ; endif
2167  if (associated(fluxes%frunoff)) then ; do j=js,je ; do i=is,ie
2168  net_mass_src(i,j) = net_mass_src(i,j) + rz_t_conversion*fluxes%frunoff(i,j)
2169  enddo ; enddo ; endif
2170  if (associated(fluxes%evap)) then ; do j=js,je ; do i=is,ie
2171  net_mass_src(i,j) = net_mass_src(i,j) + rz_t_conversion*fluxes%evap(i,j)
2172  enddo ; enddo ; endif
2173  if (associated(fluxes%seaice_melt)) then ; do j=js,je ; do i=is,ie
2174  net_mass_src(i,j) = net_mass_src(i,j) + rz_t_conversion*fluxes%seaice_melt(i,j)
2175  enddo ; enddo ; endif
2176 
2177 end subroutine get_net_mass_forcing
2178 
2179 !> This subroutine copies the computational domains of common forcing fields
2180 !! from a mech_forcing type to a (thermodynamic) forcing type.
2181 subroutine copy_back_forcing_fields(fluxes, forces, G)
2182  type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields
2183  type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces
2184  type(ocean_grid_type), intent(in) :: g !< grid type
2185 
2186  real :: taux2, tauy2 ! Squared wind stress components [Pa2].
2187  integer :: i, j, is, ie, js, je
2188  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
2189 
2190  if (associated(forces%ustar) .and. associated(fluxes%ustar)) then
2191  do j=js,je ; do i=is,ie
2192  forces%ustar(i,j) = fluxes%ustar(i,j)
2193  enddo ; enddo
2194  endif
2195 
2196 end subroutine copy_back_forcing_fields
2197 
2198 !> Offer mechanical forcing fields for diagnostics for those
2199 !! fields registered as part of register_forcing_type_diags.
2200 subroutine mech_forcing_diags(forces, dt, G, time_end, diag, handles)
2201  type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces
2202  real, intent(in) :: dt !< time step for the forcing [s]
2203  type(ocean_grid_type), intent(in) :: g !< grid type
2204  type(time_type), intent(in) :: time_end !< The end time of the diagnostic interval.
2205  type(diag_ctrl), intent(inout) :: diag !< diagnostic type
2206  type(forcing_diags), intent(inout) :: handles !< diagnostic id for diag_manager
2207 
2208  integer :: i,j,is,ie,js,je
2209 
2210  call cpu_clock_begin(handles%id_clock_forcing)
2211 
2212  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
2213  call enable_averaging(dt, time_end, diag)
2214  ! if (query_averaging_enabled(diag)) then
2215 
2216  if ((handles%id_taux > 0) .and. associated(forces%taux)) &
2217  call post_data(handles%id_taux, forces%taux, diag)
2218 
2219  if ((handles%id_tauy > 0) .and. associated(forces%tauy)) &
2220  call post_data(handles%id_tauy, forces%tauy, diag)
2221 
2222  if ((handles%id_mass_berg > 0) .and. associated(forces%mass_berg)) &
2223  call post_data(handles%id_mass_berg, forces%mass_berg, diag)
2224 
2225  if ((handles%id_area_berg > 0) .and. associated(forces%area_berg)) &
2226  call post_data(handles%id_area_berg, forces%area_berg, diag)
2227 
2228  ! endif
2229 
2230  call disable_averaging(diag)
2231  call cpu_clock_end(handles%id_clock_forcing)
2232 end subroutine mech_forcing_diags
2233 
2234 
2235 !> Offer buoyancy forcing fields for diagnostics for those
2236 !! fields registered as part of register_forcing_type_diags.
2237 subroutine forcing_diagnostics(fluxes, sfc_state, G, US, time_end, diag, handles)
2238  type(forcing), intent(in) :: fluxes !< A structure containing thermodynamic forcing fields
2239  type(surface), intent(in) :: sfc_state !< A structure containing fields that
2240  !! describe the surface state of the ocean.
2241  type(ocean_grid_type), intent(in) :: g !< grid type
2242  type(unit_scale_type), intent(in) :: us !< A dimensional unit scaling type
2243  type(time_type), intent(in) :: time_end !< The end time of the diagnostic interval.
2244  type(diag_ctrl), intent(inout) :: diag !< diagnostic regulator
2245  type(forcing_diags), intent(inout) :: handles !< diagnostic ids
2246 
2247  ! local
2248  real, dimension(SZI_(G),SZJ_(G)) :: res
2249  real :: total_transport ! for diagnosing integrated boundary transport
2250  real :: ave_flux ! for diagnosing averaged boundary flux
2251  real :: c_p ! seawater heat capacity (J/(deg K * kg))
2252  real :: rz_t_conversion ! A combination of scaling factors for mass fluxes [kg T m-2 s-1 R-1 Z-1 ~> 1]
2253  real :: i_dt ! inverse time step [s-1]
2254  real :: ppt2mks ! conversion between ppt and mks
2255  integer :: i,j,is,ie,js,je
2256 
2257  call cpu_clock_begin(handles%id_clock_forcing)
2258 
2259  c_p = fluxes%C_p
2260  rz_t_conversion = us%R_to_kg_m3*us%Z_to_m*us%s_to_T
2261  i_dt = 1.0 / (us%T_to_s*fluxes%dt_buoy_accum)
2262  ppt2mks = 1e-3
2263  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec
2264 
2265  call enable_averages(fluxes%dt_buoy_accum, time_end, diag)
2266  ! if (query_averaging_enabled(diag)) then
2267 
2268  ! post the diagnostics for surface mass fluxes ==================================
2269 
2270  if (handles%id_prcme > 0 .or. handles%id_total_prcme > 0 .or. handles%id_prcme_ga > 0) then
2271  do j=js,je ; do i=is,ie
2272  res(i,j) = 0.0
2273  if (associated(fluxes%lprec)) res(i,j) = res(i,j) + rz_t_conversion*fluxes%lprec(i,j)
2274  if (associated(fluxes%fprec)) res(i,j) = res(i,j) + rz_t_conversion*fluxes%fprec(i,j)
2275  ! fluxes%cond is not needed because it is derived from %evap > 0
2276  if (associated(fluxes%evap)) res(i,j) = res(i,j) + rz_t_conversion*fluxes%evap(i,j)
2277  if (associated(fluxes%lrunoff)) res(i,j) = res(i,j) + rz_t_conversion*fluxes%lrunoff(i,j)
2278  if (associated(fluxes%frunoff)) res(i,j) = res(i,j) + rz_t_conversion*fluxes%frunoff(i,j)
2279  if (associated(fluxes%vprec)) res(i,j) = res(i,j) + rz_t_conversion*fluxes%vprec(i,j)
2280  if (associated(fluxes%seaice_melt)) res(i,j) = res(i,j) + rz_t_conversion*fluxes%seaice_melt(i,j)
2281  enddo ; enddo
2282  if (handles%id_prcme > 0) call post_data(handles%id_prcme, res, diag)
2283  if (handles%id_total_prcme > 0) then
2284  total_transport = global_area_integral(res, g)
2285  call post_data(handles%id_total_prcme, total_transport, diag)
2286  endif
2287  if (handles%id_prcme_ga > 0) then
2288  ave_flux = global_area_mean(res,g)
2289  call post_data(handles%id_prcme_ga, ave_flux, diag)
2290  endif
2291  endif
2292 
2293  if (handles%id_net_massout > 0 .or. handles%id_total_net_massout > 0) then
2294  do j=js,je ; do i=is,ie
2295  res(i,j) = 0.0
2296  if (associated(fluxes%lprec)) then
2297  if (fluxes%lprec(i,j) < 0.0) res(i,j) = res(i,j) + rz_t_conversion*fluxes%lprec(i,j)
2298  endif
2299  if (associated(fluxes%vprec)) then
2300  if (fluxes%vprec(i,j) < 0.0) res(i,j) = res(i,j) + rz_t_conversion*fluxes%vprec(i,j)
2301  endif
2302  if (associated(fluxes%evap)) then
2303  if (fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + rz_t_conversion*fluxes%evap(i,j)
2304  endif
2305  if (associated(fluxes%seaice_melt)) then
2306  if (fluxes%seaice_melt(i,j) < 0.0) &
2307  res(i,j) = res(i,j) + rz_t_conversion*fluxes%seaice_melt(i,j)
2308  endif
2309  enddo ; enddo
2310  if (handles%id_net_massout > 0) call post_data(handles%id_net_massout, res, diag)
2311  if (handles%id_total_net_massout > 0) then
2312  total_transport = global_area_integral(res,g)
2313  call post_data(handles%id_total_net_massout, total_transport, diag)
2314  endif
2315  endif
2316 
2317  if (handles%id_massout_flux > 0 .and. associated(fluxes%netMassOut)) &
2318  call post_data(handles%id_massout_flux,fluxes%netMassOut,diag)
2319 
2320  if (handles%id_net_massin > 0 .or. handles%id_total_net_massin > 0) then
2321  do j=js,je ; do i=is,ie
2322  res(i,j) = 0.0
2323 
2324  if (associated(fluxes%fprec)) &
2325  res(i,j) = res(i,j) + rz_t_conversion*fluxes%fprec(i,j)
2326  if (associated(fluxes%lrunoff)) &
2327  res(i,j) = res(i,j) + rz_t_conversion*fluxes%lrunoff(i,j)
2328  if (associated(fluxes%frunoff)) &
2329  res(i,j) = res(i,j) + rz_t_conversion*fluxes%frunoff(i,j)
2330 
2331  if (associated(fluxes%lprec)) then
2332  if (fluxes%lprec(i,j) > 0.0) res(i,j) = res(i,j) + rz_t_conversion*fluxes%lprec(i,j)
2333  endif
2334  if (associated(fluxes%vprec)) then
2335  if (fluxes%vprec(i,j) > 0.0) res(i,j) = res(i,j) + rz_t_conversion*fluxes%vprec(i,j)
2336  endif
2337  ! fluxes%cond is not needed because it is derived from %evap > 0
2338  if (associated(fluxes%evap)) then
2339  if (fluxes%evap(i,j) > 0.0) res(i,j) = res(i,j) + rz_t_conversion*fluxes%evap(i,j)
2340  endif
2341  if (associated(fluxes%seaice_melt)) then
2342  if (fluxes%seaice_melt(i,j) > 0.0) &
2343  res(i,j) = res(i,j) + rz_t_conversion*fluxes%seaice_melt(i,j)
2344  endif
2345  enddo ; enddo
2346  if (handles%id_net_massin > 0) call post_data(handles%id_net_massin, res, diag)
2347  if (handles%id_total_net_massin > 0) then
2348  total_transport = global_area_integral(res,g)
2349  call post_data(handles%id_total_net_massin, total_transport, diag)
2350  endif
2351  endif
2352 
2353  if (handles%id_massin_flux > 0 .and. associated(fluxes%netMassIn)) &
2354  call post_data(handles%id_massin_flux,fluxes%netMassIn,diag)
2355 
2356  if ((handles%id_evap > 0) .and. associated(fluxes%evap)) &
2357  call post_data(handles%id_evap, fluxes%evap, diag)
2358  if ((handles%id_total_evap > 0) .and. associated(fluxes%evap)) then
2359  total_transport = global_area_integral(fluxes%evap, g, scale=rz_t_conversion)
2360  call post_data(handles%id_total_evap, total_transport, diag)
2361  endif
2362  if ((handles%id_evap_ga > 0) .and. associated(fluxes%evap)) then
2363  ave_flux = global_area_mean(fluxes%evap, g, scale=rz_t_conversion)
2364  call post_data(handles%id_evap_ga, ave_flux, diag)
2365  endif
2366 
2367  if (associated(fluxes%lprec) .and. associated(fluxes%fprec)) then
2368  do j=js,je ; do i=is,ie
2369  res(i,j) = rz_t_conversion* (fluxes%lprec(i,j) + fluxes%fprec(i,j))
2370  enddo ; enddo
2371  if (handles%id_precip > 0) call post_data(handles%id_precip, res, diag)
2372  if (handles%id_total_precip > 0) then
2373  total_transport = global_area_integral(res,g)
2374  call post_data(handles%id_total_precip, total_transport, diag)
2375  endif
2376  if (handles%id_precip_ga > 0) then
2377  ave_flux = global_area_mean(res,g)
2378  call post_data(handles%id_precip_ga, ave_flux, diag)
2379  endif
2380  endif
2381 
2382  if (associated(fluxes%lprec)) then
2383  if (handles%id_lprec > 0) call post_data(handles%id_lprec, fluxes%lprec, diag)
2384  if (handles%id_total_lprec > 0) then
2385  total_transport = global_area_integral(fluxes%lprec, g, scale=rz_t_conversion)
2386  call post_data(handles%id_total_lprec, total_transport, diag)
2387  endif
2388  if (handles%id_lprec_ga > 0) then
2389  ave_flux = global_area_mean(fluxes%lprec, g, scale=rz_t_conversion)
2390  call post_data(handles%id_lprec_ga, ave_flux, diag)
2391  endif
2392  endif
2393 
2394  if (associated(fluxes%fprec)) then
2395  if (handles%id_fprec > 0) call post_data(handles%id_fprec, fluxes%fprec, diag)
2396  if (handles%id_total_fprec > 0) then
2397  total_transport = global_area_integral(fluxes%fprec ,g, scale=rz_t_conversion)
2398  call post_data(handles%id_total_fprec, total_transport, diag)
2399  endif
2400  if (handles%id_fprec_ga > 0) then
2401  ave_flux = global_area_mean(fluxes%fprec, g, scale=rz_t_conversion)
2402  call post_data(handles%id_fprec_ga, ave_flux, diag)
2403  endif
2404  endif
2405 
2406  if (associated(fluxes%vprec)) then
2407  if (handles%id_vprec > 0) call post_data(handles%id_vprec, fluxes%vprec, diag)
2408  if (handles%id_total_vprec > 0) then
2409  total_transport = global_area_integral(fluxes%vprec, g, scale=rz_t_conversion)
2410  call post_data(handles%id_total_vprec, total_transport, diag)
2411  endif
2412  if (handles%id_vprec_ga > 0) then
2413  ave_flux = global_area_mean(fluxes%vprec, g, scale=rz_t_conversion)
2414  call post_data(handles%id_vprec_ga, ave_flux, diag)
2415  endif
2416  endif
2417 
2418  if (associated(fluxes%lrunoff)) then
2419  if (handles%id_lrunoff > 0) call post_data(handles%id_lrunoff, fluxes%lrunoff, diag)
2420  if (handles%id_total_lrunoff > 0) then
2421  total_transport = global_area_integral(fluxes%lrunoff, g, scale=rz_t_conversion)
2422  call post_data(handles%id_total_lrunoff, total_transport, diag)
2423  endif
2424  endif
2425 
2426  if (associated(fluxes%frunoff)) then
2427  if (handles%id_frunoff > 0) call post_data(handles%id_frunoff, fluxes%frunoff, diag)
2428  if (handles%id_total_frunoff > 0) then
2429  total_transport = global_area_integral(fluxes%frunoff, g, scale=rz_t_conversion)
2430  call post_data(handles%id_total_frunoff, total_transport, diag)
2431  endif
2432  endif
2433 
2434  if (associated(fluxes%seaice_melt)) then
2435  if (handles%id_seaice_melt > 0) call post_data(handles%id_seaice_melt, fluxes%seaice_melt, diag)
2436  if (handles%id_total_seaice_melt > 0) then
2437  total_transport = global_area_integral(fluxes%seaice_melt, g, scale=rz_t_conversion)
2438  call post_data(handles%id_total_seaice_melt, total_transport, diag)
2439  endif
2440  endif
2441 
2442  ! post diagnostics for boundary heat fluxes ====================================
2443 
2444  if ((handles%id_heat_content_lrunoff > 0) .and. associated(fluxes%heat_content_lrunoff)) &
2445  call post_data(handles%id_heat_content_lrunoff, fluxes%heat_content_lrunoff, diag)
2446  if ((handles%id_total_heat_content_lrunoff > 0) .and. associated(fluxes%heat_content_lrunoff)) then
2447  total_transport = global_area_integral(fluxes%heat_content_lrunoff, g, scale=rz_t_conversion)
2448  call post_data(handles%id_total_heat_content_lrunoff, total_transport, diag)
2449  endif
2450 
2451  if ((handles%id_heat_content_frunoff > 0) .and. associated(fluxes%heat_content_frunoff)) &
2452  call post_data(handles%id_heat_content_frunoff, fluxes%heat_content_frunoff, diag)
2453  if ((handles%id_total_heat_content_frunoff > 0) .and. associated(fluxes%heat_content_frunoff)) then
2454  total_transport = global_area_integral(fluxes%heat_content_frunoff, g, scale=rz_t_conversion)
2455  call post_data(handles%id_total_heat_content_frunoff, total_transport, diag)
2456  endif
2457 
2458  if ((handles%id_heat_content_lprec > 0) .and. associated(fluxes%heat_content_lprec)) &
2459  call post_data(handles%id_heat_content_lprec, fluxes%heat_content_lprec, diag)
2460  if ((handles%id_total_heat_content_lprec > 0) .and. associated(fluxes%heat_content_lprec)) then
2461  total_transport = global_area_integral(fluxes%heat_content_lprec, g, scale=rz_t_conversion)
2462  call post_data(handles%id_total_heat_content_lprec, total_transport, diag)
2463  endif
2464 
2465  if ((handles%id_heat_content_fprec > 0) .and. associated(fluxes%heat_content_fprec)) &
2466  call post_data(handles%id_heat_content_fprec, fluxes%heat_content_fprec, diag)
2467  if ((handles%id_total_heat_content_fprec > 0) .and. associated(fluxes%heat_content_fprec)) then
2468  total_transport = global_area_integral(fluxes%heat_content_fprec, g, scale=rz_t_conversion)
2469  call post_data(handles%id_total_heat_content_fprec, total_transport, diag)
2470  endif
2471 
2472  if ((handles%id_heat_content_icemelt > 0) .and. associated(fluxes%heat_content_icemelt)) &
2473  call post_data(handles%id_heat_content_icemelt, fluxes%heat_content_icemelt, diag)
2474  if ((handles%id_total_heat_content_icemelt > 0) .and. associated(fluxes%heat_content_icemelt)) then
2475  total_transport = global_area_integral(fluxes%heat_content_icemelt, g, scale=rz_t_conversion)
2476  call post_data(handles%id_total_heat_content_icemelt, total_transport, diag)
2477  endif
2478 
2479  if ((handles%id_heat_content_vprec > 0) .and. associated(fluxes%heat_content_vprec)) &
2480  call post_data(handles%id_heat_content_vprec, fluxes%heat_content_vprec, diag)
2481  if ((handles%id_total_heat_content_vprec > 0) .and. associated(fluxes%heat_content_vprec)) then
2482  total_transport = global_area_integral(fluxes%heat_content_vprec, g, scale=rz_t_conversion)
2483  call post_data(handles%id_total_heat_content_vprec, total_transport, diag)
2484  endif
2485 
2486  if ((handles%id_heat_content_cond > 0) .and. associated(fluxes%heat_content_cond)) &
2487  call post_data(handles%id_heat_content_cond, fluxes%heat_content_cond, diag)
2488  if ((handles%id_total_heat_content_cond > 0) .and. associated(fluxes%heat_content_cond)) then
2489  total_transport = global_area_integral(fluxes%heat_content_cond, g, scale=rz_t_conversion)
2490  call post_data(handles%id_total_heat_content_cond, total_transport, diag)
2491  endif
2492 
2493  if ((handles%id_heat_content_massout > 0) .and. associated(fluxes%heat_content_massout)) &
2494  call post_data(handles%id_heat_content_massout, fluxes%heat_content_massout, diag)
2495  if ((handles%id_total_heat_content_massout > 0) .and. associated(fluxes%heat_content_massout)) then
2496  total_transport = global_area_integral(fluxes%heat_content_massout,g, scale=rz_t_conversion)
2497  call post_data(handles%id_total_heat_content_massout, total_transport, diag)
2498  endif
2499 
2500  if ((handles%id_heat_content_massin > 0) .and. associated(fluxes%heat_content_massin)) &
2501  call post_data(handles%id_heat_content_massin, fluxes%heat_content_massin, diag)
2502  if ((handles%id_total_heat_content_massin > 0) .and. associated(fluxes%heat_content_massin)) then
2503  total_transport = global_area_integral(fluxes%heat_content_massin, g, scale=rz_t_conversion)
2504  call post_data(handles%id_total_heat_content_massin, total_transport, diag)
2505  endif
2506 
2507  if (handles%id_net_heat_coupler > 0 .or. handles%id_total_net_heat_coupler > 0 .or. &
2508  handles%id_net_heat_coupler_ga > 0. ) then
2509  do j=js,je ; do i=is,ie
2510  res(i,j) = 0.0
2511  if (associated(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j)
2512  if (associated(fluxes%latent)) res(i,j) = res(i,j) + fluxes%latent(i,j)
2513  if (associated(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j)
2514  if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j)
2515  if (associated(fluxes%seaice_melt_heat)) res(i,j) = res(i,j) + fluxes%seaice_melt_heat(i,j)
2516  enddo ; enddo
2517  if (handles%id_net_heat_coupler > 0) call post_data(handles%id_net_heat_coupler, res, diag)
2518  if (handles%id_total_net_heat_coupler > 0) then
2519  total_transport = global_area_integral(res,g)
2520  call post_data(handles%id_total_net_heat_coupler, total_transport, diag)
2521  endif
2522  if (handles%id_net_heat_coupler_ga > 0) then
2523  ave_flux = global_area_mean(res,g)
2524  call post_data(handles%id_net_heat_coupler_ga, ave_flux, diag)
2525  endif
2526  endif
2527 
2528  if (handles%id_net_heat_surface > 0 .or. handles%id_total_net_heat_surface > 0 .or. &
2529  handles%id_net_heat_surface_ga > 0. ) then
2530  do j=js,je ; do i=is,ie
2531  res(i,j) = 0.0
2532  if (associated(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j)
2533  if (associated(fluxes%latent)) res(i,j) = res(i,j) + fluxes%latent(i,j)
2534  if (associated(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j)
2535  if (associated(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j)
2536  if (associated(fluxes%seaice_melt_heat)) res(i,j) = res(i,j) + fluxes%seaice_melt_heat(i,j)
2537  if (associated(sfc_state%frazil)) res(i,j) = res(i,j) + sfc_state%frazil(i,j) * i_dt
2538  !if (associated(sfc_state%TempXpme)) then
2539  ! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * fluxes%C_p * I_dt
2540  !else
2541  if (associated(fluxes%heat_content_lrunoff)) &
2542  res(i,j) = res(i,j) + rz_t_conversion*fluxes%heat_content_lrunoff(i,j)
2543  if (associated(fluxes%heat_content_frunoff)) &
2544  res(i,j) = res(i,j) + rz_t_conversion*fluxes%heat_content_frunoff(i,j)
2545  if (associated(fluxes%heat_content_lprec)) &
2546  res(i,j) = res(i,j) + rz_t_conversion*fluxes%heat_content_lprec(i,j)
2547  if (associated(fluxes%heat_content_fprec)) &
2548  res(i,j) = res(i,j) + rz_t_conversion*fluxes%heat_content_fprec(i,j)
2549  if (associated(fluxes%heat_content_icemelt)) &
2550  res(i,j) = res(i,j) + rz_t_conversion*fluxes%heat_content_icemelt(i,j)
2551  if (associated(fluxes%heat_content_vprec)) &
2552  res(i,j) = res(i,j) + rz_t_conversion*fluxes%heat_content_vprec(i,j)
2553  if (associated(fluxes%heat_content_cond)) &
2554  res(i,j) = res(i,j) + rz_t_conversion*fluxes%heat_content_cond(i,j)
2555  if (associated(fluxes%heat_content_massout)) &
2556  res(i,j) = res(i,j) + rz_t_conversion*fluxes%heat_content_massout(i,j)
2557  !endif
2558  if (associated(fluxes%heat_added)) res(i,j) = res(i,j) + fluxes%heat_added(i,j)
2559  enddo ; enddo
2560  if (handles%id_net_heat_surface > 0) call post_data(handles%id_net_heat_surface, res, diag)
2561 
2562  if (handles%id_total_net_heat_surface > 0) then
2563  total_transport = global_area_integral(res, g)
2564  call post_data(handles%id_total_net_heat_surface, total_transport, diag)
2565  endif
2566  if (handles%id_net_heat_surface_ga > 0) then
2567  ave_flux = global_area_mean(res, g)
2568  call post_data(handles%id_net_heat_surface_ga, ave_flux, diag)
2569  endif
2570  endif
2571 
2572  if (handles%id_heat_content_surfwater > 0 .or. handles%id_total_heat_content_surfwater > 0) then
2573  do j=js,je ; do i=is,ie
2574  res(i,j) = 0.0
2575  ! if (associated(sfc_state%TempXpme)) then
2576  ! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * fluxes%C_p * I_dt
2577  ! else
2578  if (associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j)
2579  if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j)
2580  if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j)
2581  if (associated(fluxes%heat_content_icemelt)) res(i,j) = res(i,j) + fluxes%heat_content_icemelt(i,j)
2582  if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j)
2583  if (associated(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j)
2584  if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j)
2585  if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j)
2586  ! endif
2587  enddo ; enddo
2588  if (handles%id_heat_content_surfwater > 0) call post_data(handles%id_heat_content_surfwater, res, diag)
2589  if (handles%id_total_heat_content_surfwater > 0) then
2590  total_transport = global_area_integral(res, g, scale=rz_t_conversion)
2591  call post_data(handles%id_total_heat_content_surfwater, total_transport, diag)
2592  endif
2593  endif
2594 
2595  ! for OMIP, hfrunoffds = heat content of liquid plus frozen runoff
2596  if (handles%id_hfrunoffds > 0) then
2597  do j=js,je ; do i=is,ie
2598  res(i,j) = 0.0
2599  if (associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j)
2600  if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j)
2601  enddo ; enddo
2602  call post_data(handles%id_hfrunoffds, res, diag)
2603  endif
2604 
2605  ! for OMIP, hfrainds = heat content of lprec + fprec + cond
2606  if (handles%id_hfrainds > 0) then
2607  do j=js,je ; do i=is,ie
2608  res(i,j) = 0.0
2609  if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j)
2610  if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j)
2611  if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j)
2612  enddo ; enddo
2613  call post_data(handles%id_hfrainds, res, diag)
2614  endif
2615 
2616  if ((handles%id_LwLatSens > 0) .and. associated(fluxes%lw) .and. &
2617  associated(fluxes%latent) .and. associated(fluxes%sens)) then
2618  do j=js,je ; do i=is,ie
2619  res(i,j) = (fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)
2620  enddo ; enddo
2621  call post_data(handles%id_LwLatSens, res, diag)
2622  endif
2623 
2624  if ((handles%id_total_LwLatSens > 0) .and. associated(fluxes%lw) .and. &
2625  associated(fluxes%latent) .and. associated(fluxes%sens)) then
2626  do j=js,je ; do i=is,ie
2627  res(i,j) = (fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)
2628  enddo ; enddo
2629  total_transport = global_area_integral(res,g)
2630  call post_data(handles%id_total_LwLatSens, total_transport, diag)
2631  endif
2632 
2633  if ((handles%id_LwLatSens_ga > 0) .and. associated(fluxes%lw) .and. &
2634  associated(fluxes%latent) .and. associated(fluxes%sens)) then
2635  do j=js,je ; do i=is,ie
2636  res(i,j) = (fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)
2637  enddo ; enddo
2638  ave_flux = global_area_mean(res,g)
2639  call post_data(handles%id_LwLatSens_ga, ave_flux, diag)
2640  endif
2641 
2642  if ((handles%id_sw > 0) .and. associated(fluxes%sw)) then
2643  call post_data(handles%id_sw, fluxes%sw, diag)
2644  endif
2645  if ((handles%id_sw_vis > 0) .and. associated(fluxes%sw_vis_dir) .and. &
2646  associated(fluxes%sw_vis_dif)) then
2647  call post_data(handles%id_sw_vis, fluxes%sw_vis_dir+fluxes%sw_vis_dif, diag)
2648  endif
2649  if ((handles%id_sw_nir > 0) .and. associated(fluxes%sw_nir_dir) .and. &
2650  associated(fluxes%sw_nir_dif)) then
2651  call post_data(handles%id_sw_nir, fluxes%sw_nir_dir+fluxes%sw_nir_dif, diag)
2652  endif
2653  if ((handles%id_total_sw > 0) .and. associated(fluxes%sw)) then
2654  total_transport = global_area_integral(fluxes%sw,g)
2655  call post_data(handles%id_total_sw, total_transport, diag)
2656  endif
2657  if ((handles%id_sw_ga > 0) .and. associated(fluxes%sw)) then
2658  ave_flux = global_area_mean(fluxes%sw,g)
2659  call post_data(handles%id_sw_ga, ave_flux, diag)
2660  endif
2661 
2662  if ((handles%id_lw > 0) .and. associated(fluxes%lw)) then
2663  call post_data(handles%id_lw, fluxes%lw, diag)
2664  endif
2665  if ((handles%id_total_lw > 0) .and. associated(fluxes%lw)) then
2666  total_transport = global_area_integral(fluxes%lw,g)
2667  call post_data(handles%id_total_lw, total_transport, diag)
2668  endif
2669  if ((handles%id_lw_ga > 0) .and. associated(fluxes%lw)) then
2670  ave_flux = global_area_mean(fluxes%lw,g)
2671  call post_data(handles%id_lw_ga, ave_flux, diag)
2672  endif
2673 
2674  if ((handles%id_lat > 0) .and. associated(fluxes%latent)) then
2675  call post_data(handles%id_lat, fluxes%latent, diag)
2676  endif
2677  if ((handles%id_total_lat > 0) .and. associated(fluxes%latent)) then
2678  total_transport = global_area_integral(fluxes%latent,g)
2679  call post_data(handles%id_total_lat, total_transport, diag)
2680  endif
2681  if ((handles%id_lat_ga > 0) .and. associated(fluxes%latent)) then
2682  ave_flux = global_area_mean(fluxes%latent,g)
2683  call post_data(handles%id_lat_ga, ave_flux, diag)
2684  endif
2685 
2686  if ((handles%id_lat_evap > 0) .and. associated(fluxes%latent_evap_diag)) then
2687  call post_data(handles%id_lat_evap, fluxes%latent_evap_diag, diag)
2688  endif
2689  if ((handles%id_total_lat_evap > 0) .and. associated(fluxes%latent_evap_diag)) then
2690  total_transport = global_area_integral(fluxes%latent_evap_diag,g)
2691  call post_data(handles%id_total_lat_evap, total_transport, diag)
2692  endif
2693 
2694  if ((handles%id_lat_fprec > 0) .and. associated(fluxes%latent_fprec_diag)) then
2695  call post_data(handles%id_lat_fprec, fluxes%latent_fprec_diag, diag)
2696  endif
2697  if ((handles%id_total_lat_fprec > 0) .and. associated(fluxes%latent_fprec_diag)) then
2698  total_transport = global_area_integral(fluxes%latent_fprec_diag,g)
2699  call post_data(handles%id_total_lat_fprec, total_transport, diag)
2700  endif
2701 
2702  if ((handles%id_lat_frunoff > 0) .and. associated(fluxes%latent_frunoff_diag)) then
2703  call post_data(handles%id_lat_frunoff, fluxes%latent_frunoff_diag, diag)
2704  endif
2705  if (handles%id_total_lat_frunoff > 0 .and. associated(fluxes%latent_frunoff_diag)) then
2706  total_transport = global_area_integral(fluxes%latent_frunoff_diag,g)
2707  call post_data(handles%id_total_lat_frunoff, total_transport, diag)
2708  endif
2709 
2710  if ((handles%id_sens > 0) .and. associated(fluxes%sens)) then
2711  call post_data(handles%id_sens, fluxes%sens, diag)
2712  endif
2713 
2714  if ((handles%id_seaice_melt_heat > 0) .and. associated(fluxes%seaice_melt_heat)) then
2715  call post_data(handles%id_seaice_melt_heat, fluxes%seaice_melt_heat, diag)
2716  endif
2717 
2718  if ((handles%id_total_seaice_melt_heat > 0) .and. associated(fluxes%seaice_melt_heat)) then
2719  total_transport = global_area_integral(fluxes%seaice_melt_heat,g)
2720  call post_data(handles%id_total_seaice_melt_heat, total_transport, diag)
2721  endif
2722 
2723  if ((handles%id_total_sens > 0) .and. associated(fluxes%sens)) then
2724  total_transport = global_area_integral(fluxes%sens,g)
2725  call post_data(handles%id_total_sens, total_transport, diag)
2726  endif
2727  if ((handles%id_sens_ga > 0) .and. associated(fluxes%sens)) then
2728  ave_flux = global_area_mean(fluxes%sens,g)
2729  call post_data(handles%id_sens_ga, ave_flux, diag)
2730  endif
2731 
2732  if ((handles%id_heat_added > 0) .and. associated(fluxes%heat_added)) then
2733  call post_data(handles%id_heat_added, fluxes%heat_added, diag)
2734  endif
2735 
2736  if ((handles%id_total_heat_added > 0) .and. associated(fluxes%heat_added)) then
2737  total_transport = global_area_integral(fluxes%heat_added,g)
2738  call post_data(handles%id_total_heat_added, total_transport, diag)
2739  endif
2740 
2741 
2742  ! post the diagnostics for boundary salt fluxes ==========================
2743 
2744  if ((handles%id_saltflux > 0) .and. associated(fluxes%salt_flux)) &
2745  call post_data(handles%id_saltflux, fluxes%salt_flux, diag)
2746  if ((handles%id_total_saltflux > 0) .and. associated(fluxes%salt_flux)) then
2747  total_transport = ppt2mks*global_area_integral(fluxes%salt_flux, g, scale=rz_t_conversion)
2748  call post_data(handles%id_total_saltflux, total_transport, diag)
2749  endif
2750 
2751  if ((handles%id_saltFluxAdded > 0) .and. associated(fluxes%salt_flux_added)) &
2752  call post_data(handles%id_saltFluxAdded, fluxes%salt_flux_added, diag)
2753  if ((handles%id_total_saltFluxAdded > 0) .and. associated(fluxes%salt_flux_added)) then
2754  total_transport = ppt2mks*global_area_integral(fluxes%salt_flux_added, g, scale=rz_t_conversion)
2755  call post_data(handles%id_total_saltFluxAdded, total_transport, diag)
2756  endif
2757 
2758  if (handles%id_saltFluxIn > 0 .and. associated(fluxes%salt_flux_in)) &
2759  call post_data(handles%id_saltFluxIn, fluxes%salt_flux_in, diag)
2760  if ((handles%id_total_saltFluxIn > 0) .and. associated(fluxes%salt_flux_in)) then
2761  total_transport = ppt2mks*global_area_integral(fluxes%salt_flux_in, g, scale=rz_t_conversion)
2762  call post_data(handles%id_total_saltFluxIn, total_transport, diag)
2763  endif
2764 
2765  if (handles%id_saltFluxGlobalAdj > 0) &
2766  call post_data(handles%id_saltFluxGlobalAdj, fluxes%saltFluxGlobalAdj, diag)
2767  if (handles%id_vPrecGlobalAdj > 0) &
2768  call post_data(handles%id_vPrecGlobalAdj, fluxes%vPrecGlobalAdj, diag)
2769  if (handles%id_netFWGlobalAdj > 0) &
2770  call post_data(handles%id_netFWGlobalAdj, fluxes%netFWGlobalAdj, diag)
2771  if (handles%id_saltFluxGlobalScl > 0) &
2772  call post_data(handles%id_saltFluxGlobalScl, fluxes%saltFluxGlobalScl, diag)
2773  if (handles%id_vPrecGlobalScl > 0) &
2774  call post_data(handles%id_vPrecGlobalScl, fluxes%vPrecGlobalScl, diag)
2775  if (handles%id_netFWGlobalScl > 0) &
2776  call post_data(handles%id_netFWGlobalScl, fluxes%netFWGlobalScl, diag)
2777 
2778 
2779  ! remaining boundary terms ==================================================
2780 
2781  if ((handles%id_psurf > 0) .and. associated(fluxes%p_surf)) &
2782  call post_data(handles%id_psurf, fluxes%p_surf, diag)
2783 
2784  if ((handles%id_TKE_tidal > 0) .and. associated(fluxes%TKE_tidal)) &
2785  call post_data(handles%id_TKE_tidal, fluxes%TKE_tidal, diag)
2786 
2787  if ((handles%id_buoy > 0) .and. associated(fluxes%buoy)) &
2788  call post_data(handles%id_buoy, fluxes%buoy, diag)
2789 
2790  if ((handles%id_ustar > 0) .and. associated(fluxes%ustar)) &
2791  call post_data(handles%id_ustar, fluxes%ustar, diag)
2792 
2793  if ((handles%id_ustar_berg > 0) .and. associated(fluxes%ustar_berg)) &
2794  call post_data(handles%id_ustar_berg, fluxes%ustar_berg, diag)
2795 
2796  if ((handles%id_frac_ice_cover > 0) .and. associated(fluxes%frac_shelf_h)) &
2797  call post_data(handles%id_frac_ice_cover, fluxes%frac_shelf_h, diag)
2798 
2799  if ((handles%id_ustar_ice_cover > 0) .and. associated(fluxes%ustar_shelf)) &
2800  call post_data(handles%id_ustar_ice_cover, fluxes%ustar_shelf, diag)
2801 
2802  ! endif ! query_averaging_enabled
2803  call disable_averaging(diag)
2804 
2805  call cpu_clock_end(handles%id_clock_forcing)
2806 end subroutine forcing_diagnostics
2807 
2808 
2809 !> Conditionally allocate fields within the forcing type
2810 subroutine allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, iceberg, salt)
2811  type(ocean_grid_type), intent(in) :: g !< Ocean grid structure
2812  type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields
2813  logical, optional, intent(in) :: water !< If present and true, allocate water fluxes
2814  logical, optional, intent(in) :: heat !< If present and true, allocate heat fluxes
2815  logical, optional, intent(in) :: ustar !< If present and true, allocate ustar and related fields
2816  logical, optional, intent(in) :: press !< If present and true, allocate p_surf and related fields
2817  logical, optional, intent(in) :: shelf !< If present and true, allocate fluxes for ice-shelf
2818  logical, optional, intent(in) :: iceberg !< If present and true, allocate fluxes for icebergs
2819  logical, optional, intent(in) :: salt !< If present and true, allocate salt fluxes
2820 
2821  ! Local variables
2822  integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb
2823  logical :: heat_water
2824 
2825  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
2826  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
2827 
2828  call myalloc(fluxes%ustar,isd,ied,jsd,jed, ustar)
2829  call myalloc(fluxes%ustar_gustless,isd,ied,jsd,jed, ustar)
2830 
2831  call myalloc(fluxes%evap,isd,ied,jsd,jed, water)
2832  call myalloc(fluxes%lprec,isd,ied,jsd,jed, water)
2833  call myalloc(fluxes%fprec,isd,ied,jsd,jed, water)
2834  call myalloc(fluxes%vprec,isd,ied,jsd,jed, water)
2835  call myalloc(fluxes%lrunoff,isd,ied,jsd,jed, water)
2836  call myalloc(fluxes%frunoff,isd,ied,jsd,jed, water)
2837  call myalloc(fluxes%seaice_melt,isd,ied,jsd,jed, water)
2838  call myalloc(fluxes%netMassOut,isd,ied,jsd,jed, water)
2839  call myalloc(fluxes%netMassIn,isd,ied,jsd,jed, water)
2840  call myalloc(fluxes%netSalt,isd,ied,jsd,jed, water)
2841  call myalloc(fluxes%seaice_melt_heat,isd,ied,jsd,jed, heat)
2842  call myalloc(fluxes%sw,isd,ied,jsd,jed, heat)
2843  call myalloc(fluxes%lw,isd,ied,jsd,jed, heat)
2844  call myalloc(fluxes%latent,isd,ied,jsd,jed, heat)
2845  call myalloc(fluxes%sens,isd,ied,jsd,jed, heat)
2846  call myalloc(fluxes%latent_evap_diag,isd,ied,jsd,jed, heat)
2847  call myalloc(fluxes%latent_fprec_diag,isd,ied,jsd,jed, heat)
2848  call myalloc(fluxes%latent_frunoff_diag,isd,ied,jsd,jed, heat)
2849 
2850  call myalloc(fluxes%salt_flux,isd,ied,jsd,jed, salt)
2851 
2852  if (present(heat) .and. present(water)) then ; if (heat .and. water) then
2853  call myalloc(fluxes%heat_content_cond,isd,ied,jsd,jed, .true.)
2854  call myalloc(fluxes%heat_content_icemelt,isd,ied,jsd,jed, .true.)
2855  call myalloc(fluxes%heat_content_lprec,isd,ied,jsd,jed, .true.)
2856  call myalloc(fluxes%heat_content_fprec,isd,ied,jsd,jed, .true.)
2857  call myalloc(fluxes%heat_content_vprec,isd,ied,jsd,jed, .true.)
2858  call myalloc(fluxes%heat_content_lrunoff,isd,ied,jsd,jed, .true.)
2859  call myalloc(fluxes%heat_content_frunoff,isd,ied,jsd,jed, .true.)
2860  call myalloc(fluxes%heat_content_massout,isd,ied,jsd,jed, .true.)
2861  call myalloc(fluxes%heat_content_massin,isd,ied,jsd,jed, .true.)
2862  endif ; endif
2863 
2864  call myalloc(fluxes%p_surf,isd,ied,jsd,jed, press)
2865 
2866  call myalloc(fluxes%frac_shelf_h,isd,ied,jsd,jed, shelf)
2867  call myalloc(fluxes%ustar_shelf,isd,ied,jsd,jed, shelf)
2868  call myalloc(fluxes%iceshelf_melt,isd,ied,jsd,jed, shelf)
2869 
2870  !These fields should only on allocated when iceberg area is being passed through the coupler.
2871  call myalloc(fluxes%ustar_berg,isd,ied,jsd,jed, iceberg)
2872  call myalloc(fluxes%area_berg,isd,ied,jsd,jed, iceberg)
2873  call myalloc(fluxes%mass_berg,isd,ied,jsd,jed, iceberg)
2874 
2875 end subroutine allocate_forcing_type
2876 
2877 !> Conditionally allocate fields within the mechanical forcing type
2878 subroutine allocate_mech_forcing(G, forces, stress, ustar, shelf, press, iceberg)
2879  type(ocean_grid_type), intent(in) :: g !< Ocean grid structure
2880  type(mech_forcing), intent(inout) :: forces !< Forcing fields structure
2881 
2882  logical, optional, intent(in) :: stress !< If present and true, allocate taux, tauy
2883  logical, optional, intent(in) :: ustar !< If present and true, allocate ustar and related fields
2884  logical, optional, intent(in) :: shelf !< If present and true, allocate forces for ice-shelf
2885  logical, optional, intent(in) :: press !< If present and true, allocate p_surf and related fields
2886  logical, optional, intent(in) :: iceberg !< If present and true, allocate forces for icebergs
2887 
2888  ! Local variables
2889  integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb
2890  logical :: heat_water
2891 
2892  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed
2893  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB
2894 
2895  call myalloc(forces%taux,isdb,iedb,jsd,jed, stress)
2896  call myalloc(forces%tauy,isd,ied,jsdb,jedb, stress)
2897 
2898  call myalloc(forces%ustar,isd,ied,jsd,jed, ustar)
2899 
2900  call myalloc(forces%p_surf,isd,ied,jsd,jed, press)
2901  call myalloc(forces%p_surf_full,isd,ied,jsd,jed, press)
2902  call myalloc(forces%net_mass_src,isd,ied,jsd,jed, press)
2903 
2904  call myalloc(forces%rigidity_ice_u,isdb,iedb,jsd,jed, shelf)
2905  call myalloc(forces%rigidity_ice_v,isd,ied,jsdb,jedb, shelf)
2906  call myalloc(forces%frac_shelf_u,isdb,iedb,jsd,jed, shelf)
2907  call myalloc(forces%frac_shelf_v,isd,ied,jsdb,jedb, shelf)
2908 
2909  !These fields should only on allocated when iceberg area is being passed through the coupler.
2910  call myalloc(forces%area_berg,isd,ied,jsd,jed, iceberg)
2911  call myalloc(forces%mass_berg,isd,ied,jsd,jed, iceberg)
2912 
2913 end subroutine allocate_mech_forcing
2914 
2915 !> Allocates and zeroes-out array.
2916 subroutine myalloc(array, is, ie, js, je, flag)
2917  real, dimension(:,:), pointer :: array !< Array to be allocated
2918  integer, intent(in) :: is !< Start i-index
2919  integer, intent(in) :: ie !< End i-index
2920  integer, intent(in) :: js !< Start j-index
2921  integer, intent(in) :: je !< End j-index
2922  logical, optional, intent(in) :: flag !< Flag to indicate to allocate
2923 
2924  if (present(flag)) then ; if (flag) then ; if (.not.associated(array)) then
2925  allocate(array(is:ie,js:je)) ; array(is:ie,js:je) = 0.0
2926  endif ; endif ; endif
2927 end subroutine myalloc
2928 
2929 !> Deallocate the forcing type
2930 subroutine deallocate_forcing_type(fluxes)
2931  type(forcing), intent(inout) :: fluxes !< Forcing fields structure
2932 
2933  if (associated(fluxes%ustar)) deallocate(fluxes%ustar)
2934  if (associated(fluxes%ustar_gustless)) deallocate(fluxes%ustar_gustless)
2935  if (associated(fluxes%buoy)) deallocate(fluxes%buoy)
2936  if (associated(fluxes%sw)) deallocate(fluxes%sw)
2937  if (associated(fluxes%seaice_melt_heat)) deallocate(fluxes%seaice_melt_heat)
2938  if (associated(fluxes%sw_vis_dir)) deallocate(fluxes%sw_vis_dir)
2939  if (associated(fluxes%sw_vis_dif)) deallocate(fluxes%sw_vis_dif)
2940  if (associated(fluxes%sw_nir_dir)) deallocate(fluxes%sw_nir_dir)
2941  if (associated(fluxes%sw_nir_dif)) deallocate(fluxes%sw_nir_dif)
2942  if (associated(fluxes%lw)) deallocate(fluxes%lw)
2943  if (associated(fluxes%latent)) deallocate(fluxes%latent)
2944  if (associated(fluxes%latent_evap_diag)) deallocate(fluxes%latent_evap_diag)
2945  if (associated(fluxes%latent_fprec_diag)) deallocate(fluxes%latent_fprec_diag)
2946  if (associated(fluxes%latent_frunoff_diag)) deallocate(fluxes%latent_frunoff_diag)
2947  if (associated(fluxes%sens)) deallocate(fluxes%sens)
2948  if (associated(fluxes%heat_added)) deallocate(fluxes%heat_added)
2949  if (associated(fluxes%heat_content_lrunoff)) deallocate(fluxes%heat_content_lrunoff)
2950  if (associated(fluxes%heat_content_frunoff)) deallocate(fluxes%heat_content_frunoff)
2951  if (associated(fluxes%heat_content_icemelt)) deallocate(fluxes%heat_content_icemelt)
2952  if (associated(fluxes%heat_content_lprec)) deallocate(fluxes%heat_content_lprec)
2953  if (associated(fluxes%heat_content_fprec)) deallocate(fluxes%heat_content_fprec)
2954  if (associated(fluxes%heat_content_cond)) deallocate(fluxes%heat_content_cond)
2955  if (associated(fluxes%heat_content_massout)) deallocate(fluxes%heat_content_massout)
2956  if (associated(fluxes%heat_content_massin)) deallocate(fluxes%heat_content_massin)
2957  if (associated(fluxes%evap)) deallocate(fluxes%evap)
2958  if (associated(fluxes%lprec)) deallocate(fluxes%lprec)
2959  if (associated(fluxes%fprec)) deallocate(fluxes%fprec)
2960  if (associated(fluxes%vprec)) deallocate(fluxes%vprec)
2961  if (associated(fluxes%lrunoff)) deallocate(fluxes%lrunoff)
2962  if (associated(fluxes%frunoff)) deallocate(fluxes%frunoff)
2963  if (associated(fluxes%seaice_melt)) deallocate(fluxes%seaice_melt)
2964  if (associated(fluxes%salt_flux)) deallocate(fluxes%salt_flux)
2965  if (associated(fluxes%p_surf_full)) deallocate(fluxes%p_surf_full)
2966  if (associated(fluxes%p_surf)) deallocate(fluxes%p_surf)
2967  if (associated(fluxes%TKE_tidal)) deallocate(fluxes%TKE_tidal)
2968  if (associated(fluxes%ustar_tidal)) deallocate(fluxes%ustar_tidal)
2969  if (associated(fluxes%ustar_shelf)) deallocate(fluxes%ustar_shelf)
2970  if (associated(fluxes%iceshelf_melt)) deallocate(fluxes%iceshelf_melt)
2971  if (associated(fluxes%frac_shelf_h)) deallocate(fluxes%frac_shelf_h)
2972  if (associated(fluxes%ustar_berg)) deallocate(fluxes%ustar_berg)
2973  if (associated(fluxes%area_berg)) deallocate(fluxes%area_berg)
2974  if (associated(fluxes%mass_berg)) deallocate(fluxes%mass_berg)
2975 
2976  call coupler_type_destructor(fluxes%tr_fluxes)
2977 
2978 end subroutine deallocate_forcing_type
2979 
2980 
2981 !> Deallocate the mechanical forcing type
2982 subroutine deallocate_mech_forcing(forces)
2983  type(mech_forcing), intent(inout) :: forces !< Forcing fields structure
2984 
2985  if (associated(forces%taux)) deallocate(forces%taux)
2986  if (associated(forces%tauy)) deallocate(forces%tauy)
2987  if (associated(forces%ustar)) deallocate(forces%ustar)
2988  if (associated(forces%p_surf)) deallocate(forces%p_surf)
2989  if (associated(forces%p_surf_full)) deallocate(forces%p_surf_full)
2990  if (associated(forces%net_mass_src)) deallocate(forces%net_mass_src)
2991  if (associated(forces%rigidity_ice_u)) deallocate(forces%rigidity_ice_u)
2992  if (associated(forces%rigidity_ice_v)) deallocate(forces%rigidity_ice_v)
2993  if (associated(forces%frac_shelf_u)) deallocate(forces%frac_shelf_u)
2994  if (associated(forces%frac_shelf_v)) deallocate(forces%frac_shelf_v)
2995  if (associated(forces%area_berg)) deallocate(forces%area_berg)
2996  if (associated(forces%mass_berg)) deallocate(forces%mass_berg)
2997 
2998 end subroutine deallocate_mech_forcing
2999 
3000 
3001 !> \namespace mom_forcing_type
3002 !!
3003 !! \section section_fluxes Boundary fluxes
3004 !!
3005 !! The ocean is a forced-dissipative system. Forcing occurs at the
3006 !! boundaries, and this module mediates the various forcing terms
3007 !! from momentum, heat, salt, and mass. Boundary fluxes from other
3008 !! tracers are treated by coupling to biogeochemical models. We
3009 !! here present elements of how MOM6 assumes boundary fluxes are
3010 !! passed into the ocean.
3011 !!
3012 !! Note that all fluxes are positive into the ocean. For surface
3013 !! boundary fluxes, that means fluxes are positive downward.
3014 !! For example, a positive shortwave flux warms the ocean.
3015 !!
3016 !! \subsection subsection_momentum_fluxes Surface boundary momentum fluxes
3017 !!
3018 !! The ocean surface exchanges momentum with the overlying atmosphere,
3019 !! sea ice, and land ice. The momentum is exchanged as a horizontal
3020 !! stress (Newtons per squared meter: N/m2) imposed on the upper ocean
3021 !! grid cell.
3022 !!
3023 !! \subsection subsection_mass_fluxes Surface boundary mass fluxes
3024 !!
3025 !! The ocean gains or loses mass through evaporation, precipitation,
3026 !! sea ice melt/form, and and river runoff. Positive mass fluxes
3027 !! add mass to the liquid ocean. The boundary mass flux units are
3028 !! (kilogram per square meter per sec: kg/(m2/sec)).
3029 !!
3030 !! * Evaporation field can in fact represent a
3031 !! mass loss (evaporation) or mass gain (condensation in foggy areas).
3032 !! * sea ice formation leads to mass moving from the liquid ocean to the
3033 !! ice model, and melt adds liquid to the ocean.
3034 !! * Precipitation can be liquid or frozen (snow). Furthermore, in
3035 !! some versions of the GFDL coupler, precipitation can be negative.
3036 !! The reason is that the ice model combines precipitation with
3037 !! ice melt and ice formation. This limitation of the ice model
3038 !! diagnostics should be overcome future versions.
3039 !! * River runoff can be liquid or frozen. Frozen runoff is often
3040 !! associated with calving land-ice and/or ice bergs.
3041 !!
3042 !! \subsection subsection_salt_fluxes Surface boundary salt fluxes
3043 !!
3044 !! Over most of the ocean, there is no exchange of salt with the
3045 !! atmosphere. However, the liquid ocean exchanges salt with sea ice.
3046 !! When ice forms, it extracts salt from ice pockets and discharges the
3047 !! salt into the liquid ocean. The salt concentration of sea ice
3048 !! is therefore much lower (around 5ppt) than liquid seawater
3049 !! (around 30-35ppt in high latitudes).
3050 !!
3051 !! For ocean-ice models run with a prescribed atmosphere, such as
3052 !! in the CORE/OMMIP simulations, it is necessary to employ a surface
3053 !! restoring term to the k=1 salinity equation, thus imposing a salt
3054 !! flux onto the ocean even outside of sea ice regimes. This salt
3055 !! flux is non-physical, and represents a limitation of the ocean-ice
3056 !! models run without an interactive atmosphere. Sometimes this salt
3057 !! flux is converted to an implied fresh water flux. However, doing
3058 !! so generally leads to changes in the sea level, unless a global
3059 !! normalization is provided to zero-out the net water flux.
3060 !! As a complement, for models with a restoring salt flux, one may
3061 !! choose to zero-out the net salt entering the ocean. There are
3062 !! pros/cons of each approach.
3063 !!
3064 !!
3065 !! \subsection subsection_heat_fluxes Surface boundary heat fluxes
3066 !!
3067 !! There are many terms that contribute to boundary-related heating
3068 !! of the k=1 surface model grid cell. We here outline details of
3069 !! this heat, with each term having units W/m2.
3070 !!
3071 !! The net flux of heat crossing ocean surface is stored in the diagnostic
3072 !! array "hfds". This array is computed as
3073 !! \f[
3074 !! \mbox{hfds = shortwave + longwave + latent + sensible + mass transfer + frazil + restore + flux adjustments}
3075 !! \f]
3076 !!
3077 !! * shortwave (SW) = shortwave radiation (always warms ocean)
3078 !! * longwave (LW) = longwave radiation (generally cools ocean)
3079 !! * latent (LAT) = turbulent latent heat loss due to evaporation
3080 !! (liquid to vapor) or melt (snow to liquid); generally
3081 !! cools the ocean
3082 !! * sensible (SENS) = turbulent heat transfer due to differences in
3083 !! air-sea or ice-sea temperature
3084 !! * mass transfer (MASS) = heat transfer due to heat content of mass (e.g., E-P+R)
3085 !! transferred across ocean surface; computed relative
3086 !! to 0 Celsius
3087 !! * frazil (FRAZ) = heat transferred to form frazil sea ice
3088 !! (positive heating of liquid ocean)
3089 !! * restore (RES) = heat from surface damping sometimes imposed
3090 !! in non-coupled model simulations .
3091 !! * restore (flux adjustments) = heat from surface flux adjustment.
3092 !!
3093 !! \subsubsection subsubsection_SW Treatment of shortwave
3094 !!
3095 !! The shortwave field itself is split into two pieces:
3096 !!
3097 !! * shortwave = penetrative SW + non-penetrative SW
3098 !! * non-penetrative = non-downwelling shortwave; portion of SW
3099 !! totally absorbed in the k=1 cell.
3100 !! The non-penetrative SW is combined with
3101 !! LW+LAT+SENS+seaice_melt_heat in net_heat inside routine
3102 !! extractFluxes1d. Notably, for many cases,
3103 !! non-penetrative SW = 0.
3104 !! * penetrative = that portion of shortwave penetrating below
3105 !! a tiny surface layer. This is the downwelling
3106 !! shortwave. Penetrative SW participates in
3107 !! the penetrative SW heating of k=1,nz cells,
3108 !! with the amount of penetration dependent on
3109 !! optical properties.
3110 !!
3111 !! \subsubsection subsubsection_bdy_heating Convergence of heat into the k=1 cell
3112 !!
3113 !! The convergence of boundary-related heat into surface grid cell is
3114 !! given by the difference in the net heat entering the top of the k=1
3115 !! cell and the penetrative SW leaving the bottom of the cell.
3116 !! \f{eqnarray*}{
3117 !! Q(k=1) &=& \mbox{hfds} - \mbox{pen_SW(leaving bottom of k=1)}
3118 !! \\ &=& \mbox{nonpen_SW} + (\mbox{pen_SW(enter k=1)}-\mbox{pen_SW(leave k=1)})
3119 !! + \mbox{LW+LAT+SENS+MASS+FRAZ+RES}
3120 !! \\ &=& \mbox{nonpen_SW}+ \mbox{LW+LAT+SENS+MASS+FRAZ+RES}
3121 !! + [\mbox{pen_SW(enter k=1)} - \mbox{pen_SW(leave k=1)}]
3122 !! \f}
3123 !! The convergence of the penetrative shortwave flux is given by
3124 !! \f$ \mbox{pen_SW (enter k)}-\mbox{pen_SW (leave k)}\f$. This term
3125 !! appears for all cells k=1,nz. It is diagnosed as "rsdoabsorb" inside module
3126 !! MOM6/src/parameterizations/vertical/MOM_diabatic_aux.F90
3127 !!
3128 
3129 end module mom_forcing_type
mom_opacity::sumswoverbands
subroutine, public sumswoverbands(G, GV, US, h, nsw, optics, j, dt, H_limit_fluxes, absorbAllSW, iPen_SW_bnd, netPen)
This subroutine calculates the total shortwave heat flux integrated over bands as a function of depth...
Definition: MOM_opacity.F90:783
mom_forcing_type::allocate_forcing_type
subroutine, public allocate_forcing_type(G, fluxes, water, heat, ustar, press, shelf, iceberg, salt)
Conditionally allocate fields within the forcing type.
Definition: MOM_forcing_type.F90:2811
mom_forcing_type::forcing_singlepointprint
subroutine, public forcing_singlepointprint(fluxes, G, i, j, mesg)
Write out values of the fluxes arrays at the i,j location. This is a debugging tool.
Definition: MOM_forcing_type.F90:1161
mom_forcing_type::mech_forcing
Structure that contains pointers to the mechanical forcing at the surface used to drive the liquid oc...
Definition: MOM_forcing_type.F90:187
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_spatial_means
Functions and routines to take area, volume, mass-weighted, layerwise, zonal or meridional means.
Definition: MOM_spatial_means.F90:2
mom_forcing_type::mom_mech_forcing_chksum
subroutine, public mom_mech_forcing_chksum(mesg, forces, G, US, haloshift)
Write out chksums for the driving mechanical forces.
Definition: MOM_forcing_type.F90:1104
mom_forcing_type::forcing_diagnostics
subroutine, public forcing_diagnostics(fluxes, sfc_state, G, US, time_end, diag, handles)
Offer buoyancy forcing fields for diagnostics for those fields registered as part of register_forcing...
Definition: MOM_forcing_type.F90:2238
mom_diag_mediator::query_averaging_enabled
logical function, public query_averaging_enabled(diag_cs, time_int, time_end)
Call this subroutine to determine whether the averaging is currently enabled. .true....
Definition: MOM_diag_mediator.F90:1850
mom_verticalgrid
Provides a transparent vertical ocean grid type and supporting routines.
Definition: MOM_verticalGrid.F90:2
mom_forcing_type::extractfluxes2d
subroutine, public extractfluxes2d(G, GV, US, fluxes, optics, nsw, dt_in_T, FluxRescaleDepth, useRiverHeatContent, useCalvingHeatContent, h, T, netMassInOut, netMassOut, net_heat, Net_salt, Pen_SW_bnd, tv, aggregate_FW)
2d wrapper for 1d extract fluxes from surface fluxes type. This subroutine extracts fluxes from the s...
Definition: MOM_forcing_type.F90:817
mom_file_parser::log_version
An overloaded interface to log version information about modules.
Definition: MOM_file_parser.F90:109
mom_forcing_type::copy_back_forcing_fields
subroutine, public copy_back_forcing_fields(fluxes, forces, G)
This subroutine copies the computational domains of common forcing fields from a mech_forcing type to...
Definition: MOM_forcing_type.F90:2182
locmsg
subroutine locmsg(array, aname)
Format and write a message depending on associated state of array.
Definition: MOM_forcing_type.F90:1147
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_forcing_type::deallocate_forcing_type
subroutine, public deallocate_forcing_type(fluxes)
Deallocate the forcing type.
Definition: MOM_forcing_type.F90:2931
mom_variables::thermo_var_ptrs
Pointers to an assortment of thermodynamic fields that may be available, including potential temperat...
Definition: MOM_variables.F90:78
mom_forcing_type::allocate_mech_forcing
subroutine, public allocate_mech_forcing(G, forces, stress, ustar, shelf, press, iceberg)
Conditionally allocate fields within the mechanical forcing type.
Definition: MOM_forcing_type.F90:2879
mom_opacity::extract_optics_slice
subroutine, public extract_optics_slice(optics, j, G, GV, opacity, opacity_scale, penSW_top, penSW_scale)
This subroutine returns a 2-d slice at constant j of fields from an optics_type, with the potential f...
Definition: MOM_opacity.F90:447
mom_diag_mediator::register_diag_field
integer function, public register_diag_field(module_name, field_name, axes_in, init_time, long_name, units, missing_value, range, mask_variant, standard_name, verbose, do_not_log, err_msg, interp_method, tile_count, cmor_field_name, cmor_long_name, cmor_units, cmor_standard_name, cell_methods, x_cell_method, y_cell_method, v_cell_method, conversion, v_extensive)
Returns the "diag_mediator" handle for a group (native, CMOR, z-coord, ...) of diagnostics derived fr...
Definition: MOM_diag_mediator.F90:1878
mom_eos
Provides subroutines for quantities specific to the equation of state.
Definition: MOM_EOS.F90:2
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_forcing_type::set_derived_forcing_fields
subroutine, public set_derived_forcing_fields(forces, fluxes, G, US, Rho0)
This subroutine calculates certain derived forcing fields based on information from a mech_forcing ty...
Definition: MOM_forcing_type.F90:2089
mom_forcing_type::fluxes_accumulate
subroutine, public fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces)
Accumulate the thermodynamic fluxes over time steps.
Definition: MOM_forcing_type.F90:1901
mom_forcing_type::set_net_mass_forcing
subroutine, public set_net_mass_forcing(fluxes, forces, G, US)
This subroutine determines the net mass source to the ocean from a (thermodynamic) forcing type and s...
Definition: MOM_forcing_type.F90:2129
mom_forcing_type::mech_forcing_diags
subroutine, public mech_forcing_diags(forces, dt, G, time_end, diag, handles)
Offer mechanical forcing fields for diagnostics for those fields registered as part of register_forci...
Definition: MOM_forcing_type.F90:2201
mom_forcing_type::myalloc
subroutine myalloc(array, is, ie, js, je, flag)
Allocates and zeroes-out array.
Definition: MOM_forcing_type.F90:2917
mom_unit_scaling::unit_scale_type
Describes various unit conversion factors.
Definition: MOM_unit_scaling.F90:14
mom_diag_mediator::post_data
Make a diagnostic available for averaging or output.
Definition: MOM_diag_mediator.F90:70
mom_forcing_type
This module implements boundary forcing for MOM6.
Definition: MOM_forcing_type.F90:2
mom_verticalgrid::verticalgrid_type
Describes the vertical ocean grid, including unit conversion factors.
Definition: MOM_verticalGrid.F90:24
mom_spatial_means::global_area_mean
real function, public global_area_mean(var, G, scale)
Return the global area mean of a variable. This uses reproducing sums.
Definition: MOM_spatial_means.F90:29
mom_variables
Provides transparent structures with groups of MOM6 variables and supporting routines.
Definition: MOM_variables.F90:2
mom_forcing_type::mom_forcing_chksum
subroutine, public mom_forcing_chksum(mesg, fluxes, G, US, haloshift)
Write out chksums for thermodynamic fluxes.
Definition: MOM_forcing_type.F90:1012
mom_cpu_clock
Wraps the MPP cpu clock functions.
Definition: MOM_cpu_clock.F90:2
mom_file_parser
The MOM6 facility to parse input files for runtime parameters.
Definition: MOM_file_parser.F90:2
mom_forcing_type::get_net_mass_forcing
subroutine, public get_net_mass_forcing(fluxes, G, US, net_mass_src)
This subroutine calculates determines the net mass source to the ocean from a (thermodynamic) forcing...
Definition: MOM_forcing_type.F90:2142
mom_eos::calculate_density_derivs
Calculate the derivatives of density with temperature and salinity from T, S, and P.
Definition: MOM_EOS.F90:70
mom_opacity::optics_type
This type is used to store information about ocean optical properties.
Definition: MOM_opacity.F90:25
mom_grid
Provides the ocean grid type.
Definition: MOM_grid.F90:2
mom_spatial_means::global_area_integral
real function, public global_area_integral(var, G, scale)
Return the global area integral of a variable. This uses reproducing sums.
Definition: MOM_spatial_means.F90:52
mom_diag_mediator::disable_averaging
subroutine, public disable_averaging(diag_cs)
Call this subroutine to avoid averaging any offered fields.
Definition: MOM_diag_mediator.F90:1840
mom_unit_scaling
Provides a transparent unit rescaling type to facilitate dimensional consistency testing.
Definition: MOM_unit_scaling.F90:2
mom_diag_mediator::enable_averages
subroutine, public enable_averages(time_int, time_end, diag_CS, T_to_s)
Enable the accumulation of time averages over the specified time interval in time units.
Definition: MOM_diag_mediator.F90:1820
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_debugging
Provides checksumming functions for debugging.
Definition: MOM_debugging.F90:7
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
mom_forcing_type::forcing_diags
Structure that defines the id handles for the forcing type.
Definition: MOM_forcing_type.F90:237
mom_forcing_type::copy_common_forcing_fields
subroutine, public copy_common_forcing_fields(forces, fluxes, G, skip_pres)
This subroutine copies the computational domains of common forcing fields from a mech_forcing type to...
Definition: MOM_forcing_type.F90:2046
mom_diag_mediator::register_scalar_field
integer function, public register_scalar_field(module_name, field_name, init_time, diag_cs, long_name, units, missing_value, range, standard_name, do_not_log, err_msg, interp_method, cmor_field_name, cmor_long_name, cmor_units, cmor_standard_name)
Definition: MOM_diag_mediator.F90:2596
mom_file_parser::log_param
An overloaded interface to log the values of various types of parameters.
Definition: MOM_file_parser.F90:96
mom_forcing_type::calculatebuoyancyflux2d
subroutine, public calculatebuoyancyflux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, buoyancyFlux, netHeatMinusSW, netSalt, skip_diags)
Calculates surface buoyancy flux by adding up the heat, FW and salt fluxes, for 2d arrays....
Definition: MOM_forcing_type.F90:976
mom_diag_mediator::enable_averaging
subroutine, public enable_averaging(time_int_in, time_end_in, diag_cs)
This subroutine enables the accumulation of time averages over the specified time interval.
Definition: MOM_diag_mediator.F90:1805
mom_forcing_type::forcing_accumulate
subroutine, public forcing_accumulate(flux_tmp, forces, fluxes, G, wt2)
Accumulate the forcing over time steps, taking input from a mechanical forcing type and a temporary f...
Definition: MOM_forcing_type.F90:1882
mom_opacity::optics_nbands
integer function, public optics_nbands(optics)
Return the number of bands of penetrating shortwave radiation.
Definition: MOM_opacity.F90:495
mom_forcing_type::deallocate_mech_forcing
subroutine, public deallocate_mech_forcing(forces)
Deallocate the mechanical forcing type.
Definition: MOM_forcing_type.F90:2983
mom_opacity
Routines used to calculate the opacity of the ocean.
Definition: MOM_opacity.F90:2
mom_error_handler
Routines for error handling and I/O management.
Definition: MOM_error_handler.F90:2
mom_forcing_type::register_forcing_type_diags
subroutine, public register_forcing_type_diags(Time, diag, US, use_temperature, handles, use_berg_fluxes)
Register members of the forcing type for diagnostics.
Definition: MOM_forcing_type.F90:1221
mom_forcing_type::extractfluxes1d
subroutine, public extractfluxes1d(G, GV, US, fluxes, optics, nsw, j, dt_in_T, FluxRescaleDepth, useRiverHeatContent, useCalvingHeatContent, h, T, netMassInOut, netMassOut, net_heat, net_salt, pen_SW_bnd, tv, aggregate_FW, nonpenSW, netmassInOut_rate, net_Heat_Rate, net_salt_rate, pen_sw_bnd_Rate, skip_diags)
This subroutine extracts fluxes from the surface fluxes type. It works on a j-row for optimization pu...
Definition: MOM_forcing_type.F90:346
mom_forcing_type::calculatebuoyancyflux1d
subroutine, public calculatebuoyancyflux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt, tv, j, buoyancyFlux, netHeatMinusSW, netSalt, skip_diags)
This routine calculates surface buoyancy flux by adding up the heat, FW & salt fluxes....
Definition: MOM_forcing_type.F90:879
mom_grid::ocean_grid_type
Ocean grid type. See mom_grid for details.
Definition: MOM_grid.F90:26
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
mom_forcing_type::mech_forcing_singlepointprint
subroutine mech_forcing_singlepointprint(forces, G, i, j, mesg)
Write out values of the mechanical forcing arrays at the i,j location. This is a debugging tool.
Definition: MOM_forcing_type.F90:1133