diff --git a/.testing/tc2/MOM_input b/.testing/tc2/MOM_input
index ca84d1c382..c7d2a35aa6 100644
--- a/.testing/tc2/MOM_input
+++ b/.testing/tc2/MOM_input
@@ -297,7 +297,7 @@ BOUND_CORIOLIS = True ! [Boolean] default = False
! v-points, and similarly at v-points. This option would
! have no effect on the SADOURNY Coriolis scheme if it
! were possible to use centered difference thickness fluxes.
-PGF_STANLEY_T2_DET_COEFF = 0.5 ! [nondim] default = -1.0
+PGF_STANLEY_T2_DET_COEFF = -1.0 ! [nondim] default = -1.0
! The coefficient correlating SGS temperature variance with the mean temperature
! gradient in the deterministic part of the Stanley form of the Brankart
! correction. Negative values disable the scheme.
@@ -430,7 +430,7 @@ KHTH = 1.0 ! [m2 s-1] default = 0.0
! The background horizontal thickness diffusivity.
KHTH_MAX = 900.0 ! [m2 s-1] default = 0.0
! The maximum horizontal thickness diffusivity.
-STANLEY_PRM_DET_COEFF = 0.5 ! [nondim] default = -1.0
+STANLEY_PRM_DET_COEFF = -1.0 ! [nondim] default = -1.0
! The coefficient correlating SGS temperature variance with the mean temperature
! gradient in the deterministic part of the Stanley parameterization. Negative
! values disable the scheme.
diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90
index 21992f5833..5e1c512e98 100644
--- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90
+++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90
@@ -276,7 +276,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas
OS%Time = Time_in ; OS%Time_dyn = Time_in
call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, &
OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, &
- diag_ptr=OS%diag, count_calls=.true.)
+ diag_ptr=OS%diag, count_calls=.true., waves_CSp=OS%Waves)
call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, &
C_p_scaled=OS%fluxes%C_p, use_temp=use_temperature)
diff --git a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90
index 11159903ab..5b1a980de1 100644
--- a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90
+++ b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90
@@ -274,7 +274,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, &
OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, &
input_restart_file=input_restart_file, &
- diag_ptr=OS%diag, count_calls=.true.)
+ diag_ptr=OS%diag, count_calls=.true., waves_CSp=OS%Waves)
call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, &
C_p_scaled=OS%fluxes%C_p, use_temp=use_temperature)
diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90
index 806aaf033e..b01e2019da 100644
--- a/config_src/drivers/nuopc_cap/mom_cap.F90
+++ b/config_src/drivers/nuopc_cap/mom_cap.F90
@@ -123,6 +123,8 @@ module MOM_cap_mod
character(len=64) :: stdname
character(len=64) :: shortname
character(len=64) :: transferOffer
+ integer :: ungridded_lbound = 0
+ integer :: ungridded_ubound = 0
end type fld_list_type
integer,parameter :: fldsMax = 100
@@ -652,8 +654,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
ocean_public%is_ocean_pe = .true.
call ocean_model_init(ocean_public, ocean_state, time0, time_start, input_restart_file=trim(restartfiles))
- ! GMM, this call is not needed for NCAR. Check with EMC.
- ! If this can be deleted, perhaps we should also delete ocean_model_flux_init
+ ! GMM, this call is not needed in CESM. Check with EMC if it can be deleted.
call ocean_model_flux_init(ocean_state)
call ocean_model_init_sfc(ocean_state, ocean_public)
@@ -678,9 +679,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
Ice_ocean_boundary% ice_fraction (isc:iec,jsc:jec), &
Ice_ocean_boundary% u10_sqr (isc:iec,jsc:jec), &
Ice_ocean_boundary% p (isc:iec,jsc:jec), &
- Ice_ocean_boundary% lrunoff_hflx (isc:iec,jsc:jec), &
- Ice_ocean_boundary% frunoff_hflx (isc:iec,jsc:jec), &
- Ice_ocean_boundary% lrunoff (isc:iec,jsc:jec), &
+ Ice_ocean_boundary% lrunoff (isc:iec,jsc:jec), &
Ice_ocean_boundary% frunoff (isc:iec,jsc:jec))
Ice_ocean_boundary%u_flux = 0.0
@@ -701,28 +700,38 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
Ice_ocean_boundary%ice_fraction = 0.0
Ice_ocean_boundary%u10_sqr = 0.0
Ice_ocean_boundary%p = 0.0
- Ice_ocean_boundary%lrunoff_hflx = 0.0
- Ice_ocean_boundary%frunoff_hflx = 0.0
Ice_ocean_boundary%lrunoff = 0.0
Ice_ocean_boundary%frunoff = 0.0
+ if (cesm_coupled) then
+ allocate (Ice_ocean_boundary% hrain (isc:iec,jsc:jec), &
+ Ice_ocean_boundary% hsnow (isc:iec,jsc:jec), &
+ Ice_ocean_boundary% hrofl (isc:iec,jsc:jec), &
+ Ice_ocean_boundary% hrofi (isc:iec,jsc:jec), &
+ Ice_ocean_boundary% hevap (isc:iec,jsc:jec), &
+ Ice_ocean_boundary% hcond (isc:iec,jsc:jec))
+
+ Ice_ocean_boundary%hrain = 0.0
+ Ice_ocean_boundary%hsnow = 0.0
+ Ice_ocean_boundary%hrofl = 0.0
+ Ice_ocean_boundary%hrofi = 0.0
+ Ice_ocean_boundary%hevap = 0.0
+ Ice_ocean_boundary%hcond = 0.0
+ endif
+
call query_ocean_state(ocean_state, use_waves=use_waves, wave_method=wave_method)
if (use_waves) then
- call query_ocean_state(ocean_state, NumWaveBands=Ice_ocean_boundary%num_stk_bands)
if (wave_method == "EFACTOR") then
allocate( Ice_ocean_boundary%lamult(isc:iec,jsc:jec) )
Ice_ocean_boundary%lamult = 0.0
- else
- allocate ( Ice_ocean_boundary% ustk0 (isc:iec,jsc:jec), &
- Ice_ocean_boundary% vstk0 (isc:iec,jsc:jec), &
- Ice_ocean_boundary% ustkb (isc:iec,jsc:jec,Ice_ocean_boundary%num_stk_bands), &
- Ice_ocean_boundary% vstkb (isc:iec,jsc:jec,Ice_ocean_boundary%num_stk_bands), &
- Ice_ocean_boundary%stk_wavenumbers (Ice_ocean_boundary%num_stk_bands))
- Ice_ocean_boundary%ustk0 = 0.0
- Ice_ocean_boundary%vstk0 = 0.0
+ else if (wave_method == "SURFACE_BANDS") then
+ call query_ocean_state(ocean_state, NumWaveBands=Ice_ocean_boundary%num_stk_bands)
+ allocate(Ice_ocean_boundary%ustkb(isc:iec,jsc:jec,Ice_ocean_boundary%num_stk_bands), source=0.0)
+ allocate(Ice_ocean_boundary%vstkb(isc:iec,jsc:jec,Ice_ocean_boundary%num_stk_bands), source=0.0)
+ allocate(Ice_ocean_boundary%stk_wavenumbers(Ice_ocean_boundary%num_stk_bands), source=0.0)
call query_ocean_state(ocean_state, WaveNumbers=Ice_ocean_boundary%stk_wavenumbers, unscale=.true.)
- Ice_ocean_boundary%ustkb = 0.0
- Ice_ocean_boundary%vstkb = 0.0
+ else
+ call MOM_error(FATAL, "Unsupported WAVE_METHOD encountered in NUOPC cap.")
endif
endif
! Consider adding this:
@@ -758,22 +767,39 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc)
call fld_list_add(fldsToOcn_num, fldsToOcn, "So_duu10n" , "will provide") !-> wind^2 at 10m
call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_fresh_water_to_ocean_rate", "will provide")
call fld_list_add(fldsToOcn_num, fldsToOcn, "net_heat_flx_to_ocn" , "will provide")
- !These are not currently used and changing requires a nuopc dictionary change
- !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_runoff_heat_flx" , "will provide")
- !call fld_list_add(fldsToOcn_num, fldsToOcn, "mean_calving_heat_flx" , "will provide")
+
+ if (cesm_coupled) then
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_lprec", "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_fprec", "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_evap" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_cond" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_rofl" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "heat_content_rofi" , "will provide")
+ endif
+
if (use_waves) then
if (wave_method == "EFACTOR") then
call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_lamult" , "will provide")
- else
- if (Ice_ocean_boundary%num_stk_bands > 3) then
- call MOM_error(FATAL, "Number of Stokes Bands > 3, NUOPC cap not set up for this")
+ else if (wave_method == "SURFACE_BANDS") then
+ if (cesm_coupled) then
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_pstokes_x", "will provide", &
+ ungridded_lbound=1, ungridded_ubound=Ice_ocean_boundary%num_stk_bands)
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "Sw_pstokes_y", "will provide", &
+ ungridded_lbound=1, ungridded_ubound=Ice_ocean_boundary%num_stk_bands)
+ else ! below is the old approach of importing partitioned stokes drift components. after the planned ww3 nuopc
+ ! cap unification, this else block should be removed in favor of the more flexible import approach above.
+ if (Ice_ocean_boundary%num_stk_bands > 3) then
+ call MOM_error(FATAL, "Number of Stokes Bands > 3, NUOPC cap not set up for this")
+ endif
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_1" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_1", "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_2" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_2", "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_3" , "will provide")
+ call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_3", "will provide")
endif
- call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_1" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_1", "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_2" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_2", "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "eastward_partitioned_stokes_drift_3" , "will provide")
- call fld_list_add(fldsToOcn_num, fldsToOcn, "northward_partitioned_stokes_drift_3", "will provide")
+ else
+ call MOM_error(FATAL, "Unsupported WAVE_METHOD encountered in NUOPC cap.")
endif
endif
@@ -1647,7 +1673,7 @@ subroutine ModelAdvance(gcomp, rc)
! Import data
!---------------
- call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc=rc)
+ call mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, cesm_coupled, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
!---------------
@@ -1655,7 +1681,8 @@ subroutine ModelAdvance(gcomp, rc)
!---------------
if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM update_ocean_model: ")
- call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled)
+ call update_ocean_model(Ice_ocean_boundary, ocean_state, ocean_public, Time, Time_step_coupled, &
+ cesm_coupled)
if(profile_memory) call ESMF_VMLogMemInfo("Leaving MOM update_ocean_model: ")
!---------------
@@ -2097,28 +2124,44 @@ subroutine MOM_RealizeFields(state, nfields, field_defs, tag, grid, mesh, rc)
if (present(grid)) then
- field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, &
- name=field_defs(i)%shortname, rc=rc)
- if (ChkErr(rc,__LINE__,u_FILE_u)) return
-
- ! initialize fldptr to zero
- call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc)
- if (ChkErr(rc,__LINE__,u_FILE_u)) return
- fldptr2d(:,:) = 0.0
+ if (field_defs(i)%ungridded_lbound > 0 .and. field_defs(i)%ungridded_ubound > 0) then
+ call ESMF_LogWrite(trim(subname)//": ERROR ungridded dimensions not supported in MOM6 nuopc cap when "//&
+ "ESMF_GEOMTYPE_GRID is used. Use ESMF_GEOMTYPE_MESH instead.", ESMF_LOGMSG_ERROR)
+ rc = ESMF_FAILURE
+ else
+ field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, &
+ name=field_defs(i)%shortname, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
+ ! initialize fldptr to zero
+ call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ fldptr2d(:,:) = 0.0
+ endif
else if (present(mesh)) then
- field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, &
- name=field_defs(i)%shortname, rc=rc)
- if (ChkErr(rc,__LINE__,u_FILE_u)) return
-
- ! initialize fldptr to zero
- call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc)
- if (ChkErr(rc,__LINE__,u_FILE_u)) return
- fldptr1d(:) = 0.0
+ if (field_defs(i)%ungridded_lbound > 0 .and. field_defs(i)%ungridded_ubound > 0) then
+ field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, &
+ name=field_defs(i)%shortname, ungriddedLbound=(/field_defs(i)%ungridded_lbound/), &
+ ungriddedUbound=(/field_defs(i)%ungridded_ubound/), gridToFieldMap=(/2/), rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ ! initialize fldptr to zero
+ call ESMF_FieldGet(field, farrayPtr=fldptr2d, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ fldptr2d(:,:) = 0.0
+ else
+ field = ESMF_FieldCreate(mesh=mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, &
+ name=field_defs(i)%shortname, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
+ ! initialize fldptr to zero
+ call ESMF_FieldGet(field, farrayPtr=fldptr1d, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ fldptr1d(:) = 0.0
+ endif
endif
-
endif
! Realize connected field
@@ -2172,12 +2215,14 @@ end subroutine MOM_RealizeFields
!===============================================================================
!> Set up list of field information
-subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname)
+subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname, ungridded_lbound, ungridded_ubound)
integer, intent(inout) :: num
type(fld_list_type), intent(inout) :: fldlist(:)
character(len=*), intent(in) :: stdname
character(len=*), intent(in) :: transferOffer
character(len=*), optional, intent(in) :: shortname
+ integer, optional, intent(in) :: ungridded_lbound
+ integer, optional, intent(in) :: ungridded_ubound
! local variables
integer :: rc
@@ -2199,6 +2244,10 @@ subroutine fld_list_add(num, fldlist, stdname, transferOffer, shortname)
fldlist(num)%shortname = trim(stdname)
endif
fldlist(num)%transferOffer = trim(transferOffer)
+ if (present(ungridded_lbound) .and. present(ungridded_ubound)) then
+ fldlist(num)%ungridded_lbound = ungridded_lbound
+ fldlist(num)%ungridded_ubound = ungridded_ubound
+ end if
end subroutine fld_list_add
@@ -2356,7 +2405,7 @@ end subroutine shr_file_getLogUnit
!! infrastructure when it's time for MOM to advance in time. During this subroutine, there is a
!! call into the MOM update routine:
!!
-!! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled)
+!! call update_ocean_model(Ice_ocean_boundary, Ocean_state, Ocean_public, Time, Time_step_coupled, cesm_coupled)
!!
!! Priori to the call to `update_ocean_model()`, the cap performs these steps
!! - the `Time` and `Time_step_coupled` parameters, based on FMS types, are derived from the incoming ESMF clock
@@ -2467,13 +2516,6 @@ end subroutine shr_file_getLogUnit
!! |
!!
!!
-!! | mean_calving_heat_flx |
-!! W m-2 |
-!! calving_hflx |
-!! heat flux, relative to 0C, of frozen land water into ocean |
-!! |
-!!
-!!
!! | mean_calving_rate |
!! kg m-2 s-1 |
!! calving |
@@ -2544,10 +2586,45 @@ end subroutine shr_file_getLogUnit
!! |
!!
!!
-!! | mean_runoff_heat_flx |
+!! heat_content_lprec |
+!! W m-2 |
+!! hrain |
+!! heat content (enthalpy) of liquid water entering the ocean |
+!! |
+!!
+!!
+!! | heat_content_fprec |
+!! W m-2 |
+!! hsnow |
+!! heat content (enthalpy) of frozen water entering the ocean |
+!! |
+!!
+!!
+!! | heat_content_evap |
+!! W m-2 |
+!! hevap |
+!! heat content (enthalpy) of water leaving the ocean |
+!! |
+!!
+!!
+!! | heat_content_cond |
+!! W m-2 |
+!! hcond |
+!! heat content (enthalpy) of liquid water entering the ocean due to condensation |
+!! |
+!!
+!!
+!! | heat_content_rofl |
+!! W m-2 |
+!! hrofl |
+!! heat content (enthalpy) of liquid runoff |
+!! |
+!!
+!!
+!! | heat_content_rofi |
!! W m-2 |
-!! runoff_hflx |
-!! heat flux, relative to 0C, of liquid land water into ocean |
+!! hrofi |
+!! heat content (enthalpy) of frozen runoff |
!! |
!!
!!
diff --git a/config_src/drivers/nuopc_cap/mom_cap_methods.F90 b/config_src/drivers/nuopc_cap/mom_cap_methods.F90
index a0b6b525d4..083e92eaf6 100644
--- a/config_src/drivers/nuopc_cap/mom_cap_methods.F90
+++ b/config_src/drivers/nuopc_cap/mom_cap_methods.F90
@@ -32,7 +32,11 @@ module MOM_cap_methods
public :: state_diagnose
public :: ChkErr
-private :: State_getImport
+interface State_getImport
+ module procedure State_getImport_2d
+ module procedure State_getImport_3d ! third dimension being an ungridded dimension
+end interface
+
private :: State_setExport
!> Get field pointer
@@ -68,21 +72,25 @@ end subroutine mom_set_geomtype
!> This function has a few purposes:
!! (1) it imports surface fluxes using data from the mediator; and
!! (2) it can apply restoring in SST and SSS.
-subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, rc)
+subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary, cesm_coupled, rc)
type(ocean_public_type) , intent(in) :: ocean_public !< Ocean surface state
type(ocean_grid_type) , intent(in) :: ocean_grid !< Ocean model grid
type(ESMF_State) , intent(inout) :: importState !< incoming data from mediator
type(ice_ocean_boundary_type) , intent(inout) :: ice_ocean_boundary !< Ocean boundary forcing
+ logical , intent(in) :: cesm_coupled !< Flag to check if coupled with cesm
integer , intent(inout) :: rc !< Return code
! Local Variables
- integer :: i, j, ig, jg, n
+ integer :: i, j, ib, ig, jg, n
integer :: isc, iec, jsc, jec
+ integer :: nsc ! number of stokes drift components
character(len=128) :: fldname
real(ESMF_KIND_R8), allocatable :: taux(:,:)
real(ESMF_KIND_R8), allocatable :: tauy(:,:)
real(ESMF_KIND_R8), allocatable :: stkx1(:,:),stkx2(:,:),stkx3(:,:)
real(ESMF_KIND_R8), allocatable :: stky1(:,:),stky2(:,:),stky3(:,:)
+ real(ESMF_KIND_R8), allocatable :: stkx(:,:,:)
+ real(ESMF_KIND_R8), allocatable :: stky(:,:,:)
character(len=*) , parameter :: subname = '(mom_import)'
rc = ESMF_SUCCESS
@@ -209,17 +217,53 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary,
isc, iec, jsc, jec, ice_ocean_boundary%frunoff, areacor=med2mod_areacor, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
- ! heat content of lrunoff
- ice_ocean_boundary%lrunoff_hflx(:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'mean_runoff_heat_flx', &
- isc, iec, jsc, jec, ice_ocean_boundary%lrunoff_hflx, areacor=med2mod_areacor, rc=rc)
- if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ !----
+ ! Enthalpy terms (only in CESM)
+ !----
+ if (cesm_coupled) then
+ !----
+ ! enthalpy from liquid precipitation (hrain)
+ !----
+ call state_getimport(importState, 'heat_content_lprec', &
+ isc, iec, jsc, jec, ice_ocean_boundary%hrain, areacor=med2mod_areacor, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
- ! heat content of frunoff
- ice_ocean_boundary%frunoff_hflx(:,:) = 0._ESMF_KIND_R8
- call state_getimport(importState, 'mean_calving_heat_flx', &
- isc, iec, jsc, jec, ice_ocean_boundary%frunoff_hflx, areacor=med2mod_areacor, rc=rc)
- if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ !----
+ ! enthalpy from frozen precipitation (hsnow)
+ !----
+ call state_getimport(importState, 'heat_content_fprec', &
+ isc, iec, jsc, jec, ice_ocean_boundary%hsnow, areacor=med2mod_areacor, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
+ !----
+ ! enthalpy from liquid runoff (hrofl)
+ !----
+ call state_getimport(importState, 'heat_content_rofl', &
+ isc, iec, jsc, jec, ice_ocean_boundary%hrofl, areacor=med2mod_areacor, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
+ !----
+ ! enthalpy from frozen runoff (hrofi)
+ !----
+ call state_getimport(importState, 'heat_content_rofi', &
+ isc, iec, jsc, jec, ice_ocean_boundary%hrofi, areacor=med2mod_areacor, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
+ !----
+ ! enthalpy from evaporation (hevap)
+ !----
+ call state_getimport(importState, 'heat_content_evap', &
+ isc, iec, jsc, jec, ice_ocean_boundary%hevap, areacor=med2mod_areacor, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
+ !----
+ ! enthalpy from condensation (hcond)
+ !----
+ call state_getimport(importState, 'heat_content_cond', &
+ isc, iec, jsc, jec, ice_ocean_boundary%hcond, areacor=med2mod_areacor, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
+ endif
!----
! salt flux from ice
@@ -285,49 +329,81 @@ subroutine mom_import(ocean_public, ocean_grid, importState, ice_ocean_boundary,
! Partitioned Stokes Drift Components
!----
if ( associated(ice_ocean_boundary%ustkb) ) then
- allocate(stkx1(isc:iec,jsc:jec))
- allocate(stky1(isc:iec,jsc:jec))
- allocate(stkx2(isc:iec,jsc:jec))
- allocate(stky2(isc:iec,jsc:jec))
- allocate(stkx3(isc:iec,jsc:jec))
- allocate(stky3(isc:iec,jsc:jec))
-
- call state_getimport(importState,'eastward_partitioned_stokes_drift_1' , isc, iec, jsc, jec, stkx1,rc=rc)
- if (ChkErr(rc,__LINE__,u_FILE_u)) return
- call state_getimport(importState,'northward_partitioned_stokes_drift_1', isc, iec, jsc, jec, stky1,rc=rc)
- if (ChkErr(rc,__LINE__,u_FILE_u)) return
- call state_getimport(importState,'eastward_partitioned_stokes_drift_2' , isc, iec, jsc, jec, stkx2,rc=rc)
- if (ChkErr(rc,__LINE__,u_FILE_u)) return
- call state_getimport(importState,'northward_partitioned_stokes_drift_2', isc, iec, jsc, jec, stky2,rc=rc)
- if (ChkErr(rc,__LINE__,u_FILE_u)) return
- call state_getimport(importState,'eastward_partitioned_stokes_drift_3' , isc, iec, jsc, jec, stkx3,rc=rc)
- if (ChkErr(rc,__LINE__,u_FILE_u)) return
- call state_getimport(importState,'northward_partitioned_stokes_drift_3', isc, iec, jsc, jec, stky3,rc=rc)
- if (ChkErr(rc,__LINE__,u_FILE_u)) return
- ! rotate from true zonal/meridional to local coordinates
- do j = jsc, jec
- jg = j + ocean_grid%jsc - jsc
- do i = isc, iec
- ig = i + ocean_grid%isc - isc
- ice_ocean_boundary%ustkb(i,j,1) = ocean_grid%cos_rot(ig,jg)*stkx1(i,j) &
- - ocean_grid%sin_rot(ig,jg)*stky1(i,j)
- ice_ocean_boundary%vstkb(i,j,1) = ocean_grid%cos_rot(ig,jg)*stky1(i,j) &
- + ocean_grid%sin_rot(ig,jg)*stkx1(i,j)
-
- ice_ocean_boundary%ustkb(i,j,2) = ocean_grid%cos_rot(ig,jg)*stkx2(i,j) &
- - ocean_grid%sin_rot(ig,jg)*stky2(i,j)
- ice_ocean_boundary%vstkb(i,j,2) = ocean_grid%cos_rot(ig,jg)*stky2(i,j) &
- + ocean_grid%sin_rot(ig,jg)*stkx2(i,j)
-
- ice_ocean_boundary%ustkb(i,j,3) = ocean_grid%cos_rot(ig,jg)*stkx3(i,j) &
- - ocean_grid%sin_rot(ig,jg)*stky3(i,j)
- ice_ocean_boundary%vstkb(i,j,3) = ocean_grid%cos_rot(ig,jg)*stky3(i,j) &
- + ocean_grid%sin_rot(ig,jg)*stkx3(i,j)
+ if (cesm_coupled) then
+ nsc = Ice_ocean_boundary%num_stk_bands
+ allocate(stkx(isc:iec,jsc:jec,1:nsc))
+ allocate(stky(isc:iec,jsc:jec,1:nsc))
+
+ call state_getimport(importState,'Sw_pstokes_x', isc, iec, jsc, jec, 1, nsc, stkx, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ call state_getimport(importState,'Sw_pstokes_y', isc, iec, jsc, jec, 1, nsc, stky, rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
+ ! rotate from true zonal/meridional to local coordinates
+ do j = jsc, jec
+ jg = j + ocean_grid%jsc - jsc
+ do i = isc, iec
+ ig = i + ocean_grid%isc - isc
+ !rotate
+ do ib = 1, nsc
+ ice_ocean_boundary%ustkb(i,j,ib) = ocean_grid%cos_rot(ig,jg)*stkx(i,j,ib) &
+ - ocean_grid%sin_rot(ig,jg)*stky(i,j,ib)
+ ice_ocean_boundary%vstkb(i,j,ib) = ocean_grid%cos_rot(ig,jg)*stky(i,j,ib) &
+ + ocean_grid%sin_rot(ig,jg)*stkx(i,j,ib)
+ enddo
+ ! apply masks
+ ice_ocean_boundary%ustkb(i,j,:) = ice_ocean_boundary%ustkb(i,j,:) * ocean_grid%mask2dT(ig,jg)
+ ice_ocean_boundary%vstkb(i,j,:) = ice_ocean_boundary%vstkb(i,j,:) * ocean_grid%mask2dT(ig,jg)
+ enddo
enddo
- enddo
+ deallocate(stkx,stky)
+
+ else ! below is the old approach of importing partitioned stokes drift components. after the planned ww3 nuopc
+ ! cap unification, this else block should be removed in favor of the more flexible import approach above.
+ allocate(stkx1(isc:iec,jsc:jec))
+ allocate(stky1(isc:iec,jsc:jec))
+ allocate(stkx2(isc:iec,jsc:jec))
+ allocate(stky2(isc:iec,jsc:jec))
+ allocate(stkx3(isc:iec,jsc:jec))
+ allocate(stky3(isc:iec,jsc:jec))
+
+ call state_getimport(importState,'eastward_partitioned_stokes_drift_1' , isc, iec, jsc, jec, stkx1,rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ call state_getimport(importState,'northward_partitioned_stokes_drift_1', isc, iec, jsc, jec, stky1,rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ call state_getimport(importState,'eastward_partitioned_stokes_drift_2' , isc, iec, jsc, jec, stkx2,rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ call state_getimport(importState,'northward_partitioned_stokes_drift_2', isc, iec, jsc, jec, stky2,rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ call state_getimport(importState,'eastward_partitioned_stokes_drift_3' , isc, iec, jsc, jec, stkx3,rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+ call state_getimport(importState,'northward_partitioned_stokes_drift_3', isc, iec, jsc, jec, stky3,rc=rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
- deallocate(stkx1,stkx2,stkx3,stky1,stky2,stky3)
+ ! rotate from true zonal/meridional to local coordinates
+ do j = jsc, jec
+ jg = j + ocean_grid%jsc - jsc
+ do i = isc, iec
+ ig = i + ocean_grid%isc - isc
+ ice_ocean_boundary%ustkb(i,j,1) = ocean_grid%cos_rot(ig,jg)*stkx1(i,j) &
+ - ocean_grid%sin_rot(ig,jg)*stky1(i,j)
+ ice_ocean_boundary%vstkb(i,j,1) = ocean_grid%cos_rot(ig,jg)*stky1(i,j) &
+ + ocean_grid%sin_rot(ig,jg)*stkx1(i,j)
+
+ ice_ocean_boundary%ustkb(i,j,2) = ocean_grid%cos_rot(ig,jg)*stkx2(i,j) &
+ - ocean_grid%sin_rot(ig,jg)*stky2(i,j)
+ ice_ocean_boundary%vstkb(i,j,2) = ocean_grid%cos_rot(ig,jg)*stky2(i,j) &
+ + ocean_grid%sin_rot(ig,jg)*stkx2(i,j)
+
+ ice_ocean_boundary%ustkb(i,j,3) = ocean_grid%cos_rot(ig,jg)*stkx3(i,j) &
+ - ocean_grid%sin_rot(ig,jg)*stky3(i,j)
+ ice_ocean_boundary%vstkb(i,j,3) = ocean_grid%cos_rot(ig,jg)*stky3(i,j) &
+ + ocean_grid%sin_rot(ig,jg)*stkx3(i,j)
+ enddo
+ enddo
+ deallocate(stkx1,stkx2,stkx3,stky1,stky2,stky3)
+ endif
endif
end subroutine mom_import
@@ -648,8 +724,8 @@ subroutine State_GetFldPtr_2d(State, fldname, fldptr, rc)
end subroutine State_GetFldPtr_2d
-!> Map import state field to output array
-subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, areacor, rc)
+!> Map 2d import state field to output array
+subroutine State_GetImport_2d(state, fldname, isc, iec, jsc, jec, output, do_sum, areacor, rc)
type(ESMF_State) , intent(in) :: state !< ESMF state
character(len=*) , intent(in) :: fldname !< Field name
integer , intent(in) :: isc !< The start i-index of cell centers within
@@ -672,7 +748,7 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, a
integer :: lbnd1,lbnd2
real(ESMF_KIND_R8), pointer :: dataPtr1d(:)
real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:)
- character(len=*) , parameter :: subname='(MOM_cap_methods:state_getimport)'
+ character(len=*) , parameter :: subname='(MOM_cap_methods:state_getimport_2d)'
! ----------------------------------------------
rc = ESMF_SUCCESS
@@ -731,7 +807,80 @@ subroutine State_GetImport(state, fldname, isc, iec, jsc, jec, output, do_sum, a
endif
-end subroutine State_GetImport
+end subroutine State_GetImport_2d
+
+!> Map 3d import state field to output array (where 3rd dim is an ungridded dimension)
+subroutine State_GetImport_3d(state, fldname, isc, iec, jsc, jec, lbd, ubd, output, do_sum, areacor, rc)
+ type(ESMF_State) , intent(in) :: state !< ESMF state
+ character(len=*) , intent(in) :: fldname !< Field name
+ integer , intent(in) :: isc !< The start i-index of cell centers within
+ !! the computational domain
+ integer , intent(in) :: iec !< The end i-index of cell centers within the
+ !! computational domain
+ integer , intent(in) :: jsc !< The start j-index of cell centers within
+ !! the computational domain
+ integer , intent(in) :: jec !< The end j-index of cell centers within
+ !! the computational domain
+ integer , intent(in) :: lbd !< lower bound of ungridded dimension
+ integer , intent(in) :: ubd !< upper bound of ungridded dimension
+ real (ESMF_KIND_R8) , intent(inout) :: output(isc:iec,jsc:jec,lbd:ubd)!< Output 3D array
+ logical, optional , intent(in) :: do_sum !< If true, sums the data
+ real (ESMF_KIND_R8), optional, intent(in) :: areacor(:) !< flux area correction factors
+ !! applicable to meshes
+ integer , intent(out) :: rc !< Return code
+
+ ! local variables
+ type(ESMF_StateItem_Flag) :: itemFlag
+ integer :: n, i, j, i1, j1, u
+ integer :: lbnd1,lbnd2
+ real(ESMF_KIND_R8), pointer :: dataPtr2d(:,:)
+ character(len=*) , parameter :: subname='(MOM_cap_methods:state_getimport_3d)'
+ ! ----------------------------------------------
+
+ rc = ESMF_SUCCESS
+
+ call ESMF_StateGet(State, trim(fldname), itemFlag, rc=rc)
+ if (itemFlag /= ESMF_STATEITEM_NOTFOUND) then
+
+ if (geomtype == ESMF_GEOMTYPE_MESH) then
+
+ ! get field pointer
+ call state_getfldptr(state, trim(fldname), dataptr2d, rc)
+ if (ChkErr(rc,__LINE__,u_FILE_u)) return
+
+ ! determine output array and apply area correction if present
+ do u = lbd, ubd ! ungridded dims
+ n = 0
+ do j = jsc,jec
+ do i = isc,iec
+ n = n + 1
+ if (present(do_sum)) then
+ if (present(areacor)) then
+ output(i,j,u) = output(i,j,u) + dataPtr2d(u,n) * areacor(n)
+ else
+ output(i,j,u) = output(i,j,u) + dataPtr2d(u,n)
+ end if
+ else
+ if (present(areacor)) then
+ output(i,j,u) = dataPtr2d(u,n) * areacor(n)
+ else
+ output(i,j,u) = dataPtr2d(u,n)
+ end if
+ endif
+ enddo
+ enddo
+ enddo
+
+ else if (geomtype == ESMF_GEOMTYPE_GRID) then
+ call ESMF_LogWrite(trim(subname)//": ERROR ungridded dimensions not supported in MOM6 nuopc cap when "// &
+ "ESMF_GEOMTYPE_GRID is used. Use ESMF_GEOMTYPE_MESH instead.", ESMF_LOGMSG_ERROR)
+ rc = ESMF_FAILURE
+ return
+ endif
+
+ endif
+
+end subroutine State_GetImport_3d
!> Map input array to export state
subroutine State_SetExport(state, fldname, isc, iec, jsc, jec, input, ocean_grid, areacor, rc)
diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90
index a44e126461..dddac936d4 100644
--- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90
+++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90
@@ -284,7 +284,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, &
OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, &
input_restart_file=input_restart_file, &
- diag_ptr=OS%diag, count_calls=.true.)
+ diag_ptr=OS%diag, count_calls=.true., waves_CSp=OS%Waves)
call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, &
C_p_scaled=OS%fluxes%C_p, use_temp=use_temperature)
@@ -378,6 +378,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
call get_param(param_file, mdl, "USE_CFC_CAP", use_CFC, &
default=.false., do_not_log=.true.)
+ call get_param(param_file, mdl, "USE_WAVES", OS%Use_Waves, &
+ "If true, enables surface wave modules.", default=.false.)
! Consider using a run-time flag to determine whether to do the diagnostic
! vertical integrals, since the related 3-d sums are not negligible in cost.
@@ -398,15 +400,14 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i
call allocate_forcing_type(OS%grid, OS%fluxes, shelf=.true.)
endif
- call allocate_forcing_type(OS%grid, OS%fluxes, waves=.true.)
- call get_param(param_file, mdl, "USE_WAVES", OS%Use_Waves, &
- "If true, enables surface wave modules.", default=.false.)
if (OS%Use_Waves) then
call get_param(param_file, mdl, "WAVE_METHOD", OS%wave_method, default="EMPTY", do_not_log=.true.)
endif
+ call allocate_forcing_type(OS%grid, OS%fluxes, waves=.true., lamult=(trim(OS%wave_method)=="EFACTOR"))
+
! MOM_wave_interface_init is called regardless of the value of USE_WAVES because
! it also initializes statistical waves.
- call MOM_wave_interface_init(OS%Time, OS%grid, OS%GV, OS%US, param_file, OS%Waves, OS%diag)
+ call MOM_wave_interface_init(OS%Time, OS%grid, OS%GV, OS%US, param_file, OS%Waves, OS%diag, OS%restart_CSp)
if (associated(OS%grid%Domain%maskmap)) then
call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, &
@@ -458,7 +459,7 @@ end subroutine ocean_model_init
!! storing the new ocean properties in Ocean_state.
subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
time_start_update, Ocean_coupling_time_step, &
- update_dyn, update_thermo, Ocn_fluxes_used)
+ cesm_coupled, update_dyn, update_thermo, Ocn_fluxes_used)
type(ice_ocean_boundary_type), &
intent(in) :: Ice_ocean_boundary !< A structure containing the
!! various forcing fields coming from the ice.
@@ -473,6 +474,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
type(time_type), intent(in) :: time_start_update !< The time at the beginning of the update step.
type(time_type), intent(in) :: Ocean_coupling_time_step !< The amount of time over
!! which to advance the ocean.
+ logical, intent(in) :: cesm_coupled !< Flag to check if coupled with cesm
logical, optional, intent(in) :: update_dyn !< If present and false, do not do updates
!! due to the ocean dynamics.
logical, optional, intent(in) :: update_thermo !< If present and false, do not do updates
@@ -522,7 +524,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
do_dyn = .true. ; if (present(update_dyn)) do_dyn = update_dyn
do_thermo = .true. ; if (present(update_thermo)) do_thermo = update_thermo
-
! This is benign but not necessary if ocean_model_init_sfc was called or if
! OS%sfc_state%tr_fields was spawned in ocean_model_init. Consider removing it.
is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec
@@ -689,7 +690,12 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, &
call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%Time, OS%diag, OS%forcing_CSp%handles)
if (OS%fluxes%fluxes_used) then
- call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%grid, OS%US, OS%Time, OS%diag, OS%forcing_CSp%handles)
+ if (cesm_coupled) then
+ call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%grid, OS%US, OS%Time, OS%diag, &
+ OS%forcing_CSp%handles, enthalpy=.true.)
+ else
+ call forcing_diagnostics(OS%fluxes, OS%sfc_state, OS%grid, OS%US, OS%Time, OS%diag, OS%forcing_CSp%handles)
+ endif
endif
! Translate state into Ocean.
diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90
index da4c15e528..c45a59c221 100644
--- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90
+++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90
@@ -81,6 +81,8 @@ module MOM_surface_forcing_nuopc
!! pressure limited by max_p_surf instead of the
!! full atmospheric pressure. The default is true.
logical :: use_CFC !< enables the MOM_CFC_cap tracer package.
+ logical :: enthalpy_cpl !< Controls if enthalpy terms are provided by the coupler or computed
+ !! internally.
real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-1 ~> Pa]
logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied
!! from an input file.
@@ -180,8 +182,12 @@ module MOM_surface_forcing_nuopc
real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs [m/s]
real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs[m2/m2]
real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2)
- real, pointer, dimension(:,:) :: lrunoff_hflx =>NULL() !< heat content of liquid runoff [W/m2]
- real, pointer, dimension(:,:) :: frunoff_hflx =>NULL() !< heat content of frozen runoff [W/m2]
+ real, pointer, dimension(:,:) :: hrofl =>NULL() !< heat content from liquid runoff [W/m2]
+ real, pointer, dimension(:,:) :: hrofi =>NULL() !< heat content from frozen runoff [W/m2]
+ real, pointer, dimension(:,:) :: hrain =>NULL() !< heat content from liquid precipitation [W/m2]
+ real, pointer, dimension(:,:) :: hsnow =>NULL() !< heat content from frozen precipitation [W/m2]
+ real, pointer, dimension(:,:) :: hevap =>NULL() !< heat content from evaporation [W/m2]
+ real, pointer, dimension(:,:) :: hcond =>NULL() !< heat content from condensation [W/m2]
real, pointer, dimension(:,:) :: p =>NULL() !< pressure of overlying ice and atmosphere
!< on ocean surface [Pa]
real, pointer, dimension(:,:) :: ice_fraction =>NULL() !< fractional ice area [nondim]
@@ -192,8 +198,6 @@ module MOM_surface_forcing_nuopc
!! for divergence damping, as determined
!! outside of the ocean model in [m3/s]
real, pointer, dimension(:,:) :: lamult => NULL() !< Langmuir enhancement factor [nondim]
- real, pointer, dimension(:,:) :: ustk0 => NULL() !< Surface Stokes drift, zonal [m/s]
- real, pointer, dimension(:,:) :: vstk0 => NULL() !< Surface Stokes drift, meridional [m/s]
real, pointer, dimension(:) :: stk_wavenumbers => NULL() !< The central wave number of Stokes bands [rad/m]
real, pointer, dimension(:,:,:) :: ustkb => NULL() !< Stokes Drift spectrum, zonal [m/s]
!! Horizontal - u points
@@ -305,7 +309,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
if (fluxes%dt_buoy_accum < 0) then
call allocate_forcing_type(G, fluxes, water=.true., heat=.true., ustar=.true., &
press=.true., fix_accum_bug=CS%fix_ustar_gustless_bug, &
- cfc=CS%use_CFC)
+ cfc=CS%use_CFC, hevap=CS%enthalpy_cpl)
call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed)
call safe_alloc_ptr(fluxes%sw_vis_dif,isd,ied,jsd,jed)
@@ -488,13 +492,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
if (associated(IOB%mass_berg)) &
fluxes%mass_berg(i,j) = US%m_to_Z*US%kg_m3_to_R * IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j)
- if (associated(IOB%lrunoff_hflx)) &
- fluxes%heat_content_lrunoff(i,j) = US%W_m2_to_QRZ_T * IOB%lrunoff_hflx(i-i0,j-j0) * G%mask2dT(i,j)
-
- if (associated(IOB%frunoff_hflx)) &
- fluxes%heat_content_frunoff(i,j) = US%W_m2_to_QRZ_T * kg_m2_s_conversion * &
- IOB%frunoff_hflx(i-i0,j-j0) * G%mask2dT(i,j)
-
if (associated(IOB%lw_flux)) &
fluxes%lw(i,j) = US%W_m2_to_QRZ_T * IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j)
@@ -545,6 +542,27 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G,
fluxes%sw(i,j) = fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j) + &
fluxes%sw_nir_dir(i,j) + fluxes%sw_nir_dif(i,j)
+ ! enthalpy terms
+ if (CS%enthalpy_cpl) then
+ if (associated(IOB%hrofl)) &
+ fluxes%heat_content_lrunoff(i,j) = US%W_m2_to_QRZ_T * IOB%hrofl(i-i0,j-j0) * G%mask2dT(i,j)
+
+ if (associated(IOB%hrofi)) &
+ fluxes%heat_content_frunoff(i,j) = US%W_m2_to_QRZ_T * IOB%hrofi(i-i0,j-j0) * G%mask2dT(i,j)
+
+ if (associated(IOB%hrain)) &
+ fluxes%heat_content_lprec(i,j) = US%W_m2_to_QRZ_T * IOB%hrain(i-i0,j-j0) * G%mask2dT(i,j)
+
+ if (associated(IOB%hsnow)) &
+ fluxes%heat_content_fprec(i,j) = US%W_m2_to_QRZ_T * IOB%hsnow(i-i0,j-j0) * G%mask2dT(i,j)
+
+ if (associated(IOB%hevap)) &
+ fluxes%heat_content_evap(i,j) = US%W_m2_to_QRZ_T * IOB%hevap(i-i0,j-j0) * G%mask2dT(i,j)
+
+ if (associated(IOB%hcond)) &
+ fluxes%heat_content_cond(i,j) = US%W_m2_to_QRZ_T * IOB%hcond(i-i0,j-j0) * G%mask2dT(i,j)
+ endif
+
! sea ice fraction [nondim]
if (associated(IOB%ice_fraction) .and. associated(fluxes%ice_fraction)) &
fluxes%ice_fraction(i,j) = G%mask2dT(i,j) * IOB%ice_fraction(i-i0,j-j0)
@@ -892,17 +910,13 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS)
if ( associated(IOB%ustkb) ) then
forces%stk_wavenumbers(:) = IOB%stk_wavenumbers
- do j=js,je; do i=is,ie
- forces%ustk0(i,j) = IOB%ustk0(i-I0,j-J0) ! How to be careful here that the domains are right?
- forces%vstk0(i,j) = IOB%vstk0(i-I0,j-J0)
- enddo ; enddo
- call pass_vector(forces%ustk0,forces%vstk0, G%domain )
do istk = 1,IOB%num_stk_bands
do j=js,je; do i=is,ie
forces%ustkb(i,j,istk) = IOB%ustkb(i-I0,j-J0,istk)
forces%vstkb(i,j,istk) = IOB%vstkb(i-I0,j-J0,istk)
enddo; enddo
- call pass_vector(forces%ustkb(:,:,istk),forces%vstkb(:,:,istk), G%domain )
+ call pass_var(forces%ustkb(:,:,istk), G%domain )
+ call pass_var(forces%vstkb(:,:,istk), G%domain )
enddo
endif
@@ -1206,6 +1220,10 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt,
call get_param(param_file, mdl, "USE_CFC_CAP", CS%use_CFC, &
default=.false., do_not_log=.true.)
+ call get_param(param_file, mdl, "ENTHALPY_FROM_COUPLER", CS%enthalpy_cpl, &
+ "If True, the heat (enthalpy) associated with mass entering/leaving the "//&
+ "ocean is provided via coupler.", default=.false.)
+
if (restore_salt) then
call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, &
"The constant that relates the restoring surface fluxes to the relative "//&
@@ -1512,6 +1530,26 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt)
chks = field_chksum( iobt%mass_berg ) ; if (root) write(outunit,100) 'iobt%mass_berg ', chks
endif
+ ! enthalpy
+ if (associated(iobt%hrofl)) then
+ chks = field_chksum( iobt%hrofl ) ; if (root) write(outunit,100) 'iobt%hrofl ', chks
+ endif
+ if (associated(iobt%hrofi)) then
+ chks = field_chksum( iobt%hrofi ) ; if (root) write(outunit,100) 'iobt%hrofi ', chks
+ endif
+ if (associated(iobt%hrain)) then
+ chks = field_chksum( iobt%hrain ) ; if (root) write(outunit,100) 'iobt%hrain ', chks
+ endif
+ if (associated(iobt%hsnow)) then
+ chks = field_chksum( iobt%hsnow ) ; if (root) write(outunit,100) 'iobt%hsnow ', chks
+ endif
+ if (associated(iobt%hevap)) then
+ chks = field_chksum( iobt%hevap ) ; if (root) write(outunit,100) 'iobt%hevap ', chks
+ endif
+ if (associated(iobt%hcond)) then
+ chks = field_chksum( iobt%hcond ) ; if (root) write(outunit,100) 'iobt%hcond ', chks
+ endif
+
100 FORMAT(" CHECKSUM::",A20," = ",Z20)
call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%')
diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90
index d6630a0f17..deab29be50 100644
--- a/config_src/drivers/solo_driver/MOM_driver.F90
+++ b/config_src/drivers/solo_driver/MOM_driver.F90
@@ -286,14 +286,15 @@ program MOM_main
Time = segment_start_time
call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, restart_CSp, &
segment_start_time, offline_tracer_mode=offline_tracer_mode, &
- diag_ptr=diag, tracer_flow_CSp=tracer_flow_CSp, ice_shelf_CSp=ice_shelf_CSp)
+ diag_ptr=diag, tracer_flow_CSp=tracer_flow_CSp, ice_shelf_CSp=ice_shelf_CSp, &
+ waves_CSp=Waves_CSp)
else
! In this case, the segment starts at a time read from the MOM restart file
! or is left at Start_time by MOM_initialize.
Time = Start_time
call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, restart_CSp, &
offline_tracer_mode=offline_tracer_mode, diag_ptr=diag, &
- tracer_flow_CSp=tracer_flow_CSp, ice_shelf_CSp=ice_shelf_CSp)
+ tracer_flow_CSp=tracer_flow_CSp, ice_shelf_CSp=ice_shelf_CSp, waves_CSp=Waves_CSp)
endif
call get_MOM_state_elements(MOM_CSp, G=grid, GV=GV, US=US, C_p_scaled=fluxes%C_p)
diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90
index 95a77f503d..8361a040c5 100644
--- a/src/ALE/MOM_regridding.F90
+++ b/src/ALE/MOM_regridding.F90
@@ -497,7 +497,6 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m
call setCoordinateResolution(dz, CS, scale=1.0)
elseif (coordinateMode(coord_mode) == REGRIDDING_RHO) then
call setCoordinateResolution(dz, CS, scale=US%kg_m3_to_R)
- CS%coord_scale = US%R_to_kg_m3
elseif (coordinateMode(coord_mode) == REGRIDDING_ADAPTIVE) then
call setCoordinateResolution(dz, CS, scale=GV%m_to_H)
CS%coord_scale = GV%H_to_m
@@ -507,6 +506,14 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m
endif
endif
+ ! set coord_scale for RHO regridding independent of allocation status of dz
+ if (coordinateMode(coord_mode) == REGRIDDING_RHO) then
+ CS%coord_scale = US%R_to_kg_m3
+ endif
+
+ ! ensure CS%ref_pressure is rescaled properly
+ CS%ref_pressure = (US%kg_m3_to_R * US%m_s_to_L_T**2) * CS%ref_pressure
+
if (allocated(rho_target)) then
call set_target_densities(CS, US%kg_m3_to_R*rho_target)
deallocate(rho_target)
diff --git a/src/core/MOM.F90 b/src/core/MOM.F90
index c4f3d40343..0a08b9bc88 100644
--- a/src/core/MOM.F90
+++ b/src/core/MOM.F90
@@ -109,6 +109,7 @@ module MOM
use MOM_shared_initialization, only : write_ocean_geometry_file
use MOM_sponge, only : init_sponge_diags, sponge_CS
use MOM_state_initialization, only : MOM_initialize_state
+use MOM_stoch_eos, only : MOM_stoch_eos_init,MOM_stoch_eos_run,MOM_stoch_eos_CS,mom_calc_varT
use MOM_sum_output, only : write_energy, accumulate_net_input
use MOM_sum_output, only : MOM_sum_output_init, MOM_sum_output_end
use MOM_sum_output, only : sum_output_CS
@@ -137,7 +138,7 @@ module MOM
use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd
use MOM_verticalGrid, only : fix_restart_scaling
use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units
-use MOM_wave_interface, only : wave_parameters_CS, waves_end
+use MOM_wave_interface, only : wave_parameters_CS, waves_end, waves_register_restarts
use MOM_wave_interface, only : Update_Stokes_Drift
use MOM_porous_barriers, only : porous_widths
@@ -243,6 +244,7 @@ module MOM
logical :: use_ALE_algorithm !< If true, use the ALE algorithm rather than layered
!! isopycnal/stacked shallow water mode. This logical is set by calling the
!! function useRegridding() from the MOM_regridding module.
+ type(MOM_stoch_eos_CS) :: stoch_eos_CS !< structure containing random pattern for stoch EOS
logical :: alternate_first_direction !< If true, alternate whether the x- or y-direction
!! updates occur first in directionally split parts of the calculation.
real :: first_dir_restart = -1.0 !< A real copy of G%first_direction for use in restart files
@@ -445,6 +447,8 @@ module MOM
integer :: id_clock_other
integer :: id_clock_offline_tracer
integer :: id_clock_unit_tests
+integer :: id_clock_stoch
+integer :: id_clock_varT
!>@}
contains
@@ -691,16 +695,16 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS
else
CS%p_surf_end => forces%p_surf
endif
-
if (CS%UseWaves) then
! Update wave information, which is presently kept static over each call to step_mom
call enable_averages(time_interval, Time_start + real_to_time(US%T_to_s*time_interval), CS%diag)
- call Update_Stokes_Drift(G, GV, US, Waves, h, forces%ustar)
+ call Update_Stokes_Drift(G, GV, US, Waves, h, forces%ustar, time_interval, do_dyn)
call disable_averaging(CS%diag)
endif
else ! not do_dyn.
- if (CS%UseWaves) & ! Diagnostics are not enabled in this call.
- call Update_Stokes_Drift(G, GV, US, Waves, h, fluxes%ustar)
+ if (CS%UseWaves) then ! Diagnostics are not enabled in this call.
+ call Update_Stokes_Drift(G, GV, US, Waves, h, fluxes%ustar, time_interval, do_dyn)
+ endif
endif
if (CS%debug) then
@@ -1047,7 +1051,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, &
! barotropic time step needs to be updated.
logical :: showCallTree
- integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
+ integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)+1) :: eta_por ! layer interface heights
@@ -1061,6 +1065,15 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, &
showCallTree = callTree_showQuery()
call cpu_clock_begin(id_clock_dynamics)
+ call cpu_clock_begin(id_clock_stoch)
+ if (CS%stoch_eos_CS%use_stoch_eos) call MOM_stoch_eos_run(G,u,v,dt,Time_local,CS%stoch_eos_CS,CS%diag)
+ call cpu_clock_end(id_clock_stoch)
+ call cpu_clock_begin(id_clock_varT)
+ if (CS%stoch_eos_CS%stanley_coeff >= 0.0) then
+ call MOM_calc_varT(G,GV,h,CS%tv,CS%stoch_eos_CS,dt)
+ call pass_var(CS%tv%varT, G%Domain,clock=id_clock_pass,halo=1)
+ endif
+ call cpu_clock_end(id_clock_varT)
if ((CS%t_dyn_rel_adv == 0.0) .and. CS%thickness_diffuse .and. CS%thickness_diffuse_first) then
@@ -1136,6 +1149,30 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, &
endif ! -------------------------------------------------- end SPLIT
+ ! Update the model's current to reflect wind-wave growth
+ if (Waves%Stokes_DDT .and. (.not.Waves%Passive_Stokes_DDT)) then
+ do J=jsq,jeq ; do i=is,ie
+ v(i,J,:) = v(i,J,:) + Waves%ddt_us_y(i,J,:)*dt
+ enddo; enddo
+ do j=js,je ; do I=isq,ieq
+ u(I,j,:) = u(I,j,:) + Waves%ddt_us_x(I,j,:)*dt
+ enddo; enddo
+ call pass_vector(u,v,G%Domain)
+ endif
+ ! Added an additional output to track Stokes drift time tendency.
+ ! It is mostly for debugging, and perhaps doesn't need to hang
+ ! around permanently.
+ if (Waves%Stokes_DDT .and. (Waves%id_3dstokes_y_from_ddt>0)) then
+ do J=jsq,jeq ; do i=is,ie
+ Waves%us_y_from_ddt(i,J,:) = Waves%us_y_from_ddt(i,J,:) + Waves%ddt_us_y(i,J,:)*dt
+ enddo; enddo
+ endif
+ if (Waves%Stokes_DDT .and. (Waves%id_3dstokes_x_from_ddt>0)) then
+ do j=js,je ; do I=isq,ieq
+ Waves%us_x_from_ddt(I,j,:) = Waves%us_x_from_ddt(I,j,:) + Waves%ddt_us_x(I,j,:)*dt
+ enddo; enddo
+ endif
+
if (CS%use_particles .and. CS%do_dynamics) then ! Run particles whether or not stepping is split
call particles_run(CS%particles, Time_local, CS%u, CS%v, CS%h, CS%tv) ! Run the particles model
endif
@@ -1203,6 +1240,9 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, &
if (IDs%id_u > 0) call post_data(IDs%id_u, u, CS%diag)
if (IDs%id_v > 0) call post_data(IDs%id_v, v, CS%diag)
if (IDs%id_h > 0) call post_data(IDs%id_h, h, CS%diag)
+ if (CS%stoch_eos_CS%id_stoch_eos > 0) call post_data(CS%stoch_eos_CS%id_stoch_eos, CS%stoch_eos_CS%pattern, CS%diag)
+ if (CS%stoch_eos_CS%id_stoch_phi > 0) call post_data(CS%stoch_eos_CS%id_stoch_phi, CS%stoch_eos_CS%phi, CS%diag)
+ if (CS%stoch_eos_CS%id_tvar_sgs > 0) call post_data(CS%stoch_eos_CS%id_tvar_sgs, CS%tv%varT, CS%diag)
call disable_averaging(CS%diag)
call cpu_clock_end(id_clock_diagnostics) ; call cpu_clock_end(id_clock_other)
@@ -1703,7 +1743,7 @@ end subroutine step_offline
!! initializing the ocean state variables, and initializing subsidiary modules
subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
Time_in, offline_tracer_mode, input_restart_file, diag_ptr, &
- count_calls, tracer_flow_CSp, ice_shelf_CSp)
+ count_calls, tracer_flow_CSp, ice_shelf_CSp, waves_CSp)
type(time_type), target, intent(inout) :: Time !< model time, set in this routine
type(time_type), intent(in) :: Time_init !< The start time for the coupled model's calendar
type(param_file_type), intent(out) :: param_file !< structure indicating parameter file to parse
@@ -1725,6 +1765,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
!! calls to step_MOM instead of the number of
!! dynamics timesteps.
type(ice_shelf_CS), optional, pointer :: ice_shelf_CSp !< A pointer to an ice shelf control structure
+ type(Wave_parameters_CS), &
+ optional, pointer :: Waves_CSp !< An optional pointer to a wave property CS
! local variables
type(ocean_grid_type), pointer :: G => NULL() ! A pointer to the metric grid use for the run
type(ocean_grid_type), pointer :: G_in => NULL() ! Pointer to the input grid
@@ -1800,6 +1842,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
integer :: first_direction ! An integer that indicates which direction is to be
! updated first in directionally split parts of the
! calculation.
+ logical :: use_KPP ! If true, diabatic is using KPP vertical mixing
integer :: nkml, nkbl, verbosity, write_geom
integer :: dynamics_stencil ! The computational stencil for the calculations
! in the dynamic core.
@@ -2327,13 +2370,18 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call register_tracer(CS%tv%T, CS%tracer_Reg, param_file, HI, GV, &
tr_desc=vd_T, registry_diags=.true., flux_nameroot='T', &
flux_units='W', flux_longname='Heat', &
+ net_surfflux_name='KPP_QminusSW', NLT_budget_name='KPP_NLT_temp_budget', &
+ net_surfflux_longname='Net temperature flux ignoring short-wave, as used by [CVMix] KPP', &
flux_scale=conv2watt, convergence_units='W m-2', &
- convergence_scale=conv2watt, CMOR_tendprefix="opottemp", diag_form=2)
+ convergence_scale=conv2watt, CMOR_tendprefix="opottemp", diag_form=2, &
+ Tr_out=CS%tv%tr_T)
call register_tracer(CS%tv%S, CS%tracer_Reg, param_file, HI, GV, &
tr_desc=vd_S, registry_diags=.true., flux_nameroot='S', &
flux_units=S_flux_units, flux_longname='Salt', &
+ net_surfflux_name='KPP_netSalt', NLT_budget_name='KPP_NLT_saln_budget', &
flux_scale=conv2salt, convergence_units='kg m-2 s-1', &
- convergence_scale=0.001*GV%H_to_kg_m2, CMOR_tendprefix="osalt", diag_form=2)
+ convergence_scale=0.001*GV%H_to_kg_m2, CMOR_tendprefix="osalt", diag_form=2, &
+ Tr_out=CS%tv%tr_S)
endif
endif
@@ -2462,6 +2510,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
param_file, restart_CSp, use_temperature)
endif
+ if (present(waves_CSp)) then
+ call waves_register_restarts(waves_CSp, HI, GV, param_file, restart_CSp)
+ endif
+
call callTree_waypoint("restart registration complete (initialize_MOM)")
call restart_registry_lock(restart_CSp)
@@ -2722,6 +2774,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call set_visc_init(Time, G, GV, US, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC)
call thickness_diffuse_init(Time, G, GV, US, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp)
+ new_sim = is_new_run(restart_CSp)
+ call MOM_stoch_eos_init(G,Time,param_file,CS%stoch_eos_CS,restart_CSp,diag)
if (CS%split) then
allocate(eta(SZI_(G),SZJ_(G)), source=0.0)
call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, &
@@ -2803,14 +2857,14 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, &
call register_surface_diags(Time, G, US, CS%sfc_IDs, CS%diag, CS%tv)
call register_diags(Time, G, GV, US, CS%IDs, CS%diag)
call register_transport_diags(Time, G, GV, US, CS%transport_IDs, CS%diag)
+ call extract_diabatic_member(CS%diabatic_CSp, use_KPP=use_KPP)
call register_tracer_diagnostics(CS%tracer_Reg, CS%h, Time, diag, G, GV, US, &
- CS%use_ALE_algorithm)
+ CS%use_ALE_algorithm, use_KPP)
if (CS%use_ALE_algorithm) then
call ALE_register_diags(Time, G, GV, US, diag, CS%ALE_CSp)
endif
! This subroutine initializes any tracer packages.
- new_sim = is_new_run(restart_CSp)
call tracer_flow_control_init(.not.new_sim, Time, G, GV, US, CS%h, param_file, &
CS%diag, CS%OBC, CS%tracer_flow_CSp, CS%sponge_CSp, &
CS%ALE_sponge_CSp, CS%tv)
@@ -3016,6 +3070,7 @@ subroutine register_diags(Time, G, GV, US, IDs, diag)
v_extensive=.true.)
IDs%id_ssh_inst = register_diag_field('ocean_model', 'SSH_inst', diag%axesT1, &
Time, 'Instantaneous Sea Surface Height', 'm', conversion=US%Z_to_m)
+
end subroutine register_diags
!> Set up CPU clock IDs for timing various subroutines.
@@ -3048,6 +3103,8 @@ subroutine MOM_timing_init(CS)
if (CS%offline_tracer_mode) then
id_clock_offline_tracer = cpu_clock_id('Ocean offline tracers', grain=CLOCK_SUBCOMPONENT)
endif
+ id_clock_stoch = cpu_clock_id('(Stochastic EOS)', grain=CLOCK_MODULE)
+ id_clock_varT = cpu_clock_id('(SGS Temperature Variance)', grain=CLOCK_MODULE)
end subroutine MOM_timing_init
diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90
index c1dfd500dc..6aacc479af 100644
--- a/src/core/MOM_CoriolisAdv.F90
+++ b/src/core/MOM_CoriolisAdv.F90
@@ -18,6 +18,7 @@ module MOM_CoriolisAdv
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : accel_diag_ptrs, porous_barrier_ptrs
use MOM_verticalGrid, only : verticalGrid_type
+use MOM_wave_interface, only : wave_parameters_CS
implicit none ; private
@@ -85,6 +86,7 @@ module MOM_CoriolisAdv
integer :: id_h_gKEu = -1, id_h_gKEv = -1
integer :: id_h_rvxu = -1, id_h_rvxv = -1
integer :: id_intz_rvxu_2d = -1, id_intz_rvxv_2d = -1
+ integer :: id_CAuS = -1, id_CAvS = -1
!>@}
end type CoriolisAdv_CS
@@ -120,7 +122,7 @@ module MOM_CoriolisAdv
contains
!> Calculates the Coriolis and momentum advection contributions to the acceleration.
-subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv)
+subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Waves)
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< Zonal velocity [L T-1 ~> m s-1]
@@ -139,10 +141,12 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv)
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(CoriolisAdv_CS), intent(in) :: CS !< Control structure for MOM_CoriolisAdv
type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics
+ type(Wave_parameters_CS), optional, pointer :: Waves !< An optional pointer to Stokes drift CS
! Local variables
real, dimension(SZIB_(G),SZJB_(G)) :: &
q, & ! Layer potential vorticity [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1].
+ qS, & ! Layer Stokes vorticity [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1].
Ih_q, & ! The inverse of thickness interpolated to q points [H-1 ~> m-1 or m2 kg-1].
Area_q ! The sum of the ocean areas at the 4 adjacent thickness points [L2 ~> m2].
@@ -176,12 +180,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv)
! discretization [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1].
real, dimension(SZIB_(G),SZJB_(G)) :: &
dvdx, dudy, & ! Contributions to the circulation around q-points [L2 T-1 ~> m2 s-1]
+ dvSdx, duSdy, & ! idem. for Stokes drift [L2 T-1 ~> m2 s-1]
rel_vort, & ! Relative vorticity at q-points [T-1 ~> s-1].
abs_vort, & ! Absolute vorticity at q-points [T-1 ~> s-1].
+ stk_vort, & ! Stokes vorticity at q-points [T-1 ~> s-1].
q2 ! Relative vorticity over thickness [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1].
real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)) :: &
PV, & ! A diagnostic array of the potential vorticities [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1].
RV ! A diagnostic array of the relative vorticities [T-1 ~> s-1].
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: CAuS !
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)) :: CAvS !
real :: fv1, fv2, fv3, fv4 ! (f+rv)*v [L T-2 ~> m s-2].
real :: fu1, fu2, fu3, fu4 ! -(f+rv)*u [L T-2 ~> m s-2].
real :: max_fv, max_fu ! The maximum or minimum of the neighboring Coriolis
@@ -217,6 +225,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv)
real :: UHeff, VHeff ! More temporary variables [H L2 T-1 ~> m3 s-1 or kg s-1].
real :: QUHeff,QVHeff ! More temporary variables [H L2 T-2 ~> m3 s-2 or kg s-2].
integer :: i, j, k, n, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz
+ logical :: Stokes_VF
! To work, the following fields must be set outside of the usual
! is to ie range before this subroutine is called:
@@ -263,9 +272,14 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv)
(Area_h(i+1,j) + Area_h(i,j+1))
enddo ; enddo
+ Stokes_VF = .false.
+ if (present(Waves)) then ; if (associated(Waves)) then
+ Stokes_VF = Waves%Stokes_VF
+ endif ; endif
+
!$OMP parallel do default(private) shared(u,v,h,uh,vh,CAu,CAv,G,GV,CS,AD,Area_h,Area_q,&
!$OMP RV,PV,is,ie,js,je,Isq,Ieq,Jsq,Jeq,nz,vol_neglect,h_tiny,OBC,eps_vel, &
- !$OMP pbv)
+ !$OMP pbv, Stokes_VF)
do k=1,nz
! Here the second order accurate layer potential vorticities, q,
@@ -273,10 +287,34 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv)
! vorticity is second order accurate everywhere with free slip b.c.s,
! but only first order accurate at boundaries with no slip b.c.s.
! First calculate the contributions to the circulation around the q-point.
- do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
- dvdx(I,J) = (v(i+1,J,k)*G%dyCv(i+1,J) - v(i,J,k)*G%dyCv(i,J))
- dudy(I,J) = (u(I,j+1,k)*G%dxCu(I,j+1) - u(I,j,k)*G%dxCu(I,j))
- enddo ; enddo
+ if (Stokes_VF) then
+ if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then
+ do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
+ dvSdx(I,J) = ((-Waves%us_y(i+1,J,k))*G%dyCv(i+1,J) - &
+ (-Waves%us_y(i,J,k))*G%dyCv(i,J))
+ duSdy(I,J) = ((-Waves%us_x(I,j+1,k))*G%dxCu(I,j+1) - &
+ (-Waves%us_x(I,j,k))*G%dxCu(I,j))
+ enddo; enddo
+ endif
+ if (.not. Waves%Passive_Stokes_VF) then
+ do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
+ dvdx(I,J) = ((v(i+1,J,k)-Waves%us_y(i+1,J,k))*G%dyCv(i+1,J) - &
+ (v(i,J,k)-Waves%us_y(i,J,k))*G%dyCv(i,J))
+ dudy(I,J) = ((u(I,j+1,k)-Waves%us_x(I,j+1,k))*G%dxCu(I,j+1) - &
+ (u(I,j,k)-Waves%us_x(I,j,k))*G%dxCu(I,j))
+ enddo; enddo
+ else
+ do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
+ dvdx(I,J) = (v(i+1,J,k)*G%dyCv(i+1,J) - v(i,J,k)*G%dyCv(i,J))
+ dudy(I,J) = (u(I,j+1,k)*G%dxCu(I,j+1) - u(I,j,k)*G%dxCu(I,j))
+ enddo; enddo
+ endif
+ else
+ do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
+ dvdx(I,J) = (v(i+1,J,k)*G%dyCv(i+1,J) - v(i,J,k)*G%dyCv(i,J))
+ dudy(I,J) = (u(I,j+1,k)*G%dxCu(I,j+1) - u(I,j,k)*G%dxCu(I,j))
+ enddo; enddo
+ endif
do J=Jsq-1,Jeq+1 ; do i=Isq-1,Ieq+2
hArea_v(i,J) = 0.5*(Area_h(i,j) * h(i,j,k) + Area_h(i,j+1) * h(i,j+1,k))
enddo ; enddo
@@ -420,11 +458,25 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv)
if (CS%no_slip) then
do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
rel_vort(I,J) = (2.0 - G%mask2dBu(I,J)) * (dvdx(I,J) - dudy(I,J)) * G%IareaBu(I,J)
- enddo ; enddo
+ enddo; enddo
+ if (Stokes_VF) then
+ if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then
+ do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
+ stk_vort(I,J) = (2.0 - G%mask2dBu(I,J)) * (dvSdx(I,J) - duSdy(I,J)) * G%IareaBu(I,J)
+ enddo; enddo
+ endif
+ endif
else
do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
rel_vort(I,J) = G%mask2dBu(I,J) * (dvdx(I,J) - dudy(I,J)) * G%IareaBu(I,J)
- enddo ; enddo
+ enddo; enddo
+ if (Stokes_VF) then
+ if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then
+ do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
+ stk_vort(I,J) = (2.0 - G%mask2dBu(I,J)) * (dvSdx(I,J) - duSdy(I,J)) * G%IareaBu(I,J)
+ enddo; enddo
+ endif
+ endif
endif
do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
@@ -435,7 +487,15 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv)
hArea_q = (hArea_u(I,j) + hArea_u(I,j+1)) + (hArea_v(i,J) + hArea_v(i+1,J))
Ih_q(I,J) = Area_q(I,J) / (hArea_q + vol_neglect)
q(I,J) = abs_vort(I,J) * Ih_q(I,J)
- enddo ; enddo
+ enddo; enddo
+
+ if (Stokes_VF) then
+ if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then
+ do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
+ qS(I,J) = stk_vort(I,J) * Ih_q(I,J)
+ enddo; enddo
+ endif
+ endif
if (CS%id_rv > 0) then
do J=Jsq-1,Jeq+1 ; do I=Isq-1,Ieq+1
@@ -659,6 +719,17 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv)
(ep_u(i,j)*uh(I-1,j,k) - ep_u(i+1,j)*uh(I+1,j,k)) * G%IdxCu(I,j)
enddo ; enddo ; endif
+ if (Stokes_VF) then
+ if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then
+ ! Computing the diagnostic Stokes contribution to CAu
+ do j=js,je ; do I=Isq,Ieq
+ CAuS(I,j,k) = 0.25 * &
+ (qS(I,J) * (vh(i+1,J,k) + vh(i,J,k)) + &
+ qS(I,J-1) * (vh(i,J-1,k) + vh(i+1,J-1,k))) * G%IdxCu(I,j)
+ enddo ; enddo
+ endif
+ endif
+
if (CS%bound_Coriolis) then
do j=js,je ; do I=Isq,Ieq
fv1 = abs_vort(I,J) * v(i+1,J,k)
@@ -772,6 +843,17 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv)
(ep_v(i,j)*vh(i,J-1,k) - ep_v(i,j+1)*vh(i,J+1,k)) * G%IdyCv(i,J)
enddo ; enddo ; endif
+ if (Stokes_VF) then
+ if (CS%id_CAuS>0 .or. CS%id_CAvS>0) then
+ ! Computing the diagnostic Stokes contribution to CAv
+ do J=Jsq,Jeq ; do i=is,ie
+ CAvS(I,j,k) = 0.25 * &
+ (qS(I,J) * (uh(I,j+1,k) + uh(I,j,k)) + &
+ qS(I,J-1) * (uh(I-1,j,k) + uh(I-1,j+1,k))) * G%IdyCv(i,J)
+ enddo; enddo
+ endif
+ endif
+
if (CS%bound_Coriolis) then
do J=Jsq,Jeq ; do i=is,ie
fu1 = -abs_vort(I,J) * u(I,j+1,k)
@@ -848,6 +930,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv)
if (CS%id_gKEv>0) call post_data(CS%id_gKEv, AD%gradKEv, CS%diag)
if (CS%id_rvxu > 0) call post_data(CS%id_rvxu, AD%rv_x_u, CS%diag)
if (CS%id_rvxv > 0) call post_data(CS%id_rvxv, AD%rv_x_v, CS%diag)
+ if (Stokes_VF) then
+ if (CS%id_CAuS > 0) call post_data(CS%id_CAuS, CAuS, CS%diag)
+ if (CS%id_CAvS > 0) call post_data(CS%id_CAvS, CAvS, CS%diag)
+ endif
! Diagnostics for terms multiplied by fractional thicknesses
@@ -1124,6 +1210,14 @@ subroutine CoriolisAdv_init(Time, G, GV, US, param_file, diag, AD, CS)
CS%id_rvxv = register_diag_field('ocean_model', 'rvxv', diag%axesCuL, Time, &
'Zonal Acceleration from Relative Vorticity', 'm s-2', conversion=US%L_T2_to_m_s2)
+ CS%id_CAuS = register_diag_field('ocean_model', 'CAu_Stokes', diag%axesCuL, Time, &
+ 'Zonal Acceleration from Stokes Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2)
+ ! add to AD
+
+ CS%id_CAvS = register_diag_field('ocean_model', 'CAv_Stokes', diag%axesCvL, Time, &
+ 'Meridional Acceleration from Stokes Vorticity', 'm-1 s-2', conversion=US%L_T2_to_m_s2)
+ ! add to AD
+
!CS%id_hf_gKEu = register_diag_field('ocean_model', 'hf_gKEu', diag%axesCuL, Time, &
! 'Fractional Thickness-weighted Zonal Acceleration from Grad. Kinetic Energy', &
! 'm s-2', v_extensive=.true., conversion=US%L_T2_to_m_s2)
diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90
index 2a79486a5f..d50ce4b364 100644
--- a/src/core/MOM_PressureForce_FV.F90
+++ b/src/core/MOM_PressureForce_FV.F90
@@ -58,11 +58,12 @@ module MOM_PressureForce_FV
integer :: Recon_Scheme !< Order of the polynomial of the reconstruction of T & S
!! for the finite volume pressure gradient calculation.
!! By the default (1) is for a piecewise linear method
- real :: Stanley_T2_det_coeff !< The coefficient correlating SGS temperature variance with
- !! the mean temperature gradient in the deterministic part of
- !! the Stanley form of the Brankart correction.
+
+ logical :: use_stanley_pgf !< If true, turn on Stanley parameterization in the PGF
integer :: id_e_tidal = -1 !< Diagnostic identifier
- integer :: id_tvar_sgs = -1 !< Diagnostic identifier
+ integer :: id_rho_pgf = -1 !< Diagnostic identifier
+ integer :: id_rho_stanley_pgf = -1 !< Diagnostic identifier
+ integer :: id_p_stanley = -1 !< Diagnostic identifier
type(tidal_forcing_CS), pointer :: tides_CSp => NULL() !< Tides control structure
end type PressureForce_FV_CS
@@ -167,7 +168,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_
if (.not.CS%initialized) call MOM_error(FATAL, &
"MOM_PressureForce_FV_nonBouss: Module must be initialized before it is used.")
- if (CS%Stanley_T2_det_coeff>=0.) call MOM_error(FATAL, &
+ if (CS%use_stanley_pgf) call MOM_error(FATAL, &
"MOM_PressureForce_FV_nonBouss: The Stanley parameterization is not yet"//&
"implemented in non-Boussinesq mode.")
@@ -473,6 +474,13 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: &
S_t, S_b, T_t, T_b ! Top and bottom edge values for linear reconstructions
! of salinity and temperature within each layer.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: &
+ rho_pgf, rho_stanley_pgf ! Density [kg m-3] from EOS with and without SGS T variance
+ ! in Stanley parameterization.
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: &
+ p_stanley ! Pressure [Pa] estimated with Rho_0
+ real :: rho_stanley_scalar ! Scalar quantity to hold density [kg m-3] in Stanley diagnostics.
+ real :: p_stanley_scalar ! Scalar quantity to hold pressure [Pa] in Stanley diagnostics.
real :: rho_in_situ(SZI_(G)) ! The in situ density [R ~> kg m-3].
real :: p_ref(SZI_(G)) ! The pressure used to calculate the coordinate
! density, [R L2 T-2 ~> Pa] (usually 2e7 Pa = 2000 dbar).
@@ -487,11 +495,6 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm
logical :: use_ALE ! If true, use an ALE pressure reconstruction.
logical :: use_EOS ! If true, density is calculated from T & S using an equation of state.
type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S.
- real :: Tl(5) ! copy and T in local stencil [degC]
- real :: mn_T ! mean of T in local stencil [degC]
- real :: mn_T2 ! mean of T**2 in local stencil [degC2]
- real :: hl(5) ! Copy of local stencil of H [H ~> m]
- real :: r_sm_H ! Reciprocal of sum of H in local stencil [H-1 ~> m-1]
real, parameter :: C1_6 = 1.0/6.0
integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state
integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb
@@ -511,49 +514,6 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm
use_ALE = .false.
if (associated(ALE_CSp)) use_ALE = CS%reconstruct .and. use_EOS
- if (CS%Stanley_T2_det_coeff>=0.) then
- if (.not. associated(tv%varT)) call safe_alloc_ptr(tv%varT, G%isd, G%ied, G%jsd, G%jed, GV%ke)
- do k=1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1
- ! Strictly speaking we should estimate the *horizontal* grid-scale variance
- ! but neither of the following blocks make a rotation to the horizontal
- ! and instead work along coordinate.
-
- ! This block calculates a simple |delta T| along coordinates and does
- ! not allow vanishing layer thicknesses or layers tracking topography
- !! SGS variance in i-direction [degC2]
- !dTdi2 = ( ( G%mask2dCu(I ,j) * G%IdxCu(I ,j) * ( tv%T(i+1,j,k) - tv%T(i,j,k) ) &
- ! + G%mask2dCu(I-1,j) * G%IdxCu(I-1,j) * ( tv%T(i,j,k) - tv%T(i-1,j,k) ) &
- ! ) * G%dxT(i,j) * 0.5 )**2
- !! SGS variance in j-direction [degC2]
- !dTdj2 = ( ( G%mask2dCv(i,J ) * G%IdyCv(i,J ) * ( tv%T(i,j+1,k) - tv%T(i,j,k) ) &
- ! + G%mask2dCv(i,J-1) * G%IdyCv(i,J-1) * ( tv%T(i,j,k) - tv%T(i,j-1,k) ) &
- ! ) * G%dyT(i,j) * 0.5 )**2
- !tv%varT(i,j,k) = CS%Stanley_T2_det_coeff * 0.5 * ( dTdi2 + dTdj2 )
-
- ! This block does a thickness weighted variance calculation and helps control for
- ! extreme gradients along layers which are vanished against topography. It is
- ! still a poor approximation in the interior when coordinates are strongly tilted.
- hl(1) = h(i,j,k) * G%mask2dT(i,j)
- hl(2) = h(i-1,j,k) * G%mask2dCu(I-1,j)
- hl(3) = h(i+1,j,k) * G%mask2dCu(I,j)
- hl(4) = h(i,j-1,k) * G%mask2dCv(i,J-1)
- hl(5) = h(i,j+1,k) * G%mask2dCv(i,J)
- r_sm_H = 1. / ( ( hl(1) + ( ( hl(2) + hl(3) ) + ( hl(4) + hl(5) ) ) ) + GV%H_subroundoff )
- ! Mean of T
- Tl(1) = tv%T(i,j,k) ; Tl(2) = tv%T(i-1,j,k) ; Tl(3) = tv%T(i+1,j,k)
- Tl(4) = tv%T(i,j-1,k) ; Tl(5) = tv%T(i,j+1,k)
- mn_T = ( hl(1)*Tl(1) + ( ( hl(2)*Tl(2) + hl(3)*Tl(3) ) + ( hl(4)*Tl(4) + hl(5)*Tl(5) ) ) ) * r_sm_H
- ! Adjust T vectors to have zero mean
- Tl(:) = Tl(:) - mn_T ; mn_T = 0.
- ! Variance of T
- mn_T2 = ( hl(1)*Tl(1)*Tl(1) + ( ( hl(2)*Tl(2)*Tl(2) + hl(3)*Tl(3)*Tl(3) ) &
- + ( hl(4)*Tl(4)*Tl(4) + hl(5)*Tl(5)*Tl(5) ) ) ) * r_sm_H
- ! Variance should be positive but round-off can violate this. Calculating
- ! variance directly would fix this but requires more operations.
- tv%varT(i,j,k) = CS%Stanley_T2_det_coeff * max(0., mn_T2)
- enddo ; enddo ; enddo
- endif
-
h_neglect = GV%H_subroundoff
dz_neglect = GV%H_subroundoff * GV%H_to_Z
I_Rho0 = 1.0 / GV%Rho0
@@ -690,7 +650,6 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm
do k=1,nz
! Calculate 4 integrals through the layer that are required in the
! subsequent calculation.
-
if (use_EOS) then
! The following routine computes the integrals that are needed to
! calculate the pressure gradient force. Linear profiles for T and S are
@@ -701,13 +660,13 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm
if ( CS%Recon_Scheme == 1 ) then
call int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, &
rho_ref, CS%Rho0, GV%g_Earth, dz_neglect, G%bathyT, &
- G%HI, GV, tv%eqn_of_state, US, dpa, intz_dpa, intx_dpa, inty_dpa, &
+ G%HI, GV, tv%eqn_of_state, US, CS%use_stanley_pgf, dpa, intz_dpa, intx_dpa, inty_dpa, &
useMassWghtInterp=CS%useMassWghtInterp, &
use_inaccurate_form=CS%use_inaccurate_pgf_rho_anom, Z_0p=G%Z_ref)
elseif ( CS%Recon_Scheme == 2 ) then
call int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, &
rho_ref, CS%Rho0, GV%g_Earth, dz_neglect, G%bathyT, &
- G%HI, GV, tv%eqn_of_state, US, dpa, intz_dpa, intx_dpa, inty_dpa, &
+ G%HI, GV, tv%eqn_of_state, US, CS%use_stanley_pgf, dpa, intz_dpa, intx_dpa, inty_dpa, &
useMassWghtInterp=CS%useMassWghtInterp, Z_0p=G%Z_ref)
endif
else
@@ -797,8 +756,26 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm
endif
endif
+ if (CS%use_stanley_pgf) then
+ do j=js,je ; do i=is,ie ;
+ p_stanley_scalar=0.0
+ do k=1, nz
+ p_stanley_scalar = p_stanley_scalar + 0.5 * h(i,j,k) * GV%H_to_Pa !Pressure at mid-point of layer
+ call calculate_density(tv%T(i,j,k), tv%S(i,j,k), p_stanley_scalar, 0.0, 0.0, 0.0, &
+ rho_stanley_scalar, tv%eqn_of_state)
+ rho_pgf(i,j,k) = rho_stanley_scalar
+ call calculate_density(tv%T(i,j,k), tv%S(i,j,k), p_stanley_scalar, tv%varT(i,j,k), 0.0, 0.0, &
+ rho_stanley_scalar, tv%eqn_of_state)
+ rho_stanley_pgf(i,j,k) = rho_stanley_scalar
+ p_stanley(i,j,k) = p_stanley_scalar
+ p_stanley_scalar = p_stanley_scalar + 0.5 * h(i,j,k) * GV%H_to_Pa !Pressure at bottom of layer
+ enddo; enddo; enddo
+ endif
+
if (CS%id_e_tidal>0) call post_data(CS%id_e_tidal, e_tidal, CS%diag)
- if (CS%id_tvar_sgs>0) call post_data(CS%id_tvar_sgs, tv%varT, CS%diag)
+ if (CS%id_rho_pgf>0) call post_data(CS%id_rho_pgf, rho_pgf, CS%diag)
+ if (CS%id_rho_stanley_pgf>0) call post_data(CS%id_rho_stanley_pgf, rho_stanley_pgf, CS%diag)
+ if (CS%id_p_stanley>0) call post_data(CS%id_p_stanley, p_stanley, CS%diag)
end subroutine PressureForce_FV_Bouss
@@ -859,14 +836,16 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, tides_CS
"boundary cells is extrapolated, rather than using PCM "//&
"in these cells. If true, the same order polynomial is "//&
"used as is used for the interior cells.", default=.true.)
- call get_param(param_file, mdl, "PGF_STANLEY_T2_DET_COEFF", CS%Stanley_T2_det_coeff, &
- "The coefficient correlating SGS temperature variance with "// &
- "the mean temperature gradient in the deterministic part of "// &
- "the Stanley form of the Brankart correction. "// &
- "Negative values disable the scheme.", units="nondim", default=-1.0)
- if (CS%Stanley_T2_det_coeff>=0.) then
- CS%id_tvar_sgs = register_diag_field('ocean_model', 'tvar_sgs_pgf', diag%axesTL, &
- Time, 'SGS temperature variance used in PGF', 'degC2')
+ call get_param(param_file, mdl, "USE_STANLEY_PGF", CS%use_stanley_pgf, &
+ "If true, turn on Stanley SGS T variance parameterization "// &
+ "in PGF code.", default=.false.)
+ if (CS%use_stanley_pgf) then
+ CS%id_rho_pgf = register_diag_field('ocean_model', 'rho_pgf', diag%axesTL, &
+ Time, 'rho in PGF', 'kg m3')
+ CS%id_rho_stanley_pgf = register_diag_field('ocean_model', 'rho_stanley_pgf', diag%axesTL, &
+ Time, 'rho in PGF with Stanley correction', 'kg m3')
+ CS%id_p_stanley = register_diag_field('ocean_model', 'p_stanley', diag%axesTL, &
+ Time, 'p in PGF with Stanley correction', 'Pa')
endif
if (CS%tides) then
CS%id_e_tidal = register_diag_field('ocean_model', 'e_tidal', diag%axesT1, &
diff --git a/src/core/MOM_density_integrals.F90 b/src/core/MOM_density_integrals.F90
index 4b7ba9454a..7950cff185 100644
--- a/src/core/MOM_density_integrals.F90
+++ b/src/core/MOM_density_integrals.F90
@@ -337,7 +337,7 @@ end subroutine int_density_dz_generic_pcm
!> Compute pressure gradient force integrals by quadrature for the case where
!! T and S are linear profiles.
subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, &
- rho_0, G_e, dz_subroundoff, bathyT, HI, GV, EOS, US, dpa, &
+ rho_0, G_e, dz_subroundoff, bathyT, HI, GV, EOS, US, use_stanley_eos, dpa, &
intz_dpa, intx_dpa, inty_dpa, useMassWghtInterp, &
use_inaccurate_form, Z_0p)
integer, intent(in) :: k !< Layer index to calculate integrals for
@@ -364,6 +364,7 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, &
intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m]
type(EOS_type), intent(in) :: EOS !< Equation of state structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ logical, intent(in) :: use_stanley_eos !< If true, turn on Stanley SGS T variance parameterization
real, dimension(SZI_(HI),SZJ_(HI)), &
intent(inout) :: dpa !< The change in the pressure anomaly across the layer [R L2 T-2 ~> Pa]
real, dimension(SZI_(HI),SZJ_(HI)), &
@@ -435,7 +436,6 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, &
real :: hWght ! A topographically limited thickness weight [Z ~> m]
real :: hL, hR ! Thicknesses to the left and right [Z ~> m]
real :: iDenom ! The denominator of the thickness weight expressions [Z-2 ~> m-2]
- logical :: use_stanley_eos ! True is SGS variance fields exist in tv.
logical :: use_rho_ref ! Pass rho_ref to the equation of state for more accurate calculation
! of density anomalies.
logical :: use_varT, use_varS, use_covarTS ! Logicals for SGS variances fields
@@ -458,10 +458,15 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, &
if (use_inaccurate_form) use_rho_ref = .not. use_inaccurate_form
endif
- use_varT = associated(tv%varT)
- use_covarTS = associated(tv%covarTS)
- use_varS = associated(tv%varS)
- use_stanley_eos = use_varT .or. use_covarTS .or. use_varS
+ use_varT = .false. !ensure initialized
+ use_covarTS = .false.
+ use_varS = .false.
+ if (use_stanley_eos) then
+ use_varT = associated(tv%varT)
+ use_covarTS = associated(tv%covarTS)
+ use_varS = associated(tv%varS)
+ endif
+
T25(:) = 0.
TS5(:) = 0.
S25(:) = 0.
@@ -488,7 +493,7 @@ subroutine int_density_dz_generic_plm(k, tv, T_t, T_b, S_t, S_b, e, rho_ref, &
if (use_covarTS) TS5(i*5+1:i*5+5) = tv%covarTS(i,j,k)
if (use_varS) S25(i*5+1:i*5+5) = tv%varS(i,j,k)
enddo
- if (use_Stanley_eos) then
+ if (use_stanley_eos) then
if (rho_scale /= 1.0) then
call calculate_density(T5, S5, p5, T25, TS5, S25, r5, 1, (ieq-isq+2)*5, EOS, &
rho_ref=rho_ref_mks, scale=rho_scale)
@@ -780,7 +785,7 @@ end subroutine int_density_dz_generic_plm
!> Compute pressure gradient force integrals for layer "k" and the case where T and S
!! are parabolic profiles
subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, &
- rho_ref, rho_0, G_e, dz_subroundoff, bathyT, HI, GV, EOS, US, &
+ rho_ref, rho_0, G_e, dz_subroundoff, bathyT, HI, GV, EOS, US, use_stanley_eos, &
dpa, intz_dpa, intx_dpa, inty_dpa, useMassWghtInterp, Z_0p)
integer, intent(in) :: k !< Layer index to calculate integrals for
type(hor_index_type), intent(in) :: HI !< Ocean horizontal index structures for the input arrays
@@ -806,6 +811,7 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, &
intent(in) :: bathyT !< The depth of the bathymetry [Z ~> m]
type(EOS_type), intent(in) :: EOS !< Equation of state structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
+ logical, intent(in) :: use_stanley_eos !< If true, turn on Stanley SGS T variance parameterization
real, dimension(SZI_(HI),SZJ_(HI)), &
intent(inout) :: dpa !< The change in the pressure anomaly across the layer [R L2 T-2 ~> Pa]
real, dimension(SZI_(HI),SZJ_(HI)), &
@@ -867,7 +873,6 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, &
real :: iDenom ! The denominator of the thickness weight expressions [Z-2 ~> m-2]
integer :: Isq, Ieq, Jsq, Jeq, i, j, m, n
logical :: use_PPM ! If false, assume zero curvature in reconstruction, i.e. PLM
- logical :: use_stanley_eos ! True is SGS variance fields exist in tv.
logical :: use_varT, use_varS, use_covarTS
Isq = HI%IscB ; Ieq = HI%IecB ; Jsq = HI%JscB ; Jeq = HI%JecB
@@ -887,10 +892,15 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, &
t6 = 0.
use_PPM = .true. ! This is a place-holder to allow later re-use of this function
- use_varT = associated(tv%varT)
- use_covarTS = associated(tv%covarTS)
- use_varS = associated(tv%varS)
- use_stanley_eos = use_varT .or. use_covarTS .or. use_varS
+ use_varT = .false. !ensure initialized
+ use_covarTS = .false.
+ use_varS = .false.
+ if (use_stanley_eos) then
+ use_varT = associated(tv%varT)
+ use_covarTS = associated(tv%covarTS)
+ use_varS = associated(tv%varS)
+ endif
+
T25(:) = 0.
TS5(:) = 0.
S25(:) = 0.
@@ -1002,7 +1012,6 @@ subroutine int_density_dz_generic_ppm(k, tv, T_t, T_b, S_t, S_b, e, &
S5(n) = wt_t(n) * S_top + wt_b(n) * ( S_bot + s6 * wt_t(n) )
T5(n) = wt_t(n) * T_top + wt_b(n) * ( T_bot + t6 * wt_t(n) )
enddo
-
if (use_stanley_eos) then
if (use_varT) T25(:) = w_left*tv%varT(i,j,k) + w_right*tv%varT(i+1,j,k)
if (use_covarTS) TS5(:) = w_left*tv%covarTS(i,j,k) + w_right*tv%covarTS(i+1,j,k)
diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90
index e78209b5ff..003033659e 100644
--- a/src/core/MOM_dynamics_split_RK2.F90
+++ b/src/core/MOM_dynamics_split_RK2.F90
@@ -67,7 +67,7 @@ module MOM_dynamics_split_RK2
use MOM_vert_friction, only : updateCFLtruncationValue
use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units
use MOM_verticalGrid, only : get_flux_units, get_tr_flux_units
-use MOM_wave_interface, only: wave_parameters_CS
+use MOM_wave_interface, only: wave_parameters_CS, Stokes_PGF
implicit none ; private
@@ -78,11 +78,13 @@ module MOM_dynamics_split_RK2
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: &
CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2]
PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2]
+ PFu_Stokes, & !< PFu_Stokes = -d/dx int_r (u_L*duS/dr) [L T-2 ~> m s-2]
diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]
real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: &
CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2]
PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2]
+ PFv_Stokes, & !< PFv_Stokes = -d/dy int_r (v_L*dvS/dr) [L T-2 ~> m s-2]
diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2]
real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: visc_rem_u
@@ -355,6 +357,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
logical :: BT_cont_BT_thick ! If true, use the BT_cont_type to estimate the
! relative weightings of the layers in calculating
! the barotropic accelerations.
+ logical :: Use_Stokes_PGF ! If true, add Stokes PGF to hydrostatic PGF
!---For group halo pass
logical :: showCallTree, sym
@@ -452,6 +455,31 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
eta_PF_start(i,j) = CS%eta_PF(i,j) - pres_to_eta * (p_surf_begin(i,j) - p_surf_end(i,j))
enddo ; enddo
endif
+ ! Stokes shear force contribution to pressure gradient
+ Use_Stokes_PGF = present(Waves)
+ if (Use_Stokes_PGF) then
+ Use_Stokes_PGF = associated(Waves)
+ if (Use_Stokes_PGF) Use_Stokes_PGF = Waves%Stokes_PGF
+ if (Use_Stokes_PGF) then
+ call Stokes_PGF(G, GV, h, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves)
+
+ ! We are adding Stokes_PGF to hydrostatic PGF here. The diag PFu/PFv
+ ! will therefore report the sum total PGF and we avoid other
+ ! modifications in the code. The PFu_Stokes is output within the waves routines.
+ if (.not.Waves%Passive_Stokes_PGF) then
+ do k=1,nz
+ do j=js,je ; do I=Isq,Ieq
+ CS%PFu(I,j,k) = CS%PFu(I,j,k) + CS%PFu_Stokes(I,j,k)
+ enddo ; enddo
+ enddo
+ do k=1,nz
+ do J=Jsq,Jeq ; do i=is,ie
+ CS%PFv(i,J,k) = CS%PFv(i,J,k) + CS%PFv_Stokes(i,J,k)
+ enddo ; enddo
+ enddo
+ endif
+ endif
+ endif
call cpu_clock_end(id_clock_pres)
call disable_averaging(CS%diag)
if (showCallTree) call callTree_wayPoint("done with PressureForce (step_MOM_dyn_split_RK2)")
@@ -468,7 +496,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av
call cpu_clock_begin(id_clock_Cor)
call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, &
- G, Gv, US, CS%CoriolisAdv, pbv)
+ G, Gv, US, CS%CoriolisAdv, pbv, Waves=Waves)
call cpu_clock_end(id_clock_Cor)
if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)")
@@ -687,6 +715,27 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
call cpu_clock_begin(id_clock_pres)
call PressureForce(hp, tv, CS%PFu, CS%PFv, G, GV, US, CS%PressureForce_CSp, &
CS%ALE_CSp, p_surf, CS%pbce, CS%eta_PF)
+ ! Stokes shear force contribution to pressure gradient
+ Use_Stokes_PGF = present(Waves)
+ if (Use_Stokes_PGF) then
+ Use_Stokes_PGF = associated(Waves)
+ if (Use_Stokes_PGF) Use_Stokes_PGF = Waves%Stokes_PGF
+ if (Use_Stokes_PGF) then
+ call Stokes_PGF(G, GV, h, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves)
+ if (.not.Waves%Passive_Stokes_PGF) then
+ do k=1,nz
+ do j=js,je ; do I=Isq,Ieq
+ CS%PFu(I,j,k) = CS%PFu(I,j,k) + CS%PFu_Stokes(I,j,k)
+ enddo ; enddo
+ enddo
+ do k=1,nz
+ do J=Jsq,Jeq ; do i=is,ie
+ CS%PFv(i,J,k) = CS%PFv(i,J,k) + CS%PFv_Stokes(i,J,k)
+ enddo ; enddo
+ enddo
+ endif
+ endif
+ endif
call cpu_clock_end(id_clock_pres)
if (showCallTree) call callTree_wayPoint("done with PressureForce[hp=(1-b).h+b.h] (step_MOM_dyn_split_RK2)")
endif
@@ -721,7 +770,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s
! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av
call cpu_clock_begin(id_clock_Cor)
call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, &
- G, GV, US, CS%CoriolisAdv, pbv)
+ G, GV, US, CS%CoriolisAdv, pbv, Waves=Waves)
call cpu_clock_end(id_clock_Cor)
if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)")
@@ -1187,6 +1236,8 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param
ALLOC_(CS%u_accel_bt(IsdB:IedB,jsd:jed,nz)) ; CS%u_accel_bt(:,:,:) = 0.0
ALLOC_(CS%v_accel_bt(isd:ied,JsdB:JedB,nz)) ; CS%v_accel_bt(:,:,:) = 0.0
+ ALLOC_(CS%PFu_Stokes(IsdB:IedB,jsd:jed,nz)) ; CS%PFu_Stokes(:,:,:) = 0.0
+ ALLOC_(CS%PFv_Stokes(isd:ied,JsdB:JedB,nz)) ; CS%PFv_Stokes(:,:,:) = 0.0
MIS%diffu => CS%diffu
MIS%diffv => CS%diffv
diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90
index 227623f5eb..768dfd628c 100644
--- a/src/core/MOM_forcing_type.F90
+++ b/src/core/MOM_forcing_type.F90
@@ -99,27 +99,27 @@ module MOM_forcing_type
! water mass fluxes into the ocean [R Z T-1 ~> kg m-2 s-1]; these fluxes impact the ocean mass
real, pointer, dimension(:,:) :: &
- evap => NULL(), & !< (-1)*fresh water flux evaporated out of the ocean [R Z T-1 ~> kg m-2 s-1]
- lprec => NULL(), & !< precipitating liquid water into the ocean [R Z T-1 ~> kg m-2 s-1]
- fprec => NULL(), & !< precipitating frozen water into the ocean [R Z T-1 ~> kg m-2 s-1]
- vprec => NULL(), & !< virtual liquid precip associated w/ SSS restoring [R Z T-1 ~> kg m-2 s-1]
- lrunoff => NULL(), & !< liquid river runoff entering ocean [R Z T-1 ~> kg m-2 s-1]
- frunoff => NULL(), & !< frozen river runoff (calving) entering ocean [R Z T-1 ~> kg m-2 s-1]
- seaice_melt => NULL() !< snow/seaice melt (positive) or formation (negative) [R Z T-1 ~> kg m-2 s-1]
+ evap => NULL(), & !< (-1)*fresh water flux evaporated out of the ocean [R Z T-1 ~> kg m-2 s-1]
+ lprec => NULL(), & !< precipitating liquid water into the ocean [R Z T-1 ~> kg m-2 s-1]
+ fprec => NULL(), & !< precipitating frozen water into the ocean [R Z T-1 ~> kg m-2 s-1]
+ vprec => NULL(), & !< virtual liquid precip associated w/ SSS restoring [R Z T-1 ~> kg m-2 s-1]
+ lrunoff => NULL(), & !< liquid river runoff entering ocean [R Z T-1 ~> kg m-2 s-1]
+ frunoff => NULL(), & !< frozen river runoff (calving) entering ocean [R Z T-1 ~> kg m-2 s-1]
+ seaice_melt => NULL() !< snow/seaice melt (positive) or formation (negative) [R Z T-1 ~> kg m-2 s-1]
! Integrated water mass fluxes into the ocean, used for passive tracer sources [H ~> m or kg m-2]
real, pointer, dimension(:,:) :: &
- netMassIn => NULL(), & !< Sum of water mass fluxes into the ocean integrated over a
- !! forcing timestep [H ~> m or kg m-2]
- netMassOut => NULL() !< Net water mass flux out of the ocean integrated over a forcing timestep,
- !! with negative values for water leaving the ocean [H ~> m or kg m-2]
+ netMassIn => NULL(), & !< Sum of water mass fluxes into the ocean integrated over a
+ !! forcing timestep [H ~> m or kg m-2]
+ netMassOut => NULL(), & !< Net water mass flux out of the ocean integrated over a forcing timestep,
+ !! with negative values for water leaving the ocean [H ~> m or kg m-2]
+ KPP_salt_flux => NULL() !< KPP effective salt flux [ppt m s-1]
! heat associated with water crossing ocean surface
real, pointer, dimension(:,:) :: &
heat_content_cond => NULL(), & !< heat content associated with condensating water [Q R Z T-1 ~> W m-2]
+ heat_content_evap => NULL(), & !< heat content associated with evaporating water [Q R Z T-1 ~> W m-2]
heat_content_lprec => NULL(), & !< heat content associated with liquid >0 precip [Q R Z T-1 ~> W m-2]
- heat_content_icemelt => NULL(), & !< heat content associated with snow and seaice
- !! melt and formation [Q R Z T-1 ~> W m-2]
heat_content_fprec => NULL(), & !< heat content associated with frozen precip [Q R Z T-1 ~> W m-2]
heat_content_vprec => NULL(), & !< heat content associated with virtual >0 precip [Q R Z T-1 ~> W m-2]
heat_content_lrunoff => NULL(), & !< heat content associated with liquid runoff [Q R Z T-1 ~> W m-2]
@@ -193,8 +193,8 @@ module MOM_forcing_type
! CFC-related arrays needed in the MOM_CFC_cap module
real, pointer, dimension(:,:) :: &
- cfc11_flux => NULL(), & !< flux of cfc_11 into the ocean [CU R Z T-1 kg m-3 ~> mol m-2 s-1]
- cfc12_flux => NULL(), & !< flux of cfc_12 into the ocean [CU R Z T-1 kg m-3 ~> mol m-2 s-1]
+ cfc11_flux => NULL(), & !< flux of cfc_11 into the ocean [CU R Z T-1 ~> mol m-2 s-1]
+ cfc12_flux => NULL(), & !< flux of cfc_12 into the ocean [CU R Z T-1 ~> mol m-2 s-1]
ice_fraction => NULL(), & !< fraction of sea ice coverage at h-cells, from 0 to 1 [nondim].
u10_sqr => NULL() !< wind magnitude at 10 m squared [L2 T-2 ~> m2 s-2]
@@ -264,9 +264,6 @@ module MOM_forcing_type
logical :: accumulate_rigidity = .false. !< If true, the rigidity due to various types of
!! ice needs to be accumulated, and the rigidity explicitly
!! reset to zero at the driver level when appropriate.
- real, pointer, dimension(:,:) :: &
- ustk0 => NULL(), & !< Surface Stokes drift, zonal [m s-1]
- vstk0 => NULL() !< Surface Stokes drift, meridional [m s-1]
real, pointer, dimension(:) :: &
stk_wavenumbers => NULL() !< The central wave number of Stokes bands [rad m-1]
real, pointer, dimension(:,:,:) :: &
@@ -316,10 +313,11 @@ module MOM_forcing_type
integer :: id_heat_content_lrunoff= -1, id_heat_content_frunoff = -1
integer :: id_heat_content_lprec = -1, id_heat_content_fprec = -1
integer :: id_heat_content_cond = -1, id_heat_content_surfwater= -1
+ integer :: id_heat_content_evap = -1
integer :: id_heat_content_vprec = -1, id_heat_content_massout = -1
integer :: id_heat_added = -1, id_heat_content_massin = -1
integer :: id_hfrainds = -1, id_hfrunoffds = -1
- integer :: id_seaice_melt_heat = -1, id_heat_content_icemelt = -1
+ integer :: id_seaice_melt_heat = -1
! global area integrated heat flux diagnostic handles
integer :: id_total_net_heat_coupler = -1, id_total_net_heat_surface = -1
@@ -330,9 +328,10 @@ module MOM_forcing_type
integer :: id_total_heat_content_lrunoff= -1, id_total_heat_content_frunoff = -1
integer :: id_total_heat_content_lprec = -1, id_total_heat_content_fprec = -1
integer :: id_total_heat_content_cond = -1, id_total_heat_content_surfwater= -1
+ integer :: id_total_heat_content_evap = -1
integer :: id_total_heat_content_vprec = -1, id_total_heat_content_massout = -1
integer :: id_total_heat_added = -1, id_total_heat_content_massin = -1
- integer :: id_total_seaice_melt_heat = -1, id_total_heat_content_icemelt = -1
+ integer :: id_total_seaice_melt_heat = -1
! global area averaged heat flux diagnostic handles
integer :: id_net_heat_coupler_ga = -1, id_net_heat_surface_ga = -1
@@ -472,6 +471,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, &
real :: I_Cp_Hconvert ! Unit conversion factors divided by the heat capacity
! [degC H R-1 Z-1 Q-1 ~> degC m3 J-1 or kg degC J-1]
logical :: calculate_diags ! Indicate to calculate/update diagnostic arrays
+ logical :: do_enthalpy ! If true (default) enthalpy terms are computed in MOM6
character(len=200) :: mesg
integer :: is, ie, nz, i, k, n
@@ -491,6 +491,13 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, &
if (present(pen_sw_bnd_rate)) do_PSWBR = .true.
!}BGR
+ ! GMM: by default heat content from mass entering and leaving the ocean (enthalpy)
+ ! is diagnosed in this subroutine. When heat_content_evap is associated,
+ ! the enthalpy terms are provided via coupler and, therefore, they do not need
+ ! to be computed again.
+ do_enthalpy = .true.
+ if (associated(fluxes%heat_content_evap)) do_enthalpy = .false.
+
Ih_limit = 0.0 ; if (FluxRescaleDepth > 0.0) Ih_limit = 1.0 / FluxRescaleDepth
I_Cp = 1.0 / fluxes%C_p
I_Cp_Hconvert = 1.0 / (GV%H_to_RZ * fluxes%C_p)
@@ -601,7 +608,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, &
! evap > 0 means condensating water is added into ocean.
! evap < 0 means evaporation of water from the ocean, in
- ! which case heat_content_evap is computed in MOM_diabatic_driver.F90
+ ! which case heat_content_massout is computed in MOM_diabatic_driver.F90
if (fluxes%evap(i,j) < 0.0) netMassOut(i) = netMassOut(i) + fluxes%evap(i,j)
! if (associated(fluxes%heat_content_cond)) fluxes%heat_content_cond(i,j) = 0.0 !??? --AJA
@@ -627,6 +634,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, &
! (H=m for Bouss, H=kg/m2 for non-Bouss)
! CIME provides heat flux from snow&ice melt (seaice_melt_heat), so this is added below
+ ! Note: this term accounts for the enthalpy associated with water flux due to sea ice melting/freezing
if (associated(fluxes%seaice_melt_heat)) then
net_heat(i) = scale * dt * I_Cp_Hconvert * &
( fluxes%sw(i,j) + (((fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j)) + &
@@ -699,6 +707,14 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, &
! (fluxes%heat_content_cond(i,j) + fluxes%heat_content_vprec(i,j))))))
! endif
+ ! When enthalpy terms are provided via coupler, they must be included in net_heat
+ if (.not. do_enthalpy) then
+ net_heat(i) = net_heat(i) + (scale * dt * I_Cp_Hconvert * &
+ (fluxes%heat_content_lrunoff(i,j) + fluxes%heat_content_frunoff(i,j) + &
+ fluxes%heat_content_lprec(i,j) + fluxes%heat_content_fprec(i,j) + &
+ fluxes%heat_content_evap(i,j) + fluxes%heat_content_cond(i,j)))
+ endif
+
if (fluxes%num_msg < fluxes%max_msg) then
if (Pen_SW_tot(i) > 1.000001 * I_Cp_Hconvert*scale*dt*fluxes%sw(i,j)) then
fluxes%num_msg = fluxes%num_msg + 1
@@ -735,7 +751,7 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, &
endif
! Diagnostics follow...
- if (calculate_diags) then
+ if (calculate_diags .and. do_enthalpy) then
! Initialize heat_content_massin that is diagnosed in mixedlayer_convection or
! applyBoundaryFluxes such that the meaning is as the sum of all incoming components.
@@ -793,15 +809,6 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, &
endif
endif
- ! Following lprec and fprec, water flux due to sea ice melt (seaice_melt) enters at SST - GMM
- if (associated(fluxes%heat_content_icemelt)) then
- if (fluxes%seaice_melt(i,j) > 0.0) then
- fluxes%heat_content_icemelt(i,j) = fluxes%C_p*fluxes%seaice_melt(i,j)*T(i,1)
- else
- fluxes%heat_content_icemelt(i,j) = 0.0
- endif
- endif
-
! virtual precip associated with salinity restoring
! vprec > 0 means add water to ocean, assumed to be at SST
! vprec < 0 means remove water from ocean; set heat_content_vprec in MOM_diabatic_driver.F90
@@ -841,7 +848,31 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, &
endif
endif
- endif ! calculate_diags
+ elseif (.not. do_enthalpy) then
+
+ ! virtual precip associated with salinity restoring. Heat content associated with
+ ! that is *not* provided by the coupler and must be calculated by MOM6.
+ ! vprec > 0 means add water to ocean, assumed to be at SST
+ ! vprec < 0 means remove water from ocean; set heat_content_vprec in MOM_diabatic_driver.F90
+ if (associated(fluxes%heat_content_vprec)) then
+ if (fluxes%vprec(i,j) > 0.0) then
+ fluxes%heat_content_vprec(i,j) = fluxes%C_p*fluxes%vprec(i,j)*T(i,1)
+ else
+ fluxes%heat_content_vprec(i,j) = 0.0
+ endif
+ endif
+
+ if (associated(tv%TempxPmE)) then
+ tv%TempxPmE(i,j) = (I_Cp*dt*scale) * &
+ (fluxes%heat_content_lprec(i,j) + &
+ fluxes%heat_content_fprec(i,j) + &
+ fluxes%heat_content_lrunoff(i,j) + &
+ fluxes%heat_content_frunoff(i,j) + &
+ fluxes%heat_content_evap(i,j) + &
+ fluxes%heat_content_cond(i,j))
+ endif
+
+ endif ! calculate_diags and do_enthalpy
enddo ! i-loop
@@ -1022,6 +1053,7 @@ subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv,
!! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1]
real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: netSalt !< Net surface salt flux
!! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1]
+
! local variables
integer :: j
@@ -1123,15 +1155,18 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift)
if (associated(fluxes%heat_content_fprec)) &
call hchksum(fluxes%heat_content_fprec, mesg//" fluxes%heat_content_fprec", G%HI, &
haloshift=hshift, scale=US%QRZ_T_to_W_m2)
- if (associated(fluxes%heat_content_icemelt)) &
- call hchksum(fluxes%heat_content_icemelt, mesg//" fluxes%heat_content_icemelt", G%HI, &
- haloshift=hshift, scale=US%QRZ_T_to_W_m2)
if (associated(fluxes%heat_content_cond)) &
call hchksum(fluxes%heat_content_cond, mesg//" fluxes%heat_content_cond", G%HI, &
haloshift=hshift, scale=US%QRZ_T_to_W_m2)
+ if (associated(fluxes%heat_content_evap)) &
+ call hchksum(fluxes%heat_content_evap, mesg//" fluxes%heat_content_evap", G%HI, &
+ haloshift=hshift, scale=US%QRZ_T_to_W_m2)
if (associated(fluxes%heat_content_massout)) &
call hchksum(fluxes%heat_content_massout, mesg//" fluxes%heat_content_massout", G%HI, &
haloshift=hshift, scale=US%QRZ_T_to_W_m2)
+ if (associated(fluxes%heat_content_massin)) &
+ call hchksum(fluxes%heat_content_massin, mesg//" fluxes%heat_content_massin", G%HI, &
+ haloshift=hshift, scale=US%QRZ_T_to_W_m2)
end subroutine MOM_forcing_chksum
!> Write out chksums for the driving mechanical forces.
@@ -1230,10 +1265,12 @@ subroutine forcing_SinglePointPrint(fluxes, G, i, j, mesg)
call locMsg(fluxes%heat_content_frunoff,'heat_content_frunoff')
call locMsg(fluxes%heat_content_lprec,'heat_content_lprec')
call locMsg(fluxes%heat_content_fprec,'heat_content_fprec')
- call locMsg(fluxes%heat_content_icemelt,'heat_content_icemelt')
call locMsg(fluxes%heat_content_vprec,'heat_content_vprec')
call locMsg(fluxes%heat_content_cond,'heat_content_cond')
call locMsg(fluxes%heat_content_cond,'heat_content_massout')
+ call locMsg(fluxes%heat_content_evap,'heat_content_evap')
+ call locMsg(fluxes%heat_content_massout,'heat_content_massout')
+ call locMsg(fluxes%heat_content_massin,'heat_content_massin')
contains
!> Format and write a message depending on associated state of array
@@ -1327,7 +1364,7 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles,
'Fraction of cell area covered by sea ice', 'm2 m-2')
handles%id_u10_sqr = register_diag_field('ocean_model', 'u10_sqr', diag%axesT1, Time, &
- 'Wind magnitude at 10m, squared', 'm2 s-2', conversion=US%Z_to_m**2*US%s_to_T**2)
+ 'Wind magnitude at 10m, squared', 'm2 s-2', conversion=US%L_to_m**2*US%s_to_T**2)
endif
endif
@@ -1551,10 +1588,6 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles,
diag%axesT1,Time,'Heat content (relative to 0degC) of frozen prec entering ocean',&
'W m-2', conversion=US%QRZ_T_to_W_m2)
- handles%id_heat_content_icemelt = register_diag_field('ocean_model', 'heat_content_icemelt',&
- diag%axesT1,Time,'Heat content (relative to 0degC) of water flux due to sea ice melting/freezing',&
- 'W m-2', conversion=US%QRZ_T_to_W_m2)
-
handles%id_heat_content_vprec = register_diag_field('ocean_model', 'heat_content_vprec', &
diag%axesT1,Time,'Heat content (relative to 0degC) of virtual precip entering ocean',&
'W m-2', conversion=US%QRZ_T_to_W_m2)
@@ -1563,6 +1596,10 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles,
diag%axesT1,Time,'Heat content (relative to 0degC) of water condensing into ocean',&
'W m-2', conversion=US%QRZ_T_to_W_m2)
+ handles%id_heat_content_evap = register_diag_field('ocean_model', 'heat_content_evap', &
+ diag%axesT1,Time,'Heat content (relative to 0degC) of water evaporating from ocean',&
+ 'W m-2', conversion=US%QRZ_T_to_W_m2)
+
handles%id_hfrainds = register_diag_field('ocean_model', 'hfrainds', &
diag%axesT1,Time,'Heat content (relative to 0degC) of liquid+frozen precip entering ocean', &
'W m-2', conversion=US%QRZ_T_to_W_m2, &
@@ -1694,11 +1731,6 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles,
long_name='Area integrated heat content (relative to 0C) of frozen precip',&
units='W')
- handles%id_total_heat_content_icemelt = register_scalar_field('ocean_model', &
- 'total_heat_content_icemelt', Time, diag,long_name= &
- 'Area integrated heat content (relative to 0C) of water flux due sea ice melting/freezing', &
- units='W')
-
handles%id_total_heat_content_vprec = register_scalar_field('ocean_model', &
'total_heat_content_vprec', Time, diag, &
long_name='Area integrated heat content (relative to 0C) of virtual precip',&
@@ -1709,6 +1741,11 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles,
long_name='Area integrated heat content (relative to 0C) of condensate',&
units='W')
+ handles%id_total_heat_content_evap = register_scalar_field('ocean_model', &
+ 'total_heat_content_evap', Time, diag, &
+ long_name='Area integrated heat content (relative to 0C) of evaporation',&
+ units='W')
+
handles%id_total_heat_content_surfwater = register_scalar_field('ocean_model', &
'total_heat_content_surfwater', Time, diag, &
long_name='Area integrated heat content (relative to 0C) of water crossing surface',&
@@ -2056,6 +2093,11 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces)
fluxes%heat_content_cond(i,j) = wt1*fluxes%heat_content_cond(i,j) + wt2*flux_tmp%heat_content_cond(i,j)
enddo ; enddo
endif
+ if (associated(fluxes%heat_content_evap) .and. associated(flux_tmp%heat_content_evap)) then
+ do j=js,je ; do i=is,ie
+ fluxes%heat_content_evap(i,j) = wt1*fluxes%heat_content_evap(i,j) + wt2*flux_tmp%heat_content_evap(i,j)
+ enddo ; enddo
+ endif
if (associated(fluxes%heat_content_lprec) .and. associated(flux_tmp%heat_content_lprec)) then
do j=js,je ; do i=is,ie
fluxes%heat_content_lprec(i,j) = wt1*fluxes%heat_content_lprec(i,j) + wt2*flux_tmp%heat_content_lprec(i,j)
@@ -2066,11 +2108,6 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces)
fluxes%heat_content_fprec(i,j) = wt1*fluxes%heat_content_fprec(i,j) + wt2*flux_tmp%heat_content_fprec(i,j)
enddo ; enddo
endif
- if (associated(fluxes%heat_content_icemelt) .and. associated(flux_tmp%heat_content_icemelt)) then
- do j=js,je ; do i=is,ie
- fluxes%heat_content_icemelt(i,j) = wt1*fluxes%heat_content_icemelt(i,j) + wt2*flux_tmp%heat_content_icemelt(i,j)
- enddo ; enddo
- endif
if (associated(fluxes%heat_content_vprec) .and. associated(flux_tmp%heat_content_vprec)) then
do j=js,je ; do i=is,ie
fluxes%heat_content_vprec(i,j) = wt1*fluxes%heat_content_vprec(i,j) + wt2*flux_tmp%heat_content_vprec(i,j)
@@ -2086,11 +2123,6 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces)
fluxes%heat_content_frunoff(i,j) = wt1*fluxes%heat_content_frunoff(i,j) + wt2*flux_tmp%heat_content_frunoff(i,j)
enddo ; enddo
endif
- if (associated(fluxes%heat_content_icemelt) .and. associated(flux_tmp%heat_content_icemelt)) then
- do j=js,je ; do i=is,ie
- fluxes%heat_content_icemelt(i,j) = wt1*fluxes%heat_content_icemelt(i,j) + wt2*flux_tmp%heat_content_icemelt(i,j)
- enddo ; enddo
- endif
if (associated(fluxes%ustar_shelf) .and. associated(flux_tmp%ustar_shelf)) then
do i=isd,ied ; do j=jsd,jed
@@ -2333,7 +2365,7 @@ end subroutine mech_forcing_diags
!> Offer buoyancy forcing fields for diagnostics for those
!! fields registered as part of register_forcing_type_diags.
-subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, handles)
+subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, handles, enthalpy)
type(forcing), target, intent(in) :: fluxes_in !< A structure containing thermodynamic forcing fields
type(surface), intent(in) :: sfc_state !< A structure containing fields that
!! describe the surface state of the ocean.
@@ -2342,6 +2374,11 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h
type(time_type), intent(in) :: time_end !< The end time of the diagnostic interval.
type(diag_ctrl), intent(inout) :: diag !< diagnostic regulator
type(forcing_diags), intent(inout) :: handles !< diagnostic ids
+ logical, optional, intent(in ) :: enthalpy !< If present and true, the heat content associated
+ !! with mass entering/leaving the ocean is provided
+ !! by the coupler. Diagnostics net_heat_surface and
+ !! heat_content_surfwater are computed using
+ !! heat_content_evap instead of heat_content_massout.
! local variables
type(ocean_grid_type), pointer :: G ! Grid metric on model index map
@@ -2353,10 +2390,14 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h
real :: I_dt ! inverse time step [T-1 ~> s-1]
real :: ppt2mks ! conversion between ppt and mks units [nondim]
integer :: turns ! Number of index quarter turns
+ logical :: mom_enthalpy ! If true (default) enthalpy terms are computed in MOM6
integer :: i, j, is, ie, js, je
call cpu_clock_begin(handles%id_clock_forcing)
+ mom_enthalpy = .true.
+ if (present(enthalpy)) mom_enthalpy = .not. enthalpy
+
! NOTE: post_data expects data to be on the rotated index map, so any
! rotations must be applied before saving the output.
turns = diag%G%HI%turns
@@ -2576,13 +2617,6 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h
call post_data(handles%id_total_heat_content_fprec, total_transport, diag)
endif
- if ((handles%id_heat_content_icemelt > 0) .and. associated(fluxes%heat_content_icemelt)) &
- call post_data(handles%id_heat_content_icemelt, fluxes%heat_content_icemelt, diag)
- if ((handles%id_total_heat_content_icemelt > 0) .and. associated(fluxes%heat_content_icemelt)) then
- total_transport = global_area_integral(fluxes%heat_content_icemelt, G, scale=US%QRZ_T_to_W_m2)
- call post_data(handles%id_total_heat_content_icemelt, total_transport, diag)
- endif
-
if ((handles%id_heat_content_vprec > 0) .and. associated(fluxes%heat_content_vprec)) &
call post_data(handles%id_heat_content_vprec, fluxes%heat_content_vprec, diag)
if ((handles%id_total_heat_content_vprec > 0) .and. associated(fluxes%heat_content_vprec)) then
@@ -2597,6 +2631,13 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h
call post_data(handles%id_total_heat_content_cond, total_transport, diag)
endif
+ if ((handles%id_heat_content_evap > 0) .and. associated(fluxes%heat_content_evap)) &
+ call post_data(handles%id_heat_content_evap, fluxes%heat_content_evap, diag)
+ if ((handles%id_total_heat_content_evap > 0) .and. associated(fluxes%heat_content_evap)) then
+ total_transport = global_area_integral(fluxes%heat_content_evap, G, scale=US%QRZ_T_to_W_m2)
+ call post_data(handles%id_total_heat_content_evap, total_transport, diag)
+ endif
+
if ((handles%id_heat_content_massout > 0) .and. associated(fluxes%heat_content_massout)) &
call post_data(handles%id_heat_content_massout, fluxes%heat_content_massout, diag)
if ((handles%id_total_heat_content_massout > 0) .and. associated(fluxes%heat_content_massout)) then
@@ -2645,22 +2686,25 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h
!if (associated(sfc_state%TempXpme)) then
! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * fluxes%C_p * I_dt
!else
- if (associated(fluxes%heat_content_lrunoff)) &
- res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j)
- if (associated(fluxes%heat_content_frunoff)) &
- res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j)
- if (associated(fluxes%heat_content_lprec)) &
- res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j)
- if (associated(fluxes%heat_content_fprec)) &
- res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j)
- if (associated(fluxes%heat_content_icemelt)) &
- res(i,j) = res(i,j) + fluxes%heat_content_icemelt(i,j)
- if (associated(fluxes%heat_content_vprec)) &
- res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j)
- if (associated(fluxes%heat_content_cond)) &
- res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j)
+ if (associated(fluxes%heat_content_lrunoff)) &
+ res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j)
+ if (associated(fluxes%heat_content_frunoff)) &
+ res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j)
+ if (associated(fluxes%heat_content_lprec)) &
+ res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j)
+ if (associated(fluxes%heat_content_fprec)) &
+ res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j)
+ if (associated(fluxes%heat_content_vprec)) &
+ res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j)
+ if (associated(fluxes%heat_content_cond)) &
+ res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j)
+ if (mom_enthalpy) then
if (associated(fluxes%heat_content_massout)) &
res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j)
+ else
+ if (associated(fluxes%heat_content_evap)) &
+ res(i,j) = res(i,j) + fluxes%heat_content_evap(i,j)
+ endif
!endif
if (associated(fluxes%heat_added)) res(i,j) = res(i,j) + fluxes%heat_added(i,j)
enddo ; enddo
@@ -2682,14 +2726,17 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h
! if (associated(sfc_state%TempXpme)) then
! res(i,j) = res(i,j) + sfc_state%TempXpme(i,j) * fluxes%C_p * I_dt
! else
- if (associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j)
- if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j)
- if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j)
- if (associated(fluxes%heat_content_icemelt)) res(i,j) = res(i,j) + fluxes%heat_content_icemelt(i,j)
- if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j)
- if (associated(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j)
- if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j)
- if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j)
+ if (associated(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j)
+ if (associated(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j)
+ if (associated(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j)
+ if (associated(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j)
+ if (associated(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j)
+ if (associated(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j)
+ if (mom_enthalpy) then
+ if (associated(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j)
+ else
+ if (associated(fluxes%heat_content_evap)) res(i,j) = res(i,j) + fluxes%heat_content_evap(i,j)
+ endif
! endif
enddo ; enddo
if (handles%id_heat_content_surfwater > 0) call post_data(handles%id_heat_content_surfwater, res, diag)
@@ -2938,7 +2985,7 @@ end subroutine forcing_diagnostics
!> Conditionally allocate fields within the forcing type
subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, &
shelf, iceberg, salt, fix_accum_bug, cfc, waves, &
- shelf_sfc_accumulation)
+ shelf_sfc_accumulation, lamult, hevap)
type(ocean_grid_type), intent(in) :: G !< Ocean grid structure
type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields
logical, optional, intent(in) :: water !< If present and true, allocate water fluxes
@@ -2955,10 +3002,18 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, &
logical, optional, intent(in) :: shelf_sfc_accumulation !< If present and true, and shelf is true,
!! then allocate surface flux deposition from the atmosphere
!! over ice shelves and ice sheets.
+ logical, optional, intent(in) :: lamult !< If present and true, allocate langmuir enhancement factor
+ logical, optional, intent(in) :: hevap !< If present and true, allocate heat content evap.
+ !! This field must be allocated when enthalpy is provided
+ !! via coupler.
! Local variables
integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
- logical :: shelf_sfc_acc
+ logical :: shelf_sfc_acc, enthalpy_mom
+
+ ! if true, allocate fluxes needed to calculate enthalpy terms in MOM6
+ enthalpy_mom = .true.
+ if (present (hevap)) enthalpy_mom = .not. hevap
isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed
IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB
@@ -2991,14 +3046,14 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, &
if (present(heat) .and. present(water)) then ; if (heat .and. water) then
call myAlloc(fluxes%heat_content_cond,isd,ied,jsd,jed, .true.)
- call myAlloc(fluxes%heat_content_icemelt,isd,ied,jsd,jed, .true.)
+ call myAlloc(fluxes%heat_content_evap,isd,ied,jsd,jed, .not. enthalpy_mom)
call myAlloc(fluxes%heat_content_lprec,isd,ied,jsd,jed, .true.)
call myAlloc(fluxes%heat_content_fprec,isd,ied,jsd,jed, .true.)
call myAlloc(fluxes%heat_content_vprec,isd,ied,jsd,jed, .true.)
call myAlloc(fluxes%heat_content_lrunoff,isd,ied,jsd,jed, .true.)
call myAlloc(fluxes%heat_content_frunoff,isd,ied,jsd,jed, .true.)
- call myAlloc(fluxes%heat_content_massout,isd,ied,jsd,jed, .true.)
- call myAlloc(fluxes%heat_content_massin,isd,ied,jsd,jed, .true.)
+ call myAlloc(fluxes%heat_content_massout,isd,ied,jsd,jed, enthalpy_mom)
+ call myAlloc(fluxes%heat_content_massin,isd,ied,jsd,jed, enthalpy_mom)
endif ; endif
call myAlloc(fluxes%p_surf,isd,ied,jsd,jed, press)
@@ -3024,7 +3079,7 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, &
!These fields should only on allocated when wave coupling is activated.
call myAlloc(fluxes%ice_fraction,isd,ied,jsd,jed, waves)
- call myAlloc(fluxes%lamult,isd,ied,jsd,jed, waves)
+ call myAlloc(fluxes%lamult,isd,ied,jsd,jed, lamult)
if (present(fix_accum_bug)) fluxes%gustless_accum_bug = .not.fix_accum_bug
end subroutine allocate_forcing_by_group
@@ -3118,8 +3173,6 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, &
call myAlloc(forces%mass_berg,isd,ied,jsd,jed, iceberg)
!These fields should only be allocated when waves
- call myAlloc(forces%ustk0,isd,ied,jsd,jed, waves)
- call myAlloc(forces%vstk0,isd,ied,jsd,jed, waves)
if (present(waves)) then; if (waves) then;
if (.not. present(num_stk_bands)) then
call MOM_error(FATAL,"Requested to &
@@ -3127,20 +3180,13 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, &
endif
if (num_stk_bands > 0) then
if (.not.associated(forces%ustkb)) then
- allocate(forces%stk_wavenumbers(num_stk_bands))
- forces%stk_wavenumbers(:) = 0.0
- allocate(forces%ustkb(isd:ied,jsd:jed,num_stk_bands))
- forces%ustkb(isd:ied,jsd:jed,:) = 0.0
+ allocate(forces%stk_wavenumbers(num_stk_bands), source=0.0)
+ allocate(forces%ustkb(isd:ied,jsd:jed,num_stk_bands), source=0.0)
+ allocate(forces%vstkb(isd:ied,jsd:jed,num_stk_bands), source=0.0)
endif
endif
endif ; endif
-
- if (present(waves)) then; if (waves) then; if (.not.associated(forces%vstkb)) then
- allocate(forces%vstkb(isd:ied,jsd:jed,num_stk_bands))
- forces%vstkb(isd:ied,jsd:jed,:) = 0.0
- endif ; endif ; endif
-
end subroutine allocate_mech_forcing_by_group
@@ -3254,10 +3300,10 @@ subroutine deallocate_forcing_type(fluxes)
if (associated(fluxes%heat_added)) deallocate(fluxes%heat_added)
if (associated(fluxes%heat_content_lrunoff)) deallocate(fluxes%heat_content_lrunoff)
if (associated(fluxes%heat_content_frunoff)) deallocate(fluxes%heat_content_frunoff)
- if (associated(fluxes%heat_content_icemelt)) deallocate(fluxes%heat_content_icemelt)
if (associated(fluxes%heat_content_lprec)) deallocate(fluxes%heat_content_lprec)
if (associated(fluxes%heat_content_fprec)) deallocate(fluxes%heat_content_fprec)
if (associated(fluxes%heat_content_cond)) deallocate(fluxes%heat_content_cond)
+ if (associated(fluxes%heat_content_evap)) deallocate(fluxes%heat_content_evap)
if (associated(fluxes%heat_content_massout)) deallocate(fluxes%heat_content_massout)
if (associated(fluxes%heat_content_massin)) deallocate(fluxes%heat_content_massin)
if (associated(fluxes%evap)) deallocate(fluxes%evap)
@@ -3358,14 +3404,17 @@ subroutine rotate_forcing(fluxes_in, fluxes, turns)
if (do_heat .and. do_water) then
call rotate_array(fluxes_in%heat_content_cond, turns, fluxes%heat_content_cond)
- call rotate_array(fluxes_in%heat_content_icemelt, turns, fluxes%heat_content_icemelt)
call rotate_array(fluxes_in%heat_content_lprec, turns, fluxes%heat_content_lprec)
call rotate_array(fluxes_in%heat_content_fprec, turns, fluxes%heat_content_fprec)
call rotate_array(fluxes_in%heat_content_vprec, turns, fluxes%heat_content_vprec)
call rotate_array(fluxes_in%heat_content_lrunoff, turns, fluxes%heat_content_lrunoff)
call rotate_array(fluxes_in%heat_content_frunoff, turns, fluxes%heat_content_frunoff)
- call rotate_array(fluxes_in%heat_content_massout, turns, fluxes%heat_content_massout)
- call rotate_array(fluxes_in%heat_content_massin, turns, fluxes%heat_content_massin)
+ if (associated (fluxes_in%heat_content_evap)) then
+ call rotate_array(fluxes_in%heat_content_evap, turns, fluxes%heat_content_evap)
+ else
+ call rotate_array(fluxes_in%heat_content_massout, turns, fluxes%heat_content_massout)
+ call rotate_array(fluxes_in%heat_content_massin, turns, fluxes%heat_content_massin)
+ endif
endif
if (do_press) then
@@ -3605,7 +3654,6 @@ subroutine homogenize_forcing(fluxes, G, GV, US)
if (do_heat .and. do_water) then
call homogenize_field_t(fluxes%heat_content_cond, G, tmp_scale=US%QRZ_T_to_W_m2)
- call homogenize_field_t(fluxes%heat_content_icemelt, G, tmp_scale=US%QRZ_T_to_W_m2)
call homogenize_field_t(fluxes%heat_content_lprec, G, tmp_scale=US%QRZ_T_to_W_m2)
call homogenize_field_t(fluxes%heat_content_fprec, G, tmp_scale=US%QRZ_T_to_W_m2)
call homogenize_field_t(fluxes%heat_content_vprec, G, tmp_scale=US%QRZ_T_to_W_m2)
diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90
index 38a3544703..25cad71b06 100644
--- a/src/core/MOM_isopycnal_slopes.F90
+++ b/src/core/MOM_isopycnal_slopes.F90
@@ -8,6 +8,7 @@ module MOM_isopycnal_slopes
use MOM_variables, only : thermo_var_ptrs
use MOM_verticalGrid, only : verticalGrid_type
use MOM_EOS, only : calculate_density_derivs
+use MOM_EOS, only : calculate_density_second_derivs
use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE
use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S
@@ -26,7 +27,7 @@ module MOM_isopycnal_slopes
!> Calculate isopycnal slopes, and optionally return other stratification dependent functions such as N^2
!! and dz*S^2*g-prime used, or calculable from factors used, during the calculation.
-subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, &
+subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stanley, &
slope_x, slope_y, N2_u, N2_v, dzu, dzv, dzSxN, dzSyN, halo, OBC) !, eta_to_m)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
@@ -38,6 +39,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, &
!! thermodynamic variables
real, intent(in) :: dt_kappa_smooth !< A smoothing vertical diffusivity
!! times a smoothing timescale [Z2 ~> m2].
+ logical, intent(in) :: use_stanley !< turn on stanley param in slope
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: slope_x !< Isopycnal slope in i-dir [Z L-1 ~> nondim]
real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: slope_y !< Isopycnal slope in j-dir [Z L-1 ~> nondim]
real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), &
@@ -70,12 +72,15 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, &
! Rho ! Density itself, when a nonlinear equation of state is not in use [R ~> kg m-3].
real, dimension(SZI_(G), SZJ_(G),SZK_(GV)+1) :: &
pres ! The pressure at an interface [R L2 T-2 ~> Pa].
+ real, dimension(SZI_(G)) :: scrap ! An array to pass to calculate_density_second_derivs() that will be ingored.
real, dimension(SZIB_(G)) :: &
drho_dT_u, & ! The derivative of density with temperature at u points [R degC-1 ~> kg m-3 degC-1].
drho_dS_u ! The derivative of density with salinity at u points [R ppt-1 ~> kg m-3 ppt-1].
real, dimension(SZI_(G)) :: &
drho_dT_v, & ! The derivative of density with temperature at v points [R degC-1 ~> kg m-3 degC-1].
- drho_dS_v ! The derivative of density with salinity at v points [R ppt-1 ~> kg m-3 ppt-1].
+ drho_dS_v, & ! The derivative of density with salinity at v points [R ppt-1 ~> kg m-3 ppt-1].
+ drho_dT_dT_h, & ! The second derivative of density with temperature at h points [R degC-2 ~> kg m-3 degC-2]
+ drho_dT_dT_hr ! The second derivative of density with temperature at h (+1) points [R degC-2 ~> kg m-3 degC-2]
real, dimension(SZIB_(G)) :: &
T_u, & ! Temperature on the interface at the u-point [degC].
S_u, & ! Salinity on the interface at the u-point [ppt].
@@ -84,6 +89,13 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, &
T_v, & ! Temperature on the interface at the v-point [degC].
S_v, & ! Salinity on the interface at the v-point [ppt].
pres_v ! Pressure on the interface at the v-point [R L2 T-2 ~> Pa].
+ real, dimension(SZI_(G)) :: &
+ T_h, & ! Temperature on the interface at the h-point [degC].
+ S_h, & ! Salinity on the interface at the h-point [ppt]
+ pres_h, & ! Pressure on the interface at the h-point [R L2 T-2 ~> Pa].
+ T_hr, & ! Temperature on the interface at the h (+1) point [degC].
+ S_hr, & ! Salinity on the interface at the h (+1) point [ppt]
+ pres_hr ! Pressure on the interface at the h (+1) point [R L2 T-2 ~> Pa].
real :: drdiA, drdiB ! Along layer zonal- and meridional- potential density
real :: drdjA, drdjB ! gradients in the layers above (A) and below (B) the
! interface times the grid spacing [R ~> kg m-3].
@@ -214,9 +226,10 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, &
!$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv,h,e, &
!$OMP h_neglect,dz_neglect,Z_to_L,L_to_Z,H_to_Z,h_neglect2, &
!$OMP present_N2_u,G_Rho0,N2_u,slope_x,dzSxN,EOSdom_u,local_open_u_BC, &
- !$OMP dzu,OBC) &
+ !$OMP dzu,OBC,use_stanley) &
!$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, &
!$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, &
+ !$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h, &
!$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, &
!$OMP drdx,mag_grad2,slope,l_seg)
do j=js,je ; do K=nz,2,-1
@@ -236,6 +249,19 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, &
tv%eqn_of_state, EOSdom_u)
endif
+ if (use_stanley) then
+ do i=is-1,ie+1
+ pres_h(i) = pres(i,j,K)
+ T_h(i) = 0.5*(T(i,j,k) + T(i,j,k-1))
+ S_h(i) = 0.5*(S(i,j,k) + S(i,j,k-1))
+ enddo
+ ! The second line below would correspond to arguments
+ ! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, &
+ call calculate_density_second_derivs(T_h, S_h, pres_h, &
+ scrap, scrap, drho_dT_dT_h, scrap, scrap, &
+ is-1, ie-is+3, tv%eqn_of_state)
+ endif
+
do I=is-1,ie
if (use_EOS) then
! Estimate the horizontal density gradients along layers.
@@ -250,7 +276,14 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, &
drdkR = (drho_dT_u(I) * (T(i+1,j,k)-T(i+1,j,k-1)) + &
drho_dS_u(I) * (S(i+1,j,k)-S(i+1,j,k-1)))
endif
-
+ if (use_stanley) then
+ ! Correction to the horizontal density gradient due to nonlinearity in
+ ! the EOS rectifying SGS temperature anomalies
+ drdiA = drdiA + 0.5 * ((drho_dT_dT_h(i+1) * tv%varT(i+1,j,k-1)) - &
+ (drho_dT_dT_h(i) * tv%varT(i,j,k-1)) )
+ drdiB = drdiB + 0.5 * ((drho_dT_dT_h(i+1) * tv%varT(i+1,j,k)) - &
+ (drho_dT_dT_h(i) * tv%varT(i,j,k)) )
+ endif
hg2A = h(i,j,k-1)*h(i+1,j,k-1) + h_neglect2
hg2B = h(i,j,k)*h(i+1,j,k) + h_neglect2
@@ -324,9 +357,11 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, &
!$OMP parallel do default(none) shared(nz,is,ie,js,je,IsdB,use_EOS,G,GV,US,pres,T,S,tv, &
!$OMP h,h_neglect,e,dz_neglect,Z_to_L,L_to_Z,H_to_Z, &
!$OMP h_neglect2,present_N2_v,G_Rho0,N2_v,slope_y,dzSyN,EOSdom_v, &
- !$OMP dzv,local_open_v_BC,OBC) &
+ !$OMP dzv,local_open_v_BC,OBC,use_stanley) &
!$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, &
!$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, &
+ !$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h, &
+ !$OMP drho_dT_dT_hr,pres_hr,T_hr,S_hr, &
!$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, &
!$OMP drdy,mag_grad2,slope,l_seg)
do j=js-1,je ; do K=nz,2,-1
@@ -344,6 +379,25 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, &
call calculate_density_derivs(T_v, S_v, pres_v, drho_dT_v, drho_dS_v, tv%eqn_of_state, &
EOSdom_v)
endif
+ if (use_stanley) then
+ do i=is,ie
+ pres_h(i) = pres(i,j,K)
+ T_h(i) = 0.5*(T(i,j,k) + T(i,j,k-1))
+ S_h(i) = 0.5*(S(i,j,k) + S(i,j,k-1))
+
+ pres_hr(i) = pres(i,j+1,K)
+ T_hr(i) = 0.5*(T(i,j+1,k) + T(i,j+1,k-1))
+ S_hr(i) = 0.5*(S(i,j+1,k) + S(i,j+1,k-1))
+ enddo
+ ! The second line below would correspond to arguments
+ ! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, &
+ call calculate_density_second_derivs(T_h, S_h, pres_h, &
+ scrap, scrap, drho_dT_dT_h, scrap, scrap, &
+ is, ie-is+1, tv%eqn_of_state)
+ call calculate_density_second_derivs(T_hr, S_hr, pres_hr, &
+ scrap, scrap, drho_dT_dT_hr, scrap, scrap, &
+ is, ie-is+1, tv%eqn_of_state)
+ endif
do i=is,ie
if (use_EOS) then
! Estimate the horizontal density gradients along layers.
@@ -358,6 +412,14 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, &
drdkR = (drho_dT_v(i) * (T(i,j+1,k)-T(i,j+1,k-1)) + &
drho_dS_v(i) * (S(i,j+1,k)-S(i,j+1,k-1)))
endif
+ if (use_stanley) then
+ ! Correction to the horizontal density gradient due to nonlinearity in
+ ! the EOS rectifying SGS temperature anomalies
+ drdjA = drdjA + 0.5 * ((drho_dT_dT_hr(i) * tv%varT(i,j+1,k-1)) - &
+ (drho_dT_dT_h(i) * tv%varT(i,j,k-1)) )
+ drdjB = drdjB + 0.5 * ((drho_dT_dT_hr(i) * tv%varT(i,j+1,k)) - &
+ (drho_dT_dT_h(i) * tv%varT(i,j,k)) )
+ endif
hg2A = h(i,j,k-1)*h(i,j+1,k-1) + h_neglect2
hg2B = h(i,j,k)*h(i,j+1,k) + h_neglect2
diff --git a/src/core/MOM_stoch_eos.F90 b/src/core/MOM_stoch_eos.F90
new file mode 100644
index 0000000000..bc5e15af4e
--- /dev/null
+++ b/src/core/MOM_stoch_eos.F90
@@ -0,0 +1,220 @@
+!> Provides the ocean stochastic equation of state
+module MOM_stoch_eos
+
+! This file is part of MOM6. See LICENSE.md for the license.
+use MOM_grid, only : ocean_grid_type
+use MOM_hor_index, only : hor_index_type
+use MOM_file_parser, only : get_param, param_file_type
+use MOM_random, only : PRNG,random_2d_constructor,random_2d_norm
+use MOM_time_manager, only : time_type
+use MOM_io, only : vardesc, var_desc
+use MOM_restart, only : MOM_restart_CS,is_new_run
+use MOM_diag_mediator, only : register_diag_field,post_data,diag_ctrl,safe_alloc_ptr
+use MOM_variables, only : thermo_var_ptrs
+use MOM_verticalGrid, only : verticalGrid_type
+use MOM_restart, only : register_restart_field
+use MOM_isopycnal_slopes,only : vert_fill_TS
+!use random_numbers_mod, only : getRandomNumbers,initializeRandomNumberStream,randomNumberStream
+
+implicit none; private
+#include
+
+public MOM_stoch_eos_init
+public MOM_stoch_eos_run
+public MOM_calc_varT
+
+!> Describes parameters of the stochastic component of the EOS
+!! correction, described in Stanley et al. JAMES 2020.
+type, public :: MOM_stoch_eos_CS
+ real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: l2_inv
+ !< One over sum of the T cell side side lengths squared
+ real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: rgauss
+ !< nondimensional random Gaussian
+ real :: tfac=0.27 !< Nondimensional decorrelation time factor, ~1/3.7
+ real :: amplitude=0.624499 !< Nondimensional std dev of Gaussian
+ integer :: seed !< PRNG seed
+ type(PRNG) :: rn_CS !< PRNG control structure
+ real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: pattern
+ !< Random pattern for stochastic EOS [nondim]
+ real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: phi
+ !< temporal correlation stochastic EOS [nondim]
+ logical :: use_stoch_eos!< If true, use the stochastic equation of state (Stanley et al. 2020)
+ real :: stanley_coeff !< Coefficient correlating the temperature gradient
+ !! and SGS T variance; if <0, turn off scheme in all codes
+ real :: stanley_a !< a in exp(aX) in stochastic coefficient
+ real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [Z2 T-1 ~> m2 s-1]
+
+ !>@{ Diagnostic IDs
+ integer :: id_stoch_eos = -1, id_stoch_phi = -1, id_tvar_sgs = -1
+ !>@}
+
+end type MOM_stoch_eos_CS
+
+contains
+
+!> Initializes MOM_stoch_eos module.
+subroutine MOM_stoch_eos_init(G,Time,param_file,CS,restart_CS,diag)
+ type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(time_type), intent(in) :: Time !< Time for stochastic process
+ type(MOM_stoch_eos_CS), intent(inout) :: CS !< Stochastic control structure
+ type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure.
+ type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics
+
+ ! local variables
+ integer :: i,j
+ type(vardesc) :: vd
+ CS%seed=0
+ ! contants
+ !pi=2*acos(0.0)
+ call get_param(param_file, "MOM_stoch_eos", "STOCH_EOS", CS%use_stoch_eos, &
+ "If true, stochastic perturbations are applied "//&
+ "to the EOS in the PGF.", default=.false.)
+ call get_param(param_file, "MOM_stoch_eos", "STANLEY_COEFF", CS%stanley_coeff, &
+ "Coefficient correlating the temperature gradient "//&
+ "and SGS T variance.", default=-1.0)
+ call get_param(param_file, "MOM_stoch_eos", "STANLEY_A", CS%stanley_a, &
+ "Coefficient a which scales chi in stochastic perturbation of the "//&
+ "SGS T variance.", default=1.0)
+ call get_param(param_file, "MOM_stoch_eos", "KD_SMOOTH", CS%kappa_smooth, &
+ "A diapycnal diffusivity that is used to interpolate "//&
+ "more sensible values of T & S into thin layers.", &
+ units="m2 s-1", default=1.0e-6)
+
+ !don't run anything if STANLEY_COEFF < 0
+ if (CS%stanley_coeff >= 0.0) then
+
+ ALLOC_(CS%pattern(G%isd:G%ied,G%jsd:G%jed)) ; CS%pattern(:,:) = 0.0
+ vd = var_desc("stoch_eos_pattern","nondim","Random pattern for stoch EOS",'h','1')
+ call register_restart_field(CS%pattern, vd, .false., restart_CS)
+ ALLOC_(CS%phi(G%isd:G%ied,G%jsd:G%jed)) ; CS%phi(:,:) = 0.0
+ ALLOC_(CS%l2_inv(G%isd:G%ied,G%jsd:G%jed))
+ ALLOC_(CS%rgauss(G%isd:G%ied,G%jsd:G%jed))
+ call get_param(param_file, "MOM_stoch_eos", "SEED_STOCH_EOS", CS%seed, &
+ "Specfied seed for random number sequence ", default=0)
+ call random_2d_constructor(CS%rn_CS, G%HI, Time, CS%seed)
+ call random_2d_norm(CS%rn_CS, G%HI, CS%rgauss)
+ ! fill array with approximation of grid area needed for decorrelation
+ ! time-scale calculation
+ do j=G%jsc,G%jec
+ do i=G%isc,G%iec
+ CS%l2_inv(i,j)=1.0/(G%dxT(i,j)**2+G%dyT(i,j)**2)
+ enddo
+ enddo
+ if (is_new_run(restart_CS)) then
+ do j=G%jsc,G%jec
+ do i=G%isc,G%iec
+ CS%pattern(i,j)=CS%amplitude*CS%rgauss(i,j)
+ enddo
+ enddo
+ endif
+
+ !register diagnostics
+ CS%id_tvar_sgs = register_diag_field('ocean_model', 'tvar_sgs', diag%axesTL, Time, &
+ 'Parameterized SGS Temperature Variance ', 'None')
+ if (CS%use_stoch_eos) then
+ CS%id_stoch_eos = register_diag_field('ocean_model', 'stoch_eos', diag%axesT1, Time, &
+ 'random pattern for EOS', 'None')
+ CS%id_stoch_phi = register_diag_field('ocean_model', 'stoch_phi', diag%axesT1, Time, &
+ 'phi for EOS', 'None')
+ endif
+ endif
+
+end subroutine MOM_stoch_eos_init
+
+!> Generates a pattern in space and time for the ocean stochastic equation of state
+subroutine MOM_stoch_eos_run(G,u,v,delt,Time,CS,diag)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: u !< The zonal velocity [L T-1 ~> m s-1].
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
+ intent(in) :: v !< The meridional velocity [L T-1 ~> m s-1].
+ real, intent(in) :: delt !< Time step size for AR1 process [T ~> s].
+ type(time_type), intent(in) :: Time !< Time for stochastic process
+ type(MOM_stoch_eos_CS), intent(inout) :: CS !< Stochastic control structure
+ type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics
+
+ ! local variables
+ integer :: i,j
+ integer :: yr,mo,dy,hr,mn,sc
+ real :: phi,ubar,vbar
+
+ call random_2d_constructor(CS%rn_CS, G%HI, Time, CS%seed)
+ call random_2d_norm(CS%rn_CS, G%HI, CS%rgauss)
+
+ ! advance AR(1)
+ do j=G%jsc,G%jec
+ do i=G%isc,G%iec
+ ubar=0.5*(u(I,j,1)*G%mask2dCu(I,j)+u(I-1,j,1)*G%mask2dCu(I-1,j))
+ vbar=0.5*(v(i,J,1)*G%mask2dCv(i,J)+v(i,J-1,1)*G%mask2dCv(i,J-1))
+ phi=exp(-delt*CS%tfac*sqrt((ubar**2+vbar**2)*CS%l2_inv(i,j)))
+ CS%pattern(i,j)=phi*CS%pattern(i,j) + CS%amplitude*sqrt(1-phi**2)*CS%rgauss(i,j)
+ CS%phi(i,j)=phi
+ enddo
+ enddo
+
+end subroutine MOM_stoch_eos_run
+
+!> Computes a parameterization of the SGS temperature variance
+subroutine MOM_calc_varT(G,GV,h,tv,CS,dt)
+ type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
+ type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: h !< Layer thickness [H ~> m]
+ type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure
+ type(MOM_stoch_eos_CS), intent(inout) :: CS !< Stochastic control structure
+ real, intent(in) :: dt !< Time increment [T ~> s]
+
+ ! local variables
+ real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: &
+ T, & !> The temperature (or density) [degC], with the values in
+ !! in massless layers filled vertically by diffusion.
+ S !> The filled salinity [ppt], with the values in
+ !! in massless layers filled vertically by diffusion.
+ integer :: i,j,k
+ real :: hl(5) !> Copy of local stencil of H [H ~> m]
+ real :: dTdi2, dTdj2 !> Differences in T variance [degC2]
+
+ ! This block does a thickness weighted variance calculation and helps control for
+ ! extreme gradients along layers which are vanished against topography. It is
+ ! still a poor approximation in the interior when coordinates are strongly tilted.
+ if (.not. associated(tv%varT)) call safe_alloc_ptr(tv%varT, G%isd, G%ied, G%jsd, G%jed, GV%ke)
+
+ call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, halo_here=1, larger_h_denom=.true.)
+
+ do k=1,G%ke
+ do j=G%jsc,G%jec
+ do i=G%isc,G%iec
+ hl(1) = h(i,j,k) * G%mask2dT(i,j)
+ hl(2) = h(i-1,j,k) * G%mask2dCu(I-1,j)
+ hl(3) = h(i+1,j,k) * G%mask2dCu(I,j)
+ hl(4) = h(i,j-1,k) * G%mask2dCv(i,J-1)
+ hl(5) = h(i,j+1,k) * G%mask2dCv(i,J)
+
+ ! SGS variance in i-direction [degC2]
+ dTdi2 = ( ( G%mask2dCu(I ,j) * G%IdxCu(I ,j) * ( T(i+1,j,k) - T(i,j,k) ) &
+ + G%mask2dCu(I-1,j) * G%IdxCu(I-1,j) * ( T(i,j,k) - T(i-1,j,k) ) &
+ ) * G%dxT(i,j) * 0.5 )**2
+ ! SGS variance in j-direction [degC2]
+ dTdj2 = ( ( G%mask2dCv(i,J ) * G%IdyCv(i,J ) * ( T(i,j+1,k) - T(i,j,k) ) &
+ + G%mask2dCv(i,J-1) * G%IdyCv(i,J-1) * ( T(i,j,k) - T(i,j-1,k) ) &
+ ) * G%dyT(i,j) * 0.5 )**2
+ tv%varT(i,j,k) = CS%stanley_coeff * ( dTdi2 + dTdj2 )
+ ! Turn off scheme near land
+ tv%varT(i,j,k) = tv%varT(i,j,k) * (minval(hl) / (maxval(hl) + GV%H_subroundoff))
+ enddo
+ enddo
+ enddo
+ ! if stochastic, perturb
+ if (CS%use_stoch_eos) then
+ do k=1,G%ke
+ do j=G%jsc,G%jec
+ do i=G%isc,G%iec
+ tv%varT(i,j,k) = exp (CS%stanley_a * CS%pattern(i,j)) * tv%varT(i,j,k)
+ enddo
+ enddo
+ enddo
+ endif
+end subroutine MOM_calc_varT
+
+end module MOM_stoch_eos
diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90
index 7cdf3e8e71..c864d90ddb 100644
--- a/src/core/MOM_variables.F90
+++ b/src/core/MOM_variables.F90
@@ -13,6 +13,7 @@ module MOM_variables
use MOM_grid, only : ocean_grid_type
use MOM_unit_scaling, only : unit_scale_type
use MOM_verticalGrid, only : verticalGrid_type
+use MOM_tracer_types, only : tracer_type
implicit none ; private
@@ -124,6 +125,8 @@ module MOM_variables
real, pointer :: varS(:,:,:) => NULL() !< SGS variance of salinity [ppt2].
real, pointer :: covarTS(:,:,:) => NULL() !< SGS covariance of salinity and potential
!! temperature [degC ppt].
+ type(tracer_type), pointer :: tr_T => NULL() !< pointer to temp in tracer registry
+ type(tracer_type), pointer :: tr_S => NULL() !< pointer to salinty in tracer registry
end type thermo_var_ptrs
!> Pointers to all of the prognostic variables allocated in MOM_variables.F90 and MOM.F90.
diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90
index 9c22ab5eb5..e2edb588ef 100644
--- a/src/diagnostics/MOM_diagnostics.F90
+++ b/src/diagnostics/MOM_diagnostics.F90
@@ -106,6 +106,8 @@ module MOM_diagnostics
integer :: id_rhopot0 = -1, id_rhopot2 = -1
integer :: id_drho_dT = -1, id_drho_dS = -1
integer :: id_h_pre_sync = -1
+ integer :: id_tosq = -1, id_sosq = -1
+
!>@}
type(wave_speed_CS) :: wave_speed !< Wave speed control struct
@@ -399,16 +401,28 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, &
! Internal T&S variables are conservative temperature & absolute salinity,
! so they need to converted to potential temperature and practical salinity
! for some diagnostics using TEOS-10 function calls.
- if ((CS%id_Tpot > 0) .or. (CS%id_tob > 0)) then
+ if ((CS%id_Tpot > 0) .or. (CS%id_tob > 0) .or. (CS%id_tosq > 0)) then
do k=1,nz ; do j=js,je ; do i=is,ie
work_3d(i,j,k) = gsw_pt_from_ct(tv%S(i,j,k),tv%T(i,j,k))
enddo ; enddo ; enddo
if (CS%id_Tpot > 0) call post_data(CS%id_Tpot, work_3d, CS%diag)
if (CS%id_tob > 0) call post_data(CS%id_tob, work_3d(:,:,nz), CS%diag, mask=G%mask2dT)
+ if (CS%id_tosq > 0) then
+ do k=1,nz ; do j=js,je ; do i=is,ie
+ work_3d(i,j,k) = work_3d(i,j,k)*work_3d(i,j,k)
+ enddo ; enddo ; enddo
+ call post_data(CS%id_tosq, work_3d, CS%diag)
+ endif
endif
else
! Internal T&S variables are potential temperature & practical salinity
if (CS%id_tob > 0) call post_data(CS%id_tob, tv%T(:,:,nz), CS%diag, mask=G%mask2dT)
+ if (CS%id_tosq > 0) then
+ do k=1,nz ; do j=js,je ; do i=is,ie
+ work_3d(i,j,k) = tv%T(i,j,k)*tv%T(i,j,k)
+ enddo ; enddo ; enddo
+ call post_data(CS%id_tosq, work_3d, CS%diag)
+ endif
endif
! Calculate additional, potentially derived salinity diagnostics
@@ -416,16 +430,28 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, p_surf, &
! Internal T&S variables are conservative temperature & absolute salinity,
! so they need to converted to potential temperature and practical salinity
! for some diagnostics using TEOS-10 function calls.
- if ((CS%id_Sprac > 0) .or. (CS%id_sob > 0)) then
+ if ((CS%id_Sprac > 0) .or. (CS%id_sob > 0) .or. (CS%id_sosq >0)) then
do k=1,nz ; do j=js,je ; do i=is,ie
work_3d(i,j,k) = gsw_sp_from_sr(tv%S(i,j,k))
enddo ; enddo ; enddo
if (CS%id_Sprac > 0) call post_data(CS%id_Sprac, work_3d, CS%diag)
if (CS%id_sob > 0) call post_data(CS%id_sob, work_3d(:,:,nz), CS%diag, mask=G%mask2dT)
+ if (CS%id_sosq > 0) then
+ do k=1,nz ; do j=js,je ; do i=is,ie
+ work_3d(i,j,k) = work_3d(i,j,k)*work_3d(i,j,k)
+ enddo ; enddo ; enddo
+ call post_data(CS%id_sosq, work_3d, CS%diag)
+ endif
endif
else
! Internal T&S variables are potential temperature & practical salinity
if (CS%id_sob > 0) call post_data(CS%id_sob, tv%S(:,:,nz), CS%diag, mask=G%mask2dT)
+ if (CS%id_sosq > 0) then
+ do k=1,nz ; do j=js,je ; do i=is,ie
+ work_3d(i,j,k) = tv%S(i,j,k)*tv%S(i,j,k)
+ enddo ; enddo ; enddo
+ call post_data(CS%id_sosq, work_3d, CS%diag)
+ endif
endif
! volume mean potential temperature
@@ -1611,6 +1637,13 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag
long_name='Sea Water Salinity at Sea Floor', &
standard_name='sea_water_salinity_at_sea_floor', units='psu')
+ CS%id_tosq = register_diag_field('ocean_model', 'tosq', diag%axesTL,&
+ Time, 'Square of Potential Temperature', 'degc2', &
+ standard_name='Potential Temperature Squared')
+ CS%id_sosq = register_diag_field('ocean_model', 'sosq', diag%axesTL,&
+ Time, 'Square of Salinity', 'psu2', &
+ standard_name='Salinity Squared')
+
CS%id_temp_layer_ave = register_diag_field('ocean_model', 'temp_layer_ave', &
diag%axesZL, Time, 'Layer Average Ocean Temperature', 'degC')
CS%id_salt_layer_ave = register_diag_field('ocean_model', 'salt_layer_ave', &
diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90
index 33f3edcfd4..f0856893ca 100644
--- a/src/diagnostics/MOM_sum_output.F90
+++ b/src/diagnostics/MOM_sum_output.F90
@@ -993,7 +993,14 @@ subroutine accumulate_net_input(fluxes, sfc_state, tv, dt, G, US, CS)
! enddo ; enddo ; endif
! smg: old code
- if (associated(tv%TempxPmE)) then
+ if (associated(fluxes%heat_content_evap)) then
+ do j=js,je ; do i=is,ie
+ heat_in(i,j) = heat_in(i,j) + dt * QRZL2_to_J * G%areaT(i,j) * &
+ (fluxes%heat_content_evap(i,j) + fluxes%heat_content_lprec(i,j) + &
+ fluxes%heat_content_cond(i,j) + fluxes%heat_content_fprec(i,j) + &
+ fluxes%heat_content_lrunoff(i,j) + fluxes%heat_content_frunoff(i,j))
+ enddo ; enddo
+ elseif (associated(tv%TempxPmE)) then
do j=js,je ; do i=is,ie
heat_in(i,j) = heat_in(i,j) + (fluxes%C_p * QRZL2_to_J*G%areaT(i,j)) * tv%TempxPmE(i,j)
enddo ; enddo
diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90
index 80a8d3f866..8d02845aa0 100644
--- a/src/equation_of_state/MOM_EOS.F90
+++ b/src/equation_of_state/MOM_EOS.F90
@@ -64,9 +64,9 @@ module MOM_EOS
!> Calculates density of sea water from T, S and P
interface calculate_density
- module procedure calculate_density_scalar, calculate_density_array, calculate_density_1d
- module procedure calculate_stanley_density_scalar, calculate_stanley_density_array
- module procedure calculate_stanley_density_1d
+ module procedure calculate_density_scalar, calculate_density_array, calculate_density_1d, &
+ calculate_stanley_density_scalar, calculate_stanley_density_array, &
+ calculate_stanley_density_1d
end interface calculate_density
!> Calculates specific volume of sea water from T, S and P
@@ -430,18 +430,18 @@ subroutine calculate_stanley_density_1d(T, S, pressure, Tvar, TScov, Svar, rho,
select case (EOS%form_of_EOS)
case (EOS_LINEAR)
- call calculate_density_linear(T, S, pres, rho, 1, npts, &
+ call calculate_density_linear(T, S, pres, rho, is, npts, &
EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, rho_ref)
call calculate_density_second_derivs_linear(T, S, pres, d2RdSS, d2RdST, &
- d2RdTT, d2RdSp, d2RdTP, 1, npts)
+ d2RdTT, d2RdSp, d2RdTP, is, npts)
case (EOS_WRIGHT)
- call calculate_density_wright(T, S, pres, rho, 1, npts, rho_ref)
+ call calculate_density_wright(T, S, pres, rho, is, npts, rho_ref)
call calculate_density_second_derivs_wright(T, S, pres, d2RdSS, d2RdST, &
- d2RdTT, d2RdSp, d2RdTP, 1, npts)
+ d2RdTT, d2RdSp, d2RdTP, is, npts)
case (EOS_TEOS10)
- call calculate_density_teos10(T, S, pres, rho, 1, npts, rho_ref)
+ call calculate_density_teos10(T, S, pres, rho, is, npts, rho_ref)
call calculate_density_second_derivs_teos10(T, S, pres, d2RdSS, d2RdST, &
- d2RdTT, d2RdSp, d2RdTP, 1, npts)
+ d2RdTT, d2RdSp, d2RdTP, is, npts)
case default
call MOM_error(FATAL, "calculate_stanley_density_scalar: EOS is not valid.")
end select
diff --git a/src/equation_of_state/TEOS10/gsw_mod_error_functions.f90 b/src/equation_of_state/TEOS10/gsw_mod_error_functions.f90
new file mode 120000
index 0000000000..1c3b7bfb3c
--- /dev/null
+++ b/src/equation_of_state/TEOS10/gsw_mod_error_functions.f90
@@ -0,0 +1 @@
+../../../pkg/GSW-Fortran/modules/gsw_mod_error_functions.f90
\ No newline at end of file
diff --git a/src/framework/MOM_diag_remap.F90 b/src/framework/MOM_diag_remap.F90
index 63e6bcba7a..b665dcd748 100644
--- a/src/framework/MOM_diag_remap.F90
+++ b/src/framework/MOM_diag_remap.F90
@@ -217,7 +217,7 @@ subroutine diag_remap_configure_axes(remap_cs, GV, US, param_file)
allocate(interfaces(remap_cs%nz+1))
allocate(layers(remap_cs%nz))
- interfaces(:) = getCoordinateInterfaces(remap_cs%regrid_cs)
+ interfaces(:) = getCoordinateInterfaces(remap_cs%regrid_cs, undo_scaling=.true.)
layers(:) = 0.5 * ( interfaces(1:remap_cs%nz) + interfaces(2:remap_cs%nz+1) )
remap_cs%interface_axes_id = MOM_diag_axis_init(lowercase(trim(remap_cs%diag_coord_name))//'_i', &
diff --git a/src/framework/MOM_random.F90 b/src/framework/MOM_random.F90
index fbdc916346..f5e996d3e4 100644
--- a/src/framework/MOM_random.F90
+++ b/src/framework/MOM_random.F90
@@ -159,6 +159,7 @@ subroutine random_2d_constructor(CS, HI, Time, seed)
if (.not. allocated(CS%stream2d)) allocate( CS%stream2d(HI%isd:HI%ied,HI%jsd:HI%jed) )
tseed = seed_from_time(Time)
+
tseed = ieor(tseed*9007, seed)
do j = HI%jsd,HI%jed
do i = HI%isd,HI%ied
diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90
index bde8632170..1cd20d3c96 100644
--- a/src/parameterizations/lateral/MOM_MEKE.F90
+++ b/src/parameterizations/lateral/MOM_MEKE.F90
@@ -721,7 +721,7 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, US, SN_u, SN_v, drag_rate_visc, I_m
SN = min(SN_u(I,j), SN_u(I-1,j), SN_v(i,J), SN_v(i,J-1))
if (CS%MEKE_equilibrium_alt) then
- MEKE%MEKE(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_m*depth_tot(i,j))**2 / cd2
+ MEKE%MEKE(i,j) = (CS%MEKE_GEOMETRIC_alpha * SN * US%Z_to_L*depth_tot(i,j))**2 / cd2
else
FatH = 0.25*((G%CoriolisBu(I,J) + G%CoriolisBu(I-1,J-1)) + &
(G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J-1))) ! Coriolis parameter at h points
diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90
index 88e1c772a2..0871737d20 100644
--- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90
+++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90
@@ -59,6 +59,7 @@ module MOM_lateral_mixing_coeffs
!! This parameter is set depending on other parameters.
logical :: calculate_Eady_growth_rate !< If true, calculate all the Eady growth rate.
!! This parameter is set depending on other parameters.
+ logical :: use_stanley_iso !< If true, use Stanley parameterization in MOM_isopycnal_slopes
logical :: use_simpler_Eady_growth_rate !< If true, use a simpler method to calculate the
!! Eady growth rate that avoids division by layer thickness.
!! This parameter is set depending on other parameters.
@@ -471,14 +472,14 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC)
if (CS%calculate_Eady_growth_rate) then
if (CS%use_simpler_Eady_growth_rate) then
call find_eta(h, tv, G, GV, US, e, halo_size=2)
- call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, &
+ call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, CS%use_stanley_iso, &
CS%slope_x, CS%slope_y, N2_u=N2_u, N2_v=N2_v, dzu=dzu, dzv=dzv, &
dzSxN=dzSxN, dzSyN=dzSyN, halo=1, OBC=OBC)
call calc_Eady_growth_rate_2D(CS, G, GV, US, OBC, h, e, dzu, dzv, dzSxN, dzSyN, CS%SN_u, CS%SN_v)
else
call find_eta(h, tv, G, GV, US, e, halo_size=2)
if (CS%use_stored_slopes) then
- call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, &
+ call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, CS%use_stanley_iso, &
CS%slope_x, CS%slope_y, N2_u=N2_u, N2_v=N2_v, halo=1, OBC=OBC)
call calc_Visbeck_coeffs_old(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS, OBC)
else
@@ -1267,6 +1268,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS)
call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.)
+ call get_param(param_file, mdl, "USE_STANLEY_ISO", CS%use_stanley_iso, &
+ "If true, turn on Stanley SGS T variance parameterization "// &
+ "in isopycnal slope code.", default=.false.)
if (CS%Resoln_use_ebt .or. CS%khth_use_ebt_struct) then
in_use = .true.
@@ -1290,6 +1294,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS)
endif
if (CS%use_stored_slopes) then
+ ! CS%calculate_Eady_growth_rate=.true.
in_use = .true.
allocate(CS%slope_x(IsdB:IedB,jsd:jed,GV%ke+1), source=0.0)
allocate(CS%slope_y(isd:ied,JsdB:JedB,GV%ke+1), source=0.0)
diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90
index e1dff4f5bd..864669a217 100644
--- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90
+++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90
@@ -59,6 +59,7 @@ module MOM_mixed_layer_restrat
logical :: debug = .false. !< If true, calculate checksums of fields for debugging.
type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the
!! timing of diagnostic output.
+ logical :: use_stanley_ml !< If true, use the Stanley parameterization of SGS T variance
real, dimension(:,:), allocatable :: &
MLD_filtered, & !< Time-filtered MLD [H ~> m or kg m-2]
@@ -178,6 +179,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var
real, dimension(SZI_(G)) :: dK, dKm1 ! Depths of layer centers [H ~> m or kg m-2].
real, dimension(SZI_(G)) :: pRef_MLD ! A reference pressure for calculating the mixed layer
! densities [R L2 T-2 ~> Pa].
+ real, dimension(SZI_(G)) :: covTS, & !SGS TS covariance in Stanley param; currently 0 [degC ppt]
+ varS !SGS S variance in Stanley param; currently 0 [ppt2]
real :: aFac, bFac ! Nondimensional ratios [nondim]
real :: ddRho ! A density difference [R ~> kg m-3]
real :: hAtVel ! Thickness at the velocity points [H ~> m or kg m-2]
@@ -194,6 +197,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var
Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB
h_min = 0.5*GV%Angstrom_H ! This should be GV%Angstrom_H, but that value would change answers.
+ covTS(:)=0.0 !!Functionality not implemented yet; in future, should be passed in tv
+ varS(:)=0.0
if (.not.associated(tv%eqn_of_state)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// &
"An equation of state must be used with this module.")
@@ -207,7 +212,12 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var
EOSdom(:) = EOS_domain(G%HI, halo=1)
do j = js-1, je+1
dK(:) = 0.5 * h(:,j,1) ! Depth of center of surface layer
- call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, tv%eqn_of_state, EOSdom)
+ if (CS%use_stanley_ml) then
+ call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, tv%varT(:,j,1), covTS, varS, &
+ rhoSurf, tv%eqn_of_state, EOSdom)
+ else
+ call calculate_density(tv%T(:,j,1), tv%S(:,j,1), pRef_MLD, rhoSurf, tv%eqn_of_state, EOSdom)
+ endif
deltaRhoAtK(:) = 0.
MLD_fast(:,j) = 0.
do k = 2, nz
@@ -215,7 +225,12 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var
dK(:) = dK(:) + 0.5 * ( h(:,j,k) + h(:,j,k-1) ) ! Depth of center of layer K
! Mixed-layer depth, using sigma-0 (surface reference pressure)
deltaRhoAtKm1(:) = deltaRhoAtK(:) ! Store value from previous iteration of K
- call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_MLD, deltaRhoAtK, tv%eqn_of_state, EOSdom)
+ if (CS%use_stanley_ml) then
+ call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_MLD, tv%varT(:,j,k), covTS, varS, &
+ deltaRhoAtK, tv%eqn_of_state, EOSdom)
+ else
+ call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_MLD, deltaRhoAtK, tv%eqn_of_state, EOSdom)
+ endif
do i = is-1,ie+1
deltaRhoAtK(i) = deltaRhoAtK(i) - rhoSurf(i) ! Density difference between layer K and surface
enddo
@@ -312,7 +327,12 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var
h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0)
enddo
if (keep_going) then
- call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, rho_ml(:), tv%eqn_of_state, EOSdom)
+ if (CS%use_stanley_ml) then
+ call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, tv%varT(:,j,k), covTS, varS, &
+ rho_ml(:), tv%eqn_of_state, EOSdom)
+ else
+ call calculate_density(tv%T(:,j,k), tv%S(:,j,k), p0, rho_ml(:), tv%eqn_of_state, EOSdom)
+ endif
line_is_empty = .true.
do i=is-1,ie+1
if (htot_fast(i,j) < MLD_fast(i,j)) then
@@ -628,6 +648,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS)
if ((nkml<2) .or. (CS%ml_restrat_coef<=0.0)) return
+
h_min = 0.5*GV%Angstrom_H ! This should be GV%Angstrom_H, but that value would change answers.
uDml(:) = 0.0 ; vDml(:) = 0.0
I4dt = 0.25 / dt
@@ -639,6 +660,10 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS)
if (.not.use_EOS) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// &
"An equation of state must be used with this module.")
+ if (CS%use_stanley_ml) call MOM_error(FATAL, &
+ "MOM_mixedlayer_restrat: The Stanley parameterization is not"//&
+ "available with the BML.")
+
! Fix this later for nkml >= 3.
p0(:) = 0.0
@@ -849,6 +874,9 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS,
"geostrophic kinetic energy or 1 plus the square of the "//&
"grid spacing over the deformation radius, as detailed "//&
"by Fox-Kemper et al. (2010)", units="nondim", default=0.0)
+ call get_param(param_file, mdl, "USE_STANLEY_ML", CS%use_stanley_ml, &
+ "If true, turn on Stanley SGS T variance parameterization "// &
+ "in ML restrat code.", default=.false.)
! We use GV%nkml to distinguish between the old and new implementation of MLE.
! The old implementation only works for the layer model with nkml>0.
if (GV%nkml==0) then
diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90
index 88376e83b9..89ba800e92 100644
--- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90
+++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90
@@ -83,6 +83,7 @@ module MOM_thickness_diffuse
real :: Stanley_det_coeff !< The coefficient correlating SGS temperature variance with the mean
!! temperature gradient in the deterministic part of the Stanley parameterization.
!! Negative values disable the scheme. [nondim]
+ logical :: use_stanley_gm !< If true, also use the Stanley parameterization in MOM_thickness_diffuse
type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics
real, allocatable :: GMwork(:,:) !< Work by thickness diffusivity [R Z L2 T-3 ~> W m-2]
@@ -615,15 +616,15 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
h_avail_rsum ! The running sum of h_avail above an interface [H L2 T-1 ~> m3 s-1 or kg s-1].
real, dimension(SZIB_(G)) :: &
drho_dT_u, & ! The derivative of density with temperature at u points [R degC-1 ~> kg m-3 degC-1]
- drho_dS_u, & ! The derivative of density with salinity at u points [R ppt-1 ~> kg m-3 ppt-1].
- drho_dT_dT_u ! The second derivative of density with temperature at u points [R degC-2 ~> kg m-3 degC-2]
- real, dimension(SZIB_(G)) :: scrap ! An array to pass to calculate_density_second_derivs() that will be ignored.
+ drho_dS_u ! The derivative of density with salinity at u points [R ppt-1 ~> kg m-3 ppt-1].
+ real, dimension(SZI_(G)) :: scrap ! An array to pass to calculate_density_second_derivs() that will be ingored.
real, dimension(SZI_(G)) :: &
drho_dT_v, & ! The derivative of density with temperature at v points [R degC-1 ~> kg m-3 degC-1]
drho_dS_v, & ! The derivative of density with salinity at v points [R ppt-1 ~> kg m-3 ppt-1].
- drho_dT_dT_v ! The second derivative of density with temperature at v points [R degC-2 ~> kg m-3 degC-2]
- real :: uhtot(SZIB_(G),SZJ_(G)) ! The vertical sum of uhD [H L2 T-1 ~> m3 s-1 or kg s-1].
- real :: vhtot(SZI_(G),SZJB_(G)) ! The vertical sum of vhD [H L2 T-1 ~> m3 s-1 or kg s-1].
+ drho_dT_dT_h, & ! The second derivative of density with temperature at h points [R degC-2 ~> kg m-3 degC-2]
+ drho_dT_dT_hr ! The second derivative of density with temperature at h (+1) points [R degC-2 ~> kg m-3 degC-2]
+ real :: uhtot(SZIB_(G), SZJ_(G)) ! The vertical sum of uhD [H L2 T-1 ~> m3 s-1 or kg s-1].
+ real :: vhtot(SZI_(G), SZJB_(G)) ! The vertical sum of vhD [H L2 T-1 ~> m3 s-1 or kg s-1].
real, dimension(SZIB_(G)) :: &
T_u, & ! Temperature on the interface at the u-point [degC].
S_u, & ! Salinity on the interface at the u-point [ppt].
@@ -631,9 +632,15 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
real, dimension(SZI_(G)) :: &
T_v, & ! Temperature on the interface at the v-point [degC].
S_v, & ! Salinity on the interface at the v-point [ppt].
- pres_v ! Pressure on the interface at the v-point [R L2 T-2 ~> Pa].
- real :: Work_u(SZIB_(G),SZJ_(G)) ! The work being done by the thickness
- real :: Work_v(SZI_(G),SZJB_(G)) ! diffusion integrated over a cell [R Z L4 T-3 ~> W]
+ pres_v, & ! Pressure on the interface at the v-point [R L2 T-2 ~> Pa].
+ T_h, & ! Temperature on the interface at the h-point [degC].
+ S_h, & ! Salinity on the interface at the h-point [ppt].
+ pres_h, & ! Pressure on the interface at the h-point [R L2 T-2 ~> Pa].
+ T_hr, & ! Temperature on the interface at the h (+1) point [degC].
+ S_hr, & ! Salinity on the interface at the h (+1) point [ppt].
+ pres_hr ! Pressure on the interface at the h (+1) point [R L2 T-2 ~> Pa].
+ real :: Work_u(SZIB_(G), SZJ_(G)) ! The work being done by the thickness
+ real :: Work_v(SZI_(G), SZJB_(G)) ! diffusion integrated over a cell [R Z L4 T-3 ~> W ]
real :: Work_h ! The work averaged over an h-cell [R Z L2 T-3 ~> W m-2].
real :: PE_release_h ! The amount of potential energy released by GM averaged over an h-cell [L4 Z-1 T-3 ~> m3 s-3]
! The calculation is equal to h * S^2 * N^2 * kappa_GM.
@@ -693,7 +700,6 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
real :: hl(5) ! Copy of local stencil of H [H ~> m]
real :: r_sm_H ! Reciprocal of sum of H in local stencil [H-1 ~> m-1]
real :: Tsgs2(SZI_(G),SZJ_(G),SZK_(GV)) ! Sub-grid temperature variance [degC2]
-
real :: diag_sfn_x(SZIB_(G),SZJ_(G),SZK_(GV)+1) ! Diagnostic of the x-face streamfunction
! [H L2 T-1 ~> m3 s-1 or kg s-1]
real :: diag_sfn_unlim_x(SZIB_(G),SZJ_(G),SZK_(GV)+1) ! Diagnostic of the x-face streamfunction before
@@ -707,7 +713,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
! state calculations at u-points.
integer, dimension(2) :: EOSdom_v ! The shifted I-computational domain to use for equation of
! state calculations at v-points.
- logical :: use_Stanley
+ logical :: use_stanley
integer :: is, ie, js, je, nz, IsdB, halo
integer :: i, j, k
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ; IsdB = G%IsdB
@@ -724,7 +730,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
use_EOS = associated(tv%eqn_of_state)
present_slope_x = PRESENT(slope_x)
present_slope_y = PRESENT(slope_y)
- use_Stanley = CS%Stanley_det_coeff >= 0.
+
+ use_stanley = CS%use_stanley_gm
nk_linear = max(GV%nkml, 1)
@@ -738,7 +745,6 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
if (use_EOS) then
halo = 1 ! Default halo to fill is 1
- if (use_Stanley) halo = 2 ! Need wider valid halo for gradients of T
call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, halo, larger_h_denom=.true.)
endif
@@ -758,42 +764,6 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
h_frac(i,j,1) = 1.0
pres(i,j,2) = pres(i,j,1) + (GV%g_Earth*GV%H_to_RZ) * h(i,j,1)
enddo ; enddo
- if (use_Stanley) then
- !$OMP do
- do k=1, nz ; do j=js-1,je+1 ; do i=is-1,ie+1
- !! SGS variance in i-direction [degC2]
- !dTdi2 = ( ( G%mask2dCu(I ,j) * G%IdxCu(I ,j) * ( T(i+1,j,k) - T(i,j,k) ) &
- ! + G%mask2dCu(I-1,j) * G%IdxCu(I-1,j) * ( T(i,j,k) - T(i-1,j,k) ) &
- ! ) * G%dxT(i,j) * 0.5 )**2
- !! SGS variance in j-direction [degC2]
- !dTdj2 = ( ( G%mask2dCv(i,J ) * G%IdyCv(i,J ) * ( T(i,j+1,k) - T(i,j,k) ) &
- ! + G%mask2dCv(i,J-1) * G%IdyCv(i,J-1) * ( T(i,j,k) - T(i,j-1,k) ) &
- ! ) * G%dyT(i,j) * 0.5 )**2
- !Tsgs2(i,j,k) = CS%Stanley_det_coeff * 0.5 * ( dTdi2 + dTdj2 )
- ! This block does a thickness weighted variance calculation and helps control for
- ! extreme gradients along layers which are vanished against topography. It is
- ! still a poor approximation in the interior when coordinates are strongly tilted.
- hl(1) = h(i,j,k) * G%mask2dT(i,j)
- hl(2) = h(i-1,j,k) * G%mask2dCu(I-1,j)
- hl(3) = h(i+1,j,k) * G%mask2dCu(I,j)
- hl(4) = h(i,j-1,k) * G%mask2dCv(i,J-1)
- hl(5) = h(i,j+1,k) * G%mask2dCv(i,J)
- r_sm_H = 1. / ( ( hl(1) + ( ( hl(2) + hl(3) ) + ( hl(4) + hl(5) ) ) ) + GV%H_subroundoff )
- ! Mean of T
- Tl(1) = T(i,j,k) ; Tl(2) = T(i-1,j,k) ; Tl(3) = T(i+1,j,k)
- Tl(4) = T(i,j-1,k) ; Tl(5) = T(i,j+1,k)
- mn_T = ( hl(1)*Tl(1) + ( ( hl(2)*Tl(2) + hl(3)*Tl(3) ) + ( hl(4)*Tl(4) + hl(5)*Tl(5) ) ) ) * r_sm_H
- ! Adjust T vectors to have zero mean
- Tl(:) = Tl(:) - mn_T ; mn_T = 0.
- ! Variance of T
- mn_T2 = ( hl(1)*Tl(1)*Tl(1) + ( ( hl(2)*Tl(2)*Tl(2) + hl(3)*Tl(3)*Tl(3) ) &
- + ( hl(4)*Tl(4)*Tl(4) + hl(5)*Tl(5)*Tl(5) ) ) ) * r_sm_H
- ! Variance should be positive but round-off can violate this. Calculating
- ! variance directly would fix this but requires more operations.
- Tsgs2(i,j,k) = CS%Stanley_det_coeff * max(0., mn_T2)
- enddo ; enddo ; enddo
- endif
- !$OMP do
do j=js-1,je+1
do k=2,nz ; do i=is-1,ie+1
h_avail(i,j,k) = max(I4dt*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0)
@@ -828,7 +798,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
!$OMP present_slope_x,G_rho0,Slope_x_PE,hN2_x_PE) &
!$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, &
!$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, &
- !$OMP drho_dT_dT_u,scrap, &
+ !$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h, &
!$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, &
!$OMP drdx,mag_grad2,Slope,slope2_Ratio_u,hN2_u, &
!$OMP Sfn_unlim_u,drdi_u,drdkDe_u,h_harm,c2_h_u, &
@@ -842,7 +812,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
endif
calc_derivatives = use_EOS .and. (k >= nk_linear) .and. &
- (find_work .or. .not. present_slope_x .or. CS%use_FGNV_streamfn .or. use_Stanley)
+ (find_work .or. .not. present_slope_x .or. CS%use_FGNV_streamfn .or. use_stanley)
! Calculate the zonal fluxes and gradients.
if (calc_derivatives) then
@@ -854,12 +824,17 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
call calculate_density_derivs(T_u, S_u, pres_u, drho_dT_u, drho_dS_u, &
tv%eqn_of_state, EOSdom_u)
endif
- if (use_Stanley) then
+ if (use_stanley) then
+ do i=is-1,ie+1
+ pres_h(i) = pres(i,j,K)
+ T_h(i) = 0.5*(T(i,j,k) + T(i,j,k-1))
+ S_h(i) = 0.5*(S(i,j,k) + S(i,j,k-1))
+ enddo
! The second line below would correspond to arguments
! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, &
- call calculate_density_second_derivs(T_u, S_u, pres_u, &
- scrap, scrap, drho_dT_dT_u, scrap, scrap, &
- (is-IsdB+1)-1, ie-is+2, tv%eqn_of_state)
+ call calculate_density_second_derivs(T_h, S_h, pres_h, &
+ scrap, scrap, drho_dT_dT_h, scrap, scrap, &
+ is-1, ie-is+3, tv%eqn_of_state)
endif
do I=is-1,ie
@@ -879,11 +854,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
elseif (find_work) then ! This is used in pure stacked SW mode
drdkDe_u(I,K) = drdkR * e(i+1,j,K) - drdkL * e(i,j,K)
endif
- if (use_Stanley) then
+ if (use_stanley) then
! Correction to the horizontal density gradient due to nonlinearity in
! the EOS rectifying SGS temperature anomalies
- drdiA = drdiA + drho_dT_dT_u(I) * 0.5 * ( Tsgs2(i+1,j,k-1)-Tsgs2(i,j,k-1) )
- drdiB = drdiB + drho_dT_dT_u(I) * 0.5 * ( Tsgs2(i+1,j,k)-Tsgs2(i,j,k) )
+ drdiA = drdiA + 0.5 * ((drho_dT_dT_h(i+1) * tv%varT(i+1,j,k-1)) - &
+ (drho_dT_dT_h(i) * tv%varT(i,j,k-1)) )
+ drdiB = drdiB + 0.5 * ((drho_dT_dT_h(i+1) * tv%varT(i+1,j,k)) - &
+ (drho_dT_dT_h(i) * tv%varT(i,j,k)) )
endif
if (find_work) drdi_u(I,k) = drdiB
@@ -1094,13 +1071,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
!$OMP h_neglect2,int_slope_v,KH_v,vhtot,h_frac,h_avail_rsum, &
!$OMP vhD,h_avail,G_scale,Work_v,CS,slope_y,cg1,diag_sfn_y, &
!$OMP diag_sfn_unlim_y,N2_floor,EOSdom_v,use_stanley,Tsgs2, &
- !$OMP present_slope_y,G_rho0,Slope_y_PE,hN2_y_PE) &
- !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v, &
- !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, &
- !$OMP drho_dT_dT_v,scrap, &
- !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, &
- !$OMP drdy,mag_grad2,Slope,slope2_Ratio_v,hN2_v, &
- !$OMP Sfn_unlim_v,drdj_v,drdkDe_v,h_harm,c2_h_v, &
+ !$OMP present_slope_y,G_rho0,Slope_y_PE,hN2_y_PE) &
+ !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v,S_h,S_hr, &
+ !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, &
+ !$OMP drho_dT_dT_h,drho_dT_dT_hr, scrap,pres_h,T_h,T_hr, &
+ !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz,pres_hr, &
+ !$OMP drdy,mag_grad2,Slope,slope2_Ratio_v,hN2_v, &
+ !$OMP Sfn_unlim_v,drdj_v,drdkDe_v,h_harm,c2_h_v, &
!$OMP Sfn_safe,Sfn_est,Sfn_in_h,calc_derivatives)
do J=js-1,je
do K=nz,2,-1
@@ -1110,7 +1087,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
endif
calc_derivatives = use_EOS .and. (k >= nk_linear) .and. &
- (find_work .or. .not. present_slope_y .or. CS%use_FGNV_streamfn .or. use_Stanley)
+ (find_work .or. .not. present_slope_y .or. CS%use_FGNV_streamfn .or. use_stanley)
if (calc_derivatives) then
do i=is,ie
@@ -1121,11 +1098,23 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
call calculate_density_derivs(T_v, S_v, pres_v, drho_dT_v, drho_dS_v, &
tv%eqn_of_state, EOSdom_v)
endif
- if (use_Stanley) then
+ if (use_stanley) then
+ do i=is,ie
+ pres_h(i) = pres(i,j,K)
+ T_h(i) = 0.5*(T(i,j,k) + T(i,j,k-1))
+ S_h(i) = 0.5*(S(i,j,k) + S(i,j,k-1))
+
+ pres_hr(i) = pres(i,j+1,K)
+ T_hr(i) = 0.5*(T(i,j+1,k) + T(i,j+1,k-1))
+ S_hr(i) = 0.5*(S(i,j+1,k) + S(i,j+1,k-1))
+ enddo
! The second line below would correspond to arguments
! drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, &
- call calculate_density_second_derivs(T_v, S_v, pres_v, &
- scrap, scrap, drho_dT_dT_v, scrap, scrap, &
+ call calculate_density_second_derivs(T_h, S_h, pres_h, &
+ scrap, scrap, drho_dT_dT_h, scrap, scrap, &
+ is, ie-is+1, tv%eqn_of_state)
+ call calculate_density_second_derivs(T_hr, S_hr, pres_hr, &
+ scrap, scrap, drho_dT_dT_hr, scrap, scrap, &
is, ie-is+1, tv%eqn_of_state)
endif
do i=is,ie
@@ -1145,11 +1134,13 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV
elseif (find_work) then ! This is used in pure stacked SW mode
drdkDe_v(i,K) = drdkR * e(i,j+1,K) - drdkL * e(i,j,K)
endif
- if (use_Stanley) then
+ if (use_stanley) then
! Correction to the horizontal density gradient due to nonlinearity in
! the EOS rectifying SGS temperature anomalies
- drdjA = drdjA + drho_dT_dT_v(I) * 0.5 * ( Tsgs2(i,j+1,k-1)-Tsgs2(i,j,k-1) )
- drdjB = drdjB + drho_dT_dT_v(I) * 0.5 * ( Tsgs2(i,j+1,k)-Tsgs2(i,j,k) )
+ drdjA = drdjA + 0.5 * ((drho_dT_dT_hr(i) * tv%varT(i,j+1,k-1)) - &
+ (drho_dT_dT_h(i) * tv%varT(i,j,k-1)) )
+ drdjB = drdjB + 0.5 * ((drho_dT_dT_hr(i) * tv%varT(i,j+1,k)) - &
+ (drho_dT_dT_h(i) * tv%varT(i,j,k)) )
endif
if (find_work) drdj_v(i,k) = drdjB
@@ -2049,10 +2040,9 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS)
"streamfunction formulation, expressed as a fraction of planetary "//&
"rotation, OMEGA. This should be tiny but non-zero to avoid degeneracy.", &
default=1.e-15, units="nondim", do_not_log=.not.CS%use_FGNV_streamfn)
- call get_param(param_file, mdl, "STANLEY_PRM_DET_COEFF", CS%Stanley_det_coeff, &
- "The coefficient correlating SGS temperature variance with the mean "//&
- "temperature gradient in the deterministic part of the Stanley parameterization. "//&
- "Negative values disable the scheme.", units="nondim", default=-1.0)
+ call get_param(param_file, mdl, "USE_STANLEY_GM", CS%use_stanley_gm, &
+ "If true, turn on Stanley SGS T variance parameterization "// &
+ "in GM code.", default=.false.)
call get_param(param_file, mdl, "OMEGA", omega, &
"The rotation rate of the earth.", &
default=7.2921e-5, units="s-1", scale=US%T_to_s, do_not_log=.not.CS%use_FGNV_streamfn)
diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90
index 30818a6f1f..4f495a1f0b 100644
--- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90
+++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90
@@ -19,6 +19,7 @@ module MOM_CVMix_KPP
use MOM_domains, only : pass_var
use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end
use MOM_cpu_clock, only : CLOCK_MODULE, CLOCK_ROUTINE
+use MOM_tracer_types, only : tracer_type
use CVMix_kpp, only : CVMix_init_kpp, CVMix_put_kpp, CVMix_get_kpp_real
use CVMix_kpp, only : CVMix_coeffs_kpp
@@ -39,6 +40,7 @@ module MOM_CVMix_KPP
public :: KPP_end
public :: KPP_NonLocalTransport_temp
public :: KPP_NonLocalTransport_saln
+public :: KPP_NonLocalTransport
public :: KPP_get_BLD
! Enumerated constants
@@ -92,7 +94,7 @@ module MOM_CVMix_KPP
logical :: debug !< If True, calculate checksums and write debugging information
character(len=30) :: MatchTechnique !< Method used in CVMix for setting diffusivity and NLT profile functions
integer :: NLT_shape !< MOM6 over-ride of CVMix NLT shape function
- logical :: applyNonLocalTrans !< If True, apply non-local transport to heat and scalars
+ logical :: applyNonLocalTrans !< If True, apply non-local transport to all tracers
integer :: n_smooth !< Number of times smoothing operator is applied on OBLdepth.
logical :: deepen_only !< If true, apply OBLdepth smoothing at a cell only if the OBLdepth gets deeper.
logical :: KPPzeroDiffusivity !< If True, will set diffusivity and viscosity from KPP to zero
@@ -127,7 +129,6 @@ module MOM_CVMix_KPP
integer :: id_Ws = -1, id_Vt2 = -1
integer :: id_BulkUz2 = -1, id_BulkDrho = -1
integer :: id_uStar = -1, id_buoyFlux = -1
- integer :: id_QminusSW = -1, id_netS = -1
integer :: id_sigma = -1, id_Kv_KPP = -1
integer :: id_Kt_KPP = -1, id_Ks_KPP = -1
integer :: id_Tsurf = -1, id_Ssurf = -1
@@ -135,10 +136,6 @@ module MOM_CVMix_KPP
integer :: id_Kd_in = -1
integer :: id_NLTt = -1
integer :: id_NLTs = -1
- integer :: id_NLT_dSdt = -1
- integer :: id_NLT_dTdt = -1
- integer :: id_NLT_temp_budget = -1
- integer :: id_NLT_saln_budget = -1
integer :: id_EnhK = -1, id_EnhVt2 = -1
integer :: id_EnhW = -1
integer :: id_La_SL = -1
@@ -226,7 +223,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive)
if (present(passive)) passive=CS%passiveMode ! This is passed back to the caller so
! the caller knows to not use KPP output
call get_param(paramFile, mdl, 'APPLY_NONLOCAL_TRANSPORT', CS%applyNonLocalTrans, &
- 'If True, applies the non-local transport to heat and scalars. '// &
+ 'If True, applies the non-local transport to all tracers. '// &
'If False, calculates the non-local transport and tendencies but '//&
'purely for diagnostic purposes.', &
default=.not. CS%passiveMode)
@@ -536,10 +533,6 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive)
'Friction velocity, u*, as used by [CVMix] KPP', 'm/s', conversion=US%Z_to_m*US%s_to_T)
CS%id_buoyFlux = register_diag_field('ocean_model', 'KPP_buoyFlux', diag%axesTi, Time, &
'Surface (and penetrating) buoyancy flux, as used by [CVMix] KPP', 'm2/s3', conversion=US%L_to_m**2*US%s_to_T**3)
- CS%id_QminusSW = register_diag_field('ocean_model', 'KPP_QminusSW', diag%axesT1, Time, &
- 'Net temperature flux ignoring short-wave, as used by [CVMix] KPP', 'K m/s', conversion=GV%H_to_m*US%s_to_T)
- CS%id_netS = register_diag_field('ocean_model', 'KPP_netSalt', diag%axesT1, Time, &
- 'Effective net surface salt flux, as used by [CVMix] KPP', 'ppt m/s', conversion=GV%H_to_m*US%s_to_T)
CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, &
'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s')
CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, &
@@ -552,18 +545,6 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive)
'Non-local transport (Cs*G(sigma)) for heat, as calculated by [CVMix] KPP', 'nondim')
CS%id_NLTs = register_diag_field('ocean_model', 'KPP_NLtransport_salt', diag%axesTi, Time, &
'Non-local tranpsort (Cs*G(sigma)) for scalars, as calculated by [CVMix] KPP', 'nondim')
- CS%id_NLT_dTdt = register_diag_field('ocean_model', 'KPP_NLT_dTdt', diag%axesTL, Time, &
- 'Temperature tendency due to non-local transport of heat, as calculated by [CVMix] KPP', &
- 'K/s', conversion=US%s_to_T)
- CS%id_NLT_dSdt = register_diag_field('ocean_model', 'KPP_NLT_dSdt', diag%axesTL, Time, &
- 'Salinity tendency due to non-local transport of salt, as calculated by [CVMix] KPP', &
- 'ppt/s', conversion=US%s_to_T)
- CS%id_NLT_temp_budget = register_diag_field('ocean_model', 'KPP_NLT_temp_budget', diag%axesTL, Time, &
- 'Heat content change due to non-local transport, as calculated by [CVMix] KPP', &
- 'W/m^2', conversion=US%QRZ_T_to_W_m2)
- CS%id_NLT_saln_budget = register_diag_field('ocean_model', 'KPP_NLT_saln_budget', diag%axesTL, Time, &
- 'Salt content change due to non-local transport, as calculated by [CVMix] KPP', &
- 'kg/(sec*m^2)', conversion=US%RZ_T_to_kg_m2s)
CS%id_Tsurf = register_diag_field('ocean_model', 'KPP_Tsurf', diag%axesT1, Time, &
'Temperature of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'C')
CS%id_Ssurf = register_diag_field('ocean_model', 'KPP_Ssurf', diag%axesT1, Time, &
@@ -1115,7 +1096,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl
enddo ! k-loop finishes
- if (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) then
+ if ( (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) .and. .not. present(lamult)) then
MLD_GUESS = max( 1.*US%m_to_Z, abs(US%m_to_Z*CS%OBLdepthprev(i,j) ) )
call get_Langmuir_Number(LA, G, GV, US, MLD_guess, uStar(i,j), i, j, &
H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES)
@@ -1379,10 +1360,75 @@ subroutine KPP_get_BLD(CS, BLD, G, US, m_to_BLD_units)
end subroutine KPP_get_BLD
-!> Apply KPP non-local transport of surface fluxes for temperature.
-subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, &
- dt, scalar, C_p)
+!> Apply KPP non-local transport of surface fluxes for a given tracer
+subroutine KPP_NonLocalTransport(CS, G, GV, h, nonLocalTrans, surfFlux, &
+ dt, diag, tr_ptr, scalar, flux_scale)
+ type(KPP_CS), intent(in) :: CS !< Control structure
+ type(ocean_grid_type), intent(in) :: G !< Ocean grid
+ type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: nonLocalTrans !< Non-local transport [nondim]
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of scalar
+ !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1]
+ real, intent(in) :: dt !< Time-step [T ~> s]
+ type(diag_ctrl), target, intent(in) :: diag !< Diagnostics
+ type(tracer_type), pointer, intent(in) :: tr_ptr !< tracer_type has diagnostic ids on it
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Scalar (scalar units [conc])
+ real, optional, intent(in) :: flux_scale !< Scale factor to get surfFlux
+ !! into proper units
+
+ integer :: i, j, k
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: dtracer ! Rate of tracer change [conc T-1 ~> conc s-1]
+ real, dimension(SZI_(G),SZJ_(G)) :: surfFlux_loc
+
+ ! term used to scale
+ if (present(flux_scale)) then
+ do j = G%jsc, G%jec ; do i = G%isc, G%iec
+ surfFlux_loc(i,j) = surfFlux(i,j) * flux_scale
+ enddo ; enddo
+ else
+ surfFlux_loc(:,:) = surfFlux(:,:)
+ endif
+
+ ! Post surface flux diagnostic
+ if (tr_ptr%id_net_surfflux > 0) call post_data(tr_ptr%id_net_surfflux, surfFlux_loc(:,:), diag)
+
+ ! Only continue if we are applying the nonlocal tendency
+ ! or the nonlocal tendency diagnostic has been requested
+ if ((tr_ptr%id_NLT_tendency > 0) .or. (CS%applyNonLocalTrans)) then
+
+ !$OMP parallel do default(none) shared(dtracer, nonLocalTrans, h, G, GV, surfFlux_loc)
+ do k = 1, GV%ke ; do j = G%jsc, G%jec ; do i = G%isc, G%iec
+ dtracer(i,j,k) = ( nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1) ) / &
+ ( h(i,j,k) + GV%H_subroundoff ) * surfFlux_loc(i,j)
+ enddo ; enddo ; enddo
+
+ ! Update tracer due to non-local redistribution of surface flux
+ if (CS%applyNonLocalTrans) then
+ !$OMP parallel do default(none) shared(G, GV, dt, scalar, dtracer)
+ do k = 1, GV%ke ; do j = G%jsc, G%jec ; do i = G%isc, G%iec
+ scalar(i,j,k) = scalar(i,j,k) + dt * dtracer(i,j,k)
+ enddo ; enddo ; enddo
+ endif
+ if (tr_ptr%id_NLT_tendency > 0) call post_data(tr_ptr%id_NLT_tendency, dtracer, diag)
+
+ endif
+
+
+ if (tr_ptr%id_NLT_budget > 0) then
+ !$OMP parallel do default(none) shared(G, GV, dtracer, nonLocalTrans, surfFlux_loc)
+ do k = 1, GV%ke ; do j = G%jsc, G%jec ; do i = G%isc, G%iec
+ ! Here dtracer has units of [Q R Z T-1 ~> W m-2].
+ dtracer(i,j,k) = (nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1)) * surfFlux_loc(i,j)
+ enddo ; enddo ; enddo
+ call post_data(tr_ptr%id_NLT_budget, dtracer(:,:,:), diag)
+ endif
+
+end subroutine KPP_NonLocalTransport
+
+!> Apply KPP non-local transport of surface fluxes for temperature.
+subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, dt, tr_ptr, scalar, C_p)
type(KPP_CS), intent(in) :: CS !< Control structure
type(ocean_grid_type), intent(in) :: G !< Ocean grid
type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid
@@ -1391,116 +1437,32 @@ subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, &
real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of temperature
!! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1]
real, intent(in) :: dt !< Time-step [T ~> s]
+ type(tracer_type), pointer, intent(in) :: tr_ptr !< tracer_type has diagnostic ids on it
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< temperature [degC]
real, intent(in) :: C_p !< Seawater specific heat capacity
!! [Q degC-1 ~> J kg-1 degC-1]
- integer :: i, j, k
- real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer ! Rate of tracer change [degC T-1 ~> degC s-1]
-
-
- dtracer(:,:,:) = 0.0
- !$OMP parallel do default(none) shared(dtracer, nonLocalTrans, h, G, GV, surfFlux)
- do k = 1, GV%ke
- do j = G%jsc, G%jec
- do i = G%isc, G%iec
- dtracer(i,j,k) = ( nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1) ) / &
- ( h(i,j,k) + GV%H_subroundoff ) * surfFlux(i,j)
- enddo
- enddo
- enddo
-
- ! Update tracer due to non-local redistribution of surface flux
- if (CS%applyNonLocalTrans) then
- !$OMP parallel do default(none) shared(dt, scalar, dtracer, G, GV)
- do k = 1, GV%ke
- do j = G%jsc, G%jec
- do i = G%isc, G%iec
- scalar(i,j,k) = scalar(i,j,k) + dt * dtracer(i,j,k)
- enddo
- enddo
- enddo
- endif
-
- ! Diagnostics
- if (CS%id_QminusSW > 0) call post_data(CS%id_QminusSW, surfFlux, CS%diag)
- if (CS%id_NLT_dTdt > 0) call post_data(CS%id_NLT_dTdt, dtracer, CS%diag)
- if (CS%id_NLT_temp_budget > 0) then
- dtracer(:,:,:) = 0.0
- !$OMP parallel do default(none) shared(dtracer, nonLocalTrans, surfFlux, C_p, G, GV)
- do k = 1, GV%ke
- do j = G%jsc, G%jec
- do i = G%isc, G%iec
- ! Here dtracer has units of [Q R Z T-1 ~> W m-2].
- dtracer(i,j,k) = (nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1)) * &
- surfFlux(i,j) * C_p * GV%H_to_RZ
- enddo
- enddo
- enddo
- call post_data(CS%id_NLT_temp_budget, dtracer, CS%diag)
- endif
+ call KPP_NonLocalTransport(CS, G, GV, h, nonLocalTrans, surfFlux, dt, CS%diag, &
+ tr_ptr, scalar)
end subroutine KPP_NonLocalTransport_temp
!> Apply KPP non-local transport of surface fluxes for salinity.
-!> This routine is a useful prototype for other material tracers.
-subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, scalar)
-
- type(KPP_CS), intent(in) :: CS !< Control structure
- type(ocean_grid_type), intent(in) :: G !< Ocean grid
- type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2]
+subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, tr_ptr, scalar)
+ type(KPP_CS), intent(in) :: CS !< Control structure
+ type(ocean_grid_type), intent(in) :: G !< Ocean grid
+ type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2]
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: nonLocalTrans !< Non-local transport [nondim]
- real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of salt
+ real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of salt
!! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1]
- real, intent(in) :: dt !< Time-step [T ~> s]
- real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Salinity [ppt]
-
- integer :: i, j, k
- real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer ! Rate of tracer change [ppt T-1 ~> ppt s-1]
-
-
- dtracer(:,:,:) = 0.0
- !$OMP parallel do default(none) shared(dtracer, nonLocalTrans, h, G, GV, surfFlux)
- do k = 1, GV%ke
- do j = G%jsc, G%jec
- do i = G%isc, G%iec
- dtracer(i,j,k) = ( nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1) ) / &
- ( h(i,j,k) + GV%H_subroundoff ) * surfFlux(i,j)
- enddo
- enddo
- enddo
+ real, intent(in) :: dt !< Time-step [T ~> s]
+ real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Salinity [ppt]
+ type(tracer_type), pointer, intent(in) :: tr_ptr !< tracer_type has diagnostic ids on it
- ! Update tracer due to non-local redistribution of surface flux
- if (CS%applyNonLocalTrans) then
- !$OMP parallel do default(none) shared(G, GV, dt, scalar, dtracer)
- do k = 1, GV%ke
- do j = G%jsc, G%jec
- do i = G%isc, G%iec
- scalar(i,j,k) = scalar(i,j,k) + dt * dtracer(i,j,k)
- enddo
- enddo
- enddo
- endif
-
- ! Diagnostics
- if (CS%id_netS > 0) call post_data(CS%id_netS, surfFlux, CS%diag)
- if (CS%id_NLT_dSdt > 0) call post_data(CS%id_NLT_dSdt, dtracer, CS%diag)
- if (CS%id_NLT_saln_budget > 0) then
- dtracer(:,:,:) = 0.0
- !$OMP parallel do default(none) shared(G, GV, dtracer, nonLocalTrans, surfFlux)
- do k = 1, GV%ke
- do j = G%jsc, G%jec
- do i = G%isc, G%iec
- ! Here dtracer has units of [ppt R Z T-1 ~> ppt kg m-2 s-1]
- dtracer(i,j,k) = (nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1)) * &
- surfFlux(i,j) * GV%H_to_RZ
- enddo
- enddo
- enddo
- call post_data(CS%id_NLT_saln_budget, dtracer, CS%diag)
- endif
+ call KPP_NonLocalTransport(CS, G, GV, h, nonLocalTrans, surfFlux, dt, CS%diag, &
+ tr_ptr, scalar)
end subroutine KPP_NonLocalTransport_saln
diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90
index 405251eaee..2a1f6b7ea6 100644
--- a/src/parameterizations/vertical/MOM_diabatic_aux.F90
+++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90
@@ -1030,7 +1030,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
real :: dThickness, dTemp, dSalt
real :: fractionOfForcing, hOld, Ithickness
real :: RivermixConst ! A constant used in implementing river mixing [R Z2 T-1 ~> Pa s].
-
+ real :: EnthalpyConst ! A constant used to control the enthalpy calculation
+ ! By default EnthalpyConst = 1.0. If fluxes%heat_content_evap
+ ! is associated enthalpy is provided via coupler and EnthalpyConst = 0.0.
real, dimension(SZI_(G)) :: &
d_pres, & ! pressure change across a layer [R L2 T-2 ~> Pa]
p_lay, & ! average pressure in a layer [R L2 T-2 ~> Pa]
@@ -1094,6 +1096,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
! Only apply forcing if fluxes%sw is associated.
if (.not.associated(fluxes%sw) .and. .not.calculate_energetics) return
+ EnthalpyConst = 1.0
+ if (associated(fluxes%heat_content_evap)) EnthalpyConst = 0.0
+
if (calculate_buoyancy) then
SurfPressure(:) = 0.0
GoRho = US%L_to_Z**2*GV%g_Earth / GV%Rho0
@@ -1115,7 +1120,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
!$OMP nonPenSW,hGrounding,CS,Idt,aggregate_FW_forcing, &
!$OMP minimum_forcing_depth,evap_CFL_limit,dt,EOSdom, &
!$OMP calculate_buoyancy,netPen_rate,SkinBuoyFlux,GoRho, &
- !$OMP calculate_energetics,dSV_dT,dSV_dS,cTKE,g_Hconv2) &
+ !$OMP calculate_energetics,dSV_dT,dSV_dS,cTKE,g_Hconv2, &
+ !$OMP EnthalpyConst) &
!$OMP private(opacityBand,h2d,T2d,netMassInOut,netMassOut, &
!$OMP netHeat,netSalt,Pen_SW_bnd,fractionOfForcing, &
!$OMP IforcingDepthScale, &
@@ -1257,17 +1263,19 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
! This line accounts for the temperature of the mass exchange
Temp_in = T2d(i,k)
Salin_in = 0.0
- dTemp = dTemp + dThickness*Temp_in
+ dTemp = dTemp + dThickness*Temp_in*EnthalpyConst
! Diagnostics of heat content associated with mass fluxes
- if (associated(fluxes%heat_content_massin)) &
- fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + &
- T2d(i,k) * max(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt
- if (associated(fluxes%heat_content_massout)) &
- fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) + &
- T2d(i,k) * min(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt
- if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + &
- T2d(i,k) * dThickness * GV%H_to_RZ
+ if (.not. associated(fluxes%heat_content_evap)) then
+ if (associated(fluxes%heat_content_massin)) &
+ fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + &
+ T2d(i,k) * max(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt
+ if (associated(fluxes%heat_content_massout)) &
+ fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) + &
+ T2d(i,k) * min(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt
+ if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + &
+ T2d(i,k) * dThickness * GV%H_to_RZ
+ endif
! Determine the energetics of river mixing before updating the state.
if (calculate_energetics .and. associated(fluxes%lrunoff) .and. CS%do_rivermix) then
@@ -1340,17 +1348,19 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t
netSalt(i) = netSalt(i) - dSalt
! This line accounts for the temperature of the mass exchange
- dTemp = dTemp + dThickness*T2d(i,k)
+ dTemp = dTemp + dThickness*T2d(i,k)*EnthalpyConst
! Diagnostics of heat content associated with mass fluxes
- if (associated(fluxes%heat_content_massin)) &
- fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + &
- T2d(i,k) * max(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt
- if (associated(fluxes%heat_content_massout)) &
- fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) + &
- T2d(i,k) * min(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt
- if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + &
- T2d(i,k) * dThickness * GV%H_to_RZ
+ if (.not. associated(fluxes%heat_content_evap)) then
+ if (associated(fluxes%heat_content_massin)) &
+ fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + &
+ T2d(i,k) * max(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt
+ if (associated(fluxes%heat_content_massout)) &
+ fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) + &
+ T2d(i,k) * min(0.,dThickness) * GV%H_to_RZ * fluxes%C_p * Idt
+ if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + &
+ T2d(i,k) * dThickness * GV%H_to_RZ
+ endif
! Update state by the appropriate increment.
hOld = h2d(i,k) ! Keep original thickness in hand
diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90
index 1a5471c79d..8e519eafdc 100644
--- a/src/parameterizations/vertical/MOM_diabatic_driver.F90
+++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90
@@ -250,7 +250,7 @@ module MOM_diabatic_driver
real, allocatable, dimension(:,:,:) :: KPP_buoy_flux !< KPP forcing buoyancy flux [L2 T-3 ~> m2 s-3]
real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux
!! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1]
- real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux
+ real, pointer, dimension(:,:) :: KPP_salt_flux => NULL() !< KPP effective salt flux
!! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1]
type(time_type), pointer :: Time !< Pointer to model time (needed for sponges)
@@ -711,9 +711,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
! Apply non-local transport of heat and salt
! Changes: tv%T, tv%S
call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, &
- dt, tv%T, tv%C_p)
+ dt, tv%tr_T, tv%T, tv%C_p)
call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, &
- dt, tv%S)
+ dt, tv%tr_S, tv%S)
call cpu_clock_end(id_clock_kpp)
if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)")
if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US)
@@ -723,6 +723,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0)
call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G, US)
endif
+ if (.not.associated(fluxes%KPP_salt_flux)) fluxes%KPP_salt_flux => CS%KPP_salt_flux
endif ! endif for KPP
! This is the "old" method for applying differential diffusion.
@@ -1030,7 +1031,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim
! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied
call call_tracer_column_fns(h_orig, h, ent_s(:,:,1:nz), ent_s(:,:,2:nz+1), fluxes, Hml, dt, &
G, GV, US, tv, CS%optics, CS%tracer_flow_CSp, CS%debug, &
- evap_CFL_limit = CS%evap_CFL_limit, &
+ KPP_CSp=CS%KPP_CSp, &
+ nonLocalTrans=CS%KPP_NLTscalar, &
+ evap_CFL_limit=CS%evap_CFL_limit, &
minimum_forcing_depth=CS%minimum_forcing_depth)
call cpu_clock_end(id_clock_tracers)
@@ -1284,9 +1287,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end,
! Apply non-local transport of heat and salt
! Changes: tv%T, tv%S
call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, &
- dt, tv%T, tv%C_p)
+ dt, tv%tr_T, tv%T, tv%C_p)
call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, &
- dt, tv%S)
+ dt, tv%tr_S, tv%S)
call cpu_clock_end(id_clock_kpp)
if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)")
if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US)
@@ -1296,6 +1299,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end,
call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0)
call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G, US)
endif
+ if (.not.associated(fluxes%KPP_salt_flux)) fluxes%KPP_salt_flux => CS%KPP_salt_flux
endif ! endif for KPP
! Calculate vertical mixing due to convection (computed via CVMix)
@@ -1534,6 +1538,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end,
! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied
call call_tracer_column_fns(h_orig, h, ent_s(:,:,1:nz), ent_s(:,:,2:nz+1), fluxes, Hml, dt, &
G, GV, US, tv, CS%optics, CS%tracer_flow_CSp, CS%debug, &
+ KPP_CSp=CS%KPP_CSp, &
+ nonLocalTrans=CS%KPP_NLTscalar, &
evap_CFL_limit=CS%evap_CFL_limit, &
minimum_forcing_depth=CS%minimum_forcing_depth)
@@ -1881,7 +1887,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e
call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s)
endif
-
+ if (.not.associated(fluxes%KPP_salt_flux)) fluxes%KPP_salt_flux => CS%KPP_salt_flux
endif ! endif for KPP
! Add vertical diff./visc. due to convection (computed via CVMix)
@@ -1900,9 +1906,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e
! Apply non-local transport of heat and salt
! Changes: tv%T, tv%S
call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, &
- dt, tv%T, tv%C_p)
+ dt, tv%tr_T, tv%T, tv%C_p)
call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, &
- dt, tv%S)
+ dt, tv%tr_S, tv%S)
call cpu_clock_end(id_clock_kpp)
if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)")
if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US)
@@ -2295,7 +2301,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e
enddo
call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, US, tv, &
- CS%optics, CS%tracer_flow_CSp, CS%debug)
+ CS%optics, CS%tracer_flow_CSp, CS%debug, &
+ KPP_CSp=CS%KPP_CSp, &
+ nonLocalTrans=CS%KPP_NLTscalar)
elseif (CS%double_diffuse) then ! extra diffusivity for passive tracers
@@ -2316,11 +2324,15 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e
enddo ; enddo ; enddo
call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, US, tv, &
- CS%optics, CS%tracer_flow_CSp, CS%debug)
+ CS%optics, CS%tracer_flow_CSp, CS%debug, &
+ KPP_CSp=CS%KPP_CSp, &
+ nonLocalTrans=CS%KPP_NLTscalar)
else
call call_tracer_column_fns(hold, h, ea, eb, fluxes, Hml, dt, G, GV, US, tv, &
- CS%optics, CS%tracer_flow_CSp, CS%debug)
+ CS%optics, CS%tracer_flow_CSp, CS%debug, &
+ KPP_CSp=CS%KPP_CSp, &
+ nonLocalTrans=CS%KPP_NLTscalar)
endif ! (CS%mix_boundary_tracers)
@@ -2529,7 +2541,7 @@ end subroutine layered_diabatic
!> Returns pointers or values of members within the diabatic_CS type. For extensibility,
!! each returned argument is an optional argument
subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, minimum_forcing_depth, &
- KPP_CSp, energetic_PBL_CSp, diabatic_aux_CSp, diabatic_halo)
+ KPP_CSp, energetic_PBL_CSp, diabatic_aux_CSp, diabatic_halo, use_KPP)
type(diabatic_CS), target, intent(in) :: CS !< module control structure
! All output arguments are optional
type(opacity_CS), optional, pointer :: opacity_CSp !< A pointer to be set to the opacity control structure
@@ -2544,6 +2556,7 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit,
!! control structure
integer, optional, intent( out) :: diabatic_halo !< The halo size where the diabatic algorithms
!! assume thermodynamics properties are valid.
+ logical, optional, intent( out) :: use_KPP !< If true, diabatic is using KPP vertical mixing
! Pointers to control structures
if (present(opacity_CSp)) opacity_CSp => CS%opacity
@@ -2556,6 +2569,7 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit,
if (present(evap_CFL_limit)) evap_CFL_limit = CS%evap_CFL_limit
if (present(minimum_forcing_depth)) minimum_forcing_depth = CS%minimum_forcing_depth
if (present(diabatic_halo)) diabatic_halo = CS%halo_TS_diff
+ if (present(use_KPP)) use_KPP = CS%use_KPP
end subroutine extract_diabatic_member
!> Routine called for adiabatic physics
diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90
index 4728fefdff..b85cd455b1 100644
--- a/src/parameterizations/vertical/MOM_tidal_mixing.F90
+++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90
@@ -597,12 +597,15 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di
CS%id_N2_int = register_diag_field('ocean_model','N2_int',diag%axesTi,Time, &
'Bouyancy frequency squared, at interfaces', 's-2', conversion=US%s_to_T**2)
!> TODO: add units
- CS%id_Simmons_coeff = register_diag_field('ocean_model','Simmons_coeff',diag%axesT1,Time, &
- 'time-invariant portion of the tidal mixing coefficient using the Simmons', '')
- CS%id_Schmittner_coeff = register_diag_field('ocean_model','Schmittner_coeff',diag%axesTL,Time, &
- 'time-invariant portion of the tidal mixing coefficient using the Schmittner', '')
- CS%id_tidal_qe_md = register_diag_field('ocean_model','tidal_qe_md',diag%axesTL,Time, &
- 'input tidal energy dissipated locally interpolated to model vertical coordinates', '')
+ if (CS%CVMix_tidal_scheme .eq. SIMMONS) then
+ CS%id_Simmons_coeff = register_diag_field('ocean_model','Simmons_coeff',diag%axesT1,Time, &
+ 'time-invariant portion of the tidal mixing coefficient using the Simmons', '')
+ else if (CS%CVMix_tidal_scheme .eq. SCHMITTNER) then
+ CS%id_Schmittner_coeff = register_diag_field('ocean_model','Schmittner_coeff',diag%axesTL,Time, &
+ 'time-invariant portion of the tidal mixing coefficient using the Schmittner', '')
+ CS%id_tidal_qe_md = register_diag_field('ocean_model','tidal_qe_md',diag%axesTL,Time, &
+ 'input tidal energy dissipated locally interpolated to model vertical coordinates', '')
+ endif
CS%id_vert_dep = register_diag_field('ocean_model','vert_dep',diag%axesTi,Time, &
'vertical deposition function needed for Simmons et al tidal mixing', '')
diff --git a/src/tracer/MOM_CFC_cap.F90 b/src/tracer/MOM_CFC_cap.F90
index d83dc8a6c2..0e78c351a8 100644
--- a/src/tracer/MOM_CFC_cap.F90
+++ b/src/tracer/MOM_CFC_cap.F90
@@ -11,14 +11,17 @@ module MOM_CFC_cap
use MOM_forcing_type, only : forcing
use MOM_hor_index, only : hor_index_type
use MOM_grid, only : ocean_grid_type
+use MOM_CVMix_KPP, only : KPP_NonLocalTransport, KPP_CS
use MOM_io, only : file_exists, MOM_read_data, slasher
use MOM_io, only : vardesc, var_desc, query_vardesc, stdout
+use MOM_tracer_registry, only : tracer_type
use MOM_open_boundary, only : ocean_OBC_type
use MOM_restart, only : query_initialized, MOM_restart_CS
use MOM_spatial_means, only : global_mass_int_EFP
use MOM_time_manager, only : time_type
use time_interp_external_mod, only : init_external_field, time_interp_external
-use MOM_tracer_registry, only : register_tracer, tracer_registry_type
+use MOM_tracer_registry, only : register_tracer
+use MOM_tracer_types, only : tracer_registry_type
use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut
use MOM_tracer_Z_init, only : tracer_Z_init
use MOM_unit_scaling, only : unit_scale_type
@@ -35,6 +38,17 @@ module MOM_CFC_cap
integer, parameter :: NTR = 2 !< the number of tracers in this module.
+!> Contains the concentration array, a pointer to Tr in Tr_reg, and some metadata for a single CFC tracer
+type, private :: CFC_tracer_data
+ type(vardesc) :: desc !< A set of metadata for the tracer
+ real :: IC_val = 0.0 !< The initial value assigned to the tracer [mol kg-1].
+ real :: land_val = -1.0 !< The value of the tracer used where land is masked out [mol kg-1].
+ character(len=32) :: name !< Tracer variable name
+ integer :: id_cmor !< Diagnostic ID
+ real, pointer, dimension(:,:,:) :: conc !< The tracer concentration [mol kg-1].
+ type(tracer_type), pointer :: tr_ptr !< pointer to tracer inside Tr_reg
+ end type CFC_tracer_data
+
!> The control structure for the CFC_cap tracer package
type, public :: CFC_cap_CS ; private
character(len=200) :: IC_file !< The file in which the CFC initial values can
@@ -42,28 +56,13 @@ module MOM_CFC_cap
logical :: Z_IC_file !< If true, the IC_file is in Z-space. The default is false.
type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM6 tracer registry
- real, pointer, dimension(:,:,:) :: &
- CFC11 => NULL(), & !< The CFC11 concentration [mol kg-1].
- CFC12 => NULL() !< The CFC12 concentration [mol kg-1].
- ! In the following variables a suffix of _11 refers to CFC11 and _12 to CFC12.
- real :: CFC11_IC_val = 0.0 !< The initial value assigned to CFC11 [mol kg-1].
- real :: CFC12_IC_val = 0.0 !< The initial value assigned to CFC12 [mol kg-1].
- real :: CFC11_land_val = -1.0 !< The value of CFC11 used where land is masked out [mol kg-1].
- real :: CFC12_land_val = -1.0 !< The value of CFC12 used where land is masked out [mol kg-1].
logical :: tracers_may_reinit !< If true, tracers may be reset via the initialization code
!! if they are not found in the restart files.
- character(len=16) :: CFC11_name !< CFC11 variable name
- character(len=16) :: CFC12_name !< CFC12 variable name
type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate
!! the timing of diagnostic output.
type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< Model restart control structure
- ! The following vardesc types contain a package of metadata about each tracer.
- type(vardesc) :: CFC11_desc !< A set of metadata for the CFC11 tracer
- type(vardesc) :: CFC12_desc !< A set of metadata for the CFC12 tracer
- !>@{ Diagnostic IDs
- integer :: id_cfc11_cmor = -1, id_cfc12_cmor = -1
- !>@}
+ type(CFC_tracer_data), dimension(2) :: CFC_data !< per-tracer parameters / metadata
end type CFC_cap_CS
contains
@@ -87,8 +86,9 @@ function register_CFC_cap(HI, GV, param_file, CS, tr_Reg, restart_CS)
#include "version_variable.h"
real, dimension(:,:,:), pointer :: tr_ptr => NULL()
character(len=200) :: dummy ! Dummy variable to store params that need to be logged here.
+ character :: m2char
logical :: register_CFC_cap
- integer :: isd, ied, jsd, jed, nz
+ integer :: isd, ied, jsd, jed, nz, m
isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke
@@ -119,12 +119,12 @@ function register_CFC_cap(HI, GV, param_file, CS, tr_Reg, restart_CS)
"if they are not found in the restart files. Otherwise "//&
"it is a fatal error if tracers are not found in the "//&
"restart files of a restarted run.", default=.false.)
- call get_param(param_file, mdl, "CFC11_IC_VAL", CS%CFC11_IC_val, &
- "Value that CFC_11 is set to when it is not read from a file.", &
- units="mol kg-1", default=0.0)
- call get_param(param_file, mdl, "CFC12_IC_VAL", CS%CFC12_IC_val, &
- "Value that CFC_12 is set to when it is not read from a file.", &
- units="mol kg-1", default=0.0)
+ do m=1,2
+ write(m2char, "(I1)") m
+ call get_param(param_file, mdl, "CFC1"//m2char//"_IC_VAL", CS%CFC_data(m)%IC_val, &
+ "Value that CFC_1"//m2char//" is set to when it is not read from a file.", &
+ units="mol kg-1", default=0.0)
+ enddo
! the following params are not used in this module. Instead, they are used in
! the cap but are logged here to keep all the CFC cap params together.
@@ -149,25 +149,25 @@ function register_CFC_cap(HI, GV, param_file, CS, tr_Reg, restart_CS)
! The following vardesc types contain a package of metadata about each tracer,
! including, the name; units; longname; and grid information.
- CS%CFC11_name = "CFC_11" ; CS%CFC12_name = "CFC_12"
- CS%CFC11_desc = var_desc(CS%CFC11_name,"mol kg-1","Moles Per Unit Mass of CFC-11 in sea water", caller=mdl)
- CS%CFC12_desc = var_desc(CS%CFC12_name,"mol kg-1","Moles Per Unit Mass of CFC-12 in sea water", caller=mdl)
-
- allocate(CS%CFC11(isd:ied,jsd:jed,nz), source=0.0)
- allocate(CS%CFC12(isd:ied,jsd:jed,nz), source=0.0)
-
- ! This pointer assignment is needed to force the compiler not to do a copy in
- ! the registration calls. Curses on the designers and implementers of F90.
- tr_ptr => CS%CFC11
- ! Register CFC11 for horizontal advection, diffusion, and restarts.
- call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, &
- tr_desc=CS%CFC11_desc, registry_diags=.true., &
- restart_CS=restart_CS, mandatory=.not.CS%tracers_may_reinit)
- ! Do the same for CFC12
- tr_ptr => CS%CFC12
- call register_tracer(tr_ptr, Tr_Reg, param_file, HI, GV, &
- tr_desc=CS%CFC12_desc, registry_diags=.true., &
- restart_CS=restart_CS, mandatory=.not.CS%tracers_may_reinit)
+ do m=1,2
+ write(m2char, "(I1)") m
+ write(CS%CFC_data(m)%name, "(2A)") "CFC_1", m2char
+ CS%CFC_data(m)%desc = var_desc(CS%CFC_data(m)%name, &
+ "mol kg-1", &
+ "Moles Per Unit Mass of CFC-1"//m2char//" in sea water", &
+ caller=mdl)
+
+ allocate(CS%CFC_data(m)%conc(isd:ied,jsd:jed,nz), source=0.0)
+
+ ! This pointer assignment is needed to force the compiler not to do a copy in
+ ! the registration calls. Curses on the designers and implementers of F90.
+ tr_ptr => CS%CFC_data(m)%conc
+ ! Register CFC tracer for horizontal advection, diffusion, and restarts.
+ call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, &
+ tr_desc=CS%CFC_data(m)%desc, registry_diags=.true., &
+ restart_CS=restart_CS, mandatory=.not.CS%tracers_may_reinit, &
+ Tr_out=CS%CFC_data(m)%tr_ptr)
+ enddo
CS%tr_Reg => tr_Reg
CS%restart_CSp => restart_CS
@@ -193,29 +193,29 @@ subroutine initialize_CFC_cap(restart, day, G, GV, US, h, diag, OBC, CS)
type(CFC_cap_CS), pointer :: CS !< The control structure returned by a
!! previous call to register_CFC_cap.
+ ! local variables
+ integer :: m
+ character :: m2char
+
if (.not.associated(CS)) return
CS%Time => day
CS%diag => diag
- if (.not.restart .or. (CS%tracers_may_reinit .and. &
- .not.query_initialized(CS%CFC11, CS%CFC11_name, CS%restart_CSp))) &
- call init_tracer_CFC(h, CS%CFC11, CS%CFC11_name, CS%CFC11_land_val, &
- CS%CFC11_IC_val, G, GV, US, CS)
-
- if (.not.restart .or. (CS%tracers_may_reinit .and. &
- .not.query_initialized(CS%CFC12, CS%CFC12_name, CS%restart_CSp))) &
- call init_tracer_CFC(h, CS%CFC12, CS%CFC12_name, CS%CFC12_land_val, &
- CS%CFC12_IC_val, G, GV, US, CS)
+ do m=1,2
+ if (.not.restart .or. (CS%tracers_may_reinit .and. &
+ .not.query_initialized(CS%CFC_data(m)%conc, CS%CFC_data(m)%name, CS%restart_CSp))) &
+ call init_tracer_CFC(h, CS%CFC_data(m)%conc, CS%CFC_data(m)%name, CS%CFC_data(m)%land_val, &
+ CS%CFC_data(m)%IC_val, G, GV, US, CS)
+ ! cmor diagnostics
+ ! CFC11 cmor conventions: http://clipc-services.ceda.ac.uk/dreq/u/42625c97b8fe75124a345962c4430982.html
+ ! CFC12 cmor conventions: http://clipc-services.ceda.ac.uk/dreq/u/3ab8e10027d7014f18f9391890369235.html
+ write(m2char, "(I1)") m
+ CS%CFC_data(m)%id_cmor = register_diag_field('ocean_model', 'cfc1'//m2char, diag%axesTL, day, &
+ 'Mole Concentration of CFC1'//m2char//' in Sea Water', 'mol m-3')
+ enddo
- ! cmor diagnostics
- ! CFC11 cmor conventions: http://clipc-services.ceda.ac.uk/dreq/u/42625c97b8fe75124a345962c4430982.html
- CS%id_cfc11_cmor = register_diag_field('ocean_model', 'cfc11', diag%axesTL, day, &
- 'Mole Concentration of CFC11 in Sea Water', 'mol m-3')
- ! CFC12 cmor conventions: http://clipc-services.ceda.ac.uk/dreq/u/3ab8e10027d7014f18f9391890369235.html
- CS%id_cfc12_cmor = register_diag_field('ocean_model', 'cfc12', diag%axesTL, day, &
- 'Mole Concentration of CFC12 in Sea Water', 'mol m-3')
if (associated(OBC)) then
! Steal from updated DOME in the fullness of time.
@@ -272,8 +272,8 @@ end subroutine init_tracer_CFC
!> Applies diapycnal diffusion, souces and sinks and any other column
!! tracer physics to the CFC cap tracers. CFCs are relatively simple,
!! as they are passive tracers with only a surface flux as a source.
-subroutine CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, &
- evap_CFL_limit, minimum_forcing_depth)
+subroutine CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, KPP_CSp, &
+ nonLocalTrans, evap_CFL_limit, minimum_forcing_depth)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
@@ -294,6 +294,8 @@ subroutine CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, C
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
type(CFC_cap_CS), pointer :: CS !< The control structure returned by a
!! previous call to register_CFC_cap.
+ type(KPP_CS), optional, pointer :: KPP_CSp !< KPP control structure
+ real, optional, intent(in) :: nonLocalTrans(:,:,:) !< Non-local transport [nondim]
real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can
!! be fluxed out of the top layer in a timestep [nondim]
real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which
@@ -304,39 +306,59 @@ subroutine CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, C
! Local variables
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2]
+ real :: flux_scale
integer :: i, j, k, is, ie, js, je, nz
is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
if (.not.associated(CS)) return
+ ! Compute KPP nonlocal term if necessary
+ if (present(KPP_CSp)) then
+ if (associated(KPP_CSp) .and. present(nonLocalTrans)) then
+ flux_scale = GV%Z_to_H / GV%rho0
+
+ call KPP_NonLocalTransport(KPP_CSp, G, GV, h_old, nonLocalTrans, fluxes%cfc11_flux(:,:), dt, CS%diag, &
+ CS%CFC_data(1)%tr_ptr, CS%CFC_data(1)%conc(:,:,:), &
+ flux_scale=flux_scale)
+ call KPP_NonLocalTransport(KPP_CSp, G, GV, h_old, nonLocalTrans, fluxes%cfc12_flux(:,:), dt, CS%diag, &
+ CS%CFC_data(2)%tr_ptr, CS%CFC_data(2)%conc(:,:,:), &
+ flux_scale=flux_scale)
+ endif
+ endif
+
! Use a tridiagonal solver to determine the concentrations after the
! surface source is applied and diapycnal advection and diffusion occurs.
if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then
do k=1,nz ;do j=js,je ; do i=is,ie
h_work(i,j,k) = h_old(i,j,k)
enddo ; enddo ; enddo
- call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC11, dt, fluxes, h_work, &
+ call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC_data(1)%conc, dt, fluxes, h_work, &
evap_CFL_limit, minimum_forcing_depth)
- call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC11, G, GV, sfc_flux=fluxes%cfc11_flux)
+ call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC_data(1)%conc, G, GV, sfc_flux=fluxes%cfc11_flux)
do k=1,nz ;do j=js,je ; do i=is,ie
h_work(i,j,k) = h_old(i,j,k)
enddo ; enddo ; enddo
- call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC12, dt, fluxes, h_work, &
+ call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC_data(2)%conc, dt, fluxes, h_work, &
evap_CFL_limit, minimum_forcing_depth)
- call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC12, G, GV, sfc_flux=fluxes%cfc12_flux)
+ call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC_data(2)%conc, G, GV, sfc_flux=fluxes%cfc12_flux)
else
- call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC11, G, GV, sfc_flux=fluxes%cfc11_flux)
- call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC12, G, GV, sfc_flux=fluxes%cfc12_flux)
+ call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC_data(1)%conc, G, GV, sfc_flux=fluxes%cfc11_flux)
+ call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC_data(2)%conc, G, GV, sfc_flux=fluxes%cfc12_flux)
endif
! If needed, write out any desired diagnostics from tracer sources & sinks here.
- if (CS%id_cfc11_cmor > 0) call post_data(CS%id_cfc11_cmor, (GV%Rho0*US%R_to_kg_m3)*CS%CFC11, CS%diag)
- if (CS%id_cfc12_cmor > 0) call post_data(CS%id_cfc12_cmor, (GV%Rho0*US%R_to_kg_m3)*CS%CFC12, CS%diag)
+ if (CS%CFC_data(1)%id_cmor > 0) call post_data(CS%CFC_data(1)%id_cmor, &
+ (GV%Rho0*US%R_to_kg_m3)*CS%CFC_data(1)%conc, &
+ CS%diag)
+ if (CS%CFC_data(2)%id_cmor > 0) call post_data(CS%CFC_data(2)%id_cmor, &
+ (GV%Rho0*US%R_to_kg_m3)*CS%CFC_data(2)%conc, &
+ CS%diag)
end subroutine CFC_cap_column_physics
+
!> Calculates the mass-weighted integral of all tracer stocks,
!! returning the number of stocks it has calculated. If the stock_index
!! is present, only the stock corresponding to that coded index is returned.
@@ -355,6 +377,11 @@ function CFC_cap_stock(h, stocks, G, GV, CS, names, units, stock_index)
!! stock being sought.
integer :: CFC_cap_stock !< The number of stocks calculated here.
+ ! Local variables
+ real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1]
+ real :: mass ! The cell volume or mass [H L2 ~> m3 or kg]
+ integer :: i, j, k, is, ie, js, je, nz, m
+ is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke
CFC_cap_stock = 0
if (.not.associated(CS)) return
@@ -366,12 +393,11 @@ function CFC_cap_stock(h, stocks, G, GV, CS, names, units, stock_index)
return
endif ; endif
- call query_vardesc(CS%CFC11_desc, name=names(1), units=units(1), caller="CFC_cap_stock")
- call query_vardesc(CS%CFC12_desc, name=names(2), units=units(2), caller="CFC_cap_stock")
- units(1) = trim(units(1))//" kg" ; units(2) = trim(units(2))//" kg"
-
- stocks(1) = global_mass_int_EFP(h, G, GV, CS%CFC11, on_PE_only=.true.)
- stocks(2) = global_mass_int_EFP(h, G, GV, CS%CFC12, on_PE_only=.true.)
+ do m=1,2
+ call query_vardesc(CS%CFC_data(m)%desc, name=names(m), units=units(m), caller="CFC_cap_stock")
+ units(m) = trim(units(m))//" kg"
+ stocks(m) = global_mass_int_EFP(h, G, GV, CS%CFC_data(m)%conc, on_PE_only=.true.)
+ enddo
CFC_cap_stock = 2
@@ -393,8 +419,8 @@ subroutine CFC_cap_surface_state(sfc_state, G, CS)
if (.not.associated(CS)) return
do j=js,je ; do i=is,ie
- sfc_state%sfc_cfc11(i,j) = CS%CFC11(i,j,1)
- sfc_state%sfc_cfc12(i,j) = CS%CFC12(i,j,1)
+ sfc_state%sfc_cfc11(i,j) = CS%CFC_data(1)%conc(i,j,1)
+ sfc_state%sfc_cfc12(i,j) = CS%CFC_data(2)%conc(i,j,1)
enddo ; enddo
end subroutine CFC_cap_surface_state
@@ -575,9 +601,13 @@ subroutine CFC_cap_end(CS)
type(CFC_cap_CS), pointer :: CS !< The control structure returned by a
!! previous call to register_CFC_cap.
+ ! local variables
+ integer :: m
+
if (associated(CS)) then
- if (associated(CS%CFC11)) deallocate(CS%CFC11)
- if (associated(CS%CFC12)) deallocate(CS%CFC12)
+ do m=1,2
+ if (associated(CS%CFC_data(m)%conc)) deallocate(CS%CFC_data(m)%conc)
+ enddo
deallocate(CS)
endif
diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90
index 94e4b669ea..d1c105fcd5 100644
--- a/src/tracer/MOM_tracer_flow_control.F90
+++ b/src/tracer/MOM_tracer_flow_control.F90
@@ -11,6 +11,7 @@ module MOM_tracer_flow_control
use MOM_get_input, only : Get_MOM_input
use MOM_grid, only : ocean_grid_type
use MOM_hor_index, only : hor_index_type
+use MOM_CVMix_KPP, only : KPP_CS
use MOM_open_boundary, only : ocean_OBC_type
use MOM_restart, only : MOM_restart_CS
use MOM_sponge, only : sponge_CS
@@ -403,7 +404,7 @@ end subroutine call_tracer_set_forcing
!> This subroutine calls all registered tracer column physics subroutines.
subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, US, tv, optics, CS, &
- debug, evap_CFL_limit, minimum_forcing_depth)
+ debug, KPP_CSp, nonLocalTrans, evap_CFL_limit, minimum_forcing_depth)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure.
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure.
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Layer thickness before entrainment
@@ -431,6 +432,8 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV,
!! a previous call to
!! call_tracer_register.
logical, intent(in) :: debug !< If true calculate checksums
+ type(KPP_CS), optional, pointer :: KPP_CSp !< KPP control structure
+ real, optional, intent(in) :: nonLocalTrans(:,:,:) !< Non-local transport [nondim]
real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of
!! the water that can be fluxed out
!! of the top layer in a timestep [nondim]
@@ -490,6 +493,8 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV,
if (CS%use_CFC_cap) &
call CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
G, GV, US, CS%CFC_cap_CSp, &
+ KPP_CSp=KPP_CSp, &
+ nonLocalTrans=nonLocalTrans, &
evap_CFL_limit=evap_CFL_limit, &
minimum_forcing_depth=minimum_forcing_depth)
if (CS%use_MOM_generic_tracer) then
@@ -503,7 +508,10 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV,
endif
if (CS%use_pseudo_salt_tracer) &
call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%pseudo_salt_tracer_CSp, tv, debug, &
+ G, GV, US, CS%pseudo_salt_tracer_CSp, tv, &
+ debug, &
+ KPP_CSp=KPP_CSp, &
+ nonLocalTrans=nonLocalTrans, &
evap_CFL_limit=evap_CFL_limit, &
minimum_forcing_depth=minimum_forcing_depth)
if (CS%use_boundary_impulse_tracer) &
@@ -551,7 +559,9 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV,
G, GV, US, CS%OCMIP2_CFC_CSp)
if (CS%use_CFC_cap) &
call CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%CFC_cap_CSp)
+ G, GV, US, CS%CFC_cap_CSp, &
+ KPP_CSp=KPP_CSp, &
+ nonLocalTrans=nonLocalTrans)
if (CS%use_MOM_generic_tracer) then
if (US%QRZ_T_to_W_m2 /= 1.0) call MOM_error(FATAL, "MOM_generic_tracer_column_physics "//&
"has not been written to permit dimensionsal rescaling. Set all 4 of the "//&
@@ -561,7 +571,10 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV,
endif
if (CS%use_pseudo_salt_tracer) &
call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
- G, GV, US, CS%pseudo_salt_tracer_CSp, tv, debug)
+ G, GV, US, CS%pseudo_salt_tracer_CSp, &
+ tv, debug, &
+ KPP_CSp=KPP_CSp, &
+ nonLocalTrans=nonLocalTrans)
if (CS%use_boundary_impulse_tracer) &
call boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, &
G, GV, US, CS%boundary_impulse_tracer_CSp, tv, debug)
diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90
index 821ac6a3cd..e87ce64d4a 100644
--- a/src/tracer/MOM_tracer_registry.F90
+++ b/src/tracer/MOM_tracer_registry.F90
@@ -1,7 +1,7 @@
-!> This module contains the tracer_registry_type and the subroutines
-!! that handle registration of tracers and related subroutines.
-!! The primary subroutine, register_tracer, is called to indicate the
-!! tracers advected and diffused.
+!> This module contains subroutines that handle registration of tracers
+!! and related subroutines. The primary subroutine, register_tracer, is
+!! called to indicate the tracers advected and diffused.
+!! It also makes public the types defined in MOM_tracer_types.
module MOM_tracer_registry
! This file is part of MOM6. See LICENSE.md for the license.
@@ -22,7 +22,7 @@ module MOM_tracer_registry
use MOM_time_manager, only : time_type
use MOM_unit_scaling, only : unit_scale_type
use MOM_verticalGrid, only : verticalGrid_type
-
+use MOM_tracer_types, only : tracer_type, tracer_registry_type
implicit none ; private
#include
@@ -34,132 +34,19 @@ module MOM_tracer_registry
public tracer_registry_init, lock_tracer_registry, tracer_registry_end
public tracer_name_lookup
-!> The tracer type
-type, public :: tracer_type
-
- real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array [conc]
-! real :: OBC_inflow_conc= 0.0 !< tracer concentration for generic inflows [conc]
-! real, dimension(:,:,:), pointer :: OBC_in_u => NULL() !< structured values for flow into the domain
-! !! specified in OBCs through u-face of cell
-! real, dimension(:,:,:), pointer :: OBC_in_v => NULL() !< structured values for flow into the domain
-! !! specified in OBCs through v-face of cell
-
- real, dimension(:,:,:), pointer :: ad_x => NULL() !< diagnostic array for x-advective tracer flux
- !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
- real, dimension(:,:,:), pointer :: ad_y => NULL() !< diagnostic array for y-advective tracer flux
- !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
- real, dimension(:,:), pointer :: ad2d_x => NULL() !< diagnostic vertical sum x-advective tracer flux
- !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
- real, dimension(:,:), pointer :: ad2d_y => NULL() !< diagnostic vertical sum y-advective tracer flux
- !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
-
- real, dimension(:,:,:), pointer :: df_x => NULL() !< diagnostic array for x-diffusive tracer flux
- !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
- real, dimension(:,:,:), pointer :: df_y => NULL() !< diagnostic array for y-diffusive tracer flux
- !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
- real, dimension(:,:,:), pointer :: lbd_dfx => NULL() !< diagnostic array for x-diffusive tracer flux
- !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
- real, dimension(:,:,:), pointer :: lbd_dfy => NULL() !< diagnostic array for y-diffusive tracer flux
- !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
- real, dimension(:,:), pointer :: lbd_dfx_2d => NULL() !< diagnostic array for x-diffusive tracer flux
- !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
- real, dimension(:,:), pointer :: lbd_dfy_2d => NULL() !< diagnostic array for y-diffusive tracer flux
- !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
- !### These two arrays may be allocated but are never used.
- real, dimension(:,:), pointer :: lbd_bulk_df_x => NULL() !< diagnostic array for x-diffusive tracer flux
- !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
- real, dimension(:,:), pointer :: lbd_bulk_df_y => NULL() !< diagnostic array for y-diffusive tracer flux
- !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
- real, dimension(:,:), pointer :: df2d_x => NULL() !< diagnostic vertical sum x-diffusive flux
- !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
- real, dimension(:,:), pointer :: df2d_y => NULL() !< diagnostic vertical sum y-diffusive flux
- !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
-! real, dimension(:,:), pointer :: df2d_conc_x => NULL() !< diagnostic vertical sum x-diffusive content flux
-! !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
-! real, dimension(:,:), pointer :: df2d_conc_y => NULL() !< diagnostic vertical sum y-diffusive content flux
-! !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
-
- real, dimension(:,:,:), pointer :: advection_xy => NULL() !< convergence of lateral advective tracer fluxes
- !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1]
-! real, dimension(:,:,:), pointer :: diff_cont_xy => NULL() !< convergence of lateral diffusive tracer fluxes
-! !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1]
-! real, dimension(:,:,:), pointer :: diff_conc_xy => NULL() !< convergence of lateral diffusive tracer fluxes
-! !! expressed as a change in concentration
-! !! [conc T-1 ~> conc s-1]
- real, dimension(:,:,:), pointer :: t_prev => NULL() !< tracer concentration array at a previous
- !! timestep used for diagnostics [conc]
- real, dimension(:,:,:), pointer :: Trxh_prev => NULL() !< layer integrated tracer concentration array
- !! at a previous timestep used for diagnostics
- !! [conc H ~> conc m or conc kg m-2]
-
- character(len=32) :: name !< tracer name used for diagnostics and error messages
- character(len=64) :: units !< Physical dimensions of the tracer concentration
- character(len=240) :: longname !< Long name of the variable
-! type(vardesc), pointer :: vd => NULL() !< metadata describing the tracer
- logical :: registry_diags = .false. !< If true, use the registry to set up the
- !! diagnostics associated with this tracer.
- character(len=64) :: cmor_name !< CMOR name of this tracer
- character(len=64) :: cmor_units !< CMOR physical dimensions of the tracer
- character(len=240) :: cmor_longname !< CMOR long name of the tracer
- character(len=32) :: flux_nameroot = "" !< Short tracer name snippet used construct the
- !! names of flux diagnostics.
- character(len=64) :: flux_longname = "" !< A word or phrase used construct the long
- !! names of flux diagnostics.
- real :: flux_scale = 1.0 !< A scaling factor used to convert the fluxes
- !! of this tracer to its desired units,
- !! including a factor compensating for H scaling.
- character(len=48) :: flux_units = "" !< The units for fluxes of this variable.
- character(len=48) :: conv_units = "" !< The units for the flux convergence of this tracer.
- real :: conv_scale = 1.0 !< A scaling factor used to convert the flux
- !! convergence of this tracer to its desired units,
- !! including a factor compensating for H scaling.
- character(len=48) :: cmor_tendprefix = "" !< The CMOR variable prefix for tendencies of this
- !! tracer, required because CMOR does not follow any
- !! discernable pattern for these names.
- integer :: ind_tr_squared = -1 !< The tracer registry index for the square of this tracer
-
- !### THESE CAPABILITIES HAVE NOT YET BEEN IMPLEMENTED.
- ! logical :: advect_tr = .true. !< If true, this tracer should be advected
- ! logical :: hordiff_tr = .true. !< If true, this tracer should experience epineutral diffusion
- logical :: remap_tr = .true. !< If true, this tracer should be vertically remapped
-
- integer :: diag_form = 1 !< An integer indicating which template is to be used to label diagnostics.
- !>@{ Diagnostic IDs
- integer :: id_tr = -1, id_tr_post_horzn = -1
- integer :: id_adx = -1, id_ady = -1, id_dfx = -1, id_dfy = -1
- integer :: id_lbd_bulk_dfx = -1, id_lbd_bulk_dfy = -1, id_lbd_dfx = -1, id_lbd_dfy = -1
- integer :: id_lbd_dfx_2d = -1 , id_lbd_dfy_2d = -1
- integer :: id_adx_2d = -1, id_ady_2d = -1, id_dfx_2d = -1, id_dfy_2d = -1
- integer :: id_adv_xy = -1, id_adv_xy_2d = -1
- integer :: id_dfxy_cont = -1, id_dfxy_cont_2d = -1, id_dfxy_conc = -1
- integer :: id_lbdxy_cont = -1, id_lbdxy_cont_2d = -1, id_lbdxy_conc = -1
- integer :: id_remap_conc = -1, id_remap_cont = -1, id_remap_cont_2d = -1
- integer :: id_tendency = -1, id_trxh_tendency = -1, id_trxh_tendency_2d = -1
- integer :: id_tr_vardec = -1
- !>@}
-end type tracer_type
-
-!> Type to carry basic tracer information
-type, public :: tracer_registry_type
- integer :: ntr = 0 !< number of registered tracers
- type(tracer_type) :: Tr(MAX_FIELDS_) !< array of registered tracers
-! type(diag_ctrl), pointer :: diag !< structure to regulate timing of diagnostics
- logical :: locked = .false. !< New tracers may be registered if locked=.false.
- !! When locked=.true., no more tracers can be registered,
- !! at which point common diagnostics can be set up
- !! for the registered tracers
-end type tracer_registry_type
+! These types come from MOM_tracer_types
+public tracer_type, tracer_registry_type
contains
!> This subroutine registers a tracer to be advected and laterally diffused.
subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, units, &
- cmor_name, cmor_units, cmor_longname, tr_desc, &
- OBC_inflow, OBC_in_u, OBC_in_v, ad_x, ad_y, df_x, df_y, &
- ad_2d_x, ad_2d_y, df_2d_x, df_2d_y, advection_xy, registry_diags, &
+ cmor_name, cmor_units, cmor_longname, net_surfflux_name, NLT_budget_name, &
+ net_surfflux_longname, tr_desc, OBC_inflow, OBC_in_u, OBC_in_v, ad_x, ad_y, &
+ df_x, df_y, ad_2d_x, ad_2d_y, df_2d_x, df_2d_y, advection_xy, registry_diags, &
flux_nameroot, flux_longname, flux_units, flux_scale, &
convergence_units, convergence_scale, cmor_tendprefix, diag_form, &
- restart_CS, mandatory)
+ restart_CS, mandatory, Tr_out)
type(hor_index_type), intent(in) :: HI !< horizontal index type
type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure
type(tracer_registry_type), pointer :: Reg !< pointer to the tracer registry
@@ -172,6 +59,9 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit
character(len=*), optional, intent(in) :: cmor_name !< CMOR name
character(len=*), optional, intent(in) :: cmor_units !< CMOR physical dimensions of variable
character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name
+ character(len=*), optional, intent(in) :: net_surfflux_name !< Name for net_surfflux diag
+ character(len=*), optional, intent(in) :: NLT_budget_name !< Name for NLT_budget diag
+ character(len=*), optional, intent(in) :: net_surfflux_longname !< Long name for net_surfflux diag
type(vardesc), optional, intent(in) :: tr_desc !< A structure with metadata about the tracer
real, optional, intent(in) :: OBC_inflow !< the tracer for all inflows via OBC for which OBC_in_u
@@ -221,6 +111,7 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit
type(MOM_restart_CS), optional, intent(inout) :: restart_CS !< MOM restart control struct
logical, optional, intent(in) :: mandatory !< If true, this tracer must be read
!! from a restart file.
+ type(tracer_type), optional, pointer :: Tr_out !< If present, returns pointer into registry
logical :: mand
type(tracer_type), pointer :: Tr=>NULL()
@@ -236,6 +127,7 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit
Reg%ntr = Reg%ntr + 1
Tr => Reg%Tr(Reg%ntr)
+ if (present(Tr_out)) Tr_out => Reg%Tr(Reg%ntr)
if (present(name)) then
Tr%name = name
@@ -277,6 +169,22 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit
if (len_trim(flux_longname) > 0) Tr%flux_longname = flux_longname
endif
+ Tr%net_surfflux_name = "KPP_net"//trim(Tr%name)
+ if (present(net_surfflux_name)) then
+ Tr%net_surfflux_name = net_surfflux_name
+ endif
+
+ Tr%NLT_budget_name = 'KPP_NLT_'//trim(Tr%flux_nameroot)//'_budget'
+ if (present(NLT_budget_name)) then
+ Tr%NLT_budget_name = NLT_budget_name
+ endif
+
+ Tr%net_surfflux_longname = 'Effective net surface '//trim(lowercase(Tr%flux_longname))//&
+ ' flux, as used by [CVMix] KPP'
+ if (present(net_surfflux_longname)) then
+ Tr%net_surfflux_longname = net_surfflux_longname
+ endif
+
Tr%flux_units = ""
if (present(flux_units)) Tr%flux_units = flux_units
@@ -340,7 +248,7 @@ end subroutine lock_tracer_registry
!> register_tracer_diagnostics does a set of register_diag_field calls for any previously
!! registered in a tracer registry with a value of registry_diags set to .true.
-subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE)
+subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE, use_KPP)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
@@ -351,22 +259,25 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE)
type(diag_ctrl), intent(in) :: diag !< structure to regulate diagnostic output
logical, intent(in) :: use_ALE !< If true active diagnostics that only
!! apply to ALE configurations
-
- character(len=24) :: name ! A variable's name in a NetCDF file.
- character(len=24) :: shortnm ! A shortened version of a variable's name for
- ! creating additional diagnostics.
- character(len=72) :: longname ! The long name of that tracer variable.
- character(len=72) :: flux_longname ! The tracer name in the long names of fluxes.
- character(len=48) :: units ! The dimensions of the tracer.
- character(len=48) :: flux_units ! The units for fluxes, either
- ! [units] m3 s-1 or [units] kg s-1.
- character(len=48) :: conv_units ! The units for flux convergences, either
- ! [units] m2 s-1 or [units] kg s-1.
- character(len=48) :: unit2 ! The dimensions of the tracer squared
+ logical, intent(in) :: use_KPP !< If true active diagnostics that only
+ !! apply to CVMix KPP mixings
+
+ character(len=24) :: name ! A variable's name in a NetCDF file.
+ character(len=24) :: shortnm ! A shortened version of a variable's name for
+ ! creating additional diagnostics.
+ character(len=72) :: longname ! The long name of that tracer variable.
+ character(len=72) :: flux_longname ! The tracer name in the long names of fluxes.
+ character(len=48) :: units ! The dimensions of the tracer.
+ character(len=48) :: flux_units ! The units for fluxes, either
+ ! [units] m3 s-1 or [units] kg s-1.
+ character(len=48) :: conv_units ! The units for flux convergences, either
+ ! [units] m2 s-1 or [units] kg s-1.
+ character(len=48) :: unit2 ! The dimensions of the tracer squared
character(len=72) :: cmorname ! The CMOR name of this tracer.
character(len=120) :: cmor_longname ! The CMOR long name of that variable.
character(len=120) :: var_lname ! A temporary longname for a diagnostic.
character(len=120) :: cmor_var_lname ! The temporary CMOR long name for a diagnostic
+ real :: conversion ! Temporary term while we address a bug
type(tracer_type), pointer :: Tr=>NULL()
integer :: i, j, k, is, ie, js, je, nz, m, m2, nTr_in
integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB
@@ -660,6 +571,30 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE)
endif
endif
+ ! KPP nonlocal term diagnostics
+ if (use_KPP) then
+ Tr%id_net_surfflux = register_diag_field('ocean_model', Tr%net_surfflux_name, diag%axesT1, Time, &
+ Tr%net_surfflux_longname, trim(units)//' m s-1', conversion=GV%H_to_m*US%s_to_T)
+ Tr%id_NLT_tendency = register_diag_field('ocean_model', "KPP_NLT_d"//trim(shortnm)//"dt", &
+ diag%axesTL, Time, &
+ trim(longname)//' tendency due to non-local transport of '//trim(lowercase(flux_longname))//&
+ ', as calculated by [CVMix] KPP', trim(units)//' s-1', conversion=US%s_to_T)
+ if (Tr%conv_scale == 0.001*GV%H_to_kg_m2) then
+ conversion = GV%H_to_kg_m2
+ else
+ conversion = Tr%conv_scale
+ end if
+ ! We actually want conversion=Tr%conv_scale for all tracers, but introducing the local variable
+ ! 'conversion' and setting it to GV%H_to_kg_m2 instead of 0.001*GV%H_to_kg_m2 for salt tracers
+ ! keeps changes introduced by this refactoring limited to round-off level; as it turns out,
+ ! there is a bug in the code and the NLT budget term for salinity is off by a factor of 10^3
+ ! so introducing the 0.001 here will fix that bug.
+ Tr%id_NLT_budget = register_diag_field('ocean_model', Tr%NLT_budget_name, &
+ diag%axesTL, Time, &
+ trim(flux_longname)//' content change due to non-local transport, as calculated by [CVMix] KPP', &
+ conv_units, conversion=conversion*US%s_to_T, v_extensive=.true.)
+ endif
+
endif ; enddo
end subroutine register_tracer_diagnostics
diff --git a/src/tracer/MOM_tracer_types.F90 b/src/tracer/MOM_tracer_types.F90
new file mode 100644
index 0000000000..4a474e9301
--- /dev/null
+++ b/src/tracer/MOM_tracer_types.F90
@@ -0,0 +1,130 @@
+!> This module contains the tracer_type and tracer_registry_type
+module MOM_tracer_types
+
+implicit none ; private
+
+#include
+
+!> The tracer type
+type, public :: tracer_type
+
+ real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array [conc]
+! real :: OBC_inflow_conc= 0.0 !< tracer concentration for generic inflows [conc]
+! real, dimension(:,:,:), pointer :: OBC_in_u => NULL() !< structured values for flow into the domain
+! !! specified in OBCs through u-face of cell
+! real, dimension(:,:,:), pointer :: OBC_in_v => NULL() !< structured values for flow into the domain
+! !! specified in OBCs through v-face of cell
+
+ real, dimension(:,:,:), pointer :: ad_x => NULL() !< diagnostic array for x-advective tracer flux
+ !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
+ real, dimension(:,:,:), pointer :: ad_y => NULL() !< diagnostic array for y-advective tracer flux
+ !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
+ real, dimension(:,:), pointer :: ad2d_x => NULL() !< diagnostic vertical sum x-advective tracer flux
+ !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
+ real, dimension(:,:), pointer :: ad2d_y => NULL() !< diagnostic vertical sum y-advective tracer flux
+ !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
+
+ real, dimension(:,:,:), pointer :: df_x => NULL() !< diagnostic array for x-diffusive tracer flux
+ !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
+ real, dimension(:,:,:), pointer :: df_y => NULL() !< diagnostic array for y-diffusive tracer flux
+ !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
+ real, dimension(:,:,:), pointer :: lbd_dfx => NULL() !< diagnostic array for x-diffusive tracer flux
+ !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
+ real, dimension(:,:,:), pointer :: lbd_dfy => NULL() !< diagnostic array for y-diffusive tracer flux
+ !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
+ real, dimension(:,:), pointer :: lbd_dfx_2d => NULL() !< diagnostic array for x-diffusive tracer flux
+ !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
+ real, dimension(:,:), pointer :: lbd_dfy_2d => NULL() !< diagnostic array for y-diffusive tracer flux
+ !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
+ !### These two arrays may be allocated but are never used.
+ real, dimension(:,:), pointer :: lbd_bulk_df_x => NULL() !< diagnostic array for x-diffusive tracer flux
+ !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
+ real, dimension(:,:), pointer :: lbd_bulk_df_y => NULL() !< diagnostic array for y-diffusive tracer flux
+ !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
+ real, dimension(:,:), pointer :: df2d_x => NULL() !< diagnostic vertical sum x-diffusive flux
+ !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
+ real, dimension(:,:), pointer :: df2d_y => NULL() !< diagnostic vertical sum y-diffusive flux
+ !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
+! real, dimension(:,:), pointer :: df2d_conc_x => NULL() !< diagnostic vertical sum x-diffusive content flux
+! !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
+! real, dimension(:,:), pointer :: df2d_conc_y => NULL() !< diagnostic vertical sum y-diffusive content flux
+! !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1]
+
+ real, dimension(:,:,:), pointer :: advection_xy => NULL() !< convergence of lateral advective tracer fluxes
+ !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1]
+! real, dimension(:,:,:), pointer :: diff_cont_xy => NULL() !< convergence of lateral diffusive tracer fluxes
+! !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1]
+! real, dimension(:,:,:), pointer :: diff_conc_xy => NULL() !< convergence of lateral diffusive tracer fluxes
+! !! expressed as a change in concentration
+ !! [conc T-1 ~> conc s-1]
+ real, dimension(:,:,:), pointer :: t_prev => NULL() !< tracer concentration array at a previous
+ !! timestep used for diagnostics [conc]
+ real, dimension(:,:,:), pointer :: Trxh_prev => NULL() !< layer integrated tracer concentration array
+ !! at a previous timestep used for diagnostics
+ !! [conc H ~> conc m or conc kg m-2]
+
+ character(len=32) :: name !< tracer name used for diagnostics and error messages
+ character(len=64) :: units !< Physical dimensions of the tracer concentration
+ character(len=240) :: longname !< Long name of the variable
+! type(vardesc), pointer :: vd => NULL() !< metadata describing the tracer
+ logical :: registry_diags = .false. !< If true, use the registry to set up the
+ !! diagnostics associated with this tracer.
+ character(len=64) :: cmor_name !< CMOR name of this tracer
+ character(len=64) :: cmor_units !< CMOR physical dimensions of the tracer
+ character(len=240) :: cmor_longname !< CMOR long name of the tracer
+ character(len=32) :: flux_nameroot = "" !< Short tracer name snippet used construct the
+ !! names of flux diagnostics.
+ character(len=64) :: flux_longname = "" !< A word or phrase used construct the long
+ !! names of flux diagnostics.
+ real :: flux_scale = 1.0 !< A scaling factor used to convert the fluxes
+ !! of this tracer to its desired units,
+ !! including a factor compensating for H scaling.
+ character(len=48) :: flux_units = "" !< The units for fluxes of this variable.
+ character(len=48) :: conv_units = "" !< The units for the flux convergence of this tracer.
+ real :: conv_scale = 1.0 !< A scaling factor used to convert the flux
+ !! convergence of this tracer to its desired units,
+ !! including a factor compensating for H scaling.
+ character(len=48) :: cmor_tendprefix = "" !< The CMOR variable prefix for tendencies of this
+ !! tracer, required because CMOR does not follow any
+ !! discernable pattern for these names.
+ character(len=48) :: net_surfflux_name = "" !< Name to use for net_surfflux KPP diagnostic
+ character(len=48) :: NLT_budget_name = "" !< Name to use for NLT_budget KPP diagnostic
+ character(len=128) :: net_surfflux_longname = "" !< Long name to use for net_surfflux KPP diagnostic
+ integer :: ind_tr_squared = -1 !< The tracer registry index for the square of this tracer
+
+ !### THESE CAPABILITIES HAVE NOT YET BEEN IMPLEMENTED.
+ ! logical :: advect_tr = .true. !< If true, this tracer should be advected
+ ! logical :: hordiff_tr = .true. !< If true, this tracer should experience epineutral diffusion
+ ! logical :: kpp_nonlocal_tr = .true. !< if true, apply KPP nonlocal transport to this tracer before diffusion
+ logical :: remap_tr = .true. !< If true, this tracer should be vertically remapped
+
+ integer :: diag_form = 1 !< An integer indicating which template is to be used to label diagnostics.
+ !>@{ Diagnostic IDs
+ integer :: id_tr = -1, id_tr_post_horzn = -1
+ integer :: id_adx = -1, id_ady = -1, id_dfx = -1, id_dfy = -1
+ integer :: id_lbd_bulk_dfx = -1, id_lbd_bulk_dfy = -1, id_lbd_dfx = -1, id_lbd_dfy = -1
+ integer :: id_lbd_dfx_2d = -1 , id_lbd_dfy_2d = -1
+ integer :: id_adx_2d = -1, id_ady_2d = -1, id_dfx_2d = -1, id_dfy_2d = -1
+ integer :: id_adv_xy = -1, id_adv_xy_2d = -1
+ integer :: id_dfxy_cont = -1, id_dfxy_cont_2d = -1, id_dfxy_conc = -1
+ integer :: id_lbdxy_cont = -1, id_lbdxy_cont_2d = -1, id_lbdxy_conc = -1
+ integer :: id_remap_conc = -1, id_remap_cont = -1, id_remap_cont_2d = -1
+ integer :: id_tendency = -1, id_trxh_tendency = -1, id_trxh_tendency_2d = -1
+ integer :: id_tr_vardec = -1
+ integer :: id_net_surfflux = -1, id_NLT_tendency = -1, id_NLT_budget = -1
+ !>@}
+end type tracer_type
+
+!> Type to carry basic tracer information
+type, public :: tracer_registry_type
+ integer :: ntr = 0 !< number of registered tracers
+ type(tracer_type) :: Tr(MAX_FIELDS_) !< array of registered tracers
+! type(diag_ctrl), pointer :: diag !< structure to regulate timing of diagnostics
+ logical :: locked = .false. !< New tracers may be registered if locked=.false.
+ !! When locked=.true., no more tracers can be registered,
+ !! at which point common diagnostics can be set up
+ !! for the registered tracers
+end type tracer_registry_type
+
+
+end module MOM_tracer_types
diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90
index 6c22daa150..fe6b49d059 100644
--- a/src/tracer/pseudo_salt_tracer.F90
+++ b/src/tracer/pseudo_salt_tracer.F90
@@ -11,6 +11,7 @@ module pseudo_salt_tracer
use MOM_file_parser, only : get_param, log_param, log_version, param_file_type
use MOM_forcing_type, only : forcing
use MOM_grid, only : ocean_grid_type
+use MOM_CVMix_KPP, only : KPP_NonLocalTransport, KPP_CS
use MOM_hor_index, only : hor_index_type
use MOM_io, only : vardesc, var_desc, query_vardesc
use MOM_open_boundary, only : ocean_OBC_type
@@ -18,7 +19,7 @@ module pseudo_salt_tracer
use MOM_spatial_means, only : global_mass_int_EFP
use MOM_sponge, only : set_up_sponge_field, sponge_CS
use MOM_time_manager, only : time_type
-use MOM_tracer_registry, only : register_tracer, tracer_registry_type
+use MOM_tracer_registry, only : register_tracer, tracer_registry_type, tracer_type
use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut
use MOM_tracer_Z_init, only : tracer_Z_init
use MOM_unit_scaling, only : unit_scale_type
@@ -35,6 +36,7 @@ module pseudo_salt_tracer
!> The control structure for the pseudo-salt tracer
type, public :: pseudo_salt_tracer_CS ; private
+ type(tracer_type), pointer :: tr_ptr !< pointer to tracer inside Tr_reg
type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock.
type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM tracer registry
real, pointer :: ps(:,:,:) => NULL() !< The array of pseudo-salt tracer used in this
@@ -98,7 +100,7 @@ function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS)
call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, name="pseudo_salt", &
longname="Pseudo salt passive tracer", units="psu", &
registry_diags=.true., restart_CS=restart_CS, &
- mandatory=.not.CS%pseudo_salt_may_reinit)
+ mandatory=.not.CS%pseudo_salt_may_reinit, Tr_out=CS%tr_ptr)
CS%tr_Reg => tr_Reg
CS%restart_CSp => restart_CS
@@ -159,7 +161,7 @@ end subroutine initialize_pseudo_salt_tracer
!> Apply sources, sinks and diapycnal diffusion to the tracers in this package.
subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, tv, debug, &
- evap_CFL_limit, minimum_forcing_depth)
+ KPP_CSp, nonLocalTrans, evap_CFL_limit, minimum_forcing_depth)
type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure
type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure
real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), &
@@ -180,6 +182,8 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G
!! call to register_pseudo_salt_tracer
type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables
logical, intent(in) :: debug !< If true calculate checksums
+ type(KPP_CS), optional, pointer :: KPP_CSp !< KPP control structure
+ real, optional, intent(in) :: nonLocalTrans(:,:,:) !< Non-local transport [nondim]
real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can
!! be fluxed out of the top layer in a timestep [nondim]
real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which
@@ -212,6 +216,14 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G
call hchksum(CS%ps,"pseudo_salt pre pseudo-salt vertdiff", G%HI)
endif
+ ! Compute KPP nonlocal term if necessary
+ if (present(KPP_CSp)) then
+ if (associated(KPP_CSp) .and. present(nonLocalTrans)) &
+ call KPP_NonLocalTransport(KPP_CSp, G, GV, h_old, nonLocalTrans, fluxes%KPP_salt_flux(:,:), &
+ dt, CS%diag, CS%tr_ptr, CS%ps(:,:,:))
+ endif
+
+ ! This uses applyTracerBoundaryFluxesInOut, usually in ALE mode
if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then
! This option uses applyTracerBoundaryFluxesInOut, usually in ALE mode
diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90
index ab8a693ba4..e6734b2ac7 100644
--- a/src/user/MOM_wave_interface.F90
+++ b/src/user/MOM_wave_interface.F90
@@ -12,12 +12,15 @@ module MOM_wave_interface
use MOM_file_parser, only : get_param, log_version, param_file_type
use MOM_forcing_type, only : mech_forcing
use MOM_grid, only : ocean_grid_type
+use MOM_hor_index, only : hor_index_type
use MOM_io, only : file_exists, get_var_sizes, read_variable
+use MOM_io, only : vardesc, var_desc
use MOM_safe_alloc, only : safe_alloc_ptr
use MOM_time_manager, only : time_type, operator(+), operator(/)
use MOM_unit_scaling, only : unit_scale_type
use MOM_variables, only : thermo_var_ptrs, surface
use MOM_verticalgrid, only : verticalGrid_type
+use MOM_restart, only : register_restart_field, MOM_restart_CS, query_initialized
implicit none ; private
@@ -31,6 +34,7 @@ module MOM_wave_interface
! called in step_mom.
public get_Langmuir_Number ! Public interface to compute Langmuir number called from
! ePBL or KPP routines.
+public Stokes_PGF ! Public interface to compute Stokes-shear induced pressure gradient force anomaly
public StokesMixing ! NOT READY - Public interface to add down-Stokes gradient
! momentum mixing (e.g. the approach of Harcourt 2013/2015)
public CoriolisStokes ! NOT READY - Public interface to add Coriolis-Stokes acceleration
@@ -40,6 +44,7 @@ module MOM_wave_interface
! CL2 effects.
public Waves_end ! public interface to deallocate and free wave related memory.
public get_wave_method ! public interface to obtain the wave method string
+public waves_register_restarts ! public interface to register wave restart fields
! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional
! consistency testing. These are noted in comments with units like Z, H, L, and T, along with
@@ -50,7 +55,15 @@ module MOM_wave_interface
type, public :: wave_parameters_CS ; private
! Main surface wave options and publicly visible variables
- logical, public :: UseWaves = .false. !< Flag to enable surface gravity wave feature
+ logical, public :: UseWaves = .false. !< Flag to enable surface gravity wave feature
+ logical, public :: Stokes_VF = .false. !< True if Stokes vortex force is used
+ logical, public :: Passive_Stokes_VF = .false. !< Computes Stokes VF, but doesn't affect dynamics
+ logical, public :: Stokes_PGF = .false. !< True if Stokes shear pressure Gradient force is used
+ logical, public :: Passive_Stokes_PGF = .false. !< Keeps Stokes_PGF on, but doesn't affect dynamics
+ logical, public :: Stokes_DDT = .false. !< Developmental:
+ !! True if Stokes d/dt is used
+ logical, public :: Passive_Stokes_DDT = .false. !< Keeps Stokes_DDT on, but doesn't affect dynamics
+
real, allocatable, dimension(:,:,:), public :: &
Us_x !< 3d zonal Stokes drift profile [L T-1 ~> m s-1]
!! Horizontal -> U points
@@ -59,6 +72,30 @@ module MOM_wave_interface
Us_y !< 3d meridional Stokes drift profile [L T-1 ~> m s-1]
!! Horizontal -> V points
!! Vertical -> Mid-points
+ real, allocatable, dimension(:,:,:), public :: &
+ ddt_Us_x !< 3d time tendency of zonal Stokes drift profile [m s-1]
+ !! Horizontal -> U points
+ !! Vertical -> Mid-points
+ real, allocatable, dimension(:,:,:), public :: &
+ ddt_Us_y !< 3d time tendency of meridional Stokes drift profile [m s-1]
+ !! Horizontal -> V points
+ !! Vertical -> Mid-points
+ real, allocatable, dimension(:,:,:), public :: &
+ Us_x_from_ddt !< Check of 3d zonal Stokes drift profile [m s-1]
+ !! Horizontal -> U points
+ !! Vertical -> Mid-points
+ real, allocatable, dimension(:,:,:), public :: &
+ Us_y_from_ddt !< Check of 3d meridional Stokes drift profile [m s-1]
+ !! Horizontal -> V points
+ !! Vertical -> Mid-points
+ real, allocatable, dimension(:,:,:), public :: &
+ Us_x_prev !< 3d zonal Stokes drift profile, previous dynamics call [m s-1]
+ !! Horizontal -> U points
+ !! Vertical -> Mid-points
+ real, allocatable, dimension(:,:,:), public :: &
+ Us_y_prev !< 3d meridional Stokes drift profile, previous dynamics call [m s-1]
+ !! Horizontal -> V points
+ !! Vertical -> Mid-points
real, allocatable, dimension(:,:,:), public :: &
KvS !< Viscosity for Stokes Drift shear [Z2 T-1 ~> m2 s-1]
@@ -165,8 +202,12 @@ module MOM_wave_interface
!! timing of diagnostic output.
!>@{ Diagnostic handles
+ integer, public :: id_PFu_Stokes = -1 , id_PFv_Stokes = -1
+ integer, public :: id_3dstokes_x_from_ddt = -1 , id_3dstokes_y_from_ddt = -1
+ integer :: id_P_deltaStokes_L = -1, id_P_deltaStokes_i = -1
integer :: id_surfacestokes_x = -1 , id_surfacestokes_y = -1
integer :: id_3dstokes_x = -1 , id_3dstokes_y = -1
+ integer :: id_ddt_3dstokes_x = -1 , id_ddt_3dstokes_y = -1
integer :: id_La_turb = -1
!>@}
@@ -191,7 +232,7 @@ module MOM_wave_interface
contains
!> Initializes parameters related to MOM_wave_interface
-subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag )
+subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restart_CSp)
type(time_type), target, intent(in) :: Time !< Model time
type(ocean_grid_type), intent(inout) :: G !< Grid structure
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
@@ -199,6 +240,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag )
type(param_file_type), intent(in) :: param_file !< Input parameter structure
type(wave_parameters_CS), pointer :: CS !< Wave parameter control structure
type(diag_ctrl), target, intent(inout) :: diag !< Diagnostic Pointer
+ type(MOM_restart_CS), optional, pointer:: restart_CSp!< Restart control structure
! Local variables
character(len=40) :: mdl = "MOM_wave_interface" !< This module's name.
@@ -212,8 +254,8 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag )
logical :: StatisticalWaves
! Dummy Check
- if (associated(CS)) then
- call MOM_error(FATAL, "wave_interface_init called with an associated control structure.")
+ if (.not. associated(CS)) then
+ call MOM_error(FATAL, "wave_interface_init called without an associated control structure.")
return
endif
@@ -226,9 +268,6 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag )
if (.not.(use_waves .or. StatisticalWaves)) return
- ! Allocate CS and set pointers
- allocate(CS)
-
CS%UseWaves = use_waves
CS%diag => diag
CS%Time => Time
@@ -277,6 +316,25 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag )
call MOM_error(FATAL, "Should you be enabling Coriolis-Stokes? Code not ready.")
endif
+ call get_param(param_file, mdl, "STOKES_VF", CS%Stokes_VF, &
+ "Flag to use Stokes vortex force", units="", &
+ Default=.false.)
+ call get_param(param_file, mdl, "PASSIVE_STOKES_VF", CS%Passive_Stokes_VF, &
+ "Flag to make Stokes vortex force diagnostic only.", units="", &
+ Default=.false.)
+ call get_param(param_file, mdl, "STOKES_PGF", CS%Stokes_PGF, &
+ "Flag to use Stokes-induced pressure gradient anomaly", units="", &
+ Default=.false.)
+ call get_param(param_file, mdl, "PASSIVE_STOKES_PGF", CS%Passive_Stokes_PGF, &
+ "Flag to make Stokes-induced pressure gradient anomaly diagnostic only.", units="", &
+ Default=.false.)
+ call get_param(param_file, mdl, "STOKES_DDT", CS%Stokes_DDT, &
+ "Flag to use Stokes d/dt", units="", &
+ Default=.false.)
+ call get_param(param_file, mdl, "PASSIVE_STOKES_DDT", CS%Passive_Stokes_DDT, &
+ "Flag to make Stokes d/dt diagnostic only", units="", &
+ Default=.false.)
+
! Get Wave Method and write to integer WaveMethod
call get_param(param_file,mdl,"WAVE_METHOD",TMPSTRING1, &
"Choice of wave method, valid options include: \n"// &
@@ -333,7 +391,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag )
"or the model will fail.", default=1)
allocate( CS%WaveNum_Cen(CS%NumBands), source=0.0 )
allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,CS%NumBands), source=0.0 )
- allocate( CS%STKy0(G%isdB:G%iedB,G%jsd:G%jed,CS%NumBands), source=0.0 )
+ allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,CS%NumBands), source=0.0 )
CS%PartitionMode = 0
call get_param(param_file, mdl, "SURFBAND_WAVENUMBERS", CS%WaveNum_Cen, &
"Central wavenumbers for surface Stokes drift bands.", &
@@ -397,8 +455,16 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag )
! Allocate and initialize
! a. Stokes driftProfiles
- allocate(CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0)
- allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,GV%ke), source=0.0)
+ allocate(CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,G%ke), source=0.0)
+ allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,G%ke), source=0.0)
+ if (CS%Stokes_DDT) then
+ !allocate(CS%Us_x_prev(G%isdB:G%IedB,G%jsd:G%jed,G%ke), source=0.0)
+ !allocate(CS%Us_y_prev(G%isd:G%Ied,G%jsdB:G%jedB,G%ke), source=0.0)
+ allocate(CS%ddt_Us_x(G%isdB:G%IedB,G%jsd:G%jed,G%ke), source=0.0)
+ allocate(CS%ddt_Us_y(G%isd:G%Ied,G%jsdB:G%jedB,G%ke), source=0.0)
+ allocate(CS%Us_x_from_ddt(G%isdB:G%IedB,G%jsd:G%jed,G%ke), source=0.0)
+ allocate(CS%Us_y_from_ddt(G%isd:G%Ied,G%jsdB:G%jedB,G%ke), source=0.0)
+ endif
! b. Surface Values
allocate(CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed), source=0.0)
allocate(CS%US0_y(G%isd:G%ied,G%jsdB:G%jedB), source=0.0)
@@ -419,6 +485,26 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag )
CS%diag%axesCvL,Time,'3d Stokes drift (y)', 'm s-1', conversion=US%L_T_to_m_s)
CS%id_3dstokes_x = register_diag_field('ocean_model','3d_stokes_x', &
CS%diag%axesCuL,Time,'3d Stokes drift (x)', 'm s-1', conversion=US%L_T_to_m_s)
+ if (CS%Stokes_DDT) then
+ CS%id_ddt_3dstokes_y = register_diag_field('ocean_model','dvdt_Stokes', &
+ CS%diag%axesCvL,Time,'d/dt Stokes drift (meridional)','m s-2')
+ CS%id_ddt_3dstokes_x = register_diag_field('ocean_model','dudt_Stokes', &
+ CS%diag%axesCuL,Time,'d/dt Stokes drift (zonal)','m s-2')
+ CS%id_3dstokes_y_from_ddt = register_diag_field('ocean_model','3d_stokes_y_from_ddt', &
+ CS%diag%axesCvL,Time,'3d Stokes drift from ddt (y)', 'm s-1', conversion=US%L_T_to_m_s)
+ CS%id_3dstokes_x_from_ddt = register_diag_field('ocean_model','3d_stokes_x_from_ddt', &
+ CS%diag%axesCuL,Time,'3d Stokes drift from ddt (x)', 'm s-1', conversion=US%L_T_to_m_s)
+ endif
+ CS%id_PFv_Stokes = register_diag_field('ocean_model','PFv_Stokes', &
+ CS%diag%axesCvL,Time,'PF from Stokes drift (meridional)','m s-2',conversion=US%L_T2_to_m_s2)
+ CS%id_PFu_Stokes = register_diag_field('ocean_model','PFu_Stokes', &
+ CS%diag%axesCuL,Time,'PF from Stokes drift (zonal)','m s-2',conversion=US%L_T2_to_m_s2)
+ CS%id_P_deltaStokes_i = register_diag_field('ocean_model','P_deltaStokes_i', &
+ CS%diag%axesTi,Time,'Interfacial pressure anomaly from Stokes drift used in PFu_Stokes',&
+ 'm2 s-2',conversion=US%L_T_to_m_s**2)
+ CS%id_P_deltaStokes_L = register_diag_field('ocean_model','P_deltaStokes_L', &
+ CS%diag%axesTL,Time,'Layer averaged pressure anomaly from Stokes drift used in PFu_Stokes',&
+ 'm2 s-2',conversion=US%L_T_to_m_s**2)
CS%id_La_turb = register_diag_field('ocean_model','La_turbulent', &
CS%diag%axesT1,Time,'Surface (turbulent) Langmuir number','nondim')
@@ -449,26 +535,28 @@ subroutine query_wave_properties(CS, NumBands, WaveNumbers, US)
end subroutine query_wave_properties
!> Subroutine that handles updating of surface wave/Stokes drift related properties
-subroutine Update_Surface_Waves(G, GV, US, Day, dt, CS, forces)
+subroutine Update_Surface_Waves(G, GV, US, Time_present, dt, CS, forces)
type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure
type(ocean_grid_type), intent(inout) :: G !< Grid structure
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type
- type(time_type), intent(in) :: Day !< Current model time
- type(time_type), intent(in) :: dt !< Timestep as a time-type
+ type(time_type), intent(in) :: Time_present !< Model Time
+ type(time_type), intent(in) :: dt !< Time increment as a time-type
type(mech_forcing), intent(in), optional :: forces !< MOM_forcing_type
! Local variables
+ type(time_type) :: Stokes_Time
integer :: ii, jj, b
- type(time_type) :: Day_Center
-
- ! Computing central time of time step
- Day_Center = Day + DT/2
if (CS%WaveMethod == TESTPROF) then
! Do nothing
elseif (CS%WaveMethod == SURFBANDS) then
if (CS%DataSource == DATAOVR) then
- call Surface_Bands_by_data_override(day_center, G, GV, US, CS)
+ ! Updating Stokes drift time to center of time increment.
+ ! This choice makes sense for the thermodynamics, but for the
+ ! dynamics it may be more useful to update to the end of the
+ ! time increment.
+ Stokes_Time = Time_present + dt/2
+ call Surface_Bands_by_data_override(Stokes_Time, G, GV, US, CS)
elseif (CS%DataSource == COUPLER) then
if (.not.present(FORCES)) then
call MOM_error(FATAL,"The option SURFBAND = COUPLER can not be used with "//&
@@ -517,7 +605,7 @@ end subroutine Update_Surface_Waves
!> Constructs the Stokes Drift profile on the model grid based on
!! desired coupling options
-subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar)
+subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step)
type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure
type(ocean_grid_type), intent(inout) :: G !< Grid structure
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
@@ -526,6 +614,9 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar)
intent(in) :: h !< Thickness [H ~> m or kg m-2]
real, dimension(SZI_(G),SZJ_(G)), &
intent(in) :: ustar !< Wind friction velocity [Z T-1 ~> m s-1].
+ real, intent(in) :: dt !< Time-step for computing Stokes-tendency
+ logical, intent(in) :: dynamics_step !< True if this call is on a dynamics step
+
! Local Variables
real :: Top, MidPoint, Bottom ! Positions within the layer [Z ~> m]
real :: one_cm ! One centimeter in the units of wavelengths [Z ~> m]
@@ -538,17 +629,25 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar)
real :: PI ! 3.1415926535...
real :: La ! The local Langmuir number [nondim]
integer :: ii, jj, kk, b, iim1, jjm1
+ real :: idt ! 1 divided by the time step
+
+ if (CS%WaveMethod==EFACTOR) return
one_cm = 0.01*US%m_to_Z
min_level_thick_avg = 1.e-3*US%m_to_Z
+ idt = 1.0/dt
+
+ if (allocated(CS%US_x) .and. allocated(CS%US_y)) then
+ call pass_vector(CS%US_x(:,:,:),CS%US_y(:,:,:), G%Domain)
+ endif
! 1. If Test Profile Option is chosen
! Computing mid-point value from surface value and decay wavelength
if (CS%WaveMethod==TESTPROF) then
PI = 4.0*atan(1.0)
DecayScale = 4.*PI / CS%TP_WVL !4pi
- do jj = G%jsd,G%jed
- do II = G%isdB,G%iedB
+ do jj = G%jsc,G%jec
+ do II = G%iscB,G%iecB
IIm1 = max(1,II-1)
Bottom = 0.0
MidPoint = 0.0
@@ -560,8 +659,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar)
enddo
enddo
enddo
- do JJ = G%jsdB,G%jedB
- do ii = G%isd,G%ied
+ do JJ = G%jscB,G%jecB
+ do ii = G%isc,G%iec
JJm1 = max(1,JJ-1)
Bottom = 0.0
MidPoint = 0.0
@@ -573,6 +672,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar)
enddo
enddo
enddo
+ call pass_vector(CS%Us_x(:,:,:),CS%Us_y(:,:,:), G%Domain, To_All)
! 2. If Surface Bands is chosen
! In wavenumber mode compute integral for layer averaged Stokes drift.
! In frequency mode compuate value at midpoint.
@@ -582,23 +682,12 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar)
CS%Us0_x(:,:) = 0.0
CS%Us0_y(:,:) = 0.0
! Computing X direction Stokes drift
- do jj = G%jsd,G%jed
- do II = G%isdB,G%iedB
+ do jj = G%jsc,G%jec
+ do II = G%iscB,G%iecB
! 1. First compute the surface Stokes drift
- ! by integrating over the partitions.
+ ! by summing over the partitions.
do b = 1,CS%NumBands
- if (CS%PartitionMode==0) then
- ! In wavenumber we are averaging over (small) level
- CMN_FAC = (1.0-exp(-one_cm*2.*CS%WaveNum_Cen(b))) / &
- (one_cm*2.*CS%WaveNum_Cen(b))
- !### For accuracy and numerical stability rewrite this as:
- ! CMN_FAC = one_minus_exp_x(2.*CS%WaveNum_Cen(b)*one_cm)
- ! or maybe just take the limit of vanishing thickness, CMN_FAC = 1.0
- elseif (CS%PartitionMode==1) then
- ! In frequency we are not averaging over level and taking top
- CMN_FAC = 1.0
- endif
- CS%US0_x(II,jj) = CS%US0_x(II,jj) + CS%STKx0(II,jj,b)*CMN_FAC
+ CS%US0_x(II,jj) = CS%US0_x(II,jj) + CS%STKx0(II,jj,b)
enddo
! 2. Second compute the level averaged Stokes drift
bottom = 0.0
@@ -646,22 +735,11 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar)
enddo
enddo
! Computing Y direction Stokes drift
- do JJ = G%jsdB,G%jedB
- do ii = G%isd,G%ied
- ! Compute the surface values.
+ do JJ = G%jscB,G%jecB
+ do ii = G%isc,G%iec
+ ! Set the surface value to that at z=0
do b = 1,CS%NumBands
- if (CS%PartitionMode==0) then
- ! In wavenumber we are averaging over (small) level
- CMN_FAC = (1.0-exp(-one_cm*2.*CS%WaveNum_Cen(b))) / &
- (one_cm*2.*CS%WaveNum_Cen(b))
- !### For accuracy and numerical stability rewrite this as:
- ! CMN_FAC = one_minus_exp_x(2.*CS%WaveNum_Cen(b)*one_cm)
- ! or maybe just take the limit of vanishing thickness, CMN_FAC = 1.0
- elseif (CS%PartitionMode==1) then
- ! In frequency we are not averaging over level and taking top
- CMN_FAC = 1.0
- endif
- CS%US0_y(ii,JJ) = CS%US0_y(ii,JJ) + CS%STKy0(ii,JJ,b)*CMN_FAC
+ CS%US0_y(ii,JJ) = CS%US0_y(ii,JJ) + CS%STKy0(ii,JJ,b)
enddo
! Compute the level averages.
bottom = 0.0
@@ -708,10 +786,12 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar)
enddo
enddo
enddo
+ call pass_vector(CS%Us_x(:,:,:),CS%Us_y(:,:,:), G%Domain, To_All)
+ call pass_vector(CS%Us0_x(:,:),CS%Us0_y(:,:), G%Domain)
elseif (CS%WaveMethod == DHH85) then
if (.not.(CS%StaticWaves .and. CS%DHH85_is_set)) then
- do jj = G%jsd,G%jed
- do II = G%isdB,G%iedB
+ do jj = G%jsc,G%jec
+ do II = G%iscB,G%iecB
bottom = 0.0
do kk = 1,GV%ke
Top = Bottom
@@ -728,8 +808,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar)
enddo
enddo
enddo
- do JJ = G%jsdB,G%jedB
- do ii = G%isd,G%ied
+ do JJ = G%jscB,G%jecB
+ do ii = G%isc,G%iec
Bottom = 0.0
do kk=1, GV%ke
Top = Bottom
@@ -752,8 +832,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar)
enddo
CS%DHH85_is_set = .true.
endif
- elseif (CS%WaveMethod==EFACTOR) then
- return ! pass
+ call pass_vector(CS%Us_x(:,:,:),CS%Us_y(:,:,:), G%Domain)
else! Keep this else, fallback to 0 Stokes drift
do kk= 1,GV%ke
do jj = G%jsd,G%jed
@@ -781,6 +860,15 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar)
enddo
enddo
+ ! Finding tendency of Stokes drift over the time step to apply
+ ! as an acceleration to the models current.
+ if ( dynamics_step .and. CS%Stokes_DDT ) then
+ CS%ddt_us_x(:,:,:) = (CS%US_x(:,:,:) - CS%US_x_prev(:,:,:)) * idt
+ CS%ddt_us_y(:,:,:) = (CS%US_y(:,:,:) - CS%US_y_prev(:,:,:)) * idt
+ CS%US_x_prev(:,:,:) = CS%US_x(:,:,:)
+ CS%US_y_prev(:,:,:) = CS%US_y(:,:,:)
+ endif
+
! Output any desired quantities
if (CS%id_surfacestokes_y>0) &
call post_data(CS%id_surfacestokes_y, CS%us0_y, CS%diag)
@@ -790,6 +878,16 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar)
call post_data(CS%id_3dstokes_y, CS%us_y, CS%diag)
if (CS%id_3dstokes_x>0) &
call post_data(CS%id_3dstokes_x, CS%us_x, CS%diag)
+ if (CS%Stokes_DDT) then
+ if (CS%id_ddt_3dstokes_x>0) &
+ call post_data(CS%id_ddt_3dstokes_x, CS%ddt_us_x, CS%diag)
+ if (CS%id_ddt_3dstokes_y>0) &
+ call post_data(CS%id_ddt_3dstokes_y, CS%ddt_us_y, CS%diag)
+ if (CS%id_3dstokes_x_from_ddt>0) &
+ call post_data(CS%id_3dstokes_x_from_ddt, CS%us_x_from_ddt, CS%diag)
+ if (CS%id_3dstokes_y_from_ddt>0) &
+ call post_data(CS%id_3dstokes_y_from_ddt, CS%us_y_from_ddt, CS%diag)
+ endif
if (CS%id_La_turb>0) &
call post_data(CS%id_La_turb, CS%La_turb, CS%diag)
@@ -809,8 +907,8 @@ end function one_minus_exp_x
!> A subroutine to fill the Stokes drift from a NetCDF file
!! using the data_override procedures.
-subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS)
- type(time_type), intent(in) :: day_center !< Center of timestep
+subroutine Surface_Bands_by_data_override(Time, G, GV, US, CS)
+ type(time_type), intent(in) :: Time !< Time to get Stokes drift bands
type(wave_parameters_CS), pointer :: CS !< Wave structure
type(ocean_grid_type), intent(inout) :: G !< Grid structure
type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
@@ -869,7 +967,7 @@ subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS)
PI = 4.0*atan(1.0)
call read_variable(CS%SurfBandFileName, dim_name(1), CS%Freq_Cen, scale=2.*PI*US%T_to_s)
- do B = 1,CS%NumBands
+ do b = 1,CS%NumBands
CS%WaveNum_Cen(b) = CS%Freq_Cen(b)**2 / CS%g_Earth
enddo
endif
@@ -887,10 +985,10 @@ subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS)
temp_y(:,:) = 0.0
varname = ' '
write(varname, "(A3,I0)") 'Usx', b
- call data_override('OCN', trim(varname), temp_x, day_center)
+ call data_override('OCN', trim(varname), temp_x, Time)
varname = ' '
write(varname, "(A3,I0)") 'Usy', b
- call data_override('OCN', trim(varname), temp_y, day_center)
+ call data_override('OCN', trim(varname), temp_y, Time)
! Update halo on h-grid
call pass_vector(temp_x, temp_y, G%Domain, To_All, AGRID)
! Filter land values
@@ -1454,6 +1552,266 @@ subroutine CoriolisStokes(G, GV, dt, h, u, v, Waves)
enddo
end subroutine CoriolisStokes
+!> Computes tendency due to Stokes pressure gradient force anomaly
+!! including analytical integration of Stokes shear using multiple-exponential decay
+!! Stokes drift profile and vertical integration of the resulting pressure
+!! anomaly to the total pressure gradient force
+subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS )
+ type(ocean_grid_type), &
+ intent(in) :: G !< Ocean grid
+ type(verticalGrid_type), &
+ intent(in) :: GV !< Ocean vertical grid
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)),&
+ intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
+ intent(in) :: u !< Lagrangian Velocity i-component [m s-1]
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
+ intent(in) :: v !< Lagrangian Velocity j-component [m s-1]
+ real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), &
+ intent(out) :: PFu_Stokes !< PGF Stokes-shear i-component [L T-2]
+ real, dimension(SZI_(G),SZJB_(G),SZK_(G)), &
+ intent(out) :: PFv_Stokes !< PGF Stokes-shear j-component [m s-1]
+ type(Wave_parameters_CS), &
+ pointer :: CS !< Surface wave related control structure.
+
+ ! Local variables
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: P_deltaStokes_L ! The stokes induced Pressure anomaly, layer averaged
+ real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: P_deltaStokes_i ! The stokes induced Pressure anomaly at interfaces
+ real :: P_Stokes_l, P_Stokes_r ! Stokes-induced pressure anomaly over layer (left/right of point) [L2 T-2 ~> m2 s-2]
+ real :: P_Stokes_l0, P_Stokes_r0 ! Stokes-induced pressure anomaly at interface
+ ! (left/right of point) [L2 T-2 ~> m2 s-2]
+ real :: dP_Stokes_l_dz, dP_Stokes_r_dz ! Contribution of layer to integrated Stokes pressure anomaly for summation
+ ! (left/right of point) [L3 T-2 ~> m3 s-2]
+ real :: dP_Stokes_l, dP_Stokes_r ! Net increment of Stokes pressure anomaly across layer for summation
+ ! (left/right of point) [L2 T-2 ~> m2 s-2]
+ real :: uE_l, uE_r, vE_l, vE_r ! Eulerian velocity components (left/right of point) [L T-1 ~> m s-1]
+ real :: uS0_l, uS0_r, vS0_l, vS0_r ! Surface Stokes velocity components (left/right of point) [L T-1 ~> m s-1]
+ real :: zi_l(SZK_(G)+1), zi_r(SZK_(G)+1) ! The height of the edges of the cells (left/right of point) [Z ~> m].
+ real :: idz_l(SZK_(G)), idz_r(SZK_(G)) ! The inverse thickness of the cells (left/right of point) [Z-1 ~> m-1]
+ real :: h_l, h_r ! The thickness of the cell (left/right of point) [Z ~> m].
+ real :: dexp2kzL,dexp4kzL,dexp2kzR,dexp4kzR ! Analytical evaluation of multi-exponential decay contribution
+ ! to Stokes pressure anomalies.
+ real :: TwoK, FourK, iTwoK, iFourK ! Wavenumber multipliers/inverses
+
+ integer :: i,j,k,l
+
+ !---------------------------------------------------------------
+ ! Compute the Stokes contribution to the pressure gradient force
+ !---------------------------------------------------------------
+ ! Notes on the algorithm/code:
+ ! This code requires computing velocities at bounding h points
+ ! of the u/v points to get the pressure-gradient. In this
+ ! implementation there are several redundant calculations as the
+ ! left/right points are computed at each cell while integrating
+ ! in the vertical, requiring about twice the calculations. The
+ ! velocities at the tracer points could be precomputed and
+ ! stored, but this would require more memory and cycling through
+ ! large 3d arrays while computing the pressures. This could be
+ ! explored as a way to speed up this code.
+ !---------------------------------------------------------------
+
+ PFu_Stokes(:,:,:) = 0.0
+ PFv_Stokes(:,:,:) = 0.0
+ if (CS%id_P_deltaStokes_i > 0) P_deltaStokes_i(:,:,:) = 0.0
+ if (CS%id_P_deltaStokes_L > 0) P_deltaStokes_L(:,:,:) = 0.0
+
+ ! First compute PGFu. The Stokes-induced pressure anomaly diagnostic is stored from this calculation.
+ ! > Seeking PGFx at (I,j), meanining we need to compute pressure at h-points (i,j) and (i+1,j).
+ ! UL(i,j) -> found as average of I-1 & I on j
+ ! UR(i+1,j) -> found as average of I & I+1 on j
+ ! VL(i,j) -> found on i as average of J-1 & J
+ ! VR(i+1,j) -> found on i+1 as average of J-1 & J
+ !
+ do j = G%jsc, G%jec ; do I = G%iscB, G%iecB
+ if (G%mask2dCu(I,j)>0.5) then
+ P_Stokes_l0 = 0.0
+ P_Stokes_r0 = 0.0
+ ! We don't need to precompute the grid in physical space arrays and could have done this during
+ ! the next loop, but this gives flexibility if the loop directions (integrations) are performed
+ ! upwards instead of downwards (it seems downwards is the better approach).
+ zi_l(1) = 0.0
+ zi_r(1) = 0.0
+ do k = 1, G%ke
+ h_l = h(i,j,k)*GV%H_to_Z
+ h_r = h(i+1,j,k)*GV%H_to_Z
+ zi_l(k+1) = zi_l(k) - h_l
+ zi_r(k+1) = zi_r(k) - h_r
+ Idz_l(k) = 1./max(0.1,h_l)
+ Idz_r(k) = 1./max(0.1,h_r)
+ enddo
+ do k = 1,G%ke
+ ! Computing (left/right) Eulerian velocities assuming the velocity passed to this routine is the
+ ! Lagrangian velocity. This requires the wave acceleration terms to be activated together.
+ uE_l = 0.5*((u(I-1,j,k)-CS%Us_x(I-1,j,k))*G%mask2dCu(I-1,j) + &
+ (u(I,j,k)-CS%Us_x(I-1,j,k))*G%mask2dCu(I,j))
+ uE_r = 0.5*((u(I,j,k)-CS%Us_x(I,j,k))*G%mask2dCu(I,j) + &
+ (u(I+1,j,k)-CS%Us_x(I+1,j,k))*G%mask2dCu(I+1,j))
+ vE_l = 0.5*((v(i,J-1,k)-CS%Us_y(i,J-1,k))*G%mask2dCv(i,J-1) + &
+ (v(i,J,k)-CS%Us_y(i,J,k))*G%mask2dCv(i,J))
+ vE_r = 0.5*((v(i+1,J-1,k)-CS%Us_y(i+1,J-1,k))*G%mask2dCv(i+1,J-1) + &
+ (v(i+1,J,k)-CS%Us_y(i+1,J,k))*G%mask2dCv(i+1,J))
+
+ dP_Stokes_l_dz = 0.0
+ dP_Stokes_r_dz = 0.0
+ dP_Stokes_l = 0.0
+ dP_Stokes_r = 0.0
+
+ do l = 1, CS%numbands
+
+ ! Computing (left/right) surface Stokes drift velocities at wavenumber band
+ uS0_l = 0.5*(CS%Stkx0(I-1,j,l)*G%mask2dCu(I-1,j) + &
+ CS%Stkx0(I,j,l)*G%mask2dCu(I,j))
+ uS0_r = 0.5*(CS%Stkx0(I,j,l)*G%mask2dCu(I,j) + &
+ CS%Stkx0(I+1,j,l)*G%mask2dCu(I+1,j))
+ vS0_l = 0.5*(CS%Stky0(i,J-1,l)*G%mask2dCv(i,J-1) + &
+ CS%Stky0(i,J,l)*G%mask2dCv(i,J))
+ vS0_r = 0.5*(CS%Stky0(i+1,J-1,l)*G%mask2dCv(i+1,J-1) + &
+ CS%Stky0(i+1,J,l)*G%mask2dCv(i+1,J))
+
+ ! Wavenumber terms that are useful to simplify the pressure calculations
+ TwoK = 2.*CS%WaveNum_Cen(l)
+ FourK = 2.*TwoK
+ iTwoK = 1./TwoK
+ iFourK = 1./(FourK)
+ dexp2kzL = exp(TwoK*zi_l(k))-exp(TwoK*zi_l(k+1))
+ dexp2kzR = exp(TwoK*zi_r(k))-exp(TwoK*zi_r(k+1))
+ dexp4kzL = exp(FourK*zi_l(k))-exp(FourK*zi_l(k+1))
+ dexp4kzR = exp(FourK*zi_r(k))-exp(FourK*zi_r(k+1))
+
+ ! Compute Pressure at interface and integrated over layer on left/right bounding points.
+ ! These are summed over wavenumber bands.
+ if (G%mask2dT(i,j)>0.5) then
+ dP_Stokes_l_dz = dP_Stokes_l_dz + &
+ ((uE_l*uS0_l+vE_l*vS0_l)*iTwoK*dexp2kzL + 0.5*(uS0_l*uS0_l+vS0_l*vS0_l)*iFourK*dexp4kzL)
+ dP_Stokes_l = dP_Stokes_l + (uE_l*uS0_l+vE_l*vS0_l)*dexp2kzL + 0.5*(uS0_l*uS0_l+vS0_l*vS0_l)*dexp4kzL
+ endif
+ if (G%mask2dT(i+1,j)>0.5) then
+ dP_Stokes_r_dz = dP_Stokes_r_dz + &
+ ((uE_r*uS0_r+vE_r*vS0_r)*iTwoK*dexp2kzR + 0.5*(uS0_l*uS0_l+vS0_l*vS0_l)*iFourK*dexp4kzR)
+ dP_Stokes_r = dP_Stokes_r + (uE_r*uS0_r+vE_r*vS0_r)*dexp2kzR + 0.5*(uS0_l*uS0_l+vS0_l*vS0_l)*dexp4kzR
+ endif
+ enddo
+
+ ! Summing PF over bands
+ ! > Increment the Layer averaged pressure
+ P_Stokes_l = P_Stokes_l0 + dP_Stokes_l_dz*Idz_l(k)
+ P_Stokes_r = P_Stokes_r0 + dP_Stokes_r_dz*Idz_r(k)
+ ! > Increment the Interface pressure
+ P_Stokes_l0 = P_Stokes_l0 + dP_Stokes_l
+ P_Stokes_r0 = P_Stokes_r0 + dP_Stokes_r
+
+ ! Pressure force anomaly is finite difference across the cell.
+ PFu_Stokes(I,j,k) = (P_Stokes_r - P_Stokes_l)*G%IdxCu(I,j)
+
+ ! Choose to output the pressure delta on the h-points from the PFu calculation.
+ if (G%mask2dT(i,j)>0.5 .and. CS%id_P_deltaStokes_L > 0) P_deltaStokes_L(i,j,k) = P_Stokes_l
+ if (G%mask2dT(i,j)>0.5 .and. CS%id_P_deltaStokes_i > 0) P_deltaStokes_i(i,j,k+1) = P_Stokes_l0
+
+ enddo
+ endif
+ enddo ; enddo
+
+ ! Next compute PGFv. The Stokes-induced pressure anomaly diagnostic is stored from this calculation.
+ ! > Seeking PGFy at (i,J), meanining we need to compute pressure at h-points (i,j) and (i,j+1).
+ ! UL(i,j) -> found as average of I-1 & I on j
+ ! UR(i,j+1) -> found as average of I-1 & I on j+1
+ ! VL(i,j) -> found on i as average of J-1 & J
+ ! VR(i,j+1) -> found on i as average of J & J+1
+ !
+ do J = G%jscB, G%jecB ; do i = G%isc, G%iec
+ if (G%mask2dCv(i,J)>0.5) then
+ P_Stokes_l0 = 0.0
+ P_Stokes_r0 = 0.0
+ zi_l(1) = 0.0
+ zi_r(1) = 0.0
+ do k = 1, G%ke
+ h_l = h(i,j,k)*GV%H_to_Z
+ h_r = h(i,j+1,k)*GV%H_to_Z
+ zi_l(k+1) = zi_l(k) - h_l
+ zi_r(k+1) = zi_r(k) - h_r
+ Idz_l(k) = 1./max(0.1,h_l)
+ Idz_r(k) = 1./max(0.1,h_r)
+ enddo
+ do k = 1,G%ke
+ ! Computing (left/right) Eulerian velocities assuming the velocity passed to this routine is the
+ ! Lagrangian velocity. This requires the wave acceleration terms to be activated together.
+ uE_l = 0.5*((u(I-1,j,k)-CS%Us_x(I-1,j,k))*G%mask2dCu(I-1,j) + &
+ (u(I,j,k)-CS%Us_x(I,j,k))*G%mask2dCu(I,j))
+ uE_r = 0.5*((u(I-1,j+1,k)-CS%Us_x(I-1,j+1,k))*G%mask2dCu(I-1,j+1) + &
+ (u(I,j+1,k)-CS%Us_x(I,j+1,k))*G%mask2dCu(I,j+1))
+ vE_l = 0.5*((v(i,J-1,k)-CS%Us_y(i,J-1,k))*G%mask2dCv(i,J-1) + &
+ (v(i,J,k)-CS%Us_y(i,J,k))*G%mask2dCv(i,J))
+ vE_r = 0.5*((v(i,J,k)-CS%Us_y(i,J,k))*G%mask2dCv(i,J) + &
+ (v(i,J+1,k)-CS%Us_y(i,J+1,k))*G%mask2dCv(i,J+1))
+
+ dP_Stokes_l_dz = 0.0
+ dP_Stokes_r_dz = 0.0
+ dP_Stokes_l = 0.0
+ dP_Stokes_r = 0.0
+
+ do l = 1, CS%numbands
+
+ ! Computing (left/right) surface Stokes drift velocities at wavenumber band
+ uS0_l = 0.5*(CS%Stkx0(I-1,j,l)*G%mask2dCu(I-1,j) + &
+ CS%Stkx0(I,j,l)*G%mask2dCu(I,j))
+ uS0_r = 0.5*(CS%Stkx0(I-1,j+1,l)*G%mask2dCu(I-1,j+1) + &
+ CS%Stkx0(I,j+1,l)*G%mask2dCu(I,j+1))
+ vS0_l = 0.5*(CS%Stky0(i,J-1,l)*G%mask2dCv(i,J-1) + &
+ CS%Stky0(i,J,l)*G%mask2dCv(i,J))
+ vS0_r = 0.5*(CS%Stky0(i,J,l)*G%mask2dCv(i,J) + &
+ CS%Stky0(i,J+1,l)*G%mask2dCv(i,J+1))
+
+ ! Wavenumber terms that are useful to simplify the pressure calculations
+ TwoK = 2.*CS%WaveNum_Cen(l)
+ FourK = 2.*TwoK
+ iTwoK = 1./TwoK
+ iFourK = 1./(FourK)
+ dexp2kzL = exp(TwoK*zi_l(k))-exp(TwoK*zi_l(k+1))
+ dexp2kzR = exp(TwoK*zi_r(k))-exp(TwoK*zi_r(k+1))
+ dexp4kzL = exp(FourK*zi_l(k))-exp(FourK*zi_l(k+1))
+ dexp4kzR = exp(FourK*zi_r(k))-exp(FourK*zi_r(k+1))
+
+ ! Compute Pressure at interface and integrated over layer on left/right bounding points.
+ ! These are summed over wavenumber bands.
+ if (G%mask2dT(i,j)>0.5) then
+ dP_Stokes_l_dz = dP_Stokes_l_dz + &
+ ((uE_l*uS0_l+vE_l*vS0_l)*iTwoK*dexp2kzL + 0.5*(uS0_l*uS0_l+vS0_l*vS0_l)*iFourK*dexp4kzL)
+ dP_Stokes_l = dP_Stokes_l + (uE_l*uS0_l+vE_l*vS0_l)*dexp2kzL + 0.5*(uS0_l*uS0_l+vS0_l*vS0_l)*dexp4kzL
+ endif
+ if (G%mask2dT(i,j+1)>0.5) then
+ dP_Stokes_r_dz = dP_Stokes_r_dz + &
+ ((uE_r*uS0_r+vE_r*vS0_r)*iTwoK*dexp2kzR + 0.5*(uS0_l*uS0_l+vS0_l*vS0_l)*iFourK*dexp4kzR)
+ dP_Stokes_r = dP_Stokes_r + (uE_r*uS0_r+vE_r*vS0_r)*dexp2kzR + 0.5*(uS0_l*uS0_l+vS0_l*vS0_l)*dexp4kzR
+ endif
+ enddo
+
+ ! Summing PF over bands
+ ! > Increment the Layer averaged pressure
+ P_Stokes_l = P_Stokes_l0 + dP_Stokes_l_dz*Idz_l(k)
+ P_Stokes_r = P_Stokes_r0 + dP_Stokes_r_dz*Idz_r(k)
+ ! > Increment the Interface pressure
+ P_Stokes_l0 = P_Stokes_l0 + dP_Stokes_l
+ P_Stokes_r0 = P_Stokes_r0 + dP_Stokes_r
+
+ ! Pressure force anomaly is finite difference across the cell.
+ PFv_Stokes(I,j,k) = (P_Stokes_r - P_Stokes_l)*G%IdyCv(i,J)
+
+ enddo
+ endif
+ enddo ; enddo
+
+ if (CS%id_PFv_Stokes>0) &
+ call post_data(CS%id_PFv_Stokes, PFv_Stokes, CS%diag)
+ if (CS%id_PFu_Stokes>0) &
+ call post_data(CS%id_PFu_Stokes, PFu_Stokes, CS%diag)
+ if (CS%id_P_deltaStokes_L>0) &
+ call post_data(CS%id_P_deltaStokes_L, P_deltaStokes_L, CS%diag)
+ if (CS%id_P_deltaStokes_i>0) &
+ call post_data(CS%id_P_deltaStokes_i, P_deltaStokes_i, CS%diag)
+
+end subroutine Stokes_PGF
+
+
!> Computes wind speed from ustar_air based on COARE 3.5 Cd relationship
!! Probably doesn't belong in this module, but it is used here to estimate
!! wind speed for wind-wave relationships. Should be a fine way to estimate
@@ -1530,6 +1888,53 @@ subroutine Waves_end(CS)
end subroutine Waves_end
+!> Register wave restart fields. To be called before MOM_wave_interface_init
+subroutine waves_register_restarts(CS, HI, GV, param_file, restart_CSp)
+ type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure
+ type(hor_index_type), intent(inout) :: HI !< Grid structure
+ type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure
+ type(param_file_type), intent(in) :: param_file !< Input parameter structure
+ type(MOM_restart_CS), pointer :: restart_CSp !< Restart structure, data intent(inout)
+ ! Local variables
+ type(vardesc) :: vd(2)
+ logical :: use_waves
+ logical :: StatisticalWaves
+ logical :: time_tendency_term
+ character(len=40) :: mdl = "MOM_wave_interface" !< This module's name.
+
+ if (associated(CS)) then
+ call MOM_error(FATAL, "waves_register_restarts: Called with initialized waves control structure")
+ endif
+ allocate(CS)
+
+ call get_param(param_file, mdl, "USE_WAVES", use_waves, &
+ "If true, enables surface wave modules.", do_not_log=.true., default=.false.)
+
+ ! Check if using LA_LI2016
+ call get_param(param_file,mdl,"USE_LA_LI2016",StatisticalWaves, &
+ do_not_log=.true.,default=.false.)
+
+ if (.not.(use_waves .or. StatisticalWaves)) return
+
+ call get_param(param_file,mdl,"STOKES_DDT",time_tendency_term, do_not_log=.true., default=.false.)
+
+ if (time_tendency_term) then
+ ! Allocate wave fields needed for restart file
+ allocate(CS%Us_x_prev(HI%isdB:HI%IedB,HI%jsd:HI%jed,GV%ke))
+ CS%Us_x_prev(:,:,:) = 0.0
+ allocate(CS%Us_y_prev(HI%isd:HI%Ied,HI%jsdB:HI%jedB,GV%ke))
+ CS%Us_y_prev(:,:,:) = 0.0
+ ! Register to restart
+ vd(1) = var_desc("Us_x_prev", "m s-1", "3d zonal Stokes drift profile",&
+ hor_grid='u',z_grid='L')
+ vd(2) = var_desc("Us_y_prev", "m s-1", "3d meridional Stokes drift profile",&
+ hor_grid='v',z_grid='L')
+ call register_restart_field(CS%US_x_prev(:,:,:), vd(1), .false., restart_CSp)
+ call register_restart_field(CS%US_y_prev(:,:,:), vd(2), .false., restart_CSp)
+ endif
+
+end subroutine waves_register_restarts
+
!> \namespace mom_wave_interface
!!
!! \author Brandon Reichl, 2018.